From f61249dda1c63c0ef27c0b77f0a71d1bcfc3ed11 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Tue, 27 Feb 2018 14:46:56 -0700 Subject: [PATCH 001/556] Initialize repository --- lilac/.gitignore | 14 ++++++++++++++ lilac/LICENSE | 34 ++++++++++++++++++++++++++++++++++ lilac/README.md | 4 ++++ 3 files changed, 52 insertions(+) create mode 100644 lilac/.gitignore create mode 100644 lilac/LICENSE create mode 100644 lilac/README.md diff --git a/lilac/.gitignore b/lilac/.gitignore new file mode 100644 index 0000000000..411de5d96e --- /dev/null +++ b/lilac/.gitignore @@ -0,0 +1,14 @@ +# directories that are checked out by the tool +cime/ +cime_config/ +components/ + +# generated local files +*.log + +# editor files +*~ +*.bak + +# generated python files +*.pyc diff --git a/lilac/LICENSE b/lilac/LICENSE new file mode 100644 index 0000000000..0ba25429ac --- /dev/null +++ b/lilac/LICENSE @@ -0,0 +1,34 @@ +Copyright (c) 2018, University Corporation for Atmospheric Research (UCAR) +All rights reserved. + +Developed by: + University Corporation for Atmospheric Research - National Center for Atmospheric Research + https://www2.cesm.ucar.edu/working-groups/sewg + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the "Software"), +to deal with the Software without restriction, including without limitation +the rights to use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to whom +the Software is furnished to do so, subject to the following conditions: + + - Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimers. + - Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimers in the documentation + and/or other materials provided with the distribution. + - Neither the names of [Name of Development Group, UCAR], + nor the names of its contributors may be used to endorse or promote + products derived from this Software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/lilac/README.md b/lilac/README.md new file mode 100644 index 0000000000..a7a62fb359 --- /dev/null +++ b/lilac/README.md @@ -0,0 +1,4 @@ +# LILAC + +LILAC, Lightweight Infrastructure for Land Atmosphere Coupling. + From 19af6730ef38e17ac804e5dbadc33d4e25e2bf2b Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Tue, 27 Feb 2018 14:48:13 -0700 Subject: [PATCH 002/556] Add clm-driver prototype source from Tony Craig. Add the clm-driver prototype source from Tony Craig based on svn https://svn-ccsm-models.cgd.ucar.edu/cesm1/exp_tags/cesm_clmdrv_150802 revision 88478 --- lilac/src/clmdrv.F90 | 394 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 394 insertions(+) create mode 100644 lilac/src/clmdrv.F90 diff --git a/lilac/src/clmdrv.F90 b/lilac/src/clmdrv.F90 new file mode 100644 index 0000000000..2fa6002069 --- /dev/null +++ b/lilac/src/clmdrv.F90 @@ -0,0 +1,394 @@ + +PROGRAM clmdrv + + use lnd_comp_mct , only: lnd_init_mct, lnd_run_mct, lnd_final_mct + use seq_flds_mod , only: & + seq_flds_x2l_states, seq_flds_x2l_fluxes, seq_flds_x2l_fields, & + seq_flds_l2x_states, seq_flds_l2x_fluxes, seq_flds_l2x_fields, & + seq_flds_dom_coord, seq_flds_dom_other, seq_flds_dom_fields + use seq_cdata_mod, only: seq_cdata + use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata + use shr_sys_mod , only: shr_sys_flush, shr_sys_abort + use shr_orb_mod , only: shr_orb_params + use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel + use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 + use mct_mod + use ESMF + + implicit none + +#include ! mpi library include file + + !----- Clocks ----- + type(ESMF_Clock) :: EClock ! Input synchronization clock + type(ESMF_Time) :: CurrTime, StartTime, StopTime + type(ESMF_TimeInterval) :: TimeStep + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar),target :: Calendar + integer :: yy,mm,dd,sec + + !----- MPI/MCT ----- + integer :: mpicom_clmdrv ! local mpicom + integer :: ID_clmdrv ! mct ID + integer :: ncomps ! number of separate components for MCT + integer :: ntasks,mytask ! mpicom size and rank + integer :: global_comm ! copy of mpi_comm_world for pio + integer,allocatable :: comp_id(:) ! for pio init2 + logical,allocatable :: comp_iamin(:) ! for pio init2 + character(len=64),allocatable :: comp_name(:) ! for pio init2 + integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 + + !----- Land Coupling Data ----- + type(seq_cdata) :: cdata ! Input land-model driver data + type(seq_infodata_type),target :: infodata ! infodata type + type(mct_aVect) :: x2l, l2x ! land model import and export states + type(mct_gGrid),target :: dom_lnd ! domain data for clm + type(mct_gsMap),target :: gsmap_lnd ! gsmap data for clm + integer :: orb_iyear ! Orbital + real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp + character(len=128) :: case_name, case_desc, model_version, hostname, username + character(len=128) :: start_type + logical :: brnch_retain_casename, single_column, atm_aero + real*8 :: scmlat, scmlon + integer :: idx_Sa_z, idx_Sa_u, idx_Sa_v, idx_Sa_tbot, idx_Sa_ptem, & + idx_Sa_shum, idx_Sa_pbot, idx_Faxa_rainc, idx_Faxa_rainl, & + idx_Faxa_snowc, idx_Faxa_snowl, idx_Faxa_lwdn, idx_Faxa_swndr, & + idx_Faxa_swvdr, idx_Faxa_swndf, idx_Faxa_swvdf + + !----- Atm Model ----- + integer :: atm_nx, atm_ny + integer :: gsize, lsize, gstart, gend ! domain decomp info + integer, allocatable :: gindex(:) ! domain decomp info + type(mct_aVect) :: x2l_a ! data for land on atm decomp + type(mct_aVect) :: l2x_a ! data from land on atm decomp + type(mct_gsMap) :: gsmap_atm ! gsmap data for atm + type(mct_rearr) :: rearr_atm2lnd ! rearranger for atm to land + type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm + + !----- Other ----- + integer :: n,m ! counter + character(len=128) :: string ! temporary string + integer :: ierr, rc ! local error status + integer :: iunit = 250 ! clmdrv log unit number + integer :: sunit = 249 ! share log unit number + character(len=*),parameter :: subname = 'clmdrv' + + !---------------------------------------------- + + !---------------------------------------------- + !--- MPI/MCT --- + !---------------------------------------------- + + call MPI_Init(ierr) + call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_clmdrv, ierr) + call MPI_COMM_RANK(mpicom_clmdrv, mytask, ierr) + call MPI_COMM_SIZE(mpicom_clmdrv, ntasks, ierr) + + ncomps = 1 + ID_clmdrv = 1 + call mct_world_init(ncomps,MPI_COMM_WORLD,mpicom_clmdrv,ID_clmdrv) + + !---------------------------------------------- + !--- Log File and PIO --- + !---------------------------------------------- + + global_comm = MPI_COMM_WORLD + call shr_pio_init1(ncomps, 'pio_in', global_comm) + allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) + do n = 1,ncomps + comp_id(n) = ID_clmdrv + comp_name(n) = 'LND' + comp_iamin(n) = .true. + comp_comm(n) = mpicom_clmdrv + comp_comm_iam(n) = mytask + enddo + call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) + deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) + + write(string,'(a,i4.4)') 'clmdrv.log.',mytask + open(iunit, file=trim(string)) + write(iunit,*) subname,' STARTING' + call shr_sys_flush(iunit) + + write(iunit,*) subname,' ntasks = ',ntasks + write(iunit,*) subname,' mytask = ',mytask + write(iunit,*) subname,' mct ID = ',ID_clmdrv + call shr_sys_flush(iunit) + call shr_file_setLogUnit(sunit) + call shr_file_setLogLevel(1) + + !---------------------------------------------- + !--- Clocks --- + !---------------------------------------------- + + call ESMF_Initialize(rc=rc) + Calendar = ESMF_CalendarCreate( name='clmdrv_NOLEAP', & + calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + EClock = ESMF_ClockCreate(name='clmdrv_EClock', & + TimeStep=TimeStep, startTime=StartTime, & + RefTime=StartTime, stopTime=stopTime, rc=rc) + + EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop' , & + clock=EClock, ringTime=StopTime, rc=rc) + EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', & + clock=EClock, ringTime=StopTime, rc=rc) + + call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec + call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + !---------------------------------------------- + !--- Coupling --- + !---------------------------------------------- + + !--- set mpicom and cdata memory + cdata%name = 'cdata_clmdrv' + cdata%ID = ID_clmdrv + cdata%mpicom = mpicom_clmdrv + cdata%dom => dom_lnd + cdata%gsmap => gsmap_lnd + cdata%infodata => infodata + + !--- coupling fields + seq_flds_dom_coord='lat:lon' + seq_flds_dom_other='area:aream:mask:frac' + seq_flds_dom_fields=trim(seq_flds_dom_coord)//':'//trim(seq_flds_dom_other) + + seq_flds_x2l_states= 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_pbot:Sg_icemask:Sg_icemask_coupled_fluxes' + seq_flds_x2l_fluxes= 'Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_lwdn:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Faxa_bcphidry:Faxa_bcphodry:Faxa_bcphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_ocphiwet:Faxa_dstwet1:Faxa_dstwet2:Faxa_dstwet3:Faxa_dstwet4:Faxa_dstdry1:Faxa_dstdry2:Faxa_dstdry3:Faxa_dstdry4:Flrr_flood:Flrr_volr' + seq_flds_x2l_fields= trim(seq_flds_x2l_states)//':'//trim(seq_flds_x2l_fluxes) + + seq_flds_l2x_states= 'Sl_avsdr:Sl_anidr:Sl_avsdf:Sl_anidf:Sl_tref:Sl_qref:Sl_t:Sl_fv:Sl_ram1:Sl_snowh:Sl_u10' + seq_flds_l2x_fluxes= 'Fall_swnet:Fall_taux:Fall_tauy:Fall_lat:Fall_sen:Fall_lwup:Fall_evap:Fall_flxdst1:Fall_flxdst2:Fall_flxdst3:Fall_flxdst4:Flrl_rofl:Flrl_rofi:Fall_voc001:Fall_voc002:Fall_voc003:Fall_voc004:Fall_voc005:Fall_voc006:Fall_voc007:Fall_voc008' + seq_flds_l2x_fields= trim(seq_flds_l2x_states)//':'//trim(seq_flds_l2x_fluxes) + + !--- set orbital params + orb_iyear = 1990 + call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & + orb_obliqr, orb_lambm0, orb_mvelpp, .true.) + call seq_infodata_putData(infodata, orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, & + orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr ) + + !--- set case information + case_name = 'clmdrv' + case_desc = 'clmdrv with clm' + model_version = 'clmdrv0.1' + hostname = 'undefined' + username = 'undefined' + start_type = 'startup' + brnch_retain_casename = .true. + single_column = .false. + scmlat = 0.0 + scmlon = 0.0 + atm_aero = .true. + call seq_infodata_putData(infodata, case_name=case_name, & + case_desc=case_desc, single_column=single_column, & + scmlat=scmlat, scmlon=scmlon, & + brnch_retain_casename=brnch_retain_casename, & + start_type=start_type, model_version=model_version, & + hostname=hostname, username=username, & + atm_aero=atm_aero ) + + !---------------------------------------------- + !--- lnd_init --- + !---------------------------------------------- + + write(iunit,*) subname,' calling lnd_init_mct' + call shr_sys_flush(iunit) + call lnd_init_mct(Eclock, cdata, x2l, l2x) + + call diag_avect(l2x,mpicom_clmdrv,'l2x_init') + + idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') + idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') + idx_Sa_v = mct_avect_indexra(x2l,'Sa_v') + idx_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') + idx_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') + idx_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') + idx_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') + idx_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') + idx_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') + idx_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') + idx_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') + idx_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') + idx_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') + idx_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') + idx_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') + idx_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') + + !---------------------------------------------- + !--- atm and atm/lnd coupling init --- + !---------------------------------------------- + + ! set atm grid size to land grid size in this example. for a real + ! atmosphere model, the atm and land grids should agree at the outset. + call seq_infodata_getData(infodata,lnd_nx=atm_nx,lnd_ny=atm_ny) + + ! atm decomp + gstart = ((mytask * atm_nx * atm_ny) / ntasks) + 1 + gend = (((mytask+1) * atm_nx * atm_ny) / ntasks) + lsize = gend - gstart + 1 + gsize = atm_nx * atm_ny + allocate(gindex(lsize)) + do n = gstart, gend + m = n-gstart+1 + gindex(m) = n + end do + write(iunit,'(1x,2a,5i8)') subname,' atm decomp = ',mytask,gsize,lsize,gstart,gend + + ! initialize land grid on atm decomp + call mct_gsMap_init(gsmap_atm, gindex, mpicom_clmdrv, ID_clmdrv, lsize, gsize) + deallocate(gindex) + + ! initialize rearrangers between atm and land decomps + call mct_rearr_init(gsmap_atm, gsmap_lnd, mpicom_clmdrv, rearr_atm2lnd) + call mct_rearr_init(gsmap_lnd, gsmap_atm, mpicom_clmdrv, rearr_lnd2atm) + + ! initialize atm avects from land avects with atm lsize + call mct_avect_init(x2l_a, x2l, lsize) + call mct_avect_zero(x2l_a) + call mct_avect_init(l2x_a, l2x, lsize) + call mct_avect_zero(l2x_a) + + !---------------------------------------------- + !--- Time Loop --- + !---------------------------------------------- + + call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) + do while (CurrTime < StopTime) + call ESMF_ClockAdvance(EClock, rc=rc) + call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) + call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' clmdrv ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + ! can manually override the alarms as needed + call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) + if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) + + ! set the coupling data that is sent to the land model, this is on atm decomp + ! this is just sample test data + x2l_a%rAttr(:,:) = 0.0 + x2l_a%rAttr(idx_Sa_z ,:) = 30.0 ! m + x2l_a%rAttr(idx_Sa_u ,:) = 0.0 ! m/s + x2l_a%rAttr(idx_Sa_v ,:) = 0.0 ! m/s + x2l_a%rAttr(idx_Sa_tbot ,:) = 280.0 ! degK + x2l_a%rAttr(idx_Sa_ptem ,:) = 280.0 ! degK + x2l_a%rAttr(idx_Sa_shum ,:) = 0.0004 ! kg/kg + x2l_a%rAttr(idx_Sa_pbot ,:) = 100100.0 ! Pa + x2l_a%rAttr(idx_Faxa_rainc,:) = 4.0e-8 ! kg/m2s + x2l_a%rAttr(idx_Faxa_rainl,:) = 3.0e-8 ! kg/m2s + x2l_a%rAttr(idx_Faxa_snowc,:) = 1.0e-8 ! kg/m2s + x2l_a%rAttr(idx_Faxa_snowl,:) = 2.0e-8 ! kg/m2s + x2l_a%rAttr(idx_Faxa_lwdn ,:) = 200.0 ! W/m2 + x2l_a%rAttr(idx_Faxa_swndr,:) = 100.0 ! W/m2 + x2l_a%rAttr(idx_Faxa_swvdr,:) = 90.0 ! W/m2 + x2l_a%rAttr(idx_Faxa_swndf,:) = 20.0 ! W/m2 + x2l_a%rAttr(idx_Faxa_swvdf,:) = 40.0 ! W/m2 + + ! rearrange data to land decomposition + call mct_rearr_rearrange(x2l_a, x2l, rearr_atm2lnd) + + ! diagnose + write(iunit,*) subname,' x2l fields: ',yy,mm,dd,sec +! call diag_avect(x2l_a,mpicom_clmdrv,'x2l_a') + call diag_avect(x2l,mpicom_clmdrv,'x2l') + + ! run clm + write(iunit,*) subname,' call lnd_run_mct',yy,mm,dd,sec + call lnd_run_mct(Eclock, cdata, x2l, l2x) + + ! rearrange data from land decomposition + call mct_rearr_rearrange(l2x, l2x_a, rearr_lnd2atm) + + ! diagnose + write(iunit,*) subname,' l2x fields: ',yy,mm,dd,sec + call diag_avect(l2x,mpicom_clmdrv,'l2x') +! call diag_avect(l2x_a,mpicom_clmdrv,'l2x_a') + enddo + + !---------------------------------------------- + !--- lnd_final --- + !---------------------------------------------- + + write(iunit,*) subname,' calling lnd_final_mct' + call shr_sys_flush(iunit) + call lnd_final_mct(Eclock, cdata, x2l, l2x) + + !---------------------------------------------- + !--- Done --- + !---------------------------------------------- + + write(iunit,*) subname,' DONE' + call shr_sys_flush(iunit) + call MPI_Finalize(ierr) + +contains +!====================================================================== + + SUBROUTINE diag_avect(av, mpicom, comment) + + use seq_infodata_mod + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + type(mct_aVect) , intent(in) :: av + integer , intent(in) :: mpicom + character(len=*), intent(in) :: comment + + !--- local --- + integer :: n,k ! counters + integer :: npts,nptsg ! number of local/global pts in AV + integer :: kflds ! number of fields in AV + real*8, pointer :: sumbuf (:) ! sum buffer + real*8, pointer :: sumbufg(:) ! sum buffer reduced + integer :: iam ! pe number + type(mct_string) :: mstring ! mct char type + character(len=128):: itemc ! string converted to char + + !----- formats ----- + character(*),parameter :: subName = '(diag_avect) ' + + !---------------------------------------------------------------- + + npts = mct_aVect_lsize(AV) + kflds = mct_aVect_nRattr(AV) + allocate(sumbuf(kflds),sumbufg(kflds)) + + sumbuf = 0.0 + + do k = 1,kflds + do n = 1,npts + sumbuf(k) = sumbuf(k) + (AV%rAttr(k,n)) + enddo + enddo + + call MPI_REDUCE(sumbuf,sumbufg,kflds,MPI_REAL8,MPI_SUM,0,mpicom,ierr) + call MPI_COMM_RANK(mpicom,iam,ierr) + + if (iam == 0) then + do k = 1,kflds + call mct_aVect_getRList(mstring,k,AV) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + write(iunit,101) trim(comment),k,sumbufg(k),trim(itemc) + enddo + call shr_sys_flush(iunit) + endif + + deallocate(sumbuf,sumbufg) + +101 format('comm_diag ',a,1x,i3,es26.19,1x,a) + + end subroutine diag_avect + +!====================================================================== +end PROGRAM clmdrv + From 65886d1c40183e3e10f9c8e5b7b4c1c376b2307e Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Tue, 27 Feb 2018 19:06:36 -0700 Subject: [PATCH 003/556] Add dir-locals file for emacs f90 settings. --- lilac/src/.dir-locals.el | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 lilac/src/.dir-locals.el diff --git a/lilac/src/.dir-locals.el b/lilac/src/.dir-locals.el new file mode 100644 index 0000000000..4edf085c03 --- /dev/null +++ b/lilac/src/.dir-locals.el @@ -0,0 +1,14 @@ +;;; Directory Local Variables +;;; For more information see (info "(emacs) Directory Variables") + +((f90-mode + (f90-program-indent . 3) + (f90-associate-indent . 3) + (f90-do-indent . 3) + (f90-if-indent . 3) + (f90-type-indent . 3) + (f90-program-indent . 3) + (f90-continuation-indent . 5) + (fill-column . 80) + (indent-tabs-mode))) + From 91f10b038a28ef2bbe1af5265c0064b076e06d28 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Tue, 27 Feb 2018 19:07:00 -0700 Subject: [PATCH 004/556] Cleanup whitespace in clmdriver --- lilac/src/clmdrv.F90 | 727 +++++++++++++++++++++---------------------- 1 file changed, 363 insertions(+), 364 deletions(-) diff --git a/lilac/src/clmdrv.F90 b/lilac/src/clmdrv.F90 index 2fa6002069..9d798b59ff 100644 --- a/lilac/src/clmdrv.F90 +++ b/lilac/src/clmdrv.F90 @@ -1,394 +1,393 @@ - PROGRAM clmdrv - use lnd_comp_mct , only: lnd_init_mct, lnd_run_mct, lnd_final_mct - use seq_flds_mod , only: & + use lnd_comp_mct , only: lnd_init_mct, lnd_run_mct, lnd_final_mct + use seq_flds_mod , only: & seq_flds_x2l_states, seq_flds_x2l_fluxes, seq_flds_x2l_fields, & seq_flds_l2x_states, seq_flds_l2x_fluxes, seq_flds_l2x_fields, & seq_flds_dom_coord, seq_flds_dom_other, seq_flds_dom_fields - use seq_cdata_mod, only: seq_cdata - use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata - use shr_sys_mod , only: shr_sys_flush, shr_sys_abort - use shr_orb_mod , only: shr_orb_params - use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel - use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 - use mct_mod - use ESMF + use seq_cdata_mod, only: seq_cdata + use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata + use shr_sys_mod , only: shr_sys_flush, shr_sys_abort + use shr_orb_mod , only: shr_orb_params + use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel + use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 + use mct_mod + use ESMF - implicit none + implicit none #include ! mpi library include file - !----- Clocks ----- - type(ESMF_Clock) :: EClock ! Input synchronization clock - type(ESMF_Time) :: CurrTime, StartTime, StopTime - type(ESMF_TimeInterval) :: TimeStep - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar),target :: Calendar - integer :: yy,mm,dd,sec - - !----- MPI/MCT ----- - integer :: mpicom_clmdrv ! local mpicom - integer :: ID_clmdrv ! mct ID - integer :: ncomps ! number of separate components for MCT - integer :: ntasks,mytask ! mpicom size and rank - integer :: global_comm ! copy of mpi_comm_world for pio - integer,allocatable :: comp_id(:) ! for pio init2 - logical,allocatable :: comp_iamin(:) ! for pio init2 - character(len=64),allocatable :: comp_name(:) ! for pio init2 - integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 - - !----- Land Coupling Data ----- - type(seq_cdata) :: cdata ! Input land-model driver data - type(seq_infodata_type),target :: infodata ! infodata type - type(mct_aVect) :: x2l, l2x ! land model import and export states - type(mct_gGrid),target :: dom_lnd ! domain data for clm - type(mct_gsMap),target :: gsmap_lnd ! gsmap data for clm - integer :: orb_iyear ! Orbital - real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp - character(len=128) :: case_name, case_desc, model_version, hostname, username - character(len=128) :: start_type - logical :: brnch_retain_casename, single_column, atm_aero - real*8 :: scmlat, scmlon - integer :: idx_Sa_z, idx_Sa_u, idx_Sa_v, idx_Sa_tbot, idx_Sa_ptem, & - idx_Sa_shum, idx_Sa_pbot, idx_Faxa_rainc, idx_Faxa_rainl, & - idx_Faxa_snowc, idx_Faxa_snowl, idx_Faxa_lwdn, idx_Faxa_swndr, & - idx_Faxa_swvdr, idx_Faxa_swndf, idx_Faxa_swvdf - - !----- Atm Model ----- - integer :: atm_nx, atm_ny - integer :: gsize, lsize, gstart, gend ! domain decomp info - integer, allocatable :: gindex(:) ! domain decomp info - type(mct_aVect) :: x2l_a ! data for land on atm decomp - type(mct_aVect) :: l2x_a ! data from land on atm decomp - type(mct_gsMap) :: gsmap_atm ! gsmap data for atm - type(mct_rearr) :: rearr_atm2lnd ! rearranger for atm to land - type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm - - !----- Other ----- - integer :: n,m ! counter - character(len=128) :: string ! temporary string - integer :: ierr, rc ! local error status - integer :: iunit = 250 ! clmdrv log unit number - integer :: sunit = 249 ! share log unit number - character(len=*),parameter :: subname = 'clmdrv' - - !---------------------------------------------- - - !---------------------------------------------- - !--- MPI/MCT --- - !---------------------------------------------- - - call MPI_Init(ierr) - call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_clmdrv, ierr) - call MPI_COMM_RANK(mpicom_clmdrv, mytask, ierr) - call MPI_COMM_SIZE(mpicom_clmdrv, ntasks, ierr) - - ncomps = 1 - ID_clmdrv = 1 - call mct_world_init(ncomps,MPI_COMM_WORLD,mpicom_clmdrv,ID_clmdrv) - - !---------------------------------------------- - !--- Log File and PIO --- - !---------------------------------------------- - - global_comm = MPI_COMM_WORLD - call shr_pio_init1(ncomps, 'pio_in', global_comm) - allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) - do n = 1,ncomps - comp_id(n) = ID_clmdrv - comp_name(n) = 'LND' - comp_iamin(n) = .true. - comp_comm(n) = mpicom_clmdrv - comp_comm_iam(n) = mytask - enddo - call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) - deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) - - write(string,'(a,i4.4)') 'clmdrv.log.',mytask - open(iunit, file=trim(string)) - write(iunit,*) subname,' STARTING' - call shr_sys_flush(iunit) - - write(iunit,*) subname,' ntasks = ',ntasks - write(iunit,*) subname,' mytask = ',mytask - write(iunit,*) subname,' mct ID = ',ID_clmdrv - call shr_sys_flush(iunit) - call shr_file_setLogUnit(sunit) - call shr_file_setLogLevel(1) - - !---------------------------------------------- - !--- Clocks --- - !---------------------------------------------- - - call ESMF_Initialize(rc=rc) - Calendar = ESMF_CalendarCreate( name='clmdrv_NOLEAP', & - calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - EClock = ESMF_ClockCreate(name='clmdrv_EClock', & - TimeStep=TimeStep, startTime=StartTime, & - RefTime=StartTime, stopTime=stopTime, rc=rc) - - EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop' , & - clock=EClock, ringTime=StopTime, rc=rc) - EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', & - clock=EClock, ringTime=StopTime, rc=rc) - - call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec - call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - !---------------------------------------------- - !--- Coupling --- - !---------------------------------------------- - - !--- set mpicom and cdata memory - cdata%name = 'cdata_clmdrv' - cdata%ID = ID_clmdrv - cdata%mpicom = mpicom_clmdrv - cdata%dom => dom_lnd - cdata%gsmap => gsmap_lnd - cdata%infodata => infodata - - !--- coupling fields - seq_flds_dom_coord='lat:lon' - seq_flds_dom_other='area:aream:mask:frac' - seq_flds_dom_fields=trim(seq_flds_dom_coord)//':'//trim(seq_flds_dom_other) - - seq_flds_x2l_states= 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_pbot:Sg_icemask:Sg_icemask_coupled_fluxes' - seq_flds_x2l_fluxes= 'Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_lwdn:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Faxa_bcphidry:Faxa_bcphodry:Faxa_bcphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_ocphiwet:Faxa_dstwet1:Faxa_dstwet2:Faxa_dstwet3:Faxa_dstwet4:Faxa_dstdry1:Faxa_dstdry2:Faxa_dstdry3:Faxa_dstdry4:Flrr_flood:Flrr_volr' - seq_flds_x2l_fields= trim(seq_flds_x2l_states)//':'//trim(seq_flds_x2l_fluxes) - - seq_flds_l2x_states= 'Sl_avsdr:Sl_anidr:Sl_avsdf:Sl_anidf:Sl_tref:Sl_qref:Sl_t:Sl_fv:Sl_ram1:Sl_snowh:Sl_u10' - seq_flds_l2x_fluxes= 'Fall_swnet:Fall_taux:Fall_tauy:Fall_lat:Fall_sen:Fall_lwup:Fall_evap:Fall_flxdst1:Fall_flxdst2:Fall_flxdst3:Fall_flxdst4:Flrl_rofl:Flrl_rofi:Fall_voc001:Fall_voc002:Fall_voc003:Fall_voc004:Fall_voc005:Fall_voc006:Fall_voc007:Fall_voc008' - seq_flds_l2x_fields= trim(seq_flds_l2x_states)//':'//trim(seq_flds_l2x_fluxes) - - !--- set orbital params - orb_iyear = 1990 - call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & - orb_obliqr, orb_lambm0, orb_mvelpp, .true.) - call seq_infodata_putData(infodata, orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, & - orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr ) - - !--- set case information - case_name = 'clmdrv' - case_desc = 'clmdrv with clm' - model_version = 'clmdrv0.1' - hostname = 'undefined' - username = 'undefined' - start_type = 'startup' - brnch_retain_casename = .true. - single_column = .false. - scmlat = 0.0 - scmlon = 0.0 - atm_aero = .true. - call seq_infodata_putData(infodata, case_name=case_name, & - case_desc=case_desc, single_column=single_column, & - scmlat=scmlat, scmlon=scmlon, & - brnch_retain_casename=brnch_retain_casename, & - start_type=start_type, model_version=model_version, & - hostname=hostname, username=username, & - atm_aero=atm_aero ) - - !---------------------------------------------- - !--- lnd_init --- - !---------------------------------------------- - - write(iunit,*) subname,' calling lnd_init_mct' - call shr_sys_flush(iunit) - call lnd_init_mct(Eclock, cdata, x2l, l2x) - - call diag_avect(l2x,mpicom_clmdrv,'l2x_init') - - idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') - idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') - idx_Sa_v = mct_avect_indexra(x2l,'Sa_v') - idx_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') - idx_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') - idx_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') - idx_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') - idx_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') - idx_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') - idx_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') - idx_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') - idx_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') - idx_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') - idx_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') - idx_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') - idx_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') - - !---------------------------------------------- - !--- atm and atm/lnd coupling init --- - !---------------------------------------------- - - ! set atm grid size to land grid size in this example. for a real - ! atmosphere model, the atm and land grids should agree at the outset. - call seq_infodata_getData(infodata,lnd_nx=atm_nx,lnd_ny=atm_ny) - - ! atm decomp - gstart = ((mytask * atm_nx * atm_ny) / ntasks) + 1 - gend = (((mytask+1) * atm_nx * atm_ny) / ntasks) - lsize = gend - gstart + 1 - gsize = atm_nx * atm_ny - allocate(gindex(lsize)) - do n = gstart, gend - m = n-gstart+1 - gindex(m) = n - end do - write(iunit,'(1x,2a,5i8)') subname,' atm decomp = ',mytask,gsize,lsize,gstart,gend - - ! initialize land grid on atm decomp - call mct_gsMap_init(gsmap_atm, gindex, mpicom_clmdrv, ID_clmdrv, lsize, gsize) - deallocate(gindex) - - ! initialize rearrangers between atm and land decomps - call mct_rearr_init(gsmap_atm, gsmap_lnd, mpicom_clmdrv, rearr_atm2lnd) - call mct_rearr_init(gsmap_lnd, gsmap_atm, mpicom_clmdrv, rearr_lnd2atm) - - ! initialize atm avects from land avects with atm lsize - call mct_avect_init(x2l_a, x2l, lsize) - call mct_avect_zero(x2l_a) - call mct_avect_init(l2x_a, l2x, lsize) - call mct_avect_zero(l2x_a) - - !---------------------------------------------- - !--- Time Loop --- - !---------------------------------------------- - - call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) - do while (CurrTime < StopTime) - call ESMF_ClockAdvance(EClock, rc=rc) - call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) - call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' clmdrv ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - ! can manually override the alarms as needed - call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) - if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) - - ! set the coupling data that is sent to the land model, this is on atm decomp - ! this is just sample test data - x2l_a%rAttr(:,:) = 0.0 - x2l_a%rAttr(idx_Sa_z ,:) = 30.0 ! m - x2l_a%rAttr(idx_Sa_u ,:) = 0.0 ! m/s - x2l_a%rAttr(idx_Sa_v ,:) = 0.0 ! m/s - x2l_a%rAttr(idx_Sa_tbot ,:) = 280.0 ! degK - x2l_a%rAttr(idx_Sa_ptem ,:) = 280.0 ! degK - x2l_a%rAttr(idx_Sa_shum ,:) = 0.0004 ! kg/kg - x2l_a%rAttr(idx_Sa_pbot ,:) = 100100.0 ! Pa - x2l_a%rAttr(idx_Faxa_rainc,:) = 4.0e-8 ! kg/m2s - x2l_a%rAttr(idx_Faxa_rainl,:) = 3.0e-8 ! kg/m2s - x2l_a%rAttr(idx_Faxa_snowc,:) = 1.0e-8 ! kg/m2s - x2l_a%rAttr(idx_Faxa_snowl,:) = 2.0e-8 ! kg/m2s - x2l_a%rAttr(idx_Faxa_lwdn ,:) = 200.0 ! W/m2 - x2l_a%rAttr(idx_Faxa_swndr,:) = 100.0 ! W/m2 - x2l_a%rAttr(idx_Faxa_swvdr,:) = 90.0 ! W/m2 - x2l_a%rAttr(idx_Faxa_swndf,:) = 20.0 ! W/m2 - x2l_a%rAttr(idx_Faxa_swvdf,:) = 40.0 ! W/m2 - - ! rearrange data to land decomposition - call mct_rearr_rearrange(x2l_a, x2l, rearr_atm2lnd) - - ! diagnose - write(iunit,*) subname,' x2l fields: ',yy,mm,dd,sec -! call diag_avect(x2l_a,mpicom_clmdrv,'x2l_a') - call diag_avect(x2l,mpicom_clmdrv,'x2l') - - ! run clm - write(iunit,*) subname,' call lnd_run_mct',yy,mm,dd,sec - call lnd_run_mct(Eclock, cdata, x2l, l2x) - - ! rearrange data from land decomposition - call mct_rearr_rearrange(l2x, l2x_a, rearr_lnd2atm) - - ! diagnose - write(iunit,*) subname,' l2x fields: ',yy,mm,dd,sec - call diag_avect(l2x,mpicom_clmdrv,'l2x') -! call diag_avect(l2x_a,mpicom_clmdrv,'l2x_a') - enddo - - !---------------------------------------------- - !--- lnd_final --- - !---------------------------------------------- - - write(iunit,*) subname,' calling lnd_final_mct' - call shr_sys_flush(iunit) - call lnd_final_mct(Eclock, cdata, x2l, l2x) - - !---------------------------------------------- - !--- Done --- - !---------------------------------------------- - - write(iunit,*) subname,' DONE' - call shr_sys_flush(iunit) - call MPI_Finalize(ierr) + !----- Clocks ----- + type(ESMF_Clock) :: EClock ! Input synchronization clock + type(ESMF_Time) :: CurrTime, StartTime, StopTime + type(ESMF_TimeInterval) :: TimeStep + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar),target :: Calendar + integer :: yy,mm,dd,sec + + !----- MPI/MCT ----- + integer :: mpicom_clmdrv ! local mpicom + integer :: ID_clmdrv ! mct ID + integer :: ncomps ! number of separate components for MCT + integer :: ntasks,mytask ! mpicom size and rank + integer :: global_comm ! copy of mpi_comm_world for pio + integer,allocatable :: comp_id(:) ! for pio init2 + logical,allocatable :: comp_iamin(:) ! for pio init2 + character(len=64),allocatable :: comp_name(:) ! for pio init2 + integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 + + !----- Land Coupling Data ----- + type(seq_cdata) :: cdata ! Input land-model driver data + type(seq_infodata_type),target :: infodata ! infodata type + type(mct_aVect) :: x2l, l2x ! land model import and export states + type(mct_gGrid),target :: dom_lnd ! domain data for clm + type(mct_gsMap),target :: gsmap_lnd ! gsmap data for clm + integer :: orb_iyear ! Orbital + real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp + character(len=128) :: case_name, case_desc, model_version, hostname, username + character(len=128) :: start_type + logical :: brnch_retain_casename, single_column, atm_aero + real*8 :: scmlat, scmlon + integer :: idx_Sa_z, idx_Sa_u, idx_Sa_v, idx_Sa_tbot, idx_Sa_ptem, & + idx_Sa_shum, idx_Sa_pbot, idx_Faxa_rainc, idx_Faxa_rainl, & + idx_Faxa_snowc, idx_Faxa_snowl, idx_Faxa_lwdn, idx_Faxa_swndr, & + idx_Faxa_swvdr, idx_Faxa_swndf, idx_Faxa_swvdf + + !----- Atm Model ----- + integer :: atm_nx, atm_ny + integer :: gsize, lsize, gstart, gend ! domain decomp info + integer, allocatable :: gindex(:) ! domain decomp info + type(mct_aVect) :: x2l_a ! data for land on atm decomp + type(mct_aVect) :: l2x_a ! data from land on atm decomp + type(mct_gsMap) :: gsmap_atm ! gsmap data for atm + type(mct_rearr) :: rearr_atm2lnd ! rearranger for atm to land + type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm + + !----- Other ----- + integer :: n,m ! counter + character(len=128) :: string ! temporary string + integer :: ierr, rc ! local error status + integer :: iunit = 250 ! clmdrv log unit number + integer :: sunit = 249 ! share log unit number + character(len=*),parameter :: subname = 'clmdrv' + + !---------------------------------------------- + + !---------------------------------------------- + !--- MPI/MCT --- + !---------------------------------------------- + + call MPI_Init(ierr) + call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_clmdrv, ierr) + call MPI_COMM_RANK(mpicom_clmdrv, mytask, ierr) + call MPI_COMM_SIZE(mpicom_clmdrv, ntasks, ierr) + + ncomps = 1 + ID_clmdrv = 1 + call mct_world_init(ncomps,MPI_COMM_WORLD,mpicom_clmdrv,ID_clmdrv) + + !---------------------------------------------- + !--- Log File and PIO --- + !---------------------------------------------- + + global_comm = MPI_COMM_WORLD + call shr_pio_init1(ncomps, 'pio_in', global_comm) + allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) + do n = 1,ncomps + comp_id(n) = ID_clmdrv + comp_name(n) = 'LND' + comp_iamin(n) = .true. + comp_comm(n) = mpicom_clmdrv + comp_comm_iam(n) = mytask + enddo + call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) + deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) + + write(string,'(a,i4.4)') 'clmdrv.log.',mytask + open(iunit, file=trim(string)) + write(iunit,*) subname,' STARTING' + call shr_sys_flush(iunit) + + write(iunit,*) subname,' ntasks = ',ntasks + write(iunit,*) subname,' mytask = ',mytask + write(iunit,*) subname,' mct ID = ',ID_clmdrv + call shr_sys_flush(iunit) + call shr_file_setLogUnit(sunit) + call shr_file_setLogLevel(1) + + !---------------------------------------------- + !--- Clocks --- + !---------------------------------------------- + + call ESMF_Initialize(rc=rc) + Calendar = ESMF_CalendarCreate( name='clmdrv_NOLEAP', & + calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + EClock = ESMF_ClockCreate(name='clmdrv_EClock', & + TimeStep=TimeStep, startTime=StartTime, & + RefTime=StartTime, stopTime=stopTime, rc=rc) + + EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop' , & + clock=EClock, ringTime=StopTime, rc=rc) + EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', & + clock=EClock, ringTime=StopTime, rc=rc) + + call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec + call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + !---------------------------------------------- + !--- Coupling --- + !---------------------------------------------- + + !--- set mpicom and cdata memory + cdata%name = 'cdata_clmdrv' + cdata%ID = ID_clmdrv + cdata%mpicom = mpicom_clmdrv + cdata%dom => dom_lnd + cdata%gsmap => gsmap_lnd + cdata%infodata => infodata + + !--- coupling fields + seq_flds_dom_coord='lat:lon' + seq_flds_dom_other='area:aream:mask:frac' + seq_flds_dom_fields=trim(seq_flds_dom_coord)//':'//trim(seq_flds_dom_other) + + seq_flds_x2l_states= 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_pbot:Sg_icemask:Sg_icemask_coupled_fluxes' + seq_flds_x2l_fluxes= 'Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_lwdn:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Faxa_bcphidry:Faxa_bcphodry:Faxa_bcphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_ocphiwet:Faxa_dstwet1:Faxa_dstwet2:Faxa_dstwet3:Faxa_dstwet4:Faxa_dstdry1:Faxa_dstdry2:Faxa_dstdry3:Faxa_dstdry4:Flrr_flood:Flrr_volr' + seq_flds_x2l_fields= trim(seq_flds_x2l_states)//':'//trim(seq_flds_x2l_fluxes) + + seq_flds_l2x_states= 'Sl_avsdr:Sl_anidr:Sl_avsdf:Sl_anidf:Sl_tref:Sl_qref:Sl_t:Sl_fv:Sl_ram1:Sl_snowh:Sl_u10' + seq_flds_l2x_fluxes= 'Fall_swnet:Fall_taux:Fall_tauy:Fall_lat:Fall_sen:Fall_lwup:Fall_evap:Fall_flxdst1:Fall_flxdst2:Fall_flxdst3:Fall_flxdst4:Flrl_rofl:Flrl_rofi:Fall_voc001:Fall_voc002:Fall_voc003:Fall_voc004:Fall_voc005:Fall_voc006:Fall_voc007:Fall_voc008' + seq_flds_l2x_fields= trim(seq_flds_l2x_states)//':'//trim(seq_flds_l2x_fluxes) + + !--- set orbital params + orb_iyear = 1990 + call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & + orb_obliqr, orb_lambm0, orb_mvelpp, .true.) + call seq_infodata_putData(infodata, orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, & + orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr ) + + !--- set case information + case_name = 'clmdrv' + case_desc = 'clmdrv with clm' + model_version = 'clmdrv0.1' + hostname = 'undefined' + username = 'undefined' + start_type = 'startup' + brnch_retain_casename = .true. + single_column = .false. + scmlat = 0.0 + scmlon = 0.0 + atm_aero = .true. + call seq_infodata_putData(infodata, case_name=case_name, & + case_desc=case_desc, single_column=single_column, & + scmlat=scmlat, scmlon=scmlon, & + brnch_retain_casename=brnch_retain_casename, & + start_type=start_type, model_version=model_version, & + hostname=hostname, username=username, & + atm_aero=atm_aero ) + + !---------------------------------------------- + !--- lnd_init --- + !---------------------------------------------- + + write(iunit,*) subname,' calling lnd_init_mct' + call shr_sys_flush(iunit) + call lnd_init_mct(Eclock, cdata, x2l, l2x) + + call diag_avect(l2x,mpicom_clmdrv,'l2x_init') + + idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') + idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') + idx_Sa_v = mct_avect_indexra(x2l,'Sa_v') + idx_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') + idx_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') + idx_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') + idx_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') + idx_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') + idx_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') + idx_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') + idx_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') + idx_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') + idx_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') + idx_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') + idx_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') + idx_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') + + !---------------------------------------------- + !--- atm and atm/lnd coupling init --- + !---------------------------------------------- + + ! set atm grid size to land grid size in this example. for a real + ! atmosphere model, the atm and land grids should agree at the outset. + call seq_infodata_getData(infodata,lnd_nx=atm_nx,lnd_ny=atm_ny) + + ! atm decomp + gstart = ((mytask * atm_nx * atm_ny) / ntasks) + 1 + gend = (((mytask+1) * atm_nx * atm_ny) / ntasks) + lsize = gend - gstart + 1 + gsize = atm_nx * atm_ny + allocate(gindex(lsize)) + do n = gstart, gend + m = n-gstart+1 + gindex(m) = n + end do + write(iunit,'(1x,2a,5i8)') subname,' atm decomp = ',mytask,gsize,lsize,gstart,gend + + ! initialize land grid on atm decomp + call mct_gsMap_init(gsmap_atm, gindex, mpicom_clmdrv, ID_clmdrv, lsize, gsize) + deallocate(gindex) + + ! initialize rearrangers between atm and land decomps + call mct_rearr_init(gsmap_atm, gsmap_lnd, mpicom_clmdrv, rearr_atm2lnd) + call mct_rearr_init(gsmap_lnd, gsmap_atm, mpicom_clmdrv, rearr_lnd2atm) + + ! initialize atm avects from land avects with atm lsize + call mct_avect_init(x2l_a, x2l, lsize) + call mct_avect_zero(x2l_a) + call mct_avect_init(l2x_a, l2x, lsize) + call mct_avect_zero(l2x_a) + + !---------------------------------------------- + !--- Time Loop --- + !---------------------------------------------- + + call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) + do while (CurrTime < StopTime) + call ESMF_ClockAdvance(EClock, rc=rc) + call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) + call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' clmdrv ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + ! can manually override the alarms as needed + call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) + if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) + + ! set the coupling data that is sent to the land model, this is on atm decomp + ! this is just sample test data + x2l_a%rAttr(:,:) = 0.0 + x2l_a%rAttr(idx_Sa_z ,:) = 30.0 ! m + x2l_a%rAttr(idx_Sa_u ,:) = 0.0 ! m/s + x2l_a%rAttr(idx_Sa_v ,:) = 0.0 ! m/s + x2l_a%rAttr(idx_Sa_tbot ,:) = 280.0 ! degK + x2l_a%rAttr(idx_Sa_ptem ,:) = 280.0 ! degK + x2l_a%rAttr(idx_Sa_shum ,:) = 0.0004 ! kg/kg + x2l_a%rAttr(idx_Sa_pbot ,:) = 100100.0 ! Pa + x2l_a%rAttr(idx_Faxa_rainc,:) = 4.0e-8 ! kg/m2s + x2l_a%rAttr(idx_Faxa_rainl,:) = 3.0e-8 ! kg/m2s + x2l_a%rAttr(idx_Faxa_snowc,:) = 1.0e-8 ! kg/m2s + x2l_a%rAttr(idx_Faxa_snowl,:) = 2.0e-8 ! kg/m2s + x2l_a%rAttr(idx_Faxa_lwdn ,:) = 200.0 ! W/m2 + x2l_a%rAttr(idx_Faxa_swndr,:) = 100.0 ! W/m2 + x2l_a%rAttr(idx_Faxa_swvdr,:) = 90.0 ! W/m2 + x2l_a%rAttr(idx_Faxa_swndf,:) = 20.0 ! W/m2 + x2l_a%rAttr(idx_Faxa_swvdf,:) = 40.0 ! W/m2 + + ! rearrange data to land decomposition + call mct_rearr_rearrange(x2l_a, x2l, rearr_atm2lnd) + + ! diagnose + write(iunit,*) subname,' x2l fields: ',yy,mm,dd,sec + ! call diag_avect(x2l_a,mpicom_clmdrv,'x2l_a') + call diag_avect(x2l,mpicom_clmdrv,'x2l') + + ! run clm + write(iunit,*) subname,' call lnd_run_mct',yy,mm,dd,sec + call lnd_run_mct(Eclock, cdata, x2l, l2x) + + ! rearrange data from land decomposition + call mct_rearr_rearrange(l2x, l2x_a, rearr_lnd2atm) + + ! diagnose + write(iunit,*) subname,' l2x fields: ',yy,mm,dd,sec + call diag_avect(l2x,mpicom_clmdrv,'l2x') + ! call diag_avect(l2x_a,mpicom_clmdrv,'l2x_a') + enddo + + !---------------------------------------------- + !--- lnd_final --- + !---------------------------------------------- + + write(iunit,*) subname,' calling lnd_final_mct' + call shr_sys_flush(iunit) + call lnd_final_mct(Eclock, cdata, x2l, l2x) + + !---------------------------------------------- + !--- Done --- + !---------------------------------------------- + + write(iunit,*) subname,' DONE' + call shr_sys_flush(iunit) + call MPI_Finalize(ierr) contains -!====================================================================== + !====================================================================== - SUBROUTINE diag_avect(av, mpicom, comment) + SUBROUTINE diag_avect(av, mpicom, comment) - use seq_infodata_mod + use seq_infodata_mod - implicit none + implicit none -! !INPUT/OUTPUT PARAMETERS: + ! !INPUT/OUTPUT PARAMETERS: - type(mct_aVect) , intent(in) :: av - integer , intent(in) :: mpicom - character(len=*), intent(in) :: comment + type(mct_aVect) , intent(in) :: av + integer , intent(in) :: mpicom + character(len=*), intent(in) :: comment - !--- local --- - integer :: n,k ! counters - integer :: npts,nptsg ! number of local/global pts in AV - integer :: kflds ! number of fields in AV - real*8, pointer :: sumbuf (:) ! sum buffer - real*8, pointer :: sumbufg(:) ! sum buffer reduced - integer :: iam ! pe number - type(mct_string) :: mstring ! mct char type - character(len=128):: itemc ! string converted to char + !--- local --- + integer :: n,k ! counters + integer :: npts,nptsg ! number of local/global pts in AV + integer :: kflds ! number of fields in AV + real*8, pointer :: sumbuf (:) ! sum buffer + real*8, pointer :: sumbufg(:) ! sum buffer reduced + integer :: iam ! pe number + type(mct_string) :: mstring ! mct char type + character(len=128):: itemc ! string converted to char - !----- formats ----- - character(*),parameter :: subName = '(diag_avect) ' + !----- formats ----- + character(*),parameter :: subName = '(diag_avect) ' - !---------------------------------------------------------------- + !---------------------------------------------------------------- - npts = mct_aVect_lsize(AV) - kflds = mct_aVect_nRattr(AV) - allocate(sumbuf(kflds),sumbufg(kflds)) + npts = mct_aVect_lsize(AV) + kflds = mct_aVect_nRattr(AV) + allocate(sumbuf(kflds),sumbufg(kflds)) - sumbuf = 0.0 + sumbuf = 0.0 - do k = 1,kflds - do n = 1,npts - sumbuf(k) = sumbuf(k) + (AV%rAttr(k,n)) - enddo - enddo + do k = 1,kflds + do n = 1,npts + sumbuf(k) = sumbuf(k) + (AV%rAttr(k,n)) + enddo + enddo - call MPI_REDUCE(sumbuf,sumbufg,kflds,MPI_REAL8,MPI_SUM,0,mpicom,ierr) - call MPI_COMM_RANK(mpicom,iam,ierr) + call MPI_REDUCE(sumbuf,sumbufg,kflds,MPI_REAL8,MPI_SUM,0,mpicom,ierr) + call MPI_COMM_RANK(mpicom,iam,ierr) - if (iam == 0) then - do k = 1,kflds - call mct_aVect_getRList(mstring,k,AV) - itemc = mct_string_toChar(mstring) - call mct_string_clean(mstring) - write(iunit,101) trim(comment),k,sumbufg(k),trim(itemc) - enddo - call shr_sys_flush(iunit) - endif + if (iam == 0) then + do k = 1,kflds + call mct_aVect_getRList(mstring,k,AV) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + write(iunit,101) trim(comment),k,sumbufg(k),trim(itemc) + enddo + call shr_sys_flush(iunit) + endif - deallocate(sumbuf,sumbufg) + deallocate(sumbuf,sumbufg) -101 format('comm_diag ',a,1x,i3,es26.19,1x,a) +101 format('comm_diag ',a,1x,i3,es26.19,1x,a) - end subroutine diag_avect + end subroutine diag_avect -!====================================================================== + !====================================================================== end PROGRAM clmdrv From 69f431ed071a84ed7715143747671d2938749afc Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Tue, 27 Feb 2018 19:07:20 -0700 Subject: [PATCH 005/556] add stub component interface file. --- lilac/src/stub_comp_mct.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 lilac/src/stub_comp_mct.F90 diff --git a/lilac/src/stub_comp_mct.F90 b/lilac/src/stub_comp_mct.F90 new file mode 100644 index 0000000000..de792d6c58 --- /dev/null +++ b/lilac/src/stub_comp_mct.F90 @@ -0,0 +1,8 @@ +module stub_comp_mct + + implicit none + +contains + + +end module stub_comp_mct From 0a1b920bb676747be73bc20e263430efadc3a084 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 28 Feb 2018 13:56:12 -0700 Subject: [PATCH 006/556] rename clmdriver to lilac-demo-driver --- lilac/src/{clmdrv.F90 => lilac-demo-driver.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename lilac/src/{clmdrv.F90 => lilac-demo-driver.F90} (100%) diff --git a/lilac/src/clmdrv.F90 b/lilac/src/lilac-demo-driver.F90 similarity index 100% rename from lilac/src/clmdrv.F90 rename to lilac/src/lilac-demo-driver.F90 From 09d60de00a5a72136d3d615b13a4225ea634d3e1 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 28 Feb 2018 15:00:11 -0700 Subject: [PATCH 007/556] Start moving mct/component initialization code out of the driver and into a new lilac interface module. --- lilac/src/lilac-demo-driver.F90 | 161 +---------------- lilac/src/lilac.F90 | 299 ++++++++++++++++++++++++++++++++ 2 files changed, 305 insertions(+), 155 deletions(-) create mode 100644 lilac/src/lilac.F90 diff --git a/lilac/src/lilac-demo-driver.F90 b/lilac/src/lilac-demo-driver.F90 index 9d798b59ff..b06b6599f7 100644 --- a/lilac/src/lilac-demo-driver.F90 +++ b/lilac/src/lilac-demo-driver.F90 @@ -78,73 +78,11 @@ PROGRAM clmdrv !--- MPI/MCT --- !---------------------------------------------- - call MPI_Init(ierr) - call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_clmdrv, ierr) - call MPI_COMM_RANK(mpicom_clmdrv, mytask, ierr) - call MPI_COMM_SIZE(mpicom_clmdrv, ntasks, ierr) - - ncomps = 1 - ID_clmdrv = 1 - call mct_world_init(ncomps,MPI_COMM_WORLD,mpicom_clmdrv,ID_clmdrv) - - !---------------------------------------------- - !--- Log File and PIO --- - !---------------------------------------------- - - global_comm = MPI_COMM_WORLD - call shr_pio_init1(ncomps, 'pio_in', global_comm) - allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) - do n = 1,ncomps - comp_id(n) = ID_clmdrv - comp_name(n) = 'LND' - comp_iamin(n) = .true. - comp_comm(n) = mpicom_clmdrv - comp_comm_iam(n) = mytask - enddo - call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) - deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) - - write(string,'(a,i4.4)') 'clmdrv.log.',mytask - open(iunit, file=trim(string)) - write(iunit,*) subname,' STARTING' - call shr_sys_flush(iunit) - - write(iunit,*) subname,' ntasks = ',ntasks - write(iunit,*) subname,' mytask = ',mytask - write(iunit,*) subname,' mct ID = ',ID_clmdrv - call shr_sys_flush(iunit) - call shr_file_setLogUnit(sunit) - call shr_file_setLogLevel(1) - - !---------------------------------------------- - !--- Clocks --- - !---------------------------------------------- - - call ESMF_Initialize(rc=rc) - Calendar = ESMF_CalendarCreate( name='clmdrv_NOLEAP', & - calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - EClock = ESMF_ClockCreate(name='clmdrv_EClock', & - TimeStep=TimeStep, startTime=StartTime, & - RefTime=StartTime, stopTime=stopTime, rc=rc) - - EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop' , & - clock=EClock, ringTime=StopTime, rc=rc) - EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', & - clock=EClock, ringTime=StopTime, rc=rc) - - call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec - call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - !---------------------------------------------- - !--- Coupling --- - !---------------------------------------------- + lilac%Init() + ! FIXME(bja, 2018-02) don't want to use the cdata structure, but we still + ! need to provide this information to the component?! + !--- set mpicom and cdata memory cdata%name = 'cdata_clmdrv' cdata%ID = ID_clmdrv @@ -153,26 +91,6 @@ PROGRAM clmdrv cdata%gsmap => gsmap_lnd cdata%infodata => infodata - !--- coupling fields - seq_flds_dom_coord='lat:lon' - seq_flds_dom_other='area:aream:mask:frac' - seq_flds_dom_fields=trim(seq_flds_dom_coord)//':'//trim(seq_flds_dom_other) - - seq_flds_x2l_states= 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_pbot:Sg_icemask:Sg_icemask_coupled_fluxes' - seq_flds_x2l_fluxes= 'Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_lwdn:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Faxa_bcphidry:Faxa_bcphodry:Faxa_bcphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_ocphiwet:Faxa_dstwet1:Faxa_dstwet2:Faxa_dstwet3:Faxa_dstwet4:Faxa_dstdry1:Faxa_dstdry2:Faxa_dstdry3:Faxa_dstdry4:Flrr_flood:Flrr_volr' - seq_flds_x2l_fields= trim(seq_flds_x2l_states)//':'//trim(seq_flds_x2l_fluxes) - - seq_flds_l2x_states= 'Sl_avsdr:Sl_anidr:Sl_avsdf:Sl_anidf:Sl_tref:Sl_qref:Sl_t:Sl_fv:Sl_ram1:Sl_snowh:Sl_u10' - seq_flds_l2x_fluxes= 'Fall_swnet:Fall_taux:Fall_tauy:Fall_lat:Fall_sen:Fall_lwup:Fall_evap:Fall_flxdst1:Fall_flxdst2:Fall_flxdst3:Fall_flxdst4:Flrl_rofl:Flrl_rofi:Fall_voc001:Fall_voc002:Fall_voc003:Fall_voc004:Fall_voc005:Fall_voc006:Fall_voc007:Fall_voc008' - seq_flds_l2x_fields= trim(seq_flds_l2x_states)//':'//trim(seq_flds_l2x_fluxes) - - !--- set orbital params - orb_iyear = 1990 - call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & - orb_obliqr, orb_lambm0, orb_mvelpp, .true.) - call seq_infodata_putData(infodata, orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, & - orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr ) - !--- set case information case_name = 'clmdrv' case_desc = 'clmdrv with clm' @@ -197,63 +115,10 @@ PROGRAM clmdrv !--- lnd_init --- !---------------------------------------------- - write(iunit,*) subname,' calling lnd_init_mct' - call shr_sys_flush(iunit) - call lnd_init_mct(Eclock, cdata, x2l, l2x) - - call diag_avect(l2x,mpicom_clmdrv,'l2x_init') - - idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') - idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') - idx_Sa_v = mct_avect_indexra(x2l,'Sa_v') - idx_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') - idx_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') - idx_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') - idx_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') - idx_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') - idx_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') - idx_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') - idx_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') - idx_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') - idx_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') - idx_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') - idx_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') - idx_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') - !---------------------------------------------- !--- atm and atm/lnd coupling init --- !---------------------------------------------- - ! set atm grid size to land grid size in this example. for a real - ! atmosphere model, the atm and land grids should agree at the outset. - call seq_infodata_getData(infodata,lnd_nx=atm_nx,lnd_ny=atm_ny) - - ! atm decomp - gstart = ((mytask * atm_nx * atm_ny) / ntasks) + 1 - gend = (((mytask+1) * atm_nx * atm_ny) / ntasks) - lsize = gend - gstart + 1 - gsize = atm_nx * atm_ny - allocate(gindex(lsize)) - do n = gstart, gend - m = n-gstart+1 - gindex(m) = n - end do - write(iunit,'(1x,2a,5i8)') subname,' atm decomp = ',mytask,gsize,lsize,gstart,gend - - ! initialize land grid on atm decomp - call mct_gsMap_init(gsmap_atm, gindex, mpicom_clmdrv, ID_clmdrv, lsize, gsize) - deallocate(gindex) - - ! initialize rearrangers between atm and land decomps - call mct_rearr_init(gsmap_atm, gsmap_lnd, mpicom_clmdrv, rearr_atm2lnd) - call mct_rearr_init(gsmap_lnd, gsmap_atm, mpicom_clmdrv, rearr_lnd2atm) - - ! initialize atm avects from land avects with atm lsize - call mct_avect_init(x2l_a, x2l, lsize) - call mct_avect_zero(x2l_a) - call mct_avect_init(l2x_a, l2x, lsize) - call mct_avect_zero(l2x_a) - !---------------------------------------------- !--- Time Loop --- !---------------------------------------------- @@ -311,22 +176,8 @@ PROGRAM clmdrv ! call diag_avect(l2x_a,mpicom_clmdrv,'l2x_a') enddo - !---------------------------------------------- - !--- lnd_final --- - !---------------------------------------------- - - write(iunit,*) subname,' calling lnd_final_mct' - call shr_sys_flush(iunit) - call lnd_final_mct(Eclock, cdata, x2l, l2x) - - !---------------------------------------------- - !--- Done --- - !---------------------------------------------- - - write(iunit,*) subname,' DONE' - call shr_sys_flush(iunit) - call MPI_Finalize(ierr) - + lilac%Shutdown() + contains !====================================================================== diff --git a/lilac/src/lilac.F90 b/lilac/src/lilac.F90 new file mode 100644 index 0000000000..a3590c0ce0 --- /dev/null +++ b/lilac/src/lilac.F90 @@ -0,0 +1,299 @@ +module lilac + ! + ! Public interface to lilac + ! + + implicit none + private + + type, abstract :: lilac_t + private + contains + ! Public API + procedure :: Init => lilac_init + procedure :: Shutdown => lilac_shutdown + procudure :: AdvanceTime => lilac_advance_time + + ! private initialization routines + procedure, private :: lilac_init_parallel + procedure, private :: lilac_init_logging + procedure, private :: lilac_init_io + procedure, private :: lilac_init_clocks + procedure, private :: lilac_init_fields + procedure, private :: lilac_init_orbit + procedure, private :: lilac_init_land + procedure, private :: lilac_init_coupling + + ! private shudown routines + procedure, private :: lilac_shutdown_land + procedure, private :: lilac_shutdown_parallel + + end type lilac_t + + + +contains + + ! + ! Public API + ! + subroutine lilac_init(this) + + use mct_mod, only : mct_world_init + + implicit none + + class(lilac_t), intent(inout) :: this + + call lilac_init_parallel() + + end subroutine lilac_init + + subroutine lilac_advance_time(this) + + implicit none + + class(lilac_t), intent(inout) :: this + + end subroutine lilac_advance_time + + subroutine lilac_shutdown(this) + + implicit none + + class(lilac_t), intent(inout) :: this + + ! FIXME(bja, 2018-02) master proc only! + write(this%iunit, *) 'lilac shutting down...' + call shr_sys_flush(this%iunit) + + call lilac_shutdown_land() + call lilac_shutdown_parallel() + + ! FIXME(bja, 2018-02) master proc only! + write(this%iunit, *) 'lilac shut down complete.' + + end subroutine lilac_shutdown + + ! + ! Private work functions + ! + subroutine lilac_init_parallel(this) + ! Initialize parallel components, e.g. MPI, MCT + + implicit none + + class(lilac_t), intent(inout) :: this + + call MPI_Init(ierr) + call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_comp, ierr) + call MPI_COMM_RANK(mpicom_comp, mytask, ierr) + call MPI_COMM_SIZE(mpicom_comp, ntasks, ierr) + + num_comps = 1 + ID_comp = 1 + call mct_world_init(num_comps, MPI_COMM_WORLD, mpicom_clmdrv, ID_comp) + + end subroutine lilac_init_parallel + + subroutine lilac_init_logging(this) + + implicit none + + class(lilac_t), intent(inout) :: this + + write(string,'(a,i4.4)') 'lilac.log.',mytask + open(iunit, file=trim(string)) + write(iunit,*) subname,' STARTING' + call shr_sys_flush(iunit) + + write(iunit,*) subname, ' ntasks = ', ntasks + write(iunit,*) subname, ' mytask = ', mytask + write(iunit,*) subname, ' mct ID = ', ID_comp + call shr_sys_flush(iunit) + call shr_file_setLogUnit(sunit) + call shr_file_setLogLevel(1) + + end subroutine lilac_init_logging + + subroutine lilac_init_io(this) + + implicit none + + class(lilac_t), intent(inout) :: this + + global_comm = MPI_COMM_WORLD + call shr_pio_init1(ncomps, 'pio_in', global_comm) + allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) + do n = 1,ncomps + comp_id(n) = ID_clmdrv + comp_name(n) = 'LND' + comp_iamin(n) = .true. + comp_comm(n) = mpicom_clmdrv + comp_comm_iam(n) = mytask + enddo + call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) + deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) + + end subroutine lilac_init_io + + subroutine lilac_init_clocks(this) + + implicit none + + class(lilac_t), intent(inout) :: this + + call ESMF_Initialize(rc=rc) + Calendar = ESMF_CalendarCreate( name='clmdrv_NOLEAP', & + calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + EClock = ESMF_ClockCreate(name='clmdrv_EClock', & + TimeStep=TimeStep, startTime=StartTime, & + RefTime=StartTime, stopTime=stopTime, rc=rc) + + EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop' , & + clock=EClock, ringTime=StopTime, rc=rc) + EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', & + clock=EClock, ringTime=StopTime, rc=rc) + + call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec + call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + end subroutine lilac_init_clocks + + subroutine lilac_init_fields(this) + ! Set coupling fields. + + implicit none + + class(lilac_t), intent(inout) :: this + + ! FIXME(bja, 2018-02) this should be dynamically created at runtime + ! instead of hard coded! + + seq_flds_dom_coord='lat:lon' + seq_flds_dom_other='area:aream:mask:frac' + seq_flds_dom_fields=trim(seq_flds_dom_coord)//':'//trim(seq_flds_dom_other) + + seq_flds_x2l_states= 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_pbot:Sg_icemask:Sg_icemask_coupled_fluxes' + seq_flds_x2l_fluxes= 'Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_lwdn:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Faxa_bcphidry:Faxa_bcphodry:Faxa_bcphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_ocphiwet:Faxa_dstwet1:Faxa_dstwet2:Faxa_dstwet3:Faxa_dstwet4:Faxa_dstdry1:Faxa_dstdry2:Faxa_dstdry3:Faxa_dstdry4:Flrr_flood:Flrr_volr' + seq_flds_x2l_fields= trim(seq_flds_x2l_states)//':'//trim(seq_flds_x2l_fluxes) + + seq_flds_l2x_states= 'Sl_avsdr:Sl_anidr:Sl_avsdf:Sl_anidf:Sl_tref:Sl_qref:Sl_t:Sl_fv:Sl_ram1:Sl_snowh:Sl_u10' + seq_flds_l2x_fluxes= 'Fall_swnet:Fall_taux:Fall_tauy:Fall_lat:Fall_sen:Fall_lwup:Fall_evap:Fall_flxdst1:Fall_flxdst2:Fall_flxdst3:Fall_flxdst4:Flrl_rofl:Flrl_rofi:Fall_voc001:Fall_voc002:Fall_voc003:Fall_voc004:Fall_voc005:Fall_voc006:Fall_voc007:Fall_voc008' + seq_flds_l2x_fields= trim(seq_flds_l2x_states)//':'//trim(seq_flds_l2x_fluxes) + + + end subroutine lilac_init_fields + + subroutine lilac_init_orbit(this) + + implicit none + + class(lilac_t), intent(inout) :: this + + !--- set orbital params + orb_iyear = 1990 + call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & + orb_obliqr, orb_lambm0, orb_mvelpp, .true.) + call seq_infodata_putData(infodata, orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, & + orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr ) + + + end subroutine lilac_init_orbit + + subroutine lilac_init_land(this) + + implicit none + + write(iunit,*) subname,' calling lnd_init_mct' + call shr_sys_flush(iunit) + call lnd_init_mct(Eclock, cdata, x2l, l2x) + + call diag_avect(l2x,mpicom_clmdrv,'l2x_init') + + idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') + idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') + idx_Sa_v = mct_avect_indexra(x2l,'Sa_v') + idx_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') + idx_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') + idx_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') + idx_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') + idx_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') + idx_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') + idx_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') + idx_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') + idx_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') + idx_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') + idx_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') + idx_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') + idx_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') + + end subroutine lilac_init_land + + subroutine lilac_init_coupling(this) + + implicit none + + class(lilac_t), intent(inout) :: this + + ! set atm grid size to land grid size in this example. for a real + ! atmosphere model, the atm and land grids should agree at the outset. + call seq_infodata_getData(infodata,lnd_nx=atm_nx,lnd_ny=atm_ny) + + ! atm decomp + gstart = ((mytask * atm_nx * atm_ny) / ntasks) + 1 + gend = (((mytask+1) * atm_nx * atm_ny) / ntasks) + lsize = gend - gstart + 1 + gsize = atm_nx * atm_ny + allocate(gindex(lsize)) + do n = gstart, gend + m = n-gstart+1 + gindex(m) = n + end do + write(iunit,'(1x,2a,5i8)') subname,' atm decomp = ',mytask,gsize,lsize,gstart,gend + + ! initialize land grid on atm decomp + call mct_gsMap_init(gsmap_atm, gindex, mpicom_clmdrv, ID_clmdrv, lsize, gsize) + deallocate(gindex) + + ! initialize rearrangers between atm and land decomps + call mct_rearr_init(gsmap_atm, gsmap_lnd, mpicom_clmdrv, rearr_atm2lnd) + call mct_rearr_init(gsmap_lnd, gsmap_atm, mpicom_clmdrv, rearr_lnd2atm) + + ! initialize atm avects from land avects with atm lsize + call mct_avect_init(x2l_a, x2l, lsize) + call mct_avect_zero(x2l_a) + call mct_avect_init(l2x_a, l2x, lsize) + call mct_avect_zero(l2x_a) + + end subroutine lilac_init_coupling + + subroutine lilac_shutdown_land(this) + + implicit none + + class(lilac_t), intent(inout) :: this + + write(iunit, *) 'lilac shutting down component ', this%comp_name + call lnd_final_mct(Eclock, cdata, x2l, l2x) + + end subroutine lilac_shutdown_land + + subroutine lilac_shutdown_parallel(this) + + implicit none + + class(lilac_t), intent(inout) :: this + + ! FIXME(bja, 2018-02) need to determine if it is our responsibility to shutdown mpi or the caller!? + ! call MPI_Finalize(ierr) + + end subroutine lilac_shutdown_parallel + +end module lilac From 0282ec49736334f4061ee996d7a9ca8acd8310c5 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 1 Mar 2018 14:30:39 -0700 Subject: [PATCH 008/556] Add spaces between items in comman separated lists. Rename clmdrv to lilac. --- lilac/src/lilac-demo-driver.F90 | 5 ++-- lilac/src/lilac.F90 | 48 +++++++++++++++++++-------------- 2 files changed, 31 insertions(+), 22 deletions(-) diff --git a/lilac/src/lilac-demo-driver.F90 b/lilac/src/lilac-demo-driver.F90 index b06b6599f7..3857271be7 100644 --- a/lilac/src/lilac-demo-driver.F90 +++ b/lilac/src/lilac-demo-driver.F90 @@ -73,6 +73,7 @@ PROGRAM clmdrv character(len=*),parameter :: subname = 'clmdrv' !---------------------------------------------- + class(lilac_t) :: lilac !---------------------------------------------- !--- MPI/MCT --- @@ -82,7 +83,7 @@ PROGRAM clmdrv ! FIXME(bja, 2018-02) don't want to use the cdata structure, but we still ! need to provide this information to the component?! - + !--- set mpicom and cdata memory cdata%name = 'cdata_clmdrv' cdata%ID = ID_clmdrv @@ -177,7 +178,7 @@ PROGRAM clmdrv enddo lilac%Shutdown() - + contains !====================================================================== diff --git a/lilac/src/lilac.F90 b/lilac/src/lilac.F90 index a3590c0ce0..c4671e8570 100644 --- a/lilac/src/lilac.F90 +++ b/lilac/src/lilac.F90 @@ -45,7 +45,7 @@ subroutine lilac_init(this) class(lilac_t), intent(inout) :: this - call lilac_init_parallel() + call this%lilac_init_parallel() end subroutine lilac_init @@ -67,8 +67,8 @@ subroutine lilac_shutdown(this) write(this%iunit, *) 'lilac shutting down...' call shr_sys_flush(this%iunit) - call lilac_shutdown_land() - call lilac_shutdown_parallel() + call this%lilac_shutdown_land() + call this%lilac_shutdown_parallel() ! FIXME(bja, 2018-02) master proc only! write(this%iunit, *) 'lilac shut down complete.' @@ -92,7 +92,7 @@ subroutine lilac_init_parallel(this) num_comps = 1 ID_comp = 1 - call mct_world_init(num_comps, MPI_COMM_WORLD, mpicom_clmdrv, ID_comp) + call mct_world_init(num_comps, MPI_COMM_WORLD, mpicom_lilac, ID_comp) end subroutine lilac_init_parallel @@ -102,7 +102,7 @@ subroutine lilac_init_logging(this) class(lilac_t), intent(inout) :: this - write(string,'(a,i4.4)') 'lilac.log.',mytask + write(string,'(a,i4.4)') 'lilac.log.', mytask open(iunit, file=trim(string)) write(iunit,*) subname,' STARTING' call shr_sys_flush(iunit) @@ -124,32 +124,40 @@ subroutine lilac_init_io(this) global_comm = MPI_COMM_WORLD call shr_pio_init1(ncomps, 'pio_in', global_comm) - allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) - do n = 1,ncomps - comp_id(n) = ID_clmdrv + allocate(comp_id(ncomps), comp_name(ncomps), comp_iamin(ncomps), comp_comm(ncomps), comp_comm_iam(ncomps)) + do n = 1, ncomps + comp_id(n) = ID_lilac comp_name(n) = 'LND' comp_iamin(n) = .true. - comp_comm(n) = mpicom_clmdrv + comp_comm(n) = mpicom_lilac comp_comm_iam(n) = mytask enddo call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) - deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) + deallocate(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) end subroutine lilac_init_io subroutine lilac_init_clocks(this) + use ESMF + implicit none class(lilac_t), intent(inout) :: this + type(ESMF_Clock) :: EClock ! Input synchronization clock + type(ESMF_Time) :: CurrTime, StartTime, StopTime + type(ESMF_TimeInterval) :: TimeStep + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar), target :: Calendar + call ESMF_Initialize(rc=rc) - Calendar = ESMF_CalendarCreate( name='clmdrv_NOLEAP', & + Calendar = ESMF_CalendarCreate( name='lilac_NOLEAP', & calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - EClock = ESMF_ClockCreate(name='clmdrv_EClock', & + EClock = ESMF_ClockCreate(name='lilac_EClock', & TimeStep=TimeStep, startTime=StartTime, & RefTime=StartTime, stopTime=stopTime, rc=rc) @@ -159,9 +167,9 @@ subroutine lilac_init_clocks(this) clock=EClock, ringTime=StopTime, rc=rc) call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec + write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=', yy, mm, dd, sec call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec + write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=', yy, mm, dd, sec call shr_sys_flush(iunit) end subroutine lilac_init_clocks @@ -215,7 +223,7 @@ subroutine lilac_init_land(this) call shr_sys_flush(iunit) call lnd_init_mct(Eclock, cdata, x2l, l2x) - call diag_avect(l2x,mpicom_clmdrv,'l2x_init') + call diag_avect(l2x, mpicom_lilac,'l2x_init') idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') @@ -244,7 +252,7 @@ subroutine lilac_init_coupling(this) ! set atm grid size to land grid size in this example. for a real ! atmosphere model, the atm and land grids should agree at the outset. - call seq_infodata_getData(infodata,lnd_nx=atm_nx,lnd_ny=atm_ny) + call seq_infodata_getData(infodata, lnd_nx=atm_nx, lnd_ny=atm_ny) ! atm decomp gstart = ((mytask * atm_nx * atm_ny) / ntasks) + 1 @@ -256,15 +264,15 @@ subroutine lilac_init_coupling(this) m = n-gstart+1 gindex(m) = n end do - write(iunit,'(1x,2a,5i8)') subname,' atm decomp = ',mytask,gsize,lsize,gstart,gend + write(iunit,'(1x,2a,5i8)') subname,' atm decomp = ', mytask, gsize, lsize, gstart, gend ! initialize land grid on atm decomp - call mct_gsMap_init(gsmap_atm, gindex, mpicom_clmdrv, ID_clmdrv, lsize, gsize) + call mct_gsMap_init(gsmap_atm, gindex, mpicom_lilac, ID_lilac, lsize, gsize) deallocate(gindex) ! initialize rearrangers between atm and land decomps - call mct_rearr_init(gsmap_atm, gsmap_lnd, mpicom_clmdrv, rearr_atm2lnd) - call mct_rearr_init(gsmap_lnd, gsmap_atm, mpicom_clmdrv, rearr_lnd2atm) + call mct_rearr_init(gsmap_atm, gsmap_lnd, mpicom_lilac, rearr_atm2lnd) + call mct_rearr_init(gsmap_lnd, gsmap_atm, mpicom_lilac, rearr_lnd2atm) ! initialize atm avects from land avects with atm lsize call mct_avect_init(x2l_a, x2l, lsize) From a0e9edf6bbc51cfe2d306af4a9496afa83ed741e Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 1 Mar 2018 14:48:06 -0700 Subject: [PATCH 009/556] Rename clmdrv and whitespace in driver. --- lilac/src/lilac-demo-driver.F90 | 93 ++++++++++++++++----------------- 1 file changed, 46 insertions(+), 47 deletions(-) diff --git a/lilac/src/lilac-demo-driver.F90 b/lilac/src/lilac-demo-driver.F90 index 3857271be7..0694e387a1 100644 --- a/lilac/src/lilac-demo-driver.F90 +++ b/lilac/src/lilac-demo-driver.F90 @@ -1,4 +1,4 @@ -PROGRAM clmdrv +program lilac_demo_driver use lnd_comp_mct , only: lnd_init_mct, lnd_run_mct, lnd_final_mct use seq_flds_mod , only: & @@ -9,7 +9,6 @@ PROGRAM clmdrv use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata use shr_sys_mod , only: shr_sys_flush, shr_sys_abort use shr_orb_mod , only: shr_orb_params - use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 use mct_mod use ESMF @@ -23,26 +22,26 @@ PROGRAM clmdrv type(ESMF_Time) :: CurrTime, StartTime, StopTime type(ESMF_TimeInterval) :: TimeStep type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar),target :: Calendar - integer :: yy,mm,dd,sec + type(ESMF_Calendar), target :: Calendar + integer :: yy, mm, dd, sec !----- MPI/MCT ----- - integer :: mpicom_clmdrv ! local mpicom - integer :: ID_clmdrv ! mct ID + integer :: mpicom_lilac ! local mpicom + integer :: ID_lilac ! mct ID integer :: ncomps ! number of separate components for MCT - integer :: ntasks,mytask ! mpicom size and rank + integer :: ntasks, mytask ! mpicom size and rank integer :: global_comm ! copy of mpi_comm_world for pio - integer,allocatable :: comp_id(:) ! for pio init2 - logical,allocatable :: comp_iamin(:) ! for pio init2 - character(len=64),allocatable :: comp_name(:) ! for pio init2 - integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 + integer, allocatable :: comp_id(:) ! for pio init2 + logical, allocatable :: comp_iamin(:) ! for pio init2 + character(len=64), allocatable :: comp_name(:) ! for pio init2 + integer, allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 !----- Land Coupling Data ----- type(seq_cdata) :: cdata ! Input land-model driver data - type(seq_infodata_type),target :: infodata ! infodata type + type(seq_infodata_type), target :: infodata ! infodata type type(mct_aVect) :: x2l, l2x ! land model import and export states - type(mct_gGrid),target :: dom_lnd ! domain data for clm - type(mct_gsMap),target :: gsmap_lnd ! gsmap data for clm + type(mct_gGrid), target :: dom_lnd ! domain data for clm + type(mct_gsMap), target :: gsmap_lnd ! gsmap data for clm integer :: orb_iyear ! Orbital real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp character(len=128) :: case_name, case_desc, model_version, hostname, username @@ -65,12 +64,12 @@ PROGRAM clmdrv type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm !----- Other ----- - integer :: n,m ! counter + integer :: n, m ! counter character(len=128) :: string ! temporary string integer :: ierr, rc ! local error status - integer :: iunit = 250 ! clmdrv log unit number + integer :: iunit = 250 ! lilac log unit number integer :: sunit = 249 ! share log unit number - character(len=*),parameter :: subname = 'clmdrv' + character(len=*), parameter :: subname = 'lilac_demo_driver' !---------------------------------------------- class(lilac_t) :: lilac @@ -85,17 +84,17 @@ PROGRAM clmdrv ! need to provide this information to the component?! !--- set mpicom and cdata memory - cdata%name = 'cdata_clmdrv' - cdata%ID = ID_clmdrv - cdata%mpicom = mpicom_clmdrv + cdata%name = 'cdata_lilac' + cdata%ID = ID_lilac + cdata%mpicom = mpicom_lilac cdata%dom => dom_lnd cdata%gsmap => gsmap_lnd cdata%infodata => infodata !--- set case information - case_name = 'clmdrv' - case_desc = 'clmdrv with clm' - model_version = 'clmdrv0.1' + case_name = 'lilac' + case_desc = 'lilac with clm' + model_version = 'lilac0.1' hostname = 'undefined' username = 'undefined' start_type = 'startup' @@ -129,12 +128,12 @@ PROGRAM clmdrv call ESMF_ClockAdvance(EClock, rc=rc) call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' clmdrv ymds=',yy,mm,dd,sec + write(iunit,'(1x,2a,4i6)') subname,' lilac ymds=', yy, mm, dd, sec call shr_sys_flush(iunit) ! can manually override the alarms as needed call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) - if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) + if (mod(dd, 5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest, rc) ! set the coupling data that is sent to the land model, this is on atm decomp ! this is just sample test data @@ -160,21 +159,21 @@ PROGRAM clmdrv call mct_rearr_rearrange(x2l_a, x2l, rearr_atm2lnd) ! diagnose - write(iunit,*) subname,' x2l fields: ',yy,mm,dd,sec - ! call diag_avect(x2l_a,mpicom_clmdrv,'x2l_a') - call diag_avect(x2l,mpicom_clmdrv,'x2l') + write(iunit,*) subname,' x2l fields: ', yy, mm, dd, sec + ! call diag_avect(x2l_a, mpicom_lilac,'x2l_a') + call diag_avect(x2l, mpicom_lilac,'x2l') ! run clm - write(iunit,*) subname,' call lnd_run_mct',yy,mm,dd,sec + write(iunit,*) subname,' call lnd_run_mct', yy, mm, dd, sec call lnd_run_mct(Eclock, cdata, x2l, l2x) ! rearrange data from land decomposition call mct_rearr_rearrange(l2x, l2x_a, rearr_lnd2atm) ! diagnose - write(iunit,*) subname,' l2x fields: ',yy,mm,dd,sec - call diag_avect(l2x,mpicom_clmdrv,'l2x') - ! call diag_avect(l2x_a,mpicom_clmdrv,'l2x_a') + write(iunit,*) subname,' l2x fields: ', yy, mm, dd, sec + call diag_avect(l2x, mpicom_lilac,'l2x') + ! call diag_avect(l2x_a, mpicom_lilac,'l2x_a') enddo lilac%Shutdown() @@ -195,8 +194,8 @@ SUBROUTINE diag_avect(av, mpicom, comment) character(len=*), intent(in) :: comment !--- local --- - integer :: n,k ! counters - integer :: npts,nptsg ! number of local/global pts in AV + integer :: n, k ! counters + integer :: npts, nptsg ! number of local/global pts in AV integer :: kflds ! number of fields in AV real*8, pointer :: sumbuf (:) ! sum buffer real*8, pointer :: sumbufg(:) ! sum buffer reduced @@ -205,41 +204,41 @@ SUBROUTINE diag_avect(av, mpicom, comment) character(len=128):: itemc ! string converted to char !----- formats ----- - character(*),parameter :: subName = '(diag_avect) ' + character(*), parameter :: subName = '(diag_avect) ' !---------------------------------------------------------------- npts = mct_aVect_lsize(AV) kflds = mct_aVect_nRattr(AV) - allocate(sumbuf(kflds),sumbufg(kflds)) + allocate(sumbuf(kflds), sumbufg(kflds)) sumbuf = 0.0 - do k = 1,kflds - do n = 1,npts - sumbuf(k) = sumbuf(k) + (AV%rAttr(k,n)) + do k = 1, kflds + do n = 1, npts + sumbuf(k) = sumbuf(k) + (AV%rAttr(k, n)) enddo enddo - call MPI_REDUCE(sumbuf,sumbufg,kflds,MPI_REAL8,MPI_SUM,0,mpicom,ierr) - call MPI_COMM_RANK(mpicom,iam,ierr) + call MPI_REDUCE(sumbuf, sumbufg, kflds, MPI_REAL8, MPI_SUM, 0, mpicom, ierr) + call MPI_COMM_RANK(mpicom, iam, ierr) if (iam == 0) then - do k = 1,kflds - call mct_aVect_getRList(mstring,k,AV) + do k = 1, kflds + call mct_aVect_getRList(mstring, k, AV) itemc = mct_string_toChar(mstring) call mct_string_clean(mstring) - write(iunit,101) trim(comment),k,sumbufg(k),trim(itemc) + write(iunit, 101) trim(comment), k, sumbufg(k), trim(itemc) enddo call shr_sys_flush(iunit) endif - deallocate(sumbuf,sumbufg) + deallocate(sumbuf, sumbufg) -101 format('comm_diag ',a,1x,i3,es26.19,1x,a) +101 format('comm_diag ', a, 1x, i3, es26.19, 1x, a) end subroutine diag_avect !====================================================================== -end PROGRAM clmdrv +end program lilac_demo_driver From f42c1566e5092b2b3fb0adefa655c88d65aef21a Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 1 Mar 2018 15:12:21 -0700 Subject: [PATCH 010/556] start on lilac init data. --- lilac/src/lilac-demo-driver.F90 | 18 +++++++++++++----- lilac/src/lilac.F90 | 22 ++++++++++++++++------ 2 files changed, 29 insertions(+), 11 deletions(-) diff --git a/lilac/src/lilac-demo-driver.F90 b/lilac/src/lilac-demo-driver.F90 index 0694e387a1..1d82475511 100644 --- a/lilac/src/lilac-demo-driver.F90 +++ b/lilac/src/lilac-demo-driver.F90 @@ -72,13 +72,21 @@ program lilac_demo_driver character(len=*), parameter :: subname = 'lilac_demo_driver' !---------------------------------------------- + type(lilac_init_data_t) :: lilac_init_data class(lilac_t) :: lilac - !---------------------------------------------- - !--- MPI/MCT --- - !---------------------------------------------- + ! + ! Initialize lilac + ! + + ! Where should these come from in general? namelist? + call MPI_Comm_Dup(MPI_COMM_WORLD, lilac_init_data%mpicom_lilac, ierr) + call MPI_Comm_Dup(MPI_COMM_WORLD, lilac_init_data%mpicom_component, ierr) + lilac_init_data%output_unit_lilac = 250 + lilac_init_data%output_unit_component = 249 + - lilac%Init() + lilac%Init(lilac_init_data) ! FIXME(bja, 2018-02) don't want to use the cdata structure, but we still ! need to provide this information to the component?! @@ -94,7 +102,7 @@ program lilac_demo_driver !--- set case information case_name = 'lilac' case_desc = 'lilac with clm' - model_version = 'lilac0.1' + model_version = 'lilac-v0.1' hostname = 'undefined' username = 'undefined' start_type = 'startup' diff --git a/lilac/src/lilac.F90 b/lilac/src/lilac.F90 index c4671e8570..f1fc35e951 100644 --- a/lilac/src/lilac.F90 +++ b/lilac/src/lilac.F90 @@ -6,7 +6,15 @@ module lilac implicit none private - type, abstract :: lilac_t + type :: lilac_init_data_t + integer :: mpicom_lilac + integer :: mpicom_component + integer :: output_unit_lilac ! for lilac and 'shr' output + integer :: output_unit_component + + end type lilac_init_data_t + + type :: lilac_t private contains ! Public API @@ -85,7 +93,9 @@ subroutine lilac_init_parallel(this) class(lilac_t), intent(inout) :: this + ! should be safe if previously initialized call MPI_Init(ierr) + ! Don't really want to dup comp_world, should be call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_comp, ierr) call MPI_COMM_RANK(mpicom_comp, mytask, ierr) call MPI_COMM_SIZE(mpicom_comp, ntasks, ierr) @@ -145,11 +155,11 @@ subroutine lilac_init_clocks(this) class(lilac_t), intent(inout) :: this - type(ESMF_Clock) :: EClock ! Input synchronization clock - type(ESMF_Time) :: CurrTime, StartTime, StopTime - type(ESMF_TimeInterval) :: TimeStep - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar), target :: Calendar + type(ESMF_Clock) :: EClock ! Input synchronization clock + type(ESMF_Time) :: CurrTime, StartTime, StopTime + type(ESMF_TimeInterval) :: TimeStep + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar), target :: Calendar call ESMF_Initialize(rc=rc) Calendar = ESMF_CalendarCreate( name='lilac_NOLEAP', & From 092b1a8c2fff8354ede815819edd8931685ada2f Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 1 Mar 2018 17:30:42 -0700 Subject: [PATCH 011/556] More refactoring of clocks, input units, mpi vars in lilac and driver initialization. --- lilac/src/lilac-demo-driver.F90 | 55 +++++++++--- lilac/src/lilac.F90 | 146 +++++++++++++++++++++----------- 2 files changed, 140 insertions(+), 61 deletions(-) diff --git a/lilac/src/lilac-demo-driver.F90 b/lilac/src/lilac-demo-driver.F90 index 1d82475511..39f28dac73 100644 --- a/lilac/src/lilac-demo-driver.F90 +++ b/lilac/src/lilac-demo-driver.F90 @@ -18,7 +18,7 @@ program lilac_demo_driver #include ! mpi library include file !----- Clocks ----- - type(ESMF_Clock) :: EClock ! Input synchronization clock + type(ESMF_Clock) :: driver_clock type(ESMF_Time) :: CurrTime, StartTime, StopTime type(ESMF_TimeInterval) :: TimeStep type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest @@ -71,22 +71,42 @@ program lilac_demo_driver integer :: sunit = 249 ! share log unit number character(len=*), parameter :: subname = 'lilac_demo_driver' + logical :: debug = true !---------------------------------------------- type(lilac_init_data_t) :: lilac_init_data + type(lilac_clock_data_t) :: lilac_clock_data class(lilac_t) :: lilac + ! + ! Initialize the driver + ! + + call setup_demo_driver_clock(driver_clock) + ! ! Initialize lilac ! - ! Where should these come from in general? namelist? + ! Hard code values normally supplied by the driver call MPI_Comm_Dup(MPI_COMM_WORLD, lilac_init_data%mpicom_lilac, ierr) call MPI_Comm_Dup(MPI_COMM_WORLD, lilac_init_data%mpicom_component, ierr) - lilac_init_data%output_unit_lilac = 250 - lilac_init_data%output_unit_component = 249 - - - lilac%Init(lilac_init_data) + lilac_init_data%output_unit_global_shared = 250 + lilac_init_data%output_unit_lilac = 251 + lilac_init_data%output_unit_component = 252 + + ! FIXME(bja, 2018-02) use namelist so the demo driver can serve as a test driver + lilac_clock_data%calendar_is_leap = .false. + lilac_clock_data%start_year = 2000 + lilac_clock_data%start_month = 1 + lilac_clock_data%start_day = 1 + lilac_clock_data%start_seconds = 0 + lilac_clock_data%stop_year = 2000 + lilac_clock_data%stop_month = 1 + lilac_clock_data%stop_day = 5 + lilac_clock_data%stop_seconds = 0 + lilac_clock_data%timestep_seconds = 3600 + + call lilac%Init(lilac_init_data, lilac_clock_data, debug) ! FIXME(bja, 2018-02) don't want to use the cdata structure, but we still ! need to provide this information to the component?! @@ -131,12 +151,12 @@ program lilac_demo_driver !--- Time Loop --- !---------------------------------------------- - call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) - do while (CurrTime < StopTime) - call ESMF_ClockAdvance(EClock, rc=rc) - call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) - call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' lilac ymds=', yy, mm, dd, sec + call ESMF_ClockGet(driver_clock, currTime=driver_current_time, rc=rc) + do while (driver_current_time < driver_stop_time) + call ESMF_ClockAdvance(driver_clock, rc=rc) + call ESMF_ClockGet(driver_clock, currTime=driver_current_time, rc=rc) + call ESMF_TimeGet(driver_current_time, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,'lilac demo driver ymds=', yy, mm, dd, sec call shr_sys_flush(iunit) ! can manually override the alarms as needed @@ -248,5 +268,14 @@ SUBROUTINE diag_avect(av, mpicom, comment) end subroutine diag_avect !====================================================================== + + subroutine setup_demo_driver_clocks() + + implicit none + + + + end subroutine setup_demo_driver_clocks + end program lilac_demo_driver diff --git a/lilac/src/lilac.F90 b/lilac/src/lilac.F90 index f1fc35e951..f3fd3e22a7 100644 --- a/lilac/src/lilac.F90 +++ b/lilac/src/lilac.F90 @@ -6,16 +6,38 @@ module lilac implicit none private + integer, parameter :: lilac_master_proc = 0 + + type :: lilac_clock_data_t + logical :: calendar_is_leap + integer :: start_year + integer :: start_month + integer :: start_day + integer :: start_second ! seconds since midnight + + integer :: stop_year + integer :: stop_month + integer :: stop_day + integer :: stop_second ! seconds since midnight + + integer :: time_step_seconds + end type lilac_clock_data_t + type :: lilac_init_data_t integer :: mpicom_lilac integer :: mpicom_component - integer :: output_unit_lilac ! for lilac and 'shr' output + integer :: output_unit_lilac + integer :: output_unit_global_shared ! this should be the same for all instances of lilac! integer :: output_unit_component end type lilac_init_data_t type :: lilac_t private + type(ESMF_Clock) :: driver_clock + integer :: my_mpi_rank + integer :: num_mpi_tasks + integer :: mct_comp_id contains ! Public API procedure :: Init => lilac_init @@ -45,15 +67,20 @@ module lilac ! ! Public API ! - subroutine lilac_init(this) + subroutine lilac_init(this, init_data, clock_data, debug) use mct_mod, only : mct_world_init implicit none class(lilac_t), intent(inout) :: this + type(lilac_init_data_t), intent(in) :: init_data + type(lilac_clock_data_t), intent(in) :: clock_data - call this%lilac_init_parallel() + logical, intent(in) :: debug + + call this%lilac_init_parallel(init_data%mpicom_lilac, init_data%mpicom_component) + call this%lilac_init_logging(init_data%output_unit_lilac, init_data%output_unit_component) end subroutine lilac_init @@ -72,21 +99,21 @@ subroutine lilac_shutdown(this) class(lilac_t), intent(inout) :: this ! FIXME(bja, 2018-02) master proc only! - write(this%iunit, *) 'lilac shutting down...' - call shr_sys_flush(this%iunit) + write(this%output_unit, *) 'lilac shutting down...' + call shr_sys_flush(this%output_unit) call this%lilac_shutdown_land() call this%lilac_shutdown_parallel() ! FIXME(bja, 2018-02) master proc only! - write(this%iunit, *) 'lilac shut down complete.' + write(this%output_unit, *) 'lilac shut down complete.' end subroutine lilac_shutdown ! ! Private work functions ! - subroutine lilac_init_parallel(this) + subroutine lilac_init_parallel(this, mpicom_lilac, mpicom_component, mpicom_global_shared) ! Initialize parallel components, e.g. MPI, MCT implicit none @@ -95,33 +122,40 @@ subroutine lilac_init_parallel(this) ! should be safe if previously initialized call MPI_Init(ierr) - ! Don't really want to dup comp_world, should be - call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_comp, ierr) - call MPI_COMM_RANK(mpicom_comp, mytask, ierr) - call MPI_COMM_SIZE(mpicom_comp, ntasks, ierr) - num_comps = 1 - ID_comp = 1 + call MPI_COMM_RANK(mpicom_lilac, this%my_mpi_rank, ierr) + call MPI_COMM_SIZE(mpicom_lilac, this%num_mpi_tasks, ierr) + + this%mct_num_comps = 1 + this%mct_comp_id = 1 + ! NOTE(bja, 2018-02) this should eventually be initialized on the union of + ! the lilac and component communicators! call mct_world_init(num_comps, MPI_COMM_WORLD, mpicom_lilac, ID_comp) end subroutine lilac_init_parallel - subroutine lilac_init_logging(this) + subroutine lilac_init_logging(this, output_unit_lilac, output_unit_global_shared) implicit none class(lilac_t), intent(inout) :: this - write(string,'(a,i4.4)') 'lilac.log.', mytask - open(iunit, file=trim(string)) - write(iunit,*) subname,' STARTING' - call shr_sys_flush(iunit) + ! open logfile for lilac + + this%output_unit = output_unit_lilac - write(iunit,*) subname, ' ntasks = ', ntasks - write(iunit,*) subname, ' mytask = ', mytask - write(iunit,*) subname, ' mct ID = ', ID_comp - call shr_sys_flush(iunit) - call shr_file_setLogUnit(sunit) + write(log_file_name,'(a,i4.4)') 'lilac.log.', this%my_mpi_rank + open(this%output_unit, file=trim(log_file_name)) + if (this%my_mpi_rank == lilac_master_proc) then + write(this%output_unit, *) subname,' starting lilac' + write(this%output_unit, *) subname, ' num lilac tasks = ', this%num_mpi_tasks + write(this%output_unit, *) subname, ' my_mpi_rank = ', this%my_mpi_rank + write(this%output_unit, *) subname, ' mct component ID = ', this%mct_comp_id + call shr_sys_flush(this%output_unit) + end if + + ! NOTE(bja, 2018-02) these are setting global variables! + call shr_file_setLogUnit(mpicom_global_shared) call shr_file_setLogLevel(1) end subroutine lilac_init_logging @@ -147,40 +181,56 @@ subroutine lilac_init_io(this) end subroutine lilac_init_io - subroutine lilac_init_clocks(this) + subroutine lilac_init_clocks(this, clock_data) use ESMF implicit none class(lilac_t), intent(inout) :: this + type(lilac_clock_data_t), intent(in) :: clock_data - type(ESMF_Clock) :: EClock ! Input synchronization clock - type(ESMF_Time) :: CurrTime, StartTime, StopTime - type(ESMF_TimeInterval) :: TimeStep + type(ESMF_Time) :: current_time, start_time, stop_time + type(ESMF_TimeInterval) :: time_step type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar), target :: Calendar + type(ESMF_Calendar), target :: calendar ! FIXME(bja, 2018-02) does this need to be freed? + integer :: cal_kind_flag + + if (clock_data%calendar_is_leap) then + cal_kind_flag = ? + else + cal_kind_flag = ESMF_CALKIND_NOLEAP + end if + ! FIXME(bja, 2018-02) verify it is to call multiple times if driver uses + ! esmf or there are multiple lilac instances...? call ESMF_Initialize(rc=rc) - Calendar = ESMF_CalendarCreate( name='lilac_NOLEAP', & - calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - EClock = ESMF_ClockCreate(name='lilac_EClock', & - TimeStep=TimeStep, startTime=StartTime, & - RefTime=StartTime, stopTime=stopTime, rc=rc) - - EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop' , & + + calendar = ESMF_CalendarCreate( name='lilac', calkindflag=cal_kind_flag, rc=rc ) + call ESMF_TimeSet(start_time, yy=clock_data%start_year, mm=clock_data%start_month, & + dd=clock_data%start_day, s=clock_data%start_seconds, calendar=calendar, rc=rc) + + call ESMF_TimeSet(stop_time , yy=clock_data%stop_year, mm=clock_data%stop_month, & + dd=clock_data%stop_day, s=clock_data%stop_seconds, calendar=Calendar, rc=rc) + + call ESMF_TimeIntervalSet(time_step, s=clock_data%time_step_seconds, rc=rc) + + this%lilac_clock = ESMF_ClockCreate(name='lilac_clock', & + TimeStep=time_step, startTime=start_time, & + RefTime=start_time, stopTime=stop_time, rc=rc) + + EAlarm_stop = ESMF_AlarmCreate(name='alarm_stop' , & clock=EClock, ringTime=StopTime, rc=rc) - EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', & + EAlarm_rest = ESMF_AlarmCreate(name='alarm_restart', & clock=EClock, ringTime=StopTime, rc=rc) - call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=', yy, mm, dd, sec - call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=', yy, mm, dd, sec - call shr_sys_flush(iunit) + if (this%debug) then + call ESMF_TimeGet( start_time, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(this%output_unit,'(1x,2a,4i6)') subname,' start time ymds=', yy, mm, dd, sec + call ESMF_TimeGet( stop_time, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(this%output_unit,'(1x,2a,4i6)') subname,' stop time ymds=', yy, mm, dd, sec + call shr_sys_flush(this%output_unit) + end if end subroutine lilac_init_clocks @@ -229,8 +279,8 @@ subroutine lilac_init_land(this) implicit none - write(iunit,*) subname,' calling lnd_init_mct' - call shr_sys_flush(iunit) + write(this%output_unit,*) subname,' calling lnd_init_mct' + call shr_sys_flush(this%output_unit) call lnd_init_mct(Eclock, cdata, x2l, l2x) call diag_avect(l2x, mpicom_lilac,'l2x_init') @@ -274,7 +324,7 @@ subroutine lilac_init_coupling(this) m = n-gstart+1 gindex(m) = n end do - write(iunit,'(1x,2a,5i8)') subname,' atm decomp = ', mytask, gsize, lsize, gstart, gend + write(this%output_unit,'(1x,2a,5i8)') subname,' atm decomp = ', mytask, gsize, lsize, gstart, gend ! initialize land grid on atm decomp call mct_gsMap_init(gsmap_atm, gindex, mpicom_lilac, ID_lilac, lsize, gsize) @@ -298,7 +348,7 @@ subroutine lilac_shutdown_land(this) class(lilac_t), intent(inout) :: this - write(iunit, *) 'lilac shutting down component ', this%comp_name + write(this%output_unit, *) 'lilac shutting down component ', this%comp_name call lnd_final_mct(Eclock, cdata, x2l, l2x) end subroutine lilac_shutdown_land From 565e828d4dcc052a537858d9f33ea57ab67d9ea1 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 7 Mar 2018 15:24:54 -0700 Subject: [PATCH 012/556] Converting latest batch of refactors. Not expected to compile or do anything. --- lilac/src/lilac-demo-driver.F90 | 10 +- lilac/src/lilac.F90 | 204 ++++++++++++++++++-------------- lilac/src/lilac_api_types.F90 | 43 +++++++ lilac/src/lilac_constants.F90 | 18 +++ 4 files changed, 185 insertions(+), 90 deletions(-) create mode 100644 lilac/src/lilac_api_types.F90 create mode 100644 lilac/src/lilac_constants.F90 diff --git a/lilac/src/lilac-demo-driver.F90 b/lilac/src/lilac-demo-driver.F90 index 39f28dac73..328b869cf8 100644 --- a/lilac/src/lilac-demo-driver.F90 +++ b/lilac/src/lilac-demo-driver.F90 @@ -80,7 +80,6 @@ program lilac_demo_driver ! ! Initialize the driver ! - call setup_demo_driver_clock(driver_clock) ! @@ -90,9 +89,12 @@ program lilac_demo_driver ! Hard code values normally supplied by the driver call MPI_Comm_Dup(MPI_COMM_WORLD, lilac_init_data%mpicom_lilac, ierr) call MPI_Comm_Dup(MPI_COMM_WORLD, lilac_init_data%mpicom_component, ierr) - lilac_init_data%output_unit_global_shared = 250 - lilac_init_data%output_unit_lilac = 251 - lilac_init_data%output_unit_component = 252 + call MPI_Comm_Dup(MPI_COMM_WORLD, lilac_init_data%mpicom_global_shared, ierr) + lilac_init_data%output_unit_lilac = 250 + lilac_init_data%output_unit_component = 251 + lilac_init_data%output_unit_global_shared = 252 + + lilac_init_data%component_name = MODEL_NAME_CTSM ! FIXME(bja, 2018-02) use namelist so the demo driver can serve as a test driver lilac_clock_data%calendar_is_leap = .false. diff --git a/lilac/src/lilac.F90 b/lilac/src/lilac.F90 index f3fd3e22a7..9f89e97d9f 100644 --- a/lilac/src/lilac.F90 +++ b/lilac/src/lilac.F90 @@ -4,45 +4,34 @@ module lilac ! implicit none - private - - integer, parameter :: lilac_master_proc = 0 - type :: lilac_clock_data_t - logical :: calendar_is_leap - integer :: start_year - integer :: start_month - integer :: start_day - integer :: start_second ! seconds since midnight + private - integer :: stop_year - integer :: stop_month - integer :: stop_day - integer :: stop_second ! seconds since midnight + integer, parameter :: LILAC_MASTER_PROC = 0 + integer, parameter :: LILAC_NUM_COMPONENTS = 1 - integer :: time_step_seconds - end type lilac_clock_data_t + type, public :: lilac_t + private + character(len=STRING_32) :: component_name + logical :: debug - type :: lilac_init_data_t integer :: mpicom_lilac - integer :: mpicom_component - integer :: output_unit_lilac - integer :: output_unit_global_shared ! this should be the same for all instances of lilac! - integer :: output_unit_component - - end type lilac_init_data_t - - type :: lilac_t - private - type(ESMF_Clock) :: driver_clock - integer :: my_mpi_rank - integer :: num_mpi_tasks + integer :: my_mpi_rank_lilac + integer :: num_mpi_tasks_lilac integer :: mct_comp_id + + type(ESMF_Clock) :: lilac_clock + type(ESMF_Time) :: start_time + type(ESMF_Time) :: stop_time + type(ESMF_TimeInterval) :: time_step + type(ESMF_Alarm) :: alarm_stop + type(ESMF_Alarm) :: alarm_restart + contains ! Public API - procedure :: Init => lilac_init - procedure :: Shutdown => lilac_shutdown - procudure :: AdvanceTime => lilac_advance_time + procedure, public :: Init => lilac_init + procedure, public :: Shutdown => lilac_shutdown + procudure, public :: AdvanceTime => lilac_advance_time ! private initialization routines procedure, private :: lilac_init_parallel @@ -69,6 +58,7 @@ module lilac ! subroutine lilac_init(this, init_data, clock_data, debug) + use lilac_api_types, only : lilac_clock_data_t use mct_mod, only : mct_world_init implicit none @@ -76,11 +66,24 @@ subroutine lilac_init(this, init_data, clock_data, debug) class(lilac_t), intent(inout) :: this type(lilac_init_data_t), intent(in) :: init_data type(lilac_clock_data_t), intent(in) :: clock_data - logical, intent(in) :: debug - call this%lilac_init_parallel(init_data%mpicom_lilac, init_data%mpicom_component) + this%debug = debug + this%component_name = init_data%component_name + + call this%lilac_init_parallel(init_data%mpicom_lilac, & + init_data%mpicom_component, init_data%mpicom_global_shared) + call this%lilac_init_logging(init_data%output_unit_lilac, init_data%output_unit_component) + call this%lilac_init_io() + call this%lilac_init_clocks(clock_data) + ! TODO(bja, 2018-03) use init_data%component_name to do some model + ! specific setup, including getting a list of hard coded input and output + ! exchange fields. + call this%lilac_init_fields() + call this%lilac_init_orbit() + call this%lilac_init_land() + call this%lilac_init_coupling() end subroutine lilac_init @@ -98,15 +101,18 @@ subroutine lilac_shutdown(this) class(lilac_t), intent(inout) :: this - ! FIXME(bja, 2018-02) master proc only! - write(this%output_unit, *) 'lilac shutting down...' + if (this%my_mpi_rank_lilac == LILAC_MASTER_PROC) then + write(this%output_unit, *) 'Shutting down lilac interface for component ', this%component_name, ' ...' + end if + call shr_sys_flush(this%output_unit) call this%lilac_shutdown_land() call this%lilac_shutdown_parallel() - ! FIXME(bja, 2018-02) master proc only! - write(this%output_unit, *) 'lilac shut down complete.' + if (this%my_mpi_rank_lilac == LILAC_MASTER_PROC) then + write(this%output_unit, *) 'lilac shut down for component ', this%component_name, ' complete.' + end if end subroutine lilac_shutdown @@ -123,14 +129,18 @@ subroutine lilac_init_parallel(this, mpicom_lilac, mpicom_component, mpicom_glob ! should be safe if previously initialized call MPI_Init(ierr) - call MPI_COMM_RANK(mpicom_lilac, this%my_mpi_rank, ierr) - call MPI_COMM_SIZE(mpicom_lilac, this%num_mpi_tasks, ierr) + this%mpicom_lilac = mpicom_lilac + this%mpicom_component = mpicom_component + + call MPI_COMM_RANK(this%mpicom_lilac, this%my_lilac_mpi_rank, ierr) + call MPI_COMM_SIZE(this%mpicom_lilac, this%num_lilac_mpi_tasks, ierr) + ! FIXME(bja, 2018-03) 1 (component | lilac) or two (component & lilac)? this%mct_num_comps = 1 this%mct_comp_id = 1 - ! NOTE(bja, 2018-02) this should eventually be initialized on the union of - ! the lilac and component communicators! - call mct_world_init(num_comps, MPI_COMM_WORLD, mpicom_lilac, ID_comp) + ! NOTE(bja, 2018-02) MPI_COMM_WORLD should eventually be initialized on + ! the union of the lilac and component communicators! If 2, then need arrays?! + call mct_world_init(this%mct_num_comps, MPI_COMM_WORLD, this%mpicom_lilac, this%mct_comp_id) end subroutine lilac_init_parallel @@ -140,43 +150,66 @@ subroutine lilac_init_logging(this, output_unit_lilac, output_unit_global_shared class(lilac_t), intent(inout) :: this + character(len=*), parameter :: subname = 'lilac_init_logging' ! open logfile for lilac this%output_unit = output_unit_lilac - write(log_file_name,'(a,i4.4)') 'lilac.log.', this%my_mpi_rank + ! FIXME(bja, 2018-03) do we want a single shared log file, or one per rank? + write(log_file_name,'(a,i4.4)') 'lilac.log.', this%my_mpi_rank_lilac open(this%output_unit, file=trim(log_file_name)) - if (this%my_mpi_rank == lilac_master_proc) then - write(this%output_unit, *) subname,' starting lilac' - write(this%output_unit, *) subname, ' num lilac tasks = ', this%num_mpi_tasks - write(this%output_unit, *) subname, ' my_mpi_rank = ', this%my_mpi_rank - write(this%output_unit, *) subname, ' mct component ID = ', this%mct_comp_id + if (this%my_mpi_rank_lilac == LILAC_MASTER_PROC) then + write(this%output_unit, *) subname, ': Starting lilac interface for component: ', this%component_name + write(this%output_unit, *) subname, ': num lilac tasks = ', this%num_mpi_tasks_lilac + write(this%output_unit, *) subname, ': my mpi rank = ', this%my_mpi_rank_lilac + write(this%output_unit, *) subname, ': mct component ID = ', this%mct_comp_id_lilac call shr_sys_flush(this%output_unit) end if - ! NOTE(bja, 2018-02) these are setting global variables! - call shr_file_setLogUnit(mpicom_global_shared) + ! NOTE(bja, 2018-02) these are setting global variables within the shr code! + call shr_file_setLogUnit(output_unit_global_shared) call shr_file_setLogLevel(1) end subroutine lilac_init_logging subroutine lilac_init_io(this) + ! NOTE(bja, 2018-02) There is only a *single science component* in each + ! lilac instance. For now assuming just the science component interacts + ! with pio, but lilac may have some parallel data I/O needs. If so it + ! needs to be added to these data structures! implicit none class(lilac_t), intent(inout) :: this - global_comm = MPI_COMM_WORLD - call shr_pio_init1(ncomps, 'pio_in', global_comm) - allocate(comp_id(ncomps), comp_name(ncomps), comp_iamin(ncomps), comp_comm(ncomps), comp_comm_iam(ncomps)) - do n = 1, ncomps - comp_id(n) = ID_lilac - comp_name(n) = 'LND' - comp_iamin(n) = .true. - comp_comm(n) = mpicom_lilac - comp_comm_iam(n) = mytask + ! + call shr_pio_init1(LILAC_NUM_COMPONENTS, 'pio_in', this%mpicom_lilac) + allocate( & + comp_id(LILAC_NUM_COMPONENTS), & + comp_name(LILAC_NUM_COMPONENTS), & + comp_iamin(LILAC_NUM_COMPONENTS), & + comp_comm(LILAC_NUM_COMPONENTS), & + comp_comm_iam(LILAC_NUM_COMPONENTS)) + + index = 1 + comp_id(index) = 1 + comp_name(index) = MODEL_NAME_LILAC // '_' // trim(this%component_name) + comp_iamin(index) = .true. + comp_comm(index) = this%mpicom_lilac + comp_comm_iam(index) = this%my_mpi_rank_lilac + + ! TODO(bja, 2018-03) Never have more than one science component, remove loop? + do n = 1, LILAC_NUM_COMPONENTS + index = index + n + comp_id(index) = ID_component + comp_name(index) = this%component_name + comp_iamin(index) = .true. + comp_comm(index) = this%mpicom_component + comp_comm_iam(index) = mytask ! FIXME(bja, 2018-02) when land and lilac are on different comms?? enddo + call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) + deallocate(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) end subroutine lilac_init_io @@ -190,45 +223,44 @@ subroutine lilac_init_clocks(this, clock_data) class(lilac_t), intent(inout) :: this type(lilac_clock_data_t), intent(in) :: clock_data - type(ESMF_Time) :: current_time, start_time, stop_time - type(ESMF_TimeInterval) :: time_step - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar), target :: calendar ! FIXME(bja, 2018-02) does this need to be freed? + type(ESMF_Calendar), target :: calendar ! FIXME(bja, 2018-02) does not need to be freed?! integer :: cal_kind_flag + integer :: year, month, day, sec - if (clock_data%calendar_is_leap) then - cal_kind_flag = ? - else + if (clock_data%calendar_is_leap == .false.) then cal_kind_flag = ESMF_CALKIND_NOLEAP + else + ! FIXME(bja, 2018-03) not implemented error! ESMF_CALKIND_GREGORIAN? end if - ! FIXME(bja, 2018-02) verify it is to call multiple times if driver uses - ! esmf or there are multiple lilac instances...? - call ESMF_Initialize(rc=rc) + if (ESMF_IsInitialized() /= .true.) then + ! NOTE(bja, 2018-03) allocates and operates on global data! + call ESMF_Initialize(rc=rc) + end if calendar = ESMF_CalendarCreate( name='lilac', calkindflag=cal_kind_flag, rc=rc ) - call ESMF_TimeSet(start_time, yy=clock_data%start_year, mm=clock_data%start_month, & + call ESMF_TimeSet(this%start_time, yy=clock_data%start_year, mm=clock_data%start_month, & dd=clock_data%start_day, s=clock_data%start_seconds, calendar=calendar, rc=rc) - call ESMF_TimeSet(stop_time , yy=clock_data%stop_year, mm=clock_data%stop_month, & - dd=clock_data%stop_day, s=clock_data%stop_seconds, calendar=Calendar, rc=rc) + call ESMF_TimeSet(this%stop_time , yy=clock_data%stop_year, mm=clock_data%stop_month, & + dd=clock_data%stop_day, s=clock_data%stop_seconds, calendar=calendar, rc=rc) - call ESMF_TimeIntervalSet(time_step, s=clock_data%time_step_seconds, rc=rc) + call ESMF_TimeIntervalSet(this%time_step, s=clock_data%time_step_seconds, rc=rc) this%lilac_clock = ESMF_ClockCreate(name='lilac_clock', & - TimeStep=time_step, startTime=start_time, & - RefTime=start_time, stopTime=stop_time, rc=rc) - - EAlarm_stop = ESMF_AlarmCreate(name='alarm_stop' , & - clock=EClock, ringTime=StopTime, rc=rc) - EAlarm_rest = ESMF_AlarmCreate(name='alarm_restart', & - clock=EClock, ringTime=StopTime, rc=rc) - - if (this%debug) then - call ESMF_TimeGet( start_time, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(this%output_unit,'(1x,2a,4i6)') subname,' start time ymds=', yy, mm, dd, sec - call ESMF_TimeGet( stop_time, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(this%output_unit,'(1x,2a,4i6)') subname,' stop time ymds=', yy, mm, dd, sec + TimeStep=this%time_step, startTime=this%start_time, & + RefTime=this%start_time, stopTime=this%stop_time, rc=rc) + + this%alarm_stop = ESMF_AlarmCreate(name='alarm_stop' , & + clock=this%lilac_clock, ringTime=this%stop_time, rc=rc) + this%alarm_rest = ESMF_AlarmCreate(name='alarm_restart', & + clock=this%lilac_clock, ringTime=this%stop_time, rc=rc) + + if (this%debug .and. this%my_mpi_rank_lilac == LILAC_MASTER_PROC) then + call ESMF_TimeGet( start_time, yy=year, mm=month, dd=day, s=sec, rc=rc ) + write(this%output_unit, '(1x,2a,4i6)') subname,': start time ymds=', year, month, day, sec + call ESMF_TimeGet( stop_time, yy=year, mm=month, dd=day, s=sec, rc=rc ) + write(this%output_unit, '(1x,2a,4i6)') subname,': stop time ymds=', year, month, day, sec call shr_sys_flush(this%output_unit) end if diff --git a/lilac/src/lilac_api_types.F90 b/lilac/src/lilac_api_types.F90 new file mode 100644 index 0000000000..da66aefe04 --- /dev/null +++ b/lilac/src/lilac_api_types.F90 @@ -0,0 +1,43 @@ +module lilac_api_types + + implicit none + + use lilac_constants, only : STRING_128 + +contains + + type :: lilac_init_data_t + character(len=STRING_32) :: component_name + integer :: mpicom_lilac + integer :: mpicom_component + integer :: output_unit_lilac + integer :: output_unit_global_shared ! this should be the same for all instances of lilac! + integer :: output_unit_component + + end type lilac_init_data_t + + type :: lilac_clock_data_t + logical :: calendar_is_leap + integer :: start_year + integer :: start_month + integer :: start_day + integer :: start_second ! seconds since midnight + + integer :: stop_year + integer :: stop_month + integer :: stop_day + integer :: stop_second ! seconds since midnight + + integer :: time_step_seconds + end type lilac_clock_data_t + + + type :: lilac_exchange_fields_t + character(len=STRING_128) :: long_name + character(len=STRING_128) :: short_name + character(len=STRING_128) :: field_name + character(len=STRING_128) :: units + integer :: field_type + end type lilac_exchange_fields_t + +end module lilac_api_types diff --git a/lilac/src/lilac_constants.F90 b/lilac/src/lilac_constants.F90 new file mode 100644 index 0000000000..d9e6442206 --- /dev/null +++ b/lilac/src/lilac_constants.F90 @@ -0,0 +1,18 @@ +module lilac_constants + + implicit none + +contains + + integer, parameter :: STRING_128 = 128 + integer, parameter :: STRING_32 = 32 + + integer, parameter :: FIELD_TYPE_INTEGER = 0 + integer, parameter :: FIELD_TYPE_REAL_8BYTE = 1 + + ! known models names + character(len=*), parameter :: MODEL_NAME_LILAC = 'lilac' + character(len=*), parameter :: MODEL_NAME_CTSM = 'ctsm' + character(len=*), parameter :: MODEL_NAME_TEST = 'test' + +end module lilac_constants From b0f5aceb42991a44079ced68ebaa2ce20f3f5269 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 10:16:13 -0700 Subject: [PATCH 013/556] add travis ci setup and dummy program --- lilac/.travis.yml | 28 ++++++++++++++++++++++++++++ lilac/CMakeLists.txt | 26 ++++++++++++++++++++++++++ lilac/lilac/test/simple_driver.f90 | 12 ++++++++++++ 3 files changed, 66 insertions(+) create mode 100644 lilac/.travis.yml create mode 100644 lilac/CMakeLists.txt create mode 100644 lilac/lilac/test/simple_driver.f90 diff --git a/lilac/.travis.yml b/lilac/.travis.yml new file mode 100644 index 0000000000..bc0113b32d --- /dev/null +++ b/lilac/.travis.yml @@ -0,0 +1,28 @@ +language: c +sudo: false +dist: trusty + +matrix: + include: + - os: linux + compiler: gcc + apt: + packages: + - cmake3 + - gfortran + +before_install: + - echo "before install" + +install: + - cd ${TRAVIS_BUILD_DIR} + - mkdir -p build && cd build + - cmake .. + - make + +before_script: + - echo "before script" + +script: + - cd ${TRAVIS_BUILD_DIR} + - ./build/prog diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt new file mode 100644 index 0000000000..a84296a576 --- /dev/null +++ b/lilac/CMakeLists.txt @@ -0,0 +1,26 @@ +cmake_minimum_required(VERSION 2.8.12.1) + +project(LILAC) +enable_language(Fortran) + +if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + set(dialect "-ffree-form -std=f2008 -fimplicit-none") + set(bounds "-fbounds-check") +endif() +if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + set(dialect "-stand f08 -free -implicitnone") + set(bounds "-check bounds") +endif() +if(CMAKE_Fortran_COMPILER_ID MATCHES "PGI") + set(dialect "-Mfreeform -Mdclchk -Mstandard -Mallocatable=03") + set(bounds "-C") +endif() + +set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} ${bounds}") +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") + +# +# Compile. +# +file(GLOB_RECURSE sources lilac/test/*.f90 lilac/test/*.h) +add_executable(prog ${sources}) diff --git a/lilac/lilac/test/simple_driver.f90 b/lilac/lilac/test/simple_driver.f90 new file mode 100644 index 0000000000..4b2d940b58 --- /dev/null +++ b/lilac/lilac/test/simple_driver.f90 @@ -0,0 +1,12 @@ +program simple_driver + implicit none + integer :: t + + t = 1 + + if (t == 1) then + write(*,*) "on this line" + else + write(*,*) "but not here" + end if +end program From 2f3a6cecefc0c8e9607f16d65df8785214176816 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 17:11:08 -0700 Subject: [PATCH 014/556] lots of cmake and travis stuff --- lilac/.travis.yml | 9 ++- lilac/CMakeLists.txt | 20 ++++-- lilac/README.md | 5 ++ lilac/ci/environment.yml | 10 +++ lilac/ci/install_esmf.sh | 15 +++++ lilac/ci/install_pfunit.sh | 20 ++++++ lilac/ci/install_python.sh | 20 ++++++ lilac/cmake/Modules/FindESMF.cmake | 70 ++++++++++++++++++++ lilac/lilac/CMakeLists.txt | 4 ++ lilac/lilac/lilac.f90 | 31 +++++++++ lilac/lilac/test/simple_driver.f90 | 12 ---- lilac/tests/CMakeLists.txt | 2 + lilac/tests/hello_world/CMakeLists.txt | 3 + lilac/tests/hello_world/main.f90 | 21 ++++++ lilac/tests/rand_atm_rand_lnd/CmakeLists.txt | 4 ++ lilac/tests/rand_atm_rand_lnd/main.f90 | 5 ++ 16 files changed, 230 insertions(+), 21 deletions(-) create mode 100644 lilac/ci/environment.yml create mode 100644 lilac/ci/install_esmf.sh create mode 100644 lilac/ci/install_pfunit.sh create mode 100644 lilac/ci/install_python.sh create mode 100644 lilac/cmake/Modules/FindESMF.cmake create mode 100644 lilac/lilac/CMakeLists.txt create mode 100644 lilac/lilac/lilac.f90 delete mode 100644 lilac/lilac/test/simple_driver.f90 create mode 100644 lilac/tests/CMakeLists.txt create mode 100644 lilac/tests/hello_world/CMakeLists.txt create mode 100644 lilac/tests/hello_world/main.f90 create mode 100644 lilac/tests/rand_atm_rand_lnd/CmakeLists.txt create mode 100644 lilac/tests/rand_atm_rand_lnd/main.f90 diff --git a/lilac/.travis.yml b/lilac/.travis.yml index bc0113b32d..1d52bb5ab3 100644 --- a/lilac/.travis.yml +++ b/lilac/.travis.yml @@ -1,4 +1,4 @@ -language: c +language: cpp sudo: false dist: trusty @@ -8,11 +8,14 @@ matrix: compiler: gcc apt: packages: - - cmake3 - gfortran + - cmake + - cmake-data before_install: - - echo "before install" + - ./install_python.sh + - ./install_esmf.sh + - ./install_pfunit.sh install: - cd ${TRAVIS_BUILD_DIR} diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index a84296a576..3b8e730424 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -1,8 +1,11 @@ cmake_minimum_required(VERSION 2.8.12.1) -project(LILAC) +project(LILAC Fortran) enable_language(Fortran) +# Local CMake modules +list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake/Modules) + if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") set(dialect "-ffree-form -std=f2008 -fimplicit-none") set(bounds "-fbounds-check") @@ -19,8 +22,13 @@ endif() set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} ${bounds}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") -# -# Compile. -# -file(GLOB_RECURSE sources lilac/test/*.f90 lilac/test/*.h) -add_executable(prog ${sources}) +# link to ESMF +find_package(ESMF) +include_directories(${esmf_INCLUDE_DIR}) +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}\ + ${ESMF_COMPILER_LINE}") +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}\ + ${ESMF_LINK_LINE} -g -cpp") + +add_subdirectory(lilac) +add_subdirectory(tests) diff --git a/lilac/README.md b/lilac/README.md index a7a62fb359..721cc0f08a 100644 --- a/lilac/README.md +++ b/lilac/README.md @@ -2,3 +2,8 @@ LILAC, Lightweight Infrastructure for Land Atmosphere Coupling. + +Currently working on: + - Setting up CI and CMake + - setup/test style (borrow from geostreams) + - setup unit tests with pfunit diff --git a/lilac/ci/environment.yml b/lilac/ci/environment.yml new file mode 100644 index 0000000000..af786a9279 --- /dev/null +++ b/lilac/ci/environment.yml @@ -0,0 +1,10 @@ +name: lilac +channels: + - conda-forge +dependencies: + - python=3.6 + - xarray + - esmpy + - cmake + - pip: + - cpp-coveralls diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh new file mode 100644 index 0000000000..9356efd2c0 --- /dev/null +++ b/lilac/ci/install_esmf.sh @@ -0,0 +1,15 @@ +#!/usr/bin/env bash +set -e +set -x + +cd ${HOME} + +git clone https://git.code.sf.net/p/esmf/esmf deps/esmf +cd deps/esmf +export ESMF_DIR=$PWD +export ESMF_INSTALL_PREFIX=/usr/esmf +export ESMFMKFILE=${ESMF_INSTALL_PREFIX}/esmf.mk +gmake -j8 lib +gmake install + +cd ${TRAVIS_BUILD_DIR} diff --git a/lilac/ci/install_pfunit.sh b/lilac/ci/install_pfunit.sh new file mode 100644 index 0000000000..84b5918c12 --- /dev/null +++ b/lilac/ci/install_pfunit.sh @@ -0,0 +1,20 @@ +#!/usr/bin/env bash + +set -e +set -x + +cd ${HOME} + +git clone https://github.com/Goddard-Fortran-Ecosystem/pFUnit.git ${HOME}/deps/pfunit +cd deps/pfunit + +# set environemnt variables +export F90=gfortran +export F90_VENDOR=GNU + +mkdir build +cd build +cmake .. +make install INSTALL_DIR=/usr + +cd ${TRAVIS_BUILD_DIR} diff --git a/lilac/ci/install_python.sh b/lilac/ci/install_python.sh new file mode 100644 index 0000000000..3e3739f648 --- /dev/null +++ b/lilac/ci/install_python.sh @@ -0,0 +1,20 @@ +#!/usr/bin/env bash + +set -e +set -x + +cd ${HOME} + +# Install miniconda +wget http://repo.continuum.io/miniconda/Miniconda3-latest-Linux-x86_64.sh -O ${HOME}/miniconda.sh +bash ~/miniconda.sh -b -p $HOME/miniconda +export PATH="$HOME/miniconda/bin:$PATH" +conda update conda --yes +conda clean -tipy +conda config --set always_yes yes --set changeps1 no +conda --version + +conda env create -f ci/environment.yml +source activate lilac + +cd ${TRAVIS_BUILD_DIR} diff --git a/lilac/cmake/Modules/FindESMF.cmake b/lilac/cmake/Modules/FindESMF.cmake new file mode 100644 index 0000000000..ba50c7a141 --- /dev/null +++ b/lilac/cmake/Modules/FindESMF.cmake @@ -0,0 +1,70 @@ +# +# Author: Ali Samii - The University of Texas at Austin +# +# Distributed under GPL2. For more info refer to: +# https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html +# +# +# FindESMF +# -------- +# +# This script tries to find the ESMF library. You have to define +# the path to esmf.mk file in your installation directory. +# +# There are plans to extend this script to find ESMF automatically, +# but until then, you should set the environment variable +# +# ESMFMKFILE = /path/to/esmf.mk +# +# in your installation directory. The output will be +# +# ESMF_LINK_LINE : All the libraries and link line stuff +# ESMF_COMPILER_LINE : All the compiler flags and include dirs +# +# + +# Defining the ${Esc} for syntax coloring. +string(ASCII 27 Esc) + +# Checking if ESMF exists +if (NOT DEFINED ENV{ESMFMKFILE} AND NOT DEFINED ESMFMKFILE) + message (FATAL_ERROR "\n${Esc}[1;31m!! Error: You need ESMF library to \ + run this program. please set the environment \ + variable ESMFMKFILE to point to esmf.mk in \ + your ESMF installation directory. \ + Try something like: ${Esc}[m\ + export ESMFMKFILE=/path/to/esmf.mk && cmake ${CMAKE_SOURCE_DIR}") +endif () + +if (NOT EXISTS $ENV{ESMFMKFILE} AND NOT EXISTS ${ESMFMKFILE}) + message (FATAL_ERROR "${Esc}[1;31m Error: esmf.mk file is not found at \ + ${ESMFMKFILE} ${Esc}[m") +else () + message ("+>${Esc}[1;32m The config file for ESMF library is found.${Esc}[m") +endif () + +if (DEFINED ENV{ESMFMKFILE}) + set(ESMFMKFILE $ENV{ESMFMKFILE} CACHE STRING "") +endif () +set(ESMFMKFILE ${ESMFMKFILE} CACHE STRING "") + +file(STRINGS "${ESMFMKFILE}" all_vars) +foreach(str ${all_vars}) + string(REGEX MATCH "^[^#]" def ${str}) + if (def) + string(REGEX MATCH "^[^=]+" var_name ${str}) + string(REGEX MATCH "=(.+)$" var_def ${str}) + set(var_def ${CMAKE_MATCH_1}) + set(${var_name} ${var_def}) + mark_as_advanced (${var_name}) + endif() +endforeach() + +set (ESMF_LINK_LINE "${ESMF_F90LINKOPTS} \ + ${ESMF_F90LINKRPATHS} \ + ${ESMF_F90LINKPATHS} \ + ${ESMF_F90ESMFLINKLIBS}") + +set (ESMF_COMPILER_LINE "${ESMF_F90COMPILEOPTS} \ + ${ESMF_F90COMPILEPATHS} \ + ${ESMF_F90COMPILEFREENOCPP}") diff --git a/lilac/lilac/CMakeLists.txt b/lilac/lilac/CMakeLists.txt new file mode 100644 index 0000000000..afbc52c6c3 --- /dev/null +++ b/lilac/lilac/CMakeLists.txt @@ -0,0 +1,4 @@ +# Compile LILAC library +file(GLOB_RECURSE LILAC_SOURCES *.f90 *.h) +add_library(lilac ${LILAC_SOURCES}) +target_include_directories(lilac PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/lilac) diff --git a/lilac/lilac/lilac.f90 b/lilac/lilac/lilac.f90 new file mode 100644 index 0000000000..a7a862e60e --- /dev/null +++ b/lilac/lilac/lilac.f90 @@ -0,0 +1,31 @@ +module lilac + + implicit none + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + public :: lilac_init + public :: lilac_run + public :: lilac_final + +contains + + subroutine lilac_init() + implicit none + print *, "lilac_init()" + flush(6) + + end subroutine lilac_init + + subroutine lilac_run() + implicit none + print *, "lilac_run()" + end subroutine lilac_run + + subroutine lilac_final() + implicit none + print *, "lilac_final()" + end subroutine lilac_final + +end module lilac diff --git a/lilac/lilac/test/simple_driver.f90 b/lilac/lilac/test/simple_driver.f90 deleted file mode 100644 index 4b2d940b58..0000000000 --- a/lilac/lilac/test/simple_driver.f90 +++ /dev/null @@ -1,12 +0,0 @@ -program simple_driver - implicit none - integer :: t - - t = 1 - - if (t == 1) then - write(*,*) "on this line" - else - write(*,*) "but not here" - end if -end program diff --git a/lilac/tests/CMakeLists.txt b/lilac/tests/CMakeLists.txt new file mode 100644 index 0000000000..6361d9e9c2 --- /dev/null +++ b/lilac/tests/CMakeLists.txt @@ -0,0 +1,2 @@ +# Add tests here +add_subdirectory(hello_world) diff --git a/lilac/tests/hello_world/CMakeLists.txt b/lilac/tests/hello_world/CMakeLists.txt new file mode 100644 index 0000000000..0e5fbd44bc --- /dev/null +++ b/lilac/tests/hello_world/CMakeLists.txt @@ -0,0 +1,3 @@ +file(GLOB_RECURSE SOURCES *.f90 *.h) +add_executable("test_hello_world" ${SOURCES} ) +target_link_libraries(lilac) diff --git a/lilac/tests/hello_world/main.f90 b/lilac/tests/hello_world/main.f90 new file mode 100644 index 0000000000..78312075c1 --- /dev/null +++ b/lilac/tests/hello_world/main.f90 @@ -0,0 +1,21 @@ +program main + + ! modules + use ESMF + ! use lilac, ONLY : lilac_init + + implicit none + + ! local variables + integer:: rc + + ! call lilac_init() + ! TODO fix linking with lilac + call ESMF_Initialize(rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) + + print *, "Hello LILAC World" + + call ESMF_Finalize() + +end program main diff --git a/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt b/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt new file mode 100644 index 0000000000..c7c253746b --- /dev/null +++ b/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt @@ -0,0 +1,4 @@ + +file(GLOB TEST_SOURCES *.f90 *.h) +add_executable(rand_atm_rand_land ${TEST_SOURCES} ) +target_link_libraries(rand_atm_rand_land) diff --git a/lilac/tests/rand_atm_rand_lnd/main.f90 b/lilac/tests/rand_atm_rand_lnd/main.f90 new file mode 100644 index 0000000000..f0c343cc4f --- /dev/null +++ b/lilac/tests/rand_atm_rand_lnd/main.f90 @@ -0,0 +1,5 @@ +program main + + + +end program main From 5d5a8183b77392164fa640674e7a8ca54977c40d Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 17:13:48 -0700 Subject: [PATCH 015/556] add travis badge to readme --- lilac/README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/lilac/README.md b/lilac/README.md index 721cc0f08a..a817ad0649 100644 --- a/lilac/README.md +++ b/lilac/README.md @@ -2,6 +2,7 @@ LILAC, Lightweight Infrastructure for Land Atmosphere Coupling. +[![Build Status](https://travis-ci.org/jhamman/lilac.svg?branch=master)](https://travis-ci.org/jhamman/lilac) Currently working on: - Setting up CI and CMake From e2262420348bc0c89284d61b5000f063967463ec Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 17:16:00 -0700 Subject: [PATCH 016/556] fix travis yaml --- lilac/.travis.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lilac/.travis.yml b/lilac/.travis.yml index 1d52bb5ab3..3c641bfd76 100644 --- a/lilac/.travis.yml +++ b/lilac/.travis.yml @@ -6,11 +6,11 @@ matrix: include: - os: linux compiler: gcc - apt: - packages: - - gfortran - - cmake - - cmake-data + apt: + packages: + - gfortran + - cmake + - cmake-data before_install: - ./install_python.sh From 503908fe21b9fdaec6adfc03c438974f1da727d0 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 17:17:42 -0700 Subject: [PATCH 017/556] fix install paths --- lilac/.travis.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lilac/.travis.yml b/lilac/.travis.yml index 3c641bfd76..3a5e7807af 100644 --- a/lilac/.travis.yml +++ b/lilac/.travis.yml @@ -13,9 +13,9 @@ matrix: - cmake-data before_install: - - ./install_python.sh - - ./install_esmf.sh - - ./install_pfunit.sh + - ./ci/install_python.sh + - ./ci/install_esmf.sh + - ./ci/install_pfunit.sh install: - cd ${TRAVIS_BUILD_DIR} From 6d98282b9ef1c3bb168f769c549c326df2f6bcbe Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 17:20:50 -0700 Subject: [PATCH 018/556] more travis fixes --- lilac/.travis.yml | 2 ++ lilac/ci/install_esmf.sh | 0 lilac/ci/install_pfunit.sh | 0 lilac/ci/install_python.sh | 0 4 files changed, 2 insertions(+) mode change 100644 => 100755 lilac/ci/install_esmf.sh mode change 100644 => 100755 lilac/ci/install_pfunit.sh mode change 100644 => 100755 lilac/ci/install_python.sh diff --git a/lilac/.travis.yml b/lilac/.travis.yml index 3a5e7807af..339b78520c 100644 --- a/lilac/.travis.yml +++ b/lilac/.travis.yml @@ -1,6 +1,8 @@ language: cpp sudo: false dist: trusty +notifications: + email: false matrix: include: diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh old mode 100644 new mode 100755 diff --git a/lilac/ci/install_pfunit.sh b/lilac/ci/install_pfunit.sh old mode 100644 new mode 100755 diff --git a/lilac/ci/install_python.sh b/lilac/ci/install_python.sh old mode 100644 new mode 100755 From 8fdce150686ead75a799b8f59499ba08927ba8c3 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 17:26:50 -0700 Subject: [PATCH 019/556] add lilac environment name --- lilac/ci/install_python.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/ci/install_python.sh b/lilac/ci/install_python.sh index 3e3739f648..b4d4452565 100755 --- a/lilac/ci/install_python.sh +++ b/lilac/ci/install_python.sh @@ -14,7 +14,7 @@ conda clean -tipy conda config --set always_yes yes --set changeps1 no conda --version -conda env create -f ci/environment.yml +conda env create --file ci/environment.yml --name lilac source activate lilac cd ${TRAVIS_BUILD_DIR} From eaf6f3b5a990c4edc13a54b2cdd919c8bbe52621 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 20:10:57 -0700 Subject: [PATCH 020/556] no env in conda install --- lilac/ci/install_python.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/ci/install_python.sh b/lilac/ci/install_python.sh index b4d4452565..650acee6a4 100755 --- a/lilac/ci/install_python.sh +++ b/lilac/ci/install_python.sh @@ -14,7 +14,7 @@ conda clean -tipy conda config --set always_yes yes --set changeps1 no conda --version -conda env create --file ci/environment.yml --name lilac +conda create --file ci/environment.yml --name lilac source activate lilac cd ${TRAVIS_BUILD_DIR} From 5540ff086a663bc072bd3d607e2cfbc78c1c58d6 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 20:14:40 -0700 Subject: [PATCH 021/556] fix conda install location --- lilac/ci/install_python.sh | 2 -- 1 file changed, 2 deletions(-) diff --git a/lilac/ci/install_python.sh b/lilac/ci/install_python.sh index 650acee6a4..1e2c2426c3 100755 --- a/lilac/ci/install_python.sh +++ b/lilac/ci/install_python.sh @@ -3,8 +3,6 @@ set -e set -x -cd ${HOME} - # Install miniconda wget http://repo.continuum.io/miniconda/Miniconda3-latest-Linux-x86_64.sh -O ${HOME}/miniconda.sh bash ~/miniconda.sh -b -p $HOME/miniconda From 4425bc6d9eb6908b59b802e7b7aa4a1a7d194e64 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 20:16:32 -0700 Subject: [PATCH 022/556] no name --- lilac/ci/environment.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/lilac/ci/environment.yml b/lilac/ci/environment.yml index af786a9279..0d0d6a023d 100644 --- a/lilac/ci/environment.yml +++ b/lilac/ci/environment.yml @@ -1,4 +1,3 @@ -name: lilac channels: - conda-forge dependencies: From 75de694b8336ab2ecede807a84d5eb6f1b5bc62b Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 20:22:21 -0700 Subject: [PATCH 023/556] back to env --- lilac/ci/install_python.sh | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lilac/ci/install_python.sh b/lilac/ci/install_python.sh index 1e2c2426c3..2a2d2a551f 100755 --- a/lilac/ci/install_python.sh +++ b/lilac/ci/install_python.sh @@ -12,7 +12,8 @@ conda clean -tipy conda config --set always_yes yes --set changeps1 no conda --version -conda create --file ci/environment.yml --name lilac +conda env create -f ci/environment.yml --name lilac + source activate lilac cd ${TRAVIS_BUILD_DIR} From 9e69979b52dba14d7930989ba85aef8703a336d8 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 21:28:24 -0700 Subject: [PATCH 024/556] make --- lilac/ci/install_esmf.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh index 9356efd2c0..021ecd5bbd 100755 --- a/lilac/ci/install_esmf.sh +++ b/lilac/ci/install_esmf.sh @@ -9,7 +9,7 @@ cd deps/esmf export ESMF_DIR=$PWD export ESMF_INSTALL_PREFIX=/usr/esmf export ESMFMKFILE=${ESMF_INSTALL_PREFIX}/esmf.mk -gmake -j8 lib -gmake install +make -j8 lib +make install cd ${TRAVIS_BUILD_DIR} From 82b38e9333e7e4a530d73b4c771ec76cfb66989a Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 21:36:18 -0700 Subject: [PATCH 025/556] gnu6 for esmf --- lilac/.travis.yml | 4 +++- lilac/ci/install_esmf.sh | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/lilac/.travis.yml b/lilac/.travis.yml index 339b78520c..8279b2b2f7 100644 --- a/lilac/.travis.yml +++ b/lilac/.travis.yml @@ -10,11 +10,13 @@ matrix: compiler: gcc apt: packages: - - gfortran + - gfortran-6 - cmake - cmake-data before_install: + - export CC=/usr/bin/gcc-6 + - export FC=/usr/bin/gfortran-6 - ./ci/install_python.sh - ./ci/install_esmf.sh - ./ci/install_pfunit.sh diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh index 021ecd5bbd..6b089d925b 100755 --- a/lilac/ci/install_esmf.sh +++ b/lilac/ci/install_esmf.sh @@ -4,12 +4,14 @@ set -x cd ${HOME} +ESMF_COMPILER=$FC + git clone https://git.code.sf.net/p/esmf/esmf deps/esmf cd deps/esmf export ESMF_DIR=$PWD export ESMF_INSTALL_PREFIX=/usr/esmf export ESMFMKFILE=${ESMF_INSTALL_PREFIX}/esmf.mk -make -j8 lib +make -j4 lib make install cd ${TRAVIS_BUILD_DIR} From 47c7cf5128b8f94e54fe3c0e743ff60c619e74c2 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 21:43:13 -0700 Subject: [PATCH 026/556] alias gfortran --- lilac/.travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/lilac/.travis.yml b/lilac/.travis.yml index 8279b2b2f7..03571b7a74 100644 --- a/lilac/.travis.yml +++ b/lilac/.travis.yml @@ -17,6 +17,7 @@ matrix: before_install: - export CC=/usr/bin/gcc-6 - export FC=/usr/bin/gfortran-6 + - alias gfortran="/usr/bin/gfortran-6" - ./ci/install_python.sh - ./ci/install_esmf.sh - ./ci/install_pfunit.sh From 095edde28edc3e6866c6d78ce4cff4d9f698838b Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 21:50:32 -0700 Subject: [PATCH 027/556] two alias for gfortran --- lilac/ci/install_esmf.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh index 6b089d925b..21e4a505d1 100755 --- a/lilac/ci/install_esmf.sh +++ b/lilac/ci/install_esmf.sh @@ -5,6 +5,7 @@ set -x cd ${HOME} ESMF_COMPILER=$FC +alias gfortran="/usr/bin/gfortran-6" git clone https://git.code.sf.net/p/esmf/esmf deps/esmf cd deps/esmf From 7f698cae0113f1769c9b6b78ee599cc92085daf6 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 22:43:05 -0700 Subject: [PATCH 028/556] export esmf compiler --- lilac/ci/install_esmf.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh index 21e4a505d1..1bda90b47d 100755 --- a/lilac/ci/install_esmf.sh +++ b/lilac/ci/install_esmf.sh @@ -4,7 +4,7 @@ set -x cd ${HOME} -ESMF_COMPILER=$FC +export ESMF_COMPILER="/usr/bin/gfortran-6" alias gfortran="/usr/bin/gfortran-6" git clone https://git.code.sf.net/p/esmf/esmf deps/esmf From 105f175d7da20c5574f2e77162a735d3caa272d8 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 2 Aug 2018 22:55:37 -0700 Subject: [PATCH 029/556] more compiler env vars --- lilac/ci/install_esmf.sh | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh index 1bda90b47d..68e622ae9e 100755 --- a/lilac/ci/install_esmf.sh +++ b/lilac/ci/install_esmf.sh @@ -4,6 +4,8 @@ set -x cd ${HOME} +export CC=""/usr/bin/gcc-6"" +export FC="/usr/bin/gfortran-6" export ESMF_COMPILER="/usr/bin/gfortran-6" alias gfortran="/usr/bin/gfortran-6" From 6a3a4e435a825195cf0d19c194590f95c20e6dfe Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Fri, 3 Aug 2018 08:33:13 -0700 Subject: [PATCH 030/556] default gfortran --- lilac/.travis.yml | 6 ++---- lilac/ci/install_esmf.sh | 10 ++++------ 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/lilac/.travis.yml b/lilac/.travis.yml index 03571b7a74..e3a280e1b9 100644 --- a/lilac/.travis.yml +++ b/lilac/.travis.yml @@ -10,14 +10,12 @@ matrix: compiler: gcc apt: packages: - - gfortran-6 + - gfortran - cmake - cmake-data before_install: - - export CC=/usr/bin/gcc-6 - - export FC=/usr/bin/gfortran-6 - - alias gfortran="/usr/bin/gfortran-6" + - export FC=/usr/bin/gfortran - ./ci/install_python.sh - ./ci/install_esmf.sh - ./ci/install_pfunit.sh diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh index 68e622ae9e..fef18a466f 100755 --- a/lilac/ci/install_esmf.sh +++ b/lilac/ci/install_esmf.sh @@ -4,17 +4,15 @@ set -x cd ${HOME} -export CC=""/usr/bin/gcc-6"" -export FC="/usr/bin/gfortran-6" -export ESMF_COMPILER="/usr/bin/gfortran-6" -alias gfortran="/usr/bin/gfortran-6" +export FC="/usr/bin/gfortran" +export ESMF_COMPILER="/usr/bin/gfortran" git clone https://git.code.sf.net/p/esmf/esmf deps/esmf cd deps/esmf export ESMF_DIR=$PWD -export ESMF_INSTALL_PREFIX=/usr/esmf -export ESMFMKFILE=${ESMF_INSTALL_PREFIX}/esmf.mk +export ESMF_INSTALL_PREFIX=/usr/ make -j4 lib make install +export ESMFMKFILE=${ESMF_INSTALL_PREFIX}/esmf.mk cd ${TRAVIS_BUILD_DIR} From 66efcdac2bb5a5031ddea9f5a2309e52db8b7af2 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Fri, 3 Aug 2018 08:51:37 -0700 Subject: [PATCH 031/556] add pfunit submodule --- external/pfunit | 1 + lilac/.gitmodules | 3 +++ 2 files changed, 4 insertions(+) create mode 160000 external/pfunit create mode 100644 lilac/.gitmodules diff --git a/external/pfunit b/external/pfunit new file mode 160000 index 0000000000..14339d668c --- /dev/null +++ b/external/pfunit @@ -0,0 +1 @@ +Subproject commit 14339d668c3f7440c408422dea68d750ee59ad9d diff --git a/lilac/.gitmodules b/lilac/.gitmodules new file mode 100644 index 0000000000..e266cf787f --- /dev/null +++ b/lilac/.gitmodules @@ -0,0 +1,3 @@ +[submodule "external/pfunit"] + path = external/pfunit + url = https://github.com/laristra/pfunit.git From ba3c09ba213633a79038028412d95b2acde52703 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Fri, 3 Aug 2018 09:11:23 -0700 Subject: [PATCH 032/556] add esmf as external --- external/esmf | 1 + lilac/.gitmodules | 3 +++ 2 files changed, 4 insertions(+) create mode 160000 external/esmf diff --git a/external/esmf b/external/esmf new file mode 160000 index 0000000000..d2761c276d --- /dev/null +++ b/external/esmf @@ -0,0 +1 @@ +Subproject commit d2761c276daf2ccac33193f28e925e974d180309 diff --git a/lilac/.gitmodules b/lilac/.gitmodules index e266cf787f..2f471a14d9 100644 --- a/lilac/.gitmodules +++ b/lilac/.gitmodules @@ -1,3 +1,6 @@ [submodule "external/pfunit"] path = external/pfunit url = https://github.com/laristra/pfunit.git +[submodule "external/esmf"] + path = external/esmf + url = https://git.code.sf.net/p/esmf/esmf From eb317b3a7495359f79e97cce126ee918c9b60f92 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Fri, 17 Aug 2018 17:01:00 -0700 Subject: [PATCH 033/556] updates after meeting with team in boulder, still has lots of holes --- lilac/CMakeLists.txt | 80 ++++++- lilac/lilac/atmos_comp.f90 | 39 ++++ lilac/lilac/coupler_mod.f90 | 326 ++++++++++++++++++++++++++ lilac/lilac/esmf_utils.f90 | 271 ++++++++++++++++++++++ lilac/lilac/land_comp.f90 | 1 + lilac/lilac/lilac.f90 | 41 +++- lilac/src/.dir-locals.el | 14 -- lilac/src/lilac-demo-driver.F90 | 283 ---------------------- lilac/src/lilac.F90 | 399 -------------------------------- lilac/src/lilac_api_types.F90 | 43 ---- lilac/src/lilac_constants.F90 | 18 -- lilac/src/stub_comp_mct.F90 | 8 - 12 files changed, 744 insertions(+), 779 deletions(-) create mode 100644 lilac/lilac/atmos_comp.f90 create mode 100644 lilac/lilac/coupler_mod.f90 create mode 100644 lilac/lilac/esmf_utils.f90 create mode 100644 lilac/lilac/land_comp.f90 delete mode 100644 lilac/src/.dir-locals.el delete mode 100644 lilac/src/lilac-demo-driver.F90 delete mode 100644 lilac/src/lilac.F90 delete mode 100644 lilac/src/lilac_api_types.F90 delete mode 100644 lilac/src/lilac_constants.F90 delete mode 100644 lilac/src/stub_comp_mct.F90 diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 3b8e730424..56d348a737 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -4,7 +4,6 @@ project(LILAC Fortran) enable_language(Fortran) # Local CMake modules -list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake/Modules) if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") set(dialect "-ffree-form -std=f2008 -fimplicit-none") @@ -22,13 +21,78 @@ endif() set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} ${bounds}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") -# link to ESMF -find_package(ESMF) -include_directories(${esmf_INCLUDE_DIR}) -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}\ - ${ESMF_COMPILER_LINE}") -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}\ - ${ESMF_LINK_LINE} -g -cpp") +if(DEFINED PFUNIT_INSTALL) + message(STATUS "Manual setup of variable PFUNIT_INSTALL: ${PFUNIT_INSTALL}") + set(PFUNIT_DIR ${PFUNIT_INSTALL}) +else() + include(ExternalProject) + + set(ExternalProjectCMakeArgs + -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} + -DCMAKE_INSTALL_PREFIX=${PROJECT_BINARY_DIR}/external/pfunit + -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} + ) + ExternalProject_Add(pfunit + DOWNLOAD_COMMAND git submodule update + DOWNLOAD_DIR ${PROJECT_SOURCE_DIR} + SOURCE_DIR ${PROJECT_SOURCE_DIR}/external/pfunit + BINARY_DIR ${PROJECT_BINARY_DIR}/external/pfunit-build + STAMP_DIR ${PROJECT_BINARY_DIR}/external/pfunit-stamp + TMP_DIR ${PROJECT_BINARY_DIR}/external/pfunit-tmp + INSTALL_DIR ${PROJECT_BINARY_DIR}/external + CMAKE_ARGS ${ExternalProjectCMakeArgs} + ) + include_directories(${PROJECT_BINARY_DIR}/external/pfunit/mod) + set(PFUNIT_DIR ${PROJECT_BINARY_DIR}/external/pfunit) +endif() + + +if(DEFINED ESMF_INSTALL) + message(STATUS "Manual setup of variable ESMF_INSTALL: ${ESMF_INSTALL}") + set(ESMF_DIR ${ESMF_INSTALL}) + +else() + message(STATUS "We will build ESMF") + include(ExternalProject) + + # set(ENV{ESMFMKFILE} "${PROJECT_BINARY_DIR}/external/esmf/esmf.mk") + + set(ExternalProjectCMakeArgs + ESMF_DIR=${ESMF_DIR} + ESMF_INSTALL_PREFIX=${PROJECT_BINARY_DIR}/external + ESMF_INSTALL_BINDIR=${PROJECT_BINARY_DIR}/bin/ + ESMF_INSTALL_DOCDIR=${PROJECT_BINARY_DIR}/doc/ + ESMF_INSTALL_HEADERDIR=${PROJECT_BINARY_DIR}/include/ + ESMF_INSTALL_LIBDIR=${PROJECT_BINARY_DIR}/lib/ + ESMF_INSTALL_MODDIR=${PROJECT_BINARY_DIR}/mod/ + ) + + ExternalProject_Add(esmf + DOWNLOAD_COMMAND git submodule update + DOWNLOAD_DIR ${PROJECT_SOURCE_DIR}/external + SOURCE_DIR ${PROJECT_SOURCE_DIR}/external/esmf + INSTALL_DIR ${PROJECT_BINARY_DIR}/external + BUILD_IN_SOURCE TRUE + CMAKE_ARGS ${ExternalProjectCMakeArgs} + CONFIGURE_COMMAND "" + BUILD_COMMAND make + INSTALL_COMMAND pwd && make install + ) + + # link to ESMF + # find_package(ESMF) + # include_directories(${PROJECT_BINARY_DIR}/include/) + # set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}\ ${ESMF_COMPILER_LINE}") + # set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") + # TODO figure out how to get these out once ESMF is compiled + set(ESMF_COMPILER_LINE, "-O -m64 -mcmodel=small -ffree-line-length-none -fopenmp -I/Users/jhamman/Dropbox/src/lilac/external/esmf/mod/modO/Darwin.gfortran.64.mpiuni.default -I/Users/jhamman/Dropbox/src/lilac/external/esmf/src/include -ffree-form") + set(ESMF_LINK_LINE, "-m64 -mcmodel=small -fopenmp -L/Users/jhamman/Dropbox/src/lilac/external/esmf/lib/libO/Darwin.gfortran.64.mpiuni.default -L/opt/local/lib/gcc5/gcc/x86_64-apple-darwin17/5.5.0/../../../ -lesmf -lstdc++") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") + + + +endif() add_subdirectory(lilac) add_subdirectory(tests) diff --git a/lilac/lilac/atmos_comp.f90 b/lilac/lilac/atmos_comp.f90 new file mode 100644 index 0000000000..b8ecec4a2d --- /dev/null +++ b/lilac/lilac/atmos_comp.f90 @@ -0,0 +1,39 @@ + +module atmos_comp + + ! ESMF Framework module + use ESMF + implicit none + + public atmos_register + +contains + + + subroutine atmos_register(comp, rc) + type(ESMF_GridComp) :: comp + integer, intent(out) :: rc + + ! Initialize return code + rc = ESMF_SUCCESS + + print *, "Atmosphere Register starting" + + ! Register the callback routines. + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, & + rc=rc) + if (rc/=ESMF_SUCCESS) return ! bail out + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_run, & + rc=rc) + if (rc/=ESMF_SUCCESS) return ! bail out + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, & + rc=rc) + if (rc/=ESMF_SUCCESS) return ! bail out + + print *, "Registered Initialize, Run, and Finalize routines" + print *, "Atmosphere Register returning" + + end subroutine atmos_register + +end module atmos_comp diff --git a/lilac/lilac/coupler_mod.f90 b/lilac/lilac/coupler_mod.f90 new file mode 100644 index 0000000000..36354e7c88 --- /dev/null +++ b/lilac/lilac/coupler_mod.f90 @@ -0,0 +1,326 @@ + module CouplerMod + + use ESMF + + implicit none + + private + + ! Public entry point + public Coupler_register + + contains + + +!------------------------------------------------------------------------------ +!BOPI +! !IROUTINE: Coupler_register - public SetServices entry point + +! !INTERFACE: + subroutine Coupler_register(comp, rc) +! +! !ARGUMENTS: + type(ESMF_CplComp) :: comp + integer, intent(out) :: rc +! +! !DESCRIPTION: +! User-supplied setservices routine. +! +! The arguments are: +! \begin{description} +! \item[comp] +! Component. +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors, +! otherwise {\tt ESMF\_FAILURE}. +! \end{description} +! +!EOPI + + ! because none of the arguments to this subroutine will ever be optional, + ! go ahead and set rc to an initial return code before using it below. + ! (this makes some eager error-checking compilers happy.) + rc = ESMF_FAILURE + + ! Register the callback routines. + + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=coupler_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + print *, "CouplerMod: Registered Initialize, Run, and Finalize routines" + + end subroutine + + +!------------------------------------------------------------------------------ +!BOPI +! !IROUTINE: coupler_init - coupler init routine + +! !INTERFACE: + subroutine coupler_init(comp, importState, exportState, clock, rc) + +! +! !ARGUMENTS: + type(ESMF_CplComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc +! +! !DESCRIPTION: +! User-supplied init routine. +! +! The arguments are: +! \begin{description} +! \item[comp] +! Component. +! \item[importState] +! Nested state object containing import data. +! \item[exportState] +! Nested state object containing export data. +! \item[clock] +! External clock. +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors, +! otherwise {\tt ESMF\_FAILURE}. +! \end{description} +! +!EOPI + +! ! Local variables + type(ESMF_Field) :: src_field, dst_field + type(ESMF_VM) :: vm + character(ESMF_MAXSTR) :: statename + + print *, "Coupler Init starting" + + ! because none of the arguments to this subroutine will ever be optional, + ! go ahead and set rc to an initial return code before using it below. + ! (this makes some eager error-checking compilers happy.) + rc = ESMF_FAILURE + + ! Get VM from coupler component to use in computing redistribution + call ESMF_CplCompGet(comp, vm=vm, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + ! Use placeholder SIE + call ESMF_StateGet(importState, name=statename, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateGet(importState, "SIE", src_field, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateGet(exportState, "SIE", dst_field, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + ! Compute routehandle + ! Since state items are needed by default, mark Fields not needed during coupling + if (trim(statename) .eq. "FlowSolver Feedback") then + call setFieldNeeded(importState, "U", .false., rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call setFieldNeeded(importState, "P", .false., rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call setFieldNeeded(importState, "Q", .false., rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_FieldRedistStore(src_field, dst_field, & + routehandle=fromFlow_rh, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + endif + + if (trim(statename) .eq. "Injection Feedback") then + call setFieldNeeded(importState, "U", .false., rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call setFieldNeeded(importState, "P", .false., rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call setFieldNeeded(importState, "Q", .false., rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call setFieldNeeded(importState, "FLAG", .false., rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_FieldRedistStore(src_field, dst_field, & + routehandle=fromInject_rh, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + endif + + print *, "Coupler Init returning" + + end subroutine coupler_init + + +!------------------------------------------------------------------------------ +!BOPI +! !IROUTINE: coupler_run - coupler run routine + +! !INTERFACE: + subroutine coupler_run(comp, importState, exportState, clock, rc) + +! +! !ARGUMENTS: + type(ESMF_CplComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc +! +! !DESCRIPTION: +! User-supplied run routine. +! +! The arguments are: +! \begin{description} +! \item[comp] +! Component. +! \item[importState] +! Nested state object containing import data. +! \item[exportState] +! Nested state object containing export data. +! \item[clock] +! External clock. +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors, +! otherwise {\tt ESMF\_FAILURE}. +! \end{description} +! +!EOPI + + ! Local variables + type(ESMF_Field) :: srcfield, dstfield + type(ESMF_RouteHandle) :: rh + + character(len=ESMF_MAXSTR) :: statename + + integer :: i, datacount + character(len=ESMF_MAXSTR), dimension(7) :: datanames + + ! none of the arguments to this subroutine will ever be optional, so + ! go ahead and set rc to an initial return code before using it below. + ! (this makes some eager error-checking compilers happy.) + rc = ESMF_FAILURE + + datacount = 7 + datanames(1) = "SIE" + datanames(2) = "U" + datanames(3) = "V" + datanames(4) = "RHO" + datanames(5) = "P" + datanames(6) = "Q" + datanames(7) = "FLAG" + + ! In this case, the coupling is symmetric - you call redist going + ! both ways - so we only care about the coupling direction in order + ! to get the right routehandle selected. + call ESMF_StateGet(importState, name=statename, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + if (trim(statename) .eq. "FlowSolver Feedback") then + rh = fromFlow_rh + else + rh = fromInject_rh + endif + + do i=1, datacount + + ! check isneeded flag here + if (.not. isFieldNeeded(importState, datanames(i), rc=rc)) then + !print *, "skipping field ", trim(datanames(i)), " not needed" + cycle + endif + + !print *, "processing field ", trim(datanames(i)), " as needed" +!BOE +! !DESCRIPTION: +! \subsubsection{Example of Redist Usage} +! +! The following piece of code provides an example of calling the data +! redistribution routine between two Fields in the Coupler Component. +! Unlike regrid, which translates between +! different Grids, redist translates between different DELayouts on +! the same Grid. The first two lines get the Fields from the +! States, each corresponding to a different subcomponent. One is +! an Export State and the other is an Import State. +! +!BOC + call ESMF_StateGet(importState, datanames(i), srcfield, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateGet(exportState, datanames(i), dstfield, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) +!EOC +! +! The redist routine uses information contained in the Fields and the +! Coupler VM object to call the communication routines to move the data. +! Because many Fields may share the same Grid association, the same +! routing information may be needed repeatedly. Route information is +! saved so the precomputed information can be retained. The following +! is an example of a Field redist call: +! +!BOC + call ESMF_FieldRedist(srcfield, dstfield, routehandle=rh, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + +!EOC +!EOE + + enddo + + ! rc has the last error code already + + end subroutine coupler_run + + +!------------------------------------------------------------------------------ +!BOPI +! !IROUTINE: coupler_final - finalization routine + +! !INTERFACE: + subroutine coupler_final(comp, importState, exportState, clock, rc) + +! +! !ARGUMENTS: + type(ESMF_CplComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc +! +! !DESCRIPTION: +! User-supplied finalize routine. +! +! The arguments are: +! \begin{description} +! \item[comp] +! Component. +! \item[importState] +! Nested state object containing import data. +! \item[exportState] +! Nested state object containing export data. +! \item[clock] +! External clock. +! \item[rc] +! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors, +! otherwise {\tt ESMF\_FAILURE}. +! \end{description} +! +!EOPI + + print *, "Coupler Final starting" + + ! none of the arguments to this subroutine will ever be optional, so + ! go ahead and set rc to an initial return code before using it below. + ! (this makes some eager error-checking compilers happy.) + rc = ESMF_FAILURE + + ! Only thing to do here is release redist and route handles + call ESMF_FieldRedistRelease(fromFlow_rh, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_FieldRedistRelease(fromInject_rh, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + rc = ESMF_SUCCESS + + print *, "Coupler Final returning" + + end subroutine coupler_final + + + end module CouplerMod diff --git a/lilac/lilac/esmf_utils.f90 b/lilac/lilac/esmf_utils.f90 new file mode 100644 index 0000000000..4d2a817b41 --- /dev/null +++ b/lilac/lilac/esmf_utils.f90 @@ -0,0 +1,271 @@ +module esmf_utils + +! Wrappers and derived types exposing ESMF components to LILAC + + +#include "ESMF.h" + use ESMF + + implicit none + private + + ! Consider renaming ESMFInfoType (add lilac to name) + type, public :: ESMFInfoType + private + character(len=MAXFILELENGTH) :: name + + type(ESMF_VM) :: vm + type(ESMF_State) :: land_import + type(ESMF_State) :: land_export + type(ESMF_State) :: atmos_import + type(E SMF_State) :: atmos_export + type(ESMF_GridComp) :: atmos_comp + type(ESMF_GridComp) :: land_comp + type(ESMF_CplComp) :: cpl_comp + + contains + procedure, public :: init => init + procedure, public :: run => run + procedure, public :: final => final + + procedure, private :: atmos_register => atmos_register + procedure, private :: land_register => land_register + procedure, private :: cpl_register => cpl_register + end type ESMFInfoType + +contains + + subroutine init(self, name) + implicit none + class(ESMFInfoType), intent(inout) :: self + character(len=MAXVARLENGTH), intent(in) :: name + + ! TODO define subroutines: https://stackoverflow.com/questions/32809769/how-to-pass-subroutine-names-as-arguments-in-fortran + + ! Local variables + integer :: localPet, petCount, localrc, rc=ESMF_SUCCESS, userrc=ESMF_SUCCESS + character(len=ESMF_MAXSTR) :: cname1, cname2 + + print *, "esmf_info%init()" + + self%name = name + + ! Create section + !------------------------------------------------------------------------- + + ! Initialize framework and get back default global VM + + ! only run if not esmf_isintialized() + call ESMF_Initialize(vm=self%vm, defaultlogfilename="lilac.log", logkindflag=ESMF_LOGKIND_MULTI, rc=localrc) + call check(localrc, rc) + + ! Get number of PETs we are running with + call ESMF_VMGet(self%vm, petCount=petCount, localPet=localPet, rc=localrc) + call check(localrc, rc) + + ! Create the 2 model components and a coupler + cname1 = "land" + ! use petList to define land on all PET + self%land_grid = ESMF_GridCompCreate(name=cname1, rc=localrc) + print *, "Created component ", trim(cname1), "rc =", localrc + call check(localrc, rc) + + cname2 = "atmosphere" + ! use petList to define atmosphere on all PET + self%atmos_comp = ESMF_GridCompCreate(name=cname2, rc=localrc) + print *, "Created component ", trim(cname2), "rc =", localrc + call check(localrc, rc) + + cplname = "lilac coupler" + ! no petList means that coupler component runs on all PETs + self%cpl_comp = ESMF_CplCompCreate(name=cplname, rc=localrc) + print *, "Created component ", trim(cplname), ", rc =", localrc + call check(localrc, rc) + + print *, "Comp Creates finished" + + ! Register section + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(self%atmos_comp, userRoutine=atmos_register, userRc=userrc, rc=localrc) + print *, "atmos SetServices finished, rc= ", localrc + call check(localrc, rc) + call check(userrc, rc) + + call ESMF_GridCompSetServices(self%land_comp, userRoutine=land_register, userRc=userrc, rc=localrc) + print *, "land SetServices finished, rc= ", localrc + call check(localrc, rc) + call check(userrc, rc) + + call ESMF_CplCompSetServices(self%cpl_comp, userRoutine=cpl_register, userRc=userrc, rc=localrc) + print *, "Cpl SetServices finished, rc= ", localrc + call check(localrc, rc) + call check(userrc, rc) + + ! Init section + !------------------------------------------------------------------------- + ! land import/export states + self%land_import = ESMF_StateCreate(name="land import", stateintent=ESMF_STATEINTENT_IMPORT, rc=localrc) + call check(localrc, rc) + self%land_export = ESMF_StateCreate(name="land export", stateintent=ESMF_STATEINTENT_EXPORT, rc=localrc) + call check(localrc, rc) + call ESMF_GridCompInitialize(land, importState=self%land_import, exportState=self%land_export, userRc=userrc, rc=localrc) + call check(localrc, rc) + call check(userrc, rc) + print *, "Land Initialize finished, rc =", localrc + + ! atmosphere import/export state + self%atmos_import = ESMF_StateCreate(name="atmos import", & + stateintent=ESMF_STATEINTENT_IMPORT, rc=localrc) + call check(localrc, rc) + + self%atmos_export = ESMF_StateCreate(name="atmos export", & + stateintent=ESMF_STATEINTENT_EXPORT, rc=localrc) + call check(localrc, rc) + call ESMF_GridCompInitialize(self%atmos_comp, exportState=self%atmos_export, userRc=userrc, rc=localrc) + print *, "Atmosphere Initialize finished, rc =", localrc + call check(localrc, rc) + call check(userrc, rc) + + ! call ESMF_CPLCompInitialize twice (once for each grid comp) + + end subroutine init + + subroutine run(self) + implicit none + integer :: localrc, rc=ESMF_SUCCESS, userrc=ESMF_SUCCESS + print *, "esmf_info%run()" + + ! TODO: need some help on order of imports/exports/runs and whether the land/atm both need import/export states + + ! atmosphere run + ! copy the atmos state and put it into atmos export + call ESMF_GridCompRun(self%atmos_comp, exportState=self%atmos_export, phase=1, userRc=userrc, rc=localrc) + print *, "Atmosphere Run returned, rc =", localrc + call check(localrc, rc) + call check(userrc, rc) + + ! coupler run + call ESMF_CplCompRun(self%cpl_comp, importState=self%atoms_export, exportState=self%land_import, & + userRc=userrc, rc=localrc) + print *, "Coupler Run returned, rc =", localrc + call check(localrc, rc) + call check(userrc, rc) + + ! land run + call ESMF_GridCompRun(self%land_comp, importState=self%land_import, exportState=self%land_export, userRc=userrc, rc=localrc) + print *, "Land Run returned, rc =", localrc + call check(localrc, rc) + call check(userrc, rc) + + ! coupler run + call ESMF_CplCompRun(self%cpl_comp, importState=self%land_export, exportState=self%atmos_import, & + userRc=userrc, rc=localrc) + print *, "Coupler Run returned, rc =", localrc + call check(localrc, rc) + call check(userrc, rc) + + call ESMF_GridCompRun(self%atmos_comp, importState%atmos_import, phase=2, userRc=userrc, rc=localrc) + print *, "Atmosphere Run returned, rc =", localrc + call check(localrc, rc) + call check(userrc, rc) + + end subroutine run + + subroutine final(self) + implicit none + class(ESMFInfoType), intent(inout) :: self + integer :: localrc, rc=ESMF_SUCCESS + + print *, "esmf_info%final()" + + ! Destroy section + call ESMF_GridCompDestroy(self%atmos_comp, rc=localrc) + check(localrc, rc) + call ESMF_GridCompDestroy(self%land_comp, rc=localrc) + check(localrc, rc) + call ESMF_CplCompDestroy(self%cpl_comp, rc=localrc) + check(localrc, rc) + + call ESMF_StateDestroy(self%land_export, rc=localrc) + call ESMF_StateDestroy(self%land_import, rc=localrc) + check(localrc, rc) + call ESMF_StateDestroy(self%atmos_export, rc=localrc) + call ESMF_StateDestroy(self%atmos_import, rc=localrc) + ! do this everywhere + if return_error(localrc, rc) return + + print *, "All Destroy routines done" + + end subroutine final + + subroutine atoms_register(comp, rc) + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc ! must not be optional + + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & + userRoutine=atoms_init, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & + userRoutine=atoms_copy_atm_to_lilac, phase=1, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & + userRoutine=atoms_copy_lilac_to_atm, phase=2, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & + userRoutine=atoms_final, rc=rc) + ! TODO: check rcs + + rc = ESMF_SUCCESS + + end subroutine + + subroutine land_register(comp, rc) + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc ! must not be optional + + ! land_* comes from ctsm esmf cap + + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & + userRoutine=land_init, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & + userRoutine=land_run, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & + userRoutine=land_final, rc=rc) + ! TODO: check rcs + + rc = ESMF_SUCCESS + + end subroutine + + subroutine cpl_register(comp, rc) + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc ! must not be optional + + rc = ESMF_FAILURE + + ! Register the callback routines. + + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=coupler_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + print *, "CouplerMod: Registered Initialize, Run, and Finalize routines" + + rc = ESMF_SUCCESS + + end subroutine + + function return_error(rc, returnrc) + ! fight with this later + integer, intent(in) :: rc, returnrc + if (ESMF_LogFoundError(rc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=returnrc)) then + return_error = .true. + else + return_error = .false. + endif + + end function return_error + +end module esmf_utils diff --git a/lilac/lilac/land_comp.f90 b/lilac/lilac/land_comp.f90 new file mode 100644 index 0000000000..1a4baf536d --- /dev/null +++ b/lilac/lilac/land_comp.f90 @@ -0,0 +1 @@ + diff --git a/lilac/lilac/lilac.f90 b/lilac/lilac/lilac.f90 index a7a862e60e..b6393f9164 100644 --- a/lilac/lilac/lilac.f90 +++ b/lilac/lilac/lilac.f90 @@ -1,5 +1,12 @@ module lilac +#include "ESMF.h" + use ESMF + + use atmos_comp, only : atmos_setvm, atmos_register + use land_comp, only : land_setvm, land_register + use coupler_comp, only : usercpl_setvm, usercpl_register + implicit none !-------------------------------------------------------------------------- @@ -9,23 +16,45 @@ module lilac public :: lilac_run public :: lilac_final + type(LilacType), save :: lilac_obj + +contains + + type, public :: LilacType + private + + type(ESMFInfoType) :: esmf_info + + contains + procedure, public :: init => init + procedure, public :: run => run + procedure, public :: final => final + end type LilacType + contains - subroutine lilac_init() + subroutine lilac_init(self) implicit none + print *, "lilac_init()" - flush(6) + + ! Initialize ESMF structures + call self%esmf_info%init("lilac") end subroutine lilac_init - subroutine lilac_run() + subroutine lilac_run(self) implicit none - print *, "lilac_run()" + + call self%esmf_info%run() + end subroutine lilac_run - subroutine lilac_final() + subroutine lilac_final(self) implicit none - print *, "lilac_final()" + + call self%esmf_info%final() + end subroutine lilac_final end module lilac diff --git a/lilac/src/.dir-locals.el b/lilac/src/.dir-locals.el deleted file mode 100644 index 4edf085c03..0000000000 --- a/lilac/src/.dir-locals.el +++ /dev/null @@ -1,14 +0,0 @@ -;;; Directory Local Variables -;;; For more information see (info "(emacs) Directory Variables") - -((f90-mode - (f90-program-indent . 3) - (f90-associate-indent . 3) - (f90-do-indent . 3) - (f90-if-indent . 3) - (f90-type-indent . 3) - (f90-program-indent . 3) - (f90-continuation-indent . 5) - (fill-column . 80) - (indent-tabs-mode))) - diff --git a/lilac/src/lilac-demo-driver.F90 b/lilac/src/lilac-demo-driver.F90 deleted file mode 100644 index 328b869cf8..0000000000 --- a/lilac/src/lilac-demo-driver.F90 +++ /dev/null @@ -1,283 +0,0 @@ -program lilac_demo_driver - - use lnd_comp_mct , only: lnd_init_mct, lnd_run_mct, lnd_final_mct - use seq_flds_mod , only: & - seq_flds_x2l_states, seq_flds_x2l_fluxes, seq_flds_x2l_fields, & - seq_flds_l2x_states, seq_flds_l2x_fluxes, seq_flds_l2x_fields, & - seq_flds_dom_coord, seq_flds_dom_other, seq_flds_dom_fields - use seq_cdata_mod, only: seq_cdata - use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata - use shr_sys_mod , only: shr_sys_flush, shr_sys_abort - use shr_orb_mod , only: shr_orb_params - use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 - use mct_mod - use ESMF - - implicit none - -#include ! mpi library include file - - !----- Clocks ----- - type(ESMF_Clock) :: driver_clock - type(ESMF_Time) :: CurrTime, StartTime, StopTime - type(ESMF_TimeInterval) :: TimeStep - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar), target :: Calendar - integer :: yy, mm, dd, sec - - !----- MPI/MCT ----- - integer :: mpicom_lilac ! local mpicom - integer :: ID_lilac ! mct ID - integer :: ncomps ! number of separate components for MCT - integer :: ntasks, mytask ! mpicom size and rank - integer :: global_comm ! copy of mpi_comm_world for pio - integer, allocatable :: comp_id(:) ! for pio init2 - logical, allocatable :: comp_iamin(:) ! for pio init2 - character(len=64), allocatable :: comp_name(:) ! for pio init2 - integer, allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 - - !----- Land Coupling Data ----- - type(seq_cdata) :: cdata ! Input land-model driver data - type(seq_infodata_type), target :: infodata ! infodata type - type(mct_aVect) :: x2l, l2x ! land model import and export states - type(mct_gGrid), target :: dom_lnd ! domain data for clm - type(mct_gsMap), target :: gsmap_lnd ! gsmap data for clm - integer :: orb_iyear ! Orbital - real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp - character(len=128) :: case_name, case_desc, model_version, hostname, username - character(len=128) :: start_type - logical :: brnch_retain_casename, single_column, atm_aero - real*8 :: scmlat, scmlon - integer :: idx_Sa_z, idx_Sa_u, idx_Sa_v, idx_Sa_tbot, idx_Sa_ptem, & - idx_Sa_shum, idx_Sa_pbot, idx_Faxa_rainc, idx_Faxa_rainl, & - idx_Faxa_snowc, idx_Faxa_snowl, idx_Faxa_lwdn, idx_Faxa_swndr, & - idx_Faxa_swvdr, idx_Faxa_swndf, idx_Faxa_swvdf - - !----- Atm Model ----- - integer :: atm_nx, atm_ny - integer :: gsize, lsize, gstart, gend ! domain decomp info - integer, allocatable :: gindex(:) ! domain decomp info - type(mct_aVect) :: x2l_a ! data for land on atm decomp - type(mct_aVect) :: l2x_a ! data from land on atm decomp - type(mct_gsMap) :: gsmap_atm ! gsmap data for atm - type(mct_rearr) :: rearr_atm2lnd ! rearranger for atm to land - type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm - - !----- Other ----- - integer :: n, m ! counter - character(len=128) :: string ! temporary string - integer :: ierr, rc ! local error status - integer :: iunit = 250 ! lilac log unit number - integer :: sunit = 249 ! share log unit number - character(len=*), parameter :: subname = 'lilac_demo_driver' - - logical :: debug = true - !---------------------------------------------- - type(lilac_init_data_t) :: lilac_init_data - type(lilac_clock_data_t) :: lilac_clock_data - class(lilac_t) :: lilac - - ! - ! Initialize the driver - ! - call setup_demo_driver_clock(driver_clock) - - ! - ! Initialize lilac - ! - - ! Hard code values normally supplied by the driver - call MPI_Comm_Dup(MPI_COMM_WORLD, lilac_init_data%mpicom_lilac, ierr) - call MPI_Comm_Dup(MPI_COMM_WORLD, lilac_init_data%mpicom_component, ierr) - call MPI_Comm_Dup(MPI_COMM_WORLD, lilac_init_data%mpicom_global_shared, ierr) - lilac_init_data%output_unit_lilac = 250 - lilac_init_data%output_unit_component = 251 - lilac_init_data%output_unit_global_shared = 252 - - lilac_init_data%component_name = MODEL_NAME_CTSM - - ! FIXME(bja, 2018-02) use namelist so the demo driver can serve as a test driver - lilac_clock_data%calendar_is_leap = .false. - lilac_clock_data%start_year = 2000 - lilac_clock_data%start_month = 1 - lilac_clock_data%start_day = 1 - lilac_clock_data%start_seconds = 0 - lilac_clock_data%stop_year = 2000 - lilac_clock_data%stop_month = 1 - lilac_clock_data%stop_day = 5 - lilac_clock_data%stop_seconds = 0 - lilac_clock_data%timestep_seconds = 3600 - - call lilac%Init(lilac_init_data, lilac_clock_data, debug) - - ! FIXME(bja, 2018-02) don't want to use the cdata structure, but we still - ! need to provide this information to the component?! - - !--- set mpicom and cdata memory - cdata%name = 'cdata_lilac' - cdata%ID = ID_lilac - cdata%mpicom = mpicom_lilac - cdata%dom => dom_lnd - cdata%gsmap => gsmap_lnd - cdata%infodata => infodata - - !--- set case information - case_name = 'lilac' - case_desc = 'lilac with clm' - model_version = 'lilac-v0.1' - hostname = 'undefined' - username = 'undefined' - start_type = 'startup' - brnch_retain_casename = .true. - single_column = .false. - scmlat = 0.0 - scmlon = 0.0 - atm_aero = .true. - call seq_infodata_putData(infodata, case_name=case_name, & - case_desc=case_desc, single_column=single_column, & - scmlat=scmlat, scmlon=scmlon, & - brnch_retain_casename=brnch_retain_casename, & - start_type=start_type, model_version=model_version, & - hostname=hostname, username=username, & - atm_aero=atm_aero ) - - !---------------------------------------------- - !--- lnd_init --- - !---------------------------------------------- - - !---------------------------------------------- - !--- atm and atm/lnd coupling init --- - !---------------------------------------------- - - !---------------------------------------------- - !--- Time Loop --- - !---------------------------------------------- - - call ESMF_ClockGet(driver_clock, currTime=driver_current_time, rc=rc) - do while (driver_current_time < driver_stop_time) - call ESMF_ClockAdvance(driver_clock, rc=rc) - call ESMF_ClockGet(driver_clock, currTime=driver_current_time, rc=rc) - call ESMF_TimeGet(driver_current_time, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,'lilac demo driver ymds=', yy, mm, dd, sec - call shr_sys_flush(iunit) - - ! can manually override the alarms as needed - call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) - if (mod(dd, 5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest, rc) - - ! set the coupling data that is sent to the land model, this is on atm decomp - ! this is just sample test data - x2l_a%rAttr(:,:) = 0.0 - x2l_a%rAttr(idx_Sa_z ,:) = 30.0 ! m - x2l_a%rAttr(idx_Sa_u ,:) = 0.0 ! m/s - x2l_a%rAttr(idx_Sa_v ,:) = 0.0 ! m/s - x2l_a%rAttr(idx_Sa_tbot ,:) = 280.0 ! degK - x2l_a%rAttr(idx_Sa_ptem ,:) = 280.0 ! degK - x2l_a%rAttr(idx_Sa_shum ,:) = 0.0004 ! kg/kg - x2l_a%rAttr(idx_Sa_pbot ,:) = 100100.0 ! Pa - x2l_a%rAttr(idx_Faxa_rainc,:) = 4.0e-8 ! kg/m2s - x2l_a%rAttr(idx_Faxa_rainl,:) = 3.0e-8 ! kg/m2s - x2l_a%rAttr(idx_Faxa_snowc,:) = 1.0e-8 ! kg/m2s - x2l_a%rAttr(idx_Faxa_snowl,:) = 2.0e-8 ! kg/m2s - x2l_a%rAttr(idx_Faxa_lwdn ,:) = 200.0 ! W/m2 - x2l_a%rAttr(idx_Faxa_swndr,:) = 100.0 ! W/m2 - x2l_a%rAttr(idx_Faxa_swvdr,:) = 90.0 ! W/m2 - x2l_a%rAttr(idx_Faxa_swndf,:) = 20.0 ! W/m2 - x2l_a%rAttr(idx_Faxa_swvdf,:) = 40.0 ! W/m2 - - ! rearrange data to land decomposition - call mct_rearr_rearrange(x2l_a, x2l, rearr_atm2lnd) - - ! diagnose - write(iunit,*) subname,' x2l fields: ', yy, mm, dd, sec - ! call diag_avect(x2l_a, mpicom_lilac,'x2l_a') - call diag_avect(x2l, mpicom_lilac,'x2l') - - ! run clm - write(iunit,*) subname,' call lnd_run_mct', yy, mm, dd, sec - call lnd_run_mct(Eclock, cdata, x2l, l2x) - - ! rearrange data from land decomposition - call mct_rearr_rearrange(l2x, l2x_a, rearr_lnd2atm) - - ! diagnose - write(iunit,*) subname,' l2x fields: ', yy, mm, dd, sec - call diag_avect(l2x, mpicom_lilac,'l2x') - ! call diag_avect(l2x_a, mpicom_lilac,'l2x_a') - enddo - - lilac%Shutdown() - -contains - !====================================================================== - - SUBROUTINE diag_avect(av, mpicom, comment) - - use seq_infodata_mod - - implicit none - - ! !INPUT/OUTPUT PARAMETERS: - - type(mct_aVect) , intent(in) :: av - integer , intent(in) :: mpicom - character(len=*), intent(in) :: comment - - !--- local --- - integer :: n, k ! counters - integer :: npts, nptsg ! number of local/global pts in AV - integer :: kflds ! number of fields in AV - real*8, pointer :: sumbuf (:) ! sum buffer - real*8, pointer :: sumbufg(:) ! sum buffer reduced - integer :: iam ! pe number - type(mct_string) :: mstring ! mct char type - character(len=128):: itemc ! string converted to char - - !----- formats ----- - character(*), parameter :: subName = '(diag_avect) ' - - !---------------------------------------------------------------- - - npts = mct_aVect_lsize(AV) - kflds = mct_aVect_nRattr(AV) - allocate(sumbuf(kflds), sumbufg(kflds)) - - sumbuf = 0.0 - - do k = 1, kflds - do n = 1, npts - sumbuf(k) = sumbuf(k) + (AV%rAttr(k, n)) - enddo - enddo - - call MPI_REDUCE(sumbuf, sumbufg, kflds, MPI_REAL8, MPI_SUM, 0, mpicom, ierr) - call MPI_COMM_RANK(mpicom, iam, ierr) - - if (iam == 0) then - do k = 1, kflds - call mct_aVect_getRList(mstring, k, AV) - itemc = mct_string_toChar(mstring) - call mct_string_clean(mstring) - write(iunit, 101) trim(comment), k, sumbufg(k), trim(itemc) - enddo - call shr_sys_flush(iunit) - endif - - deallocate(sumbuf, sumbufg) - -101 format('comm_diag ', a, 1x, i3, es26.19, 1x, a) - - end subroutine diag_avect - - !====================================================================== - - subroutine setup_demo_driver_clocks() - - implicit none - - - - end subroutine setup_demo_driver_clocks - -end program lilac_demo_driver - diff --git a/lilac/src/lilac.F90 b/lilac/src/lilac.F90 deleted file mode 100644 index 9f89e97d9f..0000000000 --- a/lilac/src/lilac.F90 +++ /dev/null @@ -1,399 +0,0 @@ -module lilac - ! - ! Public interface to lilac - ! - - implicit none - - private - - integer, parameter :: LILAC_MASTER_PROC = 0 - integer, parameter :: LILAC_NUM_COMPONENTS = 1 - - type, public :: lilac_t - private - character(len=STRING_32) :: component_name - logical :: debug - - integer :: mpicom_lilac - integer :: my_mpi_rank_lilac - integer :: num_mpi_tasks_lilac - integer :: mct_comp_id - - type(ESMF_Clock) :: lilac_clock - type(ESMF_Time) :: start_time - type(ESMF_Time) :: stop_time - type(ESMF_TimeInterval) :: time_step - type(ESMF_Alarm) :: alarm_stop - type(ESMF_Alarm) :: alarm_restart - - contains - ! Public API - procedure, public :: Init => lilac_init - procedure, public :: Shutdown => lilac_shutdown - procudure, public :: AdvanceTime => lilac_advance_time - - ! private initialization routines - procedure, private :: lilac_init_parallel - procedure, private :: lilac_init_logging - procedure, private :: lilac_init_io - procedure, private :: lilac_init_clocks - procedure, private :: lilac_init_fields - procedure, private :: lilac_init_orbit - procedure, private :: lilac_init_land - procedure, private :: lilac_init_coupling - - ! private shudown routines - procedure, private :: lilac_shutdown_land - procedure, private :: lilac_shutdown_parallel - - end type lilac_t - - - -contains - - ! - ! Public API - ! - subroutine lilac_init(this, init_data, clock_data, debug) - - use lilac_api_types, only : lilac_clock_data_t - use mct_mod, only : mct_world_init - - implicit none - - class(lilac_t), intent(inout) :: this - type(lilac_init_data_t), intent(in) :: init_data - type(lilac_clock_data_t), intent(in) :: clock_data - logical, intent(in) :: debug - - this%debug = debug - this%component_name = init_data%component_name - - call this%lilac_init_parallel(init_data%mpicom_lilac, & - init_data%mpicom_component, init_data%mpicom_global_shared) - - call this%lilac_init_logging(init_data%output_unit_lilac, init_data%output_unit_component) - call this%lilac_init_io() - call this%lilac_init_clocks(clock_data) - ! TODO(bja, 2018-03) use init_data%component_name to do some model - ! specific setup, including getting a list of hard coded input and output - ! exchange fields. - call this%lilac_init_fields() - call this%lilac_init_orbit() - call this%lilac_init_land() - call this%lilac_init_coupling() - - end subroutine lilac_init - - subroutine lilac_advance_time(this) - - implicit none - - class(lilac_t), intent(inout) :: this - - end subroutine lilac_advance_time - - subroutine lilac_shutdown(this) - - implicit none - - class(lilac_t), intent(inout) :: this - - if (this%my_mpi_rank_lilac == LILAC_MASTER_PROC) then - write(this%output_unit, *) 'Shutting down lilac interface for component ', this%component_name, ' ...' - end if - - call shr_sys_flush(this%output_unit) - - call this%lilac_shutdown_land() - call this%lilac_shutdown_parallel() - - if (this%my_mpi_rank_lilac == LILAC_MASTER_PROC) then - write(this%output_unit, *) 'lilac shut down for component ', this%component_name, ' complete.' - end if - - end subroutine lilac_shutdown - - ! - ! Private work functions - ! - subroutine lilac_init_parallel(this, mpicom_lilac, mpicom_component, mpicom_global_shared) - ! Initialize parallel components, e.g. MPI, MCT - - implicit none - - class(lilac_t), intent(inout) :: this - - ! should be safe if previously initialized - call MPI_Init(ierr) - - this%mpicom_lilac = mpicom_lilac - this%mpicom_component = mpicom_component - - call MPI_COMM_RANK(this%mpicom_lilac, this%my_lilac_mpi_rank, ierr) - call MPI_COMM_SIZE(this%mpicom_lilac, this%num_lilac_mpi_tasks, ierr) - - ! FIXME(bja, 2018-03) 1 (component | lilac) or two (component & lilac)? - this%mct_num_comps = 1 - this%mct_comp_id = 1 - ! NOTE(bja, 2018-02) MPI_COMM_WORLD should eventually be initialized on - ! the union of the lilac and component communicators! If 2, then need arrays?! - call mct_world_init(this%mct_num_comps, MPI_COMM_WORLD, this%mpicom_lilac, this%mct_comp_id) - - end subroutine lilac_init_parallel - - subroutine lilac_init_logging(this, output_unit_lilac, output_unit_global_shared) - - implicit none - - class(lilac_t), intent(inout) :: this - - character(len=*), parameter :: subname = 'lilac_init_logging' - ! open logfile for lilac - - this%output_unit = output_unit_lilac - - ! FIXME(bja, 2018-03) do we want a single shared log file, or one per rank? - write(log_file_name,'(a,i4.4)') 'lilac.log.', this%my_mpi_rank_lilac - open(this%output_unit, file=trim(log_file_name)) - if (this%my_mpi_rank_lilac == LILAC_MASTER_PROC) then - write(this%output_unit, *) subname, ': Starting lilac interface for component: ', this%component_name - write(this%output_unit, *) subname, ': num lilac tasks = ', this%num_mpi_tasks_lilac - write(this%output_unit, *) subname, ': my mpi rank = ', this%my_mpi_rank_lilac - write(this%output_unit, *) subname, ': mct component ID = ', this%mct_comp_id_lilac - call shr_sys_flush(this%output_unit) - end if - - ! NOTE(bja, 2018-02) these are setting global variables within the shr code! - call shr_file_setLogUnit(output_unit_global_shared) - call shr_file_setLogLevel(1) - - end subroutine lilac_init_logging - - subroutine lilac_init_io(this) - ! NOTE(bja, 2018-02) There is only a *single science component* in each - ! lilac instance. For now assuming just the science component interacts - ! with pio, but lilac may have some parallel data I/O needs. If so it - ! needs to be added to these data structures! - - implicit none - - class(lilac_t), intent(inout) :: this - - ! - call shr_pio_init1(LILAC_NUM_COMPONENTS, 'pio_in', this%mpicom_lilac) - allocate( & - comp_id(LILAC_NUM_COMPONENTS), & - comp_name(LILAC_NUM_COMPONENTS), & - comp_iamin(LILAC_NUM_COMPONENTS), & - comp_comm(LILAC_NUM_COMPONENTS), & - comp_comm_iam(LILAC_NUM_COMPONENTS)) - - index = 1 - comp_id(index) = 1 - comp_name(index) = MODEL_NAME_LILAC // '_' // trim(this%component_name) - comp_iamin(index) = .true. - comp_comm(index) = this%mpicom_lilac - comp_comm_iam(index) = this%my_mpi_rank_lilac - - ! TODO(bja, 2018-03) Never have more than one science component, remove loop? - do n = 1, LILAC_NUM_COMPONENTS - index = index + n - comp_id(index) = ID_component - comp_name(index) = this%component_name - comp_iamin(index) = .true. - comp_comm(index) = this%mpicom_component - comp_comm_iam(index) = mytask ! FIXME(bja, 2018-02) when land and lilac are on different comms?? - enddo - - call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) - - deallocate(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) - - end subroutine lilac_init_io - - subroutine lilac_init_clocks(this, clock_data) - - use ESMF - - implicit none - - class(lilac_t), intent(inout) :: this - type(lilac_clock_data_t), intent(in) :: clock_data - - type(ESMF_Calendar), target :: calendar ! FIXME(bja, 2018-02) does not need to be freed?! - integer :: cal_kind_flag - integer :: year, month, day, sec - - if (clock_data%calendar_is_leap == .false.) then - cal_kind_flag = ESMF_CALKIND_NOLEAP - else - ! FIXME(bja, 2018-03) not implemented error! ESMF_CALKIND_GREGORIAN? - end if - - if (ESMF_IsInitialized() /= .true.) then - ! NOTE(bja, 2018-03) allocates and operates on global data! - call ESMF_Initialize(rc=rc) - end if - - calendar = ESMF_CalendarCreate( name='lilac', calkindflag=cal_kind_flag, rc=rc ) - call ESMF_TimeSet(this%start_time, yy=clock_data%start_year, mm=clock_data%start_month, & - dd=clock_data%start_day, s=clock_data%start_seconds, calendar=calendar, rc=rc) - - call ESMF_TimeSet(this%stop_time , yy=clock_data%stop_year, mm=clock_data%stop_month, & - dd=clock_data%stop_day, s=clock_data%stop_seconds, calendar=calendar, rc=rc) - - call ESMF_TimeIntervalSet(this%time_step, s=clock_data%time_step_seconds, rc=rc) - - this%lilac_clock = ESMF_ClockCreate(name='lilac_clock', & - TimeStep=this%time_step, startTime=this%start_time, & - RefTime=this%start_time, stopTime=this%stop_time, rc=rc) - - this%alarm_stop = ESMF_AlarmCreate(name='alarm_stop' , & - clock=this%lilac_clock, ringTime=this%stop_time, rc=rc) - this%alarm_rest = ESMF_AlarmCreate(name='alarm_restart', & - clock=this%lilac_clock, ringTime=this%stop_time, rc=rc) - - if (this%debug .and. this%my_mpi_rank_lilac == LILAC_MASTER_PROC) then - call ESMF_TimeGet( start_time, yy=year, mm=month, dd=day, s=sec, rc=rc ) - write(this%output_unit, '(1x,2a,4i6)') subname,': start time ymds=', year, month, day, sec - call ESMF_TimeGet( stop_time, yy=year, mm=month, dd=day, s=sec, rc=rc ) - write(this%output_unit, '(1x,2a,4i6)') subname,': stop time ymds=', year, month, day, sec - call shr_sys_flush(this%output_unit) - end if - - end subroutine lilac_init_clocks - - subroutine lilac_init_fields(this) - ! Set coupling fields. - - implicit none - - class(lilac_t), intent(inout) :: this - - ! FIXME(bja, 2018-02) this should be dynamically created at runtime - ! instead of hard coded! - - seq_flds_dom_coord='lat:lon' - seq_flds_dom_other='area:aream:mask:frac' - seq_flds_dom_fields=trim(seq_flds_dom_coord)//':'//trim(seq_flds_dom_other) - - seq_flds_x2l_states= 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_pbot:Sg_icemask:Sg_icemask_coupled_fluxes' - seq_flds_x2l_fluxes= 'Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_lwdn:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Faxa_bcphidry:Faxa_bcphodry:Faxa_bcphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_ocphiwet:Faxa_dstwet1:Faxa_dstwet2:Faxa_dstwet3:Faxa_dstwet4:Faxa_dstdry1:Faxa_dstdry2:Faxa_dstdry3:Faxa_dstdry4:Flrr_flood:Flrr_volr' - seq_flds_x2l_fields= trim(seq_flds_x2l_states)//':'//trim(seq_flds_x2l_fluxes) - - seq_flds_l2x_states= 'Sl_avsdr:Sl_anidr:Sl_avsdf:Sl_anidf:Sl_tref:Sl_qref:Sl_t:Sl_fv:Sl_ram1:Sl_snowh:Sl_u10' - seq_flds_l2x_fluxes= 'Fall_swnet:Fall_taux:Fall_tauy:Fall_lat:Fall_sen:Fall_lwup:Fall_evap:Fall_flxdst1:Fall_flxdst2:Fall_flxdst3:Fall_flxdst4:Flrl_rofl:Flrl_rofi:Fall_voc001:Fall_voc002:Fall_voc003:Fall_voc004:Fall_voc005:Fall_voc006:Fall_voc007:Fall_voc008' - seq_flds_l2x_fields= trim(seq_flds_l2x_states)//':'//trim(seq_flds_l2x_fluxes) - - - end subroutine lilac_init_fields - - subroutine lilac_init_orbit(this) - - implicit none - - class(lilac_t), intent(inout) :: this - - !--- set orbital params - orb_iyear = 1990 - call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & - orb_obliqr, orb_lambm0, orb_mvelpp, .true.) - call seq_infodata_putData(infodata, orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, & - orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr ) - - - end subroutine lilac_init_orbit - - subroutine lilac_init_land(this) - - implicit none - - write(this%output_unit,*) subname,' calling lnd_init_mct' - call shr_sys_flush(this%output_unit) - call lnd_init_mct(Eclock, cdata, x2l, l2x) - - call diag_avect(l2x, mpicom_lilac,'l2x_init') - - idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') - idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') - idx_Sa_v = mct_avect_indexra(x2l,'Sa_v') - idx_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') - idx_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') - idx_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') - idx_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') - idx_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') - idx_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') - idx_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') - idx_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') - idx_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') - idx_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') - idx_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') - idx_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') - idx_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') - - end subroutine lilac_init_land - - subroutine lilac_init_coupling(this) - - implicit none - - class(lilac_t), intent(inout) :: this - - ! set atm grid size to land grid size in this example. for a real - ! atmosphere model, the atm and land grids should agree at the outset. - call seq_infodata_getData(infodata, lnd_nx=atm_nx, lnd_ny=atm_ny) - - ! atm decomp - gstart = ((mytask * atm_nx * atm_ny) / ntasks) + 1 - gend = (((mytask+1) * atm_nx * atm_ny) / ntasks) - lsize = gend - gstart + 1 - gsize = atm_nx * atm_ny - allocate(gindex(lsize)) - do n = gstart, gend - m = n-gstart+1 - gindex(m) = n - end do - write(this%output_unit,'(1x,2a,5i8)') subname,' atm decomp = ', mytask, gsize, lsize, gstart, gend - - ! initialize land grid on atm decomp - call mct_gsMap_init(gsmap_atm, gindex, mpicom_lilac, ID_lilac, lsize, gsize) - deallocate(gindex) - - ! initialize rearrangers between atm and land decomps - call mct_rearr_init(gsmap_atm, gsmap_lnd, mpicom_lilac, rearr_atm2lnd) - call mct_rearr_init(gsmap_lnd, gsmap_atm, mpicom_lilac, rearr_lnd2atm) - - ! initialize atm avects from land avects with atm lsize - call mct_avect_init(x2l_a, x2l, lsize) - call mct_avect_zero(x2l_a) - call mct_avect_init(l2x_a, l2x, lsize) - call mct_avect_zero(l2x_a) - - end subroutine lilac_init_coupling - - subroutine lilac_shutdown_land(this) - - implicit none - - class(lilac_t), intent(inout) :: this - - write(this%output_unit, *) 'lilac shutting down component ', this%comp_name - call lnd_final_mct(Eclock, cdata, x2l, l2x) - - end subroutine lilac_shutdown_land - - subroutine lilac_shutdown_parallel(this) - - implicit none - - class(lilac_t), intent(inout) :: this - - ! FIXME(bja, 2018-02) need to determine if it is our responsibility to shutdown mpi or the caller!? - ! call MPI_Finalize(ierr) - - end subroutine lilac_shutdown_parallel - -end module lilac diff --git a/lilac/src/lilac_api_types.F90 b/lilac/src/lilac_api_types.F90 deleted file mode 100644 index da66aefe04..0000000000 --- a/lilac/src/lilac_api_types.F90 +++ /dev/null @@ -1,43 +0,0 @@ -module lilac_api_types - - implicit none - - use lilac_constants, only : STRING_128 - -contains - - type :: lilac_init_data_t - character(len=STRING_32) :: component_name - integer :: mpicom_lilac - integer :: mpicom_component - integer :: output_unit_lilac - integer :: output_unit_global_shared ! this should be the same for all instances of lilac! - integer :: output_unit_component - - end type lilac_init_data_t - - type :: lilac_clock_data_t - logical :: calendar_is_leap - integer :: start_year - integer :: start_month - integer :: start_day - integer :: start_second ! seconds since midnight - - integer :: stop_year - integer :: stop_month - integer :: stop_day - integer :: stop_second ! seconds since midnight - - integer :: time_step_seconds - end type lilac_clock_data_t - - - type :: lilac_exchange_fields_t - character(len=STRING_128) :: long_name - character(len=STRING_128) :: short_name - character(len=STRING_128) :: field_name - character(len=STRING_128) :: units - integer :: field_type - end type lilac_exchange_fields_t - -end module lilac_api_types diff --git a/lilac/src/lilac_constants.F90 b/lilac/src/lilac_constants.F90 deleted file mode 100644 index d9e6442206..0000000000 --- a/lilac/src/lilac_constants.F90 +++ /dev/null @@ -1,18 +0,0 @@ -module lilac_constants - - implicit none - -contains - - integer, parameter :: STRING_128 = 128 - integer, parameter :: STRING_32 = 32 - - integer, parameter :: FIELD_TYPE_INTEGER = 0 - integer, parameter :: FIELD_TYPE_REAL_8BYTE = 1 - - ! known models names - character(len=*), parameter :: MODEL_NAME_LILAC = 'lilac' - character(len=*), parameter :: MODEL_NAME_CTSM = 'ctsm' - character(len=*), parameter :: MODEL_NAME_TEST = 'test' - -end module lilac_constants diff --git a/lilac/src/stub_comp_mct.F90 b/lilac/src/stub_comp_mct.F90 deleted file mode 100644 index de792d6c58..0000000000 --- a/lilac/src/stub_comp_mct.F90 +++ /dev/null @@ -1,8 +0,0 @@ -module stub_comp_mct - - implicit none - -contains - - -end module stub_comp_mct From 702363f681b695057c92c7a1aff98c8c73ce3df5 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Mon, 10 Sep 2018 12:21:03 -0700 Subject: [PATCH 034/556] move to dockerfile, builds deps and should run on travis now --- external/esmf | 2 +- lilac/.dockerignore | 328 +++++++++++++++++++++++++++++++++++++ lilac/.travis.yml | 28 +--- lilac/Dockerfile | 19 +++ lilac/ci/environment.yml | 6 +- lilac/ci/install_esmf.sh | 10 +- lilac/ci/install_pfunit.sh | 9 +- lilac/ci/install_python.sh | 11 +- 8 files changed, 366 insertions(+), 47 deletions(-) create mode 100644 lilac/.dockerignore create mode 100644 lilac/Dockerfile diff --git a/external/esmf b/external/esmf index d2761c276d..3a9c142262 160000 --- a/external/esmf +++ b/external/esmf @@ -1 +1 @@ -Subproject commit d2761c276daf2ccac33193f28e925e974d180309 +Subproject commit 3a9c142262b247189abd8dbca0d63e6dbb3a8207 diff --git a/lilac/.dockerignore b/lilac/.dockerignore new file mode 100644 index 0000000000..96c67bd53f --- /dev/null +++ b/lilac/.dockerignore @@ -0,0 +1,328 @@ +# Created by .ignore support plugin (hsz.mobi) + +### Vim template +# swap +[._]*.s[a-w][a-z] +[._]s[a-w][a-z] +# session +Session.vim +# temporary +.netrwhist +*~ + +# auto-generated tag files +tags + +### Cpp template +# Compiled Object files +*.slo +*.lo +*.o +*.obj + +# Precompiled Headers +*.gch +*.pch + +# Compiled Dynamic libraries +*.so +*.dylib +*.dll + +# Fortran module files +*.mod +*.smod + +# Compiled Static libraries +*.lai +*.la +*.a +*.lib + +# Executables +*.exe +*.out +*.app + +### CMake template +CMakeCache.txt +CMakeFiles +CMakeScripts +Makefile +cmake_install.cmake +install_manifest.txt +CTestTestfile.cmake + +### Emacs template +# -*- mode: gitignore; -*- +*~ +\#*\# +/.emacs.desktop +/.emacs.desktop.lock +*.elc +auto-save-list +tramp +.\#* + +# Org-mode +.org-id-locations +*_archive + +# flymake-mode +*_flymake.* + +# eshell files +/eshell/history +/eshell/lastdir + +# elpa packages +/elpa/ + +# reftex files +*.rel + +# AUCTeX auto folder +/auto/ + +# cask packages +.cask/ +dist/ + +# Flycheck +flycheck_*.el + +# server auth directory +/server/ + +# projectiles files +.projectile### VirtualEnv template +# Virtualenv +# http://iamzed.com/2009/05/07/a-primer-on-virtualenv/ +.Python +[Bb]in +[Ii]nclude +[Ll]ib +[Ll]ib64 +[Ll]ocal +[Ss]cripts +pyvenv.cfg +.venv +pip-selfcheck.json + +### Linux template +*~ + +# temporary files which can be created if a process still has a handle open of a deleted file +.fuse_hidden* + +# KDE directory preferences +.directory + +# Linux trash folder which might appear on any partition or disk +.Trash-* + +### C template +# Object files +*.o +*.ko +*.obj +*.elf + +# Precompiled Headers +*.gch +*.pch + +# Libraries +*.lib +*.a +*.la +*.lo + +# Shared objects (inc. Windows DLLs) +*.dll +*.so +*.so.* +*.dylib + +# Executables +*.exe +*.out +*.app +*.i*86 +*.x86_64 +*.hex + +# Debug files +*.dSYM/ +*.su + +### Windows template +# Windows image file caches +Thumbs.db +ehthumbs.db + +# Folder config file +Desktop.ini + +# Recycle Bin used on file shares +$RECYCLE.BIN/ + +# Windows Installer files +*.cab +*.msi +*.msm +*.msp + +# Windows shortcuts +*.lnk + +### KDevelop4 template +*.kdev4 +.kdev4/ + +### Python template +# Byte-compiled / optimized / DLL files +__pycache__/ +*.py[cod] +*$py.class + +# C extensions +*.so + +# Distribution / packaging +.Python +env/ +build/ +develop-eggs/ +dist/ +downloads/ +eggs/ +.eggs/ +lib/ +lib64/ +parts/ +sdist/ +var/ +*.egg-info/ +.installed.cfg +*.egg + +# PyInstaller +# Usually these files are written by a python script from a template +# before PyInstaller builds the exe, so as to inject date/other infos into it. +*.manifest +*.spec + +# Installer logs +pip-log.txt +pip-delete-this-directory.txt + +# Unit test / coverage reports +htmlcov/ +.tox/ +.coverage +.coverage.* +.cache +nosetests.xml +coverage.xml +*,cover +.hypothesis/ + +# Translations +*.mo +*.pot + +# Django stuff: +*.log +local_settings.py + +# Flask stuff: +instance/ +.webassets-cache + +# Scrapy stuff: +.scrapy + +# Sphinx documentation +docs/_build/ + +# PyBuilder +target/ + +# IPython Notebook +.ipynb_checkpoints + +# pyenv +.python-version + +# celery beat schedule file +celerybeat-schedule + +# dotenv +.env + +# virtualenv +venv/ +ENV/ + +# Spyder project settings +.spyderproject + +# Rope project settings +.ropeproject + +### Xcode template +# Xcode +# +# gitignore contributors: remember to update Global/Xcode.gitignore, Objective-C.gitignore & Swift.gitignore + +## Build generated +build/ +DerivedData/ + +## Various settings +*.pbxuser +!default.pbxuser +*.mode1v3 +!default.mode1v3 +*.mode2v3 +!default.mode2v3 +*.perspectivev3 +!default.perspectivev3 +xcuserdata/ + +## Other +*.moved-aside +*.xccheckout +*.xcscmblueprint + +### NodeJS template +# Logs +logs +*.log +npm-debug.log* + +# Runtime data +pids +*.pid +*.seed + +# Directory for instrumented libs generated by jscoverage/JSCover +lib-cov + +# Coverage directory used by tools like istanbul +coverage + +# Grunt intermediate storage (http://gruntjs.com/creating-plugins#storing-task-files) +.grunt + +# node-waf configuration +.lock-wscript + +# Compiled binary addons (http://nodejs.org/api/addons.html) +build/Release + +# Dependency directory +# https://docs.npmjs.com/misc/faq#should-i-check-my-node-modules-folder-into-git +node_modules + diff --git a/lilac/.travis.yml b/lilac/.travis.yml index e3a280e1b9..5f8d66aede 100644 --- a/lilac/.travis.yml +++ b/lilac/.travis.yml @@ -1,34 +1,20 @@ language: cpp -sudo: false +sudo: required dist: trusty notifications: email: false -matrix: - include: - - os: linux - compiler: gcc - apt: - packages: - - gfortran - - cmake - - cmake-data +services: + - docker before_install: - - export FC=/usr/bin/gfortran - - ./ci/install_python.sh - - ./ci/install_esmf.sh - - ./ci/install_pfunit.sh + - docker version install: - - cd ${TRAVIS_BUILD_DIR} - - mkdir -p build && cd build - - cmake .. - - make + - docker build -t lilac . before_script: - - echo "before script" + - docker images script: - - cd ${TRAVIS_BUILD_DIR} - - ./build/prog + - docker run -t lilac diff --git a/lilac/Dockerfile b/lilac/Dockerfile new file mode 100644 index 0000000000..ae9bd09913 --- /dev/null +++ b/lilac/Dockerfile @@ -0,0 +1,19 @@ +FROM centos:latest +LABEL description="LILAC development environment" + + +RUN yum install -y curl; yum upgrade -y; yum update -y; yum clean all +RUN yum -y install wget bzip2 gcc gcc-c++ gcc-gfortran mpich make + +ADD ./ /usr/src/lilac +RUN cd /usr/src/lilac && mkdir -p build + +WORKDIR /usr/src/lilac +ENV PATH /usr/local/miniconda/bin:$PATH +RUN /usr/src/lilac/ci/install_python.sh +RUN /usr/src/lilac/ci/install_esmf.sh +RUN /usr/src/lilac/ci/install_pfunit.sh + +# RUN mkdir -p /usr/src/lilac/build && cd /usr/src/lilac/build && cmake .. + +CMD /bin/bash -c "ctest" diff --git a/lilac/ci/environment.yml b/lilac/ci/environment.yml index 0d0d6a023d..735c333293 100644 --- a/lilac/ci/environment.yml +++ b/lilac/ci/environment.yml @@ -2,8 +2,4 @@ channels: - conda-forge dependencies: - python=3.6 - - xarray - - esmpy - - cmake - - pip: - - cpp-coveralls + - cmake>=3 diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh index fef18a466f..95c89cef7e 100755 --- a/lilac/ci/install_esmf.sh +++ b/lilac/ci/install_esmf.sh @@ -2,17 +2,15 @@ set -e set -x -cd ${HOME} +cd external/esmf -export FC="/usr/bin/gfortran" -export ESMF_COMPILER="/usr/bin/gfortran" +export FC="gfortran" +export ESMF_COMPILER="gfortran" -git clone https://git.code.sf.net/p/esmf/esmf deps/esmf -cd deps/esmf export ESMF_DIR=$PWD export ESMF_INSTALL_PREFIX=/usr/ make -j4 lib make install export ESMFMKFILE=${ESMF_INSTALL_PREFIX}/esmf.mk -cd ${TRAVIS_BUILD_DIR} +cd - \ No newline at end of file diff --git a/lilac/ci/install_pfunit.sh b/lilac/ci/install_pfunit.sh index 84b5918c12..9a2aff43e3 100755 --- a/lilac/ci/install_pfunit.sh +++ b/lilac/ci/install_pfunit.sh @@ -3,18 +3,15 @@ set -e set -x -cd ${HOME} - -git clone https://github.com/Goddard-Fortran-Ecosystem/pFUnit.git ${HOME}/deps/pfunit -cd deps/pfunit +cd external/pfunit # set environemnt variables export F90=gfortran export F90_VENDOR=GNU -mkdir build +mkdir -p build cd build cmake .. make install INSTALL_DIR=/usr -cd ${TRAVIS_BUILD_DIR} +cd - diff --git a/lilac/ci/install_python.sh b/lilac/ci/install_python.sh index 2a2d2a551f..02a15e043c 100755 --- a/lilac/ci/install_python.sh +++ b/lilac/ci/install_python.sh @@ -4,16 +4,11 @@ set -e set -x # Install miniconda -wget http://repo.continuum.io/miniconda/Miniconda3-latest-Linux-x86_64.sh -O ${HOME}/miniconda.sh -bash ~/miniconda.sh -b -p $HOME/miniconda -export PATH="$HOME/miniconda/bin:$PATH" +wget --quiet http://repo.continuum.io/miniconda/Miniconda3-latest-Linux-x86_64.sh -O /usr/src/miniconda.sh +bash /usr/src/miniconda.sh -b -p /usr/local/miniconda conda update conda --yes conda clean -tipy conda config --set always_yes yes --set changeps1 no conda --version -conda env create -f ci/environment.yml --name lilac - -source activate lilac - -cd ${TRAVIS_BUILD_DIR} +conda install -c conda-forge cmake>=3 From 69f6b3e7eda97279e85df9182d8c8ec6b738844a Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Mon, 10 Sep 2018 17:35:12 -0700 Subject: [PATCH 035/556] cleanup and move to docker-compose --- lilac/.dockerignore | 1 + lilac/.gitignore | 2 + lilac/.travis.yml | 5 +- lilac/CMakeLists.txt | 78 ++----------------- lilac/Dockerfile | 30 ++++--- lilac/ci/build_and_test_lilac.sh | 16 ++++ lilac/ci/install_esmf.sh | 6 +- lilac/ci/install_pfunit.sh | 4 +- .../{Modules => CMakeModules}/FindESMF.cmake | 29 +++---- lilac/docker-compose.yml | 10 +++ 10 files changed, 78 insertions(+), 103 deletions(-) create mode 100755 lilac/ci/build_and_test_lilac.sh rename lilac/cmake/{Modules => CMakeModules}/FindESMF.cmake (74%) create mode 100644 lilac/docker-compose.yml diff --git a/lilac/.dockerignore b/lilac/.dockerignore index 96c67bd53f..2fc5d54e03 100644 --- a/lilac/.dockerignore +++ b/lilac/.dockerignore @@ -326,3 +326,4 @@ build/Release # https://docs.npmjs.com/misc/faq#should-i-check-my-node-modules-folder-into-git node_modules +build/ \ No newline at end of file diff --git a/lilac/.gitignore b/lilac/.gitignore index 411de5d96e..21537a4ee9 100644 --- a/lilac/.gitignore +++ b/lilac/.gitignore @@ -12,3 +12,5 @@ components/ # generated python files *.pyc + +build/ diff --git a/lilac/.travis.yml b/lilac/.travis.yml index 5f8d66aede..40f2c1981a 100644 --- a/lilac/.travis.yml +++ b/lilac/.travis.yml @@ -9,12 +9,13 @@ services: before_install: - docker version + - docker-compose version install: - - docker build -t lilac . + - docker-compose build lilac before_script: - - docker images + - docker-compose images script: - docker run -t lilac diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 56d348a737..9d94ba5afe 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -3,6 +3,10 @@ cmake_minimum_required(VERSION 2.8.12.1) project(LILAC Fortran) enable_language(Fortran) +set (CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") + +find_package (ESMF) + # Local CMake modules if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") @@ -21,78 +25,8 @@ endif() set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} ${bounds}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") -if(DEFINED PFUNIT_INSTALL) - message(STATUS "Manual setup of variable PFUNIT_INSTALL: ${PFUNIT_INSTALL}") - set(PFUNIT_DIR ${PFUNIT_INSTALL}) -else() - include(ExternalProject) - - set(ExternalProjectCMakeArgs - -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} - -DCMAKE_INSTALL_PREFIX=${PROJECT_BINARY_DIR}/external/pfunit - -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} - ) - ExternalProject_Add(pfunit - DOWNLOAD_COMMAND git submodule update - DOWNLOAD_DIR ${PROJECT_SOURCE_DIR} - SOURCE_DIR ${PROJECT_SOURCE_DIR}/external/pfunit - BINARY_DIR ${PROJECT_BINARY_DIR}/external/pfunit-build - STAMP_DIR ${PROJECT_BINARY_DIR}/external/pfunit-stamp - TMP_DIR ${PROJECT_BINARY_DIR}/external/pfunit-tmp - INSTALL_DIR ${PROJECT_BINARY_DIR}/external - CMAKE_ARGS ${ExternalProjectCMakeArgs} - ) - include_directories(${PROJECT_BINARY_DIR}/external/pfunit/mod) - set(PFUNIT_DIR ${PROJECT_BINARY_DIR}/external/pfunit) -endif() - - -if(DEFINED ESMF_INSTALL) - message(STATUS "Manual setup of variable ESMF_INSTALL: ${ESMF_INSTALL}") - set(ESMF_DIR ${ESMF_INSTALL}) - -else() - message(STATUS "We will build ESMF") - include(ExternalProject) - - # set(ENV{ESMFMKFILE} "${PROJECT_BINARY_DIR}/external/esmf/esmf.mk") - - set(ExternalProjectCMakeArgs - ESMF_DIR=${ESMF_DIR} - ESMF_INSTALL_PREFIX=${PROJECT_BINARY_DIR}/external - ESMF_INSTALL_BINDIR=${PROJECT_BINARY_DIR}/bin/ - ESMF_INSTALL_DOCDIR=${PROJECT_BINARY_DIR}/doc/ - ESMF_INSTALL_HEADERDIR=${PROJECT_BINARY_DIR}/include/ - ESMF_INSTALL_LIBDIR=${PROJECT_BINARY_DIR}/lib/ - ESMF_INSTALL_MODDIR=${PROJECT_BINARY_DIR}/mod/ - ) - - ExternalProject_Add(esmf - DOWNLOAD_COMMAND git submodule update - DOWNLOAD_DIR ${PROJECT_SOURCE_DIR}/external - SOURCE_DIR ${PROJECT_SOURCE_DIR}/external/esmf - INSTALL_DIR ${PROJECT_BINARY_DIR}/external - BUILD_IN_SOURCE TRUE - CMAKE_ARGS ${ExternalProjectCMakeArgs} - CONFIGURE_COMMAND "" - BUILD_COMMAND make - INSTALL_COMMAND pwd && make install - ) - - # link to ESMF - # find_package(ESMF) - # include_directories(${PROJECT_BINARY_DIR}/include/) - # set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}\ ${ESMF_COMPILER_LINE}") - # set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") - # TODO figure out how to get these out once ESMF is compiled - set(ESMF_COMPILER_LINE, "-O -m64 -mcmodel=small -ffree-line-length-none -fopenmp -I/Users/jhamman/Dropbox/src/lilac/external/esmf/mod/modO/Darwin.gfortran.64.mpiuni.default -I/Users/jhamman/Dropbox/src/lilac/external/esmf/src/include -ffree-form") - set(ESMF_LINK_LINE, "-m64 -mcmodel=small -fopenmp -L/Users/jhamman/Dropbox/src/lilac/external/esmf/lib/libO/Darwin.gfortran.64.mpiuni.default -L/opt/local/lib/gcc5/gcc/x86_64-apple-darwin17/5.5.0/../../../ -lesmf -lstdc++") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") - - - -endif() +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}\ ${ESMF_COMPILER_LINE}") +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") add_subdirectory(lilac) add_subdirectory(tests) diff --git a/lilac/Dockerfile b/lilac/Dockerfile index ae9bd09913..ef7b9610b0 100644 --- a/lilac/Dockerfile +++ b/lilac/Dockerfile @@ -1,19 +1,29 @@ FROM centos:latest LABEL description="LILAC development environment" - RUN yum install -y curl; yum upgrade -y; yum update -y; yum clean all -RUN yum -y install wget bzip2 gcc gcc-c++ gcc-gfortran mpich make +RUN yum -y install wget bzip2 gcc gcc-c++ gcc-gfortran mpich make git + +WORKDIR /usr/src/lilac/ + +RUN mkdir -p external +RUN mkdir -p ci -ADD ./ /usr/src/lilac -RUN cd /usr/src/lilac && mkdir -p build +COPY external/esmf external/esmf +COPY external/pfunit external/pfunit +COPY ci/* ci/ -WORKDIR /usr/src/lilac +# Install some remaining dependencies ENV PATH /usr/local/miniconda/bin:$PATH -RUN /usr/src/lilac/ci/install_python.sh -RUN /usr/src/lilac/ci/install_esmf.sh -RUN /usr/src/lilac/ci/install_pfunit.sh +RUN ./ci/install_python.sh -# RUN mkdir -p /usr/src/lilac/build && cd /usr/src/lilac/build && cmake .. +# Install ESMF +# TODO: what's up with the .../lib/lib0/... maybe move this somewhere more logical? +RUN pwd +RUN ls $PWD +RUN ./ci/install_esmf.sh +ENV ESMF_CONFIG_FILE /usr/lib/libO/Linux.gfortran.64.mpiuni.default/esmf.mk -CMD /bin/bash -c "ctest" +# # Install PFUNIT +RUN ./ci/install_pfunit.sh +ENV PFUNIT_INSTALL /usr/pfunit diff --git a/lilac/ci/build_and_test_lilac.sh b/lilac/ci/build_and_test_lilac.sh new file mode 100755 index 0000000000..ce8b993ae4 --- /dev/null +++ b/lilac/ci/build_and_test_lilac.sh @@ -0,0 +1,16 @@ +#!/usr/bin/env bash + +set -e +set -x + +echo "building lilac" + +# build lilac +mkdir -p /lilac/build +cd /lilac/build && cmake .. +make -j 4 + +echo "done building lilac, time to run the tests..." + +# run test suite +ctest \ No newline at end of file diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh index 95c89cef7e..d14f747771 100755 --- a/lilac/ci/install_esmf.sh +++ b/lilac/ci/install_esmf.sh @@ -2,15 +2,15 @@ set -e set -x -cd external/esmf +cd ./external/esmf export FC="gfortran" export ESMF_COMPILER="gfortran" export ESMF_DIR=$PWD -export ESMF_INSTALL_PREFIX=/usr/ +export ESMF_INSTALL_PREFIX=/usr make -j4 lib make install -export ESMFMKFILE=${ESMF_INSTALL_PREFIX}/esmf.mk +export ESMFMKFILE=/usr/lib/libO/Linux.gfortran.64.mpiuni.default/esmf.mk cd - \ No newline at end of file diff --git a/lilac/ci/install_pfunit.sh b/lilac/ci/install_pfunit.sh index 9a2aff43e3..9290ab7306 100755 --- a/lilac/ci/install_pfunit.sh +++ b/lilac/ci/install_pfunit.sh @@ -3,7 +3,7 @@ set -e set -x -cd external/pfunit +cd ./external/pfunit # set environemnt variables export F90=gfortran @@ -12,6 +12,6 @@ export F90_VENDOR=GNU mkdir -p build cd build cmake .. -make install INSTALL_DIR=/usr +make install INSTALL_DIR=/usr/pfunit cd - diff --git a/lilac/cmake/Modules/FindESMF.cmake b/lilac/cmake/CMakeModules/FindESMF.cmake similarity index 74% rename from lilac/cmake/Modules/FindESMF.cmake rename to lilac/cmake/CMakeModules/FindESMF.cmake index ba50c7a141..b8fb622ee8 100644 --- a/lilac/cmake/Modules/FindESMF.cmake +++ b/lilac/cmake/CMakeModules/FindESMF.cmake @@ -1,24 +1,24 @@ -# +# # Author: Ali Samii - The University of Texas at Austin # # Distributed under GPL2. For more info refer to: # https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html # -# +# # FindESMF # -------- -# +# # This script tries to find the ESMF library. You have to define # the path to esmf.mk file in your installation directory. # # There are plans to extend this script to find ESMF automatically, # but until then, you should set the environment variable # -# ESMFMKFILE = /path/to/esmf.mk +# ESMF_CONFIG_FILE = /path/to/esmf.mk # # in your installation directory. The output will be # -# ESMF_LINK_LINE : All the libraries and link line stuff +# ESMF_LINK_LINE : All the libraries and link line stuff # ESMF_COMPILER_LINE : All the compiler flags and include dirs # # @@ -27,28 +27,28 @@ string(ASCII 27 Esc) # Checking if ESMF exists -if (NOT DEFINED ENV{ESMFMKFILE} AND NOT DEFINED ESMFMKFILE) +if (NOT DEFINED ENV{ESMF_CONFIG_FILE} AND NOT DEFINED ESMF_CONFIG_FILE) message (FATAL_ERROR "\n${Esc}[1;31m!! Error: You need ESMF library to \ run this program. please set the environment \ - variable ESMFMKFILE to point to esmf.mk in \ + variable ESMF_CONFIG_FILE to point to esmf.mk in \ your ESMF installation directory. \ Try something like: ${Esc}[m\ - export ESMFMKFILE=/path/to/esmf.mk && cmake ${CMAKE_SOURCE_DIR}") + export ESMF_CONFIG_FILE=/path/to/esmf.mk && cmake ${CMAKE_SOURCE_DIR}") endif () -if (NOT EXISTS $ENV{ESMFMKFILE} AND NOT EXISTS ${ESMFMKFILE}) +if (NOT EXISTS $ENV{ESMF_CONFIG_FILE} AND NOT EXISTS ${ESMF_CONFIG_FILE}) message (FATAL_ERROR "${Esc}[1;31m Error: esmf.mk file is not found at \ - ${ESMFMKFILE} ${Esc}[m") + ${ESMF_CONFIG_FILE} ${Esc}[m") else () message ("+>${Esc}[1;32m The config file for ESMF library is found.${Esc}[m") endif () -if (DEFINED ENV{ESMFMKFILE}) - set(ESMFMKFILE $ENV{ESMFMKFILE} CACHE STRING "") +if (DEFINED ENV{ESMF_CONFIG_FILE}) + set(ESMF_CONFIG_FILE $ENV{ESMF_CONFIG_FILE} CACHE STRING "") endif () -set(ESMFMKFILE ${ESMFMKFILE} CACHE STRING "") +set(ESMF_CONFIG_FILE ${ESMF_CONFIG_FILE} CACHE STRING "") -file(STRINGS "${ESMFMKFILE}" all_vars) +file(STRINGS "${ESMF_CONFIG_FILE}" all_vars) foreach(str ${all_vars}) string(REGEX MATCH "^[^#]" def ${str}) if (def) @@ -68,3 +68,4 @@ set (ESMF_LINK_LINE "${ESMF_F90LINKOPTS} \ set (ESMF_COMPILER_LINE "${ESMF_F90COMPILEOPTS} \ ${ESMF_F90COMPILEPATHS} \ ${ESMF_F90COMPILEFREENOCPP}") + diff --git a/lilac/docker-compose.yml b/lilac/docker-compose.yml new file mode 100644 index 0000000000..422b0bc607 --- /dev/null +++ b/lilac/docker-compose.yml @@ -0,0 +1,10 @@ +version: '3' + +services: + lilac: + build: . + container_name: lilac + volumes: + - .:/lilac + command: /lilac/ci/build_and_test_lilac.sh + From bc96784d64dcf019e6ab09ecf26383dffeb80f74 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Mon, 10 Sep 2018 23:07:23 -0700 Subject: [PATCH 036/556] boiler plat docs --- lilac/docs/Makefile | 20 ++++++ lilac/docs/conf.py | 164 +++++++++++++++++++++++++++++++++++++++++++ lilac/docs/index.rst | 24 +++++++ 3 files changed, 208 insertions(+) create mode 100644 lilac/docs/Makefile create mode 100644 lilac/docs/conf.py create mode 100644 lilac/docs/index.rst diff --git a/lilac/docs/Makefile b/lilac/docs/Makefile new file mode 100644 index 0000000000..0e382f9883 --- /dev/null +++ b/lilac/docs/Makefile @@ -0,0 +1,20 @@ +# Minimal makefile for Sphinx documentation +# + +# You can set these variables from the command line. +SPHINXOPTS = +SPHINXBUILD = sphinx-build +SPHINXPROJ = lilac +SOURCEDIR = . +BUILDDIR = _build + +# Put it first so that "make" without argument is like "make help". +help: + @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) + +.PHONY: help Makefile + +# Catch-all target: route all unknown targets to Sphinx using the new +# "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). +%: Makefile + @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) \ No newline at end of file diff --git a/lilac/docs/conf.py b/lilac/docs/conf.py new file mode 100644 index 0000000000..767f7287b1 --- /dev/null +++ b/lilac/docs/conf.py @@ -0,0 +1,164 @@ +# -*- coding: utf-8 -*- +# +# Configuration file for the Sphinx documentation builder. +# +# This file does only contain a selection of the most common options. For a +# full list see the documentation: +# http://www.sphinx-doc.org/en/stable/config + +# -- Path setup -------------------------------------------------------------- + +# If extensions (or modules to document with autodoc) are in another directory, +# add these directories to sys.path here. If the directory is relative to the +# documentation root, use os.path.abspath to make it absolute, like shown here. +# +# import os +# import sys +# sys.path.insert(0, os.path.abspath('.')) + + +# -- Project information ----------------------------------------------------- + +project = 'lilac' +copyright = '2018, Joseph Hamman' +author = 'Joseph Hamman' + +# The short X.Y version +version = '' +# The full version, including alpha/beta/rc tags +release = '' + + +# -- General configuration --------------------------------------------------- + +# If your documentation needs a minimal Sphinx version, state it here. +# +# needs_sphinx = '1.0' + +# Add any Sphinx extension module names here, as strings. They can be +# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom +# ones. +extensions = [ + 'sphinx.ext.intersphinx', +] + +# Add any paths that contain templates here, relative to this directory. +templates_path = ['_templates'] + +# The suffix(es) of source filenames. +# You can specify multiple suffix as a list of string: +# +# source_suffix = ['.rst', '.md'] +source_suffix = '.rst' + +# The master toctree document. +master_doc = 'index' + +# The language for content autogenerated by Sphinx. Refer to documentation +# for a list of supported languages. +# +# This is also used if you do content translation via gettext catalogs. +# Usually you set "language" from the command line for these cases. +language = None + +# List of patterns, relative to source directory, that match files and +# directories to ignore when looking for source files. +# This pattern also affects html_static_path and html_extra_path . +exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store'] + +# The name of the Pygments (syntax highlighting) style to use. +pygments_style = 'sphinx' + + +# -- Options for HTML output ------------------------------------------------- + +# The theme to use for HTML and HTML Help pages. See the documentation for +# a list of builtin themes. +# +html_theme = 'alabaster' + +# Theme options are theme-specific and customize the look and feel of a theme +# further. For a list of options available for each theme, see the +# documentation. +# +# html_theme_options = {} + +# Add any paths that contain custom static files (such as style sheets) here, +# relative to this directory. They are copied after the builtin static files, +# so a file named "default.css" will overwrite the builtin "default.css". +html_static_path = ['_static'] + +# Custom sidebar templates, must be a dictionary that maps document names +# to template names. +# +# The default sidebars (for documents that don't match any pattern) are +# defined by theme itself. Builtin themes are using these templates by +# default: ``['localtoc.html', 'relations.html', 'sourcelink.html', +# 'searchbox.html']``. +# +# html_sidebars = {} + + +# -- Options for HTMLHelp output --------------------------------------------- + +# Output file base name for HTML help builder. +htmlhelp_basename = 'lilacdoc' + + +# -- Options for LaTeX output ------------------------------------------------ + +latex_elements = { + # The paper size ('letterpaper' or 'a4paper'). + # + # 'papersize': 'letterpaper', + + # The font size ('10pt', '11pt' or '12pt'). + # + # 'pointsize': '10pt', + + # Additional stuff for the LaTeX preamble. + # + # 'preamble': '', + + # Latex figure (float) alignment + # + # 'figure_align': 'htbp', +} + +# Grouping the document tree into LaTeX files. List of tuples +# (source start file, target name, title, +# author, documentclass [howto, manual, or own class]). +latex_documents = [ + (master_doc, 'lilac.tex', 'lilac Documentation', + 'Joseph Hamman', 'manual'), +] + + +# -- Options for manual page output ------------------------------------------ + +# One entry per manual page. List of tuples +# (source start file, name, description, authors, manual section). +man_pages = [ + (master_doc, 'lilac', 'lilac Documentation', + [author], 1) +] + + +# -- Options for Texinfo output ---------------------------------------------- + +# Grouping the document tree into Texinfo files. List of tuples +# (source start file, target name, title, author, +# dir menu entry, description, category) +texinfo_documents = [ + (master_doc, 'lilac', 'lilac Documentation', + author, 'lilac', 'One line description of project.', + 'Miscellaneous'), +] + + +# -- Extension configuration ------------------------------------------------- + +# -- Options for intersphinx extension --------------------------------------- + +# Example configuration for intersphinx: refer to the Python standard library. +intersphinx_mapping = {'https://docs.python.org/': None} \ No newline at end of file diff --git a/lilac/docs/index.rst b/lilac/docs/index.rst new file mode 100644 index 0000000000..4549b0c639 --- /dev/null +++ b/lilac/docs/index.rst @@ -0,0 +1,24 @@ +.. lilac documentation master file, created by + sphinx-quickstart on Mon Sep 10 22:59:54 2018. + You can adapt this file completely to your liking, but it should at least + contain the root `toctree` directive. + +Welcome to lilac's documentation! +================================= + +LILAC, Lightweight Infrastructure for Land Atmosphere Coupling. + +More coming soon. + +.. toctree:: + :maxdepth: 2 + :caption: Contents: + + + +Indices and tables +================== + +* :ref:`genindex` +* :ref:`modindex` +* :ref:`search` From ec59330c32844c10e8458c308802d8ccfca02d17 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Mon, 10 Sep 2018 23:08:25 -0700 Subject: [PATCH 037/556] add docs badge --- lilac/README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/lilac/README.md b/lilac/README.md index a817ad0649..b3315ab04a 100644 --- a/lilac/README.md +++ b/lilac/README.md @@ -3,6 +3,7 @@ LILAC, Lightweight Infrastructure for Land Atmosphere Coupling. [![Build Status](https://travis-ci.org/jhamman/lilac.svg?branch=master)](https://travis-ci.org/jhamman/lilac) +[![Documentation Status](https://readthedocs.org/projects/ctsm-lilac/badge/?version=latest)](https://ctsm-lilac.readthedocs.io/en/latest/?badge=latest) Currently working on: - Setting up CI and CMake From eba309c7136587ab0a42441f4676d10034736579 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Wed, 26 Sep 2018 12:55:09 -0700 Subject: [PATCH 038/556] more build and doc updates --- lilac/CMakeLists.txt | 10 +- lilac/Dockerfile | 2 +- lilac/ci/build_and_test_lilac.sh | 5 +- lilac/ci/code_format.sh | 11 + lilac/ci/emacs-fortran-formating-script.lisp | 46 +++ lilac/ci/install_esmf.sh | 15 +- lilac/cmake/CMakeModules/FindESMF.cmake | 6 +- lilac/docs/api.rst | 14 + lilac/docs/index.rst | 41 ++- lilac/lilac/atmos_comp.f90 | 39 --- lilac/lilac/coupler_mod.f90 | 326 ------------------- lilac/lilac/esmf_utils.f90 | 28 +- lilac/lilac/land_comp.f90 | 1 - lilac/lilac/lilac.f90 | 13 +- 14 files changed, 153 insertions(+), 404 deletions(-) create mode 100755 lilac/ci/code_format.sh create mode 100644 lilac/ci/emacs-fortran-formating-script.lisp create mode 100644 lilac/docs/api.rst delete mode 100644 lilac/lilac/atmos_comp.f90 delete mode 100644 lilac/lilac/coupler_mod.f90 delete mode 100644 lilac/lilac/land_comp.f90 diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 9d94ba5afe..8e7c0cf87a 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -3,9 +3,10 @@ cmake_minimum_required(VERSION 2.8.12.1) project(LILAC Fortran) enable_language(Fortran) -set (CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") +set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") -find_package (ESMF) +find_package(MPI REQUIRED) +find_package(ESMF REQUIRED) # Local CMake modules @@ -25,8 +26,11 @@ endif() set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} ${bounds}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}\ ${ESMF_COMPILER_LINE}") +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I /usr/include/ -I/usr/src/lilac/external/esmf/src/Infrastructure/Util/include") + +message("CMAKE_Fortran_FLAGS:" ${CMAKE_Fortran_FLAGS}) add_subdirectory(lilac) add_subdirectory(tests) diff --git a/lilac/Dockerfile b/lilac/Dockerfile index ef7b9610b0..c7b5923a04 100644 --- a/lilac/Dockerfile +++ b/lilac/Dockerfile @@ -2,7 +2,7 @@ FROM centos:latest LABEL description="LILAC development environment" RUN yum install -y curl; yum upgrade -y; yum update -y; yum clean all -RUN yum -y install wget bzip2 gcc gcc-c++ gcc-gfortran mpich make git +RUN yum -y install wget bzip2 gcc gcc-c++ gcc-gfortran mpich-devel make git WORKDIR /usr/src/lilac/ diff --git a/lilac/ci/build_and_test_lilac.sh b/lilac/ci/build_and_test_lilac.sh index ce8b993ae4..176478a5c6 100755 --- a/lilac/ci/build_and_test_lilac.sh +++ b/lilac/ci/build_and_test_lilac.sh @@ -7,8 +7,11 @@ echo "building lilac" # build lilac mkdir -p /lilac/build + +export CMAKE_PREFIX_PATH=/usr/lib64/mpich/bin + cd /lilac/build && cmake .. -make -j 4 +make # -j 4 echo "done building lilac, time to run the tests..." diff --git a/lilac/ci/code_format.sh b/lilac/ci/code_format.sh new file mode 100755 index 0000000000..828b0e229a --- /dev/null +++ b/lilac/ci/code_format.sh @@ -0,0 +1,11 @@ +#!/usr/bin/env bash + +# Run emacs/list on all Fortran source files +format_fortran () { + echo "Parsing $1 as language Fortran" + emacs --batch -l ./emacs-fortran-formating-script.lisp \ + -f f90-batch-indent-region $1 +} +export -f format_fortran +find ../lilac/ -iregex ".*\.F[0-9]*" -exec bash -c 'format_fortran "$0"' {} \; +find ../tests/ -iregex ".*\.F[0-9]*" -exec bash -c 'format_fortran "$0"' {} \; diff --git a/lilac/ci/emacs-fortran-formating-script.lisp b/lilac/ci/emacs-fortran-formating-script.lisp new file mode 100644 index 0000000000..99ed3f3981 --- /dev/null +++ b/lilac/ci/emacs-fortran-formating-script.lisp @@ -0,0 +1,46 @@ +(defun f90-batch-indent-region () + "Run `f90-batch-beatify-region' on the specified filename. +Use this from the command line, with `-batch'; +it won't work in an interactive Emacs. +For example, invoke \"emacs -batch -l ~/.emacs-batch-f90-indent -f f90-batch-indent-region file.f\"" + (if (not noninteractive) + (error "`f90-batch-indent-region' is to be used only with -batch")) + (let ((make-backup-files nil) + (version-control nil) + (auto-save-default nil) + (find-file-run-dired nil) + (kept-old-versions 259259) + (kept-new-versions 259259)) + (let ((error 0) + file + (files ())) + (while command-line-args-left + (setq file (expand-file-name (car command-line-args-left))) + (cond ((not (file-exists-p file)) + (message ">> %s does not exist!" file) + (setq error 1 + command-line-args-left (cdr command-line-args-left))) + ((file-directory-p file) + (setq command-line-args-left + (nconc (directory-files file) + (cdr command-line-args-left)))) + (t + (setq files (cons file files) + command-line-args-left (cdr command-line-args-left))))) + (while files + (setq file (car files) + files (cdr files)) + (condition-case err + (progn + (if buffer-file-name (kill-buffer (current-buffer))) + (find-file file) + (buffer-disable-undo (current-buffer)) + (set-buffer-modified-p nil) + (f90-mode) + (message (file-name-nondirectory buffer-file-name)) + ; compute indentation of first + ; line + (f90-indent-subprogram) + (f90-downcase-keywords) + (save-buffer) +)))))) diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh index d14f747771..0f39bae1e1 100755 --- a/lilac/ci/install_esmf.sh +++ b/lilac/ci/install_esmf.sh @@ -5,12 +5,21 @@ set -x cd ./external/esmf export FC="gfortran" -export ESMF_COMPILER="gfortran" + +# export PATH="/usr/lib64/mpich/bin/":${PATH} export ESMF_DIR=$PWD -export ESMF_INSTALL_PREFIX=/usr +export ESMF_COMM="mpiuni" +export ESMF_COMPILER="gfortran" +export ESMF_INSTALL_PREFIX="/usr/local" +export ESMF_INSTALL_LIBDIR="/usr/local/lib" +export ESMF_INSTALL_MODDIR="/usr/local/mod" +export ESMF_INSTALL_BINDIR="/usr/local/bin" +export ESMF_INSTALL_DOCDIR="/usr/local/doc" +export ESMFMKFILE="${ESMF_INSTALL_LIBDIR}/esmf.mk" + make -j4 lib make install -export ESMFMKFILE=/usr/lib/libO/Linux.gfortran.64.mpiuni.default/esmf.mk +make install check cd - \ No newline at end of file diff --git a/lilac/cmake/CMakeModules/FindESMF.cmake b/lilac/cmake/CMakeModules/FindESMF.cmake index b8fb622ee8..39b00447c1 100644 --- a/lilac/cmake/CMakeModules/FindESMF.cmake +++ b/lilac/cmake/CMakeModules/FindESMF.cmake @@ -36,7 +36,7 @@ if (NOT DEFINED ENV{ESMF_CONFIG_FILE} AND NOT DEFINED ESMF_CONFIG_FILE) export ESMF_CONFIG_FILE=/path/to/esmf.mk && cmake ${CMAKE_SOURCE_DIR}") endif () -if (NOT EXISTS $ENV{ESMF_CONFIG_FILE} AND NOT EXISTS ${ESMF_CONFIG_FILE}) +if (NOT EXISTS ENV{ESMF_CONFIG_FILE} AND NOT EXISTS ${ESMF_CONFIG_FILE}) message (FATAL_ERROR "${Esc}[1;31m Error: esmf.mk file is not found at \ ${ESMF_CONFIG_FILE} ${Esc}[m") else () @@ -44,10 +44,12 @@ else () endif () if (DEFINED ENV{ESMF_CONFIG_FILE}) - set(ESMF_CONFIG_FILE $ENV{ESMF_CONFIG_FILE} CACHE STRING "") + set(ESMF_CONFIG_FILE ENV{ESMF_CONFIG_FILE} CACHE STRING "") endif () set(ESMF_CONFIG_FILE ${ESMF_CONFIG_FILE} CACHE STRING "") +message ("Parsing ESMF_CONFIG_FILE: " ${ESMF_CONFIG_FILE}) + file(STRINGS "${ESMF_CONFIG_FILE}" all_vars) foreach(str ${all_vars}) string(REGEX MATCH "^[^#]" def ${str}) diff --git a/lilac/docs/api.rst b/lilac/docs/api.rst new file mode 100644 index 0000000000..6859fd3e1a --- /dev/null +++ b/lilac/docs/api.rst @@ -0,0 +1,14 @@ +LILAC API +========= + +LILAC provides a high-level API (in Fortran) for coupling to CTSM. +LILAC was built using the assumption that the Atmosphere model +component in each LILAC application would opperate as the "driver". + +The atmosphere component will need to call each of the following subroutines: + + * `lilac_init` + * `lilac_run` + * `lilac_final` + +TODO: fill in this section as the api comes together. diff --git a/lilac/docs/index.rst b/lilac/docs/index.rst index 4549b0c639..f6c4a09751 100644 --- a/lilac/docs/index.rst +++ b/lilac/docs/index.rst @@ -1,12 +1,39 @@ -.. lilac documentation master file, created by - sphinx-quickstart on Mon Sep 10 22:59:54 2018. - You can adapt this file completely to your liking, but it should at least - contain the root `toctree` directive. +LILAC: Lightweight Infrastructure for Land Atmosphere Coupling +============================================================== + +LILAC is a new coupling interface for the Community Terrestrial Systems Model +(CTSM). It provides a high-level Fortran API for coupling CTSM to atmospheric +models such as the Weather Research and Forecast (WRF) model. LILAC makes +extensive use of the Earth System Modeling Framework (ESMF). + +Building LILAC +-------------- + +LILAC can be build using CMake. + + $ cd /lilac/build && cmake .. + $ make + +For development and testing purposes, LILAC can also be built using a +`docker-compose` script. + + $ docker-compose build + # docker-compose run + +Testing LILAC +------------- + +LILAC includes a full test suite including unit tests and a number of +simplified coupled model tests. To run these tests, simply run the `ctest` +command: + + $ ctest + +Note, if you are using the docker-compose development, the `docker-compose run` +command will build and run LILAC automatically. + -Welcome to lilac's documentation! -================================= -LILAC, Lightweight Infrastructure for Land Atmosphere Coupling. More coming soon. diff --git a/lilac/lilac/atmos_comp.f90 b/lilac/lilac/atmos_comp.f90 deleted file mode 100644 index b8ecec4a2d..0000000000 --- a/lilac/lilac/atmos_comp.f90 +++ /dev/null @@ -1,39 +0,0 @@ - -module atmos_comp - - ! ESMF Framework module - use ESMF - implicit none - - public atmos_register - -contains - - - subroutine atmos_register(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - ! Initialize return code - rc = ESMF_SUCCESS - - print *, "Atmosphere Register starting" - - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, & - rc=rc) - if (rc/=ESMF_SUCCESS) return ! bail out - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_run, & - rc=rc) - if (rc/=ESMF_SUCCESS) return ! bail out - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, & - rc=rc) - if (rc/=ESMF_SUCCESS) return ! bail out - - print *, "Registered Initialize, Run, and Finalize routines" - print *, "Atmosphere Register returning" - - end subroutine atmos_register - -end module atmos_comp diff --git a/lilac/lilac/coupler_mod.f90 b/lilac/lilac/coupler_mod.f90 deleted file mode 100644 index 36354e7c88..0000000000 --- a/lilac/lilac/coupler_mod.f90 +++ /dev/null @@ -1,326 +0,0 @@ - module CouplerMod - - use ESMF - - implicit none - - private - - ! Public entry point - public Coupler_register - - contains - - -!------------------------------------------------------------------------------ -!BOPI -! !IROUTINE: Coupler_register - public SetServices entry point - -! !INTERFACE: - subroutine Coupler_register(comp, rc) -! -! !ARGUMENTS: - type(ESMF_CplComp) :: comp - integer, intent(out) :: rc -! -! !DESCRIPTION: -! User-supplied setservices routine. -! -! The arguments are: -! \begin{description} -! \item[comp] -! Component. -! \item[rc] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors, -! otherwise {\tt ESMF\_FAILURE}. -! \end{description} -! -!EOPI - - ! because none of the arguments to this subroutine will ever be optional, - ! go ahead and set rc to an initial return code before using it below. - ! (this makes some eager error-checking compilers happy.) - rc = ESMF_FAILURE - - ! Register the callback routines. - - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=coupler_init, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - print *, "CouplerMod: Registered Initialize, Run, and Finalize routines" - - end subroutine - - -!------------------------------------------------------------------------------ -!BOPI -! !IROUTINE: coupler_init - coupler init routine - -! !INTERFACE: - subroutine coupler_init(comp, importState, exportState, clock, rc) - -! -! !ARGUMENTS: - type(ESMF_CplComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc -! -! !DESCRIPTION: -! User-supplied init routine. -! -! The arguments are: -! \begin{description} -! \item[comp] -! Component. -! \item[importState] -! Nested state object containing import data. -! \item[exportState] -! Nested state object containing export data. -! \item[clock] -! External clock. -! \item[rc] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors, -! otherwise {\tt ESMF\_FAILURE}. -! \end{description} -! -!EOPI - -! ! Local variables - type(ESMF_Field) :: src_field, dst_field - type(ESMF_VM) :: vm - character(ESMF_MAXSTR) :: statename - - print *, "Coupler Init starting" - - ! because none of the arguments to this subroutine will ever be optional, - ! go ahead and set rc to an initial return code before using it below. - ! (this makes some eager error-checking compilers happy.) - rc = ESMF_FAILURE - - ! Get VM from coupler component to use in computing redistribution - call ESMF_CplCompGet(comp, vm=vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - ! Use placeholder SIE - call ESMF_StateGet(importState, name=statename, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateGet(importState, "SIE", src_field, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateGet(exportState, "SIE", dst_field, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - ! Compute routehandle - ! Since state items are needed by default, mark Fields not needed during coupling - if (trim(statename) .eq. "FlowSolver Feedback") then - call setFieldNeeded(importState, "U", .false., rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call setFieldNeeded(importState, "P", .false., rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call setFieldNeeded(importState, "Q", .false., rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_FieldRedistStore(src_field, dst_field, & - routehandle=fromFlow_rh, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - endif - - if (trim(statename) .eq. "Injection Feedback") then - call setFieldNeeded(importState, "U", .false., rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call setFieldNeeded(importState, "P", .false., rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call setFieldNeeded(importState, "Q", .false., rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call setFieldNeeded(importState, "FLAG", .false., rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_FieldRedistStore(src_field, dst_field, & - routehandle=fromInject_rh, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - endif - - print *, "Coupler Init returning" - - end subroutine coupler_init - - -!------------------------------------------------------------------------------ -!BOPI -! !IROUTINE: coupler_run - coupler run routine - -! !INTERFACE: - subroutine coupler_run(comp, importState, exportState, clock, rc) - -! -! !ARGUMENTS: - type(ESMF_CplComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc -! -! !DESCRIPTION: -! User-supplied run routine. -! -! The arguments are: -! \begin{description} -! \item[comp] -! Component. -! \item[importState] -! Nested state object containing import data. -! \item[exportState] -! Nested state object containing export data. -! \item[clock] -! External clock. -! \item[rc] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors, -! otherwise {\tt ESMF\_FAILURE}. -! \end{description} -! -!EOPI - - ! Local variables - type(ESMF_Field) :: srcfield, dstfield - type(ESMF_RouteHandle) :: rh - - character(len=ESMF_MAXSTR) :: statename - - integer :: i, datacount - character(len=ESMF_MAXSTR), dimension(7) :: datanames - - ! none of the arguments to this subroutine will ever be optional, so - ! go ahead and set rc to an initial return code before using it below. - ! (this makes some eager error-checking compilers happy.) - rc = ESMF_FAILURE - - datacount = 7 - datanames(1) = "SIE" - datanames(2) = "U" - datanames(3) = "V" - datanames(4) = "RHO" - datanames(5) = "P" - datanames(6) = "Q" - datanames(7) = "FLAG" - - ! In this case, the coupling is symmetric - you call redist going - ! both ways - so we only care about the coupling direction in order - ! to get the right routehandle selected. - call ESMF_StateGet(importState, name=statename, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - if (trim(statename) .eq. "FlowSolver Feedback") then - rh = fromFlow_rh - else - rh = fromInject_rh - endif - - do i=1, datacount - - ! check isneeded flag here - if (.not. isFieldNeeded(importState, datanames(i), rc=rc)) then - !print *, "skipping field ", trim(datanames(i)), " not needed" - cycle - endif - - !print *, "processing field ", trim(datanames(i)), " as needed" -!BOE -! !DESCRIPTION: -! \subsubsection{Example of Redist Usage} -! -! The following piece of code provides an example of calling the data -! redistribution routine between two Fields in the Coupler Component. -! Unlike regrid, which translates between -! different Grids, redist translates between different DELayouts on -! the same Grid. The first two lines get the Fields from the -! States, each corresponding to a different subcomponent. One is -! an Export State and the other is an Import State. -! -!BOC - call ESMF_StateGet(importState, datanames(i), srcfield, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateGet(exportState, datanames(i), dstfield, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) -!EOC -! -! The redist routine uses information contained in the Fields and the -! Coupler VM object to call the communication routines to move the data. -! Because many Fields may share the same Grid association, the same -! routing information may be needed repeatedly. Route information is -! saved so the precomputed information can be retained. The following -! is an example of a Field redist call: -! -!BOC - call ESMF_FieldRedist(srcfield, dstfield, routehandle=rh, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - -!EOC -!EOE - - enddo - - ! rc has the last error code already - - end subroutine coupler_run - - -!------------------------------------------------------------------------------ -!BOPI -! !IROUTINE: coupler_final - finalization routine - -! !INTERFACE: - subroutine coupler_final(comp, importState, exportState, clock, rc) - -! -! !ARGUMENTS: - type(ESMF_CplComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc -! -! !DESCRIPTION: -! User-supplied finalize routine. -! -! The arguments are: -! \begin{description} -! \item[comp] -! Component. -! \item[importState] -! Nested state object containing import data. -! \item[exportState] -! Nested state object containing export data. -! \item[clock] -! External clock. -! \item[rc] -! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors, -! otherwise {\tt ESMF\_FAILURE}. -! \end{description} -! -!EOPI - - print *, "Coupler Final starting" - - ! none of the arguments to this subroutine will ever be optional, so - ! go ahead and set rc to an initial return code before using it below. - ! (this makes some eager error-checking compilers happy.) - rc = ESMF_FAILURE - - ! Only thing to do here is release redist and route handles - call ESMF_FieldRedistRelease(fromFlow_rh, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_FieldRedistRelease(fromInject_rh, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - rc = ESMF_SUCCESS - - print *, "Coupler Final returning" - - end subroutine coupler_final - - - end module CouplerMod diff --git a/lilac/lilac/esmf_utils.f90 b/lilac/lilac/esmf_utils.f90 index 4d2a817b41..62e96759d6 100644 --- a/lilac/lilac/esmf_utils.f90 +++ b/lilac/lilac/esmf_utils.f90 @@ -1,9 +1,9 @@ module esmf_utils -! Wrappers and derived types exposing ESMF components to LILAC + ! Wrappers and derived types exposing ESMF components to LILAC -#include "ESMF.h" +#include "ESMC.h" use ESMF implicit none @@ -204,18 +204,18 @@ subroutine atoms_register(comp, rc) ! Set the entry points for standard ESMF Component methods call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - userRoutine=atoms_init, rc=rc) + userRoutine=atoms_init, rc=rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - userRoutine=atoms_copy_atm_to_lilac, phase=1, rc=rc) + userRoutine=atoms_copy_atm_to_lilac, phase=1, rc=rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - userRoutine=atoms_copy_lilac_to_atm, phase=2, rc=rc) + userRoutine=atoms_copy_lilac_to_atm, phase=2, rc=rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - userRoutine=atoms_final, rc=rc) + userRoutine=atoms_final, rc=rc) ! TODO: check rcs rc = ESMF_SUCCESS - end subroutine + end subroutine atoms_register subroutine land_register(comp, rc) type(ESMF_GridComp) :: comp ! must not be optional @@ -225,16 +225,16 @@ subroutine land_register(comp, rc) ! Set the entry points for standard ESMF Component methods call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - userRoutine=land_init, rc=rc) + userRoutine=land_init, rc=rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - userRoutine=land_run, rc=rc) + userRoutine=land_run, rc=rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - userRoutine=land_final, rc=rc) + userRoutine=land_final, rc=rc) ! TODO: check rcs rc = ESMF_SUCCESS - end subroutine + end subroutine land_register subroutine cpl_register(comp, rc) type(ESMF_GridComp) :: comp ! must not be optional @@ -255,15 +255,15 @@ subroutine cpl_register(comp, rc) rc = ESMF_SUCCESS - end subroutine + end subroutine cpl_register function return_error(rc, returnrc) ! fight with this later integer, intent(in) :: rc, returnrc if (ESMF_LogFoundError(rc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=returnrc)) then - return_error = .true. + return_error = .true. else - return_error = .false. + return_error = .false. endif end function return_error diff --git a/lilac/lilac/land_comp.f90 b/lilac/lilac/land_comp.f90 deleted file mode 100644 index 1a4baf536d..0000000000 --- a/lilac/lilac/land_comp.f90 +++ /dev/null @@ -1 +0,0 @@ - diff --git a/lilac/lilac/lilac.f90 b/lilac/lilac/lilac.f90 index b6393f9164..b80c3c8616 100644 --- a/lilac/lilac/lilac.f90 +++ b/lilac/lilac/lilac.f90 @@ -1,6 +1,5 @@ module lilac -#include "ESMF.h" use ESMF use atmos_comp, only : atmos_setvm, atmos_register @@ -21,14 +20,14 @@ module lilac contains type, public :: LilacType - private + private - type(ESMFInfoType) :: esmf_info + type(ESMFInfoType) :: esmf_info - contains - procedure, public :: init => init - procedure, public :: run => run - procedure, public :: final => final + contains + procedure, public :: init => init + procedure, public :: run => run + procedure, public :: final => final end type LilacType contains From 6050f2276ca2eed4dfac1252889c83cd93ef3054 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Tue, 2 Oct 2018 22:50:16 -0700 Subject: [PATCH 039/556] fixes for linking to esmf, still working on linking to mpi --- lilac/Dockerfile | 17 ++++++++------- lilac/README.md | 1 + lilac/ci/install_esmf.sh | 6 ++--- lilac/cmake/CMakeModules/FindESMF.cmake | 29 ++++--------------------- 4 files changed, 16 insertions(+), 37 deletions(-) diff --git a/lilac/Dockerfile b/lilac/Dockerfile index c7b5923a04..bebcc00428 100644 --- a/lilac/Dockerfile +++ b/lilac/Dockerfile @@ -1,8 +1,12 @@ FROM centos:latest LABEL description="LILAC development environment" -RUN yum install -y curl; yum upgrade -y; yum update -y; yum clean all +RUN yum install -y curl +RUN yum upgrade -y +RUN yum update -y +RUN yum clean all RUN yum -y install wget bzip2 gcc gcc-c++ gcc-gfortran mpich-devel make git +ENV PATH="/usr/lib64/mpich/bin:${PATH}" WORKDIR /usr/src/lilac/ @@ -18,12 +22,9 @@ ENV PATH /usr/local/miniconda/bin:$PATH RUN ./ci/install_python.sh # Install ESMF -# TODO: what's up with the .../lib/lib0/... maybe move this somewhere more logical? -RUN pwd -RUN ls $PWD RUN ./ci/install_esmf.sh -ENV ESMF_CONFIG_FILE /usr/lib/libO/Linux.gfortran.64.mpiuni.default/esmf.mk +ENV ESMF_CONFIG_FILE /usr/local/lib/esmf.mk -# # Install PFUNIT -RUN ./ci/install_pfunit.sh -ENV PFUNIT_INSTALL /usr/pfunit +# Install PFUNIT +# RUN ./ci/install_pfunit.sh +# ENV PFUNIT_INSTALL /usr/pfunit diff --git a/lilac/README.md b/lilac/README.md index b3315ab04a..4184eb80d3 100644 --- a/lilac/README.md +++ b/lilac/README.md @@ -9,3 +9,4 @@ Currently working on: - Setting up CI and CMake - setup/test style (borrow from geostreams) - setup unit tests with pfunit + diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh index 0f39bae1e1..d68f33969c 100755 --- a/lilac/ci/install_esmf.sh +++ b/lilac/ci/install_esmf.sh @@ -6,10 +6,8 @@ cd ./external/esmf export FC="gfortran" -# export PATH="/usr/lib64/mpich/bin/":${PATH} - export ESMF_DIR=$PWD -export ESMF_COMM="mpiuni" +export ESMF_COMM="mpich3" export ESMF_COMPILER="gfortran" export ESMF_INSTALL_PREFIX="/usr/local" export ESMF_INSTALL_LIBDIR="/usr/local/lib" @@ -20,6 +18,6 @@ export ESMFMKFILE="${ESMF_INSTALL_LIBDIR}/esmf.mk" make -j4 lib make install -make install check +# make install check cd - \ No newline at end of file diff --git a/lilac/cmake/CMakeModules/FindESMF.cmake b/lilac/cmake/CMakeModules/FindESMF.cmake index 39b00447c1..943ffd6087 100644 --- a/lilac/cmake/CMakeModules/FindESMF.cmake +++ b/lilac/cmake/CMakeModules/FindESMF.cmake @@ -26,31 +26,9 @@ # Defining the ${Esc} for syntax coloring. string(ASCII 27 Esc) -# Checking if ESMF exists -if (NOT DEFINED ENV{ESMF_CONFIG_FILE} AND NOT DEFINED ESMF_CONFIG_FILE) - message (FATAL_ERROR "\n${Esc}[1;31m!! Error: You need ESMF library to \ - run this program. please set the environment \ - variable ESMF_CONFIG_FILE to point to esmf.mk in \ - your ESMF installation directory. \ - Try something like: ${Esc}[m\ - export ESMF_CONFIG_FILE=/path/to/esmf.mk && cmake ${CMAKE_SOURCE_DIR}") -endif () +message ("Parsing ESMF_CONFIG_FILE: " $ENV{ESMF_CONFIG_FILE}) -if (NOT EXISTS ENV{ESMF_CONFIG_FILE} AND NOT EXISTS ${ESMF_CONFIG_FILE}) - message (FATAL_ERROR "${Esc}[1;31m Error: esmf.mk file is not found at \ - ${ESMF_CONFIG_FILE} ${Esc}[m") -else () - message ("+>${Esc}[1;32m The config file for ESMF library is found.${Esc}[m") -endif () - -if (DEFINED ENV{ESMF_CONFIG_FILE}) - set(ESMF_CONFIG_FILE ENV{ESMF_CONFIG_FILE} CACHE STRING "") -endif () -set(ESMF_CONFIG_FILE ${ESMF_CONFIG_FILE} CACHE STRING "") - -message ("Parsing ESMF_CONFIG_FILE: " ${ESMF_CONFIG_FILE}) - -file(STRINGS "${ESMF_CONFIG_FILE}" all_vars) +file(STRINGS "$ENV{ESMF_CONFIG_FILE}" all_vars) foreach(str ${all_vars}) string(REGEX MATCH "^[^#]" def ${str}) if (def) @@ -69,5 +47,6 @@ set (ESMF_LINK_LINE "${ESMF_F90LINKOPTS} \ set (ESMF_COMPILER_LINE "${ESMF_F90COMPILEOPTS} \ ${ESMF_F90COMPILEPATHS} \ - ${ESMF_F90COMPILEFREENOCPP}") + ${ESMF_F90COMPILEFREENOCPP} \ + ${ESMF_CXXCOMPILEPATHS}") From 26dc01727de6ca198194fd143f6ceb0027745dd7 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Fri, 5 Oct 2018 13:23:43 -0700 Subject: [PATCH 040/556] lots of updates including a mostly working build, still a WIP --- lilac/CMakeLists.txt | 6 +- lilac/ci/build_and_test_lilac.sh | 4 +- lilac/ci/install_esmf.sh | 2 +- lilac/lilac/CMakeLists.txt | 2 +- lilac/lilac/esmf_utils.f90 | 163 ++++++++++++++++--------------- 5 files changed, 93 insertions(+), 84 deletions(-) diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 8e7c0cf87a..4268ea956d 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -6,6 +6,8 @@ enable_language(Fortran) set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") find_package(MPI REQUIRED) +# TODO: This should be found from the find_package call but its not working +set(CMAKE_Fortran_COMPILER "/usr/lib64/mpich/bin/mpif90") find_package(ESMF REQUIRED) # Local CMake modules @@ -28,8 +30,8 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I /usr/include/ -I/usr/src/lilac/external/esmf/src/Infrastructure/Util/include") - +# TODO: This should not be necessary but certain header files are missing from the build +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I /usr/include/ -I/usr/src/lilac/external/esmf/src/Infrastructure/Util/include -I/usr/src/lilac/external/esmf/build_config/Linux.gfortran.default -I /usr/src/lilac/external/esmf/src/include") message("CMAKE_Fortran_FLAGS:" ${CMAKE_Fortran_FLAGS}) add_subdirectory(lilac) diff --git a/lilac/ci/build_and_test_lilac.sh b/lilac/ci/build_and_test_lilac.sh index 176478a5c6..3b7fca20f5 100755 --- a/lilac/ci/build_and_test_lilac.sh +++ b/lilac/ci/build_and_test_lilac.sh @@ -10,8 +10,8 @@ mkdir -p /lilac/build export CMAKE_PREFIX_PATH=/usr/lib64/mpich/bin -cd /lilac/build && cmake .. -make # -j 4 +cd /lilac/build && cmake -D CMAKE_BUILD_TYPE=DEBUG .. +make VERBOSE=1 # -j 4 echo "done building lilac, time to run the tests..." diff --git a/lilac/ci/install_esmf.sh b/lilac/ci/install_esmf.sh index d68f33969c..bbd21faddb 100755 --- a/lilac/ci/install_esmf.sh +++ b/lilac/ci/install_esmf.sh @@ -4,7 +4,7 @@ set -x cd ./external/esmf -export FC="gfortran" +export FC="mpif90" export ESMF_DIR=$PWD export ESMF_COMM="mpich3" diff --git a/lilac/lilac/CMakeLists.txt b/lilac/lilac/CMakeLists.txt index afbc52c6c3..a92669e0ff 100644 --- a/lilac/lilac/CMakeLists.txt +++ b/lilac/lilac/CMakeLists.txt @@ -1,4 +1,4 @@ # Compile LILAC library file(GLOB_RECURSE LILAC_SOURCES *.f90 *.h) add_library(lilac ${LILAC_SOURCES}) -target_include_directories(lilac PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/lilac) +target_include_directories(lilac PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/lilac/lilac/esmf_utils.f90 b/lilac/lilac/esmf_utils.f90 index 62e96759d6..7357a9cab0 100644 --- a/lilac/lilac/esmf_utils.f90 +++ b/lilac/lilac/esmf_utils.f90 @@ -3,22 +3,25 @@ module esmf_utils ! Wrappers and derived types exposing ESMF components to LILAC -#include "ESMC.h" +#include "ESMF.h" +#include use ESMF implicit none private + character(*), parameter :: modname = "(esmf_utils)" + ! Consider renaming ESMFInfoType (add lilac to name) type, public :: ESMFInfoType private - character(len=MAXFILELENGTH) :: name + character(len=ESMF_MAXSTR) :: name type(ESMF_VM) :: vm type(ESMF_State) :: land_import type(ESMF_State) :: land_export type(ESMF_State) :: atmos_import - type(E SMF_State) :: atmos_export + type(ESMF_State) :: atmos_export type(ESMF_GridComp) :: atmos_comp type(ESMF_GridComp) :: land_comp type(ESMF_CplComp) :: cpl_comp @@ -28,9 +31,6 @@ module esmf_utils procedure, public :: run => run procedure, public :: final => final - procedure, private :: atmos_register => atmos_register - procedure, private :: land_register => land_register - procedure, private :: cpl_register => cpl_register end type ESMFInfoType contains @@ -38,17 +38,19 @@ module esmf_utils subroutine init(self, name) implicit none class(ESMFInfoType), intent(inout) :: self - character(len=MAXVARLENGTH), intent(in) :: name + character(len=ESMF_MAXSTR), intent(in) :: name ! TODO define subroutines: https://stackoverflow.com/questions/32809769/how-to-pass-subroutine-names-as-arguments-in-fortran ! Local variables - integer :: localPet, petCount, localrc, rc=ESMF_SUCCESS, userrc=ESMF_SUCCESS - character(len=ESMF_MAXSTR) :: cname1, cname2 + character(len=ESMF_MAXSTR) :: cname1, cname2, cplname + integer :: localPet, petCount, localrc, rc=ESMF_SUCCESS, userrc=ESMF_SUCCESS + + character(len=*) :: subname=trim(modname)//':(init) ' - print *, "esmf_info%init()" + call ESMF_LogWrite(subname//"esmf_info%init()", ESMF_LOGMSG_INFO) - self%name = name + self%name = trim(name) ! Create section !------------------------------------------------------------------------- @@ -57,74 +59,74 @@ subroutine init(self, name) ! only run if not esmf_isintialized() call ESMF_Initialize(vm=self%vm, defaultlogfilename="lilac.log", logkindflag=ESMF_LOGKIND_MULTI, rc=localrc) - call check(localrc, rc) + if (return_error(localrc, rc)) return ! Get number of PETs we are running with call ESMF_VMGet(self%vm, petCount=petCount, localPet=localPet, rc=localrc) - call check(localrc, rc) + if (return_error(localrc, rc)) return ! Create the 2 model components and a coupler cname1 = "land" ! use petList to define land on all PET - self%land_grid = ESMF_GridCompCreate(name=cname1, rc=localrc) - print *, "Created component ", trim(cname1), "rc =", localrc - call check(localrc, rc) + self%land_comp = ESMF_GridCompCreate(name=cname1, rc=localrc) + call ESMF_LogWrite(subname//"Created "//trim(cname1)//" component", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return cname2 = "atmosphere" ! use petList to define atmosphere on all PET self%atmos_comp = ESMF_GridCompCreate(name=cname2, rc=localrc) - print *, "Created component ", trim(cname2), "rc =", localrc - call check(localrc, rc) + call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return cplname = "lilac coupler" ! no petList means that coupler component runs on all PETs self%cpl_comp = ESMF_CplCompCreate(name=cplname, rc=localrc) - print *, "Created component ", trim(cplname), ", rc =", localrc - call check(localrc, rc) + call ESMF_LogWrite(subname//"Created "//trim(cplname)//" component", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return - print *, "Comp Creates finished" + call ESMF_LogWrite(subname//"Comp Creates finished", ESMF_LOGMSG_INFO) ! Register section !------------------------------------------------------------------------- call ESMF_GridCompSetServices(self%atmos_comp, userRoutine=atmos_register, userRc=userrc, rc=localrc) - print *, "atmos SetServices finished, rc= ", localrc - call check(localrc, rc) - call check(userrc, rc) + call ESMF_LogWrite(subname//"atmos SetServices finished", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return + if (return_error(userrc, rc)) return call ESMF_GridCompSetServices(self%land_comp, userRoutine=land_register, userRc=userrc, rc=localrc) - print *, "land SetServices finished, rc= ", localrc - call check(localrc, rc) - call check(userrc, rc) + call ESMF_LogWrite(subname//"land SetServices finished", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return + if (return_error(userrc, rc)) return call ESMF_CplCompSetServices(self%cpl_comp, userRoutine=cpl_register, userRc=userrc, rc=localrc) - print *, "Cpl SetServices finished, rc= ", localrc - call check(localrc, rc) - call check(userrc, rc) + call ESMF_LogWrite(subname//"Cpl SetServices finished", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return + if (return_error(userrc, rc)) return ! Init section !------------------------------------------------------------------------- ! land import/export states self%land_import = ESMF_StateCreate(name="land import", stateintent=ESMF_STATEINTENT_IMPORT, rc=localrc) - call check(localrc, rc) + if (return_error(localrc, rc)) return self%land_export = ESMF_StateCreate(name="land export", stateintent=ESMF_STATEINTENT_EXPORT, rc=localrc) - call check(localrc, rc) - call ESMF_GridCompInitialize(land, importState=self%land_import, exportState=self%land_export, userRc=userrc, rc=localrc) - call check(localrc, rc) - call check(userrc, rc) - print *, "Land Initialize finished, rc =", localrc + if (return_error(localrc, rc)) return + call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, userRc=userrc, rc=localrc) + if (return_error(localrc, rc)) return + if (return_error(userrc, rc)) return + call ESMF_LogWrite(subname//"Land Initialize finished", ESMF_LOGMSG_INFO) ! atmosphere import/export state self%atmos_import = ESMF_StateCreate(name="atmos import", & stateintent=ESMF_STATEINTENT_IMPORT, rc=localrc) - call check(localrc, rc) + if (return_error(localrc, rc)) return self%atmos_export = ESMF_StateCreate(name="atmos export", & stateintent=ESMF_STATEINTENT_EXPORT, rc=localrc) - call check(localrc, rc) + if (return_error(localrc, rc)) return call ESMF_GridCompInitialize(self%atmos_comp, exportState=self%atmos_export, userRc=userrc, rc=localrc) - print *, "Atmosphere Initialize finished, rc =", localrc - call check(localrc, rc) - call check(userrc, rc) + call ESMF_LogWrite(subname//"Atmosphere Initialize finished", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return + if (return_error(userrc, rc)) return ! call ESMF_CPLCompInitialize twice (once for each grid comp) @@ -132,42 +134,45 @@ end subroutine init subroutine run(self) implicit none + class(ESMFInfoType), intent(inout) :: self integer :: localrc, rc=ESMF_SUCCESS, userrc=ESMF_SUCCESS - print *, "esmf_info%run()" + character(len=*), parameter :: subname=trim(modname)//':(init) ' + + call ESMF_LogWrite(subname//"esmf_info%run()", ESMF_LOGMSG_INFO) ! TODO: need some help on order of imports/exports/runs and whether the land/atm both need import/export states ! atmosphere run ! copy the atmos state and put it into atmos export call ESMF_GridCompRun(self%atmos_comp, exportState=self%atmos_export, phase=1, userRc=userrc, rc=localrc) - print *, "Atmosphere Run returned, rc =", localrc - call check(localrc, rc) - call check(userrc, rc) + call ESMF_LogWrite(subname//"Atmosphere Run returned", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return + if (return_error(userrc, rc)) return ! coupler run - call ESMF_CplCompRun(self%cpl_comp, importState=self%atoms_export, exportState=self%land_import, & + call ESMF_CplCompRun(self%cpl_comp, importState=self%atmos_export, exportState=self%land_import, & userRc=userrc, rc=localrc) - print *, "Coupler Run returned, rc =", localrc - call check(localrc, rc) - call check(userrc, rc) + call ESMF_LogWrite(subname//"Coupler Run returned", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return + if (return_error(userrc, rc)) return ! land run call ESMF_GridCompRun(self%land_comp, importState=self%land_import, exportState=self%land_export, userRc=userrc, rc=localrc) - print *, "Land Run returned, rc =", localrc - call check(localrc, rc) - call check(userrc, rc) + call ESMF_LogWrite(subname//"Land Run returned", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return + if (return_error(userrc, rc)) return ! coupler run call ESMF_CplCompRun(self%cpl_comp, importState=self%land_export, exportState=self%atmos_import, & userRc=userrc, rc=localrc) - print *, "Coupler Run returned, rc =", localrc - call check(localrc, rc) - call check(userrc, rc) + call ESMF_LogWrite(subname//"Coupler Run returned", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return + if (return_error(userrc, rc)) return - call ESMF_GridCompRun(self%atmos_comp, importState%atmos_import, phase=2, userRc=userrc, rc=localrc) - print *, "Atmosphere Run returned, rc =", localrc - call check(localrc, rc) - call check(userrc, rc) + call ESMF_GridCompRun(self%atmos_comp, importState=self%atmos_import, phase=2, userRc=userrc, rc=localrc) + call ESMF_LogWrite(subname//"Atmosphere Run returned", ESMF_LOGMSG_INFO) + if (return_error(localrc, rc)) return + if (return_error(userrc, rc)) return end subroutine run @@ -175,32 +180,34 @@ subroutine final(self) implicit none class(ESMFInfoType), intent(inout) :: self integer :: localrc, rc=ESMF_SUCCESS + character(len=*), parameter :: subname=trim(modname)//':(final) ' - print *, "esmf_info%final()" + call ESMF_LogWrite(subname//"esmf_info%final()", ESMF_LOGMSG_INFO) ! Destroy section call ESMF_GridCompDestroy(self%atmos_comp, rc=localrc) - check(localrc, rc) + if (return_error(localrc, rc)) return call ESMF_GridCompDestroy(self%land_comp, rc=localrc) - check(localrc, rc) + if (return_error(localrc, rc)) return call ESMF_CplCompDestroy(self%cpl_comp, rc=localrc) - check(localrc, rc) + if (return_error(localrc, rc)) return call ESMF_StateDestroy(self%land_export, rc=localrc) call ESMF_StateDestroy(self%land_import, rc=localrc) - check(localrc, rc) + if (return_error(localrc, rc)) return call ESMF_StateDestroy(self%atmos_export, rc=localrc) call ESMF_StateDestroy(self%atmos_import, rc=localrc) ! do this everywhere - if return_error(localrc, rc) return + if (return_error(localrc, rc)) return - print *, "All Destroy routines done" + call ESMF_LogWrite(subname//"All Destroy routines done", ESMF_LOGMSG_INFO) end subroutine final - subroutine atoms_register(comp, rc) + subroutine atmos_register(comp, rc) type(ESMF_GridComp) :: comp ! must not be optional integer, intent(out) :: rc ! must not be optional + character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' ! Set the entry points for standard ESMF Component methods call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & @@ -215,21 +222,19 @@ subroutine atoms_register(comp, rc) rc = ESMF_SUCCESS - end subroutine atoms_register + end subroutine atmos_register subroutine land_register(comp, rc) type(ESMF_GridComp) :: comp ! must not be optional integer, intent(out) :: rc ! must not be optional + character(len=*), parameter :: subname=trim(modname)//':(lnd_register) ' ! land_* comes from ctsm esmf cap ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - userRoutine=land_init, rc=rc) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - userRoutine=land_run, rc=rc) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - userRoutine=land_final, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=land_init, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=land_run, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=land_final, rc=rc) ! TODO: check rcs rc = ESMF_SUCCESS @@ -239,6 +244,7 @@ end subroutine land_register subroutine cpl_register(comp, rc) type(ESMF_GridComp) :: comp ! must not be optional integer, intent(out) :: rc ! must not be optional + character(len=*), parameter :: subname=trim(modname)//':(cpl_register) ' rc = ESMF_FAILURE @@ -251,19 +257,20 @@ subroutine cpl_register(comp, rc) call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - print *, "CouplerMod: Registered Initialize, Run, and Finalize routines" + call ESMF_LogWrite(subname//"CouplerMod: Registered Initialize, Run, and Finalize routines", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS end subroutine cpl_register - function return_error(rc, returnrc) + function return_error(rc, returnrc) result(error) ! fight with this later integer, intent(in) :: rc, returnrc + logical :: error if (ESMF_LogFoundError(rc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=returnrc)) then - return_error = .true. + error = .true. else - return_error = .false. + error = .false. endif end function return_error From 1190c2e08756c0771d38f6cd613af602290568a2 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Fri, 5 Oct 2018 13:25:09 -0700 Subject: [PATCH 041/556] remove unecessary header file --- lilac/lilac/esmf_utils.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/lilac/lilac/esmf_utils.f90 b/lilac/lilac/esmf_utils.f90 index 7357a9cab0..6a40202bf7 100644 --- a/lilac/lilac/esmf_utils.f90 +++ b/lilac/lilac/esmf_utils.f90 @@ -4,7 +4,6 @@ module esmf_utils #include "ESMF.h" -#include use ESMF implicit none From 4f1b63a3723af70c3b39a71063acf28b4c4463b5 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Mon, 8 Oct 2018 10:55:40 -0700 Subject: [PATCH 042/556] passing build --- lilac/lilac/core.f90 | 317 +++++++++++++++++++++++++++++++++++++ lilac/lilac/esmf_utils.f90 | 230 ++++++++++----------------- lilac/lilac/lilac.f90 | 59 ------- 3 files changed, 404 insertions(+), 202 deletions(-) create mode 100644 lilac/lilac/core.f90 delete mode 100644 lilac/lilac/lilac.f90 diff --git a/lilac/lilac/core.f90 b/lilac/lilac/core.f90 new file mode 100644 index 0000000000..7feec6eac2 --- /dev/null +++ b/lilac/lilac/core.f90 @@ -0,0 +1,317 @@ +module lilac + + use ESMF + use esmf_utils + + implicit none + + character(*), parameter :: modname = "(core)" + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + public :: init + public :: run + public :: final + + private :: atmos_register + private :: land_register + private :: cpl_register + + type, public :: LilacType + private + + type(ESMFInfoType) :: esmf_info + character(len=ESMF_MAXSTR) :: name + + contains + procedure, public :: init => init + procedure, public :: run => run + procedure, public :: final => final + + ! register methods + procedure, nopass, private :: atmos_register => atmos_register + procedure, nopass, private :: land_register => land_register + procedure, nopass, private :: cpl_register => cpl_register + + ! Init methods + procedure, nopass, private :: atmos_init => atmos_init + procedure, nopass, private :: land_init => land_init + procedure, nopass, private :: coupler_init => coupler_init + + ! Run methods + procedure, nopass, private :: atmos_copy_atm_to_lilac => atmos_copy_atm_to_lilac + procedure, nopass, private :: atmos_copy_lilac_to_atm => atmos_copy_lilac_to_atm + procedure, nopass, private :: land_run => land_run + procedure, nopass, private :: coupler_run => coupler_run + + ! Final methods + procedure, nopass, private :: atmos_final => atmos_final + procedure, nopass, private :: land_final => land_final + procedure, nopass, private :: coupler_final => coupler_final + + end type LilacType + +contains + + subroutine init(self, name) + implicit none + class(LilacType), intent(inout) :: self + character(len=ESMF_MAXSTR), intent(in) :: name + + character(len=*), parameter :: subname=trim(modname)//':(init) ' + + call ESMF_LogWrite(subname//"Initializing lilac", ESMF_LOGMSG_INFO) + + self%name = trim(name) + + ! Initialize ESMF structures + call self%esmf_info%init(name, atmos_register, land_register, cpl_register) + + end subroutine init + + subroutine run(self) + implicit none + class(LilacType), intent(inout) :: self + + character(len=*), parameter :: subname=trim(modname)//':(run) ' + + call ESMF_LogWrite(subname//"Running lilac", ESMF_LOGMSG_INFO) + + call self%esmf_info%run() + + end subroutine run + + subroutine final(self) + implicit none + class(LilacType), intent(inout) :: self + + character(len=*), parameter :: subname=trim(modname)//':(final) ' + + call ESMF_LogWrite(subname//"Finalizing lilac", ESMF_LOGMSG_INFO) + + call self%esmf_info%final() + + end subroutine final + + subroutine atmos_register(comp, rc) + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc ! must not be optional + character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' + + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & + userRoutine=atmos_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & + userRoutine=atmos_copy_atm_to_lilac, phase=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & + userRoutine=atmos_copy_lilac_to_atm, phase=2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & + userRoutine=atmos_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + rc = ESMF_SUCCESS + + end subroutine atmos_register + + subroutine land_register(comp, rc) + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc ! must not be optional + character(len=*), parameter :: subname=trim(modname)//':(lnd_register) ' + + ! land_* comes from ctsm esmf cap + + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=land_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=land_run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=land_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + rc = ESMF_SUCCESS + + end subroutine land_register + + subroutine cpl_register(comp, rc) + type(ESMF_CplComp) :: comp ! must not be optional + integer, intent(out) :: rc ! must not be optional + character(len=*), parameter :: subname=trim(modname)//':(cpl_register) ' + + rc = ESMF_FAILURE + + ! Register the callback routines. + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=coupler_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_LogWrite(subname//"CouplerMod: Registered Initialize, Run, and Finalize routines", ESMF_LOGMSG_INFO) + + rc = ESMF_SUCCESS + + end subroutine cpl_register + +subroutine atmos_init(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_init) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"atmos_init has not been implemented yet", ESMF_LOGMSG_INFO) + +end subroutine atmos_init + +subroutine land_init(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(land_init) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"land_init has not been implemented yet", ESMF_LOGMSG_INFO) + +end subroutine land_init + +subroutine coupler_init(comp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(coupler_init) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"coupler_init has not been implemented yet", ESMF_LOGMSG_INFO) + +end subroutine coupler_init + +subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_atm_to_lilac) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) + +end subroutine atmos_copy_atm_to_lilac + +subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_lilac_to_atm) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) + +end subroutine atmos_copy_lilac_to_atm + +subroutine land_run(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(land_run) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"land_run has not been implemented yet", ESMF_LOGMSG_INFO) + +end subroutine land_run + +subroutine coupler_run(comp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(coupler_run) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"coupler_run has not been implemented yet", ESMF_LOGMSG_INFO) + +end subroutine coupler_run + +subroutine atmos_final(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_final) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"atmos_final has not been implemented yet", ESMF_LOGMSG_INFO) + +end subroutine atmos_final + +subroutine land_final(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(land_final) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"land_final has not been implemented yet", ESMF_LOGMSG_INFO) + +end subroutine land_final + +subroutine coupler_final(comp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(coupler_final) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"coupler_final has not been implemented yet", ESMF_LOGMSG_INFO) + +end subroutine coupler_final + +end module lilac diff --git a/lilac/lilac/esmf_utils.f90 b/lilac/lilac/esmf_utils.f90 index 6a40202bf7..57f9cf0168 100644 --- a/lilac/lilac/esmf_utils.f90 +++ b/lilac/lilac/esmf_utils.f90 @@ -11,6 +11,24 @@ module esmf_utils character(*), parameter :: modname = "(esmf_utils)" + interface + subroutine userRoutine(gridcomp, rc) + use ESMF_CompMod + implicit none + type(ESMF_GridComp) :: gridcomp ! must not be optional + integer, intent(out) :: rc ! must not be optional + end subroutine userRoutine + end interface + + interface + subroutine userCplRoutine(cplcomp, rc) + use ESMF_CompMod + implicit none + type(ESMF_CplComp) :: cplcomp ! must not be optional + integer, intent(out) :: rc ! must not be optional + end subroutine userCplRoutine + end interface + ! Consider renaming ESMFInfoType (add lilac to name) type, public :: ESMFInfoType private @@ -34,18 +52,19 @@ module esmf_utils contains - subroutine init(self, name) + subroutine init(self, name, atmos_register, land_register, cpl_register) implicit none - class(ESMFInfoType), intent(inout) :: self - character(len=ESMF_MAXSTR), intent(in) :: name - - ! TODO define subroutines: https://stackoverflow.com/questions/32809769/how-to-pass-subroutine-names-as-arguments-in-fortran + class(ESMFInfoType), intent(inout) :: self + character(len=ESMF_MAXSTR), intent(in) :: name + procedure(userRoutine) :: atmos_register + procedure(userRoutine) :: land_register + procedure(userCplRoutine) :: cpl_register ! Local variables character(len=ESMF_MAXSTR) :: cname1, cname2, cplname - integer :: localPet, petCount, localrc, rc=ESMF_SUCCESS, userrc=ESMF_SUCCESS + integer :: localPet, petCount, rc=ESMF_SUCCESS - character(len=*) :: subname=trim(modname)//':(init) ' + character(len=*), parameter :: subname=trim(modname)//':(init) ' call ESMF_LogWrite(subname//"esmf_info%init()", ESMF_LOGMSG_INFO) @@ -57,75 +76,71 @@ subroutine init(self, name) ! Initialize framework and get back default global VM ! only run if not esmf_isintialized() - call ESMF_Initialize(vm=self%vm, defaultlogfilename="lilac.log", logkindflag=ESMF_LOGKIND_MULTI, rc=localrc) - if (return_error(localrc, rc)) return + call ESMF_Initialize(vm=self%vm, defaultlogfilename="lilac.log", logkindflag=ESMF_LOGKIND_MULTI, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Get number of PETs we are running with - call ESMF_VMGet(self%vm, petCount=petCount, localPet=localPet, rc=localrc) - if (return_error(localrc, rc)) return + call ESMF_VMGet(self%vm, petCount=petCount, localPet=localPet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create the 2 model components and a coupler cname1 = "land" ! use petList to define land on all PET - self%land_comp = ESMF_GridCompCreate(name=cname1, rc=localrc) + self%land_comp = ESMF_GridCompCreate(name=cname1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Created "//trim(cname1)//" component", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return cname2 = "atmosphere" ! use petList to define atmosphere on all PET - self%atmos_comp = ESMF_GridCompCreate(name=cname2, rc=localrc) + self%atmos_comp = ESMF_GridCompCreate(name=cname2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return cplname = "lilac coupler" ! no petList means that coupler component runs on all PETs - self%cpl_comp = ESMF_CplCompCreate(name=cplname, rc=localrc) + self%cpl_comp = ESMF_CplCompCreate(name=cplname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Created "//trim(cplname)//" component", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return call ESMF_LogWrite(subname//"Comp Creates finished", ESMF_LOGMSG_INFO) ! Register section !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(self%atmos_comp, userRoutine=atmos_register, userRc=userrc, rc=localrc) + call ESMF_GridCompSetServices(self%atmos_comp, userRoutine=atmos_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"atmos SetServices finished", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return - if (return_error(userrc, rc)) return - call ESMF_GridCompSetServices(self%land_comp, userRoutine=land_register, userRc=userrc, rc=localrc) + call ESMF_GridCompSetServices(self%land_comp, userRoutine=land_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"land SetServices finished", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return - if (return_error(userrc, rc)) return - call ESMF_CplCompSetServices(self%cpl_comp, userRoutine=cpl_register, userRc=userrc, rc=localrc) + call ESMF_CplCompSetServices(self%cpl_comp, userRoutine=cpl_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Cpl SetServices finished", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return - if (return_error(userrc, rc)) return ! Init section !------------------------------------------------------------------------- ! land import/export states - self%land_import = ESMF_StateCreate(name="land import", stateintent=ESMF_STATEINTENT_IMPORT, rc=localrc) - if (return_error(localrc, rc)) return - self%land_export = ESMF_StateCreate(name="land export", stateintent=ESMF_STATEINTENT_EXPORT, rc=localrc) - if (return_error(localrc, rc)) return - call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, userRc=userrc, rc=localrc) - if (return_error(localrc, rc)) return - if (return_error(userrc, rc)) return + self%land_import = ESMF_StateCreate(name="land import", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + self%land_export = ESMF_StateCreate(name="land export", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Land Initialize finished", ESMF_LOGMSG_INFO) ! atmosphere import/export state - self%atmos_import = ESMF_StateCreate(name="atmos import", & - stateintent=ESMF_STATEINTENT_IMPORT, rc=localrc) - if (return_error(localrc, rc)) return - - self%atmos_export = ESMF_StateCreate(name="atmos export", & - stateintent=ESMF_STATEINTENT_EXPORT, rc=localrc) - if (return_error(localrc, rc)) return - call ESMF_GridCompInitialize(self%atmos_comp, exportState=self%atmos_export, userRc=userrc, rc=localrc) + self%atmos_import = ESMF_StateCreate(name="atmos import", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + self%atmos_export = ESMF_StateCreate(name="atmos export", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompInitialize(self%atmos_comp, exportState=self%atmos_export, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Atmosphere Initialize finished", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return - if (return_error(userrc, rc)) return ! call ESMF_CPLCompInitialize twice (once for each grid comp) @@ -134,8 +149,8 @@ end subroutine init subroutine run(self) implicit none class(ESMFInfoType), intent(inout) :: self - integer :: localrc, rc=ESMF_SUCCESS, userrc=ESMF_SUCCESS - character(len=*), parameter :: subname=trim(modname)//':(init) ' + integer :: rc=ESMF_SUCCESS + character(len=*), parameter :: subname=trim(modname)//':(run) ' call ESMF_LogWrite(subname//"esmf_info%run()", ESMF_LOGMSG_INFO) @@ -143,135 +158,64 @@ subroutine run(self) ! atmosphere run ! copy the atmos state and put it into atmos export - call ESMF_GridCompRun(self%atmos_comp, exportState=self%atmos_export, phase=1, userRc=userrc, rc=localrc) + call ESMF_GridCompRun(self%atmos_comp, exportState=self%atmos_export, phase=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Atmosphere Run returned", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return - if (return_error(userrc, rc)) return ! coupler run call ESMF_CplCompRun(self%cpl_comp, importState=self%atmos_export, exportState=self%land_import, & - userRc=userrc, rc=localrc) + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Coupler Run returned", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return - if (return_error(userrc, rc)) return ! land run - call ESMF_GridCompRun(self%land_comp, importState=self%land_import, exportState=self%land_export, userRc=userrc, rc=localrc) + call ESMF_GridCompRun(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Land Run returned", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return - if (return_error(userrc, rc)) return ! coupler run - call ESMF_CplCompRun(self%cpl_comp, importState=self%land_export, exportState=self%atmos_import, & - userRc=userrc, rc=localrc) + call ESMF_CplCompRun(self%cpl_comp, importState=self%land_export, exportState=self%atmos_import, rc=rc) call ESMF_LogWrite(subname//"Coupler Run returned", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return - if (return_error(userrc, rc)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridCompRun(self%atmos_comp, importState=self%atmos_import, phase=2, userRc=userrc, rc=localrc) + call ESMF_GridCompRun(self%atmos_comp, importState=self%atmos_import, phase=2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Atmosphere Run returned", ESMF_LOGMSG_INFO) - if (return_error(localrc, rc)) return - if (return_error(userrc, rc)) return end subroutine run subroutine final(self) implicit none class(ESMFInfoType), intent(inout) :: self - integer :: localrc, rc=ESMF_SUCCESS + integer :: rc=ESMF_SUCCESS character(len=*), parameter :: subname=trim(modname)//':(final) ' call ESMF_LogWrite(subname//"esmf_info%final()", ESMF_LOGMSG_INFO) ! Destroy section - call ESMF_GridCompDestroy(self%atmos_comp, rc=localrc) - if (return_error(localrc, rc)) return - call ESMF_GridCompDestroy(self%land_comp, rc=localrc) - if (return_error(localrc, rc)) return - call ESMF_CplCompDestroy(self%cpl_comp, rc=localrc) - if (return_error(localrc, rc)) return - - call ESMF_StateDestroy(self%land_export, rc=localrc) - call ESMF_StateDestroy(self%land_import, rc=localrc) - if (return_error(localrc, rc)) return - call ESMF_StateDestroy(self%atmos_export, rc=localrc) - call ESMF_StateDestroy(self%atmos_import, rc=localrc) - ! do this everywhere - if (return_error(localrc, rc)) return - - call ESMF_LogWrite(subname//"All Destroy routines done", ESMF_LOGMSG_INFO) - - end subroutine final + call ESMF_GridCompDestroy(self%atmos_comp, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - subroutine atmos_register(comp, rc) - type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(out) :: rc ! must not be optional - character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' + call ESMF_GridCompDestroy(self%land_comp, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - userRoutine=atoms_init, rc=rc) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - userRoutine=atoms_copy_atm_to_lilac, phase=1, rc=rc) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - userRoutine=atoms_copy_lilac_to_atm, phase=2, rc=rc) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - userRoutine=atoms_final, rc=rc) - ! TODO: check rcs + call ESMF_CplCompDestroy(self%cpl_comp, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - rc = ESMF_SUCCESS + call ESMF_StateDestroy(self%land_export, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end subroutine atmos_register + call ESMF_StateDestroy(self%land_import, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - subroutine land_register(comp, rc) - type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(out) :: rc ! must not be optional - character(len=*), parameter :: subname=trim(modname)//':(lnd_register) ' + call ESMF_StateDestroy(self%atmos_export, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! land_* comes from ctsm esmf cap + call ESMF_StateDestroy(self%atmos_import, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=land_init, rc=rc) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=land_run, rc=rc) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=land_final, rc=rc) - ! TODO: check rcs - - rc = ESMF_SUCCESS - - end subroutine land_register - - subroutine cpl_register(comp, rc) - type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(out) :: rc ! must not be optional - character(len=*), parameter :: subname=trim(modname)//':(cpl_register) ' - - rc = ESMF_FAILURE - - ! Register the callback routines. - - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=coupler_init, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_LogWrite(subname//"CouplerMod: Registered Initialize, Run, and Finalize routines", ESMF_LOGMSG_INFO) - - rc = ESMF_SUCCESS - - end subroutine cpl_register - - function return_error(rc, returnrc) result(error) - ! fight with this later - integer, intent(in) :: rc, returnrc - logical :: error - if (ESMF_LogFoundError(rc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=returnrc)) then - error = .true. - else - error = .false. - endif + call ESMF_LogWrite(subname//"All Destroy routines done", ESMF_LOGMSG_INFO) - end function return_error + end subroutine final end module esmf_utils diff --git a/lilac/lilac/lilac.f90 b/lilac/lilac/lilac.f90 deleted file mode 100644 index b80c3c8616..0000000000 --- a/lilac/lilac/lilac.f90 +++ /dev/null @@ -1,59 +0,0 @@ -module lilac - - use ESMF - - use atmos_comp, only : atmos_setvm, atmos_register - use land_comp, only : land_setvm, land_register - use coupler_comp, only : usercpl_setvm, usercpl_register - - implicit none - - !-------------------------------------------------------------------------- - ! Public interfaces - !-------------------------------------------------------------------------- - public :: lilac_init - public :: lilac_run - public :: lilac_final - - type(LilacType), save :: lilac_obj - -contains - - type, public :: LilacType - private - - type(ESMFInfoType) :: esmf_info - - contains - procedure, public :: init => init - procedure, public :: run => run - procedure, public :: final => final - end type LilacType - -contains - - subroutine lilac_init(self) - implicit none - - print *, "lilac_init()" - - ! Initialize ESMF structures - call self%esmf_info%init("lilac") - - end subroutine lilac_init - - subroutine lilac_run(self) - implicit none - - call self%esmf_info%run() - - end subroutine lilac_run - - subroutine lilac_final(self) - implicit none - - call self%esmf_info%final() - - end subroutine lilac_final - -end module lilac From 9a1b5bdc46c2022ccbe884ac154c605d11a6c4a8 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Mon, 8 Oct 2018 12:16:16 -0700 Subject: [PATCH 043/556] fixup formatting --- lilac/lilac/core.f90 | 46 ++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/lilac/lilac/core.f90 b/lilac/lilac/core.f90 index 7feec6eac2..91ff33fd6c 100644 --- a/lilac/lilac/core.f90 +++ b/lilac/lilac/core.f90 @@ -62,7 +62,7 @@ subroutine init(self, name) character(len=*), parameter :: subname=trim(modname)//':(init) ' call ESMF_LogWrite(subname//"Initializing lilac", ESMF_LOGMSG_INFO) - + self%name = trim(name) ! Initialize ESMF structures @@ -151,10 +151,10 @@ subroutine cpl_register(comp, rc) ! Register the callback routines. call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=coupler_init, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - + call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -164,7 +164,7 @@ subroutine cpl_register(comp, rc) end subroutine cpl_register -subroutine atmos_init(comp, importState, exportState, clock, rc) + subroutine atmos_init(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -177,9 +177,9 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"atmos_init has not been implemented yet", ESMF_LOGMSG_INFO) -end subroutine atmos_init + end subroutine atmos_init -subroutine land_init(comp, importState, exportState, clock, rc) + subroutine land_init(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -192,9 +192,9 @@ subroutine land_init(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"land_init has not been implemented yet", ESMF_LOGMSG_INFO) -end subroutine land_init + end subroutine land_init -subroutine coupler_init(comp, importState, exportState, clock, rc) + subroutine coupler_init(comp, importState, exportState, clock, rc) type(ESMF_CplComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -207,9 +207,9 @@ subroutine coupler_init(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"coupler_init has not been implemented yet", ESMF_LOGMSG_INFO) -end subroutine coupler_init + end subroutine coupler_init -subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) + subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -222,9 +222,9 @@ subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) -end subroutine atmos_copy_atm_to_lilac + end subroutine atmos_copy_atm_to_lilac -subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) + subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -237,9 +237,9 @@ subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) -end subroutine atmos_copy_lilac_to_atm + end subroutine atmos_copy_lilac_to_atm -subroutine land_run(comp, importState, exportState, clock, rc) + subroutine land_run(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -252,9 +252,9 @@ subroutine land_run(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"land_run has not been implemented yet", ESMF_LOGMSG_INFO) -end subroutine land_run + end subroutine land_run -subroutine coupler_run(comp, importState, exportState, clock, rc) + subroutine coupler_run(comp, importState, exportState, clock, rc) type(ESMF_CplComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -267,9 +267,9 @@ subroutine coupler_run(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"coupler_run has not been implemented yet", ESMF_LOGMSG_INFO) -end subroutine coupler_run + end subroutine coupler_run -subroutine atmos_final(comp, importState, exportState, clock, rc) + subroutine atmos_final(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -282,9 +282,9 @@ subroutine atmos_final(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"atmos_final has not been implemented yet", ESMF_LOGMSG_INFO) -end subroutine atmos_final + end subroutine atmos_final -subroutine land_final(comp, importState, exportState, clock, rc) + subroutine land_final(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -297,9 +297,9 @@ subroutine land_final(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"land_final has not been implemented yet", ESMF_LOGMSG_INFO) -end subroutine land_final + end subroutine land_final -subroutine coupler_final(comp, importState, exportState, clock, rc) + subroutine coupler_final(comp, importState, exportState, clock, rc) type(ESMF_CplComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -312,6 +312,6 @@ subroutine coupler_final(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"coupler_final has not been implemented yet", ESMF_LOGMSG_INFO) -end subroutine coupler_final + end subroutine coupler_final end module lilac From 5473eb753849ad8677ddbb4703a887e2f06173c1 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Mon, 8 Oct 2018 13:25:44 -0700 Subject: [PATCH 044/556] autodoc fortran codes --- lilac/docs/api.rst | 8 ++++++- lilac/docs/conf.py | 27 +++++++++++++++++++++-- lilac/docs/developers.rst | 28 ++++++++++++++++++++++++ lilac/docs/index.rst | 45 +++++---------------------------------- 4 files changed, 65 insertions(+), 43 deletions(-) create mode 100644 lilac/docs/developers.rst diff --git a/lilac/docs/api.rst b/lilac/docs/api.rst index 6859fd3e1a..dac6446ce8 100644 --- a/lilac/docs/api.rst +++ b/lilac/docs/api.rst @@ -11,4 +11,10 @@ The atmosphere component will need to call each of the following subroutines: * `lilac_run` * `lilac_final` -TODO: fill in this section as the api comes together. +LILAC Core +---------- +.. f:autosrcfile:: core.f90 + +ESMF Utils +---------- +.. f:autosrcfile:: esmf_utils.f90 diff --git a/lilac/docs/conf.py b/lilac/docs/conf.py index 767f7287b1..f8c67d5d2b 100644 --- a/lilac/docs/conf.py +++ b/lilac/docs/conf.py @@ -12,7 +12,7 @@ # add these directories to sys.path here. If the directory is relative to the # documentation root, use os.path.abspath to make it absolute, like shown here. # -# import os +import os # import sys # sys.path.insert(0, os.path.abspath('.')) @@ -39,7 +39,14 @@ # extensions coming with Sphinx (named 'sphinx.ext.*') or your custom # ones. extensions = [ + 'sphinx.ext.autodoc', + 'sphinx.ext.todo', + 'sphinx.ext.coverage', + 'sphinx.ext.imgmath', + 'sphinx.ext.ifconfig', 'sphinx.ext.intersphinx', + 'sphinxfortran.fortran_domain', + 'sphinxfortran.fortran_autodoc', ] # Add any paths that contain templates here, relative to this directory. @@ -50,6 +57,7 @@ # # source_suffix = ['.rst', '.md'] source_suffix = '.rst' +fortran_src = '*f90' # The master toctree document. master_doc = 'index' @@ -161,4 +169,19 @@ # -- Options for intersphinx extension --------------------------------------- # Example configuration for intersphinx: refer to the Python standard library. -intersphinx_mapping = {'https://docs.python.org/': None} \ No newline at end of file +intersphinx_mapping = {'https://docs.python.org/': None} + + +## -- Options for Sphinx-Fortran --------------------------------------------- +# List of possible extensions in the case of a directory listing +fortran_ext = ['f90', 'F90', 'f95', 'F95'] + +# This variable must be set with file pattern, like "*.f90", or a list of them. +# It is also possible to specify a directory name; in this case, all files than +# have an extension matching those define by the config variable `fortran_ext` +# are used. +fortran_src = [os.path.abspath('../lilac/')] + +# Indentation string or length (default 4). If it is an integer, +# indicates the number of spaces. +fortran_indent = 4 diff --git a/lilac/docs/developers.rst b/lilac/docs/developers.rst new file mode 100644 index 0000000000..f4910d80d6 --- /dev/null +++ b/lilac/docs/developers.rst @@ -0,0 +1,28 @@ +Developers Guide to Using LILAC +=============================== + +Building LILAC +-------------- + +LILAC can be build using CMake:: + + $ cd /lilac/build && cmake .. + $ make + +For development and testing purposes, LILAC can also be built using a +`docker-compose` script:: + + $ docker-compose build + $ docker-compose run + +Testing LILAC +------------- + +LILAC includes a full test suite including unit tests and a number of +simplified coupled model tests. To run these tests, simply run the `ctest` +command:: + + $ ctest + +Note, if you are using the docker-compose development, the `docker-compose run` +command will build and run LILAC automatically. diff --git a/lilac/docs/index.rst b/lilac/docs/index.rst index f6c4a09751..e7c7a097f7 100644 --- a/lilac/docs/index.rst +++ b/lilac/docs/index.rst @@ -4,48 +4,13 @@ LILAC: Lightweight Infrastructure for Land Atmosphere Coupling LILAC is a new coupling interface for the Community Terrestrial Systems Model (CTSM). It provides a high-level Fortran API for coupling CTSM to atmospheric models such as the Weather Research and Forecast (WRF) model. LILAC makes -extensive use of the Earth System Modeling Framework (ESMF). - -Building LILAC --------------- - -LILAC can be build using CMake. - - $ cd /lilac/build && cmake .. - $ make - -For development and testing purposes, LILAC can also be built using a -`docker-compose` script. - - $ docker-compose build - # docker-compose run - -Testing LILAC -------------- - -LILAC includes a full test suite including unit tests and a number of -simplified coupled model tests. To run these tests, simply run the `ctest` -command: - - $ ctest - -Note, if you are using the docker-compose development, the `docker-compose run` -command will build and run LILAC automatically. - - - - -More coming soon. +extensive use of the Earth System Modeling Framework (ESMF). .. toctree:: :maxdepth: 2 :caption: Contents: - - -Indices and tables -================== - -* :ref:`genindex` -* :ref:`modindex` -* :ref:`search` +Contents +--------------- +* :doc:`developers` +* :doc:`api` From 09ad7d04e7da83cee3435253eb6f711e23c6184d Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Mon, 8 Oct 2018 13:31:19 -0700 Subject: [PATCH 045/556] add reqs for doc build --- lilac/.gitmodules | 2 ++ lilac/docs/requirements.txt | 2 ++ 2 files changed, 4 insertions(+) create mode 100644 lilac/docs/requirements.txt diff --git a/lilac/.gitmodules b/lilac/.gitmodules index 2f471a14d9..3836c21e6b 100644 --- a/lilac/.gitmodules +++ b/lilac/.gitmodules @@ -1,6 +1,8 @@ [submodule "external/pfunit"] path = external/pfunit url = https://github.com/laristra/pfunit.git + shallow = true [submodule "external/esmf"] path = external/esmf url = https://git.code.sf.net/p/esmf/esmf + shallow = true diff --git a/lilac/docs/requirements.txt b/lilac/docs/requirements.txt new file mode 100644 index 0000000000..5edaa385f9 --- /dev/null +++ b/lilac/docs/requirements.txt @@ -0,0 +1,2 @@ +numpy +sphinx-fortran From ef3cb0c4e60787b21d50a278e4df7cf0b25a7886 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Mon, 8 Oct 2018 13:34:22 -0700 Subject: [PATCH 046/556] pip sphinx --- lilac/docs/requirements.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/lilac/docs/requirements.txt b/lilac/docs/requirements.txt index 5edaa385f9..f3d707325c 100644 --- a/lilac/docs/requirements.txt +++ b/lilac/docs/requirements.txt @@ -1,2 +1,3 @@ numpy sphinx-fortran +sphinx==1.6.7 \ No newline at end of file From 59b944b42116d8b7df686347c7d4e191c0032fa0 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Wed, 14 Nov 2018 17:34:10 -0800 Subject: [PATCH 047/556] bare bones test, no moving data yet --- lilac/.gitignore | 1 + lilac/CMakeLists.txt | 2 +- lilac/Dockerfile | 12 +- lilac/docker-compose.yml | 1 - lilac/lilac/core.f90 | 1 + lilac/tests/CMakeLists.txt | 3 +- lilac/tests/hello_world/CMakeLists.txt | 3 - lilac/tests/hello_world/main.f90 | 21 ---- lilac/tests/rand_atm_rand_lnd/CmakeLists.txt | 7 +- lilac/tests/rand_atm_rand_lnd/main.f90 | 15 +++ lilac/tests/rand_atm_rand_lnd/rand_test.f90 | 112 +++++++++++++++++++ 11 files changed, 140 insertions(+), 38 deletions(-) delete mode 100644 lilac/tests/hello_world/CMakeLists.txt delete mode 100644 lilac/tests/hello_world/main.f90 create mode 100644 lilac/tests/rand_atm_rand_lnd/rand_test.f90 diff --git a/lilac/.gitignore b/lilac/.gitignore index 21537a4ee9..6e5803401e 100644 --- a/lilac/.gitignore +++ b/lilac/.gitignore @@ -14,3 +14,4 @@ components/ *.pyc build/ +_build/ diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 4268ea956d..10630051ce 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -31,7 +31,7 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") # TODO: This should not be necessary but certain header files are missing from the build -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I /usr/include/ -I/usr/src/lilac/external/esmf/src/Infrastructure/Util/include -I/usr/src/lilac/external/esmf/build_config/Linux.gfortran.default -I /usr/src/lilac/external/esmf/src/include") +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/usr/include/ -I/usr/src/esmf/src/Infrastructure/Util/include/ -I/usr/src/esmf/build_config/Linux.gfortran.default -I /usr/src/esmf/src/include") message("CMAKE_Fortran_FLAGS:" ${CMAKE_Fortran_FLAGS}) add_subdirectory(lilac) diff --git a/lilac/Dockerfile b/lilac/Dockerfile index bebcc00428..cdd4200a64 100644 --- a/lilac/Dockerfile +++ b/lilac/Dockerfile @@ -1,19 +1,17 @@ -FROM centos:latest +FROM jhamman/esmf:latest LABEL description="LILAC development environment" RUN yum install -y curl RUN yum upgrade -y RUN yum update -y RUN yum clean all -RUN yum -y install wget bzip2 gcc gcc-c++ gcc-gfortran mpich-devel make git -ENV PATH="/usr/lib64/mpich/bin:${PATH}" +RUN yum -y install wget bzip2 WORKDIR /usr/src/lilac/ RUN mkdir -p external RUN mkdir -p ci -COPY external/esmf external/esmf COPY external/pfunit external/pfunit COPY ci/* ci/ @@ -21,10 +19,8 @@ COPY ci/* ci/ ENV PATH /usr/local/miniconda/bin:$PATH RUN ./ci/install_python.sh -# Install ESMF -RUN ./ci/install_esmf.sh ENV ESMF_CONFIG_FILE /usr/local/lib/esmf.mk # Install PFUNIT -# RUN ./ci/install_pfunit.sh -# ENV PFUNIT_INSTALL /usr/pfunit +RUN ./ci/install_pfunit.sh +ENV PFUNIT_INSTALL /usr/pfunit diff --git a/lilac/docker-compose.yml b/lilac/docker-compose.yml index 422b0bc607..8bd538f458 100644 --- a/lilac/docker-compose.yml +++ b/lilac/docker-compose.yml @@ -7,4 +7,3 @@ services: volumes: - .:/lilac command: /lilac/ci/build_and_test_lilac.sh - diff --git a/lilac/lilac/core.f90 b/lilac/lilac/core.f90 index 91ff33fd6c..ced01bb32c 100644 --- a/lilac/lilac/core.f90 +++ b/lilac/lilac/core.f90 @@ -6,6 +6,7 @@ module lilac implicit none character(*), parameter :: modname = "(core)" + integer, parameter :: LILAC_SUCCESS = ESMF_SUCCESS !-------------------------------------------------------------------------- ! Public interfaces diff --git a/lilac/tests/CMakeLists.txt b/lilac/tests/CMakeLists.txt index 6361d9e9c2..7de7443322 100644 --- a/lilac/tests/CMakeLists.txt +++ b/lilac/tests/CMakeLists.txt @@ -1,2 +1,3 @@ # Add tests here -add_subdirectory(hello_world) +add_subdirectory(rand_atm_rand_lnd) +target_include_directories(lilac PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/lilac/tests/hello_world/CMakeLists.txt b/lilac/tests/hello_world/CMakeLists.txt deleted file mode 100644 index 0e5fbd44bc..0000000000 --- a/lilac/tests/hello_world/CMakeLists.txt +++ /dev/null @@ -1,3 +0,0 @@ -file(GLOB_RECURSE SOURCES *.f90 *.h) -add_executable("test_hello_world" ${SOURCES} ) -target_link_libraries(lilac) diff --git a/lilac/tests/hello_world/main.f90 b/lilac/tests/hello_world/main.f90 deleted file mode 100644 index 78312075c1..0000000000 --- a/lilac/tests/hello_world/main.f90 +++ /dev/null @@ -1,21 +0,0 @@ -program main - - ! modules - use ESMF - ! use lilac, ONLY : lilac_init - - implicit none - - ! local variables - integer:: rc - - ! call lilac_init() - ! TODO fix linking with lilac - call ESMF_Initialize(rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - print *, "Hello LILAC World" - - call ESMF_Finalize() - -end program main diff --git a/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt b/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt index c7c253746b..f7b14fc7d5 100644 --- a/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt +++ b/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt @@ -1,4 +1,5 @@ -file(GLOB TEST_SOURCES *.f90 *.h) -add_executable(rand_atm_rand_land ${TEST_SOURCES} ) -target_link_libraries(rand_atm_rand_land) +file(GLOB_RECURSE SOURCES *.f90 *.h) +add_executable("rand_atm_rand_land" ${SOURCES}) +target_link_libraries(rand_atm_rand_land lilac) +target_include_directories(lilac PUBLIC ${CMAKE_BINARY_DIR}/lilac) diff --git a/lilac/tests/rand_atm_rand_lnd/main.f90 b/lilac/tests/rand_atm_rand_lnd/main.f90 index f0c343cc4f..3d0284eab2 100644 --- a/lilac/tests/rand_atm_rand_lnd/main.f90 +++ b/lilac/tests/rand_atm_rand_lnd/main.f90 @@ -1,5 +1,20 @@ program main + use rand_test, only : atm_driver + use ESMF + implicit none + + ! local variables + integer:: rc + + rc = 0 + print *, "Running Atmosphere Driver" + + call atm_driver(rc) + + if (rc /= ESMF_SUCCESS) stop 1 + + print *, "Done Running Atmosphere Driver" end program main diff --git a/lilac/tests/rand_atm_rand_lnd/rand_test.f90 b/lilac/tests/rand_atm_rand_lnd/rand_test.f90 new file mode 100644 index 0000000000..70263d243c --- /dev/null +++ b/lilac/tests/rand_atm_rand_lnd/rand_test.f90 @@ -0,0 +1,112 @@ +module rand_test + + use lilac, only : LilacType + use ESMF + + implicit none + + character(*), parameter :: modname = "(rand_test)" + integer, parameter :: num_timesteps = 10 + type(LilacType), save :: lilac_obj + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + public :: atm_driver + + private :: atm_init + private :: lnd_init + private :: atm_run + private :: lnd_run + private :: atm_final + private :: lnd_final + +contains + + subroutine atm_driver(rc) + + integer, intent(out) :: rc + + + call atm_init(rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call atm_run(rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + + call atm_final(rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine atm_driver + + subroutine atm_init(rc) + + integer, intent(out) :: rc + + ! Initialize atmosphere + ! TODO + + ! Initialize land via lilac + call lnd_init(rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine atm_init + + + subroutine lnd_init(rc) + + integer, intent(out) :: rc + character(len=ESMF_MAXSTR), parameter :: lilac_name="lilac_rand_test" + + call lilac_obj%init(lilac_name) + + + end subroutine lnd_init + + + subroutine atm_run(rc) + + integer, intent(out) :: rc + + integer :: n + + ! Run atm for num_timesteps + do n = 1, num_timesteps, 1 + print *, "------ Running land -------" + ! Run land via lilac + call lnd_run(rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end do + + end subroutine atm_run + + + subroutine lnd_run(rc) + + integer, intent(out) :: rc + + call lilac_obj%run() + + + end subroutine lnd_run + + + subroutine atm_final(rc) + + integer, intent(out) :: rc + + + end subroutine atm_final + + + subroutine lnd_final(rc) + + integer, intent(out) :: rc + + call lilac_obj%final() + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine lnd_final + +end module rand_test From 763817cbe6e221b4d9dfb9146abfcafd8c2f10ed Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Wed, 14 Nov 2018 22:22:56 -0800 Subject: [PATCH 048/556] adjust name of random test --- lilac/ci/build_and_test_lilac.sh | 6 +++++- lilac/tests/rand_atm_rand_lnd/CmakeLists.txt | 4 ++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/lilac/ci/build_and_test_lilac.sh b/lilac/ci/build_and_test_lilac.sh index 3b7fca20f5..6ed3c17e6e 100755 --- a/lilac/ci/build_and_test_lilac.sh +++ b/lilac/ci/build_and_test_lilac.sh @@ -16,4 +16,8 @@ make VERBOSE=1 # -j 4 echo "done building lilac, time to run the tests..." # run test suite -ctest \ No newline at end of file +ctest + +# run system tests +# TODO: these should probably be run via ctest +/lilac/build/tests/rand_atm_rand_lnd/rand_atm_rand_lnd \ No newline at end of file diff --git a/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt b/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt index f7b14fc7d5..5807d75fb0 100644 --- a/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt +++ b/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt @@ -1,5 +1,5 @@ file(GLOB_RECURSE SOURCES *.f90 *.h) -add_executable("rand_atm_rand_land" ${SOURCES}) -target_link_libraries(rand_atm_rand_land lilac) +add_executable("rand_atm_rand_lnd" ${SOURCES}) +target_link_libraries(rand_atm_rand_lnd lilac) target_include_directories(lilac PUBLIC ${CMAKE_BINARY_DIR}/lilac) From d4b6dcc426c4245af384420c0ba5107d9a16be1a Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 28 Feb 2019 10:53:33 -0700 Subject: [PATCH 049/556] added draft data driver --- lilac/lilac/drivers/data_driver.f90 | 352 ++++++++++++++++++++++++++++ 1 file changed, 352 insertions(+) create mode 100644 lilac/lilac/drivers/data_driver.f90 diff --git a/lilac/lilac/drivers/data_driver.f90 b/lilac/lilac/drivers/data_driver.f90 new file mode 100644 index 0000000000..b5cb581d9b --- /dev/null +++ b/lilac/lilac/drivers/data_driver.f90 @@ -0,0 +1,352 @@ + +PROGRAM lilac_data_driver + + use seq_flds_mod , only: & + seq_flds_x2l_states, seq_flds_x2l_fluxes, seq_flds_x2l_fields, & + seq_flds_l2x_states, seq_flds_l2x_fluxes, seq_flds_l2x_fields, & + seq_flds_dom_coord, seq_flds_dom_other, seq_flds_dom_fields + use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata + use shr_sys_mod , only: shr_sys_flush, shr_sys_abort + use shr_orb_mod , only: shr_orb_params + use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel + use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 + use ESMF + + implicit none + +#include ! mpi library include file + + !----- Clocks ----- + type(ESMF_Clock) :: EClock ! Input synchronization clock + type(ESMF_Time) :: CurrTime, StartTime, StopTime + type(ESMF_TimeInterval) :: TimeStep + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar),target :: Calendar + integer :: yy,mm,dd,sec + + !----- MPI/MCT ----- + integer :: mpicom_clmdrv ! local mpicom + integer :: ID_clmdrv ! mct ID + integer :: ncomps ! number of separate components for MCT + integer :: ntasks,mytask ! mpicom size and rank + integer :: global_comm ! copy of mpi_comm_world for pio + integer,allocatable :: comp_id(:) ! for pio init2 + logical,allocatable :: comp_iamin(:) ! for pio init2 + character(len=64),allocatable :: comp_name(:) ! for pio init2 + integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 + + !----- Land Coupling Data ----- + ! type(seq_cdata) :: cdata ! Input land-model driver data + ! type(seq_infodata_type),target :: infodata ! infodata type + ! type(mct_aVect) :: x2l, l2x ! land model import and export states + ! type(mct_gGrid),target :: dom_lnd ! domain data for clm + ! type(mct_gsMap),target :: gsmap_lnd ! gsmap data for clm + integer :: orb_iyear ! Orbital + real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp + character(len=128) :: case_name, case_desc, model_version, hostname, username + character(len=128) :: start_type + logical :: brnch_retain_casename, single_column, atm_aero + real*8 :: scmlat, scmlon + integer :: idx_Sa_z, idx_Sa_u, idx_Sa_v, idx_Sa_tbot, idx_Sa_ptem, & + idx_Sa_shum, idx_Sa_pbot, idx_Faxa_rainc, idx_Faxa_rainl, & + idx_Faxa_snowc, idx_Faxa_snowl, idx_Faxa_lwdn, idx_Faxa_swndr, & + idx_Faxa_swvdr, idx_Faxa_swndf, idx_Faxa_swvdf + + !----- Atm Model ----- + integer :: atm_nx, atm_ny + integer :: gsize, lsize, gstart, gend ! domain decomp info + integer, allocatable :: gindex(:) ! domain decomp info + type(mct_aVect) :: x2l_a ! data for land on atm decomp + type(mct_aVect) :: l2x_a ! data from land on atm decomp + type(mct_gsMap) :: gsmap_atm ! gsmap data for atm + type(mct_rearr) :: rearr_atm2lnd ! rearranger for atm to land + type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm + + !----- Other ----- + integer :: n,m ! counter + character(len=128) :: string ! temporary string + integer :: ierr, rc ! local error status + integer :: iunit = 250 ! clmdrv log unit number + integer :: sunit = 249 ! share log unit number + character(len=*),parameter :: subname = 'clmdrv' + + type fld_list_type + character(len=128) :: stdname + end type fld_list_type + + !---------------------------------------------- + + !---------------------------------------------- + !--- MPI/MCT --- + !---------------------------------------------- + + call MPI_Init(ierr) + call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_clmdrv, ierr) + call MPI_COMM_RANK(mpicom_clmdrv, mytask, ierr) + call MPI_COMM_SIZE(mpicom_clmdrv, ntasks, ierr) + + ncomps = 1 + ID_clmdrv = 1 + call mct_world_init(ncomps,MPI_COMM_WORLD,mpicom_clmdrv,ID_clmdrv) + + !---------------------------------------------- + !--- Log File and PIO --- + !---------------------------------------------- + + global_comm = MPI_COMM_WORLD + call shr_pio_init1(ncomps, 'pio_in', global_comm) + allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) + do n = 1,ncomps + comp_id(n) = ID_clmdrv + comp_name(n) = 'LND' + comp_iamin(n) = .true. + comp_comm(n) = mpicom_clmdrv + comp_comm_iam(n) = mytask + enddo + call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) + deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) + + write(string,'(a,i4.4)') 'clmdrv.log.',mytask + open(iunit, file=trim(string)) + write(iunit,*) subname,' STARTING' + call shr_sys_flush(iunit) + + write(iunit,*) subname,' ntasks = ',ntasks + write(iunit,*) subname,' mytask = ',mytask + write(iunit,*) subname,' mct ID = ',ID_clmdrv + call shr_sys_flush(iunit) + call shr_file_setLogUnit(sunit) + call shr_file_setLogLevel(1) + + !---------------------------------------------- + !--- Clocks --- + !---------------------------------------------- + + call ESMF_Initialize(rc=rc) + Calendar = ESMF_CalendarCreate( name='clmdrv_NOLEAP', & + calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + EClock = ESMF_ClockCreate(name='clmdrv_EClock', & + TimeStep=TimeStep, startTime=StartTime, & + RefTime=StartTime, stopTime=stopTime, rc=rc) + + EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop' , & + clock=EClock, ringTime=StopTime, rc=rc) + EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', & + clock=EClock, ringTime=StopTime, rc=rc) + + call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec + call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + !---------------------------------------------- + !--- Coupling --- + !---------------------------------------------- + + !--- coupling fields + seq_flds_dom_coord='lat:lon' + seq_flds_dom_other='area:aream:mask:frac' + seq_flds_dom_fields=trim(seq_flds_dom_coord)//':'//trim(seq_flds_dom_other) + + seq_flds_x2l_states= 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_pbot:Sg_icemask:Sg_icemask_coupled_fluxes' + seq_flds_x2l_fluxes= 'Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_lwdn:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Faxa_bcphidry:Faxa_bcphodry:Faxa_bcphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_ocphiwet:Faxa_dstwet1:Faxa_dstwet2:Faxa_dstwet3:Faxa_dstwet4:Faxa_dstdry1:Faxa_dstdry2:Faxa_dstdry3:Faxa_dstdry4:Flrr_flood:Flrr_volr' + seq_flds_x2l_fields= trim(seq_flds_x2l_states)//':'//trim(seq_flds_x2l_fluxes) + + seq_flds_l2x_states= 'Sl_avsdr:Sl_anidr:Sl_avsdf:Sl_anidf:Sl_tref:Sl_qref:Sl_t:Sl_fv:Sl_ram1:Sl_snowh:Sl_u10' + seq_flds_l2x_fluxes= 'Fall_swnet:Fall_taux:Fall_tauy:Fall_lat:Fall_sen:Fall_lwup:Fall_evap:Fall_flxdst1:Fall_flxdst2:Fall_flxdst3:Fall_flxdst4:Flrl_rofl:Flrl_rofi:Fall_voc001:Fall_voc002:Fall_voc003:Fall_voc004:Fall_voc005:Fall_voc006:Fall_voc007:Fall_voc008' + seq_flds_l2x_fields= trim(seq_flds_l2x_states)//':'//trim(seq_flds_l2x_fluxes) + + !--- set orbital params + orb_iyear = 1990 + call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & + orb_obliqr, orb_lambm0, orb_mvelpp, .true.) + ! call seq_infodata_putData(infodata, orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, & + ! orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr ) + + !--- set case information + case_name = 'clmdrv' + case_desc = 'clmdrv with clm' + model_version = 'clmdrv0.1' + hostname = 'undefined' + username = 'undefined' + start_type = 'startup' + brnch_retain_casename = .true. + single_column = .false. + scmlat = 0.0 + scmlon = 0.0 + atm_aero = .true. + call seq_infodata_putData(infodata, case_name=case_name, & + case_desc=case_desc, single_column=single_column, & + scmlat=scmlat, scmlon=scmlon, & + brnch_retain_casename=brnch_retain_casename, & + start_type=start_type, model_version=model_version, & + hostname=hostname, username=username, & + atm_aero=atm_aero ) + + !---------------------------------------------- + !--- lnd_init --- + !---------------------------------------------- + + write(iunit,*) subname,' calling lnd_init_mct' + call shr_sys_flush(iunit) + ! call lnd_init_mct(Eclock, cdata, x2l, l2x) + + call diag_avect(l2x,mpicom_clmdrv,'l2x_init') + + idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') + idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') + idx_Sa_v = mct_avect_indexra(x2l,'Sa_v') + idx_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') + idx_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') + idx_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') + idx_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') + idx_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') + idx_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') + idx_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') + idx_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') + idx_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') + idx_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') + idx_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') + idx_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') + idx_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') + + !---------------------------------------------- + !--- atm and atm/lnd coupling init --- + !---------------------------------------------- + + ! read in the mesh + ! TODO: set cvalue to filepath of atm mesh + cvalue = "/path/to/foo" + + if (masterproc) then + write(iulog,*)'mesh file for domain is ',trim(cvalue) + end if + + EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + + + state = ESMF_StateCreate(name=statename, & + stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + + ! Create Field Bundle + FBout = ESMF_FieldBundleCreate(name=trim(lname), rc=rc) + + ! Create individual states and add to field bundle + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name="Sa_z", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Add FB to state + call ESMF_StateAdd(state, (/FBout/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! fill in pointer with data + call ESMF_StateGet(State, itemName="Sa_z", field=lfield, rc=rc) + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + + ! then + fldptr = 30.0 + + !---------------------------------------------- + !--- Time Loop --- + !---------------------------------------------- + + call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) + do while (CurrTime < StopTime) + call ESMF_ClockAdvance(EClock, rc=rc) + call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) + call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' clmdrv ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + ! can manually override the alarms as needed + call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) + if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) + + ! set the coupling data that is sent to the land model, this is on atm decomp + ! this is just sample test data + ! these all need to be set in the pointers + Sa_z = 30.0 ! m + Sa_u = 0.0 ! m/s + Sa_v = 0.0 ! m/s + Sa_tbot = 280.0 ! degK + Sa_ptem = 280.0 ! degK + Sa_shum = 0.0004 ! kg/kg + Sa_pbot = 100100.0 ! Pa + Faxa_rainc = 4.0e-8 ! kg/m2s + Faxa_rainl = 3.0e-8 ! kg/m2s + Faxa_snowc = 1.0e-8 ! kg/m2s + Faxa_snowl = 2.0e-8 ! kg/m2s + Faxa_lwdn = 200.0 ! W/m2 + Faxa_swndr = 100.0 ! W/m2 + Faxa_swvdr = 90.0 ! W/m2 + Faxa_swndf = 20.0 ! W/m2 + Faxa_swvdf = 40.0 ! W/m2 + + ! run clm + write(iunit,*) subname,' call lilac%run',yy,mm,dd,sec + call lilac%run(importState, exportState, clock) + ! call lnd_run_mct(Eclock, cdata, x2l, l2x) + + enddo + + !---------------------------------------------- + !--- lnd_final --- + !---------------------------------------------- + + write(iunit,*) subname,' calling lnd_final_mct' + call shr_sys_flush(iunit) + ! call lnd_final_mct(Eclock, cdata, x2l, l2x) + + !---------------------------------------------- + !--- Done --- + !---------------------------------------------- + + write(iunit,*) subname,' DONE' + call shr_sys_flush(iunit) + call MPI_Finalize(ierr) + + subroutine fldlist_add(num, fldlist, stdname) + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + + + ! local variables + integer :: rc + integer :: dbrc + character(len=*), parameter :: subname='(dshr_nuopc_mod:fldlist_add)' + !------------------------------------------------------------------------------- + + + ! Set up a list of field information + + + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + return + endif + fldlist(num)%stdname = trim(stdname) + + + end subroutine fldlist_add + +end PROGRAM lilac_data_driver + From 39e6fe8ae645059c22d8f3119f934e59bc2610a9 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 28 Feb 2019 09:56:04 -0800 Subject: [PATCH 050/556] code format --- lilac/lilac/drivers/data_driver.f90 | 628 ++++++++++++++-------------- 1 file changed, 314 insertions(+), 314 deletions(-) diff --git a/lilac/lilac/drivers/data_driver.f90 b/lilac/lilac/drivers/data_driver.f90 index b5cb581d9b..6f876bb64f 100644 --- a/lilac/lilac/drivers/data_driver.f90 +++ b/lilac/lilac/drivers/data_driver.f90 @@ -1,325 +1,325 @@ -PROGRAM lilac_data_driver +program lilac_data_driver - use seq_flds_mod , only: & - seq_flds_x2l_states, seq_flds_x2l_fluxes, seq_flds_x2l_fields, & - seq_flds_l2x_states, seq_flds_l2x_fluxes, seq_flds_l2x_fields, & - seq_flds_dom_coord, seq_flds_dom_other, seq_flds_dom_fields - use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata - use shr_sys_mod , only: shr_sys_flush, shr_sys_abort - use shr_orb_mod , only: shr_orb_params - use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel - use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 - use ESMF + use seq_flds_mod , only: & + seq_flds_x2l_states, seq_flds_x2l_fluxes, seq_flds_x2l_fields, & + seq_flds_l2x_states, seq_flds_l2x_fluxes, seq_flds_l2x_fields, & + seq_flds_dom_coord, seq_flds_dom_other, seq_flds_dom_fields + use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata + use shr_sys_mod , only: shr_sys_flush, shr_sys_abort + use shr_orb_mod , only: shr_orb_params + use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel + use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 + use ESMF - implicit none + implicit none #include ! mpi library include file - !----- Clocks ----- - type(ESMF_Clock) :: EClock ! Input synchronization clock - type(ESMF_Time) :: CurrTime, StartTime, StopTime - type(ESMF_TimeInterval) :: TimeStep - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar),target :: Calendar - integer :: yy,mm,dd,sec - - !----- MPI/MCT ----- - integer :: mpicom_clmdrv ! local mpicom - integer :: ID_clmdrv ! mct ID - integer :: ncomps ! number of separate components for MCT - integer :: ntasks,mytask ! mpicom size and rank - integer :: global_comm ! copy of mpi_comm_world for pio - integer,allocatable :: comp_id(:) ! for pio init2 - logical,allocatable :: comp_iamin(:) ! for pio init2 - character(len=64),allocatable :: comp_name(:) ! for pio init2 - integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 - - !----- Land Coupling Data ----- - ! type(seq_cdata) :: cdata ! Input land-model driver data - ! type(seq_infodata_type),target :: infodata ! infodata type - ! type(mct_aVect) :: x2l, l2x ! land model import and export states - ! type(mct_gGrid),target :: dom_lnd ! domain data for clm - ! type(mct_gsMap),target :: gsmap_lnd ! gsmap data for clm - integer :: orb_iyear ! Orbital - real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp - character(len=128) :: case_name, case_desc, model_version, hostname, username - character(len=128) :: start_type - logical :: brnch_retain_casename, single_column, atm_aero - real*8 :: scmlat, scmlon - integer :: idx_Sa_z, idx_Sa_u, idx_Sa_v, idx_Sa_tbot, idx_Sa_ptem, & - idx_Sa_shum, idx_Sa_pbot, idx_Faxa_rainc, idx_Faxa_rainl, & - idx_Faxa_snowc, idx_Faxa_snowl, idx_Faxa_lwdn, idx_Faxa_swndr, & - idx_Faxa_swvdr, idx_Faxa_swndf, idx_Faxa_swvdf - - !----- Atm Model ----- - integer :: atm_nx, atm_ny - integer :: gsize, lsize, gstart, gend ! domain decomp info - integer, allocatable :: gindex(:) ! domain decomp info - type(mct_aVect) :: x2l_a ! data for land on atm decomp - type(mct_aVect) :: l2x_a ! data from land on atm decomp - type(mct_gsMap) :: gsmap_atm ! gsmap data for atm - type(mct_rearr) :: rearr_atm2lnd ! rearranger for atm to land - type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm - - !----- Other ----- - integer :: n,m ! counter - character(len=128) :: string ! temporary string - integer :: ierr, rc ! local error status - integer :: iunit = 250 ! clmdrv log unit number - integer :: sunit = 249 ! share log unit number - character(len=*),parameter :: subname = 'clmdrv' - - type fld_list_type - character(len=128) :: stdname - end type fld_list_type - - !---------------------------------------------- - - !---------------------------------------------- - !--- MPI/MCT --- - !---------------------------------------------- - - call MPI_Init(ierr) - call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_clmdrv, ierr) - call MPI_COMM_RANK(mpicom_clmdrv, mytask, ierr) - call MPI_COMM_SIZE(mpicom_clmdrv, ntasks, ierr) - - ncomps = 1 - ID_clmdrv = 1 - call mct_world_init(ncomps,MPI_COMM_WORLD,mpicom_clmdrv,ID_clmdrv) - - !---------------------------------------------- - !--- Log File and PIO --- - !---------------------------------------------- - - global_comm = MPI_COMM_WORLD - call shr_pio_init1(ncomps, 'pio_in', global_comm) - allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) - do n = 1,ncomps - comp_id(n) = ID_clmdrv - comp_name(n) = 'LND' - comp_iamin(n) = .true. - comp_comm(n) = mpicom_clmdrv - comp_comm_iam(n) = mytask - enddo - call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) - deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) - - write(string,'(a,i4.4)') 'clmdrv.log.',mytask - open(iunit, file=trim(string)) - write(iunit,*) subname,' STARTING' - call shr_sys_flush(iunit) - - write(iunit,*) subname,' ntasks = ',ntasks - write(iunit,*) subname,' mytask = ',mytask - write(iunit,*) subname,' mct ID = ',ID_clmdrv - call shr_sys_flush(iunit) - call shr_file_setLogUnit(sunit) - call shr_file_setLogLevel(1) - - !---------------------------------------------- - !--- Clocks --- - !---------------------------------------------- - - call ESMF_Initialize(rc=rc) - Calendar = ESMF_CalendarCreate( name='clmdrv_NOLEAP', & - calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - EClock = ESMF_ClockCreate(name='clmdrv_EClock', & + !----- Clocks ----- + type(ESMF_Clock) :: EClock ! Input synchronization clock + type(ESMF_Time) :: CurrTime, StartTime, StopTime + type(ESMF_TimeInterval) :: TimeStep + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar),target :: Calendar + integer :: yy,mm,dd,sec + + !----- MPI/MCT ----- + integer :: mpicom_clmdrv ! local mpicom + integer :: ID_clmdrv ! mct ID + integer :: ncomps ! number of separate components for MCT + integer :: ntasks,mytask ! mpicom size and rank + integer :: global_comm ! copy of mpi_comm_world for pio + integer,allocatable :: comp_id(:) ! for pio init2 + logical,allocatable :: comp_iamin(:) ! for pio init2 + character(len=64),allocatable :: comp_name(:) ! for pio init2 + integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 + + !----- Land Coupling Data ----- + ! type(seq_cdata) :: cdata ! Input land-model driver data + ! type(seq_infodata_type),target :: infodata ! infodata type + ! type(mct_aVect) :: x2l, l2x ! land model import and export states + ! type(mct_gGrid),target :: dom_lnd ! domain data for clm + ! type(mct_gsMap),target :: gsmap_lnd ! gsmap data for clm + integer :: orb_iyear ! Orbital + real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp + character(len=128) :: case_name, case_desc, model_version, hostname, username + character(len=128) :: start_type + logical :: brnch_retain_casename, single_column, atm_aero + real*8 :: scmlat, scmlon + integer :: idx_Sa_z, idx_Sa_u, idx_Sa_v, idx_Sa_tbot, idx_Sa_ptem, & + idx_Sa_shum, idx_Sa_pbot, idx_Faxa_rainc, idx_Faxa_rainl, & + idx_Faxa_snowc, idx_Faxa_snowl, idx_Faxa_lwdn, idx_Faxa_swndr, & + idx_Faxa_swvdr, idx_Faxa_swndf, idx_Faxa_swvdf + + !----- Atm Model ----- + integer :: atm_nx, atm_ny + integer :: gsize, lsize, gstart, gend ! domain decomp info + integer, allocatable :: gindex(:) ! domain decomp info + type(mct_aVect) :: x2l_a ! data for land on atm decomp + type(mct_aVect) :: l2x_a ! data from land on atm decomp + type(mct_gsMap) :: gsmap_atm ! gsmap data for atm + type(mct_rearr) :: rearr_atm2lnd ! rearranger for atm to land + type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm + + !----- Other ----- + integer :: n,m ! counter + character(len=128) :: string ! temporary string + integer :: ierr, rc ! local error status + integer :: iunit = 250 ! clmdrv log unit number + integer :: sunit = 249 ! share log unit number + character(len=*),parameter :: subname = 'clmdrv' + + type fld_list_type + character(len=128) :: stdname + end type fld_list_type + + !---------------------------------------------- + + !---------------------------------------------- + !--- MPI/MCT --- + !---------------------------------------------- + + call MPI_Init(ierr) + call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_clmdrv, ierr) + call MPI_COMM_RANK(mpicom_clmdrv, mytask, ierr) + call MPI_COMM_SIZE(mpicom_clmdrv, ntasks, ierr) + + ncomps = 1 + ID_clmdrv = 1 + call mct_world_init(ncomps,MPI_COMM_WORLD,mpicom_clmdrv,ID_clmdrv) + + !---------------------------------------------- + !--- Log File and PIO --- + !---------------------------------------------- + + global_comm = MPI_COMM_WORLD + call shr_pio_init1(ncomps, 'pio_in', global_comm) + allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) + do n = 1,ncomps + comp_id(n) = ID_clmdrv + comp_name(n) = 'LND' + comp_iamin(n) = .true. + comp_comm(n) = mpicom_clmdrv + comp_comm_iam(n) = mytask + enddo + call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) + deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) + + write(string,'(a,i4.4)') 'clmdrv.log.',mytask + open(iunit, file=trim(string)) + write(iunit,*) subname,' STARTING' + call shr_sys_flush(iunit) + + write(iunit,*) subname,' ntasks = ',ntasks + write(iunit,*) subname,' mytask = ',mytask + write(iunit,*) subname,' mct ID = ',ID_clmdrv + call shr_sys_flush(iunit) + call shr_file_setLogUnit(sunit) + call shr_file_setLogLevel(1) + + !---------------------------------------------- + !--- Clocks --- + !---------------------------------------------- + + call ESMF_Initialize(rc=rc) + Calendar = ESMF_CalendarCreate( name='clmdrv_NOLEAP', & + calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + EClock = ESMF_ClockCreate(name='clmdrv_EClock', & TimeStep=TimeStep, startTime=StartTime, & RefTime=StartTime, stopTime=stopTime, rc=rc) - EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop' , & - clock=EClock, ringTime=StopTime, rc=rc) - EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', & - clock=EClock, ringTime=StopTime, rc=rc) - - call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec - call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - !---------------------------------------------- - !--- Coupling --- - !---------------------------------------------- - - !--- coupling fields - seq_flds_dom_coord='lat:lon' - seq_flds_dom_other='area:aream:mask:frac' - seq_flds_dom_fields=trim(seq_flds_dom_coord)//':'//trim(seq_flds_dom_other) - - seq_flds_x2l_states= 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_pbot:Sg_icemask:Sg_icemask_coupled_fluxes' - seq_flds_x2l_fluxes= 'Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_lwdn:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Faxa_bcphidry:Faxa_bcphodry:Faxa_bcphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_ocphiwet:Faxa_dstwet1:Faxa_dstwet2:Faxa_dstwet3:Faxa_dstwet4:Faxa_dstdry1:Faxa_dstdry2:Faxa_dstdry3:Faxa_dstdry4:Flrr_flood:Flrr_volr' - seq_flds_x2l_fields= trim(seq_flds_x2l_states)//':'//trim(seq_flds_x2l_fluxes) - - seq_flds_l2x_states= 'Sl_avsdr:Sl_anidr:Sl_avsdf:Sl_anidf:Sl_tref:Sl_qref:Sl_t:Sl_fv:Sl_ram1:Sl_snowh:Sl_u10' - seq_flds_l2x_fluxes= 'Fall_swnet:Fall_taux:Fall_tauy:Fall_lat:Fall_sen:Fall_lwup:Fall_evap:Fall_flxdst1:Fall_flxdst2:Fall_flxdst3:Fall_flxdst4:Flrl_rofl:Flrl_rofi:Fall_voc001:Fall_voc002:Fall_voc003:Fall_voc004:Fall_voc005:Fall_voc006:Fall_voc007:Fall_voc008' - seq_flds_l2x_fields= trim(seq_flds_l2x_states)//':'//trim(seq_flds_l2x_fluxes) - - !--- set orbital params - orb_iyear = 1990 - call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & - orb_obliqr, orb_lambm0, orb_mvelpp, .true.) - ! call seq_infodata_putData(infodata, orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, & - ! orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr ) - - !--- set case information - case_name = 'clmdrv' - case_desc = 'clmdrv with clm' - model_version = 'clmdrv0.1' - hostname = 'undefined' - username = 'undefined' - start_type = 'startup' - brnch_retain_casename = .true. - single_column = .false. - scmlat = 0.0 - scmlon = 0.0 - atm_aero = .true. - call seq_infodata_putData(infodata, case_name=case_name, & - case_desc=case_desc, single_column=single_column, & - scmlat=scmlat, scmlon=scmlon, & - brnch_retain_casename=brnch_retain_casename, & - start_type=start_type, model_version=model_version, & - hostname=hostname, username=username, & - atm_aero=atm_aero ) - - !---------------------------------------------- - !--- lnd_init --- - !---------------------------------------------- - - write(iunit,*) subname,' calling lnd_init_mct' - call shr_sys_flush(iunit) - ! call lnd_init_mct(Eclock, cdata, x2l, l2x) - - call diag_avect(l2x,mpicom_clmdrv,'l2x_init') - - idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') - idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') - idx_Sa_v = mct_avect_indexra(x2l,'Sa_v') - idx_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') - idx_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') - idx_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') - idx_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') - idx_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') - idx_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') - idx_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') - idx_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') - idx_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') - idx_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') - idx_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') - idx_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') - idx_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') - - !---------------------------------------------- - !--- atm and atm/lnd coupling init --- - !---------------------------------------------- - - ! read in the mesh - ! TODO: set cvalue to filepath of atm mesh - cvalue = "/path/to/foo" - - if (masterproc) then - write(iulog,*)'mesh file for domain is ',trim(cvalue) - end if - - EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - - - state = ESMF_StateCreate(name=statename, & - stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - - ! Create Field Bundle - FBout = ESMF_FieldBundleCreate(name=trim(lname), rc=rc) - - ! Create individual states and add to field bundle - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name="Sa_z", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Add FB to state - call ESMF_StateAdd(state, (/FBout/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! fill in pointer with data - call ESMF_StateGet(State, itemName="Sa_z", field=lfield, rc=rc) - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - - ! then - fldptr = 30.0 - - !---------------------------------------------- - !--- Time Loop --- - !---------------------------------------------- - - call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) - do while (CurrTime < StopTime) - call ESMF_ClockAdvance(EClock, rc=rc) - call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) - call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' clmdrv ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - ! can manually override the alarms as needed - call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) - if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) - - ! set the coupling data that is sent to the land model, this is on atm decomp - ! this is just sample test data - ! these all need to be set in the pointers - Sa_z = 30.0 ! m - Sa_u = 0.0 ! m/s - Sa_v = 0.0 ! m/s - Sa_tbot = 280.0 ! degK - Sa_ptem = 280.0 ! degK - Sa_shum = 0.0004 ! kg/kg - Sa_pbot = 100100.0 ! Pa - Faxa_rainc = 4.0e-8 ! kg/m2s - Faxa_rainl = 3.0e-8 ! kg/m2s - Faxa_snowc = 1.0e-8 ! kg/m2s - Faxa_snowl = 2.0e-8 ! kg/m2s - Faxa_lwdn = 200.0 ! W/m2 - Faxa_swndr = 100.0 ! W/m2 - Faxa_swvdr = 90.0 ! W/m2 - Faxa_swndf = 20.0 ! W/m2 - Faxa_swvdf = 40.0 ! W/m2 - - ! run clm - write(iunit,*) subname,' call lilac%run',yy,mm,dd,sec - call lilac%run(importState, exportState, clock) - ! call lnd_run_mct(Eclock, cdata, x2l, l2x) - - enddo - - !---------------------------------------------- - !--- lnd_final --- - !---------------------------------------------- - - write(iunit,*) subname,' calling lnd_final_mct' - call shr_sys_flush(iunit) - ! call lnd_final_mct(Eclock, cdata, x2l, l2x) - - !---------------------------------------------- - !--- Done --- - !---------------------------------------------- - - write(iunit,*) subname,' DONE' - call shr_sys_flush(iunit) - call MPI_Finalize(ierr) + EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop' , & + clock=EClock, ringTime=StopTime, rc=rc) + EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', & + clock=EClock, ringTime=StopTime, rc=rc) + + call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec + call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + !---------------------------------------------- + !--- Coupling --- + !---------------------------------------------- + + !--- coupling fields + seq_flds_dom_coord='lat:lon' + seq_flds_dom_other='area:aream:mask:frac' + seq_flds_dom_fields=trim(seq_flds_dom_coord)//':'//trim(seq_flds_dom_other) + + seq_flds_x2l_states= 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_pbot:Sg_icemask:Sg_icemask_coupled_fluxes' + seq_flds_x2l_fluxes= 'Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_lwdn:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Faxa_bcphidry:Faxa_bcphodry:Faxa_bcphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_ocphiwet:Faxa_dstwet1:Faxa_dstwet2:Faxa_dstwet3:Faxa_dstwet4:Faxa_dstdry1:Faxa_dstdry2:Faxa_dstdry3:Faxa_dstdry4:Flrr_flood:Flrr_volr' + seq_flds_x2l_fields= trim(seq_flds_x2l_states)//':'//trim(seq_flds_x2l_fluxes) + + seq_flds_l2x_states= 'Sl_avsdr:Sl_anidr:Sl_avsdf:Sl_anidf:Sl_tref:Sl_qref:Sl_t:Sl_fv:Sl_ram1:Sl_snowh:Sl_u10' + seq_flds_l2x_fluxes= 'Fall_swnet:Fall_taux:Fall_tauy:Fall_lat:Fall_sen:Fall_lwup:Fall_evap:Fall_flxdst1:Fall_flxdst2:Fall_flxdst3:Fall_flxdst4:Flrl_rofl:Flrl_rofi:Fall_voc001:Fall_voc002:Fall_voc003:Fall_voc004:Fall_voc005:Fall_voc006:Fall_voc007:Fall_voc008' + seq_flds_l2x_fields= trim(seq_flds_l2x_states)//':'//trim(seq_flds_l2x_fluxes) + + !--- set orbital params + orb_iyear = 1990 + call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & + orb_obliqr, orb_lambm0, orb_mvelpp, .true.) + ! call seq_infodata_putData(infodata, orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, & + ! orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr ) + + !--- set case information + case_name = 'clmdrv' + case_desc = 'clmdrv with clm' + model_version = 'clmdrv0.1' + hostname = 'undefined' + username = 'undefined' + start_type = 'startup' + brnch_retain_casename = .true. + single_column = .false. + scmlat = 0.0 + scmlon = 0.0 + atm_aero = .true. + call seq_infodata_putData(infodata, case_name=case_name, & + case_desc=case_desc, single_column=single_column, & + scmlat=scmlat, scmlon=scmlon, & + brnch_retain_casename=brnch_retain_casename, & + start_type=start_type, model_version=model_version, & + hostname=hostname, username=username, & + atm_aero=atm_aero ) + + !---------------------------------------------- + !--- lnd_init --- + !---------------------------------------------- + + write(iunit,*) subname,' calling lnd_init_mct' + call shr_sys_flush(iunit) + ! call lnd_init_mct(Eclock, cdata, x2l, l2x) + + call diag_avect(l2x,mpicom_clmdrv,'l2x_init') + + idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') + idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') + idx_Sa_v = mct_avect_indexra(x2l,'Sa_v') + idx_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') + idx_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') + idx_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') + idx_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') + idx_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') + idx_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') + idx_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') + idx_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') + idx_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') + idx_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') + idx_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') + idx_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') + idx_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') + + !---------------------------------------------- + !--- atm and atm/lnd coupling init --- + !---------------------------------------------- + + ! read in the mesh + ! TODO: set cvalue to filepath of atm mesh + cvalue = "/path/to/foo" + + if (masterproc) then + write(iulog,*)'mesh file for domain is ',trim(cvalue) + end if + + EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + + + state = ESMF_StateCreate(name=statename, & + stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + + ! Create Field Bundle + FBout = ESMF_FieldBundleCreate(name=trim(lname), rc=rc) + + ! Create individual states and add to field bundle + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name="Sa_z", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Add FB to state + call ESMF_StateAdd(state, (/FBout/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! fill in pointer with data + call ESMF_StateGet(State, itemName="Sa_z", field=lfield, rc=rc) + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + + ! then + fldptr = 30.0 + + !---------------------------------------------- + !--- Time Loop --- + !---------------------------------------------- + + call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) + do while (CurrTime < StopTime) + call ESMF_ClockAdvance(EClock, rc=rc) + call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) + call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' clmdrv ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + ! can manually override the alarms as needed + call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) + if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) + + ! set the coupling data that is sent to the land model, this is on atm decomp + ! this is just sample test data + ! these all need to be set in the pointers + Sa_z = 30.0 ! m + Sa_u = 0.0 ! m/s + Sa_v = 0.0 ! m/s + Sa_tbot = 280.0 ! degK + Sa_ptem = 280.0 ! degK + Sa_shum = 0.0004 ! kg/kg + Sa_pbot = 100100.0 ! Pa + Faxa_rainc = 4.0e-8 ! kg/m2s + Faxa_rainl = 3.0e-8 ! kg/m2s + Faxa_snowc = 1.0e-8 ! kg/m2s + Faxa_snowl = 2.0e-8 ! kg/m2s + Faxa_lwdn = 200.0 ! W/m2 + Faxa_swndr = 100.0 ! W/m2 + Faxa_swvdr = 90.0 ! W/m2 + Faxa_swndf = 20.0 ! W/m2 + Faxa_swvdf = 40.0 ! W/m2 + + ! run clm + write(iunit,*) subname,' call lilac%run',yy,mm,dd,sec + call lilac%run(importState, exportState, clock) + ! call lnd_run_mct(Eclock, cdata, x2l, l2x) + + enddo + + !---------------------------------------------- + !--- lnd_final --- + !---------------------------------------------- + + write(iunit,*) subname,' calling lnd_final_mct' + call shr_sys_flush(iunit) + ! call lnd_final_mct(Eclock, cdata, x2l, l2x) + + !---------------------------------------------- + !--- Done --- + !---------------------------------------------- + + write(iunit,*) subname,' DONE' + call shr_sys_flush(iunit) + call MPI_Finalize(ierr) subroutine fldlist_add(num, fldlist, stdname) integer, intent(inout) :: num @@ -348,5 +348,5 @@ subroutine fldlist_add(num, fldlist, stdname) end subroutine fldlist_add -end PROGRAM lilac_data_driver +end program lilac_data_driver From 5054cffe11d5ec0f7597035329b0e1193ecb2c5f Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 28 Feb 2019 12:35:57 -0800 Subject: [PATCH 051/556] working on data driver --- lilac/lilac/core.f90 | 61 +++-- lilac/lilac/drivers/data_driver.f90 | 365 +++++++++++++++------------- lilac/lilac/esmf_utils.f90 | 54 ++-- 3 files changed, 262 insertions(+), 218 deletions(-) diff --git a/lilac/lilac/core.f90 b/lilac/lilac/core.f90 index ced01bb32c..e08677478b 100644 --- a/lilac/lilac/core.f90 +++ b/lilac/lilac/core.f90 @@ -11,6 +11,7 @@ module lilac !-------------------------------------------------------------------------- ! Public interfaces !-------------------------------------------------------------------------- + public :: start public :: init public :: run public :: final @@ -22,8 +23,7 @@ module lilac type, public :: LilacType private - type(ESMFInfoType) :: esmf_info - character(len=ESMF_MAXSTR) :: name + type(ESMFInfoType) :: esmf_info contains procedure, public :: init => init @@ -55,66 +55,85 @@ module lilac contains - subroutine init(self, name) + subroutine start(self, rc) + implicit none + class(LilacType), intent(inout) :: self + integer, intent(in) :: rc=ESMF_SUCCESS + + character(len=*), parameter :: subname=trim(modname)//':(init) ' + + call ESMF_LogWrite(subname//"Starting lilac and setting up ESMF", ESMF_LOGMSG_INFO) + + ! Initialize ESMF structures + call self%esmf_info%start(rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + end subroutine start + + subroutine init(self, clock, x2a_state, a2x_state, rc) implicit none class(LilacType), intent(inout) :: self - character(len=ESMF_MAXSTR), intent(in) :: name + type(ESMF_Clock) :: clock ! Input synchronization clock + type(ESMF_State) :: x2a_state + type(ESMF_State) :: a2x_state + integer, intent(in) :: rc=ESMF_SUCCESS character(len=*), parameter :: subname=trim(modname)//':(init) ' call ESMF_LogWrite(subname//"Initializing lilac", ESMF_LOGMSG_INFO) - self%name = trim(name) - - ! Initialize ESMF structures - call self%esmf_info%init(name, atmos_register, land_register, cpl_register) + call self%esmf_info%start(atmos_register, land_register, cpl_register, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end subroutine init - subroutine run(self) + subroutine run(self, clock, x2a_state, a2x_state, rc) implicit none class(LilacType), intent(inout) :: self + type(ESMF_Clock) :: clock ! Input synchronization clock + type(ESMF_State) :: x2a_state + type(ESMF_State) :: a2x_state + integer, intent(in) :: rc=ESMF_SUCCESS character(len=*), parameter :: subname=trim(modname)//':(run) ' call ESMF_LogWrite(subname//"Running lilac", ESMF_LOGMSG_INFO) - call self%esmf_info%run() + call self%esmf_info%run(rc, ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end subroutine run - subroutine final(self) + subroutine final(self, rc) implicit none class(LilacType), intent(inout) :: self + integer, intent(in) :: rc=ESMF_SUCCESS character(len=*), parameter :: subname=trim(modname)//':(final) ' call ESMF_LogWrite(subname//"Finalizing lilac", ESMF_LOGMSG_INFO) - call self%esmf_info%final() + call self%esmf_info%final(rc) end subroutine final subroutine atmos_register(comp, rc) type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(out) :: rc ! must not be optional + integer, intent(in) :: rc=ESMF_SUCCESS + character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - userRoutine=atmos_init, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - userRoutine=atmos_copy_atm_to_lilac, phase=1, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_atm_to_lilac, phase=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - userRoutine=atmos_copy_lilac_to_atm, phase=2, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_lilac_to_atm, phase=2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - userRoutine=atmos_final, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out rc = ESMF_SUCCESS diff --git a/lilac/lilac/drivers/data_driver.f90 b/lilac/lilac/drivers/data_driver.f90 index 6f876bb64f..abdf8c21ee 100644 --- a/lilac/lilac/drivers/data_driver.f90 +++ b/lilac/lilac/drivers/data_driver.f90 @@ -25,8 +25,8 @@ program lilac_data_driver integer :: yy,mm,dd,sec !----- MPI/MCT ----- - integer :: mpicom_clmdrv ! local mpicom - integer :: ID_clmdrv ! mct ID + integer :: mpicom_lilac_drv ! local mpicom + integer :: ID_lilac_drv ! mct ID integer :: ncomps ! number of separate components for MCT integer :: ntasks,mytask ! mpicom size and rank integer :: global_comm ! copy of mpi_comm_world for pio @@ -36,21 +36,16 @@ program lilac_data_driver integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 !----- Land Coupling Data ----- - ! type(seq_cdata) :: cdata ! Input land-model driver data - ! type(seq_infodata_type),target :: infodata ! infodata type - ! type(mct_aVect) :: x2l, l2x ! land model import and export states - ! type(mct_gGrid),target :: dom_lnd ! domain data for clm - ! type(mct_gsMap),target :: gsmap_lnd ! gsmap data for clm + type(ESMF_GridComp) :: gridComp + type(ESMF_State) :: a2x_state + type(ESMF_State) :: x2a_state + integer :: orb_iyear ! Orbital real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp character(len=128) :: case_name, case_desc, model_version, hostname, username character(len=128) :: start_type logical :: brnch_retain_casename, single_column, atm_aero real*8 :: scmlat, scmlon - integer :: idx_Sa_z, idx_Sa_u, idx_Sa_v, idx_Sa_tbot, idx_Sa_ptem, & - idx_Sa_shum, idx_Sa_pbot, idx_Faxa_rainc, idx_Faxa_rainl, & - idx_Faxa_snowc, idx_Faxa_snowl, idx_Faxa_lwdn, idx_Faxa_swndr, & - idx_Faxa_swvdr, idx_Faxa_swndf, idx_Faxa_swvdf !----- Atm Model ----- integer :: atm_nx, atm_ny @@ -66,14 +61,22 @@ program lilac_data_driver integer :: n,m ! counter character(len=128) :: string ! temporary string integer :: ierr, rc ! local error status - integer :: iunit = 250 ! clmdrv log unit number + integer :: iunit = 250 ! lilac_drv log unit number integer :: sunit = 249 ! share log unit number - character(len=*),parameter :: subname = 'clmdrv' + character(len=*),parameter :: subname = 'lilac_drv' type fld_list_type character(len=128) :: stdname + real*8 :: default_value + character(len=128) :: units end type fld_list_type + integer, parameter :: fldsMax = 100 + integer :: fldsToCpl_num = 0 + integer :: fldsFrCpl_num = 0 + type (fld_list_type) :: fldsToCpl(fldsMax) + type (fld_list_type) :: fldsFrCpl(fldsMax) + !---------------------------------------------- !---------------------------------------------- @@ -81,13 +84,11 @@ program lilac_data_driver !---------------------------------------------- call MPI_Init(ierr) - call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_clmdrv, ierr) - call MPI_COMM_RANK(mpicom_clmdrv, mytask, ierr) - call MPI_COMM_SIZE(mpicom_clmdrv, ntasks, ierr) + call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_lilac_drv, ierr) + call MPI_COMM_RANK(mpicom_lilac_drv, mytask, ierr) + call MPI_COMM_SIZE(mpicom_lilac_drv, ntasks, ierr) - ncomps = 1 - ID_clmdrv = 1 - call mct_world_init(ncomps,MPI_COMM_WORLD,mpicom_clmdrv,ID_clmdrv) + call lilac%start() !---------------------------------------------- !--- Log File and PIO --- @@ -97,23 +98,23 @@ program lilac_data_driver call shr_pio_init1(ncomps, 'pio_in', global_comm) allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) do n = 1,ncomps - comp_id(n) = ID_clmdrv + comp_id(n) = ID_lilac_drv comp_name(n) = 'LND' comp_iamin(n) = .true. - comp_comm(n) = mpicom_clmdrv + comp_comm(n) = mpicom_lilac_drv comp_comm_iam(n) = mytask enddo call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) - write(string,'(a,i4.4)') 'clmdrv.log.',mytask + write(string,'(a,i4.4)') 'lilac_drv.log.',mytask open(iunit, file=trim(string)) write(iunit,*) subname,' STARTING' call shr_sys_flush(iunit) write(iunit,*) subname,' ntasks = ',ntasks write(iunit,*) subname,' mytask = ',mytask - write(iunit,*) subname,' mct ID = ',ID_clmdrv + write(iunit,*) subname,' mct ID = ',ID_lilac_drv call shr_sys_flush(iunit) call shr_file_setLogUnit(sunit) call shr_file_setLogLevel(1) @@ -121,21 +122,14 @@ program lilac_data_driver !---------------------------------------------- !--- Clocks --- !---------------------------------------------- - - call ESMF_Initialize(rc=rc) - Calendar = ESMF_CalendarCreate( name='clmdrv_NOLEAP', & - calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + Calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - EClock = ESMF_ClockCreate(name='clmdrv_EClock', & - TimeStep=TimeStep, startTime=StartTime, & - RefTime=StartTime, stopTime=stopTime, rc=rc) + EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop' , & - clock=EClock, ringTime=StopTime, rc=rc) - EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', & - clock=EClock, ringTime=StopTime, rc=rc) + EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop', clock=EClock, ringTime=StopTime, rc=rc) + EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', clock=EClock, ringTime=StopTime, rc=rc) call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec @@ -143,34 +137,14 @@ program lilac_data_driver write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec call shr_sys_flush(iunit) - !---------------------------------------------- - !--- Coupling --- - !---------------------------------------------- - - !--- coupling fields - seq_flds_dom_coord='lat:lon' - seq_flds_dom_other='area:aream:mask:frac' - seq_flds_dom_fields=trim(seq_flds_dom_coord)//':'//trim(seq_flds_dom_other) - - seq_flds_x2l_states= 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_pbot:Sg_icemask:Sg_icemask_coupled_fluxes' - seq_flds_x2l_fluxes= 'Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_lwdn:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Faxa_bcphidry:Faxa_bcphodry:Faxa_bcphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_ocphiwet:Faxa_dstwet1:Faxa_dstwet2:Faxa_dstwet3:Faxa_dstwet4:Faxa_dstdry1:Faxa_dstdry2:Faxa_dstdry3:Faxa_dstdry4:Flrr_flood:Flrr_volr' - seq_flds_x2l_fields= trim(seq_flds_x2l_states)//':'//trim(seq_flds_x2l_fluxes) - - seq_flds_l2x_states= 'Sl_avsdr:Sl_anidr:Sl_avsdf:Sl_anidf:Sl_tref:Sl_qref:Sl_t:Sl_fv:Sl_ram1:Sl_snowh:Sl_u10' - seq_flds_l2x_fluxes= 'Fall_swnet:Fall_taux:Fall_tauy:Fall_lat:Fall_sen:Fall_lwup:Fall_evap:Fall_flxdst1:Fall_flxdst2:Fall_flxdst3:Fall_flxdst4:Flrl_rofl:Flrl_rofi:Fall_voc001:Fall_voc002:Fall_voc003:Fall_voc004:Fall_voc005:Fall_voc006:Fall_voc007:Fall_voc008' - seq_flds_l2x_fields= trim(seq_flds_l2x_states)//':'//trim(seq_flds_l2x_fluxes) - !--- set orbital params orb_iyear = 1990 - call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & - orb_obliqr, orb_lambm0, orb_mvelpp, .true.) - ! call seq_infodata_putData(infodata, orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, & - ! orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr ) + call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp, .true.) !--- set case information - case_name = 'clmdrv' - case_desc = 'clmdrv with clm' - model_version = 'clmdrv0.1' + case_name = 'lilac_drv' + case_desc = 'lilac_drv with clm' + model_version = 'lilac_drv0.1' hostname = 'undefined' username = 'undefined' start_type = 'startup' @@ -191,28 +165,10 @@ program lilac_data_driver !--- lnd_init --- !---------------------------------------------- - write(iunit,*) subname,' calling lnd_init_mct' + write(iunit,*) subname,' calling lilac%init' call shr_sys_flush(iunit) - ! call lnd_init_mct(Eclock, cdata, x2l, l2x) - - call diag_avect(l2x,mpicom_clmdrv,'l2x_init') - - idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') - idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') - idx_Sa_v = mct_avect_indexra(x2l,'Sa_v') - idx_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') - idx_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') - idx_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') - idx_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') - idx_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') - idx_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') - idx_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') - idx_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') - idx_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') - idx_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') - idx_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') - idx_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') - idx_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') + + call lilac%init(EClock, x2a_state, a2x_state, rc=rc) !---------------------------------------------- !--- atm and atm/lnd coupling init --- @@ -227,40 +183,124 @@ program lilac_data_driver end if EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! import fields + ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) + + ! land states + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) + + ! fluxes to atm + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) + + ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) + + ! from atm + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) + + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) + + ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 + + ! Create States + x2a_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + a2x_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Coupler to Atmosphere Fields + FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Create individual states and add to field bundle + do n = 1,fldsFrCpl_num + ! create field + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsFrCpl(n)%stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! add field to field bundle + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + enddo + ! Add FB to state + call ESMF_StateAdd(x2a_state, (/FBout/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - state = ESMF_StateCreate(name=statename, & - stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - - ! Create Field Bundle - FBout = ESMF_FieldBundleCreate(name=trim(lname), rc=rc) - + ! Atmosphere to Coupler Fields + FBout = ESMF_FieldBundleCreate(name="a2x_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! Create individual states and add to field bundle - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name="Sa_z", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + do n = 1,fldsToCpl_num + ! create field + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsToCpl(n)%stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! initialize with default value + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ldptr = fldsToCpl(n)%default_value + + ! add field to field bundle + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + enddo ! Add FB to state - call ESMF_StateAdd(state, (/FBout/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! fill in pointer with data - call ESMF_StateGet(State, itemName="Sa_z", field=lfield, rc=rc) - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + call ESMF_StateAdd(a2x_state, (/FBout/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! then - fldptr = 30.0 !---------------------------------------------- !--- Time Loop --- @@ -268,50 +308,29 @@ program lilac_data_driver call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) do while (CurrTime < StopTime) - call ESMF_ClockAdvance(EClock, rc=rc) - call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) - call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' clmdrv ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - ! can manually override the alarms as needed - call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) - if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) - - ! set the coupling data that is sent to the land model, this is on atm decomp - ! this is just sample test data - ! these all need to be set in the pointers - Sa_z = 30.0 ! m - Sa_u = 0.0 ! m/s - Sa_v = 0.0 ! m/s - Sa_tbot = 280.0 ! degK - Sa_ptem = 280.0 ! degK - Sa_shum = 0.0004 ! kg/kg - Sa_pbot = 100100.0 ! Pa - Faxa_rainc = 4.0e-8 ! kg/m2s - Faxa_rainl = 3.0e-8 ! kg/m2s - Faxa_snowc = 1.0e-8 ! kg/m2s - Faxa_snowl = 2.0e-8 ! kg/m2s - Faxa_lwdn = 200.0 ! W/m2 - Faxa_swndr = 100.0 ! W/m2 - Faxa_swvdr = 90.0 ! W/m2 - Faxa_swndf = 20.0 ! W/m2 - Faxa_swvdf = 40.0 ! W/m2 - - ! run clm - write(iunit,*) subname,' call lilac%run',yy,mm,dd,sec - call lilac%run(importState, exportState, clock) - ! call lnd_run_mct(Eclock, cdata, x2l, l2x) - + call ESMF_ClockAdvance(EClock, rc=rc) + call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) + call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' lilac_drv ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + ! can manually override the alarms as needed + call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) + if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) + + ! run lilac + write(iunit,*) subname,' call lilac%run',yy,mm,dd,sec + call lilac%run(EClock, x2a_state, a2x_state, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out enddo !---------------------------------------------- !--- lnd_final --- !---------------------------------------------- - write(iunit,*) subname,' calling lnd_final_mct' + write(iunit,*) subname,' calling lilac%final()' call shr_sys_flush(iunit) - ! call lnd_final_mct(Eclock, cdata, x2l, l2x) + call lilac%final() !---------------------------------------------- !--- Done --- @@ -321,32 +340,36 @@ program lilac_data_driver call shr_sys_flush(iunit) call MPI_Finalize(ierr) - subroutine fldlist_add(num, fldlist, stdname) - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname - - - ! local variables - integer :: rc - integer :: dbrc - character(len=*), parameter :: subname='(dshr_nuopc_mod:fldlist_add)' - !------------------------------------------------------------------------------- - - - ! Set up a list of field information - - - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - fldlist(num)%stdname = trim(stdname) - - - end subroutine fldlist_add - end program lilac_data_driver +subroutine fldlist_add(num, fldlist, stdname, default_value, units) + integer intent(inout) :: num + type(fld_list_type) intent(inout) :: fldlist(:) + character(len=*) intent(in) :: stdname + real, optional intent(in) :: default_value + character(len=*), optional intent(in) :: units + + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(fldlist_add)' + !------------------------------------------------------------------------------- + + ! Set up a list of field information + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) return + endif + fldlist(num)%stdname = trim(stdname) + if(present(default_value)) then + fldlist(num)%default_value = default_value + else + fldlist(num)%default_value = 0. + end if + if(present(units)) then + fldlist(num)%units = trim(units) + else + fldlist(num)%units = "" + end if + +end subroutine fldlist_add diff --git a/lilac/lilac/esmf_utils.f90 b/lilac/lilac/esmf_utils.f90 index 57f9cf0168..f9bac2809a 100644 --- a/lilac/lilac/esmf_utils.f90 +++ b/lilac/lilac/esmf_utils.f90 @@ -2,7 +2,6 @@ module esmf_utils ! Wrappers and derived types exposing ESMF components to LILAC - #include "ESMF.h" use ESMF @@ -32,7 +31,6 @@ end subroutine userCplRoutine ! Consider renaming ESMFInfoType (add lilac to name) type, public :: ESMFInfoType private - character(len=ESMF_MAXSTR) :: name type(ESMF_VM) :: vm type(ESMF_State) :: land_import @@ -52,26 +50,15 @@ end subroutine userCplRoutine contains - subroutine init(self, name, atmos_register, land_register, cpl_register) + subroutine start(self, rc) implicit none - class(ESMFInfoType), intent(inout) :: self - character(len=ESMF_MAXSTR), intent(in) :: name - procedure(userRoutine) :: atmos_register - procedure(userRoutine) :: land_register - procedure(userCplRoutine) :: cpl_register + integer, intent(in) :: rc=ESMF_SUCCESS - ! Local variables - character(len=ESMF_MAXSTR) :: cname1, cname2, cplname - integer :: localPet, petCount, rc=ESMF_SUCCESS + integer :: localPet, petCount - character(len=*), parameter :: subname=trim(modname)//':(init) ' - - call ESMF_LogWrite(subname//"esmf_info%init()", ESMF_LOGMSG_INFO) + character(len=*), parameter :: subname=trim(modname)//':(start) ' - self%name = trim(name) - - ! Create section - !------------------------------------------------------------------------- + call ESMF_LogWrite(subname//"esmf_info%start()", ESMF_LOGMSG_INFO) ! Initialize framework and get back default global VM @@ -83,6 +70,26 @@ subroutine init(self, name, atmos_register, land_register, cpl_register) call ESMF_VMGet(self%vm, petCount=petCount, localPet=localPet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end subroutine start + + subroutine init(self, atmos_register, land_register, cpl_register, rc) + implicit none + class(ESMFInfoType), intent(inout) :: self + procedure(userRoutine) :: atmos_register + procedure(userRoutine) :: land_register + procedure(userCplRoutine) :: cpl_register + integer, intent(in) :: rc=ESMF_SUCCESS + + ! Local variables + character(len=ESMF_MAXSTR) :: cname1, cname2, cplname + integer :: rc=ESMF_SUCCESS + + character(len=*), parameter :: subname=trim(modname)//':(init) ' + + call ESMF_LogWrite(subname//"esmf_info%init()", ESMF_LOGMSG_INFO) + + ! Create section + !------------------------------------------------------------------------- ! Create the 2 model components and a coupler cname1 = "land" ! use petList to define land on all PET @@ -142,11 +149,9 @@ subroutine init(self, name, atmos_register, land_register, cpl_register) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Atmosphere Initialize finished", ESMF_LOGMSG_INFO) - ! call ESMF_CPLCompInitialize twice (once for each grid comp) - end subroutine init - subroutine run(self) + subroutine run(self, rc) implicit none class(ESMFInfoType), intent(inout) :: self integer :: rc=ESMF_SUCCESS @@ -154,8 +159,6 @@ subroutine run(self) call ESMF_LogWrite(subname//"esmf_info%run()", ESMF_LOGMSG_INFO) - ! TODO: need some help on order of imports/exports/runs and whether the land/atm both need import/export states - ! atmosphere run ! copy the atmos state and put it into atmos export call ESMF_GridCompRun(self%atmos_comp, exportState=self%atmos_export, phase=1, rc=rc) @@ -163,8 +166,7 @@ subroutine run(self) call ESMF_LogWrite(subname//"Atmosphere Run returned", ESMF_LOGMSG_INFO) ! coupler run - call ESMF_CplCompRun(self%cpl_comp, importState=self%atmos_export, exportState=self%land_import, & - rc=rc) + call ESMF_CplCompRun(self%cpl_comp, importState=self%atmos_export, exportState=self%land_import, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Coupler Run returned", ESMF_LOGMSG_INFO) @@ -184,7 +186,7 @@ subroutine run(self) end subroutine run - subroutine final(self) + subroutine final(self, rc) implicit none class(ESMFInfoType), intent(inout) :: self integer :: rc=ESMF_SUCCESS From 697858d15fa587cd5031158679c9354df38d01c0 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 28 Feb 2019 12:38:48 -0800 Subject: [PATCH 052/556] remove rand test --- lilac/tests/CMakeLists.txt | 1 - lilac/tests/rand_atm_rand_lnd/CmakeLists.txt | 5 - lilac/tests/rand_atm_rand_lnd/main.f90 | 20 ---- lilac/tests/rand_atm_rand_lnd/rand_test.f90 | 112 ------------------- 4 files changed, 138 deletions(-) delete mode 100644 lilac/tests/rand_atm_rand_lnd/CmakeLists.txt delete mode 100644 lilac/tests/rand_atm_rand_lnd/main.f90 delete mode 100644 lilac/tests/rand_atm_rand_lnd/rand_test.f90 diff --git a/lilac/tests/CMakeLists.txt b/lilac/tests/CMakeLists.txt index 7de7443322..09a90942c8 100644 --- a/lilac/tests/CMakeLists.txt +++ b/lilac/tests/CMakeLists.txt @@ -1,3 +1,2 @@ # Add tests here -add_subdirectory(rand_atm_rand_lnd) target_include_directories(lilac PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt b/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt deleted file mode 100644 index 5807d75fb0..0000000000 --- a/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt +++ /dev/null @@ -1,5 +0,0 @@ - -file(GLOB_RECURSE SOURCES *.f90 *.h) -add_executable("rand_atm_rand_lnd" ${SOURCES}) -target_link_libraries(rand_atm_rand_lnd lilac) -target_include_directories(lilac PUBLIC ${CMAKE_BINARY_DIR}/lilac) diff --git a/lilac/tests/rand_atm_rand_lnd/main.f90 b/lilac/tests/rand_atm_rand_lnd/main.f90 deleted file mode 100644 index 3d0284eab2..0000000000 --- a/lilac/tests/rand_atm_rand_lnd/main.f90 +++ /dev/null @@ -1,20 +0,0 @@ -program main - - use rand_test, only : atm_driver - use ESMF - - implicit none - - ! local variables - integer:: rc - - rc = 0 - print *, "Running Atmosphere Driver" - - call atm_driver(rc) - - if (rc /= ESMF_SUCCESS) stop 1 - - print *, "Done Running Atmosphere Driver" - -end program main diff --git a/lilac/tests/rand_atm_rand_lnd/rand_test.f90 b/lilac/tests/rand_atm_rand_lnd/rand_test.f90 deleted file mode 100644 index 70263d243c..0000000000 --- a/lilac/tests/rand_atm_rand_lnd/rand_test.f90 +++ /dev/null @@ -1,112 +0,0 @@ -module rand_test - - use lilac, only : LilacType - use ESMF - - implicit none - - character(*), parameter :: modname = "(rand_test)" - integer, parameter :: num_timesteps = 10 - type(LilacType), save :: lilac_obj - - !-------------------------------------------------------------------------- - ! Public interfaces - !-------------------------------------------------------------------------- - public :: atm_driver - - private :: atm_init - private :: lnd_init - private :: atm_run - private :: lnd_run - private :: atm_final - private :: lnd_final - -contains - - subroutine atm_driver(rc) - - integer, intent(out) :: rc - - - call atm_init(rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call atm_run(rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - - call atm_final(rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - end subroutine atm_driver - - subroutine atm_init(rc) - - integer, intent(out) :: rc - - ! Initialize atmosphere - ! TODO - - ! Initialize land via lilac - call lnd_init(rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - end subroutine atm_init - - - subroutine lnd_init(rc) - - integer, intent(out) :: rc - character(len=ESMF_MAXSTR), parameter :: lilac_name="lilac_rand_test" - - call lilac_obj%init(lilac_name) - - - end subroutine lnd_init - - - subroutine atm_run(rc) - - integer, intent(out) :: rc - - integer :: n - - ! Run atm for num_timesteps - do n = 1, num_timesteps, 1 - print *, "------ Running land -------" - ! Run land via lilac - call lnd_run(rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end do - - end subroutine atm_run - - - subroutine lnd_run(rc) - - integer, intent(out) :: rc - - call lilac_obj%run() - - - end subroutine lnd_run - - - subroutine atm_final(rc) - - integer, intent(out) :: rc - - - end subroutine atm_final - - - subroutine lnd_final(rc) - - integer, intent(out) :: rc - - call lilac_obj%final() - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - end subroutine lnd_final - -end module rand_test From 3a9158683391c280740f4fcb1099c1dd6d898edf Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 28 Feb 2019 12:39:20 -0800 Subject: [PATCH 053/556] code format --- lilac/lilac/drivers/data_driver.f90 | 74 ++++++++++++++--------------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/lilac/lilac/drivers/data_driver.f90 b/lilac/lilac/drivers/data_driver.f90 index abdf8c21ee..c083a78961 100644 --- a/lilac/lilac/drivers/data_driver.f90 +++ b/lilac/lilac/drivers/data_driver.f90 @@ -263,15 +263,15 @@ program lilac_data_driver ! Coupler to Atmosphere Fields FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - + ! Create individual states and add to field bundle do n = 1,fldsFrCpl_num - ! create field - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsFrCpl(n)%stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! add field to field bundle - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! create field + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsFrCpl(n)%stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! add field to field bundle + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out enddo ! Add FB to state @@ -281,20 +281,20 @@ program lilac_data_driver ! Atmosphere to Coupler Fields FBout = ESMF_FieldBundleCreate(name="a2x_fields", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - + ! Create individual states and add to field bundle do n = 1,fldsToCpl_num - ! create field - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsToCpl(n)%stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! initialize with default value - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ldptr = fldsToCpl(n)%default_value - - ! add field to field bundle - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! create field + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsToCpl(n)%stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! initialize with default value + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ldptr = fldsToCpl(n)%default_value + + ! add field to field bundle + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out enddo ! Add FB to state @@ -308,20 +308,20 @@ program lilac_data_driver call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) do while (CurrTime < StopTime) - call ESMF_ClockAdvance(EClock, rc=rc) - call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) - call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' lilac_drv ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - ! can manually override the alarms as needed - call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) - if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) - - ! run lilac - write(iunit,*) subname,' call lilac%run',yy,mm,dd,sec - call lilac%run(EClock, x2a_state, a2x_state, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_ClockAdvance(EClock, rc=rc) + call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) + call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' lilac_drv ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + ! can manually override the alarms as needed + call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) + if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) + + ! run lilac + write(iunit,*) subname,' call lilac%run',yy,mm,dd,sec + call lilac%run(EClock, x2a_state, a2x_state, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out enddo !---------------------------------------------- @@ -362,14 +362,14 @@ subroutine fldlist_add(num, fldlist, stdname, default_value, units) endif fldlist(num)%stdname = trim(stdname) if(present(default_value)) then - fldlist(num)%default_value = default_value + fldlist(num)%default_value = default_value else - fldlist(num)%default_value = 0. + fldlist(num)%default_value = 0. end if if(present(units)) then - fldlist(num)%units = trim(units) + fldlist(num)%units = trim(units) else - fldlist(num)%units = "" + fldlist(num)%units = "" end if end subroutine fldlist_add From 6ccf2144d850a67f3c3b5d759754551bc85368b4 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 14 Mar 2019 13:00:03 -0700 Subject: [PATCH 054/556] wip: setup basic structure for test driver using lilac field objects --- lilac/lilac/core.f90 | 203 +++++++++++- lilac/lilac/drivers/data_driver.f90 | 375 ---------------------- lilac/lilac/drivers/lilac_data_driver.f90 | 208 ++++++++++++ lilac/lilac/esmf_utils.f90 | 3 +- lilac/lilac/lilac_utils.f90 | 116 +++++++ 5 files changed, 523 insertions(+), 382 deletions(-) delete mode 100644 lilac/lilac/drivers/data_driver.f90 create mode 100644 lilac/lilac/drivers/lilac_data_driver.f90 create mode 100644 lilac/lilac/lilac_utils.f90 diff --git a/lilac/lilac/core.f90 b/lilac/lilac/core.f90 index e08677478b..dc178d0aa1 100644 --- a/lilac/lilac/core.f90 +++ b/lilac/lilac/core.f90 @@ -3,11 +3,17 @@ module lilac use ESMF use esmf_utils + use lilac_utils , only fldlist_add + + implicit none character(*), parameter :: modname = "(core)" integer, parameter :: LILAC_SUCCESS = ESMF_SUCCESS + type(LilacFields) :: a2x_state + type(LilacFields) :: x2a_state + !-------------------------------------------------------------------------- ! Public interfaces !-------------------------------------------------------------------------- @@ -24,6 +30,7 @@ module lilac private type(ESMFInfoType) :: esmf_info + character contains procedure, public :: init => init @@ -53,6 +60,17 @@ module lilac end type LilacType + type, public :: LilacFields + private + + real, dimension(:, :), allocatable :: fields + character(len=:), allocatable :: field_names(:) + + contains + procedure, public :: init => init_lilac_state + procedure, public :: get => get_lilac_field + end type LilacFields + contains subroutine start(self, rc) @@ -74,8 +92,8 @@ subroutine init(self, clock, x2a_state, a2x_state, rc) implicit none class(LilacType), intent(inout) :: self type(ESMF_Clock) :: clock ! Input synchronization clock - type(ESMF_State) :: x2a_state - type(ESMF_State) :: a2x_state + type(LilacFields) :: x2a_state + type(LilacFields) :: a2x_state integer, intent(in) :: rc=ESMF_SUCCESS character(len=*), parameter :: subname=trim(modname)//':(init) ' @@ -91,15 +109,17 @@ subroutine run(self, clock, x2a_state, a2x_state, rc) implicit none class(LilacType), intent(inout) :: self type(ESMF_Clock) :: clock ! Input synchronization clock - type(ESMF_State) :: x2a_state - type(ESMF_State) :: a2x_state + type(LilacFields) :: x2a_state + type(LilacFields) :: a2x_state integer, intent(in) :: rc=ESMF_SUCCESS character(len=*), parameter :: subname=trim(modname)//':(run) ' call ESMF_LogWrite(subname//"Running lilac", ESMF_LOGMSG_INFO) - call self%esmf_info%run(rc, ) + ! save states to module level variable here + + call self%esmf_info%run(rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end subroutine run @@ -195,7 +215,133 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) ! Initialize return code rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"atmos_init has not been implemented yet", ESMF_LOGMSG_INFO) + ! read in the mesh + ! TODO: set cvalue to filepath of atm mesh + cvalue = "/path/to/foo" + + if (masterproc) then + write(iulog,*)'mesh file for domain is ',trim(cvalue) + end if + + ! move to lilac dummy atmosphere init + EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! import fields + ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) + + ! land states + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) + + ! fluxes to atm + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) + + ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) + + ! from atm + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) + + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) + + ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 + + ! Create States + x2a_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + a2x_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Coupler to Atmosphere Fields + FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Create individual states and add to field bundle + do n = 1,fldsFrCpl_num + ! create field + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsFrCpl(n)%stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! add field to field bundle + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + enddo + + ! Add FB to state + call ESMF_StateAdd(x2a_state, (/FBout/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Atmosphere to Coupler Fields + FBout = ESMF_FieldBundleCreate(name="a2x_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Create individual states and add to field bundle + do n = 1,fldsToCpl_num + ! create field + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsToCpl(n)%stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! initialize with default value + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ldptr = fldsToCpl(n)%default_value + + ! add field to field bundle + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + enddo + + ! Add FB to state + call ESMF_StateAdd(a2x_state, (/FBout/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end subroutine atmos_init @@ -242,6 +388,8 @@ subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) + ! loop over fields, copying pointer from import to export state + end subroutine atmos_copy_atm_to_lilac subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) @@ -334,4 +482,47 @@ subroutine coupler_final(comp, importState, exportState, clock, rc) end subroutine coupler_final + subroutine init_lilac_state(self, field_list, nlocal) + implicit none + class(LilacFields), intent(inout) :: self + type(fld_list_type), intent(inout) :: field_list(:) + integer, intent(in) :: nlocal + + integer :: nfields, i + + nfields = size(field_list) + + allocate(character(MAXCHAR) :: self%field_names(nfields)) + allocate(self%fields(nfields, nlocal)) + + do i = 1, nfields + self%field_names(i) = field_list(i)%stdname + self%fields(i) = field_list(i)%default_value + enddo + + end subroutine init_lilac_state + + + function get_lilac_field(self, field_name) result(array_ptr) + implicit none + class(LilacFields) :: self + character(len=*) :: field_name + pointer :: array_ptr + + integer :: i + + nfields = size(self%field_names) + + do i = 1, nfields + if (field_name .eq. (self%field_names(i))) then + ptr => self%fields(i, :) + return + endif + enddo + + ! Raise error here + call ESMF_LogWrite("KeyError: Did not find variable in LilacFields object" // field_name, ESMF_LOGMSG_INFO) + + end function get_lilac_field + end module lilac diff --git a/lilac/lilac/drivers/data_driver.f90 b/lilac/lilac/drivers/data_driver.f90 deleted file mode 100644 index c083a78961..0000000000 --- a/lilac/lilac/drivers/data_driver.f90 +++ /dev/null @@ -1,375 +0,0 @@ - -program lilac_data_driver - - use seq_flds_mod , only: & - seq_flds_x2l_states, seq_flds_x2l_fluxes, seq_flds_x2l_fields, & - seq_flds_l2x_states, seq_flds_l2x_fluxes, seq_flds_l2x_fields, & - seq_flds_dom_coord, seq_flds_dom_other, seq_flds_dom_fields - use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata - use shr_sys_mod , only: shr_sys_flush, shr_sys_abort - use shr_orb_mod , only: shr_orb_params - use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel - use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 - use ESMF - - implicit none - -#include ! mpi library include file - - !----- Clocks ----- - type(ESMF_Clock) :: EClock ! Input synchronization clock - type(ESMF_Time) :: CurrTime, StartTime, StopTime - type(ESMF_TimeInterval) :: TimeStep - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar),target :: Calendar - integer :: yy,mm,dd,sec - - !----- MPI/MCT ----- - integer :: mpicom_lilac_drv ! local mpicom - integer :: ID_lilac_drv ! mct ID - integer :: ncomps ! number of separate components for MCT - integer :: ntasks,mytask ! mpicom size and rank - integer :: global_comm ! copy of mpi_comm_world for pio - integer,allocatable :: comp_id(:) ! for pio init2 - logical,allocatable :: comp_iamin(:) ! for pio init2 - character(len=64),allocatable :: comp_name(:) ! for pio init2 - integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 - - !----- Land Coupling Data ----- - type(ESMF_GridComp) :: gridComp - type(ESMF_State) :: a2x_state - type(ESMF_State) :: x2a_state - - integer :: orb_iyear ! Orbital - real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp - character(len=128) :: case_name, case_desc, model_version, hostname, username - character(len=128) :: start_type - logical :: brnch_retain_casename, single_column, atm_aero - real*8 :: scmlat, scmlon - - !----- Atm Model ----- - integer :: atm_nx, atm_ny - integer :: gsize, lsize, gstart, gend ! domain decomp info - integer, allocatable :: gindex(:) ! domain decomp info - type(mct_aVect) :: x2l_a ! data for land on atm decomp - type(mct_aVect) :: l2x_a ! data from land on atm decomp - type(mct_gsMap) :: gsmap_atm ! gsmap data for atm - type(mct_rearr) :: rearr_atm2lnd ! rearranger for atm to land - type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm - - !----- Other ----- - integer :: n,m ! counter - character(len=128) :: string ! temporary string - integer :: ierr, rc ! local error status - integer :: iunit = 250 ! lilac_drv log unit number - integer :: sunit = 249 ! share log unit number - character(len=*),parameter :: subname = 'lilac_drv' - - type fld_list_type - character(len=128) :: stdname - real*8 :: default_value - character(len=128) :: units - end type fld_list_type - - integer, parameter :: fldsMax = 100 - integer :: fldsToCpl_num = 0 - integer :: fldsFrCpl_num = 0 - type (fld_list_type) :: fldsToCpl(fldsMax) - type (fld_list_type) :: fldsFrCpl(fldsMax) - - !---------------------------------------------- - - !---------------------------------------------- - !--- MPI/MCT --- - !---------------------------------------------- - - call MPI_Init(ierr) - call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_lilac_drv, ierr) - call MPI_COMM_RANK(mpicom_lilac_drv, mytask, ierr) - call MPI_COMM_SIZE(mpicom_lilac_drv, ntasks, ierr) - - call lilac%start() - - !---------------------------------------------- - !--- Log File and PIO --- - !---------------------------------------------- - - global_comm = MPI_COMM_WORLD - call shr_pio_init1(ncomps, 'pio_in', global_comm) - allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) - do n = 1,ncomps - comp_id(n) = ID_lilac_drv - comp_name(n) = 'LND' - comp_iamin(n) = .true. - comp_comm(n) = mpicom_lilac_drv - comp_comm_iam(n) = mytask - enddo - call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) - deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) - - write(string,'(a,i4.4)') 'lilac_drv.log.',mytask - open(iunit, file=trim(string)) - write(iunit,*) subname,' STARTING' - call shr_sys_flush(iunit) - - write(iunit,*) subname,' ntasks = ',ntasks - write(iunit,*) subname,' mytask = ',mytask - write(iunit,*) subname,' mct ID = ',ID_lilac_drv - call shr_sys_flush(iunit) - call shr_file_setLogUnit(sunit) - call shr_file_setLogLevel(1) - - !---------------------------------------------- - !--- Clocks --- - !---------------------------------------------- - Calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - - EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop', clock=EClock, ringTime=StopTime, rc=rc) - EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', clock=EClock, ringTime=StopTime, rc=rc) - - call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec - call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - !--- set orbital params - orb_iyear = 1990 - call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp, .true.) - - !--- set case information - case_name = 'lilac_drv' - case_desc = 'lilac_drv with clm' - model_version = 'lilac_drv0.1' - hostname = 'undefined' - username = 'undefined' - start_type = 'startup' - brnch_retain_casename = .true. - single_column = .false. - scmlat = 0.0 - scmlon = 0.0 - atm_aero = .true. - call seq_infodata_putData(infodata, case_name=case_name, & - case_desc=case_desc, single_column=single_column, & - scmlat=scmlat, scmlon=scmlon, & - brnch_retain_casename=brnch_retain_casename, & - start_type=start_type, model_version=model_version, & - hostname=hostname, username=username, & - atm_aero=atm_aero ) - - !---------------------------------------------- - !--- lnd_init --- - !---------------------------------------------- - - write(iunit,*) subname,' calling lilac%init' - call shr_sys_flush(iunit) - - call lilac%init(EClock, x2a_state, a2x_state, rc=rc) - - !---------------------------------------------- - !--- atm and atm/lnd coupling init --- - !---------------------------------------------- - - ! read in the mesh - ! TODO: set cvalue to filepath of atm mesh - cvalue = "/path/to/foo" - - if (masterproc) then - write(iulog,*)'mesh file for domain is ',trim(cvalue) - end if - - EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! import fields - ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) - - ! land states - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) - - ! fluxes to atm - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) - - ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) - - ! from atm - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) - - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) - - ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 - - ! Create States - x2a_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - a2x_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Coupler to Atmosphere Fields - FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Create individual states and add to field bundle - do n = 1,fldsFrCpl_num - ! create field - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsFrCpl(n)%stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! add field to field bundle - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - enddo - - ! Add FB to state - call ESMF_StateAdd(x2a_state, (/FBout/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Atmosphere to Coupler Fields - FBout = ESMF_FieldBundleCreate(name="a2x_fields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Create individual states and add to field bundle - do n = 1,fldsToCpl_num - ! create field - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsToCpl(n)%stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! initialize with default value - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ldptr = fldsToCpl(n)%default_value - - ! add field to field bundle - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - enddo - - ! Add FB to state - call ESMF_StateAdd(a2x_state, (/FBout/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - - !---------------------------------------------- - !--- Time Loop --- - !---------------------------------------------- - - call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) - do while (CurrTime < StopTime) - call ESMF_ClockAdvance(EClock, rc=rc) - call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) - call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' lilac_drv ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - ! can manually override the alarms as needed - call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) - if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) - - ! run lilac - write(iunit,*) subname,' call lilac%run',yy,mm,dd,sec - call lilac%run(EClock, x2a_state, a2x_state, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - enddo - - !---------------------------------------------- - !--- lnd_final --- - !---------------------------------------------- - - write(iunit,*) subname,' calling lilac%final()' - call shr_sys_flush(iunit) - call lilac%final() - - !---------------------------------------------- - !--- Done --- - !---------------------------------------------- - - write(iunit,*) subname,' DONE' - call shr_sys_flush(iunit) - call MPI_Finalize(ierr) - -end program lilac_data_driver - -subroutine fldlist_add(num, fldlist, stdname, default_value, units) - integer intent(inout) :: num - type(fld_list_type) intent(inout) :: fldlist(:) - character(len=*) intent(in) :: stdname - real, optional intent(in) :: default_value - character(len=*), optional intent(in) :: units - - - ! local variables - integer :: rc - character(len=*), parameter :: subname='(fldlist_add)' - !------------------------------------------------------------------------------- - - ! Set up a list of field information - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) return - endif - fldlist(num)%stdname = trim(stdname) - if(present(default_value)) then - fldlist(num)%default_value = default_value - else - fldlist(num)%default_value = 0. - end if - if(present(units)) then - fldlist(num)%units = trim(units) - else - fldlist(num)%units = "" - end if - -end subroutine fldlist_add diff --git a/lilac/lilac/drivers/lilac_data_driver.f90 b/lilac/lilac/drivers/lilac_data_driver.f90 new file mode 100644 index 0000000000..3fc0fc1cd7 --- /dev/null +++ b/lilac/lilac/drivers/lilac_data_driver.f90 @@ -0,0 +1,208 @@ + +program lilac_data_driver + + use seq_flds_mod , only: & + seq_flds_x2l_states, seq_flds_x2l_fluxes, seq_flds_x2l_fields, & + seq_flds_l2x_states, seq_flds_l2x_fluxes, seq_flds_l2x_fields, & + seq_flds_dom_coord, seq_flds_dom_other, seq_flds_dom_fields + use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata + use shr_sys_mod , only: shr_sys_flush, shr_sys_abort + use shr_orb_mod , only: shr_orb_params + use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel + use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 + use ESMF + + implicit none + +#include ! mpi library include file + + !----- Clocks ----- + type(ESMF_Clock) :: EClock ! Input synchronization clock + type(ESMF_Time) :: CurrTime, StartTime, StopTime + type(ESMF_TimeInterval) :: TimeStep + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar),target :: Calendar + integer :: yy,mm,dd,sec + + !----- MPI/MCT ----- + integer :: mpicom_lilac_drv ! local mpicom + integer :: ID_lilac_drv ! mct ID + integer :: ncomps ! number of separate components for MCT + integer :: ntasks,mytask ! mpicom size and rank + integer :: global_comm ! copy of mpi_comm_world for pio + integer,allocatable :: comp_id(:) ! for pio init2 + logical,allocatable :: comp_iamin(:) ! for pio init2 + character(len=64),allocatable :: comp_name(:) ! for pio init2 + integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 + + !----- Land Coupling Data ----- + type(LilacGrid) :: gridComp + type(LilacState) :: a2x_state + type(LilacState) :: x2a_state + + integer :: orb_iyear ! Orbitalle + real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp + character(len=128) :: case_name, case_desc, model_version, hostname, username + character(len=128) :: start_type + logical :: brnch_retain_casename, single_column, atm_aero + real*8 :: scmlat, scmlon + + !----- Atm Model ----- + integer :: atm_nx, atm_ny + integer :: gsize, lsize, gstart, gend ! domain decomp info + integer, allocatable :: gindex(:) ! domain decomp info + type(mct_aVect) :: x2l_a ! data for land on atm decomp + type(mct_aVect) :: l2x_a ! data from land on atm decomp + type(mct_gsMap) :: gsmap_atm ! gsmap data for atm + type(mct_rearr) :: rearr_atm2lnd ! rearranger for atm to land + type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm + + !----- Other ----- + integer :: n,m ! counter + character(len=128) :: string ! temporary string + integer :: ierr, rc ! local error status + integer :: iunit = 250 ! lilac_drv log unit number + integer :: sunit = 249 ! share log unit number + character(len=*),parameter :: subname = 'lilac_drv' + + integer, parameter :: fldsMax = 100 + integer :: fldsToCpl_num = 0 + integer :: fldsFrCpl_num = 0 + type (fld_list_type) :: fldsToCpl(fldsMax) + type (fld_list_type) :: fldsFrCpl(fldsMax) + + !---------------------------------------------- + + !---------------------------------------------- + !--- MPI/MCT --- + !---------------------------------------------- + + call MPI_Init(ierr) + call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_lilac_drv, ierr) + call MPI_COMM_RANK(mpicom_lilac_drv, mytask, ierr) + call MPI_COMM_SIZE(mpicom_lilac_drv, ntasks, ierr) + + call lilac%start() + + !---------------------------------------------- + !--- Log File and PIO --- + !---------------------------------------------- + + global_comm = MPI_COMM_WORLD + call shr_pio_init1(ncomps, 'pio_in', global_comm) + allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) + do n = 1,ncomps + comp_id(n) = ID_lilac_drv + comp_name(n) = 'LND' + comp_iamin(n) = .true. + comp_comm(n) = mpicom_lilac_drv + comp_comm_iam(n) = mytask + enddo + call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) + deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) + + write(string,'(a,i4.4)') 'lilac_drv.log.',mytask + open(iunit, file=trim(string)) + write(iunit,*) subname,' STARTING' + call shr_sys_flush(iunit) + + write(iunit,*) subname,' ntasks = ',ntasks + write(iunit,*) subname,' mytask = ',mytask + write(iunit,*) subname,' mct ID = ',ID_lilac_drv + call shr_sys_flush(iunit) + call shr_file_setLogUnit(sunit) + call shr_file_setLogLevel(1) + + !---------------------------------------------- + !--- Clocks --- + !---------------------------------------------- + Calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) + + EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop', clock=EClock, ringTime=StopTime, rc=rc) + EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', clock=EClock, ringTime=StopTime, rc=rc) + + call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec + call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + !--- set orbital params + orb_iyear = 1990 + call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp, .true.) + + !--- set case information + case_name = 'lilac_drv' + case_desc = 'lilac_drv with clm' + model_version = 'lilac_drv0.1' + hostname = 'undefined' + username = 'undefined' + start_type = 'startup' + brnch_retain_casename = .true. + single_column = .false. + scmlat = 0.0 + scmlon = 0.0 + atm_aero = .true. + call seq_infodata_putData(infodata, case_name=case_name, & + case_desc=case_desc, single_column=single_column, & + scmlat=scmlat, scmlon=scmlon, & + brnch_retain_casename=brnch_retain_casename, & + start_type=start_type, model_version=model_version, & + hostname=hostname, username=username, & + atm_aero=atm_aero ) + + !---------------------------------------------- + !--- lnd_init --- + !---------------------------------------------- + + write(iunit,*) subname,' calling lilac%init' + call shr_sys_flush(iunit) + + call lilac%init(EClock, x2a_state, a2x_state, rc=rc) + + !---------------------------------------------- + !--- atm and atm/lnd coupling init --- + !---------------------------------------------- + + !---------------------------------------------- + !--- Time Loop --- + !---------------------------------------------- + + call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) + do while (CurrTime < StopTime) + call ESMF_ClockAdvance(EClock, rc=rc) + call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) + call ESMF_TimeGet(CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + write(iunit,'(1x,2a,4i6)') subname,' lilac_drv ymds=',yy,mm,dd,sec + call shr_sys_flush(iunit) + + ! can manually override the alarms as needed + call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) + if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) + + ! run lilac + write(iunit,*) subname,' call lilac%run',yy,mm,dd,sec + call lilac%run(EClock, x2a_state, a2x_state, rc=rc) + enddo + + !---------------------------------------------- + !--- lnd_final --- + !---------------------------------------------- + + write(iunit,*) subname,' calling lilac%final()' + call shr_sys_flush(iunit) + call lilac%final() + + !---------------------------------------------- + !--- Done --- + !---------------------------------------------- + + write(iunit,*) subname,' DONE' + call shr_sys_flush(iunit) + call MPI_Finalize(ierr) + +end program lilac_data_driver diff --git a/lilac/lilac/esmf_utils.f90 b/lilac/lilac/esmf_utils.f90 index f9bac2809a..527d8081a1 100644 --- a/lilac/lilac/esmf_utils.f90 +++ b/lilac/lilac/esmf_utils.f90 @@ -160,7 +160,7 @@ subroutine run(self, rc) call ESMF_LogWrite(subname//"esmf_info%run()", ESMF_LOGMSG_INFO) ! atmosphere run - ! copy the atmos state and put it into atmos export + ! atmos_run phase 1: copy the atmos state and put it into atmos export call ESMF_GridCompRun(self%atmos_comp, exportState=self%atmos_export, phase=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Atmosphere Run returned", ESMF_LOGMSG_INFO) @@ -180,6 +180,7 @@ subroutine run(self, rc) call ESMF_LogWrite(subname//"Coupler Run returned", ESMF_LOGMSG_INFO) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! atmos run phase 2: copy the atmos state and put it into atmos export call ESMF_GridCompRun(self%atmos_comp, importState=self%atmos_import, phase=2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Atmosphere Run returned", ESMF_LOGMSG_INFO) diff --git a/lilac/lilac/lilac_utils.f90 b/lilac/lilac/lilac_utils.f90 new file mode 100644 index 0000000000..008d49524d --- /dev/null +++ b/lilac/lilac/lilac_utils.f90 @@ -0,0 +1,116 @@ +module lilac_utils + + type fld_list_type + character(len=128) :: stdname + real*8 :: default_value + character(len=128) :: units + end type fld_list_type + + subroutine fldlist_add(num, fldlist, stdname, default_value, units) + integer intent(inout) :: num + type(fld_list_type) intent(inout) :: fldlist(:) + character(len=*) intent(in) :: stdname + real, optional intent(in) :: default_value + character(len=*), optional intent(in) :: units + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(fldlist_add)' + !------------------------------------------------------------------------------- + + ! Set up a list of field information + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) return + endif + fldlist(num)%stdname = trim(stdname) + if(present(default_value)) then + fldlist(num)%default_value = default_value + else + fldlist(num)%default_value = 0. + end if + if(present(units)) then + fldlist(num)%units = trim(units) + else + fldlist(num)%units = "" + end if + + end subroutine fldlist_add + + subroutine create_fldlists(fldsFrCpl_num, fldsToCpl_num) + type(fld_list_type) intent(inout) :: fldsFrCpl(:) + type(fld_list_type) intent(inout) :: fldsToCpl(:) + + ! import fields + ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) + + integer :: fldsFrCpl_num, fldsToCpl_num + + ! land states + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) + + ! fluxes to atm + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) + + ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) + + ! from atm + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) + + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) + + ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 + end subroutine create_fldlists + +end module lilac_utils From 71a69ef15b9f0b19120a9a9058479ccfd0499bb1 Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Thu, 14 Mar 2019 13:04:36 -0700 Subject: [PATCH 055/556] fix a few typos --- lilac/lilac/core.f90 | 1 - lilac/lilac/lilac_utils.f90 | 130 ++++++++++++++++++------------------ 2 files changed, 65 insertions(+), 66 deletions(-) diff --git a/lilac/lilac/core.f90 b/lilac/lilac/core.f90 index dc178d0aa1..cce93f0e62 100644 --- a/lilac/lilac/core.f90 +++ b/lilac/lilac/core.f90 @@ -30,7 +30,6 @@ module lilac private type(ESMFInfoType) :: esmf_info - character contains procedure, public :: init => init diff --git a/lilac/lilac/lilac_utils.f90 b/lilac/lilac/lilac_utils.f90 index 008d49524d..4a8732e1be 100644 --- a/lilac/lilac/lilac_utils.f90 +++ b/lilac/lilac/lilac_utils.f90 @@ -38,79 +38,79 @@ subroutine fldlist_add(num, fldlist, stdname, default_value, units) end subroutine fldlist_add subroutine create_fldlists(fldsFrCpl_num, fldsToCpl_num) - type(fld_list_type) intent(inout) :: fldsFrCpl(:) - type(fld_list_type) intent(inout) :: fldsToCpl(:) + type(fld_list_type) intent(inout) :: fldsFrCpl(:) + type(fld_list_type) intent(inout) :: fldsToCpl(:) - ! import fields - ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) + ! import fields + ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) - integer :: fldsFrCpl_num, fldsToCpl_num + integer :: fldsFrCpl_num, fldsToCpl_num - ! land states - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) + ! land states + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) - ! fluxes to atm - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) + ! fluxes to atm + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) - ! from atm - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) + ! from atm + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) - ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 + ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 end subroutine create_fldlists end module lilac_utils From 6f1217b7c712043a4a1ae5a25848ee9c517d4b1c Mon Sep 17 00:00:00 2001 From: Joseph Hamman Date: Fri, 15 Mar 2019 13:35:28 -0700 Subject: [PATCH 056/556] checking working space before call --- lilac/lilac/core.f90 | 89 ++++------------------- lilac/lilac/drivers/lilac_data_driver.f90 | 21 +++--- lilac/lilac/lilac_utils.f90 | 7 +- 3 files changed, 29 insertions(+), 88 deletions(-) diff --git a/lilac/lilac/core.f90 b/lilac/lilac/core.f90 index cce93f0e62..af33240e6d 100644 --- a/lilac/lilac/core.f90 +++ b/lilac/lilac/core.f90 @@ -3,7 +3,7 @@ module lilac use ESMF use esmf_utils - use lilac_utils , only fldlist_add + use lilac_utils , only create_fldlists, fldsMax implicit none @@ -11,6 +11,8 @@ module lilac character(*), parameter :: modname = "(core)" integer, parameter :: LILAC_SUCCESS = ESMF_SUCCESS + ! shared module level variables + character(len=*) :: atm_mesh_filepath type(LilacFields) :: a2x_state type(LilacFields) :: x2a_state @@ -209,91 +211,26 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc + type (fld_list_type) :: fldsToCpl(fldsMax) + type (fld_list_type) :: fldsFrCpl(fldsMax) + integer :: fldsToCpl_num + integer :: fldsFrCpl_num + character(len=*), parameter :: subname=trim(modname)//':(atmos_init) ' ! Initialize return code rc = ESMF_SUCCESS ! read in the mesh - ! TODO: set cvalue to filepath of atm mesh - cvalue = "/path/to/foo" - if (masterproc) then - write(iulog,*)'mesh file for domain is ',trim(cvalue) + write(iulog,*)'mesh file for domain is ',trim(atm_mesh_filepath) end if - - ! move to lilac dummy atmosphere init - EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + ! move to lilac dummy atmosphere init? + EMesh = ESMF_MeshCreate(filename=trim(atm_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! import fields - ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) - - ! land states - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) - - ! fluxes to atm - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) - - ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) - - ! from atm - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) - - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) - - ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 + ! create field lists + call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) ! Create States x2a_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) diff --git a/lilac/lilac/drivers/lilac_data_driver.f90 b/lilac/lilac/drivers/lilac_data_driver.f90 index 3fc0fc1cd7..b1dfe32665 100644 --- a/lilac/lilac/drivers/lilac_data_driver.f90 +++ b/lilac/lilac/drivers/lilac_data_driver.f90 @@ -1,17 +1,16 @@ program lilac_data_driver - use seq_flds_mod , only: & - seq_flds_x2l_states, seq_flds_x2l_fluxes, seq_flds_x2l_fields, & - seq_flds_l2x_states, seq_flds_l2x_fluxes, seq_flds_l2x_fields, & - seq_flds_dom_coord, seq_flds_dom_other, seq_flds_dom_fields - use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata - use shr_sys_mod , only: shr_sys_flush, shr_sys_abort + use seq_infodata_mod, only: seq_infodata_putdata + use shr_sys_mod , only: shr_sys_flush use shr_orb_mod , only: shr_orb_params use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 use ESMF + use lilac_utils , only create_fldlists, fldsMax + + implicit none #include ! mpi library include file @@ -37,8 +36,8 @@ program lilac_data_driver !----- Land Coupling Data ----- type(LilacGrid) :: gridComp - type(LilacState) :: a2x_state - type(LilacState) :: x2a_state + type(LilacFields) :: a2x_state + type(LilacFields) :: x2a_state integer :: orb_iyear ! Orbitalle real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp @@ -65,9 +64,6 @@ program lilac_data_driver integer :: sunit = 249 ! share log unit number character(len=*),parameter :: subname = 'lilac_drv' - integer, parameter :: fldsMax = 100 - integer :: fldsToCpl_num = 0 - integer :: fldsFrCpl_num = 0 type (fld_list_type) :: fldsToCpl(fldsMax) type (fld_list_type) :: fldsFrCpl(fldsMax) @@ -162,6 +158,9 @@ program lilac_data_driver write(iunit,*) subname,' calling lilac%init' call shr_sys_flush(iunit) + call create_fldlists(fldsFrCpl, fldsToCpl) + + call lilac%init(EClock, x2a_state, a2x_state, rc=rc) !---------------------------------------------- diff --git a/lilac/lilac/lilac_utils.f90 b/lilac/lilac/lilac_utils.f90 index 4a8732e1be..be5d0df6db 100644 --- a/lilac/lilac/lilac_utils.f90 +++ b/lilac/lilac/lilac_utils.f90 @@ -1,5 +1,8 @@ module lilac_utils + integer, parameter :: fldsMax = 100 + + type fld_list_type character(len=128) :: stdname real*8 :: default_value @@ -37,9 +40,11 @@ subroutine fldlist_add(num, fldlist, stdname, default_value, units) end subroutine fldlist_add - subroutine create_fldlists(fldsFrCpl_num, fldsToCpl_num) + subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) type(fld_list_type) intent(inout) :: fldsFrCpl(:) type(fld_list_type) intent(inout) :: fldsToCpl(:) + integer, intent(out) :: fldsToCpl_num = 0 + integer, intent(out) :: fldsFrCpl_num = 0 ! import fields ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) From 4336a2badee050102f9bc59020374d9710cac1b4 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 16 Apr 2019 12:33:58 -0600 Subject: [PATCH 057/556] initial submission of files but it does not compile --- lilac/scripts/DummyAtmos.F90 | 236 +++++++++++++++++++++++++++++ lilac/scripts/LilacMod.F90 | 277 ++++++++++++++++++++++++++++++++++ lilac/scripts/Makefile | 64 ++++++++ lilac/scripts/demo_driver.F90 | 27 ++++ 4 files changed, 604 insertions(+) create mode 100644 lilac/scripts/DummyAtmos.F90 create mode 100644 lilac/scripts/LilacMod.F90 create mode 100644 lilac/scripts/Makefile create mode 100644 lilac/scripts/demo_driver.F90 diff --git a/lilac/scripts/DummyAtmos.F90 b/lilac/scripts/DummyAtmos.F90 new file mode 100644 index 0000000000..4393b99521 --- /dev/null +++ b/lilac/scripts/DummyAtmos.F90 @@ -0,0 +1,236 @@ +module DummyAtmos + use ESMF + use LilacMod + implicit none + + character(*), parameter :: modname = "(core)" + + type(ESMF_Field), public, save :: field + type(ESMF_Field), public, save :: field_sie, field_u + + type fld_list_type + character(len=128) :: stdname + real*8 :: default_value + character(len=128) :: units + real*8, pointer :: datafld1d(:) ! this will be filled in by lilac when it gets its data from the host atm + end type fld_list_type + + +! integer, parameter :: fldsMax = 100 + integer :: flds_x2a_num = 0 + integer :: flds_a2x_num = 0 + + type(fld_list_type), allocatable :: x2a_fields(:) + type(fld_list_type), allocatable :: a2x_fields(:) + + public atmos_register + + contains + + subroutine atmos_register(comp, rc) + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc + character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' + + print *, "in user register routine" + + rc = ESMF_SUCCESS + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_atm_to_lilac, phase=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_lilac_to_atm, phase=2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + end subroutine atmos_register + + subroutine atmos_init(comp, importState, exportState, clock, rc) + type (ESMF_GridComp) :: comp + type (ESMF_State) :: importState, exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + !!! TODO: Maybe it is better to call these fldsToAtm and fldsFrAtm + type (fld_list_type) :: fldsToCpl(fldsMax) + type (fld_list_type) :: fldsFrCpl(fldsMax) + integer :: fldsToCpl_num + integer :: fldsFrCpl_num + + character(len=*), parameter :: subname=trim(modname)//':(atmos_init) ' + + type (ESMF_State) :: x2a_state ! the coupled flow State + type (ESMF_State) :: a2x_state ! the coupled flow State + type (ESMF_FieldBundle) :: FBout + integer :: n + + type(ESMF_Mesh) :: Emesh + character(len=ESMF_MAXSTR) :: atmos_mesh_filepath + + ! Initialize return code + + rc = ESMF_SUCCESS + + !------------------------------------------------------------------------- + ! Generate -- Read in the mesh + !------------------------------------------------------------------------- + + ! For now this is our dummy mesh: + atmos_mesh_filepath='/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + + EMesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) + print *, "!Mesh for atmosphere is created!" + + !------------------------------------------------------------------------- + ! Create States -- x2a_state (import) -- a2x_state (export) + !------------------------------------------------------------------------- + x2a_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + a2x_state = ESMF_StateCreate(name="a2x_state", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, "!empty x2a_state (import) is created!" + print *, "!empty a2x_state (export) is created!" + + !------------------------------------------------------------------------- + ! Coupler (land) to Atmosphere Fields -- x2a + ! I- Create Field Bundle -- FBout for now-- TODO: negin want to rename to x2a_fieldbundle + ! II- Create Fields and add them to field bundle + ! III - Add FBout to state (x2a_state) + !------------------------------------------------------------------------- + FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Create individual states and add to field bundle + fldsFrCpl_num = 1 + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'dummy_var_1') + do n = 1,fldsFrCpl_num + ! create field + !!! Here we want to pass pointers + !!! + !field = ESMF_FieldCreate(lmesh,farrayPtr=x2a_fields%fields(:, n), meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) + print *, trim(fldsFrCpl(n)%stdname) + field = ESMF_FieldCreate(EMesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! add field to field bundle + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + enddo + print *, "!Fields For Coupler (fldsFrCpl) Field Bundle Created!" + + ! Add FB to state + call ESMF_StateAdd(x2a_state, (/FBout/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Atmosphere to Coupler Fields + FBout = ESMF_FieldBundleCreate(name="a2x_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Create individual states and add to field bundle + fldsToCpl_num = 1 + call fldlist_add(fldsToCpl_num, fldsToCpl, 'dummy_var2' ) + do n = 1,fldsToCpl_num + ! create field + !field = ESMF_FieldCreate(lmesh, farrayPtr=a2x_field%fields(:,n) , meshloc=ESMF_MESHLOC_ELEMENT, name=trim(fldsToCpl(n)%stdname), rc=rc) + field = ESMF_FieldCreate(EMesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsToCpl(n)%stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! initialize with default value + !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !fldptr = fldsToCpl(n)%default_value + + ! add field to field bundle + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + enddo + print *, "!Fields to Coupler (fldstoCpl) Field Bundle Created!" + + ! Add FB to state + call ESMF_StateAdd(a2x_state, (/FBout/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, "!a2x_state is filld with dummy_var field bundle!" + + end subroutine atmos_init + + subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_atm_to_lilac) ' + + ! Initialize return code + rc = ESMF_SUCCESS +! get a list of fields of variables we need from atmos.... +! + !call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) + + ! loop over fields, copying pointer from import to export state + + end subroutine atmos_copy_atm_to_lilac + + subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_lilac_to_atm) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) + + end subroutine atmos_copy_lilac_to_atm + + subroutine atmos_final(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_final) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"atmos_final has not been implemented yet", ESMF_LOGMSG_INFO) + + end subroutine atmos_final + !=============================================================================== + + subroutine fldlist_add(num, fldlist, stdname) + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + + ! local variables + integer :: rc + integer :: dbrc + character(len=*), parameter :: subname='(lnd_import_export:fldlist_add)' + !------------------------------------------------------------------------------- + + ! Set up a list of field information + + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + return + endif + fldlist(num)%stdname = trim(stdname) + + end subroutine fldlist_add + + + + +end module DummyAtmos diff --git a/lilac/scripts/LilacMod.F90 b/lilac/scripts/LilacMod.F90 new file mode 100644 index 0000000000..6a02fa44be --- /dev/null +++ b/lilac/scripts/LilacMod.F90 @@ -0,0 +1,277 @@ +!Khoda +module LilacMod +use ESMF +!use DummyAtmos +implicit none + + ! Clock, TimeInterval, and Times + type(ESMF_Clock) :: clock + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_Time) :: stopTime + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar),target :: calendar + integer :: yy,mm,dd,sec + + integer, parameter :: fldsMax = 100 + + type fld_list_type + character(len=128) :: stdname + real*8 :: default_value + character(len=128) :: units + real*8, pointer :: datafld1d(:) ! this will be filled in by lilac when it gets its data from the host atm + end type fld_list_type + + character(*), parameter :: modname = "(LilacMod)" + + !=============================================================================== + + !public :: lilac_init + contains + + subroutine lilac_init( dum_var1, dum_var2) + ! modules + implicit none + + real, dimension(10) :: dum_var1 + real, dimension(10) :: dum_var2 + + ! Component, and State + type(ESMF_GridComp) :: dummy_atmos_comp ! the coupled flow Component + type(ESMF_State) :: coupledFlowState ! the coupled flow State + type(ESMF_Mesh) :: Emesh + character(len=*), parameter :: subname=trim(modname)//':(lilac_init) ' + type(ESMF_State) :: importState, exportState + !character(len=*) :: atm_mesh_filepath + + ! local variables + integer :: rc, urc + character(len=ESMF_MAXSTR) :: cname1, cname2, cplname + + !------------------------------------------------------------------------- + ! Initialize ESMF, set the default calendar and log type. + !------------------------------------------------------------------------- + call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + print *, "----------------------------" + print *, "lilac Demo Application Start" + + !------------------------------------------------------------------------- + ! Create Gridded Component! + !------------------------------------------------------------------------- + cname1 = "Dummy Atmosphere" + + ! Create dummy atmosphere gridded component. + dummy_atmos_comp = ESMF_GridCompCreate(name=cname1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(cname1)//" component", ESMF_LOGMSG_INFO) + print *, "Dummy Atmosphere Gridded Component Created!" + + !------------------------------------------------------------------------- + ! Register section -- set services + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(dummy_atmos_comp, userRoutine=atmos_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"dummy atmos SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Dummy Atmosphere Gridded Component SetServices finished!" + + !------------------------------------------------------------------------- + ! Create and initialize a clock! + ! ????? Should I create a clock here or in driver? + !------------------------------------------------------------------------- + calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) + + !print *, + !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) + !EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) + + !------------------------------------------------------------------------- + ! Atmosphere Initialization.... + !------------------------------------------------------------------------- + call ESMF_GridCompInitialize(dummy_atmos_comp, & + importState=importState, exportState=exportState, & + clock=clock, rc=rc) + !call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + + end subroutine lilac_init + + subroutine lilac_run(dum_var_input, dum_var_output) + + use DummyAtmos, only : x2a_fields + use DummyAtmos, only : a2x_fields + + real, dimension(:) :: dum_var_input ! from host atm + real, dimension(:) :: dum_var_output ! to host atm + + integer :: n, num + + integer, parameter :: fldsMax = 100 + integer :: fldsToLnd_num = 0 + integer :: fldsFrLnd_num = 0 + + type (fld_list_type) :: fldsToLnd(fldsMax) + type (fld_list_type) :: fldsFrLnd(fldsMax) + !----------------------------------------- + !----------------------------------------- + type(ESMF_State) :: importState, exportState + + !search through fldlist array to find the right fldist object to do the copy - say its index N + + x2a_fields(n)%datafld1d(:) = dum_var_input(:) + + !call ESMF_CplCompRun(cpl_atm2lnd, rc=rc) + + !call ESMF_GridCompRun(lndcomp, rc=rc) + + !call ESMF_CplCompRun(cpl_lnd2atm, rc=rc) + + dum_var_output(:) = a2x_fields(N)%datafld1d(:) + + end subroutine lilac_run + + + + + + !subroutine fldlist_add(num, fldlist, stdname, default_value, units) + ! integer, intent(inout) :: num + ! type(fld_list_type), intent(inout) :: fldlist(:) + ! character(len=*), intent(in) :: stdname + ! real, optional, intent(in) :: default_value + ! character(len=*), optional, intent(in) :: units + + ! local variables + ! integer :: rc + ! character(len=*), parameter :: subname='(fldlist_add)' + !------------------------------------------------------------------------------- + + ! Set up a list of field information + ! num = num + 1 + ! if (num > fldsMax) then + ! call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) return + ! endif + ! fldlist(num)%stdname = trim(stdname) + ! if(present(default_value)) then + ! fldlist(num)%default_value = default_value + ! else + ! fldlist(num)%default_value = 0. + ! end if + ! if(present(units)) then + ! fldlist(num)%units = trim(units) + ! else + ! fldlist(num)%units = "" + ! end if + + ! end subroutine fldlist_add + + +subroutine fldlist_add(num, fldlist, stdname) + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + + ! local variables + integer :: rc + integer :: dbrc + character(len=*), parameter :: subname='(lnd_import_export:fldlist_add)' + !------------------------------------------------------------------------------- + + ! Set up a list of field information + + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + return + endif + fldlist(num)%stdname = trim(stdname) + + end subroutine fldlist_add + subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) + type(fld_list_type), intent(inout) :: fldsFrCpl(:) + type(fld_list_type), intent(inout) :: fldsToCpl(:) + integer, intent(out) :: fldsToCpl_num = 0 + integer, intent(out) :: fldsFrCpl_num = 0 + + ! import fields + ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) + + integer :: fldsFrCpl_num, fldsToCpl_num + + ! land states + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) + + ! fluxes to atm + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) + + ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) + + ! from atm + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) + + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) + + ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 + end subroutine create_fldlists + +end module LilacMod + diff --git a/lilac/scripts/Makefile b/lilac/scripts/Makefile new file mode 100644 index 0000000000..8890dbdd9e --- /dev/null +++ b/lilac/scripts/Makefile @@ -0,0 +1,64 @@ +# GNU Makefile template for user ESMF application + +################################################################################ +################################################################################ +## This Makefile must be able to find the "esmf.mk" Makefile fragment in the ## +## 'include' line below. Following the ESMF User's Guide, a complete ESMF ## +## installation should ensure that a single environment variable "ESMFMKFILE" ## +## is made available on the system. This variable should point to the ## +## "esmf.mk" file. ## +## ## +## This example Makefile uses the "ESMFMKFILE" environment variable. ## +## ## +## If you notice that this Makefile cannot find variable ESMFMKFILE then ## +## please contact the person responsible for the ESMF installation on your ## +## system. ## +## As a work-around you can simply hardcode the path to "esmf.mk" in the ## +## include line below. However, doing so will render this Makefile a lot less ## +## flexible and non-portable. ## +################################################################################ + +ifneq ($(origin ESMFMKFILE), environment) +$(error Environment variable ESMFMKFILE was not set.) +endif + +include $(ESMFMKFILE) + +################################################################################ +################################################################################ + +.SUFFIXES: .f90 .F90 .c .C + +%.o : %.f90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREENOCPP) $< + +%.o : %.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $< + +%.o : %.c + $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< + +% : %.C + $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< + + +# ----------------------------------------------------------------------------- +demo_driver: demo_driver.o DummyAtmos.o LilacMod.o + $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) + mv demo_driver demo_driver.exe + rm *.o *.mod + +# module dependencies: +demo_driver.o: LilacMod.o DummyAtmos.o +DummyAtmos.o: LilacMod.o +LilacMod.o: +# ----------------------------------------------------------------------------- +# ----------------------------------------------------------------------------- +.PHONY: dust clean distclean berzerk +dust: + rm -f PET*.ESMF_LogFile DE.nc FLAG.nc OMEGA.nc SIE.nc U_velocity.nc V_velocity.nc +clean: + rm -f *.exe *.o *.mod +distclean: dust clean +berzerk: + rm -f PET*.ESMF_LogFile job_name* *.o *.mod *.exe diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 new file mode 100644 index 0000000000..f41691e7d7 --- /dev/null +++ b/lilac/scripts/demo_driver.F90 @@ -0,0 +1,27 @@ +!Khoda +program demo_lilac_driver + ! modules + use ESMF + use LilacMod + + implicit none + real, dimension(10) :: dum_var1 + real, dimension(10) :: dum_var2 + + real, dimension(10) :: t_phy ! temperature (K) + real, dimension(10) :: th_phy ! potential temperature (K) + !real, dimension(10,10) :: rho ! + + call random_number(dum_var1) + call random_number(dum_var2) + call random_number(t_phy) + call random_number(th_phy) + print *, "dum_var1 = ", dum_var1 + print *, "dum_var2 = ", dum_var2 + call lilac_init(dum_var1, dum_var2) + call lilac_run(dum_var1, dum_var2) + call ESMF_Finalize() + + +end program demo_lilac_driver + From d6987f2785d10e7ed902e72fe57aee0a59d1024b Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 16 Apr 2019 13:05:19 -0600 Subject: [PATCH 058/556] Using Joe Hamman lilac_utils --- lilac/scripts/lilac_utils.f90 | 122 ++++++++++++++++++++++++++++++++++ 1 file changed, 122 insertions(+) create mode 100644 lilac/scripts/lilac_utils.f90 diff --git a/lilac/scripts/lilac_utils.f90 b/lilac/scripts/lilac_utils.f90 new file mode 100644 index 0000000000..1c45b8caf5 --- /dev/null +++ b/lilac/scripts/lilac_utils.f90 @@ -0,0 +1,122 @@ +module lilac_utils +!!! NS: THIS IS JH WORK + + integer, parameter :: fldsMax = 100 + + + type fld_list_type + character(len=128) :: stdname + real*8 :: default_value + character(len=128) :: units + end type fld_list_type + + subroutine fldlist_add(num, fldlist, stdname, default_value, units) + integer intent(inout) :: num + type(fld_list_type) intent(inout) :: fldlist(:) + character(len=*) intent(in) :: stdname + real, optional intent(in) :: default_value + character(len=*), optional intent(in) :: units + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(fldlist_add)' + !------------------------------------------------------------------------------- + + ! Set up a list of field information + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) return + endif + fldlist(num)%stdname = trim(stdname) + if(present(default_value)) then + fldlist(num)%default_value = default_value + else + fldlist(num)%default_value = 0. + end if + if(present(units)) then + fldlist(num)%units = trim(units) + else + fldlist(num)%units = "" + end if + + end subroutine fldlist_add + + subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) + type(fld_list_type) intent(inout) :: fldsFrCpl(:) + type(fld_list_type) intent(inout) :: fldsToCpl(:) + integer, intent(out) :: fldsToCpl_num = 0 + integer, intent(out) :: fldsFrCpl_num = 0 + + ! import fields + ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) + + integer :: fldsFrCpl_num, fldsToCpl_num + + ! land states + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) + + ! fluxes to atm + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) + + ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) + + ! from atm + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) + + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) + + ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 + end subroutine create_fldlists + +end module lilac_utils From 7d2d1eef1bc3fc6bcadea63d4f5876cb217ed126 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 16 Apr 2019 14:53:14 -0600 Subject: [PATCH 059/556] at least it is getting built! --- lilac/scripts/demo_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index f41691e7d7..bd1bb2d34d 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -1,5 +1,5 @@ -!Khoda program demo_lilac_driver + ! modules use ESMF use LilacMod From a3a36d41eccd9aaa0001afdec0350cbfdba7f47f Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 16 Apr 2019 14:54:51 -0600 Subject: [PATCH 060/556] at least it is getting built and compiled! :-) compile: success --- lilac/scripts/DummyAtmos.F90 | 53 ++++--- lilac/scripts/LilacMod.F90 | 27 ++-- lilac/scripts/Makefile | 9 +- lilac/scripts/lilac_utils.f90 | 251 ++++++++++++++++++---------------- 4 files changed, 175 insertions(+), 165 deletions(-) diff --git a/lilac/scripts/DummyAtmos.F90 b/lilac/scripts/DummyAtmos.F90 index 4393b99521..419d716b7d 100644 --- a/lilac/scripts/DummyAtmos.F90 +++ b/lilac/scripts/DummyAtmos.F90 @@ -1,28 +1,23 @@ module DummyAtmos use ESMF - use LilacMod + use lilac_utils, only: fldlist_add, fld_list_type, fldsMax + + implicit none - - character(*), parameter :: modname = "(core)" + type(ESMF_Field), public, save :: field type(ESMF_Field), public, save :: field_sie, field_u - - type fld_list_type - character(len=128) :: stdname - real*8 :: default_value - character(len=128) :: units - real*8, pointer :: datafld1d(:) ! this will be filled in by lilac when it gets its data from the host atm - end type fld_list_type - -! integer, parameter :: fldsMax = 100 integer :: flds_x2a_num = 0 integer :: flds_a2x_num = 0 type(fld_list_type), allocatable :: x2a_fields(:) type(fld_list_type), allocatable :: a2x_fields(:) + !private + character(*), parameter :: modname = "(core)" + public atmos_register contains @@ -109,7 +104,9 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) ! Create individual states and add to field bundle fldsFrCpl_num = 1 - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'dummy_var_1') + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'dummy_var_1', default_value=0.0, units='m') + !call fldlist_add + call fldlist_add(fldsToCpl_num, fldsFrCpl, 'Sa_u', default_value=0.0,units='m/s') do n = 1,fldsFrCpl_num ! create field !!! Here we want to pass pointers @@ -207,28 +204,28 @@ subroutine atmos_final(comp, importState, exportState, clock, rc) end subroutine atmos_final !=============================================================================== - subroutine fldlist_add(num, fldlist, stdname) - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname + !subroutine fldlist_add(num, fldlist, stdname) + ! integer, intent(inout) :: num + ! type(fld_list_type), intent(inout) :: fldlist(:) + ! character(len=*), intent(in) :: stdname ! local variables - integer :: rc - integer :: dbrc - character(len=*), parameter :: subname='(lnd_import_export:fldlist_add)' + ! integer :: rc + ! integer :: dbrc + ! character(len=*), parameter :: subname='(lnd_import_export:fldlist_add)' !------------------------------------------------------------------------------- ! Set up a list of field information - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - fldlist(num)%stdname = trim(stdname) + ! num = num + 1 + ! if (num > fldsMax) then + ! call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & + ! ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + ! return + ! endif + ! fldlist(num)%stdname = trim(stdname) - end subroutine fldlist_add + !end subroutine fldlist_add diff --git a/lilac/scripts/LilacMod.F90 b/lilac/scripts/LilacMod.F90 index 6a02fa44be..feb896860b 100644 --- a/lilac/scripts/LilacMod.F90 +++ b/lilac/scripts/LilacMod.F90 @@ -1,7 +1,11 @@ !Khoda module LilacMod use ESMF +use lilac_utils !use DummyAtmos +use DummyAtmos, only : x2a_fields +use DummyAtmos, only : a2x_fields +use DummyAtmos, only : atmos_register implicit none ! Clock, TimeInterval, and Times @@ -13,15 +17,6 @@ module LilacMod type(ESMF_Calendar),target :: calendar integer :: yy,mm,dd,sec - integer, parameter :: fldsMax = 100 - - type fld_list_type - character(len=128) :: stdname - real*8 :: default_value - character(len=128) :: units - real*8, pointer :: datafld1d(:) ! this will be filled in by lilac when it gets its data from the host atm - end type fld_list_type - character(*), parameter :: modname = "(LilacMod)" !=============================================================================== @@ -173,7 +168,7 @@ end subroutine lilac_run ! end subroutine fldlist_add -subroutine fldlist_add(num, fldlist, stdname) +subroutine fldlist_add_dumb(num, fldlist, stdname) integer, intent(inout) :: num type(fld_list_type), intent(inout) :: fldlist(:) character(len=*), intent(in) :: stdname @@ -194,12 +189,12 @@ subroutine fldlist_add(num, fldlist, stdname) endif fldlist(num)%stdname = trim(stdname) - end subroutine fldlist_add - subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) + end subroutine fldlist_add_dumb + subroutine create_fldlists_dumb(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) type(fld_list_type), intent(inout) :: fldsFrCpl(:) type(fld_list_type), intent(inout) :: fldsToCpl(:) - integer, intent(out) :: fldsToCpl_num = 0 - integer, intent(out) :: fldsFrCpl_num = 0 + !integer, intent(out) :: fldsToCpl_num = 0 + !integer, intent(out) :: fldsFrCpl_num = 0 ! import fields ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) @@ -240,7 +235,7 @@ subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, units='degK') call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') @@ -271,7 +266,7 @@ subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 - end subroutine create_fldlists + end subroutine create_fldlists_dumb end module LilacMod diff --git a/lilac/scripts/Makefile b/lilac/scripts/Makefile index 8890dbdd9e..58d8b9b527 100644 --- a/lilac/scripts/Makefile +++ b/lilac/scripts/Makefile @@ -43,15 +43,16 @@ include $(ESMFMKFILE) # ----------------------------------------------------------------------------- -demo_driver: demo_driver.o DummyAtmos.o LilacMod.o +demo_driver: demo_driver.o DummyAtmos.o LilacMod.o lilac_utils.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) mv demo_driver demo_driver.exe rm *.o *.mod # module dependencies: -demo_driver.o: LilacMod.o DummyAtmos.o -DummyAtmos.o: LilacMod.o -LilacMod.o: +demo_driver.o: LilacMod.o DummyAtmos.o lilac_utils.o +LilacMod.o: DummyAtmos.o lilac_utils.o +DummyAtmos.o: lilac_utils.o +lilac_utils.o: # ----------------------------------------------------------------------------- # ----------------------------------------------------------------------------- .PHONY: dust clean distclean berzerk diff --git a/lilac/scripts/lilac_utils.f90 b/lilac/scripts/lilac_utils.f90 index 1c45b8caf5..37200f1124 100644 --- a/lilac/scripts/lilac_utils.f90 +++ b/lilac/scripts/lilac_utils.f90 @@ -1,122 +1,139 @@ module lilac_utils +use ESMF +implicit none !!! NS: THIS IS JH WORK - integer, parameter :: fldsMax = 100 - - - type fld_list_type - character(len=128) :: stdname - real*8 :: default_value - character(len=128) :: units - end type fld_list_type - - subroutine fldlist_add(num, fldlist, stdname, default_value, units) - integer intent(inout) :: num - type(fld_list_type) intent(inout) :: fldlist(:) - character(len=*) intent(in) :: stdname - real, optional intent(in) :: default_value - character(len=*), optional intent(in) :: units - - ! local variables - integer :: rc - character(len=*), parameter :: subname='(fldlist_add)' - !------------------------------------------------------------------------------- - - ! Set up a list of field information - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) return - endif - fldlist(num)%stdname = trim(stdname) - if(present(default_value)) then - fldlist(num)%default_value = default_value - else - fldlist(num)%default_value = 0. - end if - if(present(units)) then - fldlist(num)%units = trim(units) - else - fldlist(num)%units = "" - end if - - end subroutine fldlist_add - - subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) - type(fld_list_type) intent(inout) :: fldsFrCpl(:) - type(fld_list_type) intent(inout) :: fldsToCpl(:) - integer, intent(out) :: fldsToCpl_num = 0 - integer, intent(out) :: fldsFrCpl_num = 0 - - ! import fields - ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) - - integer :: fldsFrCpl_num, fldsToCpl_num - - ! land states - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) - - ! fluxes to atm - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) - - ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) - - ! from atm - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) - - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) - - ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 - end subroutine create_fldlists + integer, parameter :: fldsMax = 100 + + public fldlist_add , create_fldlists + + type fld_list_type + character(len=128) :: stdname + real*8 :: default_value + character(len=128) :: units + real*8, pointer :: datafld1d(:) ! this will be filled in by lilac when it gets its data from the host atm + end type fld_list_type + +!=============================================================================== + contains +!=============================================================================== + + subroutine fldlist_add(num, fldlist, stdname, default_value, units) + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + real, optional, intent(in) :: default_value + character(len=*), optional, intent(in) :: units + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(fldlist_add)' + !------------------------------------------------------------------------------- + + ! Set up a list of field information + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) + endif + + fldlist(num)%stdname = trim(stdname) + + if(present(default_value)) then + fldlist(num)%default_value = default_value + else + fldlist(num)%default_value = 0. + end if + if(present(units)) then + fldlist(num)%units = trim(units) + else + fldlist(num)%units = "" + end if + + end subroutine fldlist_add + + subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) + type(fld_list_type), intent(inout) :: fldsFrCpl(:) + type(fld_list_type), intent(inout) :: fldsToCpl(:) + !integer, intent(out) :: fldsToCpl_num = 0 + !integer, intent(out) :: fldsFrCpl_num = 0 + + ! import fields + ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) + + integer :: fldsFrCpl_num, fldsToCpl_num + + + !!! First from atmosphere to land fields + + !call fldlist_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) + + ! from atm + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, units= 'degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) + + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) + + ! land states + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'dum1', default_value=0.0 , units='degk') + + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) + + ! fluxes to atm + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) + + + + ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 + end subroutine create_fldlists end module lilac_utils From 75c0da25fcd4e58886207a0931124f8c11705032 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 16 Apr 2019 14:57:26 -0600 Subject: [PATCH 061/556] adding .gitignore to make my job easier! --- lilac/scripts/.gitignore | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 lilac/scripts/.gitignore diff --git a/lilac/scripts/.gitignore b/lilac/scripts/.gitignore new file mode 100644 index 0000000000..d52decad68 --- /dev/null +++ b/lilac/scripts/.gitignore @@ -0,0 +1,5 @@ +*.o +job_name* +PET* +*.exe +batch.sub From 011ff08494b282fb196f8b409184420a40bac487 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Apr 2019 12:48:54 -0600 Subject: [PATCH 062/556] Initialization without error working --- but it is not correct! -- compiles +runs (but wrong) . --- lilac/scripts/DummyAtmos.F90 | 51 ++++++++++++++++++++++++----------- lilac/scripts/LilacMod.F90 | 3 ++- lilac/scripts/demo_driver.F90 | 2 +- 3 files changed, 39 insertions(+), 17 deletions(-) diff --git a/lilac/scripts/DummyAtmos.F90 b/lilac/scripts/DummyAtmos.F90 index 419d716b7d..8a2f05b8d4 100644 --- a/lilac/scripts/DummyAtmos.F90 +++ b/lilac/scripts/DummyAtmos.F90 @@ -12,6 +12,7 @@ module DummyAtmos integer :: flds_x2a_num = 0 integer :: flds_a2x_num = 0 + type(fld_list_type), allocatable :: x2a_fields(:) type(fld_list_type), allocatable :: a2x_fields(:) @@ -19,6 +20,15 @@ module DummyAtmos character(*), parameter :: modname = "(core)" public atmos_register + !public :: add_fields + !public :: import_fields + !public :: export_fields + + + + + !!! Adding import export states stuff here.... + contains @@ -45,7 +55,9 @@ subroutine atmos_register(comp, rc) end subroutine atmos_register - subroutine atmos_init(comp, importState, exportState, clock, rc) + subroutine atmos_init(comp, importState, exportState, clock, rc) + !, dum_var1, dum_var2) + type (ESMF_GridComp) :: comp type (ESMF_State) :: importState, exportState type (ESMF_Clock) :: clock @@ -66,7 +78,14 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) type(ESMF_Mesh) :: Emesh character(len=ESMF_MAXSTR) :: atmos_mesh_filepath - + + real, pointer :: dum_var1_ptr (:) + real, pointer :: dum_var2_ptr (:) + real, dimension(10) :: dum_var1 + real, dimension(10) :: dum_var2 + + + ! Initialize return code rc = ESMF_SUCCESS @@ -83,6 +102,15 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) print *, "!Mesh for atmosphere is created!" + !------------------------------------------------------------------------- + ! Create States -- x2a_state (import) -- a2x_state (export) + !------------------------------------------------------------------------- + + EMesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) + print *, "!Mesh for atmosphere is created!" + !------------------------------------------------------------------------- ! Create States -- x2a_state (import) -- a2x_state (export) !------------------------------------------------------------------------- @@ -103,17 +131,18 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create individual states and add to field bundle - fldsFrCpl_num = 1 + fldsFrCpl_num = 0 !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'dummy_var_1', default_value=0.0, units='m') !call fldlist_add - call fldlist_add(fldsToCpl_num, fldsFrCpl, 'Sa_u', default_value=0.0,units='m/s') + !`call fldlist_add(fldsToCpl_num, fldsFrCpl, 'Sa_u', default_value=0.0,units='m/s') do n = 1,fldsFrCpl_num ! create field !!! Here we want to pass pointers - !!! + !!! Create With pointer ? or fieldcreate and then fieldget + field = ESMF_FieldCreate(Emesh,farrayPtr=dum_var1_ptr, meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) !field = ESMF_FieldCreate(lmesh,farrayPtr=x2a_fields%fields(:, n), meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) print *, trim(fldsFrCpl(n)%stdname) - field = ESMF_FieldCreate(EMesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(EMesh, farrayPtr , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! add field to field bundle call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) @@ -131,7 +160,7 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) ! Create individual states and add to field bundle fldsToCpl_num = 1 - call fldlist_add(fldsToCpl_num, fldsToCpl, 'dummy_var2' ) + call fldlist_add(fldsToCpl_num, fldsToCpl, 'dum_var2' ) do n = 1,fldsToCpl_num ! create field !field = ESMF_FieldCreate(lmesh, farrayPtr=a2x_field%fields(:,n) , meshloc=ESMF_MESHLOC_ELEMENT, name=trim(fldsToCpl(n)%stdname), rc=rc) @@ -140,15 +169,7 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) ! initialize with default value !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !fldptr = fldsToCpl(n)%default_value - - ! add field to field bundle - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out enddo - print *, "!Fields to Coupler (fldstoCpl) Field Bundle Created!" - - ! Add FB to state call ESMF_StateAdd(a2x_state, (/FBout/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "!a2x_state is filld with dummy_var field bundle!" diff --git a/lilac/scripts/LilacMod.F90 b/lilac/scripts/LilacMod.F90 index feb896860b..5d40f7654f 100644 --- a/lilac/scripts/LilacMod.F90 +++ b/lilac/scripts/LilacMod.F90 @@ -91,6 +91,7 @@ subroutine lilac_init( dum_var1, dum_var2) call ESMF_GridCompInitialize(dummy_atmos_comp, & importState=importState, exportState=exportState, & clock=clock, rc=rc) + !, dum_var1= dum_var1, dum_var2= dum_var2) !call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -120,7 +121,7 @@ subroutine lilac_run(dum_var_input, dum_var_output) !search through fldlist array to find the right fldist object to do the copy - say its index N - x2a_fields(n)%datafld1d(:) = dum_var_input(:) + !x2a_fields(n)%datafld1d(:) = dum_var_input(:) !call ESMF_CplCompRun(cpl_atm2lnd, rc=rc) diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index bd1bb2d34d..7e042ddc0d 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -19,7 +19,7 @@ program demo_lilac_driver print *, "dum_var1 = ", dum_var1 print *, "dum_var2 = ", dum_var2 call lilac_init(dum_var1, dum_var2) - call lilac_run(dum_var1, dum_var2) + !call lilac_run(dum_var1, dum_var2) call ESMF_Finalize() From 822eea309a11e48b917d26e77dfef4b6db871925 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Apr 2019 15:02:02 -0600 Subject: [PATCH 063/556] Adding coupler modules..... --- lilac/scripts/DummyAtmos.F90 | 23 +++- lilac/scripts/LilacMod.F90 | 234 ++++++++++++---------------------- lilac/scripts/cpl_mod.F90 | 45 +++++++ lilac/scripts/demo_driver.F90 | 17 ++- 4 files changed, 158 insertions(+), 161 deletions(-) create mode 100644 lilac/scripts/cpl_mod.F90 diff --git a/lilac/scripts/DummyAtmos.F90 b/lilac/scripts/DummyAtmos.F90 index 8a2f05b8d4..c2ad54862f 100644 --- a/lilac/scripts/DummyAtmos.F90 +++ b/lilac/scripts/DummyAtmos.F90 @@ -64,6 +64,7 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) integer, intent(out) :: rc !!! TODO: Maybe it is better to call these fldsToAtm and fldsFrAtm + type (fld_list_type) :: fldsToCpl(fldsMax) type (fld_list_type) :: fldsFrCpl(fldsMax) integer :: fldsToCpl_num @@ -121,6 +122,20 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) print *, "!empty x2a_state (import) is created!" print *, "!empty a2x_state (export) is created!" + !------------------------------------------------------------------------- + ! Create Field lists -- Basically create a list of fields and add a default + ! value to them. + !------------------------------------------------------------------------- + + !!! FOR NOW LET'S JUST ADD TWO THINGS.... + !!! WE WILL PUT THIS UNDER CREATE_FLDLIST LATER + fldsFrCpl_num = 1 + fldsToCpl_num = 2 + + call fldlist_add(fldsToCpl_num, fldsToCpl, 'dum_var1', default_value=30.0, units='m') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'dum_var2', default_value=30.0, units='m') + + !------------------------------------------------------------------------- ! Coupler (land) to Atmosphere Fields -- x2a ! I- Create Field Bundle -- FBout for now-- TODO: negin want to rename to x2a_fieldbundle @@ -130,11 +145,14 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + + !!! THIS IS INIT! We don't Have anything from coupler + ! Create individual states and add to field bundle fldsFrCpl_num = 0 !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'dummy_var_1', default_value=0.0, units='m') - !call fldlist_add - !`call fldlist_add(fldsToCpl_num, fldsFrCpl, 'Sa_u', default_value=0.0,units='m/s') do n = 1,fldsFrCpl_num ! create field !!! Here we want to pass pointers @@ -225,6 +243,7 @@ subroutine atmos_final(comp, importState, exportState, clock, rc) end subroutine atmos_final !=============================================================================== + ! Let's put this in a lilac_utils !subroutine fldlist_add(num, fldlist, stdname) ! integer, intent(inout) :: num ! type(fld_list_type), intent(inout) :: fldlist(:) diff --git a/lilac/scripts/LilacMod.F90 b/lilac/scripts/LilacMod.F90 index 5d40f7654f..b7f7ba1610 100644 --- a/lilac/scripts/LilacMod.F90 +++ b/lilac/scripts/LilacMod.F90 @@ -6,6 +6,11 @@ module LilacMod use DummyAtmos, only : x2a_fields use DummyAtmos, only : a2x_fields use DummyAtmos, only : atmos_register + +use cpl_mod + + + implicit none ! Clock, TimeInterval, and Times @@ -21,7 +26,8 @@ module LilacMod !=============================================================================== - !public :: lilac_init + public :: lilac_init + public :: lilac_run contains subroutine lilac_init( dum_var1, dum_var2) @@ -32,16 +38,22 @@ subroutine lilac_init( dum_var1, dum_var2) real, dimension(10) :: dum_var2 ! Component, and State - type(ESMF_GridComp) :: dummy_atmos_comp ! the coupled flow Component - type(ESMF_State) :: coupledFlowState ! the coupled flow State - type(ESMF_Mesh) :: Emesh + type(ESMF_GridComp) :: dummy_atmos_comp + type(ESMF_GridComp) :: dummy_land_comp + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp + + + type(ESMF_State) :: coupledFlowState ! the coupled flow State + type(ESMF_Mesh) :: Emesh character(len=*), parameter :: subname=trim(modname)//':(lilac_init) ' - type(ESMF_State) :: importState, exportState - !character(len=*) :: atm_mesh_filepath + type(ESMF_State) :: importState, exportState + !character(len=*) :: atm_mesh_filepath ! local variables - integer :: rc, urc - character(len=ESMF_MAXSTR) :: cname1, cname2, cplname + integer :: rc, urc + character(len=ESMF_MAXSTR) :: cname1, cname2, cname3, cname4 + !integer, parameter :: fldsMax = 100 !------------------------------------------------------------------------- ! Initialize ESMF, set the default calendar and log type. @@ -53,23 +65,75 @@ subroutine lilac_init( dum_var1, dum_var2) print *, "lilac Demo Application Start" !------------------------------------------------------------------------- - ! Create Gridded Component! + ! Create Gridded Component! --- dummy atmosphere !------------------------------------------------------------------------- cname1 = "Dummy Atmosphere" - - ! Create dummy atmosphere gridded component. + dummy_atmos_comp = ESMF_GridCompCreate(name=cname1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Created "//trim(cname1)//" component", ESMF_LOGMSG_INFO) print *, "Dummy Atmosphere Gridded Component Created!" !------------------------------------------------------------------------- - ! Register section -- set services + ! Create Gridded Component! --- Coupler from atmosphere to land + !------------------------------------------------------------------------- + cname2 = "Coupler from atmosphere to land" + cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) + print *, "1st Coupler Gridded Component (atmosphere to land ) Created!" + + !------------------------------------------------------------------------- + ! Create Gridded Component! --- dummy land (land cap) + !------------------------------------------------------------------------- + cname3 = "Dummy Land" + + dummy_land_comp = ESMF_GridCompCreate(name=cname3, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(cname3)//" component", ESMF_LOGMSG_INFO) + print *, "Dummy Land Gridded Component Created!" + + !------------------------------------------------------------------------- + ! Create Gridded Component! -- Coupler from land to atmos + !------------------------------------------------------------------------- + cname4 = "Coupler from land to atmosphere" + cpl_lnd2atm_comp = ESMF_CplCompCreate(name=cname4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(cname4)//" component", ESMF_LOGMSG_INFO) + print *, "2nd Coupler Gridded Component (land to atmosphere) Created!" + + + ! ======================================================================== + !------------------------------------------------------------------------- + ! Register section -- set services -- dummy atmosphere !------------------------------------------------------------------------- call ESMF_GridCompSetServices(dummy_atmos_comp, userRoutine=atmos_register, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"dummy atmos SetServices finished!", ESMF_LOGMSG_INFO) print *, "Dummy Atmosphere Gridded Component SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- coupler atmosphere to land + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=atmos_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Coupler from atmosphere to land SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- dummy land + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(dummy_land_comp, userRoutine=atmos_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"dummy land SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Dummy Land Gridded Component SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- coupler land to atmosphere + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=atmos_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Coupler from land to atmosphere SetServices finished!" + + ! ======================================================================== !------------------------------------------------------------------------- ! Create and initialize a clock! @@ -99,17 +163,17 @@ subroutine lilac_init( dum_var1, dum_var2) end subroutine lilac_init - subroutine lilac_run(dum_var_input, dum_var_output) + subroutine lilac_run(dum_var1, dum_var2) use DummyAtmos, only : x2a_fields use DummyAtmos, only : a2x_fields - real, dimension(:) :: dum_var_input ! from host atm - real, dimension(:) :: dum_var_output ! to host atm + real, dimension(:) :: dum_var1 ! from host atm + real, dimension(:) :: dum_var2 ! to host atm integer :: n, num - integer, parameter :: fldsMax = 100 + !integer, parameter :: fldsMax = 100 integer :: fldsToLnd_num = 0 integer :: fldsFrLnd_num = 0 @@ -129,145 +193,9 @@ subroutine lilac_run(dum_var_input, dum_var_output) !call ESMF_CplCompRun(cpl_lnd2atm, rc=rc) - dum_var_output(:) = a2x_fields(N)%datafld1d(:) + !dum_var_output(:) = a2x_fields(N)%datafld1d(:) end subroutine lilac_run - - - - - !subroutine fldlist_add(num, fldlist, stdname, default_value, units) - ! integer, intent(inout) :: num - ! type(fld_list_type), intent(inout) :: fldlist(:) - ! character(len=*), intent(in) :: stdname - ! real, optional, intent(in) :: default_value - ! character(len=*), optional, intent(in) :: units - - ! local variables - ! integer :: rc - ! character(len=*), parameter :: subname='(fldlist_add)' - !------------------------------------------------------------------------------- - - ! Set up a list of field information - ! num = num + 1 - ! if (num > fldsMax) then - ! call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) return - ! endif - ! fldlist(num)%stdname = trim(stdname) - ! if(present(default_value)) then - ! fldlist(num)%default_value = default_value - ! else - ! fldlist(num)%default_value = 0. - ! end if - ! if(present(units)) then - ! fldlist(num)%units = trim(units) - ! else - ! fldlist(num)%units = "" - ! end if - - ! end subroutine fldlist_add - - -subroutine fldlist_add_dumb(num, fldlist, stdname) - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname - - ! local variables - integer :: rc - integer :: dbrc - character(len=*), parameter :: subname='(lnd_import_export:fldlist_add)' - !------------------------------------------------------------------------------- - - ! Set up a list of field information - - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - fldlist(num)%stdname = trim(stdname) - - end subroutine fldlist_add_dumb - subroutine create_fldlists_dumb(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) - type(fld_list_type), intent(inout) :: fldsFrCpl(:) - type(fld_list_type), intent(inout) :: fldsToCpl(:) - !integer, intent(out) :: fldsToCpl_num = 0 - !integer, intent(out) :: fldsFrCpl_num = 0 - - ! import fields - ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) - - integer :: fldsFrCpl_num, fldsToCpl_num - - ! land states - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) - - ! fluxes to atm - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) - - ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) - - ! from atm - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, units='degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) - - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) - - ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 - end subroutine create_fldlists_dumb - end module LilacMod diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 new file mode 100644 index 0000000000..dfae41aa44 --- /dev/null +++ b/lilac/scripts/cpl_mod.F90 @@ -0,0 +1,45 @@ +module cpl_mod + + + use ESMF + implicit none + + contains + + + + subroutine cpl_atm2lnd_register(cplcomp, rc) + type(ESMF_CplComp) :: cplcomp + integer, intent(inout) :: rc + + rc = ESMF_FAILURE + + ! Register the callback routines. + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_atm2lnd_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) + !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) + !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + + end subroutine + + + + + subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) + + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(inout) :: rc + + end subroutine + + + +end module cpl_mod + + diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 7e042ddc0d..7bfa405866 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -5,21 +5,26 @@ program demo_lilac_driver use LilacMod implicit none + real, dimension(10) :: dum_var1 - real, dimension(10) :: dum_var2 + real, dimension(10) :: dum_var2 - real, dimension(10) :: t_phy ! temperature (K) - real, dimension(10) :: th_phy ! potential temperature (K) + !real, dimension(10) :: t_phy ! temperature (K) + !real, dimension(10) :: th_phy ! potential temperature (K) !real, dimension(10,10) :: rho ! call random_number(dum_var1) call random_number(dum_var2) - call random_number(t_phy) - call random_number(th_phy) + + !call random_number(t_phy) + !call random_number(th_phy) + print *, "dum_var1 = ", dum_var1 print *, "dum_var2 = ", dum_var2 + call lilac_init(dum_var1, dum_var2) - !call lilac_run(dum_var1, dum_var2) + call lilac_run(dum_var1, dum_var2) + call ESMF_Finalize() From 9fd64152c6a2a12389d490351efe156b9241a46e Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Apr 2019 15:50:15 -0600 Subject: [PATCH 064/556] saving my stuff --- lilac/scripts/cpl_mod.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index dfae41aa44..e4c8579dd8 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -24,9 +24,7 @@ subroutine cpl_atm2lnd_register(cplcomp, rc) !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - end subroutine - - + end subroutine cpl_atm2lnd_register subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) @@ -36,7 +34,7 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(inout) :: rc - end subroutine + end subroutine cpl_atm2lnd_init From 47c74886fd1f1dd6e91db0c6f8c3a43d0bbf65a0 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Apr 2019 15:51:44 -0600 Subject: [PATCH 065/556] this is saving for the enxt step .... checkpoint --- lilac/scripts/Makefile | 7 ++++--- lilac/scripts/lilac_utils.f90 | 4 +++- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/lilac/scripts/Makefile b/lilac/scripts/Makefile index 58d8b9b527..9d02f57197 100644 --- a/lilac/scripts/Makefile +++ b/lilac/scripts/Makefile @@ -43,16 +43,17 @@ include $(ESMFMKFILE) # ----------------------------------------------------------------------------- -demo_driver: demo_driver.o DummyAtmos.o LilacMod.o lilac_utils.o +demo_driver: demo_driver.o DummyAtmos.o LilacMod.o lilac_utils.o cpl_mod.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) mv demo_driver demo_driver.exe rm *.o *.mod # module dependencies: -demo_driver.o: LilacMod.o DummyAtmos.o lilac_utils.o -LilacMod.o: DummyAtmos.o lilac_utils.o +demo_driver.o: LilacMod.o DummyAtmos.o lilac_utils.o cpl_mod.o +LilacMod.o: DummyAtmos.o lilac_utils.o cpl_mod.o DummyAtmos.o: lilac_utils.o lilac_utils.o: +cpl_mod.o: # ----------------------------------------------------------------------------- # ----------------------------------------------------------------------------- .PHONY: dust clean distclean berzerk diff --git a/lilac/scripts/lilac_utils.f90 b/lilac/scripts/lilac_utils.f90 index 37200f1124..fcf3f7b16f 100644 --- a/lilac/scripts/lilac_utils.f90 +++ b/lilac/scripts/lilac_utils.f90 @@ -1,7 +1,7 @@ module lilac_utils use ESMF implicit none -!!! NS: THIS IS JH WORK +!!! NS: THIS IS FROM JH WORK integer, parameter :: fldsMax = 100 @@ -19,6 +19,7 @@ module lilac_utils !=============================================================================== subroutine fldlist_add(num, fldlist, stdname, default_value, units) + ! This adds a field to a fieldlist! integer, intent(inout) :: num type(fld_list_type), intent(inout) :: fldlist(:) character(len=*), intent(in) :: stdname @@ -52,6 +53,7 @@ subroutine fldlist_add(num, fldlist, stdname, default_value, units) end subroutine fldlist_add subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) + ! add all the necessary fields one by one to the fieldlist type(fld_list_type), intent(inout) :: fldsFrCpl(:) type(fld_list_type), intent(inout) :: fldsToCpl(:) !integer, intent(out) :: fldsToCpl_num = 0 From 0ba773a10e57c272971b95d2fdabd30de2be5b6c Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Apr 2019 17:52:45 -0600 Subject: [PATCH 066/556] saving my work midway through... compiles.... --- lilac/scripts/atmos_cap.F90 | 240 ++++++++++++++++++++++++++++++++++++ lilac/scripts/cpl_mod.F90 | 32 +++-- lilac/scripts/lilac_mod.F90 | 201 ++++++++++++++++++++++++++++++ lilac/scripts/lnd_cap.F90 | 96 +++++++++++++++ 4 files changed, 559 insertions(+), 10 deletions(-) create mode 100644 lilac/scripts/atmos_cap.F90 create mode 100644 lilac/scripts/lilac_mod.F90 create mode 100644 lilac/scripts/lnd_cap.F90 diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 new file mode 100644 index 0000000000..227ffd34bb --- /dev/null +++ b/lilac/scripts/atmos_cap.F90 @@ -0,0 +1,240 @@ +module atmos_cap + + use ESMF + use lilac_utils + + + implicit none + + character(*), parameter :: modname = "(core)" + + !!integer, parameter :: fldsMax = 100 + + type(ESMF_Field), public, save :: field + type(ESMF_Field), public, save :: field_sie, field_u + + type(fld_list_type), allocatable :: x2a_fields(:) + type(fld_list_type), allocatable :: a2x_fields(:) + + !private + + public atmos_register + !public :: add_fields + !public :: import_fields + !public :: export_fields + + contains + + subroutine atmos_register(comp, rc) + + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc + character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' + + print *, "in user register routine" + + rc = ESMF_SUCCESS + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_atm_to_lilac, phase=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_lilac_to_atm, phase=2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + end subroutine atmos_register + + subroutine atmos_init(comp, importState, exportState, clock, rc) + type (ESMF_GridComp) :: comp + type (ESMF_State) :: importState, exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + !!! TODO: Maybe it is better to call these fldsToAtm and fldsFrAtm + + type (fld_list_type) :: fldsToCpl(fldsMax) + type (fld_list_type) :: fldsFrCpl(fldsMax) + ! TODO Probably we can have these at the top + integer :: fldsToCpl_num + integer :: fldsFrCpl_num + + character(len=*), parameter :: subname=trim(modname)//':(atmos_init) ' + + type (ESMF_State) :: x2a_state + type (ESMF_State) :: a2x_state + type (ESMF_FieldBundle) :: FBout + integer :: n + + type(ESMF_Mesh) :: atmos_mesh + character(len=ESMF_MAXSTR) :: atmos_mesh_filepath + + ! Initialize return code + + rc = ESMF_SUCCESS + + !------------------------------------------------------------------------- + ! Generate -- Read in the mesh + !------------------------------------------------------------------------- + + ! For now this is our dummy mesh: + atmos_mesh_filepath='/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + + atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) + print *, "!Mesh for atmosphere is created!" + + !------------------------------------------------------------------------- + ! Create States -- x2a_state (import) -- a2x_state (export) + !------------------------------------------------------------------------- + x2a_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + a2x_state = ESMF_StateCreate(name="a2x_state", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, "!empty x2a_state (import) is created!" + print *, "!empty a2x_state (export) is created!" + + !------------------------------------------------------------------------- + ! Create Field lists -- Basically create a list of fields and add a default + ! value to them. + !------------------------------------------------------------------------- + + call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) + + !!! FOR NOW LET'S JUST ADD TWO THINGS.... + !!! WE WILL PUT THIS UNDER CREATE_FLDLIST LATER + fldsFrCpl_num = 1 + fldsToCpl_num = 1 + + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'lnd2atmos_var', default_value=30.0, units='m') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=10.0, units='m') + + + !------------------------------------------------------------------------- + ! Coupler (land) to Atmosphere Fields -- x2a + ! I- Create Field Bundle -- FBout for now-- TODO: negin want to rename to x2a_fieldbundle + ! II- Create Fields and add them to field bundle + ! III - Add FBout to state (x2a_state) + !------------------------------------------------------------------------- + FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + + ! Create individual states and add to field bundle + do n = 1,fldsFrCpl_num + ! create field + !!! Here we want to pass pointers + !field = ESMF_FieldCreate(Emesh,farrayPtr=dum_var1_ptr, meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(lmesh,farrayPtr=x2a_fields%fields(:, n), meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) + print *, trim(fldsFrCpl(n)%stdname) + field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 ,meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, farrayPtr , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! add field to field bundle + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + enddo + print *, "!Fields For Coupler (fldsFrCpl) Field Bundle Created!" + + ! Add FB to state + call ESMF_StateAdd(x2a_state, (/FBout/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Atmosphere to Coupler Fields + FBout = ESMF_FieldBundleCreate(name="a2x_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + ! Create individual states and add to field bundle + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'dum_var2' ) + do n = 1,fldsToCpl_num + ! create field + !field = ESMF_FieldCreate(lmesh, farrayPtr=a2x_field%fields(:,n) , meshloc=ESMF_MESHLOC_ELEMENT, name=trim(fldsToCpl(n)%stdname), rc=rc) + field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsToCpl(n)%stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! initialize with default value + !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !fldptr = fldsToCpl(n)%default_value + + ! add field to field bundle + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + enddo + + + print *, "!Fields to Coupler (fldstoCpl) Field Bundle Created!" + + ! Add FB to state + call ESMF_StateAdd(a2x_state, (/FBout/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, "!a2x_state is filld with dummy_var field bundle!" + + end subroutine atmos_init + + subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_atm_to_lilac) ' + + ! Initialize return code + rc = ESMF_SUCCESS +! get a list of fields of variables we need from atmos.... +! + !call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) + + ! loop over fields, copying pointer from import to export state + + end subroutine atmos_copy_atm_to_lilac + + subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_lilac_to_atm) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) + + end subroutine atmos_copy_lilac_to_atm + + subroutine atmos_final(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_final) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"atmos_final has not been implemented yet", ESMF_LOGMSG_INFO) + + end subroutine atmos_final + !=============================================================================== + + + + + +end module atmos_cap diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index e4c8579dd8..f276267b12 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -1,38 +1,50 @@ module cpl_mod - use ESMF implicit none - contains - + public cpl_atm2lnd_register +contains subroutine cpl_atm2lnd_register(cplcomp, rc) type(ESMF_CplComp) :: cplcomp - integer, intent(inout) :: rc + integer, intent(out) :: rc rc = ESMF_FAILURE ! Register the callback routines. - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_atm2lnd_init, rc=rc) + !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_atm2lnd_init, rc=rc) + !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_atm2lnd_init ,rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, my_init, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end subroutine cpl_atm2lnd_register + subroutine my_init(cplcomp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc - end subroutine cpl_atm2lnd_register + print *, "CPLR initialize routine called" + rc = ESMF_SUCCESS + end subroutine my_init subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(inout) :: rc - type(ESMF_CplComp) :: cplcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(inout) :: rc + print *, "Coupler Init starting" + rc = ESMF_SUCCESS end subroutine cpl_atm2lnd_init diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 new file mode 100644 index 0000000000..4bc2be9423 --- /dev/null +++ b/lilac/scripts/lilac_mod.F90 @@ -0,0 +1,201 @@ +!Khoda +module LilacMod +use ESMF +use lilac_utils +!use DummyAtmos +use atmos_cap, only : x2a_fields +use atmos_cap, only : a2x_fields +use atmos_cap, only : atmos_register + +use cpl_mod + + + +implicit none + + ! Clock, TimeInterval, and Times + type(ESMF_Clock) :: clock + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_Time) :: stopTime + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar),target :: calendar + integer :: yy,mm,dd,sec + + character(*), parameter :: modname = "(LilacMod)" + + !=============================================================================== + + public :: lilac_init + public :: lilac_run + contains + + subroutine lilac_init( dum_var1, dum_var2) + ! modules + implicit none + + real, dimension(10) :: dum_var1 + real, dimension(10) :: dum_var2 + + ! Component, and State + type(ESMF_GridComp) :: dummy_atmos_comp + type(ESMF_GridComp) :: dummy_land_comp + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp + + + type(ESMF_State) :: coupledFlowState ! the coupled flow State + type(ESMF_Mesh) :: Emesh + character(len=*), parameter :: subname=trim(modname)//':(lilac_init) ' + type(ESMF_State) :: importState, exportState + !character(len=*) :: atm_mesh_filepath + + ! local variables + integer :: rc, urc + character(len=ESMF_MAXSTR) :: cname1, cname2, cname3, cname4 + !integer, parameter :: fldsMax = 100 + + !------------------------------------------------------------------------- + ! Initialize ESMF, set the default calendar and log type. + !------------------------------------------------------------------------- + call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + print *, "----------------------------" + print *, "lilac Demo Application Start" + + !------------------------------------------------------------------------- + ! Create Gridded Component! --- dummy atmosphere + !------------------------------------------------------------------------- + cname1 = "Dummy Atmosphere" + + dummy_atmos_comp = ESMF_GridCompCreate(name=cname1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(cname1)//" component", ESMF_LOGMSG_INFO) + print *, "Dummy Atmosphere Gridded Component Created!" + + !------------------------------------------------------------------------- + ! Create Gridded Component! --- Coupler from atmosphere to land + !------------------------------------------------------------------------- + cname2 = "Coupler from atmosphere to land" + cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) + print *, "1st Coupler Gridded Component (atmosphere to land ) Created!" + + !------------------------------------------------------------------------- + ! Create Gridded Component! --- dummy land (land cap) + !------------------------------------------------------------------------- + cname3 = "Dummy Land" + + dummy_land_comp = ESMF_GridCompCreate(name=cname3, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(cname3)//" component", ESMF_LOGMSG_INFO) + print *, "Dummy Land Gridded Component Created!" + + !------------------------------------------------------------------------- + ! Create Gridded Component! -- Coupler from land to atmos + !------------------------------------------------------------------------- + cname4 = "Coupler from land to atmosphere" + cpl_lnd2atm_comp = ESMF_CplCompCreate(name=cname4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(cname4)//" component", ESMF_LOGMSG_INFO) + print *, "2nd Coupler Gridded Component (land to atmosphere) Created!" + + + ! ======================================================================== + !------------------------------------------------------------------------- + ! Register section -- set services -- dummy atmosphere + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(dummy_atmos_comp, userRoutine=atmos_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"dummy atmos SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Dummy Atmosphere Gridded Component SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- coupler atmosphere to land + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Coupler from atmosphere to land SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- dummy land + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(dummy_land_comp, userRoutine=lnd_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Land Gridded Component SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- coupler land to atmosphere + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_atm2lnd_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Coupler from land to atmosphere SetServices finished!" + + ! ======================================================================== + + !------------------------------------------------------------------------- + ! Create and initialize a clock! + ! ????? Should I create a clock here or in driver? + !------------------------------------------------------------------------- + calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) + + !print *, + !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) + !EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) + + !------------------------------------------------------------------------- + ! Atmosphere Initialization.... + !------------------------------------------------------------------------- + call ESMF_GridCompInitialize(dummy_atmos_comp, & + importState=importState, exportState=exportState, & + clock=clock, rc=rc) + !, dum_var1= dum_var1, dum_var2= dum_var2) + !call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + + end subroutine lilac_init + + subroutine lilac_run(dum_var1, dum_var2) + + use atmos_cap, only : x2a_fields + use atmos_cap, only : a2x_fields + + real, dimension(:) :: dum_var1 ! from host atm + real, dimension(:) :: dum_var2 ! to host atm + + integer :: n, num + + !integer, parameter :: fldsMax = 100 + integer :: fldsToLnd_num = 0 + integer :: fldsFrLnd_num = 0 + + type (fld_list_type) :: fldsToLnd(fldsMax) + type (fld_list_type) :: fldsFrLnd(fldsMax) + !----------------------------------------- + !----------------------------------------- + type(ESMF_State) :: importState, exportState + + !search through fldlist array to find the right fldist object to do the copy - say its index N + + !x2a_fields(n)%datafld1d(:) = dum_var_input(:) + + !call ESMF_CplCompRun(cpl_atm2lnd, rc=rc) + + !call ESMF_GridCompRun(lndcomp, rc=rc) + + !call ESMF_CplCompRun(cpl_lnd2atm, rc=rc) + + !dum_var_output(:) = a2x_fields(N)%datafld1d(:) + + end subroutine lilac_run + +end module LilacMod + diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 new file mode 100644 index 0000000000..b7157eb9ec --- /dev/null +++ b/lilac/scripts/lnd_cap.F90 @@ -0,0 +1,96 @@ +module lnd_cap + use ESMF + use lilac_utils + + implicit none + + character(*), parameter :: modname = "(core)" + + !!integer, parameter :: fldsMax = 100 + + type(ESMF_Field), public, save :: field + type(ESMF_Field), public, save :: field_sie, field_u + + type(fld_list_type), allocatable :: x2a_fields(:) + type(fld_list_type), allocatable :: a2x_fields(:) + + !private + + public lnd_register + !public :: add_fields + !public :: import_fields + !public :: export_fields + + contains + + subroutine lnd_register(comp, rc) + + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc + character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' + + print *, "in user register routine" + + rc = ESMF_SUCCESS + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=lnd_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=lnd_run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=lnd_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + end subroutine atmos_register + + subroutine lnd_init(comp, importState, exportState, clock, rc) + type (ESMF_GridComp) :: comp + type (ESMF_State) :: importState, exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + print *, " Empty land is created !!!!" + rc = ESMF_SUCCESS + !------------------------------------------------------------------------- + ! Generate -- Read in the mesh + !------------------------------------------------------------------------- + end subroutine lnd_init + + + subroutine lnd_run(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_lilac_to_atm) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) + + end subroutine lnd_run + + subroutine lnd_final(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(lnd_final) ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"lnd_final is called but has not been implemented yet", ESMF_LOGMSG_INFO) + + end subroutine lnd_final + !=============================================================================== + + + + + +end module lnd_cap From 0f169cb408ca3b65d17515091b96edeff7e07c2f Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Apr 2019 17:54:47 -0600 Subject: [PATCH 067/556] file names changed. Make file also changed and working. --- lilac/scripts/DummyAtmos.F90 | 273 ------------------ lilac/scripts/LilacMod.F90 | 201 ------------- lilac/scripts/Makefile | 8 +- .../{lilac_utils.f90 => lilac_utils.F90} | 35 +-- 4 files changed, 22 insertions(+), 495 deletions(-) delete mode 100644 lilac/scripts/DummyAtmos.F90 delete mode 100644 lilac/scripts/LilacMod.F90 rename lilac/scripts/{lilac_utils.f90 => lilac_utils.F90} (75%) diff --git a/lilac/scripts/DummyAtmos.F90 b/lilac/scripts/DummyAtmos.F90 deleted file mode 100644 index c2ad54862f..0000000000 --- a/lilac/scripts/DummyAtmos.F90 +++ /dev/null @@ -1,273 +0,0 @@ -module DummyAtmos - use ESMF - use lilac_utils, only: fldlist_add, fld_list_type, fldsMax - - - implicit none - - - type(ESMF_Field), public, save :: field - type(ESMF_Field), public, save :: field_sie, field_u - - integer :: flds_x2a_num = 0 - integer :: flds_a2x_num = 0 - - - type(fld_list_type), allocatable :: x2a_fields(:) - type(fld_list_type), allocatable :: a2x_fields(:) - - !private - character(*), parameter :: modname = "(core)" - - public atmos_register - !public :: add_fields - !public :: import_fields - !public :: export_fields - - - - - !!! Adding import export states stuff here.... - - - contains - - subroutine atmos_register(comp, rc) - type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' - - print *, "in user register routine" - - rc = ESMF_SUCCESS - ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_atm_to_lilac, phase=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_lilac_to_atm, phase=2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - end subroutine atmos_register - - subroutine atmos_init(comp, importState, exportState, clock, rc) - !, dum_var1, dum_var2) - - type (ESMF_GridComp) :: comp - type (ESMF_State) :: importState, exportState - type (ESMF_Clock) :: clock - integer, intent(out) :: rc - - !!! TODO: Maybe it is better to call these fldsToAtm and fldsFrAtm - - type (fld_list_type) :: fldsToCpl(fldsMax) - type (fld_list_type) :: fldsFrCpl(fldsMax) - integer :: fldsToCpl_num - integer :: fldsFrCpl_num - - character(len=*), parameter :: subname=trim(modname)//':(atmos_init) ' - - type (ESMF_State) :: x2a_state ! the coupled flow State - type (ESMF_State) :: a2x_state ! the coupled flow State - type (ESMF_FieldBundle) :: FBout - integer :: n - - type(ESMF_Mesh) :: Emesh - character(len=ESMF_MAXSTR) :: atmos_mesh_filepath - - real, pointer :: dum_var1_ptr (:) - real, pointer :: dum_var2_ptr (:) - real, dimension(10) :: dum_var1 - real, dimension(10) :: dum_var2 - - - - ! Initialize return code - - rc = ESMF_SUCCESS - - !------------------------------------------------------------------------- - ! Generate -- Read in the mesh - !------------------------------------------------------------------------- - - ! For now this is our dummy mesh: - atmos_mesh_filepath='/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' - - EMesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) - print *, "!Mesh for atmosphere is created!" - - !------------------------------------------------------------------------- - ! Create States -- x2a_state (import) -- a2x_state (export) - !------------------------------------------------------------------------- - - EMesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) - print *, "!Mesh for atmosphere is created!" - - !------------------------------------------------------------------------- - ! Create States -- x2a_state (import) -- a2x_state (export) - !------------------------------------------------------------------------- - x2a_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - a2x_state = ESMF_StateCreate(name="a2x_state", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!empty x2a_state (import) is created!" - print *, "!empty a2x_state (export) is created!" - - !------------------------------------------------------------------------- - ! Create Field lists -- Basically create a list of fields and add a default - ! value to them. - !------------------------------------------------------------------------- - - !!! FOR NOW LET'S JUST ADD TWO THINGS.... - !!! WE WILL PUT THIS UNDER CREATE_FLDLIST LATER - fldsFrCpl_num = 1 - fldsToCpl_num = 2 - - call fldlist_add(fldsToCpl_num, fldsToCpl, 'dum_var1', default_value=30.0, units='m') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'dum_var2', default_value=30.0, units='m') - - - !------------------------------------------------------------------------- - ! Coupler (land) to Atmosphere Fields -- x2a - ! I- Create Field Bundle -- FBout for now-- TODO: negin want to rename to x2a_fieldbundle - ! II- Create Fields and add them to field bundle - ! III - Add FBout to state (x2a_state) - !------------------------------------------------------------------------- - FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - - - - !!! THIS IS INIT! We don't Have anything from coupler - - ! Create individual states and add to field bundle - fldsFrCpl_num = 0 - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'dummy_var_1', default_value=0.0, units='m') - do n = 1,fldsFrCpl_num - ! create field - !!! Here we want to pass pointers - !!! Create With pointer ? or fieldcreate and then fieldget - field = ESMF_FieldCreate(Emesh,farrayPtr=dum_var1_ptr, meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(lmesh,farrayPtr=x2a_fields%fields(:, n), meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) - print *, trim(fldsFrCpl(n)%stdname) - !field = ESMF_FieldCreate(EMesh, farrayPtr , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! add field to field bundle - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - enddo - print *, "!Fields For Coupler (fldsFrCpl) Field Bundle Created!" - - ! Add FB to state - call ESMF_StateAdd(x2a_state, (/FBout/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Atmosphere to Coupler Fields - FBout = ESMF_FieldBundleCreate(name="a2x_fields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Create individual states and add to field bundle - fldsToCpl_num = 1 - call fldlist_add(fldsToCpl_num, fldsToCpl, 'dum_var2' ) - do n = 1,fldsToCpl_num - ! create field - !field = ESMF_FieldCreate(lmesh, farrayPtr=a2x_field%fields(:,n) , meshloc=ESMF_MESHLOC_ELEMENT, name=trim(fldsToCpl(n)%stdname), rc=rc) - field = ESMF_FieldCreate(EMesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsToCpl(n)%stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! initialize with default value - !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - enddo - call ESMF_StateAdd(a2x_state, (/FBout/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!a2x_state is filld with dummy_var field bundle!" - - end subroutine atmos_init - - subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_atm_to_lilac) ' - - ! Initialize return code - rc = ESMF_SUCCESS -! get a list of fields of variables we need from atmos.... -! - !call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) - - ! loop over fields, copying pointer from import to export state - - end subroutine atmos_copy_atm_to_lilac - - subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_lilac_to_atm) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine atmos_copy_lilac_to_atm - - subroutine atmos_final(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_final) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"atmos_final has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine atmos_final - !=============================================================================== - - ! Let's put this in a lilac_utils - !subroutine fldlist_add(num, fldlist, stdname) - ! integer, intent(inout) :: num - ! type(fld_list_type), intent(inout) :: fldlist(:) - ! character(len=*), intent(in) :: stdname - - ! local variables - ! integer :: rc - ! integer :: dbrc - ! character(len=*), parameter :: subname='(lnd_import_export:fldlist_add)' - !------------------------------------------------------------------------------- - - ! Set up a list of field information - - ! num = num + 1 - ! if (num > fldsMax) then - ! call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & - ! ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - ! return - ! endif - ! fldlist(num)%stdname = trim(stdname) - - !end subroutine fldlist_add - - - - -end module DummyAtmos diff --git a/lilac/scripts/LilacMod.F90 b/lilac/scripts/LilacMod.F90 deleted file mode 100644 index b7f7ba1610..0000000000 --- a/lilac/scripts/LilacMod.F90 +++ /dev/null @@ -1,201 +0,0 @@ -!Khoda -module LilacMod -use ESMF -use lilac_utils -!use DummyAtmos -use DummyAtmos, only : x2a_fields -use DummyAtmos, only : a2x_fields -use DummyAtmos, only : atmos_register - -use cpl_mod - - - -implicit none - - ! Clock, TimeInterval, and Times - type(ESMF_Clock) :: clock - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime - type(ESMF_Time) :: stopTime - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar),target :: calendar - integer :: yy,mm,dd,sec - - character(*), parameter :: modname = "(LilacMod)" - - !=============================================================================== - - public :: lilac_init - public :: lilac_run - contains - - subroutine lilac_init( dum_var1, dum_var2) - ! modules - implicit none - - real, dimension(10) :: dum_var1 - real, dimension(10) :: dum_var2 - - ! Component, and State - type(ESMF_GridComp) :: dummy_atmos_comp - type(ESMF_GridComp) :: dummy_land_comp - type(ESMF_CplComp) :: cpl_atm2lnd_comp - type(ESMF_CplComp) :: cpl_lnd2atm_comp - - - type(ESMF_State) :: coupledFlowState ! the coupled flow State - type(ESMF_Mesh) :: Emesh - character(len=*), parameter :: subname=trim(modname)//':(lilac_init) ' - type(ESMF_State) :: importState, exportState - !character(len=*) :: atm_mesh_filepath - - ! local variables - integer :: rc, urc - character(len=ESMF_MAXSTR) :: cname1, cname2, cname3, cname4 - !integer, parameter :: fldsMax = 100 - - !------------------------------------------------------------------------- - ! Initialize ESMF, set the default calendar and log type. - !------------------------------------------------------------------------- - call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - print *, "----------------------------" - print *, "lilac Demo Application Start" - - !------------------------------------------------------------------------- - ! Create Gridded Component! --- dummy atmosphere - !------------------------------------------------------------------------- - cname1 = "Dummy Atmosphere" - - dummy_atmos_comp = ESMF_GridCompCreate(name=cname1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname1)//" component", ESMF_LOGMSG_INFO) - print *, "Dummy Atmosphere Gridded Component Created!" - - !------------------------------------------------------------------------- - ! Create Gridded Component! --- Coupler from atmosphere to land - !------------------------------------------------------------------------- - cname2 = "Coupler from atmosphere to land" - cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) - print *, "1st Coupler Gridded Component (atmosphere to land ) Created!" - - !------------------------------------------------------------------------- - ! Create Gridded Component! --- dummy land (land cap) - !------------------------------------------------------------------------- - cname3 = "Dummy Land" - - dummy_land_comp = ESMF_GridCompCreate(name=cname3, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname3)//" component", ESMF_LOGMSG_INFO) - print *, "Dummy Land Gridded Component Created!" - - !------------------------------------------------------------------------- - ! Create Gridded Component! -- Coupler from land to atmos - !------------------------------------------------------------------------- - cname4 = "Coupler from land to atmosphere" - cpl_lnd2atm_comp = ESMF_CplCompCreate(name=cname4, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname4)//" component", ESMF_LOGMSG_INFO) - print *, "2nd Coupler Gridded Component (land to atmosphere) Created!" - - - ! ======================================================================== - !------------------------------------------------------------------------- - ! Register section -- set services -- dummy atmosphere - !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(dummy_atmos_comp, userRoutine=atmos_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"dummy atmos SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Dummy Atmosphere Gridded Component SetServices finished!" - !------------------------------------------------------------------------- - ! Register section -- set services -- coupler atmosphere to land - !------------------------------------------------------------------------- - call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=atmos_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Coupler from atmosphere to land SetServices finished!" - !------------------------------------------------------------------------- - ! Register section -- set services -- dummy land - !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(dummy_land_comp, userRoutine=atmos_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"dummy land SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Dummy Land Gridded Component SetServices finished!" - !------------------------------------------------------------------------- - ! Register section -- set services -- coupler land to atmosphere - !------------------------------------------------------------------------- - call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=atmos_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Coupler from land to atmosphere SetServices finished!" - - ! ======================================================================== - - !------------------------------------------------------------------------- - ! Create and initialize a clock! - ! ????? Should I create a clock here or in driver? - !------------------------------------------------------------------------- - calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - - !print *, - !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) - !EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - - !------------------------------------------------------------------------- - ! Atmosphere Initialization.... - !------------------------------------------------------------------------- - call ESMF_GridCompInitialize(dummy_atmos_comp, & - importState=importState, exportState=exportState, & - clock=clock, rc=rc) - !, dum_var1= dum_var1, dum_var2= dum_var2) - !call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - - - end subroutine lilac_init - - subroutine lilac_run(dum_var1, dum_var2) - - use DummyAtmos, only : x2a_fields - use DummyAtmos, only : a2x_fields - - real, dimension(:) :: dum_var1 ! from host atm - real, dimension(:) :: dum_var2 ! to host atm - - integer :: n, num - - !integer, parameter :: fldsMax = 100 - integer :: fldsToLnd_num = 0 - integer :: fldsFrLnd_num = 0 - - type (fld_list_type) :: fldsToLnd(fldsMax) - type (fld_list_type) :: fldsFrLnd(fldsMax) - !----------------------------------------- - !----------------------------------------- - type(ESMF_State) :: importState, exportState - - !search through fldlist array to find the right fldist object to do the copy - say its index N - - !x2a_fields(n)%datafld1d(:) = dum_var_input(:) - - !call ESMF_CplCompRun(cpl_atm2lnd, rc=rc) - - !call ESMF_GridCompRun(lndcomp, rc=rc) - - !call ESMF_CplCompRun(cpl_lnd2atm, rc=rc) - - !dum_var_output(:) = a2x_fields(N)%datafld1d(:) - - end subroutine lilac_run - -end module LilacMod - diff --git a/lilac/scripts/Makefile b/lilac/scripts/Makefile index 9d02f57197..ca0f3648ff 100644 --- a/lilac/scripts/Makefile +++ b/lilac/scripts/Makefile @@ -43,15 +43,15 @@ include $(ESMFMKFILE) # ----------------------------------------------------------------------------- -demo_driver: demo_driver.o DummyAtmos.o LilacMod.o lilac_utils.o cpl_mod.o +demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) mv demo_driver demo_driver.exe rm *.o *.mod # module dependencies: -demo_driver.o: LilacMod.o DummyAtmos.o lilac_utils.o cpl_mod.o -LilacMod.o: DummyAtmos.o lilac_utils.o cpl_mod.o -DummyAtmos.o: lilac_utils.o +demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o +lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o +atmos_cap.o: lilac_utils.o lilac_utils.o: cpl_mod.o: # ----------------------------------------------------------------------------- diff --git a/lilac/scripts/lilac_utils.f90 b/lilac/scripts/lilac_utils.F90 similarity index 75% rename from lilac/scripts/lilac_utils.f90 rename to lilac/scripts/lilac_utils.F90 index fcf3f7b16f..76ffd32db0 100644 --- a/lilac/scripts/lilac_utils.f90 +++ b/lilac/scripts/lilac_utils.F90 @@ -70,25 +70,27 @@ subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) !call fldlist_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) ! from atm - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') + call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=0.0, units='m') + ! from lnd + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'lnd2atmos_var', default_value=0.0, units='m') ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, units= 'degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, units= 'degK') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') @@ -105,7 +107,6 @@ subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) ! land states - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'dum1', default_value=0.0 , units='degk') !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) From 9f44c9d34185345cc5583335cbecd4ef42f8a149 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Apr 2019 18:59:07 -0600 Subject: [PATCH 068/556] working and compiling .... hurrray.... skleton is working.... --- lilac/scripts/Makefile | 6 +-- lilac/scripts/atmos_cap.F90 | 6 +-- lilac/scripts/cpl_mod.F90 | 25 +++++++++++ lilac/scripts/demo_driver.F90 | 2 +- lilac/scripts/lilac_mod.F90 | 81 +++++++++++++++++++++++------------ lilac/scripts/lnd_cap.F90 | 4 +- 6 files changed, 85 insertions(+), 39 deletions(-) diff --git a/lilac/scripts/Makefile b/lilac/scripts/Makefile index ca0f3648ff..92817a8381 100644 --- a/lilac/scripts/Makefile +++ b/lilac/scripts/Makefile @@ -43,17 +43,15 @@ include $(ESMFMKFILE) # ----------------------------------------------------------------------------- -demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o +demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) mv demo_driver demo_driver.exe rm *.o *.mod # module dependencies: demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o -lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o +lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o atmos_cap.o: lilac_utils.o -lilac_utils.o: -cpl_mod.o: # ----------------------------------------------------------------------------- # ----------------------------------------------------------------------------- .PHONY: dust clean distclean berzerk diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 227ffd34bb..706790106c 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -104,12 +104,10 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) ! value to them. !------------------------------------------------------------------------- - call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) - - !!! FOR NOW LET'S JUST ADD TWO THINGS.... - !!! WE WILL PUT THIS UNDER CREATE_FLDLIST LATER fldsFrCpl_num = 1 fldsToCpl_num = 1 + call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'lnd2atmos_var', default_value=30.0, units='m') !call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=10.0, units='m') diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index f276267b12..8cc7ce0be1 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -4,6 +4,7 @@ module cpl_mod implicit none public cpl_atm2lnd_register + public cpl_lnd2atm_register contains @@ -25,6 +26,17 @@ subroutine cpl_atm2lnd_register(cplcomp, rc) !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) end subroutine cpl_atm2lnd_register + subroutine cpl_lnd2atm_register(cplcomp, rc) + type(ESMF_CplComp) :: cplcomp + integer, intent(out) :: rc + rc = ESMF_FAILURE + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_lnd2atm_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + + end subroutine cpl_lnd2atm_register + + subroutine my_init(cplcomp, importState, exportState, clock, rc) type(ESMF_CplComp) :: cplcomp type(ESMF_State) :: importState @@ -37,6 +49,19 @@ subroutine my_init(cplcomp, importState, exportState, clock, rc) end subroutine my_init + subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + print *, "Coupler for land to atmosphere initialize routine called" + rc = ESMF_SUCCESS + end subroutine cpl_lnd2atm_init + + + subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) type(ESMF_CplComp) :: cplcomp type(ESMF_State) :: importState, exportState diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 7bfa405866..7cf8846985 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -2,7 +2,7 @@ program demo_lilac_driver ! modules use ESMF - use LilacMod + use Lilac_mod implicit none diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 4bc2be9423..a892006984 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -1,12 +1,13 @@ !Khoda -module LilacMod +module lilac_mod use ESMF use lilac_utils !use DummyAtmos -use atmos_cap, only : x2a_fields -use atmos_cap, only : a2x_fields +!use atmos_cap, only : x2a_fields +!use atmos_cap, only : a2x_fields +!use atmos_cap, only : atmos_register use atmos_cap, only : atmos_register - +use lnd_cap, only : lnd_register use cpl_mod @@ -48,8 +49,10 @@ subroutine lilac_init( dum_var1, dum_var2) type(ESMF_Mesh) :: Emesh character(len=*), parameter :: subname=trim(modname)//':(lilac_init) ' type(ESMF_State) :: importState, exportState + type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state + type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state + !character(len=*) :: atm_mesh_filepath - ! local variables integer :: rc, urc character(len=ESMF_MAXSTR) :: cname1, cname2, cname3, cname4 @@ -74,15 +77,6 @@ subroutine lilac_init( dum_var1, dum_var2) call ESMF_LogWrite(subname//"Created "//trim(cname1)//" component", ESMF_LOGMSG_INFO) print *, "Dummy Atmosphere Gridded Component Created!" - !------------------------------------------------------------------------- - ! Create Gridded Component! --- Coupler from atmosphere to land - !------------------------------------------------------------------------- - cname2 = "Coupler from atmosphere to land" - cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) - print *, "1st Coupler Gridded Component (atmosphere to land ) Created!" - !------------------------------------------------------------------------- ! Create Gridded Component! --- dummy land (land cap) !------------------------------------------------------------------------- @@ -93,6 +87,15 @@ subroutine lilac_init( dum_var1, dum_var2) call ESMF_LogWrite(subname//"Created "//trim(cname3)//" component", ESMF_LOGMSG_INFO) print *, "Dummy Land Gridded Component Created!" + !------------------------------------------------------------------------- + ! Create Gridded Component! --- Coupler from atmosphere to land + !------------------------------------------------------------------------- + cname2 = "Coupler from atmosphere to land" + cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) + print *, "1st Coupler Gridded Component (atmosphere to land ) Created!" + !------------------------------------------------------------------------- ! Create Gridded Component! -- Coupler from land to atmos !------------------------------------------------------------------------- @@ -112,6 +115,13 @@ subroutine lilac_init( dum_var1, dum_var2) call ESMF_LogWrite(subname//"dummy atmos SetServices finished!", ESMF_LOGMSG_INFO) print *, "Dummy Atmosphere Gridded Component SetServices finished!" !------------------------------------------------------------------------- + ! Register section -- set services -- land cap + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(dummy_land_comp, userRoutine=lnd_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Land Gridded Component SetServices finished!" + !------------------------------------------------------------------------- ! Register section -- set services -- coupler atmosphere to land !------------------------------------------------------------------------- call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, rc=rc) @@ -119,16 +129,9 @@ subroutine lilac_init( dum_var1, dum_var2) call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) print *, "Coupler from atmosphere to land SetServices finished!" !------------------------------------------------------------------------- - ! Register section -- set services -- dummy land - !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(dummy_land_comp, userRoutine=lnd_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Land Gridded Component SetServices finished!" - !------------------------------------------------------------------------- ! Register section -- set services -- coupler land to atmosphere !------------------------------------------------------------------------- - call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_atm2lnd_register, rc=rc) + call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_lnd2atm_register, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) print *, "Coupler from land to atmosphere SetServices finished!" @@ -152,14 +155,36 @@ subroutine lilac_init( dum_var1, dum_var2) !------------------------------------------------------------------------- ! Atmosphere Initialization.... !------------------------------------------------------------------------- - call ESMF_GridCompInitialize(dummy_atmos_comp, & - importState=importState, exportState=exportState, & - clock=clock, rc=rc) - !, dum_var1= dum_var1, dum_var2= dum_var2) - !call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) + + ! Create the necessary import and export states used to pass data + ! between components. + + ! following 4 states are lilac module variables + + atm2lnd_a_state = ESMF_StateCreate(name=cname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + atm2lnd_l_state = ESMF_StateCreate(name=cname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + lnd2atm_a_state = ESMF_StateCreate(name=cname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + lnd2atm_l_state = ESMF_StateCreate(name=cname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !, dum_var1= dum_var1, dum_var2= dum_var2) + ! returns a valid state_to_lnd_atm and an empty state_from_land_atmgrid + + call ESMF_GridCompInitialize(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + call ESMF_GridCompInitialize(dummy_land_comp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + ! All 4 states that are module variables are no longer empty - have been initialized + call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + + !call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end subroutine lilac_init @@ -197,5 +222,5 @@ subroutine lilac_run(dum_var1, dum_var2) end subroutine lilac_run -end module LilacMod +end module lilac_mod diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index b7157eb9ec..71c29f5eb5 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -4,7 +4,7 @@ module lnd_cap implicit none - character(*), parameter :: modname = "(core)" + character(*), parameter :: modname = "(land)" !!integer, parameter :: fldsMax = 100 @@ -42,7 +42,7 @@ subroutine lnd_register(comp, rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=lnd_final, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end subroutine atmos_register + end subroutine lnd_register subroutine lnd_init(comp, importState, exportState, clock, rc) type (ESMF_GridComp) :: comp From 336d4c53d846e1784cb3a49b12d0bba98bba16a7 Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 22 Apr 2019 11:39:24 -0600 Subject: [PATCH 069/556] adding grid creation for land and atmosphere -- compiling and running -- but not correctly... --- lilac/scripts/.cpl_mod.F90.swp | Bin 0 -> 12288 bytes lilac/scripts/atmos_cap.F90 | 52 +++++++++++++++++++------- lilac/scripts/demo_driver.F90 | 10 ++--- lilac/scripts/lilac_mod.F90 | 8 ++-- lilac/scripts/lnd_cap.F90 | 65 ++++++++++++++++++++++++++++----- 5 files changed, 103 insertions(+), 32 deletions(-) create mode 100644 lilac/scripts/.cpl_mod.F90.swp diff --git a/lilac/scripts/.cpl_mod.F90.swp b/lilac/scripts/.cpl_mod.F90.swp new file mode 100644 index 0000000000000000000000000000000000000000..f5b5fe720ede7c4567a1fb56a69411949340a14d GIT binary patch literal 12288 zcmeI2&2JM&7>6emLQMG*J+(#ZBvmB`Suv!Qsv@}}b!=gjgvgG2C`e|r9w#f-v#Z^) z+Hl~bYB-XfIPeD`1P3^CK;l-Ztwaw!_t1X;BCXZGE9 zpP6^omUsF1x0QMR<3A|g z2FL&zAOmE843GgbKnC6+1Iis?SCH?nDCfoKbtLr~?a~VwAOmE843GgbKnBPF86X2> zfDDiUGVl%>Fq(|r+0EGQQ6!Jw|GVG+pB-ZCDfk=w0iJ*d;AgM_u7h>31oGezI0*hZ z$k+?;JNOM;01Vtcz}PwPazA7Dz$|$FKKg)P!7b1Mb?`O#Yah-9Hoy(g0s=I_C*Wm< zu|L6mumL1!g97*r>;oAv1|E(vb`!YZ3^)cdU<^Fk%h+x3Be({xf-B$z$bcvCau=+F zpTIdV15SaX;A8L+_z;YOJwUsB570&i$N(95`wa-$#z- z%J2|#WuhMg{ltp!a$Nr-Ro0R??Ib^W646-@3xCv_E3(0fine23oDAMa7gO(T(yOKn zC3?NAw(EE*crVAr551jD4lKHM(P_K-P#xa2P3#5zh6u?<{csJhI8!dnG>2=N9AX)U zr(rs@j1;iFO7WoJmg8~Tz|bj&BZ%X>tHKk|YAMUGtxJOU2Gp=^(d>;udISdi57 z@Sv%$gcq$joLj9dCVM`)piFWTlQmpp%9ae~aTX)ivW=BOuppEcW*al#oUJbD;wtF+ z3MW$kxTvOULY1WQ))pO1`2N)dLFP+Kr_atdDhrjR%FJBlyAldEmaDFzWcYqrmS-w+ z^=c_R>+4FXUjtE6uU}}=zWSL5Yl*(t)C|^{ch~El2isf=;A#&XDg;x#l zG6gfdPc&M3l#{agTak9PzL4XaW$bliD&HNpycNmusT@^sD#|Xa82+RES&g~ocx&gFHLY~(*OVf literal 0 HcmV?d00001 diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 706790106c..8b83dcf3dd 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -6,7 +6,7 @@ module atmos_cap implicit none - character(*), parameter :: modname = "(core)" + character(*), parameter :: modname = "(atmos_cap)" !!integer, parameter :: fldsMax = 100 @@ -59,13 +59,12 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) type (fld_list_type) :: fldsToCpl(fldsMax) type (fld_list_type) :: fldsFrCpl(fldsMax) - ! TODO Probably we can have these at the top integer :: fldsToCpl_num integer :: fldsFrCpl_num character(len=*), parameter :: subname=trim(modname)//':(atmos_init) ' - type (ESMF_State) :: x2a_state + type (ESMF_State) :: x2a_state type (ESMF_State) :: a2x_state type (ESMF_FieldBundle) :: FBout integer :: n @@ -73,22 +72,49 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) type(ESMF_Mesh) :: atmos_mesh character(len=ESMF_MAXSTR) :: atmos_mesh_filepath - ! Initialize return code + integer :: petCount, localrc, urc + integer :: mid, by2, quart, by4 + + type(ESMF_Grid) :: atmos_grid, Grid1 + + type(ESMF_DistGrid) :: distgridIN, distgridFS + logical mesh_switch + !integer :: regDecomp(:,:) + ! Initialize return code rc = ESMF_SUCCESS !------------------------------------------------------------------------- ! Generate -- Read in the mesh !------------------------------------------------------------------------- - ! For now this is our dummy mesh: - atmos_mesh_filepath='/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' - - atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) - print *, "!Mesh for atmosphere is created!" - + mesh_switch = .false. + if(mesh_switch) then + ! For now this is our dummy mesh: + atmos_mesh_filepath='/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + + atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) + print *, "!Mesh for atmosphere is created!" + + else + call ESMF_GridCompGet(comp, petcount=petcount, rc=rc) + !Grid1= ESMF_GridCreateNoPeriDimUfrmR( maxIndex=(/180,360 /), & + ! minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & + ! maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & + ! regDecomp=(/petcount,1/), rc=rc) + + atmos_grid = ESMF_GridCreateNoPeriDimUfrm( minIndex= (/1,1/), maxIndex=(/180,360 /), & + maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & + minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & + coordSys=ESMF_COORDSYS_CART,& + regDecomp=(/1,petcount/),& + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Grid for atmosphere is created!", ESMF_LOGMSG_INFO) + print *, "Grid for atmosphere is created!" + endif !------------------------------------------------------------------------- ! Create States -- x2a_state (import) -- a2x_state (export) !------------------------------------------------------------------------- @@ -117,7 +143,7 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) ! Coupler (land) to Atmosphere Fields -- x2a ! I- Create Field Bundle -- FBout for now-- TODO: negin want to rename to x2a_fieldbundle ! II- Create Fields and add them to field bundle - ! III - Add FBout to state (x2a_state) + ! III - Add FBout to state (x2a_state) !------------------------------------------------------------------------- FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 7cf8846985..3f3dfcce28 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -6,8 +6,8 @@ program demo_lilac_driver implicit none - real, dimension(10) :: dum_var1 - real, dimension(10) :: dum_var2 + real, dimension(100,100) :: dum_var1 + real, dimension(100,100) :: dum_var2 !real, dimension(10) :: t_phy ! temperature (K) !real, dimension(10) :: th_phy ! potential temperature (K) @@ -19,9 +19,9 @@ program demo_lilac_driver !call random_number(t_phy) !call random_number(th_phy) - print *, "dum_var1 = ", dum_var1 - print *, "dum_var2 = ", dum_var2 - + !print *, "dum_var1 = ", dum_var1 + !print *, "dum_var2 = ", dum_var2 + call lilac_init(dum_var1, dum_var2) call lilac_run(dum_var1, dum_var2) diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index a892006984..19007a059c 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -35,8 +35,8 @@ subroutine lilac_init( dum_var1, dum_var2) ! modules implicit none - real, dimension(10) :: dum_var1 - real, dimension(10) :: dum_var2 + real, dimension(:,:) :: dum_var1 + real, dimension(:,:) :: dum_var2 ! Component, and State type(ESMF_GridComp) :: dummy_atmos_comp @@ -193,8 +193,8 @@ subroutine lilac_run(dum_var1, dum_var2) use atmos_cap, only : x2a_fields use atmos_cap, only : a2x_fields - real, dimension(:) :: dum_var1 ! from host atm - real, dimension(:) :: dum_var2 ! to host atm + real, dimension(:,:) :: dum_var1 ! from host atm + real, dimension(:,:) :: dum_var2 ! to host atm integer :: n, num diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index 71c29f5eb5..3d9b2dc7b5 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -23,13 +23,16 @@ module lnd_cap contains +!------------------------------------------------------------------------- +! land register +!------------------------------------------------------------------------- subroutine lnd_register(comp, rc) type(ESMF_GridComp) :: comp ! must not be optional integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' + character(len=*), parameter :: subname=trim(modname)//':(lnd_register) ' - print *, "in user register routine" + print *, "in lnd register routine" rc = ESMF_SUCCESS ! Set the entry points for standard ESMF Component methods @@ -44,35 +47,77 @@ subroutine lnd_register(comp, rc) end subroutine lnd_register +!------------------------------------------------------------------------- +! land init +!------------------------------------------------------------------------- + subroutine lnd_init(comp, importState, exportState, clock, rc) - type (ESMF_GridComp) :: comp - type (ESMF_State) :: importState, exportState - type (ESMF_Clock) :: clock - integer, intent(out) :: rc + type (ESMF_GridComp) :: comp + type (ESMF_State) :: importState, exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + logical mesh_switch + integer :: petCount, localrc, urc + type(ESMF_Mesh) :: lnd_mesh + character(len=ESMF_MAXSTR) :: lnd_mesh_filepath + + character(len=*), parameter :: subname=trim(modname)//':(lnd_register) ' + + type(ESMF_Grid) :: lnd_grid print *, " Empty land is created !!!!" rc = ESMF_SUCCESS + + + print *, "in land routine routine" !------------------------------------------------------------------------- - ! Generate -- Read in the mesh + ! Read in the mesh ----or----- Generate the grid !------------------------------------------------------------------------- + mesh_switch = .false. + if(mesh_switch) then + ! For now this is our dummy mesh: + lnd_mesh_filepath='/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + + lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Mesh for land is created!", ESMF_LOGMSG_INFO) + print *, "!Mesh for land is created!" + else + call ESMF_GridCompGet(comp, petcount=petcount, rc=rc) + lnd_grid = ESMF_GridCreateNoPeriDimUfrm( minIndex= (/1,1/), maxIndex=(/180,360 /), & + maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & + minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & + coordSys=ESMF_COORDSYS_CART,& + regDecomp=(/petcount,1/),& + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Grid for land is created!", ESMF_LOGMSG_INFO) + print *, "Grid for land is created!" + endif end subroutine lnd_init - +!------------------------------------------------------------------------- +! land run +!------------------------------------------------------------------------- subroutine lnd_run(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_lilac_to_atm) ' + character(len=*), parameter :: subname=trim(modname)//':(lnd_run) ' ! Initialize return code rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"lnd_run has not been implemented yet", ESMF_LOGMSG_INFO) end subroutine lnd_run +!------------------------------------------------------------------------- +! land final +!------------------------------------------------------------------------- subroutine lnd_final(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState From d72396c56d8fa097434e8e06f1bbf686226d26f2 Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 22 Apr 2019 16:20:22 -0600 Subject: [PATCH 070/556] after a session with Mariana and Rocky --- lilac/scripts/atmos_cap.F90 | 86 +++++++++--------------- lilac/scripts/demo_driver.F90 | 6 ++ lilac/scripts/lilac_mod.F90 | 123 +++++++++++++++++++++++++++------- lilac/scripts/lilac_utils.F90 | 19 +++--- lilac/scripts/lnd_cap.F90 | 2 +- 5 files changed, 144 insertions(+), 92 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 8b83dcf3dd..d8c3c1b417 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -54,36 +54,32 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) type (ESMF_State) :: importState, exportState type (ESMF_Clock) :: clock integer, intent(out) :: rc - - !!! TODO: Maybe it is better to call these fldsToAtm and fldsFrAtm - - type (fld_list_type) :: fldsToCpl(fldsMax) - type (fld_list_type) :: fldsFrCpl(fldsMax) - integer :: fldsToCpl_num - integer :: fldsFrCpl_num + ! local variables + !!! TODO: Maybe it is better to call these fldsToAtm and fldsFrAtm + type (fld_list_type) :: fldsToCpl(fldsMax) + type (fld_list_type) :: fldsFrCpl(fldsMax) + integer :: fldsToCpl_num + integer :: fldsFrCpl_num + type (ESMF_FieldBundle) :: FBout + integer :: n + type(ESMF_Mesh) :: atmos_mesh + character(len=ESMF_MAXSTR) :: atmos_mesh_filepath + integer :: petCount, localrc, urc + integer :: mid, by2, quart, by4 + type(ESMF_Grid) :: atmos_grid + type(ESMF_DistGrid) :: distgridIN, distgridFS + logical :: mesh_switch character(len=*), parameter :: subname=trim(modname)//':(atmos_init) ' + !---------------------- - type (ESMF_State) :: x2a_state - type (ESMF_State) :: a2x_state - type (ESMF_FieldBundle) :: FBout - integer :: n - - type(ESMF_Mesh) :: atmos_mesh - character(len=ESMF_MAXSTR) :: atmos_mesh_filepath - - - integer :: petCount, localrc, urc - integer :: mid, by2, quart, by4 - - type(ESMF_Grid) :: atmos_grid, Grid1 - - type(ESMF_DistGrid) :: distgridIN, distgridFS - logical mesh_switch !integer :: regDecomp(:,:) ! Initialize return code rc = ESMF_SUCCESS + call ESMF_GridCompGet(comp, petcount=petcount, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + !------------------------------------------------------------------------- ! Generate -- Read in the mesh !------------------------------------------------------------------------- @@ -99,7 +95,6 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) print *, "!Mesh for atmosphere is created!" else - call ESMF_GridCompGet(comp, petcount=petcount, rc=rc) !Grid1= ESMF_GridCreateNoPeriDimUfrmR( maxIndex=(/180,360 /), & ! minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & ! maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & @@ -111,33 +106,10 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) coordSys=ESMF_COORDSYS_CART,& regDecomp=(/1,petcount/),& rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Grid for atmosphere is created!", ESMF_LOGMSG_INFO) print *, "Grid for atmosphere is created!" endif - !------------------------------------------------------------------------- - ! Create States -- x2a_state (import) -- a2x_state (export) - !------------------------------------------------------------------------- - x2a_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - a2x_state = ESMF_StateCreate(name="a2x_state", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!empty x2a_state (import) is created!" - print *, "!empty a2x_state (export) is created!" - - !------------------------------------------------------------------------- - ! Create Field lists -- Basically create a list of fields and add a default - ! value to them. - !------------------------------------------------------------------------- - - fldsFrCpl_num = 1 - fldsToCpl_num = 1 - call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) - - - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'lnd2atmos_var', default_value=30.0, units='m') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=10.0, units='m') - !------------------------------------------------------------------------- ! Coupler (land) to Atmosphere Fields -- x2a @@ -148,18 +120,20 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - - ! Create individual states and add to field bundle + ! Create individual fields and add to field bundle do n = 1,fldsFrCpl_num ! create field !!! Here we want to pass pointers !field = ESMF_FieldCreate(Emesh,farrayPtr=dum_var1_ptr, meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) !field = ESMF_FieldCreate(lmesh,farrayPtr=x2a_fields%fields(:, n), meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) print *, trim(fldsFrCpl(n)%stdname) - field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 ,meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(atmos_mesh, farrayPtr , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (mesh_switch) then + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(fldsFrCpl(n)%stdname), farraPtr=fldsFrCpl(n)%arrayptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + else + field = ESMF_FieldCreate(atmos_grid, name=trim(fldsFrCpl(n)%stdname), name=trim(fldsFrCpl(n)%stdname), farraPtr=fldsFrCpl(n)%arrayptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if ! add field to field bundle call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -167,7 +141,7 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) print *, "!Fields For Coupler (fldsFrCpl) Field Bundle Created!" ! Add FB to state - call ESMF_StateAdd(x2a_state, (/FBout/), rc=rc) + call ESMF_StateAdd(exportState, (/FBout/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Atmosphere to Coupler Fields @@ -202,7 +176,7 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) print *, "!Fields to Coupler (fldstoCpl) Field Bundle Created!" ! Add FB to state - call ESMF_StateAdd(a2x_state, (/FBout/), rc=rc) + call ESMF_StateAdd(importState, (/FBout/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "!a2x_state is filld with dummy_var field bundle!" diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 3f3dfcce28..be8d1985ed 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -25,8 +25,14 @@ program demo_lilac_driver call lilac_init(dum_var1, dum_var2) call lilac_run(dum_var1, dum_var2) + !---------------------------------------------- + !--- Done --- + !---------------------------------------------- + !write(iunit,*) subname,' DONE' + print *, " ... DONE ..." call ESMF_Finalize() + end program demo_lilac_driver diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 19007a059c..c0db2dc8e2 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -1,13 +1,9 @@ -!Khoda module lilac_mod use ESMF use lilac_utils !use DummyAtmos -!use atmos_cap, only : x2a_fields -!use atmos_cap, only : a2x_fields -!use atmos_cap, only : atmos_register use atmos_cap, only : atmos_register -use lnd_cap, only : lnd_register +use lnd_cap, only : lnd_register use cpl_mod @@ -25,24 +21,54 @@ module lilac_mod character(*), parameter :: modname = "(LilacMod)" + type atm2lnd_data1d_type + real(r8), pointer :: uwind(:) + real(r8), pointer :: vwind(:) + real(r8), pointer :: tbot(:) + end type atm2lnd_data1d_type + + type atm2lnd_data2d_type + real(r8), pointer :: uwind(:,:) + real(r8), pointer :: vwind(:,:) + real(r8), pointer :: tbot(:,:) + end type atm2lnd_data2d_type + + type lnd2atm_data1d_type + real(r8), pointer :: lwup(:) + real(r8), pointer :: taux(:) + real(r8), pointer :: tauy(:) + end type lnd2atm_data1d_type + + type lnd2atm_data2d_type + real(r8), pointer :: lwup(:,:) + real(r8), pointer :: taux(:,:) + real(r8), pointer :: tauy(:,:) + end type lnd2atm_data2d_type + !=============================================================================== public :: lilac_init public :: lilac_run contains - subroutine lilac_init( dum_var1, dum_var2) + subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) + + use atmos_cap, only : a2l_fields !**** + use atmos_cap, only : l2a_fields !**** + ! modules implicit none - real, dimension(:,:) :: dum_var1 - real, dimension(:,:) :: dum_var2 + type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d + type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d + type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d + type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d ! Component, and State type(ESMF_GridComp) :: dummy_atmos_comp type(ESMF_GridComp) :: dummy_land_comp - type(ESMF_CplComp) :: cpl_atm2lnd_comp - type(ESMF_CplComp) :: cpl_lnd2atm_comp + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp type(ESMF_State) :: coupledFlowState ! the coupled flow State @@ -52,11 +78,13 @@ subroutine lilac_init( dum_var1, dum_var2) type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state - !character(len=*) :: atm_mesh_filepath + !character(len=*) :: atm_mesh_filepath !!! For now this is hard + !coded in the atmos init + ! local variables integer :: rc, urc character(len=ESMF_MAXSTR) :: cname1, cname2, cname3, cname4 - !integer, parameter :: fldsMax = 100 + !integer, parameter :: fldsMax = 100 !------------------------------------------------------------------------- ! Initialize ESMF, set the default calendar and log type. @@ -67,10 +95,27 @@ subroutine lilac_init( dum_var1, dum_var2) print *, "----------------------------" print *, "lilac Demo Application Start" + !------------------------------------------------------------------------- + ! Create Field lists -- Basically create a list of fields and add a default + ! value to them. + !------------------------------------------------------------------------- + fldsFrCpl_num = 1 + fldsToCpl_num = 1 + + if (present(var1_a2l_1d)) then + a2l_fields%name = 'uwind' + a2l_fields%arrptr1d => atm2lnd_data1d%uwind + call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num, 'mesh') + else + a2l_fields%name = 'name' + a2l_fields%arrptr2d => var1_a2l_2d + call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num, 'grid') + end if + !------------------------------------------------------------------------- ! Create Gridded Component! --- dummy atmosphere !------------------------------------------------------------------------- - cname1 = "Dummy Atmosphere" + cname1 = "Dummy Atmosphere or Atmosphere Cap" dummy_atmos_comp = ESMF_GridCompCreate(name=cname1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -80,20 +125,20 @@ subroutine lilac_init( dum_var1, dum_var2) !------------------------------------------------------------------------- ! Create Gridded Component! --- dummy land (land cap) !------------------------------------------------------------------------- - cname3 = "Dummy Land" + cname2 = "Dummy Land or Land Cap" - dummy_land_comp = ESMF_GridCompCreate(name=cname3, rc=rc) + dummy_land_comp = ESMF_GridCompCreate(name=cname2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname3)//" component", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) print *, "Dummy Land Gridded Component Created!" !------------------------------------------------------------------------- - ! Create Gridded Component! --- Coupler from atmosphere to land + ! Create Gridded Component! --- Coupler from atmos to land !------------------------------------------------------------------------- - cname2 = "Coupler from atmosphere to land" - cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname2, rc=rc) + cname3 = "Coupler from atmosphere to land" + cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname3, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Created "//trim(cname3)//" component", ESMF_LOGMSG_INFO) print *, "1st Coupler Gridded Component (atmosphere to land ) Created!" !------------------------------------------------------------------------- @@ -105,8 +150,8 @@ subroutine lilac_init( dum_var1, dum_var2) call ESMF_LogWrite(subname//"Created "//trim(cname4)//" component", ESMF_LOGMSG_INFO) print *, "2nd Coupler Gridded Component (land to atmosphere) Created!" - ! ======================================================================== + !------------------------------------------------------------------------- ! Register section -- set services -- dummy atmosphere !------------------------------------------------------------------------- @@ -152,12 +197,11 @@ subroutine lilac_init( dum_var1, dum_var2) !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) !EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - !------------------------------------------------------------------------- - ! Atmosphere Initialization.... - !------------------------------------------------------------------------- + !------------------------------------------------------------------------- ! Create the necessary import and export states used to pass data ! between components. + !------------------------------------------------------------------------- ! following 4 states are lilac module variables @@ -173,18 +217,43 @@ subroutine lilac_init( dum_var1, dum_var2) lnd2atm_l_state = ESMF_StateCreate(name=cname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + call ESMF_LogWrite(subname//"Empty import and export states are created!!", ESMF_LOGMSG_INFO) + print *, "Empty import and export states are created!!" + !, dum_var1= dum_var1, dum_var2= dum_var2) ! returns a valid state_to_lnd_atm and an empty state_from_land_atmgrid + ! ======================================================================== + !------------------------------------------------------------------------- + ! Grid Componenet Initialization -- 1- atmos cap 2- lnd cap 3- cpl_atm2lnd + ! 4- cpl_lnd2atm + !------------------------------------------------------------------------- call ESMF_GridCompInitialize(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp initialized", ESMF_LOGMSG_INFO) + print *, "atmos_cap initialize finished, rc =", rc + + call ESMF_GridCompInitialize(dummy_land_comp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp initialized", ESMF_LOGMSG_INFO) + print *, "lnd_cap initialize finished, rc =", rc + + ! All 4 states that are module variables are no longer empty - have been initialized call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) - call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) + print *, "coupler :: cpl_atm2lnd_comp initialize finished, rc =", rc - !call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) + call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) + print *, "coupler :: cpl_lnd2atm_comp initialize finished, rc =", rc + end subroutine lilac_init @@ -222,5 +291,7 @@ subroutine lilac_run(dum_var1, dum_var2) end subroutine lilac_run + + end module lilac_mod diff --git a/lilac/scripts/lilac_utils.F90 b/lilac/scripts/lilac_utils.F90 index 76ffd32db0..edf39a64f8 100644 --- a/lilac/scripts/lilac_utils.F90 +++ b/lilac/scripts/lilac_utils.F90 @@ -11,7 +11,8 @@ module lilac_utils character(len=128) :: stdname real*8 :: default_value character(len=128) :: units - real*8, pointer :: datafld1d(:) ! this will be filled in by lilac when it gets its data from the host atm + real*8, pointer :: farrayptr1d(:) ! this will be filled in by lilac when it gets its data from the host atm + real*8, pointer :: farrayptr2d(:,:) ! this will be filled in by lilac when it gets its data from the host atm end type fld_list_type !=============================================================================== @@ -34,7 +35,7 @@ subroutine fldlist_add(num, fldlist, stdname, default_value, units) ! Set up a list of field information num = num + 1 if (num > fldsMax) then - call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"?!", ESMF_LOGMSG_INFO) endif fldlist(num)%stdname = trim(stdname) @@ -58,21 +59,21 @@ subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) type(fld_list_type), intent(inout) :: fldsToCpl(:) !integer, intent(out) :: fldsToCpl_num = 0 !integer, intent(out) :: fldsFrCpl_num = 0 + integer :: fldsFrCpl_num, fldsToCpl_num - ! import fields - ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) + ! from atm + call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=0.0, units='m') + ! from lnd + call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'lnd2atmos_var', default_value=0.0, units='m') - integer :: fldsFrCpl_num, fldsToCpl_num !!! First from atmosphere to land fields + ! import fields + ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) !call fldlist_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) - ! from atm - call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=0.0, units='m') - ! from lnd - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'lnd2atmos_var', default_value=0.0, units='m') ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index 3d9b2dc7b5..74545bf281 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -84,13 +84,13 @@ subroutine lnd_init(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"Mesh for land is created!", ESMF_LOGMSG_INFO) print *, "!Mesh for land is created!" else - call ESMF_GridCompGet(comp, petcount=petcount, rc=rc) lnd_grid = ESMF_GridCreateNoPeriDimUfrm( minIndex= (/1,1/), maxIndex=(/180,360 /), & maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & coordSys=ESMF_COORDSYS_CART,& regDecomp=(/petcount,1/),& rc=rc) + call ESMF_GridCompGet(comp, grid= lnd_grid , petcount=petcount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Grid for land is created!", ESMF_LOGMSG_INFO) print *, "Grid for land is created!" From e7f19be45947a89fd1c6773bb335b38560bd2143 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 24 Apr 2019 11:04:00 -0600 Subject: [PATCH 071/556] saving lilac_utils.F90 --- lilac/scripts/lilac_utils.F90 | 56 +++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/lilac/scripts/lilac_utils.F90 b/lilac/scripts/lilac_utils.F90 index edf39a64f8..aa2bdfb0d1 100644 --- a/lilac/scripts/lilac_utils.F90 +++ b/lilac/scripts/lilac_utils.F90 @@ -15,6 +15,62 @@ module lilac_utils real*8, pointer :: farrayptr2d(:,:) ! this will be filled in by lilac when it gets its data from the host atm end type fld_list_type +!!! 1d for when we have mesh and 2d for when we have grids.... + + type :: atm2lnd_data1d_type + real*8, pointer :: uwind (:) + real*8, pointer :: vwind (:) + real*8, pointer :: tbot (:) + end type atm2lnd_data1d_type + + type :: lnd2atm_data1d_type + real*8, pointer :: lwup (:) + real*8, pointer :: taux (:) + real*8, pointer :: tauy (:) + end type lnd2atm_data1d_type + + type :: atm2lnd_data2d_type + real*8, pointer :: uwind (:,:) + real*8, pointer :: vwind (:,:) + real*8, pointer :: tbot (:,:) + end type atm2lnd_data1d_type + + type :: lnd2atm_data2d_type + real*8, pointer :: lwup (:,:) + real*8, pointer :: taux (:,:) + real*8, pointer :: tauy (:,:) + end type lnd2atm_data2d_type + + + + + + + + + type atm2lnd_data1d_type + real*8, pointer :: uwind(:) + real*8, pointer :: vwind(:) + real*8, pointer :: tbot(:) + end type atm2lnd_data1d_type + + type atm2lnd_data2d_type + real*8, pointer :: uwind(:,:) + real*8, pointer :: vwind(:,:) + real*8, pointer :: tbot(:,:) + end type atm2lnd_data2d_type + + type lnd2atm_data1d_type + real*8, pointer :: lwup(:) + real*8, pointer :: taux(:) + real*8, pointer :: tauy(:) + end type lnd2atm_data1d_type + + type lnd2atm_data2d_type + real*8, pointer :: lwup(:,:) + real*8, pointer :: taux(:,:) + real*8, pointer :: tauy(:,:) + end type lnd2atm_data2d_type !=============================================================================== contains !=============================================================================== From c1df7955a3a2de4fb4437efba51932ce7f47ed44 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 24 Apr 2019 11:07:06 -0600 Subject: [PATCH 072/556] working version of the driver with the data types. --- lilac/scripts/demo_driver.F90 | 75 ++++++++++++++++++++--------------- 1 file changed, 44 insertions(+), 31 deletions(-) diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index be8d1985ed..c4c45634ab 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -1,36 +1,49 @@ program demo_lilac_driver - ! modules - use ESMF - use Lilac_mod - - implicit none - - real, dimension(100,100) :: dum_var1 - real, dimension(100,100) :: dum_var2 - - !real, dimension(10) :: t_phy ! temperature (K) - !real, dimension(10) :: th_phy ! potential temperature (K) - !real, dimension(10,10) :: rho ! - - call random_number(dum_var1) - call random_number(dum_var2) - - !call random_number(t_phy) - !call random_number(th_phy) - - !print *, "dum_var1 = ", dum_var1 - !print *, "dum_var2 = ", dum_var2 - - call lilac_init(dum_var1, dum_var2) - call lilac_run(dum_var1, dum_var2) - - !---------------------------------------------- - !--- Done --- - !---------------------------------------------- - !write(iunit,*) subname,' DONE' - print *, " ... DONE ..." - call ESMF_Finalize() + ! modules + use ESMF + !use Lilac_mod + + !use lilac_utils, only : atm2lnd_data1d_type , lnd2atm_data1d_type, atm2lnd_data2d_type, atm2lnd_data2d_type + !use lilac_utils, only : atm2lnd_data2d_type + implicit none + + type :: atm2lnd_data1d_type + real*8, pointer :: uwind (:) + real*8, pointer :: vwind (:) + real*8, pointer :: tbot (:) + end type atm2lnd_data1d_type + + type :: lnd2atm_data1d_type + real*8, pointer :: lwup(:) + real*8, pointer :: taux(:) + real*8, pointer :: tauy(:) + end type lnd2atm_data1d_type + + + type (atm2lnd_data1d_type) :: atm2lnd + type (lnd2atm_data1d_type) :: lnd2atm + integer :: begc,endc + real, dimension(100,100), target :: dum_var1 + real, dimension(100) :: dum_var2 + + begc = 1 + endc = 100 + + call random_number(dum_var2) + allocate( atm2lnd%uwind (begc:endc) ) ; atm2lnd%uwind (:) = dum_var2 + allocate( atm2lnd%vwind (begc:endc) ) ; atm2lnd%vwind (:) = dum_var2 + allocate( atm2lnd%tbot (begc:endc) ) ; atm2lnd%tbot (:) = dum_var2 + allocate( lnd2atm%lwup (begc:endc) ) ; lnd2atm%lwup (:) = dum_var2 + allocate( lnd2atm%taux (begc:endc) ) ; lnd2atm%taux (:) = dum_var2 + allocate( lnd2atm%tauy (begc:endc) ) ; lnd2atm%tauy (:) = dum_var2 + + print *, "=======================================" + print *, "=======================================" + print *, atm2lnd%uwind + + print *, "=======================================" + print *, " ... DONE ..." From c62fa26ccadd32aa08b9075897398ad827a77935 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 24 Apr 2019 11:25:46 -0600 Subject: [PATCH 073/556] saving a version implementing the derived data types... ! Not completely implemented! wq --- lilac/scripts/atmos_cap.F90 | 7 +-- lilac/scripts/demo_driver.F90 | 34 ++++++------- lilac/scripts/lilac_mod.F90 | 89 ++++++++++++++--------------------- lilac/scripts/lilac_utils.F90 | 80 ++++++++++--------------------- 4 files changed, 79 insertions(+), 131 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index d8c3c1b417..a7922057e7 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -128,10 +128,11 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) !field = ESMF_FieldCreate(lmesh,farrayPtr=x2a_fields%fields(:, n), meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) print *, trim(fldsFrCpl(n)%stdname) if (mesh_switch) then - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(fldsFrCpl(n)%stdname), farraPtr=fldsFrCpl(n)%arrayptr1d, rc=rc) + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(fldsFrCpl(n)%stdname), farrayPtr=fldsFrCpl(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - else - field = ESMF_FieldCreate(atmos_grid, name=trim(fldsFrCpl(n)%stdname), name=trim(fldsFrCpl(n)%stdname), farraPtr=fldsFrCpl(n)%arrayptr2d, rc=rc) + else + field = ESMF_FieldCreate(atmos_grid, name=trim(fldsFrCpl(n)%stdname), farrayPtr=fldsFrCpl(n)%farrayptr2d, rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, name=trim(fldsFrCpl(n)%stdname), farrayPtr=fldsFrCpl(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end if ! add field to field bundle diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index c4c45634ab..d3041578c9 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -2,35 +2,26 @@ program demo_lilac_driver ! modules use ESMF - !use Lilac_mod + use Lilac_mod - !use lilac_utils, only : atm2lnd_data1d_type , lnd2atm_data1d_type, atm2lnd_data2d_type, atm2lnd_data2d_type + use lilac_utils, only : atm2lnd_data1d_type , lnd2atm_data1d_type, atm2lnd_data2d_type, atm2lnd_data2d_type !use lilac_utils, only : atm2lnd_data2d_type implicit none - type :: atm2lnd_data1d_type - real*8, pointer :: uwind (:) - real*8, pointer :: vwind (:) - real*8, pointer :: tbot (:) - end type atm2lnd_data1d_type - - type :: lnd2atm_data1d_type - real*8, pointer :: lwup(:) - real*8, pointer :: taux(:) - real*8, pointer :: tauy(:) - end type lnd2atm_data1d_type - - type (atm2lnd_data1d_type) :: atm2lnd type (lnd2atm_data1d_type) :: lnd2atm integer :: begc,endc real, dimension(100,100), target :: dum_var1 real, dimension(100) :: dum_var2 + !------------------------------------------------------------------------ + + begc = 1 endc = 100 call random_number(dum_var2) + allocate( atm2lnd%uwind (begc:endc) ) ; atm2lnd%uwind (:) = dum_var2 allocate( atm2lnd%vwind (begc:endc) ) ; atm2lnd%vwind (:) = dum_var2 allocate( atm2lnd%tbot (begc:endc) ) ; atm2lnd%tbot (:) = dum_var2 @@ -38,12 +29,15 @@ program demo_lilac_driver allocate( lnd2atm%taux (begc:endc) ) ; lnd2atm%taux (:) = dum_var2 allocate( lnd2atm%tauy (begc:endc) ) ; lnd2atm%tauy (:) = dum_var2 - print *, "=======================================" - print *, "=======================================" - print *, atm2lnd%uwind + print *, "=======================================" + print *, atm2lnd%uwind + + + + call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) - print *, "=======================================" - print *, " ... DONE ..." + print *, "=======================================" + print *, " ............. DONE ..................." diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index c0db2dc8e2..4dae3ccb2b 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -21,70 +21,53 @@ module lilac_mod character(*), parameter :: modname = "(LilacMod)" - type atm2lnd_data1d_type - real(r8), pointer :: uwind(:) - real(r8), pointer :: vwind(:) - real(r8), pointer :: tbot(:) - end type atm2lnd_data1d_type - - type atm2lnd_data2d_type - real(r8), pointer :: uwind(:,:) - real(r8), pointer :: vwind(:,:) - real(r8), pointer :: tbot(:,:) - end type atm2lnd_data2d_type - - type lnd2atm_data1d_type - real(r8), pointer :: lwup(:) - real(r8), pointer :: taux(:) - real(r8), pointer :: tauy(:) - end type lnd2atm_data1d_type - - type lnd2atm_data2d_type - real(r8), pointer :: lwup(:,:) - real(r8), pointer :: taux(:,:) - real(r8), pointer :: tauy(:,:) - end type lnd2atm_data2d_type - - !=============================================================================== + + !------------------------------------------------------------------------ public :: lilac_init public :: lilac_run - contains - subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) + !------------------------------------------------------------------------ - use atmos_cap, only : a2l_fields !**** - use atmos_cap, only : l2a_fields !**** + contains - ! modules - implicit none + subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d - ! Component, and State - type(ESMF_GridComp) :: dummy_atmos_comp - type(ESMF_GridComp) :: dummy_land_comp - type(ESMF_CplComp) :: cpl_atm2lnd_comp - type(ESMF_CplComp) :: cpl_lnd2atm_comp + type(fld_list_type) :: a2l_fields, l2a_fields + ! ! Gridded Components and Coupling Components + type(ESMF_GridComp) :: dummy_atmos_comp + type(ESMF_GridComp) :: dummy_land_comp - type(ESMF_State) :: coupledFlowState ! the coupled flow State - type(ESMF_Mesh) :: Emesh + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp + + + type(ESMF_State) :: coupledFlowState ! the coupled flow State + type(ESMF_Mesh) :: Emesh character(len=*), parameter :: subname=trim(modname)//':(lilac_init) ' - type(ESMF_State) :: importState, exportState - type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state - type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state + type(ESMF_State) :: importState, exportState + type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state + type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state !character(len=*) :: atm_mesh_filepath !!! For now this is hard !coded in the atmos init ! local variables - integer :: rc, urc - character(len=ESMF_MAXSTR) :: cname1, cname2, cname3, cname4 - !integer, parameter :: fldsMax = 100 + integer :: rc, urc + character(len=ESMF_MAXSTR) :: cname1, cname2, cname3, cname4 + !integer, parameter :: fldsMax = 100 + integer :: fldsFrCpl_num, fldsToCpl_num + logical :: mesh_switch + + !------------------------------------------------------------------------ + + mesh_switch = .True. !------------------------------------------------------------------------- ! Initialize ESMF, set the default calendar and log type. @@ -92,8 +75,8 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "----------------------------" - print *, "lilac Demo Application Start" + print *, "---------------------------------------" + print *, " Lilac Demo Application Start " !------------------------------------------------------------------------- ! Create Field lists -- Basically create a list of fields and add a default @@ -102,14 +85,14 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) fldsFrCpl_num = 1 fldsToCpl_num = 1 - if (present(var1_a2l_1d)) then - a2l_fields%name = 'uwind' - a2l_fields%arrptr1d => atm2lnd_data1d%uwind - call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num, 'mesh') + if (.True.) then + l2a_fields%stdname = 'uwind' + l2a_fields%farrayptr1d => atm2lnd1d%uwind + !call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num) else - a2l_fields%name = 'name' - a2l_fields%arrptr2d => var1_a2l_2d - call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num, 'grid') + a2l_fields%stdname = 'name' + a2l_fields%farrayptr2d => atm2lnd2d%uwind + !call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) end if !------------------------------------------------------------------------- diff --git a/lilac/scripts/lilac_utils.F90 b/lilac/scripts/lilac_utils.F90 index aa2bdfb0d1..80a3f11db0 100644 --- a/lilac/scripts/lilac_utils.F90 +++ b/lilac/scripts/lilac_utils.F90 @@ -7,70 +7,40 @@ module lilac_utils public fldlist_add , create_fldlists - type fld_list_type + type :: fld_list_type character(len=128) :: stdname real*8 :: default_value character(len=128) :: units real*8, pointer :: farrayptr1d(:) ! this will be filled in by lilac when it gets its data from the host atm real*8, pointer :: farrayptr2d(:,:) ! this will be filled in by lilac when it gets its data from the host atm - end type fld_list_type + end type fld_list_type !!! 1d for when we have mesh and 2d for when we have grids.... - type :: atm2lnd_data1d_type - real*8, pointer :: uwind (:) - real*8, pointer :: vwind (:) - real*8, pointer :: tbot (:) - end type atm2lnd_data1d_type + type :: atm2lnd_data1d_type + real*8, pointer :: uwind (:) + real*8, pointer :: vwind (:) + real*8, pointer :: tbot (:) + end type atm2lnd_data1d_type + + type :: lnd2atm_data1d_type + real*8, pointer :: lwup (:) + real*8, pointer :: taux (:) + real*8, pointer :: tauy (:) + end type lnd2atm_data1d_type + + type :: atm2lnd_data2d_type + real*8, pointer :: uwind (:,:) + real*8, pointer :: vwind (:,:) + real*8, pointer :: tbot (:,:) + end type atm2lnd_data2d_type + + type :: lnd2atm_data2d_type + real*8, pointer :: lwup (:,:) + real*8, pointer :: taux (:,:) + real*8, pointer :: tauy (:,:) + end type lnd2atm_data2d_type - type :: lnd2atm_data1d_type - real*8, pointer :: lwup (:) - real*8, pointer :: taux (:) - real*8, pointer :: tauy (:) - end type lnd2atm_data1d_type - - type :: atm2lnd_data2d_type - real*8, pointer :: uwind (:,:) - real*8, pointer :: vwind (:,:) - real*8, pointer :: tbot (:,:) - end type atm2lnd_data1d_type - - type :: lnd2atm_data2d_type - real*8, pointer :: lwup (:,:) - real*8, pointer :: taux (:,:) - real*8, pointer :: tauy (:,:) - end type lnd2atm_data2d_type - - - - - - - - - type atm2lnd_data1d_type - real*8, pointer :: uwind(:) - real*8, pointer :: vwind(:) - real*8, pointer :: tbot(:) - end type atm2lnd_data1d_type - - type atm2lnd_data2d_type - real*8, pointer :: uwind(:,:) - real*8, pointer :: vwind(:,:) - real*8, pointer :: tbot(:,:) - end type atm2lnd_data2d_type - - type lnd2atm_data1d_type - real*8, pointer :: lwup(:) - real*8, pointer :: taux(:) - real*8, pointer :: tauy(:) - end type lnd2atm_data1d_type - - type lnd2atm_data2d_type - real*8, pointer :: lwup(:,:) - real*8, pointer :: taux(:,:) - real*8, pointer :: tauy(:,:) - end type lnd2atm_data2d_type !=============================================================================== contains !=============================================================================== From af7b62b0fdfd83517434e78fd72cea2ccc16a44e Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 24 Apr 2019 12:11:54 -0600 Subject: [PATCH 074/556] Working until the end version of the code... data types not completely implemented yet! but at least it compiles and runs ! --- lilac/scripts/atmos_cap.F90 | 1 + lilac/scripts/demo_driver.F90 | 1 + lilac/scripts/lilac_mod.F90 | 74 +++++++++++++++++------------------ lilac/scripts/lnd_cap.F90 | 2 + 4 files changed, 41 insertions(+), 37 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index a7922057e7..9a20831de4 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -121,6 +121,7 @@ subroutine atmos_init(comp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create individual fields and add to field bundle + fldsFrCpl_num = 2 do n = 1,fldsFrCpl_num ! create field !!! Here we want to pass pointers diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index d3041578c9..4c583d7ccc 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -40,6 +40,7 @@ program demo_lilac_driver print *, " ............. DONE ..................." + call ESMF_Finalize() end program demo_lilac_driver diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 4dae3ccb2b..bcbdbe8af5 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -1,9 +1,9 @@ module lilac_mod use ESMF use lilac_utils -!use DummyAtmos -use atmos_cap, only : atmos_register -use lnd_cap, only : lnd_register + +use atmos_cap , only : atmos_register +use lnd_cap , only : lnd_register use cpl_mod @@ -19,8 +19,7 @@ module lilac_mod type(ESMF_Calendar),target :: calendar integer :: yy,mm,dd,sec - character(*), parameter :: modname = "(LilacMod)" - + character(*), parameter :: modname = "lilac_mod" !------------------------------------------------------------------------ @@ -33,10 +32,10 @@ module lilac_mod subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) - type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d - type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d - type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d - type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d + type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d + type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d + type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d + type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d type(fld_list_type) :: a2l_fields, l2a_fields @@ -50,7 +49,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) type(ESMF_State) :: coupledFlowState ! the coupled flow State type(ESMF_Mesh) :: Emesh - character(len=*), parameter :: subname=trim(modname)//':(lilac_init) ' + character(len=*), parameter :: subname=trim(modname)//':[lilac_init]' type(ESMF_State) :: importState, exportState type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state @@ -60,7 +59,8 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! local variables integer :: rc, urc - character(len=ESMF_MAXSTR) :: cname1, cname2, cname3, cname4 + character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names + character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names !integer, parameter :: fldsMax = 100 integer :: fldsFrCpl_num, fldsToCpl_num logical :: mesh_switch @@ -85,9 +85,15 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) fldsFrCpl_num = 1 fldsToCpl_num = 1 + print *, "field lists: !" if (.True.) then - l2a_fields%stdname = 'uwind' - l2a_fields%farrayptr1d => atm2lnd1d%uwind + a2l_fields % stdname = 'uwind' + a2l_fields % farrayptr1d => atm2lnd1d%uwind + print *, a2l_fields%farrayptr1d + a2l_fields % stdname = 'vwind' + a2l_fields % farrayptr1d => atm2lnd1d%vwind + print *, a2l_fields%farrayptr1d + !call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num) else a2l_fields%stdname = 'name' @@ -98,39 +104,39 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) !------------------------------------------------------------------------- ! Create Gridded Component! --- dummy atmosphere !------------------------------------------------------------------------- - cname1 = "Dummy Atmosphere or Atmosphere Cap" + gcname1 = "Dummy Atmosphere or Atmosphere Cap" - dummy_atmos_comp = ESMF_GridCompCreate(name=cname1, rc=rc) + dummy_atmos_comp = ESMF_GridCompCreate(name=gcname1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname1)//" component", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Created "//trim(gcname1)//" component", ESMF_LOGMSG_INFO) print *, "Dummy Atmosphere Gridded Component Created!" !------------------------------------------------------------------------- ! Create Gridded Component! --- dummy land (land cap) !------------------------------------------------------------------------- - cname2 = "Dummy Land or Land Cap" + gcname2 = "Dummy Land or Land Cap" - dummy_land_comp = ESMF_GridCompCreate(name=cname2, rc=rc) + dummy_land_comp = ESMF_GridCompCreate(name=gcname2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Created "//trim(gcname2)//" component", ESMF_LOGMSG_INFO) print *, "Dummy Land Gridded Component Created!" !------------------------------------------------------------------------- - ! Create Gridded Component! --- Coupler from atmos to land + ! Create Coupling Component! --- Coupler from atmos to land !------------------------------------------------------------------------- - cname3 = "Coupler from atmosphere to land" - cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname3, rc=rc) + ccname1 = "Coupler from atmosphere to land" + cpl_atm2lnd_comp = ESMF_CplCompCreate(name=ccname1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname3)//" component", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Created "//trim(ccname1)//" component", ESMF_LOGMSG_INFO) print *, "1st Coupler Gridded Component (atmosphere to land ) Created!" !------------------------------------------------------------------------- - ! Create Gridded Component! -- Coupler from land to atmos + ! Create Coupling Component! -- Coupler from land to atmos !------------------------------------------------------------------------- - cname4 = "Coupler from land to atmosphere" - cpl_lnd2atm_comp = ESMF_CplCompCreate(name=cname4, rc=rc) + ccname2 = "Coupler from land to atmosphere" + cpl_lnd2atm_comp = ESMF_CplCompCreate(name=ccname2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname4)//" component", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Created "//trim(ccname2)//" component", ESMF_LOGMSG_INFO) print *, "2nd Coupler Gridded Component (land to atmosphere) Created!" ! ======================================================================== @@ -175,12 +181,9 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - - !print *, !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) !EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - !------------------------------------------------------------------------- ! Create the necessary import and export states used to pass data ! between components. @@ -188,16 +191,16 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! following 4 states are lilac module variables - atm2lnd_a_state = ESMF_StateCreate(name=cname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + atm2lnd_a_state = ESMF_StateCreate(name=gcname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - atm2lnd_l_state = ESMF_StateCreate(name=cname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + atm2lnd_l_state = ESMF_StateCreate(name=gcname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - lnd2atm_a_state = ESMF_StateCreate(name=cname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + lnd2atm_a_state = ESMF_StateCreate(name=gcname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - lnd2atm_l_state = ESMF_StateCreate(name=cname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + lnd2atm_l_state = ESMF_StateCreate(name=gcname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -205,7 +208,6 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call ESMF_LogWrite(subname//"Empty import and export states are created!!", ESMF_LOGMSG_INFO) print *, "Empty import and export states are created!!" - !, dum_var1= dum_var1, dum_var2= dum_var2) ! returns a valid state_to_lnd_atm and an empty state_from_land_atmgrid ! ======================================================================== !------------------------------------------------------------------------- @@ -218,13 +220,11 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp initialized", ESMF_LOGMSG_INFO) print *, "atmos_cap initialize finished, rc =", rc - call ESMF_GridCompInitialize(dummy_land_comp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp initialized", ESMF_LOGMSG_INFO) print *, "lnd_cap initialize finished, rc =", rc - ! All 4 states that are module variables are no longer empty - have been initialized call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index 74545bf281..b1c7de725b 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -68,6 +68,8 @@ subroutine lnd_init(comp, importState, exportState, clock, rc) print *, " Empty land is created !!!!" rc = ESMF_SUCCESS + call ESMF_GridCompGet(comp, petcount=petcount, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) print *, "in land routine routine" From 4b97ae74b4c3da5ddcf12f9ef95e4c1779e7a183 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 24 Apr 2019 13:34:49 -0600 Subject: [PATCH 075/556] working to the end... data types not completely impletemented. compiles and runs to final! --- lilac/scripts/atmos_cap.F90 | 398 +++++++++++++++++----------------- lilac/scripts/demo_driver.F90 | 3 +- lilac/scripts/lilac_mod.F90 | 4 +- 3 files changed, 199 insertions(+), 206 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 9a20831de4..9ab6c07026 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -1,240 +1,232 @@ module atmos_cap - use ESMF - use lilac_utils + use ESMF + use lilac_utils - implicit none + implicit none - character(*), parameter :: modname = "(atmos_cap)" + character(*), parameter :: modname = "atmos_cap" - !!integer, parameter :: fldsMax = 100 + !!integer, parameter :: fldsMax = 100 - type(ESMF_Field), public, save :: field - type(ESMF_Field), public, save :: field_sie, field_u + type(ESMF_Field), public, save :: field + type(ESMF_Field), public, save :: field_sie, field_u - type(fld_list_type), allocatable :: x2a_fields(:) - type(fld_list_type), allocatable :: a2x_fields(:) + type(fld_list_type), allocatable :: l2a_fields(:) + type(fld_list_type), allocatable :: a2l_fields(:) - !private + !private - public atmos_register - !public :: add_fields - !public :: import_fields - !public :: export_fields + public :: atmos_register + !public :: add_fields + !public :: import_fields + !public :: export_fields - contains - subroutine atmos_register(comp, rc) + !------------------------------------------------------------------------ - type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' + contains - print *, "in user register routine" + subroutine atmos_register (comp, rc) - rc = ESMF_SUCCESS - ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc + character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_atm_to_lilac, phase=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, "in user register routine" - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_lilac_to_atm, phase=2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + rc = ESMF_SUCCESS + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_atm_to_lilac, phase=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end subroutine atmos_register + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_lilac_to_atm, phase=2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - subroutine atmos_init(comp, importState, exportState, clock, rc) - type (ESMF_GridComp) :: comp - type (ESMF_State) :: importState, exportState - type (ESMF_Clock) :: clock - integer, intent(out) :: rc + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! local variables - !!! TODO: Maybe it is better to call these fldsToAtm and fldsFrAtm - type (fld_list_type) :: fldsToCpl(fldsMax) - type (fld_list_type) :: fldsFrCpl(fldsMax) - integer :: fldsToCpl_num - integer :: fldsFrCpl_num - type (ESMF_FieldBundle) :: FBout - integer :: n - type(ESMF_Mesh) :: atmos_mesh - character(len=ESMF_MAXSTR) :: atmos_mesh_filepath - integer :: petCount, localrc, urc - integer :: mid, by2, quart, by4 - type(ESMF_Grid) :: atmos_grid - type(ESMF_DistGrid) :: distgridIN, distgridFS - logical :: mesh_switch - character(len=*), parameter :: subname=trim(modname)//':(atmos_init) ' - !---------------------- + end subroutine atmos_register + + + + subroutine atmos_init (comp, importState, exportState, clock, rc) + + type (ESMF_GridComp) :: comp + type (ESMF_State) :: importState, exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + !!! TODO: Maybe it is better to call these fldsToAtm and fldsFrAtm + type (fld_list_type) :: flds_a2l(fldsMax) + type (fld_list_type) :: flds_l2a(fldsMax) + integer :: flds_a2l_num + integer :: flds_l2a_num + type (ESMF_FieldBundle) :: l2a_fb , a2l_fb + integer :: n + type(ESMF_Mesh) :: atmos_mesh + character(len=ESMF_MAXSTR) :: atmos_mesh_filepath + integer :: petCount, localrc, urc + integer :: mid, by2, quart, by4 + type(ESMF_Grid) :: atmos_grid + type(ESMF_DistGrid) :: distgridIN, distgridFS + logical :: mesh_switch + character(len=*), parameter :: subname=trim(modname)//':[atmos_init] ' + !---------------------- + + !integer :: regDecomp(:,:) + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_GridCompGet (comp, petcount=petcount, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !------------------------------------------------------------------------- + ! Generate -- Read in the mesh + !------------------------------------------------------------------------- + mesh_switch = .True. + + if(mesh_switch) then + ! For now this is our dummy mesh: + atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + + atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) + print *, "!Mesh for atmosphere is created!" + + else + !Grid1= ESMF_GridCreateNoPeriDimUfrmR( maxIndex=(/180,360 /), & + ! minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & + ! maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & + ! regDecomp=(/petcount,1/), rc=rc) + + atmos_grid = ESMF_GridCreateNoPeriDimUfrm( minIndex= (/1,1/), maxIndex=(/180,360 /), & + maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & + minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & + coordSys=ESMF_COORDSYS_CART,& + regDecomp=(/1,petcount/),& + rc=rc) + call ESMF_LogWrite(subname//"Grid for atmosphere is created!", ESMF_LOGMSG_INFO) + print *, "Grid for atmosphere is created!" + endif + + !------------------------------------------------------------------------- + ! Coupler (land) to Atmosphere Fields -- l2a + ! I- Create Field Bundle -- l2a_fb for now + ! II- Create Fields and add them to field bundle + ! III - Add l2a_fb to state (l2a_state) + !------------------------------------------------------------------------- + + l2a_fb = ESMF_FieldBundleCreate (name="l2a_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !integer :: regDecomp(:,:) - ! Initialize return code - rc = ESMF_SUCCESS + ! Create individual fields and add to field bundle + flds_l2a_num = 2 + do n = 1,flds_l2a_num + ! create field + !!! Here we want to pass pointers + print *, trim(flds_l2a(n)%stdname) + if (mesh_switch) then + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(flds_l2a(n)%stdname), farrayPtr=flds_l2a(n)%farrayptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + else + field = ESMF_FieldCreate(atmos_grid, name=trim(flds_l2a(n)%stdname), farrayPtr=flds_l2a(n)%farrayptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if + ! add field to field bundle + call ESMF_FieldBundleAdd(l2a_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + enddo + print *, "!Fields For Coupler (flds_l2a) Field Bundle Created!" + + ! Add FB to state + call ESMF_StateAdd(exportState, (/l2a_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + ! Atmosphere to Coupler Fields + a2l_fb = ESMF_FieldBundleCreate(name="a2l_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridCompGet(comp, petcount=petcount, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + !------------------------------------------------------------------------- + ! Create individual states and add to field bundle -- a2l + !------------------------------------------------------------------------- - !------------------------------------------------------------------------- - ! Generate -- Read in the mesh - !------------------------------------------------------------------------- + !call fldlist_add(flds_a2l_num, flds_a2l, 'dum_var2' ) - mesh_switch = .false. - if(mesh_switch) then - ! For now this is our dummy mesh: - atmos_mesh_filepath='/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + do n = 1,flds_a2l_num + ! create field + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(flds_a2l(n)%stdname), farrayPtr=flds_a2l(n)%farrayptr1d, rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(flds_a2l(n)%stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! initialize with default value + !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + !fldptr = flds_a2l(n)%default_value - atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + ! add field to field bundle + call ESMF_FieldBundleAdd(a2l_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + enddo + + + print *, "!Fields to Coupler (flds_a2l) Field Bundle Created!" + + ! Add FB to state + call ESMF_StateAdd(importState, (/a2l_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) - print *, "!Mesh for atmosphere is created!" - - else - !Grid1= ESMF_GridCreateNoPeriDimUfrmR( maxIndex=(/180,360 /), & - ! minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & - ! maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & - ! regDecomp=(/petcount,1/), rc=rc) - - atmos_grid = ESMF_GridCreateNoPeriDimUfrm( minIndex= (/1,1/), maxIndex=(/180,360 /), & - maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & - minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & - coordSys=ESMF_COORDSYS_CART,& - regDecomp=(/1,petcount/),& - rc=rc) - - call ESMF_LogWrite(subname//"Grid for atmosphere is created!", ESMF_LOGMSG_INFO) - print *, "Grid for atmosphere is created!" - endif - - !------------------------------------------------------------------------- - ! Coupler (land) to Atmosphere Fields -- x2a - ! I- Create Field Bundle -- FBout for now-- TODO: negin want to rename to x2a_fieldbundle - ! II- Create Fields and add them to field bundle - ! III - Add FBout to state (x2a_state) - !------------------------------------------------------------------------- - FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Create individual fields and add to field bundle - fldsFrCpl_num = 2 - do n = 1,fldsFrCpl_num - ! create field - !!! Here we want to pass pointers - !field = ESMF_FieldCreate(Emesh,farrayPtr=dum_var1_ptr, meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(lmesh,farrayPtr=x2a_fields%fields(:, n), meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsFrCpl(n)%stdname), rc=rc) - print *, trim(fldsFrCpl(n)%stdname) - if (mesh_switch) then - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(fldsFrCpl(n)%stdname), farrayPtr=fldsFrCpl(n)%farrayptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - else - field = ESMF_FieldCreate(atmos_grid, name=trim(fldsFrCpl(n)%stdname), farrayPtr=fldsFrCpl(n)%farrayptr2d, rc=rc) - !field = ESMF_FieldCreate(atmos_mesh, name=trim(fldsFrCpl(n)%stdname), farrayPtr=fldsFrCpl(n)%farrayptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end if - ! add field to field bundle - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - enddo - print *, "!Fields For Coupler (fldsFrCpl) Field Bundle Created!" - - ! Add FB to state - call ESMF_StateAdd(exportState, (/FBout/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Atmosphere to Coupler Fields - FBout = ESMF_FieldBundleCreate(name="a2x_fields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- - ! Create individual states and add to field bundle - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- - - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'dum_var2' ) - do n = 1,fldsToCpl_num - ! create field - !field = ESMF_FieldCreate(lmesh, farrayPtr=a2x_field%fields(:,n) , meshloc=ESMF_MESHLOC_ELEMENT, name=trim(fldsToCpl(n)%stdname), rc=rc) - field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldsToCpl(n)%stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! initialize with default value - !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !fldptr = fldsToCpl(n)%default_value - - ! add field to field bundle - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - enddo - - - print *, "!Fields to Coupler (fldstoCpl) Field Bundle Created!" - - ! Add FB to state - call ESMF_StateAdd(importState, (/FBout/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!a2x_state is filld with dummy_var field bundle!" - - end subroutine atmos_init - - subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_atm_to_lilac) ' - - ! Initialize return code - rc = ESMF_SUCCESS -! get a list of fields of variables we need from atmos.... -! - !call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) - - ! loop over fields, copying pointer from import to export state - - end subroutine atmos_copy_atm_to_lilac - - subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_lilac_to_atm) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine atmos_copy_lilac_to_atm - - subroutine atmos_final(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc + print *, "!a2l_state is filld with dummy_var field bundle!" + end subroutine atmos_init + + subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_atm_to_lilac) ' + + ! Initialize return code + rc = ESMF_SUCCESS + ! get a list of fields of variables we need from atmos.... + ! + !call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) + + ! loop over fields, copying pointer from import to export state + end subroutine atmos_copy_atm_to_lilac + + subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':(atmos_final) ' + character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_lilac_to_atm) ' - ! Initialize return code - rc = ESMF_SUCCESS + ! Initialize return code + rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"atmos_final has not been implemented yet", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) + end subroutine atmos_copy_lilac_to_atm - end subroutine atmos_final - !=============================================================================== + subroutine atmos_final(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + character(len=*), parameter :: subname=trim(modname)//':(atmos_final) ' + ! Initialize return code + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"atmos_final has not been implemented yet", ESMF_LOGMSG_INFO) + end subroutine atmos_final end module atmos_cap diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 4c583d7ccc..3182bb2f7b 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -22,9 +22,10 @@ program demo_lilac_driver call random_number(dum_var2) - allocate( atm2lnd%uwind (begc:endc) ) ; atm2lnd%uwind (:) = dum_var2 + allocate( atm2lnd%uwind (begc:endc) ) ; atm2lnd%uwind (:) = dum_var2 allocate( atm2lnd%vwind (begc:endc) ) ; atm2lnd%vwind (:) = dum_var2 allocate( atm2lnd%tbot (begc:endc) ) ; atm2lnd%tbot (:) = dum_var2 + allocate( lnd2atm%lwup (begc:endc) ) ; lnd2atm%lwup (:) = dum_var2 allocate( lnd2atm%taux (begc:endc) ) ; lnd2atm%taux (:) = dum_var2 allocate( lnd2atm%tauy (begc:endc) ) ; lnd2atm%tauy (:) = dum_var2 diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index bcbdbe8af5..f32e3db050 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -242,8 +242,8 @@ end subroutine lilac_init subroutine lilac_run(dum_var1, dum_var2) - use atmos_cap, only : x2a_fields - use atmos_cap, only : a2x_fields + use atmos_cap, only : l2a_fields + use atmos_cap, only : a2l_fields real, dimension(:,:) :: dum_var1 ! from host atm real, dimension(:,:) :: dum_var2 ! to host atm From 202c07aed60c9e33f016fa9c78e41ae19c8f6569 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 24 Apr 2019 13:37:53 -0600 Subject: [PATCH 076/556] after mariana's help... But does not compile... --- lilac/scripts/lilac_mod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index f32e3db050..76a068642d 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -32,13 +32,15 @@ module lilac_mod subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) + use atmos_cap, only : a2l_fields, l2a_fields + + ! input/output variables type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d - - type(fld_list_type) :: a2l_fields, l2a_fields + ! local variables ! ! Gridded Components and Coupling Components type(ESMF_GridComp) :: dummy_atmos_comp type(ESMF_GridComp) :: dummy_land_comp @@ -88,7 +90,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) print *, "field lists: !" if (.True.) then a2l_fields % stdname = 'uwind' - a2l_fields % farrayptr1d => atm2lnd1d%uwind + a2l_fields % farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 print *, a2l_fields%farrayptr1d a2l_fields % stdname = 'vwind' a2l_fields % farrayptr1d => atm2lnd1d%vwind From e85dcdcc484f1d08f242f34bada98ec359ab2413 Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 29 Apr 2019 13:10:32 -0600 Subject: [PATCH 077/556] saving some changes... and it is compiling and working.... --- lilac/scripts/atmos_cap.F90 | 5 +++++ lilac/scripts/lilac_mod.F90 | 34 ++++++++++++++++++++++------------ 2 files changed, 27 insertions(+), 12 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 9ab6c07026..3d177d3ab6 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -2,6 +2,7 @@ module atmos_cap use ESMF use lilac_utils + !use lilac_mod, only : a2l_fields implicit none @@ -13,6 +14,10 @@ module atmos_cap type(ESMF_Field), public, save :: field type(ESMF_Field), public, save :: field_sie, field_u + !type(fld_list_type), public, allocatable :: l2a_fields(:) + !type(fld_list_type), public, allocatable :: a2l_fields(:) + !type(fld_list_type), public, save :: l2a_fields(:) + !type(fld_list_type), public, save :: a2l_fields(:) type(fld_list_type), allocatable :: l2a_fields(:) type(fld_list_type), allocatable :: a2l_fields(:) diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 76a068642d..63f715faa0 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -20,6 +20,7 @@ module lilac_mod integer :: yy,mm,dd,sec character(*), parameter :: modname = "lilac_mod" + !type(fld_list_type), public :: a2l_fields, l2a_fields !------------------------------------------------------------------------ @@ -33,7 +34,7 @@ module lilac_mod subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) use atmos_cap, only : a2l_fields, l2a_fields - + ! type(fld_list_type) :: a2l_fields , l2a_fields ! input/output variables type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d @@ -64,7 +65,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names !integer, parameter :: fldsMax = 100 - integer :: fldsFrCpl_num, fldsToCpl_num + integer :: a2l_fldnum, l2a_fldnum logical :: mesh_switch !------------------------------------------------------------------------ @@ -84,22 +85,31 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! Create Field lists -- Basically create a list of fields and add a default ! value to them. !------------------------------------------------------------------------- - fldsFrCpl_num = 1 - fldsToCpl_num = 1 + a2l_fldnum = 3 + l2a_fldnum = 3 + + allocate (a2l_fields(a2l_fldnum)) + allocate (l2a_fields(l2a_fldnum)) print *, "field lists: !" +! call create_fldlists(l2a_fields, a2l_fields, a2l_fldnum, l2a_fldnum) + + if (.True.) then - a2l_fields % stdname = 'uwind' - a2l_fields % farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 - print *, a2l_fields%farrayptr1d - a2l_fields % stdname = 'vwind' - a2l_fields % farrayptr1d => atm2lnd1d%vwind - print *, a2l_fields%farrayptr1d + a2l_fields(1)%stdname = 'uwind' + a2l_fields(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 + a2l_fields(2)%stdname = 'vwind' + a2l_fields(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 + print *, a2l_fields(1)%stdname + print *, a2l_fields(1)%farrayptr1d(:) +! a2l_fields(3)%stdname = 'vwind' +! a2l_fields(3)%farrayptr1d => atm2lnd1d%vwind +! print *, a2l_fields(3)%farrayptr1d !call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num) else - a2l_fields%stdname = 'name' - a2l_fields%farrayptr2d => atm2lnd2d%uwind + a2l_fields(1)%stdname = 'name' + a2l_fields(1)%farrayptr2d => atm2lnd2d%uwind !call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) end if From 53260be2c292db4ba3cb33102f10f46c8b341b51 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 30 Apr 2019 10:53:09 -0600 Subject: [PATCH 078/556] saving my progress.... --- lilac/scripts/atmos_cap.F90 | 55 +++++++++++++++++++++---------------- lilac/scripts/lilac_mod.F90 | 31 +++++++++++---------- 2 files changed, 48 insertions(+), 38 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 3d177d3ab6..2e3c246442 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -14,12 +14,16 @@ module atmos_cap type(ESMF_Field), public, save :: field type(ESMF_Field), public, save :: field_sie, field_u - !type(fld_list_type), public, allocatable :: l2a_fields(:) - !type(fld_list_type), public, allocatable :: a2l_fields(:) - !type(fld_list_type), public, save :: l2a_fields(:) - !type(fld_list_type), public, save :: a2l_fields(:) - type(fld_list_type), allocatable :: l2a_fields(:) - type(fld_list_type), allocatable :: a2l_fields(:) + type(fld_list_type), public, allocatable :: l2a_fields(:) + type(fld_list_type), public, allocatable :: a2l_fields(:) + !type(fld_list_type), allocatable :: l2a_fields(:) + !type(fld_list_type), allocatable :: a2l_fields(:) + + + !type (fld_list_type) :: a2l_fields(fldsMax) + !type (fld_list_type) :: l2a_fields(fldsMax) + integer :: a2l_fields_num + integer :: l2a_fields_num !private @@ -67,11 +71,6 @@ subroutine atmos_init (comp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - !!! TODO: Maybe it is better to call these fldsToAtm and fldsFrAtm - type (fld_list_type) :: flds_a2l(fldsMax) - type (fld_list_type) :: flds_l2a(fldsMax) - integer :: flds_a2l_num - integer :: flds_l2a_num type (ESMF_FieldBundle) :: l2a_fb , a2l_fb integer :: n type(ESMF_Mesh) :: atmos_mesh @@ -132,30 +131,32 @@ subroutine atmos_init (comp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create individual fields and add to field bundle - flds_l2a_num = 2 - do n = 1,flds_l2a_num + l2a_fields_num = 2 + do n = 1,l2a_fields_num ! create field !!! Here we want to pass pointers - print *, trim(flds_l2a(n)%stdname) + print *, trim(l2a_fields(n)%stdname) if (mesh_switch) then - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(flds_l2a(n)%stdname), farrayPtr=flds_l2a(n)%farrayptr1d, rc=rc) + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(l2a_fields(n)%stdname), farrayPtr=l2a_fields(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out else - field = ESMF_FieldCreate(atmos_grid, name=trim(flds_l2a(n)%stdname), farrayPtr=flds_l2a(n)%farrayptr2d, rc=rc) + field = ESMF_FieldCreate(atmos_grid, name=trim(l2a_fields(n)%stdname), farrayPtr=l2a_fields(n)%farrayptr2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end if ! add field to field bundle call ESMF_FieldBundleAdd(l2a_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out enddo - print *, "!Fields For Coupler (flds_l2a) Field Bundle Created!" + print *, "!Fields For Coupler (l2a_fields) Field Bundle Created!" ! Add FB to state call ESMF_StateAdd(exportState, (/l2a_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !------------------------------------------------------------------------- ! Atmosphere to Coupler Fields + !------------------------------------------------------------------------- a2l_fb = ESMF_FieldBundleCreate(name="a2l_fields", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -163,16 +164,24 @@ subroutine atmos_init (comp, importState, exportState, clock, rc) ! Create individual states and add to field bundle -- a2l !------------------------------------------------------------------------- - !call fldlist_add(flds_a2l_num, flds_a2l, 'dum_var2' ) + !call fldlist_add(a2l_fields_num, a2l_fields, 'dum_var2' ) + a2l_fields_num = 3 - do n = 1,flds_a2l_num + do n = 1,a2l_fields_num ! create field - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(flds_a2l(n)%stdname), farrayPtr=flds_a2l(n)%farrayptr1d, rc=rc) - !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(flds_a2l(n)%stdname), rc=rc) + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2l_fields(n)%stdname), farrayPtr=a2l_fields(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2l_fields(n)%stdname), rc=rc) ! initialize with default value + print *, "==========================================================" + print *, "**********************************************************" + print *, "a2l_fields as shown in the atmos_cap" + print *, a2l_fields(n)%stdname + print *, a2l_fields(n)%farrayptr1d + print *, "**********************************************************" + print *, "==========================================================" !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) - !fldptr = flds_a2l(n)%default_value + !fldptr = a2l_fields(n)%default_value ! add field to field bundle call ESMF_FieldBundleAdd(a2l_fb, (/field/), rc=rc) @@ -180,7 +189,7 @@ subroutine atmos_init (comp, importState, exportState, clock, rc) enddo - print *, "!Fields to Coupler (flds_a2l) Field Bundle Created!" + print *, "!Fields to Coupler (a2l_fields) Field Bundle Created!" ! Add FB to state call ESMF_StateAdd(importState, (/a2l_fb/), rc=rc) diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 63f715faa0..0f8667ae3f 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -42,7 +42,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d ! local variables - ! ! Gridded Components and Coupling Components + ! ! Gridded Components and Coupling Components type(ESMF_GridComp) :: dummy_atmos_comp type(ESMF_GridComp) :: dummy_land_comp @@ -50,14 +50,14 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) type(ESMF_CplComp) :: cpl_lnd2atm_comp - type(ESMF_State) :: coupledFlowState ! the coupled flow State - type(ESMF_Mesh) :: Emesh - character(len=*), parameter :: subname=trim(modname)//':[lilac_init]' - type(ESMF_State) :: importState, exportState - type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state - type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state + type(ESMF_State) :: coupledFlowState ! the coupled flow State + type(ESMF_Mesh) :: Emesh + character(len=*), parameter :: subname=trim(modname)//':[lilac_init]' + type(ESMF_State) :: importState, exportState + type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state + type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state - !character(len=*) :: atm_mesh_filepath !!! For now this is hard + !character(len=*) :: atm_mesh_filepath !!! For now this is hard !coded in the atmos init ! local variables @@ -98,13 +98,16 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) if (.True.) then a2l_fields(1)%stdname = 'uwind' a2l_fields(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 - a2l_fields(2)%stdname = 'vwind' - a2l_fields(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 print *, a2l_fields(1)%stdname print *, a2l_fields(1)%farrayptr1d(:) -! a2l_fields(3)%stdname = 'vwind' -! a2l_fields(3)%farrayptr1d => atm2lnd1d%vwind -! print *, a2l_fields(3)%farrayptr1d + a2l_fields(2)%stdname = 'vwind' + a2l_fields(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 + print *, a2l_fields(2)%stdname + print *, a2l_fields(2)%farrayptr1d(:) + a2l_fields(3)%stdname = 'tbot' + a2l_fields(3)%farrayptr1d => atm2lnd1d%vwind + print *, a2l_fields(3)%stdname + print *, a2l_fields(3)%farrayptr1d !call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num) else @@ -215,8 +218,6 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) lnd2atm_l_state = ESMF_StateCreate(name=gcname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_LogWrite(subname//"Empty import and export states are created!!", ESMF_LOGMSG_INFO) print *, "Empty import and export states are created!!" From 74fbe723549f1605b49abee5a24c3dac6153667d Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 30 Apr 2019 12:06:48 -0600 Subject: [PATCH 079/556] again saving .... --- lilac/scripts/atmos_cap.F90 | 105 +++++++++++++++++++--------------- lilac/scripts/lilac_utils.F90 | 14 ++--- 2 files changed, 66 insertions(+), 53 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 2e3c246442..f904e428a7 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -120,6 +120,50 @@ subroutine atmos_init (comp, importState, exportState, clock, rc) print *, "Grid for atmosphere is created!" endif + !------------------------------------------------------------------------- + ! Atmosphere to Coupler (land) Fields -- a2l + ! I- Create empty field bundle -- a2l_fb + ! II- Create Fields and add them to field bundle + ! III - Add a2l_fb to state (a2l_state) + !------------------------------------------------------------------------- + + a2l_fb = ESMF_FieldBundleCreate(name="a2l_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Create individual fields and add to field bundle -- a2l + + !call fldlist_add(a2l_fields_num, a2l_fields, 'dum_var2' ) + a2l_fields_num = 3 + + do n = 1,a2l_fields_num + + ! create field + !!! Here we want to pass pointers + field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2l_fields(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2l_fields(n)%stdname), farrayPtr=a2l_fields(n)%farrayptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + !fldptr = a2l_fields(n)%default_value + + ! add field to field bundle + call ESMF_FieldBundleAdd(a2l_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + print *, "**********************************************************" + print *, "creating field for a2l:" + print *, trim(a2l_fields(n)%stdname) + print *, a2l_fields(n)%farrayptr1d + + enddo + + print *, "!Fields to Coupler (atmo to land ) (a2l_fb) Field Bundle Created!" + + ! Add field bundle to state + call ESMF_StateAdd(exportState, (/a2l_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, "!a2l_state is filld with dummy_var field bundle!" + !------------------------------------------------------------------------- ! Coupler (land) to Atmosphere Fields -- l2a ! I- Create Field Bundle -- l2a_fb for now @@ -130,14 +174,16 @@ subroutine atmos_init (comp, importState, exportState, clock, rc) l2a_fb = ESMF_FieldBundleCreate (name="l2a_fields", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! Create individual fields and add to field bundle - l2a_fields_num = 2 + ! Create individual fields and add to field bundle -- l2a + l2a_fields_num = 3 + do n = 1,l2a_fields_num + ! create field !!! Here we want to pass pointers - print *, trim(l2a_fields(n)%stdname) if (mesh_switch) then - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(l2a_fields(n)%stdname), farrayPtr=l2a_fields(n)%farrayptr1d, rc=rc) + field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(l2a_fields(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(l2a_fields(n)%stdname), farrayPtr=l2a_fields(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out else field = ESMF_FieldCreate(atmos_grid, name=trim(l2a_fields(n)%stdname), farrayPtr=l2a_fields(n)%farrayptr2d, rc=rc) @@ -146,55 +192,22 @@ subroutine atmos_init (comp, importState, exportState, clock, rc) ! add field to field bundle call ESMF_FieldBundleAdd(l2a_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - enddo - print *, "!Fields For Coupler (l2a_fields) Field Bundle Created!" - - ! Add FB to state - call ESMF_StateAdd(exportState, (/l2a_fb/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - - !------------------------------------------------------------------------- - ! Atmosphere to Coupler Fields - !------------------------------------------------------------------------- - a2l_fb = ESMF_FieldBundleCreate(name="a2l_fields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - !------------------------------------------------------------------------- - ! Create individual states and add to field bundle -- a2l - !------------------------------------------------------------------------- - - !call fldlist_add(a2l_fields_num, a2l_fields, 'dum_var2' ) - a2l_fields_num = 3 - do n = 1,a2l_fields_num - ! create field - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2l_fields(n)%stdname), farrayPtr=a2l_fields(n)%farrayptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2l_fields(n)%stdname), rc=rc) - ! initialize with default value - print *, "==========================================================" - print *, "**********************************************************" - print *, "a2l_fields as shown in the atmos_cap" - print *, a2l_fields(n)%stdname - print *, a2l_fields(n)%farrayptr1d print *, "**********************************************************" - print *, "==========================================================" - !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) - !fldptr = a2l_fields(n)%default_value + print *, "creating field for l2a:" + print *, trim(l2a_fields(n)%stdname) + print *, l2a_fields(n)%farrayptr1d - ! add field to field bundle - call ESMF_FieldBundleAdd(a2l_fb, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out enddo + print *, "!Fields For Coupler (l2a_fields) Field Bundle Created!" - print *, "!Fields to Coupler (a2l_fields) Field Bundle Created!" - - ! Add FB to state - call ESMF_StateAdd(importState, (/a2l_fb/), rc=rc) + ! Add field bundle to state + call ESMF_StateAdd(importState, (/l2a_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!a2l_state is filld with dummy_var field bundle!" + print *, "!l2a_state is filld with dummy_var field bundle!" + + end subroutine atmos_init subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) diff --git a/lilac/scripts/lilac_utils.F90 b/lilac/scripts/lilac_utils.F90 index 80a3f11db0..266b654532 100644 --- a/lilac/scripts/lilac_utils.F90 +++ b/lilac/scripts/lilac_utils.F90 @@ -7,13 +7,13 @@ module lilac_utils public fldlist_add , create_fldlists - type :: fld_list_type - character(len=128) :: stdname - real*8 :: default_value - character(len=128) :: units - real*8, pointer :: farrayptr1d(:) ! this will be filled in by lilac when it gets its data from the host atm - real*8, pointer :: farrayptr2d(:,:) ! this will be filled in by lilac when it gets its data from the host atm - end type fld_list_type + type :: fld_list_type + character(len=128) :: stdname + real*8 :: default_value + character(len=128) :: units + real(ESMF_KIND_R8), pointer :: farrayptr1d(:) ! this will be filled in by lilac when it gets its data from the host atm + real(ESMF_KIND_R8), pointer :: farrayptr2d(:,:) ! this will be filled in by lilac when it gets its data from the host atm + end type fld_list_type !!! 1d for when we have mesh and 2d for when we have grids.... From 99766558ed27be71b1b4304286e299a7689ceafd Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 30 Apr 2019 12:50:37 -0600 Subject: [PATCH 080/556] setting land init part..... --- lilac/scripts/atmos_cap.F90 | 14 ++--- lilac/scripts/lnd_cap.F90 | 116 ++++++++++++++++++++++++++++++++++-- 2 files changed, 118 insertions(+), 12 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index f904e428a7..7592f757e0 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -63,10 +63,10 @@ end subroutine atmos_register - subroutine atmos_init (comp, importState, exportState, clock, rc) - + !subroutine atmos_init (comp, importState, exportState, clock, rc) + subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) type (ESMF_GridComp) :: comp - type (ESMF_State) :: importState, exportState + type (ESMF_State) :: lnd2atm_a_state, atm2lnd_a_state type (ESMF_Clock) :: clock integer, intent(out) :: rc @@ -91,7 +91,7 @@ subroutine atmos_init (comp, importState, exportState, clock, rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) !------------------------------------------------------------------------- - ! Generate -- Read in the mesh + ! Read in the mesh ----or----- Generate the grid !------------------------------------------------------------------------- mesh_switch = .True. @@ -157,10 +157,10 @@ subroutine atmos_init (comp, importState, exportState, clock, rc) enddo - print *, "!Fields to Coupler (atmo to land ) (a2l_fb) Field Bundle Created!" + print *, "!Fields to Coupler (atmos to land ) (a2l_fb) Field Bundle Created!" ! Add field bundle to state - call ESMF_StateAdd(exportState, (/a2l_fb/), rc=rc) + call ESMF_StateAdd(atm2lnd_a_state, (/a2l_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "!a2l_state is filld with dummy_var field bundle!" @@ -203,7 +203,7 @@ subroutine atmos_init (comp, importState, exportState, clock, rc) print *, "!Fields For Coupler (l2a_fields) Field Bundle Created!" ! Add field bundle to state - call ESMF_StateAdd(importState, (/l2a_fb/), rc=rc) + call ESMF_StateAdd(lnd2atm_a_state, (/l2a_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "!l2a_state is filld with dummy_var field bundle!" diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index b1c7de725b..8a4106a658 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -51,12 +51,18 @@ end subroutine lnd_register ! land init !------------------------------------------------------------------------- - subroutine lnd_init(comp, importState, exportState, clock, rc) + subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) + + use atmos_cap, only : a2l_fields, l2a_fields type (ESMF_GridComp) :: comp - type (ESMF_State) :: importState, exportState + type (ESMF_State) :: atm2lnd_l_state, lnd2atm_l_state type (ESMF_Clock) :: clock integer, intent(out) :: rc + type (ESMF_FieldBundle) :: l2a_fb , a2l_fb + integer :: n + + logical mesh_switch integer :: petCount, localrc, urc type(ESMF_Mesh) :: lnd_mesh @@ -66,6 +72,12 @@ subroutine lnd_init(comp, importState, exportState, clock, rc) type(ESMF_Grid) :: lnd_grid + integer :: a2l_fields_num + integer :: l2a_fields_num + + + + print *, " Empty land is created !!!!" rc = ESMF_SUCCESS call ESMF_GridCompGet(comp, petcount=petcount, rc=rc) @@ -76,12 +88,13 @@ subroutine lnd_init(comp, importState, exportState, clock, rc) !------------------------------------------------------------------------- ! Read in the mesh ----or----- Generate the grid !------------------------------------------------------------------------- - mesh_switch = .false. + mesh_switch = .true. if(mesh_switch) then + print *, "creating mesh for land" ! For now this is our dummy mesh: - lnd_mesh_filepath='/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' - lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Mesh for land is created!", ESMF_LOGMSG_INFO) print *, "!Mesh for land is created!" @@ -97,6 +110,99 @@ subroutine lnd_init(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"Grid for land is created!", ESMF_LOGMSG_INFO) print *, "Grid for land is created!" endif + + + + !------------------------------------------------------------------------- + ! Coupler (land) to Atmosphere Fields -- l2a + ! I- Create Field Bundle -- l2a_fb for now + ! II- Create Fields and add them to field bundle + ! III - Add l2a_fb to state (l2a_state) + !------------------------------------------------------------------------- + + l2a_fb = ESMF_FieldBundleCreate (name="l2a_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Create individual fields and add to field bundle -- l2a + l2a_fields_num = 3 + + do n = 1,l2a_fields_num + + ! create field + !!! Here we want to pass pointers + if (mesh_switch) then + field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(l2a_fields(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(l2a_fields(n)%stdname), farrayPtr=l2a_fields(n)%farrayptr1d, rc= + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + else + field = ESMF_FieldCreate(lnd_grid, name=trim(l2a_fields(n)%stdname), farrayPtr=l2a_fields(n)%farrayptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if + ! add field to field bundle + call ESMF_FieldBundleAdd(l2a_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + print *, "**********************************************************" + print *, "creating field for l2a:" + print *, trim(l2a_fields(n)%stdname) + print *, l2a_fields(n)%farrayptr1d + + enddo + + print *, "!Fields For Coupler (l2a_fields) Field Bundle Created!" + + ! Add field bundle to state + call ESMF_StateAdd(lnd2atm_l_state, (/l2a_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, "!l2a_state is filld with dummy_var field bundle!" + + + !------------------------------------------------------------------------- + ! Atmosphere to Coupler (land) Fields -- a2l + ! I- Create empty field bundle -- a2l_fb + ! II- Create Fields and add them to field bundle + ! III - Add a2l_fb to state (a2l_state) + !------------------------------------------------------------------------- + + a2l_fb = ESMF_FieldBundleCreate(name="a2l_fields", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Create individual fields and add to field bundle -- a2l + + !call fldlist_add(a2l_fields_num, a2l_fields, 'dum_var2' ) + a2l_fields_num = 3 + + do n = 1,a2l_fields_num + + ! create field + !!! Here we want to pass pointers + field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2l_fields(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2l_fields(n)%stdname), farrayPtr=a2l_fields(n)%farrayptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + !fldptr = a2l_fields(n)%default_value + + ! add field to field bundle + call ESMF_FieldBundleAdd(a2l_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + print *, "**********************************************************" + print *, "creating field for a2l:" + print *, trim(a2l_fields(n)%stdname) + print *, a2l_fields(n)%farrayptr1d + + enddo + + print *, "!Fields to Coupler (atmos to land ) (a2l_fb) Field Bundle Created!" + + ! Add field bundle to state + call ESMF_StateAdd(atm2lnd_l_state, (/a2l_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, "!a2l_state is filld with dummy_var field bundle!" + + + end subroutine lnd_init !------------------------------------------------------------------------- From 2b34682085017e5b868b1e5d6a2ca9e724a57872 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 30 Apr 2019 14:43:38 -0600 Subject: [PATCH 081/556] saving progress so far --- lilac/scripts/atmos_cap.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 7592f757e0..adc47321a6 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -12,7 +12,6 @@ module atmos_cap !!integer, parameter :: fldsMax = 100 type(ESMF_Field), public, save :: field - type(ESMF_Field), public, save :: field_sie, field_u type(fld_list_type), public, allocatable :: l2a_fields(:) type(fld_list_type), public, allocatable :: a2l_fields(:) @@ -31,7 +30,7 @@ module atmos_cap !public :: add_fields !public :: import_fields !public :: export_fields - + real(kind=ESMF_KIND_R4), dimension(:), public, pointer, save :: fldptr !------------------------------------------------------------------------ @@ -142,8 +141,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2l_fields(n)%stdname), rc=rc) !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2l_fields(n)%stdname), farrayPtr=a2l_fields(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) - !fldptr = a2l_fields(n)%default_value + call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + fldptr = a2l_fields(n)%farrayptr1d ! add field to field bundle call ESMF_FieldBundleAdd(a2l_fb, (/field/), rc=rc) From a49e16bf7e299db951ef1147fc96216a440f4091 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 30 Apr 2019 16:04:26 -0600 Subject: [PATCH 082/556] saving the work for atmos_cap and land_cap init part... compiling and working.... --- lilac/scripts/atmos_cap.F90 | 82 +++++++++++++++++++------------------ lilac/scripts/lilac_mod.F90 | 75 ++++++++++++++++++++++----------- lilac/scripts/lnd_cap.F90 | 77 +++++++++++++++++----------------- 3 files changed, 131 insertions(+), 103 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index adc47321a6..e9dcc2bb3b 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -2,7 +2,7 @@ module atmos_cap use ESMF use lilac_utils - !use lilac_mod, only : a2l_fields + !use lilac_mod, only : a2c_fldlist implicit none @@ -13,16 +13,16 @@ module atmos_cap type(ESMF_Field), public, save :: field - type(fld_list_type), public, allocatable :: l2a_fields(:) - type(fld_list_type), public, allocatable :: a2l_fields(:) - !type(fld_list_type), allocatable :: l2a_fields(:) - !type(fld_list_type), allocatable :: a2l_fields(:) + type(fld_list_type), public, allocatable :: c2a_fldlist(:) + type(fld_list_type), public, allocatable :: a2c_fldlist(:) + !type(fld_list_type), allocatable :: c2a_fldlist(:) + !type(fld_list_type), allocatable :: a2c_fldlist(:) - !type (fld_list_type) :: a2l_fields(fldsMax) - !type (fld_list_type) :: l2a_fields(fldsMax) - integer :: a2l_fields_num - integer :: l2a_fields_num + !type (fld_list_type) :: a2c_fldlist(fldsMax) + !type (fld_list_type) :: c2a_fldlist(fldsMax) + integer :: a2c_fldlist_num + integer :: c2a_fldlist_num !private @@ -70,7 +70,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) integer, intent(out) :: rc ! local variables - type (ESMF_FieldBundle) :: l2a_fb , a2l_fb + type (ESMF_FieldBundle) :: c2a_fb , a2c_fb integer :: n type(ESMF_Mesh) :: atmos_mesh character(len=ESMF_MAXSTR) :: atmos_mesh_filepath @@ -85,6 +85,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) !integer :: regDecomp(:,:) ! Initialize return code rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) call ESMF_GridCompGet (comp, petcount=petcount, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) @@ -121,90 +122,91 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) !------------------------------------------------------------------------- ! Atmosphere to Coupler (land) Fields -- a2l - ! I- Create empty field bundle -- a2l_fb + ! I- Create empty field bundle -- a2c_fb ! II- Create Fields and add them to field bundle - ! III - Add a2l_fb to state (a2l_state) + ! III - Add a2c_fb to state (atm2lnd_a_state) !------------------------------------------------------------------------- - a2l_fb = ESMF_FieldBundleCreate(name="a2l_fields", rc=rc) + a2c_fb = ESMF_FieldBundleCreate(name="a2c_fldlist", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create individual fields and add to field bundle -- a2l - !call fldlist_add(a2l_fields_num, a2l_fields, 'dum_var2' ) - a2l_fields_num = 3 + !call fldlist_add(a2c_fldlist_num, a2c_fldlist, 'dum_var2' ) + a2c_fldlist_num = 3 - do n = 1,a2l_fields_num + do n = 1,a2c_fldlist_num ! create field !!! Here we want to pass pointers - field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2l_fields(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2l_fields(n)%stdname), farrayPtr=a2l_fields(n)%farrayptr1d, rc=rc) + field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2c_fldlist(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) - fldptr = a2l_fields(n)%farrayptr1d + !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + !fldptr = a2c_fldlist(n)%farrayptr1d ! add field to field bundle - call ESMF_FieldBundleAdd(a2l_fb, (/field/), rc=rc) + call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "**********************************************************" print *, "creating field for a2l:" - print *, trim(a2l_fields(n)%stdname) - print *, a2l_fields(n)%farrayptr1d + print *, trim(a2c_fldlist(n)%stdname) + print *, a2c_fldlist(n)%farrayptr1d enddo - print *, "!Fields to Coupler (atmos to land ) (a2l_fb) Field Bundle Created!" + print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" ! Add field bundle to state - call ESMF_StateAdd(atm2lnd_a_state, (/a2l_fb/), rc=rc) + call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!a2l_state is filld with dummy_var field bundle!" + call ESMF_LogWrite(subname//"atm2lnd_a_state is filled with dummy_var field bundle!", ESMF_LOGMSG_INFO) + print *, "!atm2lnd_a_state is filld with dummy_var field bundle!" !------------------------------------------------------------------------- ! Coupler (land) to Atmosphere Fields -- l2a - ! I- Create Field Bundle -- l2a_fb for now + ! I- Create Field Bundle -- c2a_fb for now ! II- Create Fields and add them to field bundle - ! III - Add l2a_fb to state (l2a_state) + ! III - Add c2a_fb to state (lnd2atm_a_state) !------------------------------------------------------------------------- - l2a_fb = ESMF_FieldBundleCreate (name="l2a_fields", rc=rc) + c2a_fb = ESMF_FieldBundleCreate (name="c2a_fldlist", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create individual fields and add to field bundle -- l2a - l2a_fields_num = 3 + c2a_fldlist_num = 3 - do n = 1,l2a_fields_num + do n = 1,c2a_fldlist_num ! create field !!! Here we want to pass pointers if (mesh_switch) then - field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(l2a_fields(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(l2a_fields(n)%stdname), farrayPtr=l2a_fields(n)%farrayptr1d, rc=rc) + field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out else - field = ESMF_FieldCreate(atmos_grid, name=trim(l2a_fields(n)%stdname), farrayPtr=l2a_fields(n)%farrayptr2d, rc=rc) + field = ESMF_FieldCreate(atmos_grid, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end if ! add field to field bundle - call ESMF_FieldBundleAdd(l2a_fb, (/field/), rc=rc) + call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "**********************************************************" print *, "creating field for l2a:" - print *, trim(l2a_fields(n)%stdname) - print *, l2a_fields(n)%farrayptr1d + print *, trim(c2a_fldlist(n)%stdname) + print *, c2a_fldlist(n)%farrayptr1d enddo - print *, "!Fields For Coupler (l2a_fields) Field Bundle Created!" + print *, "!Fields For Coupler (c2a_fldlist) Field Bundle Created!" ! Add field bundle to state - call ESMF_StateAdd(lnd2atm_a_state, (/l2a_fb/), rc=rc) + call ESMF_StateAdd(lnd2atm_a_state, (/c2a_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!l2a_state is filld with dummy_var field bundle!" + print *, "!lnd2atm_a_state is filld with dummy_var field bundle!" end subroutine atmos_init diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 0f8667ae3f..23a0c47c7a 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -20,7 +20,7 @@ module lilac_mod integer :: yy,mm,dd,sec character(*), parameter :: modname = "lilac_mod" - !type(fld_list_type), public :: a2l_fields, l2a_fields + !type(fld_list_type), public :: a2c_fldlist, c2a_fldlist !------------------------------------------------------------------------ @@ -33,8 +33,9 @@ module lilac_mod subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) - use atmos_cap, only : a2l_fields, l2a_fields - ! type(fld_list_type) :: a2l_fields , l2a_fields + use atmos_cap, only : a2c_fldlist, c2a_fldlist + use lnd_cap, only : l2c_fldlist, c2l_fldlist + ! type(fld_list_type) :: a2c_fldlist , c2a_fldlist ! input/output variables type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d @@ -88,33 +89,59 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) a2l_fldnum = 3 l2a_fldnum = 3 - allocate (a2l_fields(a2l_fldnum)) - allocate (l2a_fields(l2a_fldnum)) + allocate (a2c_fldlist(a2l_fldnum)) + allocate (c2a_fldlist(l2a_fldnum)) - print *, "field lists: !" -! call create_fldlists(l2a_fields, a2l_fields, a2l_fldnum, l2a_fldnum) + allocate (l2c_fldlist(l2a_fldnum)) + allocate (c2l_fldlist(a2l_fldnum)) + + print *, "creatibg field lists: a2c_fldlist !" +! call create_fldlists(c2a_fldlist, a2c_fldlist, a2l_fldnum, l2a_fldnum) if (.True.) then - a2l_fields(1)%stdname = 'uwind' - a2l_fields(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 - print *, a2l_fields(1)%stdname - print *, a2l_fields(1)%farrayptr1d(:) - a2l_fields(2)%stdname = 'vwind' - a2l_fields(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 - print *, a2l_fields(2)%stdname - print *, a2l_fields(2)%farrayptr1d(:) - a2l_fields(3)%stdname = 'tbot' - a2l_fields(3)%farrayptr1d => atm2lnd1d%vwind - print *, a2l_fields(3)%stdname - print *, a2l_fields(3)%farrayptr1d + a2c_fldlist(1)%stdname = 'uwind' + a2c_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 + print *, a2c_fldlist(1)%stdname + print *, a2c_fldlist(1)%farrayptr1d(:) + a2c_fldlist(2)%stdname = 'vwind' + a2c_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 + print *, a2c_fldlist(2)%stdname + print *, a2c_fldlist(2)%farrayptr1d(:) + a2c_fldlist(3)%stdname = 'tbot' + a2c_fldlist(3)%farrayptr1d => atm2lnd1d%vwind + print *, a2c_fldlist(3)%stdname + print *, a2c_fldlist(3)%farrayptr1d !call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num) else - a2l_fields(1)%stdname = 'name' - a2l_fields(1)%farrayptr2d => atm2lnd2d%uwind + a2c_fldlist(1)%stdname = 'name' + a2c_fldlist(1)%farrayptr2d => atm2lnd2d%uwind !call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) - end if + end if + + print *, "creatibg field lists: l2c_fldlist !" + l2c_fldlist(1)%stdname = 'lwup' + print *, l2c_fldlist(1)%stdname + + l2c_fldlist(2)%stdname = 'taux' + print *, l2c_fldlist(2)%stdname + + l2c_fldlist(2)%stdname = 'tauy' + print *, l2c_fldlist(3)%stdname + + c2l_fldlist(1)%stdname = 'uwind' + print *, c2l_fldlist(1)%stdname + + c2l_fldlist(2)%stdname = 'vwind' + print *, c2l_fldlist(2)%stdname + + c2l_fldlist(2)%stdname = 'tbot' + print *, c2l_fldlist(3)%stdname + + + + !------------------------------------------------------------------------- ! Create Gridded Component! --- dummy atmosphere @@ -255,8 +282,8 @@ end subroutine lilac_init subroutine lilac_run(dum_var1, dum_var2) - use atmos_cap, only : l2a_fields - use atmos_cap, only : a2l_fields + use atmos_cap, only : c2a_fldlist + use atmos_cap, only : a2c_fldlist real, dimension(:,:) :: dum_var1 ! from host atm real, dimension(:,:) :: dum_var2 ! to host atm diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index 8a4106a658..b68610832b 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -4,15 +4,15 @@ module lnd_cap implicit none - character(*), parameter :: modname = "(land)" + character(*), parameter :: modname = " lnd_cap" !!integer, parameter :: fldsMax = 100 type(ESMF_Field), public, save :: field type(ESMF_Field), public, save :: field_sie, field_u - type(fld_list_type), allocatable :: x2a_fields(:) - type(fld_list_type), allocatable :: a2x_fields(:) + type(fld_list_type), public, allocatable :: c2l_fldlist(:) + type(fld_list_type), public, allocatable :: l2c_fldlist(:) !private @@ -30,7 +30,7 @@ subroutine lnd_register(comp, rc) type(ESMF_GridComp) :: comp ! must not be optional integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':(lnd_register) ' + character(len=*), parameter :: subname=trim(modname)//':[lnd_register] ' print *, "in lnd register routine" @@ -53,13 +53,12 @@ end subroutine lnd_register subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) - use atmos_cap, only : a2l_fields, l2a_fields type (ESMF_GridComp) :: comp type (ESMF_State) :: atm2lnd_l_state, lnd2atm_l_state type (ESMF_Clock) :: clock integer, intent(out) :: rc - type (ESMF_FieldBundle) :: l2a_fb , a2l_fb + type (ESMF_FieldBundle) :: l2c_fb , c2l_fb integer :: n @@ -68,12 +67,12 @@ subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) type(ESMF_Mesh) :: lnd_mesh character(len=ESMF_MAXSTR) :: lnd_mesh_filepath - character(len=*), parameter :: subname=trim(modname)//':(lnd_register) ' + character(len=*), parameter :: subname=trim(modname)//':[lnd_init] ' type(ESMF_Grid) :: lnd_grid - integer :: a2l_fields_num - integer :: l2a_fields_num + integer :: c2l_fldlist_num + integer :: l2c_fldlist_num @@ -115,91 +114,91 @@ subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) !------------------------------------------------------------------------- ! Coupler (land) to Atmosphere Fields -- l2a - ! I- Create Field Bundle -- l2a_fb for now + ! I- Create Field Bundle -- l2c_fb for now ! II- Create Fields and add them to field bundle - ! III - Add l2a_fb to state (l2a_state) + ! III - Add l2c_fb to state (lnd2atm_l_state) !------------------------------------------------------------------------- - l2a_fb = ESMF_FieldBundleCreate (name="l2a_fields", rc=rc) + l2c_fb = ESMF_FieldBundleCreate (name="l2c_fb", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - + print *, 'l2c_fb is created' ! Create individual fields and add to field bundle -- l2a - l2a_fields_num = 3 + l2c_fldlist_num = 3 - do n = 1,l2a_fields_num + do n = 1,l2c_fldlist_num ! create field !!! Here we want to pass pointers if (mesh_switch) then - field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(l2a_fields(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(l2a_fields(n)%stdname), farrayPtr=l2a_fields(n)%farrayptr1d, rc= + field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(l2c_fldlist(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(l2c_fldlist(n)%stdname), farrayPtr=l2c_fldlist(n)%farrayptr1d, rc= if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out else - field = ESMF_FieldCreate(lnd_grid, name=trim(l2a_fields(n)%stdname), farrayPtr=l2a_fields(n)%farrayptr2d, rc=rc) + field = ESMF_FieldCreate(lnd_grid, name=trim(l2c_fldlist(n)%stdname), farrayPtr=l2c_fldlist(n)%farrayptr2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end if ! add field to field bundle - call ESMF_FieldBundleAdd(l2a_fb, (/field/), rc=rc) + call ESMF_FieldBundleAdd(l2c_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "**********************************************************" print *, "creating field for l2a:" - print *, trim(l2a_fields(n)%stdname) - print *, l2a_fields(n)%farrayptr1d + print *, trim(l2c_fldlist(n)%stdname) + print *, l2c_fldlist(n)%farrayptr1d enddo - print *, "!Fields For Coupler (l2a_fields) Field Bundle Created!" + print *, "!Fields For Coupler (l2c_fldlist) Field Bundle Created!" ! Add field bundle to state - call ESMF_StateAdd(lnd2atm_l_state, (/l2a_fb/), rc=rc) + call ESMF_StateAdd(lnd2atm_l_state, (/l2c_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!l2a_state is filld with dummy_var field bundle!" + print *, "!lnd2atm_l_state is filld with dummy_var field bundle!" !------------------------------------------------------------------------- ! Atmosphere to Coupler (land) Fields -- a2l - ! I- Create empty field bundle -- a2l_fb + ! I- Create empty field bundle -- c2l_fb ! II- Create Fields and add them to field bundle - ! III - Add a2l_fb to state (a2l_state) + ! III - Add c2l_fb to state (atm2lnd_l_state) !------------------------------------------------------------------------- - a2l_fb = ESMF_FieldBundleCreate(name="a2l_fields", rc=rc) + c2l_fb = ESMF_FieldBundleCreate(name="c2l_fb", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create individual fields and add to field bundle -- a2l - !call fldlist_add(a2l_fields_num, a2l_fields, 'dum_var2' ) - a2l_fields_num = 3 + !call fldlist_add(c2l_fldlist_num, c2l_fldlist, 'dum_var2' ) + c2l_fldlist_num = 3 - do n = 1,a2l_fields_num + do n = 1,c2l_fldlist_num ! create field !!! Here we want to pass pointers - field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2l_fields(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2l_fields(n)%stdname), farrayPtr=a2l_fields(n)%farrayptr1d, rc=rc) + field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2l_fldlist(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2l_fldlist(n)%stdname), farrayPtr=c2l_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) - !fldptr = a2l_fields(n)%default_value + !fldptr = c2l_fldlist(n)%default_value ! add field to field bundle - call ESMF_FieldBundleAdd(a2l_fb, (/field/), rc=rc) + call ESMF_FieldBundleAdd(c2l_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "**********************************************************" print *, "creating field for a2l:" - print *, trim(a2l_fields(n)%stdname) - print *, a2l_fields(n)%farrayptr1d + print *, trim(c2l_fldlist(n)%stdname) + print *, c2l_fldlist(n)%farrayptr1d enddo - print *, "!Fields to Coupler (atmos to land ) (a2l_fb) Field Bundle Created!" + print *, "!Fields to Coupler (atmos to land ) (c2l_fb) Field Bundle Created!" ! Add field bundle to state - call ESMF_StateAdd(atm2lnd_l_state, (/a2l_fb/), rc=rc) + call ESMF_StateAdd(atm2lnd_l_state, (/c2l_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!a2l_state is filld with dummy_var field bundle!" + print *, "!atm2lnd_l_state is filld with dummy_var field bundle!" From e92fab01f3062777171d3a8d4c418960abbdaaef Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 30 Apr 2019 17:12:05 -0600 Subject: [PATCH 083/556] working on couplers initializations.... --- lilac/scripts/atmos_cap.F90 | 4 +- lilac/scripts/cpl_mod.F90 | 97 ++++++++++++++++++----------------- lilac/scripts/demo_driver.F90 | 2 +- lilac/scripts/lilac_mod.F90 | 6 +-- 4 files changed, 57 insertions(+), 52 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index e9dcc2bb3b..ec3c0cdb19 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -139,8 +139,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! create field !!! Here we want to pass pointers - field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2c_fldlist(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2c_fldlist(n)%stdname), rc=rc) + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) !fldptr = a2c_fldlist(n)%farrayptr1d diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index 8cc7ce0be1..4dbd5d5c72 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -6,71 +6,76 @@ module cpl_mod public cpl_atm2lnd_register public cpl_lnd2atm_register -contains - subroutine cpl_atm2lnd_register(cplcomp, rc) - type(ESMF_CplComp) :: cplcomp - integer, intent(out) :: rc + character(*), parameter :: modname = " cpl_mod" - rc = ESMF_FAILURE + contains - ! Register the callback routines. + subroutine cpl_atm2lnd_register(cplcomp, rc) + type(ESMF_CplComp) :: cplcomp + integer, intent(out) :: rc + character(len=*), parameter :: subname=trim(modname)//':[cpl_atm2lnd_register] ' + + rc = ESMF_SUCCESS + print *, "in cpl_atm2lnd_register routine" + + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_atm2lnd_init, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_atm2lnd_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) + !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) + !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_atm2lnd_init, rc=rc) - !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_atm2lnd_init ,rc=rc) - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, my_init, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) - !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) - !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) end subroutine cpl_atm2lnd_register subroutine cpl_lnd2atm_register(cplcomp, rc) - type(ESMF_CplComp) :: cplcomp - integer, intent(out) :: rc - rc = ESMF_FAILURE - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_lnd2atm_init, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - - end subroutine cpl_lnd2atm_register + type(ESMF_CplComp) :: cplcomp + integer, intent(out) :: rc + character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_register] ' - subroutine my_init(cplcomp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: cplcomp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc + rc = ESMF_SUCCESS + print *, "in cpl_lnd2atm_register routine" - print *, "CPLR initialize routine called" - rc = ESMF_SUCCESS - end subroutine my_init + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_lnd2atm_init, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_lnd2atm_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end subroutine cpl_lnd2atm_register subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: cplcomp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - print *, "Coupler for land to atmosphere initialize routine called" - rc = ESMF_SUCCESS - end subroutine cpl_lnd2atm_init + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_init] ' + print *, "CPLR initialize routine called" + print *, "Coupler for land to atmosphere initialize routine called" + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + end subroutine cpl_lnd2atm_init subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: cplcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(inout) :: rc + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc - print *, "Coupler Init starting" - rc = ESMF_SUCCESS + character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_init] ' + print *, "CPLR initialize routine called" + print *, "Coupler for atmosphere to land initialize routine called" + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) end subroutine cpl_atm2lnd_init diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 3182bb2f7b..b5ded8c896 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -18,7 +18,7 @@ program demo_lilac_driver begc = 1 - endc = 100 + endc = 4608 call random_number(dum_var2) diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 23a0c47c7a..a7682fd90c 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -4,7 +4,7 @@ module lilac_mod use atmos_cap , only : atmos_register use lnd_cap , only : lnd_register -use cpl_mod +use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register @@ -127,7 +127,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) l2c_fldlist(2)%stdname = 'taux' print *, l2c_fldlist(2)%stdname - l2c_fldlist(2)%stdname = 'tauy' + l2c_fldlist(3)%stdname = 'tauy' print *, l2c_fldlist(3)%stdname c2l_fldlist(1)%stdname = 'uwind' @@ -136,7 +136,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) c2l_fldlist(2)%stdname = 'vwind' print *, c2l_fldlist(2)%stdname - c2l_fldlist(2)%stdname = 'tbot' + c2l_fldlist(3)%stdname = 'tbot' print *, c2l_fldlist(3)%stdname From 358f16b98a53d74c7bc37480fa1a66b74ca55844 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 30 Apr 2019 17:12:33 -0600 Subject: [PATCH 084/556] with marian's help on coupler initializations..... --- lilac/scripts/cpl_mod.F90 | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index 4dbd5d5c72..9e3eb230db 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -60,6 +60,13 @@ subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) print *, "CPLR initialize routine called" print *, "Coupler for land to atmosphere initialize routine called" rc = ESMF_SUCCESS + + call ESMF_StateGet(importState, itemname=importStateName, item=import_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, itemname=exportStateName, item=export_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) end subroutine cpl_lnd2atm_init @@ -78,7 +85,21 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) end subroutine cpl_atm2lnd_init + subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + call ESMF_StateGet(importState, itemname=importStateName, item=srcFieldBundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, itemname=exportStateName, item=dstFieldBundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleRegrid(srcFieldBundle, dstFieldBundle, rh_lnd2atm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + !routehandle, zeroregion, termorderflag, checkflag, rc) + end subroutine cpl_lnd2atm_run end module cpl_mod From dfa964dd8c0660de41adaa6df78eff28a3a2e1a7 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 1 May 2019 13:10:06 -0600 Subject: [PATCH 085/556] implementing lilac rungit add *.F90 currently compiling and running but not complete! --- lilac/scripts/atmos_cap.F90 | 4 +- lilac/scripts/cpl_mod.F90 | 107 +++++++++++++++++++++++++++------- lilac/scripts/demo_driver.F90 | 3 +- lilac/scripts/lilac_mod.F90 | 89 ++++++++++++++++++++-------- lilac/scripts/lnd_cap.F90 | 8 ++- 5 files changed, 160 insertions(+), 51 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index ec3c0cdb19..3241e04435 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -127,7 +127,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! III - Add a2c_fb to state (atm2lnd_a_state) !------------------------------------------------------------------------- - a2c_fb = ESMF_FieldBundleCreate(name="a2c_fldlist", rc=rc) + a2c_fb = ESMF_FieldBundleCreate(name="a2c_fb", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create individual fields and add to field bundle -- a2l @@ -172,7 +172,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! III - Add c2a_fb to state (lnd2atm_a_state) !------------------------------------------------------------------------- - c2a_fb = ESMF_FieldBundleCreate (name="c2a_fldlist", rc=rc) + c2a_fb = ESMF_FieldBundleCreate (name="c2a_fb", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create individual fields and add to field bundle -- l2a diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index 9e3eb230db..f78bd275be 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -3,6 +3,11 @@ module cpl_mod use ESMF implicit none + private + + type(ESMF_RouteHandle), save :: rh_atm2lnd, rh_lnd2atm + + public cpl_atm2lnd_register public cpl_lnd2atm_register @@ -22,10 +27,10 @@ subroutine cpl_atm2lnd_register(cplcomp, rc) ! Register the callback routines. ! Set the entry points for coupler ESMF Component methods !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_atm2lnd_init, rc=rc) - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_atm2lnd_init, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine= cpl_atm2lnd_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_atm2lnd_run , rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) - !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) @@ -45,29 +50,40 @@ subroutine cpl_lnd2atm_register(cplcomp, rc) !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_lnd2atm_init, rc=rc) call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_lnd2atm_init, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_lnd2atm_run , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) end subroutine cpl_lnd2atm_register + !-------------------------------------------------------------------------- + !-------------------------------------------------------------------------- + subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) type(ESMF_CplComp) :: cplcomp type(ESMF_State) :: importState type(ESMF_State) :: exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_init] ' - print *, "CPLR initialize routine called" - print *, "Coupler for land to atmosphere initialize routine called" rc = ESMF_SUCCESS - - call ESMF_StateGet(importState, itemname=importStateName, item=import_fieldbundle, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(exportState, itemname=exportStateName, item=export_fieldbundle, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + print *, "Coupler for land to atmosphere initialize routine called" call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + !call ESMF_StateGet(importState, itemname="a2c_fb", item=import_fieldbundle, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + !call ESMF_StateGet(exportState, itemname="c2a_fb", item=export_fieldbundle, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + !call ESMF_FieldRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine cpl_lnd2atm_init subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) @@ -76,31 +92,78 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) type(ESMF_State) :: exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_init] ' + character(len=*), parameter :: subname=trim(modname)//':[cpl_atm2lnd_init] ' - print *, "CPLR initialize routine called" - print *, "Coupler for atmosphere to land initialize routine called" rc = ESMF_SUCCESS + print *, "Coupler for atmosphere to land initialize routine called" call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "a2c_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end subroutine cpl_atm2lnd_init + !-------------------------------------------------------------------------- + !-------------------------------------------------------------------------- + subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) type(ESMF_CplComp) :: cplcomp type(ESMF_State) :: importState type(ESMF_State) :: exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + rc = ESMF_SUCCESS - call ESMF_StateGet(importState, itemname=importStateName, item=srcFieldBundle, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(exportState, itemname=exportStateName, item=dstFieldBundle, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleRegrid(srcFieldBundle, dstFieldBundle, rh_lnd2atm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + print *, "Running cpl_lnd2atm_run" + call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + !call ESMF_StateGet(importState, itemname=importStateName, item=srcFieldBundle, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + !call ESMF_StateGet(exportState, itemname=exportStateName, item=dstFieldBundle, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + !call ESMF_FieldBundleRegrid(srcFieldBundle, dstFieldBundle, rh_lnd2atm, rc=rc) + call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, rh_lnd2atm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !if (chkerr(rc,__LINE__,u_FILE_u)) return !routehandle, zeroregion, termorderflag, checkflag, rc) end subroutine cpl_lnd2atm_run -end module cpl_mod + subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + rc = ESMF_SUCCESS + + print *, "Running cpl_atm2lnd_run" + + call ESMF_StateGet(importState, "a2c_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + !call ESMF_StateGet(importState, itemname=importStateName, item=srcFieldBundle, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + !call ESMF_StateGet(exportState, itemname=exportStateName, item=dstFieldBundle, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + !call ESMF_FieldBundleRegrid(srcFieldBundle, dstFieldBundle, rh_lnd2atm, rc=rc) + call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, rh_lnd2atm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !if (chkerr(rc,__LINE__,u_FILE_u)) return + !routehandle, zeroregion, termorderflag, checkflag, rc) + end subroutine cpl_atm2lnd_run + +end module cpl_mod diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index b5ded8c896..92bbdfb338 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -12,7 +12,7 @@ program demo_lilac_driver type (lnd2atm_data1d_type) :: lnd2atm integer :: begc,endc real, dimension(100,100), target :: dum_var1 - real, dimension(100) :: dum_var2 + real, dimension(4608) :: dum_var2 !------------------------------------------------------------------------ @@ -36,6 +36,7 @@ program demo_lilac_driver call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) + call lilac_run ( ) print *, "=======================================" print *, " ............. DONE ..................." diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index a7682fd90c..429d360030 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -29,6 +29,14 @@ module lilac_mod !------------------------------------------------------------------------ + ! ! Gridded Components and Coupling Components + type(ESMF_GridComp) :: dummy_atmos_comp + type(ESMF_GridComp) :: dummy_land_comp + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp + type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state + type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state + contains subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) @@ -43,20 +51,13 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d ! local variables - ! ! Gridded Components and Coupling Components - type(ESMF_GridComp) :: dummy_atmos_comp - type(ESMF_GridComp) :: dummy_land_comp - type(ESMF_CplComp) :: cpl_atm2lnd_comp - type(ESMF_CplComp) :: cpl_lnd2atm_comp type(ESMF_State) :: coupledFlowState ! the coupled flow State type(ESMF_Mesh) :: Emesh character(len=*), parameter :: subname=trim(modname)//':[lilac_init]' type(ESMF_State) :: importState, exportState - type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state - type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state !character(len=*) :: atm_mesh_filepath !!! For now this is hard !coded in the atmos init @@ -277,28 +278,70 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) print *, "coupler :: cpl_lnd2atm_comp initialize finished, rc =", rc - end subroutine lilac_init - subroutine lilac_run(dum_var1, dum_var2) + subroutine lilac_run( ) - use atmos_cap, only : c2a_fldlist - use atmos_cap, only : a2c_fldlist - - real, dimension(:,:) :: dum_var1 ! from host atm - real, dimension(:,:) :: dum_var2 ! to host atm + use atmos_cap, only : a2c_fldlist, c2a_fldlist + use lnd_cap, only : l2c_fldlist, c2l_fldlist + ! type(fld_list_type) :: a2c_fldlist , c2a_fldlist + ! input/output variables + !type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d + !type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d + !type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d + !type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d - integer :: n, num + ! local variables + ! ! Gridded Components and Coupling Components + !type(ESMF_GridComp) :: dummy_atmos_comp + !type(ESMF_GridComp) :: dummy_land_comp !integer, parameter :: fldsMax = 100 - integer :: fldsToLnd_num = 0 - integer :: fldsFrLnd_num = 0 - - type (fld_list_type) :: fldsToLnd(fldsMax) - type (fld_list_type) :: fldsFrLnd(fldsMax) - !----------------------------------------- - !----------------------------------------- - type(ESMF_State) :: importState, exportState + !integer :: fldsToLnd_num = 0 + !integer :: fldsFrLnd_num = 0 + + + character(len=*), parameter :: subname=trim(modname)//':[lilac_run]' + type(ESMF_State) :: importState, exportState + + ! local variables + integer :: rc, urc + character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names + character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names + !integer, parameter :: fldsMax = 100 + integer :: a2l_fldnum, l2a_fldnum + logical :: mesh_switch + + !------------------------------------------------------------------------ + + mesh_switch = .True. + + !------------------------------------------------------------------------- + ! Initialize ESMF, set the default calendar and log type. + !------------------------------------------------------------------------- + call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + print *, " Lilac Run " + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + + + !------------------------------------------------------------------------- + ! Gridded Component Run! --- dummy atmosphere + !------------------------------------------------------------------------- + call ESMF_GridCompRun(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) + print *, "Running atmos_cap gridded component , rc =", rc + + call ESMF_GridCompRun(dummy_land_comp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp is running", ESMF_LOGMSG_INFO) + print *, "Running lnd_cap gridded component , rc =", rc + + + !call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) !search through fldlist array to find the right fldist object to do the copy - say its index N diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index b68610832b..2a8867c264 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -75,14 +75,16 @@ subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) integer :: l2c_fldlist_num - - - print *, " Empty land is created !!!!" + !integer :: regDecomp(:,:) + ! Initialize return code rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) + call ESMF_GridCompGet(comp, petcount=petcount, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + print *, " Empty land is created !!!!" print *, "in land routine routine" !------------------------------------------------------------------------- ! Read in the mesh ----or----- Generate the grid From b77e78aae4118de843aece2f0635088fc4f281ef Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 1 May 2019 13:17:24 -0600 Subject: [PATCH 086/556] saving for the sake of saving... working on coupler run.... --- lilac/scripts/atmos_cap.F90 | 2 +- lilac/scripts/lilac_mod.F90 | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 3241e04435..7badd4b56e 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -223,7 +223,7 @@ subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) rc = ESMF_SUCCESS ! get a list of fields of variables we need from atmos.... ! - !call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) ! loop over fields, copying pointer from import to export state end subroutine atmos_copy_atm_to_lilac diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 429d360030..59eea72f35 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -313,6 +313,8 @@ subroutine lilac_run( ) logical :: mesh_switch !------------------------------------------------------------------------ + ! Initialize return code + rc = ESMF_SUCCESS mesh_switch = .True. From 4433359da4cbd9e5e224dbeb0fbebd8dadf97a8c Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 2 May 2019 13:16:45 -0600 Subject: [PATCH 087/556] commiting my changes so far.... --- lilac/scripts/atmos_cap.F90 | 11 +-- lilac/scripts/cpl_mod.F90 | 91 ++++++++++++++++++++--- lilac/scripts/demo_driver.F90 | 7 +- lilac/scripts/lilac_mod.F90 | 132 +++++++++++++++++++++++++++++++++- 4 files changed, 221 insertions(+), 20 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 7badd4b56e..6d4a0be932 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -153,7 +153,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) print *, "**********************************************************" print *, "creating field for a2l:" print *, trim(a2c_fldlist(n)%stdname) - print *, a2c_fldlist(n)%farrayptr1d + !print *, a2c_fldlist(n)%farrayptr1d enddo @@ -183,7 +183,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! create field !!! Here we want to pass pointers if (mesh_switch) then - field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out else @@ -195,9 +196,9 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "**********************************************************" - print *, "creating field for l2a:" - print *, trim(c2a_fldlist(n)%stdname) - print *, c2a_fldlist(n)%farrayptr1d + print *, "creating field for c2a:" + !print *, trim(c2a_fldlist(n)%stdname) + !print *, c2a_fldlist(n)%farrayptr1d enddo diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index f78bd275be..48ab1519de 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -31,8 +31,8 @@ subroutine cpl_atm2lnd_register(cplcomp, rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_atm2lnd_run , rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) - !if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_atm2lnd_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) end subroutine cpl_atm2lnd_register @@ -52,6 +52,8 @@ subroutine cpl_lnd2atm_register(cplcomp, rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_lnd2atm_run , rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_lnd2atm_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) end subroutine cpl_lnd2atm_register @@ -78,6 +80,13 @@ subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! For Redisting + !call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! For ReGridding + call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_StateGet(importState, itemname="a2c_fb", item=import_fieldbundle, rc=rc) !if (chkerr(rc,__LINE__,u_FILE_u)) return !call ESMF_StateGet(exportState, itemname="c2a_fb", item=export_fieldbundle, rc=rc) @@ -105,6 +114,13 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! For Redisting + !call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! For ReGridding + call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end subroutine cpl_atm2lnd_init !-------------------------------------------------------------------------- @@ -117,9 +133,14 @@ subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + + character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_run] ' + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) print *, "Running cpl_lnd2atm_run" + call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -131,11 +152,11 @@ subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) !call ESMF_StateGet(exportState, itemname=exportStateName, item=dstFieldBundle, rc=rc) !if (chkerr(rc,__LINE__,u_FILE_u)) return !call ESMF_FieldBundleRegrid(srcFieldBundle, dstFieldBundle, rh_lnd2atm, rc=rc) - call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, rh_lnd2atm, rc=rc) + call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//" regridding fieldbundles from land to atmos!", ESMF_LOGMSG_INFO) !routehandle, zeroregion, termorderflag, checkflag, rc) - end subroutine cpl_lnd2atm_run + end subroutine cpl_lnd2atm_run subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) type(ESMF_CplComp) :: cplcomp @@ -144,26 +165,76 @@ subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + + character(len=*), parameter :: subname=trim(modname)//':[cpl_atm2lnd_run] ' + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) print *, "Running cpl_atm2lnd_run" - call ESMF_StateGet(importState, "a2c_fb", import_fieldbundle, rc=rc) + + call ESMF_StateGet(importState, trim("a2c_fb"), import_fieldbundle, rc=rc) + !call ESMF_StateGet(importState, itemName=trim("a2c_fb"), item=import_fieldbundle, rc=rc) ! this syntax was not working??? if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//" got a2c fieldbundle!", ESMF_LOGMSG_INFO) - call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) + call ESMF_StateGet(exportState, trim("c2l_fb"), export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//" got c2l fieldbundle!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) !call ESMF_StateGet(importState, itemname=importStateName, item=srcFieldBundle, rc=rc) !if (chkerr(rc,__LINE__,u_FILE_u)) return !call ESMF_StateGet(exportState, itemname=exportStateName, item=dstFieldBundle, rc=rc) !if (chkerr(rc,__LINE__,u_FILE_u)) return - !call ESMF_FieldBundleRegrid(srcFieldBundle, dstFieldBundle, rh_lnd2atm, rc=rc) - call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, rh_lnd2atm, rc=rc) + + + call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//" regridding fieldbundles from atmos to land!", ESMF_LOGMSG_INFO) + + !routehandle, zeroregion, termorderflag, checkflag, rc) end subroutine cpl_atm2lnd_run + subroutine cpl_lnd2atm_final(cplcomp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + + character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_final] ' + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//" has not been implemented yet", ESMF_LOGMSG_INFO) + end subroutine cpl_lnd2atm_final + + + subroutine cpl_atm2lnd_final(cplcomp, importState, exportState, clock, rc) + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + + character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_final] ' + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//" has not been implemented yet", ESMF_LOGMSG_INFO) + end subroutine cpl_atm2lnd_final + + + + + + end module cpl_mod diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 92bbdfb338..12c1859aef 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -35,14 +35,15 @@ program demo_lilac_driver - call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) - call lilac_run ( ) + call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) + call lilac_run ( ) print *, "=======================================" print *, " ............. DONE ..................." - call ESMF_Finalize() + call lilac_final ( ) + call ESMF_Finalize ( ) end program demo_lilac_driver diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 59eea72f35..7412a84665 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -121,6 +121,21 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) !call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) end if + ! Similary we need c2a_fldlist + + + + c2a_fldlist(1)%stdname = 'uwind' + c2a_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 + c2a_fldlist(2)%stdname = 'vwind' + c2a_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 + c2a_fldlist(3)%stdname = 'tbot' + c2a_fldlist(3)%farrayptr1d => atm2lnd1d%vwind + + + + + print *, "creatibg field lists: l2c_fldlist !" l2c_fldlist(1)%stdname = 'lwup' print *, l2c_fldlist(1)%stdname @@ -337,13 +352,20 @@ subroutine lilac_run( ) call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) print *, "Running atmos_cap gridded component , rc =", rc + call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) + print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc + call ESMF_GridCompRun(dummy_land_comp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp is running", ESMF_LOGMSG_INFO) print *, "Running lnd_cap gridded component , rc =", rc - - !call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) + print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc !search through fldlist array to find the right fldist object to do the copy - say its index N @@ -360,6 +382,112 @@ subroutine lilac_run( ) end subroutine lilac_run + subroutine lilac_final( ) + + use atmos_cap, only : a2c_fldlist, c2a_fldlist + use lnd_cap, only : l2c_fldlist, c2l_fldlist + ! type(fld_list_type) :: a2c_fldlist , c2a_fldlist + ! input/output variables + !type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d + !type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d + !type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d + !type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d + + ! local variables + ! ! Gridded Components and Coupling Components + !type(ESMF_GridComp) :: dummy_atmos_comp + !type(ESMF_GridComp) :: dummy_land_comp + + !integer, parameter :: fldsMax = 100 + !integer :: fldsToLnd_num = 0 + !integer :: fldsFrLnd_num = 0 + + + character(len=*), parameter :: subname=trim(modname)//':[lilac_final]' + type(ESMF_State) :: importState, exportState + + ! local variables + integer :: rc, urc + character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names + character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names + !integer, parameter :: fldsMax = 100 + integer :: a2l_fldnum, l2a_fldnum + logical :: mesh_switch + + !------------------------------------------------------------------------ + !------------------------------------------------------------------------ + ! Initialize return code + rc = ESMF_SUCCESS + mesh_switch = .True. + + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + print *, " Lilac Finalizing " + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + !------------------------------------------------------------------------- + ! Gridded Component Finalizing! --- dummy atmosphere + !------------------------------------------------------------------------- + call ESMF_GridCompFinalize(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) + print *, "Finalizing atmos_cap gridded component , rc =", rc + + !------------------------------------------------------------------------- + ! Coupler component Finalizing --- coupler atmos to land + !------------------------------------------------------------------------- + call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) + print *, "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc + + !------------------------------------------------------------------------- + ! Gridded Component Finalizing! --- dummy land + !------------------------------------------------------------------------- + call ESMF_GridCompFinalize(dummy_land_comp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp is running", ESMF_LOGMSG_INFO) + print *, "Finalizing lnd_cap gridded component , rc =", rc + + !------------------------------------------------------------------------- + ! Coupler component Finalizing --- coupler land to atmos + !------------------------------------------------------------------------- + call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) + print *, "Finalizing coupler component..... cpl_lnd2atm_comp , rc =", rc + + + ! Then clean them up + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"destroying all states ", ESMF_LOGMSG_INFO) + + print *, "ready to destroy all states" + call ESMF_StateDestroy(atm2lnd_a_state , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(atm2lnd_l_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(lnd2atm_a_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(lnd2atm_l_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_LogWrite(subname//"destroying all components ", ESMF_LOGMSG_INFO) + print *, "ready to destroy all components" + + call ESMF_GridCompDestroy(dummy_atmos_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_GridCompDestroy(dummy_land_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompDestroy(cpl_atm2lnd_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompDestroy(cpl_lnd2atm_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + print *, "end of CoupledFlowMod Finalization routine" + + end subroutine lilac_final + + end module lilac_mod From 90c0c7952d514707ab302162a9f074064854fa58 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 2 May 2019 16:17:18 -0600 Subject: [PATCH 088/556] saving all components except for the driver... running without fail... --- lilac/scripts/atmos_cap.F90 | 37 ++++++++++++++++---------- lilac/scripts/cpl_mod.F90 | 29 +++++++++++++-------- lilac/scripts/lilac_mod.F90 | 52 ++++++++++++++++--------------------- lilac/scripts/lnd_cap.F90 | 9 ++++--- 4 files changed, 70 insertions(+), 57 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 6d4a0be932..14879732a2 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -62,7 +62,6 @@ end subroutine atmos_register - !subroutine atmos_init (comp, importState, exportState, clock, rc) subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) type (ESMF_GridComp) :: comp type (ESMF_State) :: lnd2atm_a_state, atm2lnd_a_state @@ -79,7 +78,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) type(ESMF_Grid) :: atmos_grid type(ESMF_DistGrid) :: distgridIN, distgridFS logical :: mesh_switch - character(len=*), parameter :: subname=trim(modname)//':[atmos_init] ' + character(len=*), parameter :: subname=trim(modname)//': [atmos_init] ' !---------------------- !integer :: regDecomp(:,:) @@ -137,24 +136,24 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) do n = 1,a2c_fldlist_num + print *, "**********************************************************" + print *, "creating field for a2l:" + print *, trim(a2c_fldlist(n)%stdname) + ! create field !!! Here we want to pass pointers !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2c_fldlist(n)%stdname), rc=rc) field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) - !fldptr = a2c_fldlist(n)%farrayptr1d ! add field to field bundle call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "**********************************************************" - print *, "creating field for a2l:" - print *, trim(a2c_fldlist(n)%stdname) - !print *, a2c_fldlist(n)%farrayptr1d - + print *, a2c_fldlist(n)%farrayptr1d + print *, "this field is created" + enddo print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" @@ -184,20 +183,21 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) !!! Here we want to pass pointers if (mesh_switch) then !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr1d, rc=rc) + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - else + else field = ESMF_FieldCreate(atmos_grid, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end if + ! add field to field bundle call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "**********************************************************" print *, "creating field for c2a:" - !print *, trim(c2a_fldlist(n)%stdname) + print *, trim(c2a_fldlist(n)%stdname) !print *, c2a_fldlist(n)%farrayptr1d enddo @@ -249,11 +249,22 @@ subroutine atmos_final(comp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':(atmos_final) ' + character(len=*), parameter :: subname=trim(modname)//': [atmos_final] ' + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle ! Initialize return code rc = ESMF_SUCCESS + call ESMF_StateGet(importState, "c2a_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_StateGet(exportState, "a2c_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail ou + + + call ESMF_FieldBundleDestroy(import_fieldbundle, rc=rc) + call ESMF_FieldBundleDestroy(export_fieldbundle, rc=rc) + call ESMF_LogWrite(subname//"atmos_final has not been implemented yet", ESMF_LOGMSG_INFO) end subroutine atmos_final diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index 48ab1519de..f8f0dd0439 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -39,7 +39,7 @@ end subroutine cpl_atm2lnd_register subroutine cpl_lnd2atm_register(cplcomp, rc) type(ESMF_CplComp) :: cplcomp integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_register] ' + character(len=*), parameter :: subname=trim(modname)//' : [cpl_lnd2atm_register] ' rc = ESMF_SUCCESS @@ -68,7 +68,7 @@ subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) integer, intent(out) :: rc type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_init] ' + character(len=*), parameter :: subname=trim(modname)//': [cpl_lnd2atm_init] ' rc = ESMF_SUCCESS print *, "Coupler for land to atmosphere initialize routine called" @@ -76,6 +76,7 @@ subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -103,7 +104,7 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) integer, intent(out) :: rc type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - character(len=*), parameter :: subname=trim(modname)//':[cpl_atm2lnd_init] ' + character(len=*), parameter :: subname=trim(modname)//': [cpl_atm2lnd_init] ' rc = ESMF_SUCCESS print *, "Coupler for atmosphere to land initialize routine called" @@ -134,7 +135,7 @@ subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) integer, intent(out) :: rc type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_run] ' + character(len=*), parameter :: subname=trim(modname)//': [cpl_lnd2atm_run] ' rc = ESMF_SUCCESS @@ -166,7 +167,7 @@ subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) integer, intent(out) :: rc type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - character(len=*), parameter :: subname=trim(modname)//':[cpl_atm2lnd_run] ' + character(len=*), parameter :: subname=trim(modname)//': [cpl_atm2lnd_run] ' rc = ESMF_SUCCESS @@ -206,12 +207,15 @@ subroutine cpl_lnd2atm_final(cplcomp, importState, exportState, clock, rc) integer, intent(out) :: rc type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_final] ' + character(len=*), parameter :: subname=trim(modname)//': [cpl_lnd2atm_final] ' rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//" has not been implemented yet", ESMF_LOGMSG_INFO) + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_lnd2atm , rc=rc) + + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//" rh_lnd2atm route handle released!", ESMF_LOGMSG_INFO) end subroutine cpl_lnd2atm_final @@ -223,12 +227,15 @@ subroutine cpl_atm2lnd_final(cplcomp, importState, exportState, clock, rc) integer, intent(out) :: rc type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - character(len=*), parameter :: subname=trim(modname)//':[cpl_lnd2atm_final] ' + character(len=*), parameter :: subname=trim(modname)//': [cpl_atm2lnd_final] ' rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//" has not been implemented yet", ESMF_LOGMSG_INFO) + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_atm2lnd, rc=rc) + + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//" rh_atm2lnd route handle released!", ESMF_LOGMSG_INFO) end subroutine cpl_atm2lnd_final diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 7412a84665..647034c3ed 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -56,7 +56,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) type(ESMF_State) :: coupledFlowState ! the coupled flow State type(ESMF_Mesh) :: Emesh - character(len=*), parameter :: subname=trim(modname)//':[lilac_init]' + character(len=*), parameter :: subname=trim(modname)//': [lilac_init]' type(ESMF_State) :: importState, exportState !character(len=*) :: atm_mesh_filepath !!! For now this is hard @@ -100,37 +100,31 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! call create_fldlists(c2a_fldlist, a2c_fldlist, a2l_fldnum, l2a_fldnum) - if (.True.) then - a2c_fldlist(1)%stdname = 'uwind' - a2c_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 - print *, a2c_fldlist(1)%stdname - print *, a2c_fldlist(1)%farrayptr1d(:) - a2c_fldlist(2)%stdname = 'vwind' - a2c_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 - print *, a2c_fldlist(2)%stdname - print *, a2c_fldlist(2)%farrayptr1d(:) - a2c_fldlist(3)%stdname = 'tbot' - a2c_fldlist(3)%farrayptr1d => atm2lnd1d%vwind - print *, a2c_fldlist(3)%stdname - print *, a2c_fldlist(3)%farrayptr1d + a2c_fldlist(1)%stdname = 'uwind' + a2c_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 + print *, a2c_fldlist(1)%stdname + !print *, a2c_fldlist(1)%farrayptr1d(:) + a2c_fldlist(2)%stdname = 'vwind' + a2c_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 + print *, a2c_fldlist(2)%stdname + !print *, a2c_fldlist(2)%farrayptr1d(:) + a2c_fldlist(3)%stdname = 'tbot' + a2c_fldlist(3)%farrayptr1d => atm2lnd1d%vwind + print *, a2c_fldlist(3)%stdname + !print *, a2c_fldlist(3)%farrayptr1d - !call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num) - else - a2c_fldlist(1)%stdname = 'name' - a2c_fldlist(1)%farrayptr2d => atm2lnd2d%uwind - !call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) - end if + !call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num) - ! Similary we need c2a_fldlist + ! Similary we need c2a_fldlist - c2a_fldlist(1)%stdname = 'uwind' - c2a_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 - c2a_fldlist(2)%stdname = 'vwind' - c2a_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 - c2a_fldlist(3)%stdname = 'tbot' - c2a_fldlist(3)%farrayptr1d => atm2lnd1d%vwind + c2a_fldlist(1)%stdname = 'uwind' + c2a_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 + c2a_fldlist(2)%stdname = 'vwind' + c2a_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 + c2a_fldlist(3)%stdname = 'tbot' + c2a_fldlist(3)%farrayptr1d => atm2lnd1d%vwind @@ -316,7 +310,7 @@ subroutine lilac_run( ) !integer :: fldsFrLnd_num = 0 - character(len=*), parameter :: subname=trim(modname)//':[lilac_run]' + character(len=*), parameter :: subname=trim(modname)//': [lilac_run]' type(ESMF_State) :: importState, exportState ! local variables @@ -403,7 +397,7 @@ subroutine lilac_final( ) !integer :: fldsFrLnd_num = 0 - character(len=*), parameter :: subname=trim(modname)//':[lilac_final]' + character(len=*), parameter :: subname=trim(modname)//': [lilac_final]' type(ESMF_State) :: importState, exportState ! local variables diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index 2a8867c264..7fddc79ac9 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -30,7 +30,7 @@ subroutine lnd_register(comp, rc) type(ESMF_GridComp) :: comp ! must not be optional integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':[lnd_register] ' + character(len=*), parameter :: subname=trim(modname)//': [lnd_register] ' print *, "in lnd register routine" @@ -67,7 +67,7 @@ subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) type(ESMF_Mesh) :: lnd_mesh character(len=ESMF_MAXSTR) :: lnd_mesh_filepath - character(len=*), parameter :: subname=trim(modname)//':[lnd_init] ' + character(len=*), parameter :: subname=trim(modname)//': [lnd_init] ' type(ESMF_Grid) :: lnd_grid @@ -93,6 +93,7 @@ subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) if(mesh_switch) then print *, "creating mesh for land" ! For now this is our dummy mesh: + !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T62_040121_ESMFmesh.nc' lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) @@ -215,7 +216,7 @@ subroutine lnd_run(comp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':(lnd_run) ' + character(len=*), parameter :: subname=trim(modname)//': [lnd_run] ' ! Initialize return code rc = ESMF_SUCCESS @@ -233,7 +234,7 @@ subroutine lnd_final(comp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':(lnd_final) ' + character(len=*), parameter :: subname=trim(modname)//': [lnd_final] ' ! Initialize return code rc = ESMF_SUCCESS From 71f07710a293cabcf02d924f65a544851103fc58 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 2 May 2019 17:04:51 -0600 Subject: [PATCH 089/556] running on 1 PET without any ERRORs! --- lilac/scripts/demo_driver.F90 | 64 ++++++++++++++++++++++++++++------- lilac/scripts/lilac_mod.F90 | 2 +- 2 files changed, 52 insertions(+), 14 deletions(-) diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 12c1859aef..83ae1e82d3 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -2,25 +2,47 @@ program demo_lilac_driver ! modules use ESMF - use Lilac_mod + use lilac_mod use lilac_utils, only : atm2lnd_data1d_type , lnd2atm_data1d_type, atm2lnd_data2d_type, atm2lnd_data2d_type - !use lilac_utils, only : atm2lnd_data2d_type - implicit none type (atm2lnd_data1d_type) :: atm2lnd type (lnd2atm_data1d_type) :: lnd2atm + integer :: begc,endc - real, dimension(100,100), target :: dum_var1 - real, dimension(4608) :: dum_var2 + + real, dimension(100,100), target :: dum_var1 + real, dimension(4608) :: dum_var2 + + integer, dimension(:), allocatable :: seed + integer :: seed_val, n + + integer :: start_time !-- start_time start time + integer :: end_time !-- end_time end time + integer :: curr_time !-- cur_time current time + integer :: itime_step !-- itime_step counter of time steps !------------------------------------------------------------------------ - begc = 1 - endc = 4608 + begc = 1 + endc = 4608 + + start_time = 1 + end_time = 10 + itime_step = 1 + + seed_val = 0 + n = endc - begc + 1 + + + + + call random_seed (size = n) + allocate (seed(n)) ; seed (:) = seed_val + call random_seed (put = seed) + call random_number (dum_var2) - call random_number(dum_var2) allocate( atm2lnd%uwind (begc:endc) ) ; atm2lnd%uwind (:) = dum_var2 allocate( atm2lnd%vwind (begc:endc) ) ; atm2lnd%vwind (:) = dum_var2 @@ -31,19 +53,35 @@ program demo_lilac_driver allocate( lnd2atm%tauy (begc:endc) ) ; lnd2atm%tauy (:) = dum_var2 print *, "=======================================" - print *, atm2lnd%uwind + print *, atm2lnd%uwind(1:10) + print *, "=======================================" + + + ! dummy looping over imaginary time .... + + do curr_time = start_time, end_time + + if (curr_time == start_time) then + ! Initalization phase + call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) + + else if (curr_time == end_time) then + !Finalization phase + call lilac_final ( ) + call ESMF_Finalize ( ) + else + call lilac_run ( ) + endif + itime_step = itime_step + 1 - call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) - call lilac_run ( ) + end do print *, "=======================================" print *, " ............. DONE ..................." - call lilac_final ( ) - call ESMF_Finalize ( ) end program demo_lilac_driver diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 647034c3ed..279dcd00de 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -128,7 +128,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) - + !!! Where should these point to? pointer to an empty array which will be filled in the land.... print *, "creatibg field lists: l2c_fldlist !" l2c_fldlist(1)%stdname = 'lwup' From 67c746f0911ba83cb103b7fc25b9880fa20df7b7 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 3 May 2019 12:50:49 -0600 Subject: [PATCH 090/556] testing different mesh for land and atmos....Fail --- lilac/scripts/cpl_mod.F90 | 2 ++ lilac/scripts/demo_driver.F90 | 24 ++++++++++++++++++++++++ lilac/scripts/lilac_mod.F90 | 27 +++++++++++++++------------ lilac/scripts/lnd_cap.F90 | 4 ++-- 4 files changed, 43 insertions(+), 14 deletions(-) diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index f8f0dd0439..1c84f493bb 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -112,6 +112,7 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) call ESMF_StateGet(importState, "a2c_fb", import_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -122,6 +123,7 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) ! For ReGridding call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) end subroutine cpl_atm2lnd_init !-------------------------------------------------------------------------- diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 83ae1e82d3..1cbb47ac85 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -1,6 +1,30 @@ program demo_lilac_driver + !*** All the components are in the hierarchy seen here: + ! + ! main driver* (WRF) + ! | + ! | + ! lilac (not a gridded component!) + ! | |________________________. + ! | | + ! atmos cap land cap ____________. ......... gridded components + ! | | | + ! | | river cap + ! oceaan (MOM, POM)? | | + ! | Mizzouroute... + ! CTSM + ! + ! + ! + ! + ! + ! + ! * aka real atmos + !---------------------------------------------------------------------------- + ! modules + use ESMF use lilac_mod diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 279dcd00de..e73584bfe9 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -119,12 +119,12 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) - c2a_fldlist(1)%stdname = 'uwind' - c2a_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 - c2a_fldlist(2)%stdname = 'vwind' - c2a_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 - c2a_fldlist(3)%stdname = 'tbot' - c2a_fldlist(3)%farrayptr1d => atm2lnd1d%vwind + c2l_fldlist(1)%stdname = 'uwind' + c2l_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 + c2l_fldlist(2)%stdname = 'vwind' + c2l_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 + c2l_fldlist(3)%stdname = 'tbot' + c2l_fldlist(3)%farrayptr1d => atm2lnd1d%vwind @@ -132,22 +132,25 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) print *, "creatibg field lists: l2c_fldlist !" l2c_fldlist(1)%stdname = 'lwup' + l2c_fldlist(1)%farrayptr1d => lnd2atm1d%lwup print *, l2c_fldlist(1)%stdname l2c_fldlist(2)%stdname = 'taux' print *, l2c_fldlist(2)%stdname + l2c_fldlist(2)%farrayptr1d => lnd2atm1d%taux l2c_fldlist(3)%stdname = 'tauy' print *, l2c_fldlist(3)%stdname + l2c_fldlist(3)%farrayptr1d => lnd2atm1d%taux - c2l_fldlist(1)%stdname = 'uwind' - print *, c2l_fldlist(1)%stdname + c2a_fldlist(1)%stdname = 'uwind' + print *, c2a_fldlist(1)%stdname - c2l_fldlist(2)%stdname = 'vwind' - print *, c2l_fldlist(2)%stdname + c2a_fldlist(2)%stdname = 'vwind' + print *, c2a_fldlist(2)%stdname - c2l_fldlist(3)%stdname = 'tbot' - print *, c2l_fldlist(3)%stdname + c2a_fldlist(3)%stdname = 'tbot' + print *, c2a_fldlist(3)%stdname diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index 7fddc79ac9..4306714bfd 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -93,8 +93,8 @@ subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) if(mesh_switch) then print *, "creating mesh for land" ! For now this is our dummy mesh: - !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T62_040121_ESMFmesh.nc' - lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T62_040121_ESMFmesh.nc' + !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out From 303ade6dc6ad4bcd07d7e2bbf3d11b1db11fcfd4 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 3 May 2019 15:10:12 -0600 Subject: [PATCH 091/556] cleaning the code up! --- lilac/scripts/cpl_mod.F90 | 4 + lilac/scripts/demo_driver.F90 | 61 ++- lilac/scripts/lilac_mod.F90 | 902 ++++++++++++++++------------------ lilac/scripts/lnd_cap.F90 | 4 +- 4 files changed, 471 insertions(+), 500 deletions(-) diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index 1c84f493bb..e168400b56 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -116,11 +116,15 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"redisting !", ESMF_LOGMSG_INFO) ! For Redisting !call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! For ReGridding + call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + call ESMF_LogWrite(subname//"regridding !", ESMF_LOGMSG_INFO) call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 1cbb47ac85..b984da4016 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -1,5 +1,6 @@ program demo_lilac_driver + !---------------------------------------------------------------------------- !*** All the components are in the hierarchy seen here: ! ! main driver* (WRF) @@ -16,31 +17,27 @@ program demo_lilac_driver ! CTSM ! ! - ! - ! - ! - ! - ! * aka real atmos !---------------------------------------------------------------------------- ! modules - use ESMF use lilac_mod - use lilac_utils, only : atm2lnd_data1d_type , lnd2atm_data1d_type, atm2lnd_data2d_type, atm2lnd_data2d_type + implicit none + + ! TO DO: change the name and the derived data types + ! data types for 1d arrays for meshes type (atm2lnd_data1d_type) :: atm2lnd type (lnd2atm_data1d_type) :: lnd2atm - integer :: begc,endc - - real, dimension(100,100), target :: dum_var1 - real, dimension(4608) :: dum_var2 + real , allocatable :: rand1(:) + real , allocatable :: rand2(:) - integer, dimension(:), allocatable :: seed + integer , allocatable :: seed(:) integer :: seed_val, n + integer :: begc,endc integer :: start_time !-- start_time start time integer :: end_time !-- end_time end time integer :: curr_time !-- cur_time current time @@ -48,7 +45,7 @@ program demo_lilac_driver !------------------------------------------------------------------------ - + ! real atmosphere: begc = 1 endc = 4608 @@ -61,50 +58,50 @@ program demo_lilac_driver - + ! making 2 random arrays with a seed. call random_seed (size = n) allocate (seed(n)) ; seed (:) = seed_val call random_seed (put = seed) - call random_number (dum_var2) + allocate (rand1(begc:endc)) ; call random_number (rand1) + allocate (rand2(begc:endc)) ; call random_number (rand2) - allocate( atm2lnd%uwind (begc:endc) ) ; atm2lnd%uwind (:) = dum_var2 - allocate( atm2lnd%vwind (begc:endc) ) ; atm2lnd%vwind (:) = dum_var2 - allocate( atm2lnd%tbot (begc:endc) ) ; atm2lnd%tbot (:) = dum_var2 + allocate( atm2lnd%uwind (begc:endc) ) ; atm2lnd%uwind (:) = rand1 + allocate( atm2lnd%vwind (begc:endc) ) ; atm2lnd%vwind (:) = rand1 + allocate( atm2lnd%tbot (begc:endc) ) ; atm2lnd%tbot (:) = rand1 + + !endc = 18048 ? should this be the size of the land or atmosphere??? + + allocate( lnd2atm%lwup (begc:endc) ) ; lnd2atm%lwup (:) = rand2 + allocate( lnd2atm%taux (begc:endc) ) ; lnd2atm%taux (:) = rand2 + allocate( lnd2atm%tauy (begc:endc) ) ; lnd2atm%tauy (:) = rand2 - allocate( lnd2atm%lwup (begc:endc) ) ; lnd2atm%lwup (:) = dum_var2 - allocate( lnd2atm%taux (begc:endc) ) ; lnd2atm%taux (:) = dum_var2 - allocate( lnd2atm%tauy (begc:endc) ) ; lnd2atm%tauy (:) = dum_var2 print *, "=======================================" print *, atm2lnd%uwind(1:10) print *, "=======================================" - - ! dummy looping over imaginary time .... + !------------------------------------------------------------------------ + ! looping over imaginary time .... + !------------------------------------------------------------------------ do curr_time = start_time, end_time - - if (curr_time == start_time) then + if (curr_time == start_time) then ! Initalization phase call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) - - else if (curr_time == end_time) then - !Finalization phase + else if (curr_time == end_time ) then + ! Finalization phase call lilac_final ( ) call ESMF_Finalize ( ) - else call lilac_run ( ) endif - itime_step = itime_step + 1 - end do print *, "=======================================" print *, " ............. DONE ..................." - + print *, "=======================================" end program demo_lilac_driver diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index e73584bfe9..2c6d7fb20d 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -1,490 +1,460 @@ module lilac_mod -use ESMF -use lilac_utils -use atmos_cap , only : atmos_register -use lnd_cap , only : lnd_register -use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! !USES + use ESMF + use lilac_utils + use atmos_cap , only : atmos_register + use lnd_cap , only : lnd_register + use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register -implicit none + implicit none - ! Clock, TimeInterval, and Times - type(ESMF_Clock) :: clock - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime - type(ESMF_Time) :: stopTime - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar),target :: calendar - integer :: yy,mm,dd,sec - character(*), parameter :: modname = "lilac_mod" - !type(fld_list_type), public :: a2c_fldlist, c2a_fldlist + public :: lilac_init + public :: lilac_run - !------------------------------------------------------------------------ - - public :: lilac_init - public :: lilac_run - - !------------------------------------------------------------------------ - - ! ! Gridded Components and Coupling Components - type(ESMF_GridComp) :: dummy_atmos_comp - type(ESMF_GridComp) :: dummy_land_comp - type(ESMF_CplComp) :: cpl_atm2lnd_comp - type(ESMF_CplComp) :: cpl_lnd2atm_comp - type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state - type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state - - contains - - subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) - - use atmos_cap, only : a2c_fldlist, c2a_fldlist - use lnd_cap, only : l2c_fldlist, c2l_fldlist - ! type(fld_list_type) :: a2c_fldlist , c2a_fldlist - ! input/output variables - type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d - type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d - type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d - type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d - - ! local variables - - - - type(ESMF_State) :: coupledFlowState ! the coupled flow State - type(ESMF_Mesh) :: Emesh - character(len=*), parameter :: subname=trim(modname)//': [lilac_init]' - type(ESMF_State) :: importState, exportState - - !character(len=*) :: atm_mesh_filepath !!! For now this is hard - !coded in the atmos init - - ! local variables - integer :: rc, urc - character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names - character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names - !integer, parameter :: fldsMax = 100 - integer :: a2l_fldnum, l2a_fldnum - logical :: mesh_switch + character(*) , parameter :: modname = "lilac_mod" + !type(fld_list_type), public :: a2c_fldlist, c2a_fldlist !------------------------------------------------------------------------ - - mesh_switch = .True. - - !------------------------------------------------------------------------- - ! Initialize ESMF, set the default calendar and log type. - !------------------------------------------------------------------------- - call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - print *, "---------------------------------------" - print *, " Lilac Demo Application Start " - - !------------------------------------------------------------------------- - ! Create Field lists -- Basically create a list of fields and add a default - ! value to them. - !------------------------------------------------------------------------- - a2l_fldnum = 3 - l2a_fldnum = 3 - - allocate (a2c_fldlist(a2l_fldnum)) - allocate (c2a_fldlist(l2a_fldnum)) - - allocate (l2c_fldlist(l2a_fldnum)) - allocate (c2l_fldlist(a2l_fldnum)) - - print *, "creatibg field lists: a2c_fldlist !" -! call create_fldlists(c2a_fldlist, a2c_fldlist, a2l_fldnum, l2a_fldnum) - - - a2c_fldlist(1)%stdname = 'uwind' - a2c_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 - print *, a2c_fldlist(1)%stdname - !print *, a2c_fldlist(1)%farrayptr1d(:) - a2c_fldlist(2)%stdname = 'vwind' - a2c_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 - print *, a2c_fldlist(2)%stdname - !print *, a2c_fldlist(2)%farrayptr1d(:) - a2c_fldlist(3)%stdname = 'tbot' - a2c_fldlist(3)%farrayptr1d => atm2lnd1d%vwind - print *, a2c_fldlist(3)%stdname - !print *, a2c_fldlist(3)%farrayptr1d - - !call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num) - - ! Similary we need c2a_fldlist - - - - c2l_fldlist(1)%stdname = 'uwind' - c2l_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 - c2l_fldlist(2)%stdname = 'vwind' - c2l_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 - c2l_fldlist(3)%stdname = 'tbot' - c2l_fldlist(3)%farrayptr1d => atm2lnd1d%vwind - - - - !!! Where should these point to? pointer to an empty array which will be filled in the land.... - - print *, "creatibg field lists: l2c_fldlist !" - l2c_fldlist(1)%stdname = 'lwup' - l2c_fldlist(1)%farrayptr1d => lnd2atm1d%lwup - print *, l2c_fldlist(1)%stdname - - l2c_fldlist(2)%stdname = 'taux' - print *, l2c_fldlist(2)%stdname - l2c_fldlist(2)%farrayptr1d => lnd2atm1d%taux - - l2c_fldlist(3)%stdname = 'tauy' - print *, l2c_fldlist(3)%stdname - l2c_fldlist(3)%farrayptr1d => lnd2atm1d%taux - - c2a_fldlist(1)%stdname = 'uwind' - print *, c2a_fldlist(1)%stdname - - c2a_fldlist(2)%stdname = 'vwind' - print *, c2a_fldlist(2)%stdname - - c2a_fldlist(3)%stdname = 'tbot' - print *, c2a_fldlist(3)%stdname - - - - - - !------------------------------------------------------------------------- - ! Create Gridded Component! --- dummy atmosphere - !------------------------------------------------------------------------- - gcname1 = "Dummy Atmosphere or Atmosphere Cap" - - dummy_atmos_comp = ESMF_GridCompCreate(name=gcname1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(gcname1)//" component", ESMF_LOGMSG_INFO) - print *, "Dummy Atmosphere Gridded Component Created!" - - !------------------------------------------------------------------------- - ! Create Gridded Component! --- dummy land (land cap) - !------------------------------------------------------------------------- - gcname2 = "Dummy Land or Land Cap" - - dummy_land_comp = ESMF_GridCompCreate(name=gcname2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(gcname2)//" component", ESMF_LOGMSG_INFO) - print *, "Dummy Land Gridded Component Created!" - - !------------------------------------------------------------------------- - ! Create Coupling Component! --- Coupler from atmos to land - !------------------------------------------------------------------------- - ccname1 = "Coupler from atmosphere to land" - cpl_atm2lnd_comp = ESMF_CplCompCreate(name=ccname1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(ccname1)//" component", ESMF_LOGMSG_INFO) - print *, "1st Coupler Gridded Component (atmosphere to land ) Created!" - - !------------------------------------------------------------------------- - ! Create Coupling Component! -- Coupler from land to atmos - !------------------------------------------------------------------------- - ccname2 = "Coupler from land to atmosphere" - cpl_lnd2atm_comp = ESMF_CplCompCreate(name=ccname2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(ccname2)//" component", ESMF_LOGMSG_INFO) - print *, "2nd Coupler Gridded Component (land to atmosphere) Created!" - - ! ======================================================================== - - !------------------------------------------------------------------------- - ! Register section -- set services -- dummy atmosphere - !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(dummy_atmos_comp, userRoutine=atmos_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"dummy atmos SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Dummy Atmosphere Gridded Component SetServices finished!" - !------------------------------------------------------------------------- - ! Register section -- set services -- land cap - !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(dummy_land_comp, userRoutine=lnd_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Land Gridded Component SetServices finished!" - !------------------------------------------------------------------------- - ! Register section -- set services -- coupler atmosphere to land - !------------------------------------------------------------------------- - call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Coupler from atmosphere to land SetServices finished!" - !------------------------------------------------------------------------- - ! Register section -- set services -- coupler land to atmosphere - !------------------------------------------------------------------------- - call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_lnd2atm_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Coupler from land to atmosphere SetServices finished!" - - ! ======================================================================== - - !------------------------------------------------------------------------- - ! Create and initialize a clock! - ! ????? Should I create a clock here or in driver? - !------------------------------------------------------------------------- - calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) - !EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - - !------------------------------------------------------------------------- - ! Create the necessary import and export states used to pass data - ! between components. - !------------------------------------------------------------------------- - - ! following 4 states are lilac module variables - - atm2lnd_a_state = ESMF_StateCreate(name=gcname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - atm2lnd_l_state = ESMF_StateCreate(name=gcname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - lnd2atm_a_state = ESMF_StateCreate(name=gcname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - lnd2atm_l_state = ESMF_StateCreate(name=gcname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_LogWrite(subname//"Empty import and export states are created!!", ESMF_LOGMSG_INFO) - print *, "Empty import and export states are created!!" - - ! returns a valid state_to_lnd_atm and an empty state_from_land_atmgrid - ! ======================================================================== - !------------------------------------------------------------------------- - ! Grid Componenet Initialization -- 1- atmos cap 2- lnd cap 3- cpl_atm2lnd - ! 4- cpl_lnd2atm - !------------------------------------------------------------------------- - - call ESMF_GridCompInitialize(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp initialized", ESMF_LOGMSG_INFO) - print *, "atmos_cap initialize finished, rc =", rc - - call ESMF_GridCompInitialize(dummy_land_comp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp initialized", ESMF_LOGMSG_INFO) - print *, "lnd_cap initialize finished, rc =", rc - - ! All 4 states that are module variables are no longer empty - have been initialized - - call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) - print *, "coupler :: cpl_atm2lnd_comp initialize finished, rc =", rc - - call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) - print *, "coupler :: cpl_lnd2atm_comp initialize finished, rc =", rc - - end subroutine lilac_init - - subroutine lilac_run( ) - - use atmos_cap, only : a2c_fldlist, c2a_fldlist - use lnd_cap, only : l2c_fldlist, c2l_fldlist - ! type(fld_list_type) :: a2c_fldlist , c2a_fldlist - ! input/output variables - !type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d - !type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d - !type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d - !type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d - - ! local variables + ! !Clock, TimeInterval, and Times + type(ESMF_Clock) :: clock + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_Time) :: stopTime + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar),target :: calendar + integer :: yy,mm,dd,sec ! ! Gridded Components and Coupling Components - !type(ESMF_GridComp) :: dummy_atmos_comp - !type(ESMF_GridComp) :: dummy_land_comp - - !integer, parameter :: fldsMax = 100 - !integer :: fldsToLnd_num = 0 - !integer :: fldsFrLnd_num = 0 - - - character(len=*), parameter :: subname=trim(modname)//': [lilac_run]' - type(ESMF_State) :: importState, exportState - - ! local variables - integer :: rc, urc - character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names - character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names - !integer, parameter :: fldsMax = 100 - integer :: a2l_fldnum, l2a_fldnum - logical :: mesh_switch - + type(ESMF_GridComp) :: dummy_atmos_comp + type(ESMF_GridComp) :: dummy_land_comp + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp + type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state + type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state !------------------------------------------------------------------------ - ! Initialize return code - rc = ESMF_SUCCESS - - mesh_switch = .True. - - !------------------------------------------------------------------------- - ! Initialize ESMF, set the default calendar and log type. - !------------------------------------------------------------------------- - call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" - print *, " Lilac Run " - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" - - - !------------------------------------------------------------------------- - ! Gridded Component Run! --- dummy atmosphere - !------------------------------------------------------------------------- - call ESMF_GridCompRun(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) - print *, "Running atmos_cap gridded component , rc =", rc - - call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) - print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc - call ESMF_GridCompRun(dummy_land_comp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp is running", ESMF_LOGMSG_INFO) - print *, "Running lnd_cap gridded component , rc =", rc + contains - call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) - print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc + subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) - !search through fldlist array to find the right fldist object to do the copy - say its index N + use atmos_cap , only : a2c_fldlist, c2a_fldlist + use lnd_cap , only : l2c_fldlist, c2l_fldlist - !x2a_fields(n)%datafld1d(:) = dum_var_input(:) + character(len=*), parameter :: subname=trim(modname)//': [lilac_init]' - !call ESMF_CplCompRun(cpl_atm2lnd, rc=rc) + ! input/output variables + type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d + type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d + type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d + type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d - !call ESMF_GridCompRun(lndcomp, rc=rc) + ! local variables - !call ESMF_CplCompRun(cpl_lnd2atm, rc=rc) + type(ESMF_State) :: importState, exportState - !dum_var_output(:) = a2x_fields(N)%datafld1d(:) + !character(len=*) :: atm_mesh_filepath !!! For now this is hardcoded in the atmos init - end subroutine lilac_run + integer :: rc , urc + character(len=ESMF_MAXSTR) :: gcname1 , gcname2 ! Gridded components names + character(len=ESMF_MAXSTR) :: ccname1 , ccname2 ! Coupling components names + integer :: a2l_fldnum , l2a_fldnum + !------------------------------------------------------------------------ - subroutine lilac_final( ) - - use atmos_cap, only : a2c_fldlist, c2a_fldlist - use lnd_cap, only : l2c_fldlist, c2l_fldlist - ! type(fld_list_type) :: a2c_fldlist , c2a_fldlist - ! input/output variables - !type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d - !type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d - !type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d - !type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d - - ! local variables - ! ! Gridded Components and Coupling Components - !type(ESMF_GridComp) :: dummy_atmos_comp - !type(ESMF_GridComp) :: dummy_land_comp - - !integer, parameter :: fldsMax = 100 - !integer :: fldsToLnd_num = 0 - !integer :: fldsFrLnd_num = 0 - - - character(len=*), parameter :: subname=trim(modname)//': [lilac_final]' - type(ESMF_State) :: importState, exportState - - ! local variables - integer :: rc, urc - character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names - character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names - !integer, parameter :: fldsMax = 100 - integer :: a2l_fldnum, l2a_fldnum - logical :: mesh_switch - - !------------------------------------------------------------------------ - !------------------------------------------------------------------------ - ! Initialize return code - rc = ESMF_SUCCESS - mesh_switch = .True. - - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" - print *, " Lilac Finalizing " - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" - !------------------------------------------------------------------------- - ! Gridded Component Finalizing! --- dummy atmosphere - !------------------------------------------------------------------------- - call ESMF_GridCompFinalize(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) - print *, "Finalizing atmos_cap gridded component , rc =", rc - - !------------------------------------------------------------------------- - ! Coupler component Finalizing --- coupler atmos to land - !------------------------------------------------------------------------- - call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) - print *, "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc - - !------------------------------------------------------------------------- - ! Gridded Component Finalizing! --- dummy land - !------------------------------------------------------------------------- - call ESMF_GridCompFinalize(dummy_land_comp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp is running", ESMF_LOGMSG_INFO) - print *, "Finalizing lnd_cap gridded component , rc =", rc - - !------------------------------------------------------------------------- - ! Coupler component Finalizing --- coupler land to atmos - !------------------------------------------------------------------------- - call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) - print *, "Finalizing coupler component..... cpl_lnd2atm_comp , rc =", rc - - - ! Then clean them up - call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//"destroying all states ", ESMF_LOGMSG_INFO) - - print *, "ready to destroy all states" - call ESMF_StateDestroy(atm2lnd_a_state , rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateDestroy(atm2lnd_l_state, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateDestroy(lnd2atm_a_state, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateDestroy(lnd2atm_l_state, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_LogWrite(subname//"destroying all components ", ESMF_LOGMSG_INFO) - print *, "ready to destroy all components" - - call ESMF_GridCompDestroy(dummy_atmos_comp, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_GridCompDestroy(dummy_land_comp, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_CplCompDestroy(cpl_atm2lnd_comp, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_CplCompDestroy(cpl_lnd2atm_comp, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) - print *, "end of CoupledFlowMod Finalization routine" - - end subroutine lilac_final - - - -end module lilac_mod + a2l_fldnum = 3 + l2a_fldnum = 3 + + !------------------------------------------------------------------------- + ! Initialize ESMF, set the default calendar and log type. + !------------------------------------------------------------------------- + call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + print *, "---------------------------------------" + print *, " Lilac Demo Application Start " + print *, "---------------------------------------" + + !------------------------------------------------------------------------- + ! Create Field lists -- Basically create a list of fields and add a default + ! value to them. + !------------------------------------------------------------------------- + + allocate (a2c_fldlist(a2l_fldnum)) + allocate (c2a_fldlist(l2a_fldnum)) + + allocate (l2c_fldlist(l2a_fldnum)) + allocate (c2l_fldlist(a2l_fldnum)) + print *, "creating empty field lists !" + ! call create_fldlists(c2a_fldlist, a2c_fldlist, a2l_fldnum, l2a_fldnum) + !call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num) + + a2c_fldlist(1)%stdname = 'uwind' + a2c_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 + print *, a2c_fldlist(1)%stdname + !print *, a2c_fldlist(1)%farrayptr1d(:) + a2c_fldlist(2)%stdname = 'vwind' + a2c_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 + print *, a2c_fldlist(2)%stdname + !print *, a2c_fldlist(2)%farrayptr1d(:) + a2c_fldlist(3)%stdname = 'tbot' + a2c_fldlist(3)%farrayptr1d => atm2lnd1d%vwind + print *, a2c_fldlist(3)%stdname + !print *, a2c_fldlist(3)%farrayptr1d + + + ! Similary we need c2a_fldlist + c2l_fldlist(1)%stdname = 'uwind' + !c2l_fldlist(1)%farrayptr1d => lnd2atm1d%lwup !*** this now sets the module variable memory in atmos_cap.F90 + print *, c2l_fldlist(1)%stdname + c2l_fldlist(2)%stdname = 'vwind' + !c2l_fldlist(2)%farrayptr1d => lnd2atm1d%taux !*** this now sets the module variable memory in atmos_cap.F90 + print *, c2l_fldlist(1)%stdname + c2l_fldlist(3)%stdname = 'tbot' + !c2l_fldlist(3)%farrayptr1d => lnd2atm1d%tauy + print *, c2l_fldlist(1)%stdname + + + + !!! Where should these point to? pointer to an empty array which will be filled in the land.... + + l2c_fldlist(1)%stdname = 'lwup' + l2c_fldlist(1)%farrayptr1d => lnd2atm1d%lwup + print *, l2c_fldlist(1)%stdname + + l2c_fldlist(2)%stdname = 'taux' + print *, l2c_fldlist(2)%stdname + l2c_fldlist(2)%farrayptr1d => lnd2atm1d%taux + + l2c_fldlist(3)%stdname = 'tauy' + print *, l2c_fldlist(3)%stdname + l2c_fldlist(3)%farrayptr1d => lnd2atm1d%taux + + + c2a_fldlist(1)%stdname = 'lwup' + print *, c2a_fldlist(1)%stdname + + c2a_fldlist(2)%stdname = 'taux' + print *, c2a_fldlist(2)%stdname + + c2a_fldlist(3)%stdname = 'tauy' + print *, c2a_fldlist(3)%stdname + + !------------------------------------------------------------------------- + ! Create Gridded Component! --- dummy atmosphere ( atmos_cap) + !------------------------------------------------------------------------- + gcname1 = "Dummy Atmosphere or Atmosphere Cap" + dummy_atmos_comp = ESMF_GridCompCreate(name=gcname1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(gcname1)//" component", ESMF_LOGMSG_INFO) + print *, "Dummy Atmosphere Gridded Component Created!" + + !------------------------------------------------------------------------- + ! Create Gridded Component! --- dummy land ( land cap ) + !------------------------------------------------------------------------- + gcname2 = "Dummy Land or Land Cap" + dummy_land_comp = ESMF_GridCompCreate(name=gcname2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(gcname2)//" component", ESMF_LOGMSG_INFO) + print *, "Dummy Land Gridded Component Created!" + + !------------------------------------------------------------------------- + ! Create Coupling Component! --- Coupler from atmos to land + !------------------------------------------------------------------------- + ccname1 = "Coupler from atmosphere to land" + cpl_atm2lnd_comp = ESMF_CplCompCreate(name=ccname1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(ccname1)//" component", ESMF_LOGMSG_INFO) + print *, "1st Coupler Component (atmosphere to land ) Created!" + + !------------------------------------------------------------------------- + ! Create Coupling Component! -- Coupler from land to atmos + !------------------------------------------------------------------------- + ccname2 = "Coupler from land to atmosphere" + cpl_lnd2atm_comp = ESMF_CplCompCreate(name=ccname2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(ccname2)//" component", ESMF_LOGMSG_INFO) + print *, "2nd Coupler Component (land to atmosphere) Created!" + + ! ======================================================================== + + !------------------------------------------------------------------------- + ! Register section -- set services -- atmos_cap + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(dummy_atmos_comp, userRoutine=atmos_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"dummy atmos SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Dummy Atmosphere Gridded Component SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- land cap + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(dummy_land_comp, userRoutine=lnd_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Land Gridded Component SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- coupler atmosphere to land + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Coupler from atmosphere to land SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- coupler land to atmosphere + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_lnd2atm_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Coupler from land to atmosphere SetServices finished!" + + ! ======================================================================== + + !------------------------------------------------------------------------- + ! Create and initialize a clock! + ! ????? Should I create a clock here or in driver? + !------------------------------------------------------------------------- + calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) + !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) + !EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) + + !------------------------------------------------------------------------- + ! Create the necessary import and export states used to pass data + ! between components. + !------------------------------------------------------------------------- + + ! following 4 states are lilac module variables + + atm2lnd_a_state = ESMF_StateCreate(name=gcname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + atm2lnd_l_state = ESMF_StateCreate(name=gcname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + lnd2atm_a_state = ESMF_StateCreate(name=gcname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + lnd2atm_l_state = ESMF_StateCreate(name=gcname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_LogWrite(subname//"Empty import and export states are created!!", ESMF_LOGMSG_INFO) + print *, "Empty import and export states are created!!" + + ! returns a valid state_to_lnd_atm and an empty state_from_land_atmgrid + + ! ------------------------------------------------------------------------- + ! Grid Componenet Initialization -- 1- atmos cap 2- lnd cap ! + ! 3- cpl_atm2lnd 4- cpl_lnd2atm ! + ! ------------------------------------------------------------------------- + + call ESMF_GridCompInitialize(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp initialized", ESMF_LOGMSG_INFO) + print *, "atmos_cap initialize finished, rc =", rc + + call ESMF_GridCompInitialize(dummy_land_comp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp initialized", ESMF_LOGMSG_INFO) + print *, "lnd_cap initialize finished, rc =", rc + + ! All 4 states that are module variables are no longer empty - have been initialized + + call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) + print *, "coupler :: cpl_atm2lnd_comp initialize finished, rc =", rc + + call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) + print *, "coupler :: cpl_lnd2atm_comp initialize finished, rc =", rc + + end subroutine lilac_init + + subroutine lilac_run( ) + + use atmos_cap, only : a2c_fldlist, c2a_fldlist + use lnd_cap, only : l2c_fldlist, c2l_fldlist + + character(len=*), parameter :: subname=trim(modname)//': [lilac_run]' + type(ESMF_State) :: importState, exportState + + ! local variables + integer :: rc, urc + character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names + character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names + !integer, parameter :: fldsMax = 100 + integer :: a2l_fldnum, l2a_fldnum + + ! type(fld_list_type) :: a2c_fldlist , c2a_fldlist + ! input/output variables + !type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d + !type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d + !type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d + !type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d + + ! local variables + ! ! Gridded Components and Coupling Components + !type(ESMF_GridComp) :: dummy_atmos_comp + !type(ESMF_GridComp) :: dummy_land_comp + + + + !------------------------------------------------------------------------ + ! Initialize return code + rc = ESMF_SUCCESS + + + !------------------------------------------------------------------------- + ! Initialize ESMF, set the default calendar and log type. + !------------------------------------------------------------------------- + call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + print *, " Lilac Run " + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + + !------------------------------------------------------------------------- + ! We are running components in this order: + ! 1- atmos_cap 2- cpl_atm2lnd + ! 3- lnd_cap 4- cpl_lnd2atm + !------------------------------------------------------------------------- + call ESMF_GridCompRun(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) + print *, "Running atmos_cap gridded component , rc =", rc + + call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) + print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc + + call ESMF_GridCompRun(dummy_land_comp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp is running", ESMF_LOGMSG_INFO) + print *, "Running lnd_cap gridded component , rc =", rc + + call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) + print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc + + end subroutine lilac_run + + + subroutine lilac_final( ) + + use atmos_cap, only : a2c_fldlist, c2a_fldlist + use lnd_cap, only : l2c_fldlist, c2l_fldlist + + ! type(fld_list_type) :: a2c_fldlist , c2a_fldlist + ! input/output variables + !type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d + !type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d + !type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d + !type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d + + ! local variables + ! ! Gridded Components and Coupling Components + !type(ESMF_GridComp) :: dummy_atmos_comp + !type(ESMF_GridComp) :: dummy_land_comp + + !integer, parameter :: fldsMax = 100 + !integer :: fldsToLnd_num = 0 + !integer :: fldsFrLnd_num = 0 + + + character(len=*), parameter :: subname=trim(modname)//': [lilac_final]' + type(ESMF_State) :: importState, exportState + + ! local variables + integer :: rc, urc + character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names + character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names + !integer, parameter :: fldsMax = 100 + integer :: a2l_fldnum, l2a_fldnum + + !------------------------------------------------------------------------ + !------------------------------------------------------------------------ + ! Initialize return code + rc = ESMF_SUCCESS + + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + print *, " Lilac Finalizing " + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + !------------------------------------------------------------------------- + ! Gridded Component Finalizing! --- dummy atmosphere + !------------------------------------------------------------------------- + call ESMF_GridCompFinalize(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) + print *, "Finalizing atmos_cap gridded component , rc =", rc + + !------------------------------------------------------------------------- + ! Coupler component Finalizing --- coupler atmos to land + !------------------------------------------------------------------------- + call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) + print *, "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc + + !------------------------------------------------------------------------- + ! Gridded Component Finalizing! --- dummy land + !------------------------------------------------------------------------- + call ESMF_GridCompFinalize(dummy_land_comp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp is running", ESMF_LOGMSG_INFO) + print *, "Finalizing lnd_cap gridded component , rc =", rc + + !------------------------------------------------------------------------- + ! Coupler component Finalizing --- coupler land to atmos + !------------------------------------------------------------------------- + call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) + print *, "Finalizing coupler component..... cpl_lnd2atm_comp , rc =", rc + + + ! Then clean them up + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"destroying all states ", ESMF_LOGMSG_INFO) + + print *, "ready to destroy all states" + call ESMF_StateDestroy(atm2lnd_a_state , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(atm2lnd_l_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(lnd2atm_a_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(lnd2atm_l_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_LogWrite(subname//"destroying all components ", ESMF_LOGMSG_INFO) + print *, "ready to destroy all components" + + call ESMF_GridCompDestroy(dummy_atmos_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_GridCompDestroy(dummy_land_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompDestroy(cpl_atm2lnd_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompDestroy(cpl_lnd2atm_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + print *, "end of Lilac Finalization routine" + + end subroutine lilac_final + + + + end module lilac_mod diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index 4306714bfd..7fddc79ac9 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -93,8 +93,8 @@ subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) if(mesh_switch) then print *, "creating mesh for land" ! For now this is our dummy mesh: - lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T62_040121_ESMFmesh.nc' - !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T62_040121_ESMFmesh.nc' + lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out From 90c562f4eca7709eda3c6afdb1b8e632ab40e25f Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 3 May 2019 16:57:30 -0600 Subject: [PATCH 092/556] coupler code clean up --- lilac/scripts/cpl_mod.F90 | 243 ++++++++++++++++++-------------------- 1 file changed, 113 insertions(+), 130 deletions(-) diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index e168400b56..3ea05d60ee 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -1,45 +1,52 @@ module cpl_mod + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing all routines for both couplers + ! 1- coupler 1 : atm ---> lnd (cpl_atm2lnd) + ! 2- coupler 2 : lnd ---> atm (cpl_lnd2atm) + !----------------------------------------------------------------------- + use ESMF implicit none private - type(ESMF_RouteHandle), save :: rh_atm2lnd, rh_lnd2atm - - public cpl_atm2lnd_register public cpl_lnd2atm_register character(*), parameter :: modname = " cpl_mod" + type(ESMF_RouteHandle), save :: rh_atm2lnd, rh_lnd2atm - contains + !----------------------------------------------------------------------- + contains + !----------------------------------------------------------------------- subroutine cpl_atm2lnd_register(cplcomp, rc) - type(ESMF_CplComp) :: cplcomp - integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':[cpl_atm2lnd_register] ' + type(ESMF_CplComp ) :: cplcomp + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname ) //':[cpl_atm2lnd_register] ' rc = ESMF_SUCCESS print *, "in cpl_atm2lnd_register routine" ! Register the callback routines. ! Set the entry points for coupler ESMF Component methods - !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_atm2lnd_init, rc=rc) call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine= cpl_atm2lnd_init, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_atm2lnd_run , rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_atm2lnd_final, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - end subroutine cpl_atm2lnd_register subroutine cpl_lnd2atm_register(cplcomp, rc) - type(ESMF_CplComp) :: cplcomp - integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//' : [cpl_lnd2atm_register] ' + type(ESMF_CplComp ) :: cplcomp + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname ) //' : [cpl_lnd2atm_register] ' rc = ESMF_SUCCESS @@ -47,64 +54,29 @@ subroutine cpl_lnd2atm_register(cplcomp, rc) ! Register the callback routines. ! Set the entry points for coupler ESMF Component methods - !call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_lnd2atm_init, rc=rc) call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_lnd2atm_init, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_lnd2atm_run , rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_lnd2atm_final, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - end subroutine cpl_lnd2atm_register !-------------------------------------------------------------------------- + ! couplers init.... !-------------------------------------------------------------------------- - subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: cplcomp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - - character(len=*), parameter :: subname=trim(modname)//': [cpl_lnd2atm_init] ' - - rc = ESMF_SUCCESS - print *, "Coupler for land to atmosphere initialize routine called" - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - - call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - - call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! For Redisting - !call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! For ReGridding - call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - !call ESMF_StateGet(importState, itemname="a2c_fb", item=import_fieldbundle, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - !call ESMF_StateGet(exportState, itemname="c2a_fb", item=export_fieldbundle, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - !call ESMF_FieldRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - end subroutine cpl_lnd2atm_init - subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: cplcomp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - character(len=*), parameter :: subname=trim(modname)//': [cpl_atm2lnd_init] ' + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname) //': [cpl_atm2lnd_init] ' rc = ESMF_SUCCESS print *, "Coupler for atmosphere to land initialize routine called" @@ -112,41 +84,28 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) call ESMF_StateGet(importState, "a2c_fb", import_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//"redisting !", ESMF_LOGMSG_INFO) - - ! For Redisting - !call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! For ReGridding - call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - call ESMF_LogWrite(subname//"regridding !", ESMF_LOGMSG_INFO) + call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) end subroutine cpl_atm2lnd_init - !-------------------------------------------------------------------------- - !-------------------------------------------------------------------------- - - subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: cplcomp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) - character(len=*), parameter :: subname=trim(modname)//': [cpl_lnd2atm_run] ' + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_lnd2atm_init] ' rc = ESMF_SUCCESS - + print *, "Coupler for land to atmosphere initialize routine called" call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - print *, "Running cpl_lnd2atm_run" call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -154,32 +113,28 @@ subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !call ESMF_StateGet(importState, itemname=importStateName, item=srcFieldBundle, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - !call ESMF_StateGet(exportState, itemname=exportStateName, item=dstFieldBundle, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - !call ESMF_FieldBundleRegrid(srcFieldBundle, dstFieldBundle, rh_lnd2atm, rc=rc) - call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//" regridding fieldbundles from land to atmos!", ESMF_LOGMSG_INFO) - !routehandle, zeroregion, termorderflag, checkflag, rc) - end subroutine cpl_lnd2atm_run + call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) + end subroutine cpl_lnd2atm_init + + !-------------------------------------------------------------------------- + ! Couplers Run phase + !-------------------------------------------------------------------------- subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: cplcomp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - character(len=*), parameter :: subname=trim(modname)//': [cpl_atm2lnd_run] ' + type(ESMF_CplComp ) :: cplcomp + type(ESMF_State ) :: importState + type(ESMF_State ) :: exportState + type(ESMF_Clock ) :: clock + integer, intent(out ) :: rc + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_run] ' rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) print *, "Running cpl_atm2lnd_run" - + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) call ESMF_StateGet(importState, trim("a2c_fb"), import_fieldbundle, rc=rc) !call ESMF_StateGet(importState, itemName=trim("a2c_fb"), item=import_fieldbundle, rc=rc) ! this syntax was not working??? @@ -189,61 +144,89 @@ subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) call ESMF_StateGet(exportState, trim("c2l_fb"), export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//" got c2l fieldbundle!", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - - !call ESMF_StateGet(importState, itemname=importStateName, item=srcFieldBundle, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - !call ESMF_StateGet(exportState, itemname=exportStateName, item=dstFieldBundle, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//" regridding fieldbundles from atmos to land!", ESMF_LOGMSG_INFO) + end subroutine cpl_atm2lnd_run - !routehandle, zeroregion, termorderflag, checkflag, rc) - end subroutine cpl_atm2lnd_run - subroutine cpl_lnd2atm_final(cplcomp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: cplcomp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) - character(len=*), parameter :: subname=trim(modname)//': [cpl_lnd2atm_final] ' + type(ESMF_CplComp ) :: cplcomp + type(ESMF_State ) :: importState + type(ESMF_State ) :: exportState + type(ESMF_Clock ) :: clock + integer, intent(out ) :: rc + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_lnd2atm_run] ' rc = ESMF_SUCCESS + print *, "Running cpl_lnd2atm_run" + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - ! Only thing to do here is release redist (or regrid) and route handles - call ESMF_FieldBundleRegridRelease (routehandle=rh_lnd2atm , rc=rc) + call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//" rh_lnd2atm route handle released!", ESMF_LOGMSG_INFO) - end subroutine cpl_lnd2atm_final + call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//" regridding fieldbundles from land to atmos!", ESMF_LOGMSG_INFO) + end subroutine cpl_lnd2atm_run + + !-------------------------------------------------------------------------- + ! couplers final phase + !-------------------------------------------------------------------------- subroutine cpl_atm2lnd_final(cplcomp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: cplcomp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - character(len=*), parameter :: subname=trim(modname)//': [cpl_atm2lnd_final] ' + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_final] ' rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + ! Only thing to do here is release redist (or regrid) and route handles call ESMF_FieldBundleRegridRelease (routehandle=rh_atm2lnd, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) call ESMF_LogWrite(subname//" rh_atm2lnd route handle released!", ESMF_LOGMSG_INFO) + end subroutine cpl_atm2lnd_final + subroutine cpl_lnd2atm_final(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname) //': [cpl_lnd2atm_final] ' + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_lnd2atm , rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_LogWrite(subname//" rh_lnd2atm route handle released!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2atm_final + + + From 070f6cc81c76fc325f7483fb0034b5024cd61653 Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 6 May 2019 15:25:30 -0600 Subject: [PATCH 093/556] saving this version of the code.... --- lilac/scripts/atmos_cap.F90 | 6 ++++- lilac/scripts/demo_driver.F90 | 2 +- lilac/scripts/lilac_mod.F90 | 16 ------------- lilac/scripts/lilac_utils.F90 | 42 +++++++++++++++++++++-------------- lilac/scripts/lnd_cap.F90 | 4 ++-- 5 files changed, 33 insertions(+), 37 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 14879732a2..8d255aeb8f 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -96,7 +96,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if(mesh_switch) then ! For now this is our dummy mesh: - atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + !atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv1.9x2.5_141008_ESMFmesh.nc' atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -128,6 +129,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) a2c_fb = ESMF_FieldBundleCreate(name="a2c_fb", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"field bundle", ESMF_LOGMSG_INFO) ! Create individual fields and add to field bundle -- a2l @@ -145,6 +147,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2c_fldlist(n)%stdname), rc=rc) field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! add field to field bundle call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index b984da4016..776723cc8b 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -47,7 +47,7 @@ program demo_lilac_driver ! real atmosphere: begc = 1 - endc = 4608 + endc = 13824 start_time = 1 end_time = 10 diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 2c6d7fb20d..4dc2720c80 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -355,22 +355,6 @@ subroutine lilac_final( ) use atmos_cap, only : a2c_fldlist, c2a_fldlist use lnd_cap, only : l2c_fldlist, c2l_fldlist - ! type(fld_list_type) :: a2c_fldlist , c2a_fldlist - ! input/output variables - !type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d - !type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d - !type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d - !type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d - - ! local variables - ! ! Gridded Components and Coupling Components - !type(ESMF_GridComp) :: dummy_atmos_comp - !type(ESMF_GridComp) :: dummy_land_comp - - !integer, parameter :: fldsMax = 100 - !integer :: fldsToLnd_num = 0 - !integer :: fldsFrLnd_num = 0 - character(len=*), parameter :: subname=trim(modname)//': [lilac_final]' type(ESMF_State) :: importState, exportState diff --git a/lilac/scripts/lilac_utils.F90 b/lilac/scripts/lilac_utils.F90 index 266b654532..4f26bae49b 100644 --- a/lilac/scripts/lilac_utils.F90 +++ b/lilac/scripts/lilac_utils.F90 @@ -1,12 +1,19 @@ module lilac_utils -use ESMF -implicit none -!!! NS: THIS IS FROM JH WORK - integer, parameter :: fldsMax = 100 + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! + !!! NS: THIS IS FROM JH WORK + + use ESMF + + implicit none public fldlist_add , create_fldlists + integer, parameter :: fldsMax = 100 + + ! !PUBLIC TYPES: type :: fld_list_type character(len=128) :: stdname real*8 :: default_value @@ -15,7 +22,7 @@ module lilac_utils real(ESMF_KIND_R8), pointer :: farrayptr2d(:,:) ! this will be filled in by lilac when it gets its data from the host atm end type fld_list_type -!!! 1d for when we have mesh and 2d for when we have grids.... + !!! 1d for when we have mesh and 2d for when we have grids.... type :: atm2lnd_data1d_type real*8, pointer :: uwind (:) @@ -41,9 +48,9 @@ module lilac_utils real*8, pointer :: tauy (:,:) end type lnd2atm_data2d_type -!=============================================================================== + !=============================================================================== contains -!=============================================================================== + !=============================================================================== subroutine fldlist_add(num, fldlist, stdname, default_value, units) ! This adds a field to a fieldlist! @@ -55,7 +62,7 @@ subroutine fldlist_add(num, fldlist, stdname, default_value, units) ! local variables integer :: rc - character(len=*), parameter :: subname='(fldlist_add)' + character(len=*), parameter :: subname='(fldlist_add)' !------------------------------------------------------------------------------- ! Set up a list of field information @@ -79,21 +86,22 @@ subroutine fldlist_add(num, fldlist, stdname, default_value, units) end subroutine fldlist_add - subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) - ! add all the necessary fields one by one to the fieldlist - type(fld_list_type), intent(inout) :: fldsFrCpl(:) - type(fld_list_type), intent(inout) :: fldsToCpl(:) - !integer, intent(out) :: fldsToCpl_num = 0 - !integer, intent(out) :: fldsFrCpl_num = 0 + subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist ) + ! add all the necessary fields one by one to the fieldlist + type(fld_list_type), intent(inout) :: a2c_fldlist + type(fld_list_type), intent(inout) :: c2a_fldlist + type(fld_list_type), intent(inout) :: l2c_fldlist + type(fld_list_type), intent(inout) :: c2l_fldlist + integer :: fldsFrCpl_num, fldsToCpl_num ! from atm - call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=0.0, units='m') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=0.0, units='m') ! from lnd - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'lnd2atmos_var', default_value=0.0, units='m') - + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'lnd2atmos_var', default_value=0.0, units='m') + ! sets the module variable memory in atmos_cap.F9 print *, a2c_fldlist(1)%stdname !!! First from atmosphere to land fields ! import fields ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index 7fddc79ac9..5c5a22f39c 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -94,8 +94,8 @@ subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) print *, "creating mesh for land" ! For now this is our dummy mesh: !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T62_040121_ESMFmesh.nc' - lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' - + !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Mesh for land is created!", ESMF_LOGMSG_INFO) From f060fde94431ffbc4ae291513f10ce684f83d8fc Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 14 May 2019 13:20:16 -0600 Subject: [PATCH 094/556] saving checkpoint using data types before restructuring to lilac_utils.F90 --- lilac/scripts/lilac_mod.F90 | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 4dc2720c80..1b3f4e6a48 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -90,8 +90,13 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) allocate (l2c_fldlist(l2a_fldnum)) allocate (c2l_fldlist(a2l_fldnum)) print *, "creating empty field lists !" - ! call create_fldlists(c2a_fldlist, a2c_fldlist, a2l_fldnum, l2a_fldnum) - !call create_fldlists(flds_a2l, fldsfldsToCpl, fldsToCpl_num, fldsFrCpl_num) + + ! ======================================================================= ! maybe move to create_fldlist? + ! call create_fldlists(c2a_fldlist, a2c_fldlist, ) + + !------------------------------------------------------------------------- + ! !---- from atm ----! a2c_fldlist & c2l_fldlist + !------------------------------------------------------------------------- a2c_fldlist(1)%stdname = 'uwind' a2c_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 @@ -107,21 +112,21 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) !print *, a2c_fldlist(3)%farrayptr1d + !!! Where should these point to? pointer to an empty array which will be filled in the land.... + ! Similary we need c2a_fldlist c2l_fldlist(1)%stdname = 'uwind' - !c2l_fldlist(1)%farrayptr1d => lnd2atm1d%lwup !*** this now sets the module variable memory in atmos_cap.F90 print *, c2l_fldlist(1)%stdname c2l_fldlist(2)%stdname = 'vwind' - !c2l_fldlist(2)%farrayptr1d => lnd2atm1d%taux !*** this now sets the module variable memory in atmos_cap.F90 print *, c2l_fldlist(1)%stdname c2l_fldlist(3)%stdname = 'tbot' - !c2l_fldlist(3)%farrayptr1d => lnd2atm1d%tauy print *, c2l_fldlist(1)%stdname + !------------------------------------------------------------------------- + ! !---- from land ----! l2c_fldlist & c2a_fldlist + !------------------------------------------------------------------------- - !!! Where should these point to? pointer to an empty array which will be filled in the land.... - l2c_fldlist(1)%stdname = 'lwup' l2c_fldlist(1)%farrayptr1d => lnd2atm1d%lwup print *, l2c_fldlist(1)%stdname @@ -144,6 +149,8 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) c2a_fldlist(3)%stdname = 'tauy' print *, c2a_fldlist(3)%stdname + ! ======================================================================= ! create_fldlist + !------------------------------------------------------------------------- ! Create Gridded Component! --- dummy atmosphere ( atmos_cap) !------------------------------------------------------------------------- From 22ec34d64ccf3a33d98fc5f8692982c74e77b053 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 15 May 2019 13:40:10 -0600 Subject: [PATCH 095/556] cleaning the code up! --- lilac/scripts/atmos_cap.F90 | 30 +++++++++++++----------------- lilac/scripts/demo_driver.F90 | 24 +++++++++++------------- lilac/scripts/lilac_mod.F90 | 20 +++++++++----------- 3 files changed, 33 insertions(+), 41 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 8d255aeb8f..2973cd1f17 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -1,9 +1,11 @@ module atmos_cap + !----------------------------------------------------------------------- + ! !DESCRIPTION: + + ! !USES use ESMF use lilac_utils - !use lilac_mod, only : a2c_fldlist - implicit none @@ -15,26 +17,21 @@ module atmos_cap type(fld_list_type), public, allocatable :: c2a_fldlist(:) type(fld_list_type), public, allocatable :: a2c_fldlist(:) - !type(fld_list_type), allocatable :: c2a_fldlist(:) - !type(fld_list_type), allocatable :: a2c_fldlist(:) - !type (fld_list_type) :: a2c_fldlist(fldsMax) !type (fld_list_type) :: c2a_fldlist(fldsMax) + integer :: a2c_fldlist_num integer :: c2a_fldlist_num !private public :: atmos_register - !public :: add_fields - !public :: import_fields - !public :: export_fields - real(kind=ESMF_KIND_R4), dimension(:), public, pointer, save :: fldptr - - !------------------------------------------------------------------------ + !real(kind=ESMF_KIND_R8), dimension(:), public, pointer, save :: fldptr + !======================================================================== contains + !======================================================================== subroutine atmos_register (comp, rc) @@ -79,9 +76,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) type(ESMF_DistGrid) :: distgridIN, distgridFS logical :: mesh_switch character(len=*), parameter :: subname=trim(modname)//': [atmos_init] ' - !---------------------- - - !integer :: regDecomp(:,:) + !integer :: regDecomp(:,:) + !------------------------------------------------------------------------- ! Initialize return code rc = ESMF_SUCCESS call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) @@ -96,7 +92,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if(mesh_switch) then ! For now this is our dummy mesh: - !atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' + !atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' !! Negin: This did not work.... atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv1.9x2.5_141008_ESMFmesh.nc' atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) @@ -105,7 +101,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) print *, "!Mesh for atmosphere is created!" else - !Grid1= ESMF_GridCreateNoPeriDimUfrmR( maxIndex=(/180,360 /), & + !atmos_grid= ESMF_GridCreateNoPeriDimUfrmR( maxIndex=(/180,360 /), & ! minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & ! maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & ! regDecomp=(/petcount,1/), rc=rc) @@ -129,7 +125,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) a2c_fb = ESMF_FieldBundleCreate(name="a2c_fb", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"field bundle", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"field bundle", ESMF_LOGMSG_INFO) ! Create individual fields and add to field bundle -- a2l diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 776723cc8b..4681acd276 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -57,24 +57,22 @@ program demo_lilac_driver n = endc - begc + 1 - ! making 2 random arrays with a seed. - call random_seed (size = n) - allocate (seed(n)) ; seed (:) = seed_val - call random_seed (put = seed) - allocate (rand1(begc:endc)) ; call random_number (rand1) - allocate (rand2(begc:endc)) ; call random_number (rand2) + call random_seed (size = n ) + allocate ( seed (n ) ) ; seed (:) = seed_val + call random_seed (put = seed ) + allocate ( rand1 (begc:endc) ) ; call random_number (rand1) + allocate ( rand2 (begc:endc) ) ; call random_number (rand2) - allocate( atm2lnd%uwind (begc:endc) ) ; atm2lnd%uwind (:) = rand1 - allocate( atm2lnd%vwind (begc:endc) ) ; atm2lnd%vwind (:) = rand1 - allocate( atm2lnd%tbot (begc:endc) ) ; atm2lnd%tbot (:) = rand1 + allocate ( atm2lnd%uwind (begc:endc) ) ; atm2lnd%uwind (:) = rand1 + allocate ( atm2lnd%vwind (begc:endc) ) ; atm2lnd%vwind (:) = rand1 + allocate ( atm2lnd%tbot (begc:endc) ) ; atm2lnd%tbot (:) = rand1 !endc = 18048 ? should this be the size of the land or atmosphere??? - - allocate( lnd2atm%lwup (begc:endc) ) ; lnd2atm%lwup (:) = rand2 - allocate( lnd2atm%taux (begc:endc) ) ; lnd2atm%taux (:) = rand2 - allocate( lnd2atm%tauy (begc:endc) ) ; lnd2atm%tauy (:) = rand2 + allocate ( lnd2atm%lwup (begc:endc) ) ; lnd2atm%lwup (:) = rand2 + allocate ( lnd2atm%taux (begc:endc) ) ; lnd2atm%taux (:) = rand2 + allocate ( lnd2atm%tauy (begc:endc) ) ; lnd2atm%tauy (:) = rand2 print *, "=======================================" diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 1b3f4e6a48..ae1e1acc56 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -18,7 +18,7 @@ module lilac_mod public :: lilac_run character(*) , parameter :: modname = "lilac_mod" - !type(fld_list_type), public :: a2c_fldlist, c2a_fldlist + !type(fld_list_type), public :: a2c_fldlist, c2a_fldlist !defined in atmosphere and land caps.... !------------------------------------------------------------------------ ! !Clock, TimeInterval, and Times @@ -36,9 +36,10 @@ module lilac_mod type(ESMF_CplComp) :: cpl_lnd2atm_comp type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state - !------------------------------------------------------------------------ + !======================================================================== contains + !======================================================================== subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) @@ -65,6 +66,8 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) integer :: a2l_fldnum , l2a_fldnum !------------------------------------------------------------------------ + ! Initialize return code + rc = ESMF_SUCCESS a2l_fldnum = 3 l2a_fldnum = 3 @@ -74,6 +77,8 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) !------------------------------------------------------------------------- call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"initializing ESMF ", ESMF_LOGMSG_INFO) print *, "---------------------------------------" print *, " Lilac Demo Application Start " @@ -237,7 +242,8 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! between components. !------------------------------------------------------------------------- - ! following 4 states are lilac module variables + ! following 4 states are lilac module variables: + ! 1- atm2lnd_a_state 2- atm2lnd_l_state 3- lnd2atm_a_state 4-lnd2atm_l_state atm2lnd_a_state = ESMF_StateCreate(name=gcname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -300,20 +306,12 @@ subroutine lilac_run( ) !integer, parameter :: fldsMax = 100 integer :: a2l_fldnum, l2a_fldnum - ! type(fld_list_type) :: a2c_fldlist , c2a_fldlist ! input/output variables !type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d !type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d !type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d !type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d - ! local variables - ! ! Gridded Components and Coupling Components - !type(ESMF_GridComp) :: dummy_atmos_comp - !type(ESMF_GridComp) :: dummy_land_comp - - - !------------------------------------------------------------------------ ! Initialize return code rc = ESMF_SUCCESS From efb4eff80e53afe13a6e0e186c2fc9b2143f8749 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 15 May 2019 14:34:30 -0600 Subject: [PATCH 096/556] cleaning the code up! --- lilac/scripts/atmos_cap.F90 | 30 +++++------------------------- lilac/scripts/cpl_mod.F90 | 14 +++++++------- lilac/scripts/lilac_mod.F90 | 10 ++++++---- lilac/scripts/lnd_cap.F90 | 5 ++--- 4 files changed, 20 insertions(+), 39 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 2973cd1f17..60c9b13930 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -46,10 +46,7 @@ subroutine atmos_register (comp, rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_atm_to_lilac, phase=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_lilac_to_atm, phase=2, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_run, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) @@ -212,36 +209,19 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) end subroutine atmos_init - subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_atm_to_lilac) ' - - ! Initialize return code - rc = ESMF_SUCCESS - ! get a list of fields of variables we need from atmos.... - ! - call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) - - ! loop over fields, copying pointer from import to export state - end subroutine atmos_copy_atm_to_lilac - - subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) + subroutine atmos_run(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_lilac_to_atm) ' + character(len=*), parameter :: subname=trim(modname)//': [atmos_run] ' ! Initialize return code rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) - end subroutine atmos_copy_lilac_to_atm + call ESMF_LogWrite(subname//"atmos run has not been implemented yet", ESMF_LOGMSG_INFO) + end subroutine atmos_run subroutine atmos_final(comp, importState, exportState, clock, rc) type(ESMF_GridComp) :: comp diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/scripts/cpl_mod.F90 index 3ea05d60ee..5372b007c9 100644 --- a/lilac/scripts/cpl_mod.F90 +++ b/lilac/scripts/cpl_mod.F90 @@ -6,27 +6,27 @@ module cpl_mod ! 1- coupler 1 : atm ---> lnd (cpl_atm2lnd) ! 2- coupler 2 : lnd ---> atm (cpl_lnd2atm) !----------------------------------------------------------------------- - + ! !USES use ESMF implicit none private - public cpl_atm2lnd_register - public cpl_lnd2atm_register + public :: cpl_atm2lnd_register + public :: cpl_lnd2atm_register - character(*), parameter :: modname = " cpl_mod" + character(*), parameter :: modname = " cpl_mod" type(ESMF_RouteHandle), save :: rh_atm2lnd, rh_lnd2atm - !----------------------------------------------------------------------- + !====================================================================== contains - !----------------------------------------------------------------------- + !====================================================================== subroutine cpl_atm2lnd_register(cplcomp, rc) type(ESMF_CplComp ) :: cplcomp integer, intent(out ) :: rc - character(len=* ) , parameter :: subname=trim(modname ) //':[cpl_atm2lnd_register] ' + character(len=* ) , parameter :: subname=trim(modname ) //' : [cpl_atm2lnd_register] ' rc = ESMF_SUCCESS print *, "in cpl_atm2lnd_register routine" diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index ae1e1acc56..93de1d3cdf 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -46,7 +46,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) use atmos_cap , only : a2c_fldlist, c2a_fldlist use lnd_cap , only : l2c_fldlist, c2l_fldlist - character(len=*), parameter :: subname=trim(modname)//': [lilac_init]' + character(len=*), parameter :: subname=trim(modname)//': [lilac_init] ' ! input/output variables type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d @@ -78,7 +78,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//"initializing ESMF ", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Initializing ESMF ", ESMF_LOGMSG_INFO) print *, "---------------------------------------" print *, " Lilac Demo Application Start " @@ -291,12 +291,14 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) end subroutine lilac_init + !======================================================================== + subroutine lilac_run( ) use atmos_cap, only : a2c_fldlist, c2a_fldlist use lnd_cap, only : l2c_fldlist, c2l_fldlist - character(len=*), parameter :: subname=trim(modname)//': [lilac_run]' + character(len=*), parameter :: subname=trim(modname)//': [lilac_run] ' type(ESMF_State) :: importState, exportState ! local variables @@ -361,7 +363,7 @@ subroutine lilac_final( ) use lnd_cap, only : l2c_fldlist, c2l_fldlist - character(len=*), parameter :: subname=trim(modname)//': [lilac_final]' + character(len=*), parameter :: subname=trim(modname)//': [lilac_final] ' type(ESMF_State) :: importState, exportState ! local variables diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/scripts/lnd_cap.F90 index 5c5a22f39c..0bf6d78dd4 100644 --- a/lilac/scripts/lnd_cap.F90 +++ b/lilac/scripts/lnd_cap.F90 @@ -73,9 +73,8 @@ subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) integer :: c2l_fldlist_num integer :: l2c_fldlist_num + !integer :: regDecomp(:,:) - - !integer :: regDecomp(:,:) ! Initialize return code rc = ESMF_SUCCESS call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) @@ -93,8 +92,8 @@ subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) if(mesh_switch) then print *, "creating mesh for land" ! For now this is our dummy mesh: + !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' !! T31 and T62 did not work.... !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T62_040121_ESMFmesh.nc' - !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out From 0c64dc5e8cd60a9c76a1cd3e1dedf38d1e8158e3 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 15 May 2019 15:03:27 -0600 Subject: [PATCH 097/556] cleaning it up --- lilac/scripts/atmos_cap.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index 60c9b13930..b97ff70d28 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -140,7 +140,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2c_fldlist(n)%stdname), rc=rc) field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) + !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) + call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! add field to field bundle @@ -183,6 +184,11 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr1d, rc=rc) field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) + call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8)*5.5, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + else field = ESMF_FieldCreate(atmos_grid, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out From 156e495c0a6c800ce0e2be09ea8e3072eaca772a Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 23 May 2019 17:32:10 -0600 Subject: [PATCH 098/556] reading in the namelist.input.... compiles successfully --- lilac/scripts/lilac_mod.F90 | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index 93de1d3cdf..b33b246e50 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -65,6 +65,20 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) character(len=ESMF_MAXSTR) :: ccname1 , ccname2 ! Coupling components names integer :: a2l_fldnum , l2a_fldnum + + ! Namelist and related variables + integer :: fileunit + integer :: i_max, j_max + real(ESMF_KIND_R8) :: x_min, x_max, y_min, y_max + integer :: s_month, s_day, s_hour, s_min + integer :: e_month, e_day, e_hour, e_min + namelist /input/ i_max, j_max, x_min, x_max, y_min, y_max, & + s_month, s_day, s_hour, s_min, & + e_month, e_day, e_hour, e_min + + + + !------------------------------------------------------------------------ ! Initialize return code rc = ESMF_SUCCESS @@ -83,6 +97,22 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) print *, "---------------------------------------" print *, " Lilac Demo Application Start " print *, "---------------------------------------" + !------------------------------------------------------------------------- + ! Read in configuration data -- namelist.input from host atmosphere(wrf) + !------------------------------------------------------------------------- + ! Read in namelist file ... + call ESMF_UtilIOUnitGet(unit=fileunit, rc=rc) ! get an available Fortran unit number + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + open(fileunit, status="old", file="./namelist", action="read", iostat=rc) + + if (rc .ne. 0) then + call ESMF_LogSetError(rcToCheck=ESMF_RC_FILE_OPEN, msg="Failed to open namelist file 'namelist'", line=__LINE__, file=__FILE__) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + read(fileunit, input) + continue + close(fileunit) + !------------------------------------------------------------------------- ! Create Field lists -- Basically create a list of fields and add a default From a91a886d837d9dddea28cbb1a83d20b4c2d9030c Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 30 May 2019 12:43:49 -0600 Subject: [PATCH 099/556] commited this branch to have it saved --- lilac/scripts/atmos_cap.F90 | 4 +- lilac/scripts/lilac_mod.F90 | 86 +++++++++++++++++++++++++------------ 2 files changed, 61 insertions(+), 29 deletions(-) diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/scripts/atmos_cap.F90 index b97ff70d28..8f0e5e40c4 100644 --- a/lilac/scripts/atmos_cap.F90 +++ b/lilac/scripts/atmos_cap.F90 @@ -226,7 +226,7 @@ subroutine atmos_run(comp, importState, exportState, clock, rc) ! Initialize return code rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"atmos run has not been implemented yet", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"SHOULD ATMOS_RUN DO ANYTHING REALLY?? ", ESMF_LOGMSG_INFO) end subroutine atmos_run subroutine atmos_final(comp, importState, exportState, clock, rc) @@ -251,7 +251,7 @@ subroutine atmos_final(comp, importState, exportState, clock, rc) call ESMF_FieldBundleDestroy(import_fieldbundle, rc=rc) call ESMF_FieldBundleDestroy(export_fieldbundle, rc=rc) - call ESMF_LogWrite(subname//"atmos_final has not been implemented yet", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"?? Are there any other thing for destroying in atmos_final??", ESMF_LOGMSG_INFO) end subroutine atmos_final diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index b33b246e50..e3f23aa8b8 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -103,9 +103,11 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! Read in namelist file ... call ESMF_UtilIOUnitGet(unit=fileunit, rc=rc) ! get an available Fortran unit number if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, "---------------------------------------" + open(fileunit, status="old", file="./namelist", action="read", iostat=rc) - if (rc .ne. 0) then + if (rc == 0) then call ESMF_LogSetError(rcToCheck=ESMF_RC_FILE_OPEN, msg="Failed to open namelist file 'namelist'", line=__LINE__, file=__FILE__) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif @@ -113,7 +115,6 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) continue close(fileunit) - !------------------------------------------------------------------------- ! Create Field lists -- Basically create a list of fields and add a default ! value to them. @@ -257,15 +258,29 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) !------------------------------------------------------------------------- ! Create and initialize a clock! - ! ????? Should I create a clock here or in driver? + ! Clock is initialized here from namelist.input from WRF..... still we + ! are looping over time from host atmosphere !------------------------------------------------------------------------- calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=2, rc=rc) ! time step every 2second + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + !call ESMF_TimeSet(startTime, yy=2003, mm=s_month, dd=s_day, h=s_hour, m=s_min, s=0, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_TimeSet(stopTime, yy=2003, mm=e_month, dd=e_day, h=e_hour, m=e_min, s=0, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1 , s=0, calendar=Calendar, rc=rc) call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) - !EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) + + print *, "---------------------------------------" + call ESMF_ClockPrint (clock, rc=rc) + print *, "=======================================" + call ESMF_CalendarPrint ( calendar , rc=rc) + print *, "---------------------------------------" !------------------------------------------------------------------------- ! Create the necessary import and export states used to pass data @@ -344,45 +359,62 @@ subroutine lilac_run( ) !type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d !type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d + type (ESMF_Clock) :: local_clock + !------------------------------------------------------------------------ ! Initialize return code rc = ESMF_SUCCESS + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + print *, " Lilac Run " + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" !------------------------------------------------------------------------- - ! Initialize ESMF, set the default calendar and log type. + ! Create a local clock from the general clock! !------------------------------------------------------------------------- - call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) + + local_clock = ESMF_ClockCreate(clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" - print *, " Lilac Run " - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + print *, "Run Loop Start time" + call ESMF_ClockPrint(local_clock, options="currtime string", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out !------------------------------------------------------------------------- ! We are running components in this order: ! 1- atmos_cap 2- cpl_atm2lnd ! 3- lnd_cap 4- cpl_lnd2atm !------------------------------------------------------------------------- - call ESMF_GridCompRun(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) - print *, "Running atmos_cap gridded component , rc =", rc + ! lilac run the RunComponent phase in a time loop + do while (.NOT. ESMF_ClockIsStopTime(local_clock, rc=rc)) - call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) - print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc + call ESMF_GridCompRun(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=local_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) + print *, "Running atmos_cap gridded component , rc =", rc - call ESMF_GridCompRun(dummy_land_comp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp is running", ESMF_LOGMSG_INFO) - print *, "Running lnd_cap gridded component , rc =", rc + call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=local_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) + print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc - call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) - print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc + call ESMF_GridCompRun(dummy_land_comp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=local_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp is running", ESMF_LOGMSG_INFO) + print *, "Running lnd_cap gridded component , rc =", rc + + call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=local_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) + print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc + + ! Advance the time + call ESMF_ClockAdvance(local_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"time is icremented now... (ClockAdvance)", ESMF_LOGMSG_INFO) + print *, "time is icremented now... (ClockAdvance) , rc =", rc + + end do end subroutine lilac_run From e4e16e8de059fa936f4c8c7e0ef707414d78b39c Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 3 Jun 2019 12:11:11 -0600 Subject: [PATCH 100/556] adding type of this_clock... but not entirely implemented yet.....! --- lilac/scripts/demo_driver.F90 | 4 +++- lilac/scripts/lilac_mod.F90 | 5 +++-- lilac/scripts/lilac_utils.F90 | 8 ++++++++ 3 files changed, 14 insertions(+), 3 deletions(-) diff --git a/lilac/scripts/demo_driver.F90 b/lilac/scripts/demo_driver.F90 index 4681acd276..2276664d68 100644 --- a/lilac/scripts/demo_driver.F90 +++ b/lilac/scripts/demo_driver.F90 @@ -22,7 +22,7 @@ program demo_lilac_driver ! modules use ESMF use lilac_mod - use lilac_utils, only : atm2lnd_data1d_type , lnd2atm_data1d_type, atm2lnd_data2d_type, atm2lnd_data2d_type + use lilac_utils, only : atm2lnd_data1d_type , lnd2atm_data1d_type, atm2lnd_data2d_type, atm2lnd_data2d_type , this_clock implicit none @@ -31,6 +31,8 @@ program demo_lilac_driver type (atm2lnd_data1d_type) :: atm2lnd type (lnd2atm_data1d_type) :: lnd2atm + type (this_clock) :: this_time + real , allocatable :: rand1(:) real , allocatable :: rand2(:) diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index e3f23aa8b8..f958777515 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -386,8 +386,9 @@ subroutine lilac_run( ) ! 3- lnd_cap 4- cpl_lnd2atm !------------------------------------------------------------------------- ! lilac run the RunComponent phase in a time loop - do while (.NOT. ESMF_ClockIsStopTime(local_clock, rc=rc)) + !!! if we want to loop through clock in atmos cap. + !do while (.NOT. ESMF_ClockIsStopTime(local_clock, rc=rc)) call ESMF_GridCompRun(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=local_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) @@ -414,7 +415,7 @@ subroutine lilac_run( ) call ESMF_LogWrite(subname//"time is icremented now... (ClockAdvance)", ESMF_LOGMSG_INFO) print *, "time is icremented now... (ClockAdvance) , rc =", rc - end do + !end do end subroutine lilac_run diff --git a/lilac/scripts/lilac_utils.F90 b/lilac/scripts/lilac_utils.F90 index 4f26bae49b..c4a665527e 100644 --- a/lilac/scripts/lilac_utils.F90 +++ b/lilac/scripts/lilac_utils.F90 @@ -48,6 +48,14 @@ module lilac_utils real*8, pointer :: tauy (:,:) end type lnd2atm_data2d_type + type :: this_clock + integer, pointer :: yy + integer, pointer :: mm + integer, pointer :: dd + integer, pointer :: hh + integer, pointer :: mn + integer, pointer :: ss + end type this_clock !=============================================================================== contains !=============================================================================== From 6851f6c4c9351d3de590d7497858277fda789a2f Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 3 Jun 2019 12:17:34 -0600 Subject: [PATCH 101/556] saving... checkpoint... before working on cmake for this.... currently this is working with Makefile --- lilac/scripts/lilac_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/scripts/lilac_mod.F90 index f958777515..d97e4c0f7b 100644 --- a/lilac/scripts/lilac_mod.F90 +++ b/lilac/scripts/lilac_mod.F90 @@ -14,8 +14,8 @@ module lilac_mod implicit none - public :: lilac_init - public :: lilac_run + public :: lilac_init + public :: lilac_run character(*) , parameter :: modname = "lilac_mod" !type(fld_list_type), public :: a2c_fldlist, c2a_fldlist !defined in atmosphere and land caps.... From 980205e84ddc9de17dd269e13e11946ad3cf10bd Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 14 Jun 2019 11:32:03 -0600 Subject: [PATCH 102/556] CMake working and building.... --- lilac/CMakeLists.txt | 11 ++++++++++- lilac/{scripts => lilac}/.cpl_mod.F90.swp | Bin lilac/{scripts => lilac}/.gitignore | 0 lilac/{scripts => lilac}/Makefile | 0 lilac/{scripts => lilac}/atmos_cap.F90 | 0 lilac/{scripts => lilac}/cpl_mod.F90 | 0 lilac/{scripts => lilac}/demo_driver.F90 | 0 lilac/{scripts => lilac}/lilac_mod.F90 | 0 lilac/{scripts => lilac}/lilac_utils.F90 | 0 lilac/{scripts => lilac}/lnd_cap.F90 | 0 lilac/{lilac => lilac_joe}/CMakeLists.txt | 0 lilac/{lilac => lilac_joe}/core.f90 | 0 .../drivers/lilac_data_driver.f90 | 0 lilac/{lilac => lilac_joe}/esmf_utils.f90 | 0 lilac/{lilac => lilac_joe}/lilac_utils.f90 | 0 15 files changed, 10 insertions(+), 1 deletion(-) rename lilac/{scripts => lilac}/.cpl_mod.F90.swp (100%) rename lilac/{scripts => lilac}/.gitignore (100%) rename lilac/{scripts => lilac}/Makefile (100%) rename lilac/{scripts => lilac}/atmos_cap.F90 (100%) rename lilac/{scripts => lilac}/cpl_mod.F90 (100%) rename lilac/{scripts => lilac}/demo_driver.F90 (100%) rename lilac/{scripts => lilac}/lilac_mod.F90 (100%) rename lilac/{scripts => lilac}/lilac_utils.F90 (100%) rename lilac/{scripts => lilac}/lnd_cap.F90 (100%) rename lilac/{lilac => lilac_joe}/CMakeLists.txt (100%) rename lilac/{lilac => lilac_joe}/core.f90 (100%) rename lilac/{lilac => lilac_joe}/drivers/lilac_data_driver.f90 (100%) rename lilac/{lilac => lilac_joe}/esmf_utils.f90 (100%) rename lilac/{lilac => lilac_joe}/lilac_utils.f90 (100%) diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 10630051ce..07747d29f1 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -7,7 +7,7 @@ set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") find_package(MPI REQUIRED) # TODO: This should be found from the find_package call but its not working -set(CMAKE_Fortran_COMPILER "/usr/lib64/mpich/bin/mpif90") +#set(CMAKE_Fortran_COMPILER "/usr/lib64/mpich/bin/mpif90") find_package(ESMF REQUIRED) # Local CMake modules @@ -31,8 +31,17 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") # TODO: This should not be necessary but certain header files are missing from the build +#set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I /usr/include/ -I/usr/src/lilac/external/esmf/src/Infrastructure/Util/include -I/usr/src/lilac/external/esmf/build_config/Linux.gfortran.default -I /usr/src/lilac/external/esmf/src/include") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/usr/include/ -I/usr/src/esmf/src/Infrastructure/Util/include/ -I/usr/src/esmf/build_config/Linux.gfortran.default -I /usr/src/esmf/src/include") + message("CMAKE_Fortran_FLAGS:" ${CMAKE_Fortran_FLAGS}) +#add_executable("lilac.exe" ../lilac/*.F90) + +add_executable(${PROJECT_NAME} ../lilac/demo_driver.F90 + ../lilac/lilac_mod.F90 ../lilac/atmos_cap.F90 ../lilac/lilac_utils.F90 + ../lilac/lnd_cap.F90 ../lilac/cpl_mod.F90) + +#emo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o add_subdirectory(lilac) add_subdirectory(tests) diff --git a/lilac/scripts/.cpl_mod.F90.swp b/lilac/lilac/.cpl_mod.F90.swp similarity index 100% rename from lilac/scripts/.cpl_mod.F90.swp rename to lilac/lilac/.cpl_mod.F90.swp diff --git a/lilac/scripts/.gitignore b/lilac/lilac/.gitignore similarity index 100% rename from lilac/scripts/.gitignore rename to lilac/lilac/.gitignore diff --git a/lilac/scripts/Makefile b/lilac/lilac/Makefile similarity index 100% rename from lilac/scripts/Makefile rename to lilac/lilac/Makefile diff --git a/lilac/scripts/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 similarity index 100% rename from lilac/scripts/atmos_cap.F90 rename to lilac/lilac/atmos_cap.F90 diff --git a/lilac/scripts/cpl_mod.F90 b/lilac/lilac/cpl_mod.F90 similarity index 100% rename from lilac/scripts/cpl_mod.F90 rename to lilac/lilac/cpl_mod.F90 diff --git a/lilac/scripts/demo_driver.F90 b/lilac/lilac/demo_driver.F90 similarity index 100% rename from lilac/scripts/demo_driver.F90 rename to lilac/lilac/demo_driver.F90 diff --git a/lilac/scripts/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 similarity index 100% rename from lilac/scripts/lilac_mod.F90 rename to lilac/lilac/lilac_mod.F90 diff --git a/lilac/scripts/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 similarity index 100% rename from lilac/scripts/lilac_utils.F90 rename to lilac/lilac/lilac_utils.F90 diff --git a/lilac/scripts/lnd_cap.F90 b/lilac/lilac/lnd_cap.F90 similarity index 100% rename from lilac/scripts/lnd_cap.F90 rename to lilac/lilac/lnd_cap.F90 diff --git a/lilac/lilac/CMakeLists.txt b/lilac/lilac_joe/CMakeLists.txt similarity index 100% rename from lilac/lilac/CMakeLists.txt rename to lilac/lilac_joe/CMakeLists.txt diff --git a/lilac/lilac/core.f90 b/lilac/lilac_joe/core.f90 similarity index 100% rename from lilac/lilac/core.f90 rename to lilac/lilac_joe/core.f90 diff --git a/lilac/lilac/drivers/lilac_data_driver.f90 b/lilac/lilac_joe/drivers/lilac_data_driver.f90 similarity index 100% rename from lilac/lilac/drivers/lilac_data_driver.f90 rename to lilac/lilac_joe/drivers/lilac_data_driver.f90 diff --git a/lilac/lilac/esmf_utils.f90 b/lilac/lilac_joe/esmf_utils.f90 similarity index 100% rename from lilac/lilac/esmf_utils.f90 rename to lilac/lilac_joe/esmf_utils.f90 diff --git a/lilac/lilac/lilac_utils.f90 b/lilac/lilac_joe/lilac_utils.f90 similarity index 100% rename from lilac/lilac/lilac_utils.f90 rename to lilac/lilac_joe/lilac_utils.f90 From 00a1374a34c20faee6cb743388b236f86420dcd3 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 14 Jun 2019 11:39:24 -0600 Subject: [PATCH 103/556] saving this version of CMake that print out compiler and versions.... --- lilac/CMakeLists.txt | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 07747d29f1..4179a4b99a 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -34,7 +34,12 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") #set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I /usr/include/ -I/usr/src/lilac/external/esmf/src/Infrastructure/Util/include -I/usr/src/lilac/external/esmf/build_config/Linux.gfortran.default -I /usr/src/lilac/external/esmf/src/include") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/usr/include/ -I/usr/src/esmf/src/Infrastructure/Util/include/ -I/usr/src/esmf/build_config/Linux.gfortran.default -I /usr/src/esmf/src/include") -message("CMAKE_Fortran_FLAGS:" ${CMAKE_Fortran_FLAGS}) + +message(STATUS "==============================================================") +message(STATUS "Fortran Compiler : ${CMAKE_Fortran_COMPILER}") +message(STATUS "cmake Fortran Flags : ${CMAKE_Fortran_FLAGS}") +message(STATUS "==============================================================") + #add_executable("lilac.exe" ../lilac/*.F90) From 93559f38b9435372d9faf4314631e693e58b940b Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 3 Jul 2019 11:40:43 -0600 Subject: [PATCH 104/556] saving CMake before incorporating CTSM --- lilac/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 4179a4b99a..07e67320e6 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -43,7 +43,7 @@ message(STATUS "==============================================================") #add_executable("lilac.exe" ../lilac/*.F90) -add_executable(${PROJECT_NAME} ../lilac/demo_driver.F90 +add_executable(${PROJECT_NAME}.exe ../lilac/demo_driver.F90 ../lilac/lilac_mod.F90 ../lilac/atmos_cap.F90 ../lilac/lilac_utils.F90 ../lilac/lnd_cap.F90 ../lilac/cpl_mod.F90) From 16ffd857a4b2b5e8382781c7a2d608e196343b36 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 17 Jul 2019 12:12:58 -0600 Subject: [PATCH 105/556] Makefile working using lnd_comp_esmf.o but still it is not used in Lilac .... --- lilac/lilac/Makefile | 14 +++++++++++--- lilac/lilac/lilac_mod.F90 | 10 +++++----- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index 92817a8381..edc21ddded 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -46,12 +46,20 @@ include $(ESMFMKFILE) demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) mv demo_driver demo_driver.exe - rm *.o *.mod + #rm *.o *.mod # module dependencies: -demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o -lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o +demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o +#demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o +lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o lnd_comp_esmf.o +#lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o +shr_string_mod.o: shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o +shr_log_mod.o: atmos_cap.o: lilac_utils.o +#lnd_comp_esmf.o: shr_string_mod.o abort_utils.o +shr_sys_mod.o: shr_log_mod.o +abort_utils.o: +clm_varctl.o: # ----------------------------------------------------------------------------- # ----------------------------------------------------------------------------- .PHONY: dust clean distclean berzerk diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index d97e4c0f7b..2622af5afe 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -7,9 +7,10 @@ module lilac_mod ! !USES use ESMF use lilac_utils - use atmos_cap , only : atmos_register - use lnd_cap , only : lnd_register - use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register + use atmos_cap , only : atmos_register + use lnd_cap , only : lnd_register + !use lnd_comp_esmf , only : lnd_register + use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register implicit none @@ -44,8 +45,7 @@ module lilac_mod subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) use atmos_cap , only : a2c_fldlist, c2a_fldlist - use lnd_cap , only : l2c_fldlist, c2l_fldlist - + use lnd_cap, only : l2c_fldlist, c2l_fldlist character(len=*), parameter :: subname=trim(modname)//': [lilac_init] ' ! input/output variables From b49e14ce2644cf0432b844c006aaa149dcf8a9ca Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 17 Jul 2019 15:43:15 -0600 Subject: [PATCH 106/556] some changes to top-level CMakeLists.txt --- lilac/CMakeLists.txt | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 07e67320e6..b5b58b299d 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -2,12 +2,17 @@ cmake_minimum_required(VERSION 2.8.12.1) project(LILAC Fortran) enable_language(Fortran) +#include(CIME_initial_setup) +#include(CIME_utils) + set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") find_package(MPI REQUIRED) +add_definitions(-DHIDE_MPI) # TODO: This should be found from the find_package call but its not working #set(CMAKE_Fortran_COMPILER "/usr/lib64/mpich/bin/mpif90") +#find_package (ESMF) find_package(ESMF REQUIRED) # Local CMake modules @@ -29,12 +34,12 @@ set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} ${bounds}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp -lesmf") # TODO: This should not be necessary but certain header files are missing from the build #set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I /usr/include/ -I/usr/src/lilac/external/esmf/src/Infrastructure/Util/include -I/usr/src/lilac/external/esmf/build_config/Linux.gfortran.default -I /usr/src/lilac/external/esmf/src/include") -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/usr/include/ -I/usr/src/esmf/src/Infrastructure/Util/include/ -I/usr/src/esmf/build_config/Linux.gfortran.default -I /usr/src/esmf/src/include") - - +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/usr/include/ -I/usr/src/esmf/src/Infrastructure/Util/include/ -I/usr/src/esmf/build_config/Linux.gfortran.default -I/usr/src/esmf/src/include -L/glade/u/home/dunlap/ESMF-INSTALL/8.0.0bs29/lib/libg/Linux.intel.64.mpt.default") +include_directories("/glade/u/home/dunlap/ESMF-INSTALL/8.0.0bs29/lib/libg/Linux.intel.64.mpt.default") +include_directories("/glade/scratch/negins/testlilac2/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/") message(STATUS "==============================================================") message(STATUS "Fortran Compiler : ${CMAKE_Fortran_COMPILER}") message(STATUS "cmake Fortran Flags : ${CMAKE_Fortran_FLAGS}") From bedf9e41a4a829f2446a775441b51fc202ef4157 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 17 Jul 2019 15:43:36 -0600 Subject: [PATCH 107/556] saving this version of our Makefile before going to a new branch.... --- lilac/lilac/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index edc21ddded..f813fd788e 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -43,7 +43,7 @@ include $(ESMFMKFILE) # ----------------------------------------------------------------------------- -demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o +demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o lnd_comp_esmf.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) mv demo_driver demo_driver.exe #rm *.o *.mod From 7ec3f2be07fbdf70e334ce995bf0fbaa978456e5 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 17 Jul 2019 15:53:07 -0600 Subject: [PATCH 108/556] this makefile is working using dummy land cap.... --- lilac/lilac/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index f813fd788e..c422356efb 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -43,7 +43,7 @@ include $(ESMFMKFILE) # ----------------------------------------------------------------------------- -demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o lnd_comp_esmf.o +demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) mv demo_driver demo_driver.exe #rm *.o *.mod @@ -51,7 +51,7 @@ demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_c # module dependencies: demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o #demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o -lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o lnd_comp_esmf.o +lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o #lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o shr_string_mod.o: shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o shr_log_mod.o: From e2560d33a4d04703edb0f5eb20cd3d0b1583b090 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 17 Jul 2019 15:53:54 -0600 Subject: [PATCH 109/556] this makefile is working using dummy land cap.... --- lilac/lilac/Makefile | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index c422356efb..b424fe060e 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -49,11 +49,11 @@ demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_c #rm *.o *.mod # module dependencies: -demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o -#demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o +#demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o +demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o #lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o -shr_string_mod.o: shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o +#shr_string_mod.o: shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o shr_log_mod.o: atmos_cap.o: lilac_utils.o #lnd_comp_esmf.o: shr_string_mod.o abort_utils.o From 8d2974a518e033af3ca55bc8b40e923bc66a0670 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 17 Jul 2019 17:50:24 -0600 Subject: [PATCH 110/556] saving before switching branch --- lilac/lilac/lilac_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 2622af5afe..a25491c2db 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -8,8 +8,10 @@ module lilac_mod use ESMF use lilac_utils use atmos_cap , only : atmos_register - use lnd_cap , only : lnd_register - !use lnd_comp_esmf , only : lnd_register + !use lnd_cap , only : lnd_register + use lnd_comp_esmf + !use clm_share , only : lnd_register + !use lnd , only : lnd_register use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register implicit none From 7ab5f600a8b5a7265558e44a9337190d7582ea92 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 18 Jul 2019 16:57:34 -0600 Subject: [PATCH 111/556] saving... --- lilac/lilac/demo_driver.F90 | 5 +++++ lilac/lilac/lilac_mod.F90 | 13 ++++++++----- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index 2276664d68..9f6bd766cf 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -87,7 +87,12 @@ program demo_lilac_driver do curr_time = start_time, end_time if (curr_time == start_time) then + ! Initalization phase + print *, "--------------------------" + print *, " LILAC Initalization phase" + print *, "--------------------------" + call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) else if (curr_time == end_time ) then ! Finalization phase diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index a25491c2db..3984fc536a 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -8,8 +8,10 @@ module lilac_mod use ESMF use lilac_utils use atmos_cap , only : atmos_register - !use lnd_cap , only : lnd_register - use lnd_comp_esmf + use lnd_cap , only : lnd_register + !use lnd_shr_methods + !use lnd_comp_esmf + !use lnd_comp_esmf , only : lnd_register !use clm_share , only : lnd_register !use lnd , only : lnd_register use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register @@ -88,6 +90,10 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) a2l_fldnum = 3 l2a_fldnum = 3 + print *, "---------------------------------------" + print *, " Lilac Demo Application Start " + print *, "---------------------------------------" + !------------------------------------------------------------------------- ! Initialize ESMF, set the default calendar and log type. !------------------------------------------------------------------------- @@ -96,9 +102,6 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) call ESMF_LogWrite(subname//"Initializing ESMF ", ESMF_LOGMSG_INFO) - print *, "---------------------------------------" - print *, " Lilac Demo Application Start " - print *, "---------------------------------------" !------------------------------------------------------------------------- ! Read in configuration data -- namelist.input from host atmosphere(wrf) !------------------------------------------------------------------------- From 456401b25a364055ccafc76200c9c48f020d3c24 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Jul 2019 12:41:59 -0600 Subject: [PATCH 112/556] saving changes made to CMake. --- lilac/CMakeLists.txt | 48 +++++++++++++++++++++++++++++++------------- 1 file changed, 34 insertions(+), 14 deletions(-) diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index b5b58b299d..0506f8751b 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -2,19 +2,30 @@ cmake_minimum_required(VERSION 2.8.12.1) project(LILAC Fortran) enable_language(Fortran) -#include(CIME_initial_setup) -#include(CIME_utils) - set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") find_package(MPI REQUIRED) -add_definitions(-DHIDE_MPI) # TODO: This should be found from the find_package call but its not working #set(CMAKE_Fortran_COMPILER "/usr/lib64/mpich/bin/mpif90") -#find_package (ESMF) find_package(ESMF REQUIRED) +# -lclm libclm.a +SET(NAMES libclm.a) + +find_library(LIB_TO_INCLUDE + libclm.a + PATHS /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) +#find_library(LIB_TO_INCLUDE /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) + +message(STATUS "include_directories for ${NAMES}: ${LIB_TO_INCLUDE}") +#include_directories(${LIB_TO_INCLUDE}) +#link_directories(${LIB_TO_INCLUDE}) +message(STATUS "include_directories for ${NAMES}: ${LIB_TO_INCLUDE}") +#find_library(LIB_TO_INCLUDE /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) +message(STATUS "include_directories: ${LIB_TO_INCLUDE}") +#target_link_libraries (${LIB_TO_INCLUDE}) + # Local CMake modules if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") @@ -34,24 +45,33 @@ set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} ${bounds}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp -lesmf") +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") # TODO: This should not be necessary but certain header files are missing from the build #set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I /usr/include/ -I/usr/src/lilac/external/esmf/src/Infrastructure/Util/include -I/usr/src/lilac/external/esmf/build_config/Linux.gfortran.default -I /usr/src/lilac/external/esmf/src/include") -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/usr/include/ -I/usr/src/esmf/src/Infrastructure/Util/include/ -I/usr/src/esmf/build_config/Linux.gfortran.default -I/usr/src/esmf/src/include -L/glade/u/home/dunlap/ESMF-INSTALL/8.0.0bs29/lib/libg/Linux.intel.64.mpt.default") -include_directories("/glade/u/home/dunlap/ESMF-INSTALL/8.0.0bs29/lib/libg/Linux.intel.64.mpt.default") -include_directories("/glade/scratch/negins/testlilac2/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/") +#set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/usr/include/ -I/usr/src/esmf/src/Infrastructure/Util/include/ -I/usr/src/esmf/build_config/Linux.gfortran.default -I /usr/src/esmf/src/include") +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/include -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib -lclm -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2/lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib ") + + message(STATUS "==============================================================") message(STATUS "Fortran Compiler : ${CMAKE_Fortran_COMPILER}") message(STATUS "cmake Fortran Flags : ${CMAKE_Fortran_FLAGS}") message(STATUS "==============================================================") +message(STATUS "==============================================================") #add_executable("lilac.exe" ../lilac/*.F90) -add_executable(${PROJECT_NAME}.exe ../lilac/demo_driver.F90 - ../lilac/lilac_mod.F90 ../lilac/atmos_cap.F90 ../lilac/lilac_utils.F90 - ../lilac/lnd_cap.F90 ../lilac/cpl_mod.F90) +# +# Compile. +# +file(GLOB_RECURSE sources lilac/*.F90) + +#add_executable(${PROJECT_NAME}.exe ../lilac/demo_driver.F90 +# ../lilac/lilac_mod.F90 ../lilac/atmos_cap.F90 ../lilac/lilac_utils.F90 +# ../lilac/lnd_cap.F90 ../lilac/cpl_mod.F90) +add_executable(${PROJECT_NAME}.exe ${sources}) +target_link_libraries(${PROJECT_NAME}.exe ${LIB_TO_INCLUDE}) #emo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o -add_subdirectory(lilac) -add_subdirectory(tests) +#add_subdirectory(lilac) +#add_subdirectory(tests) From ef3c30e79d73ff0c28c4f735ed8fd99f4e18742b Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Jul 2019 12:44:15 -0600 Subject: [PATCH 113/556] WORKING and RUNNING (not debugged) version of LILAC with CTSM. CTSM LILAC CAP and lilac mod should be debugged now.... --- lilac/lilac/batch.sub | 22 ++++++++++++++++++++++ lilac/lilac/lilac_mod.F90 | 5 +---- 2 files changed, 23 insertions(+), 4 deletions(-) create mode 100644 lilac/lilac/batch.sub diff --git a/lilac/lilac/batch.sub b/lilac/lilac/batch.sub new file mode 100644 index 0000000000..746db8d477 --- /dev/null +++ b/lilac/lilac/batch.sub @@ -0,0 +1,22 @@ +#!/bin/tcsh +#PBS -N job_name +#####PBS -A P54048000 +#PBS -A P93300606 +#PBS -l walltime=00:05:00 +#PBS -q regular +#PBS -j oe +#PBS -l select=2:ncpus=2:mpiprocs=4 +##PBS -l select=1:ncpus=1:mpiprocs=1 + +ml + +### Set TMPDIR as recommended +setenv TMPDIR /glade/scratch/$USER/temp +mkdir -p $TMPDIR + + +echo "hello" +### Run the executable +set MPI_SHEPHERD=true +source /glade/scratch/negins/test_clean/.env_mach_specific.csh +mpiexec_mpt ./demo_driver diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 3984fc536a..4d5fb164e2 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -8,12 +8,9 @@ module lilac_mod use ESMF use lilac_utils use atmos_cap , only : atmos_register - use lnd_cap , only : lnd_register !use lnd_shr_methods !use lnd_comp_esmf - !use lnd_comp_esmf , only : lnd_register - !use clm_share , only : lnd_register - !use lnd , only : lnd_register + use lnd_comp_esmf , only : lnd_register use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register implicit none From cbe599bd7816f6a631ab7e1f32a286ca054a6bea Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Jul 2019 12:50:10 -0600 Subject: [PATCH 114/556] update --- lilac/lilac/.gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/lilac/.gitignore b/lilac/lilac/.gitignore index d52decad68..3ddd2df7eb 100644 --- a/lilac/lilac/.gitignore +++ b/lilac/lilac/.gitignore @@ -2,4 +2,4 @@ job_name* PET* *.exe -batch.sub +#batch.sub From ba1d74f9c2b23f97fa6cef25543f85ce5f59a7ff Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 25 Jul 2019 11:01:44 -0600 Subject: [PATCH 115/556] fixing makefile... now it works with -lclm and link to ctsm library... but it does not build ctsm and pio......etc. --- lilac/lilac/Makefile | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index b424fe060e..f835636887 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -33,7 +33,7 @@ include $(ESMFMKFILE) $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREENOCPP) $< %.o : %.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $< + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(CTSM_INC) $(CTSM_LIB) $< %.o : %.c $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< @@ -41,10 +41,14 @@ include $(ESMFMKFILE) % : %.C $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< - +CTSM_BLD_DIR = /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf +CTSM_INC = -I$(CTSM_BLD_DIR)/include +CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm +# ----------------------------------------------------------------------------- +EXTRA_LIBS = -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2/lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib # ----------------------------------------------------------------------------- demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o - $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) + $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(CTSM_INC) $(CTSM_LIB) $(EXTRA_LIBS) mv demo_driver demo_driver.exe #rm *.o *.mod @@ -52,14 +56,8 @@ demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_c #demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o -#lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o -#shr_string_mod.o: shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o -shr_log_mod.o: +###shr_string_mod.o: shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o atmos_cap.o: lilac_utils.o -#lnd_comp_esmf.o: shr_string_mod.o abort_utils.o -shr_sys_mod.o: shr_log_mod.o -abort_utils.o: -clm_varctl.o: # ----------------------------------------------------------------------------- # ----------------------------------------------------------------------------- .PHONY: dust clean distclean berzerk From 4872fdcaab8f28d469232d3baa8db2775b749b6e Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 25 Jul 2019 11:14:48 -0600 Subject: [PATCH 116/556] adding some comments to atmos_cap.F90 for tracking.... --- lilac/lilac/atmos_cap.F90 | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 index 8f0e5e40c4..04b192b206 100644 --- a/lilac/lilac/atmos_cap.F90 +++ b/lilac/lilac/atmos_cap.F90 @@ -138,21 +138,28 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! create field !!! Here we want to pass pointers !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2c_fldlist(n)%stdname), rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) - call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8), rc=rc) + !call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8), rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_FieldPrint(field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_LogWrite(subname//"fieldget!", ESMF_LOGMSG_INFO) + !call ESMF_FieldGet(field, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! add field to field bundle call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, a2c_fldlist(n)%farrayptr1d - print *, "this field is created" + !print *, a2c_fldlist(n)%farrayptr1d + !print *, "this field is created" enddo + call ESMF_LogWrite(subname//"fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" @@ -177,6 +184,10 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) do n = 1,c2a_fldlist_num + print *, "**********************************************************" + print *, "creating field for l2a:" + print *, trim(c2a_fldlist(n)%stdname) + ! create field !!! Here we want to pass pointers if (mesh_switch) then @@ -186,17 +197,19 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) - call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8)*5.5, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8)*5.5, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out else field = ESMF_FieldCreate(atmos_grid, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end if + end if + call ESMF_LogWrite(subname//"line 208 and going.... .... !", ESMF_LOGMSG_INFO) ! add field to field bundle call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"c2a fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) print *, "**********************************************************" print *, "creating field for c2a:" From 817a007af63b526de047d6f18e399a561a5d09e9 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 25 Jul 2019 11:15:18 -0600 Subject: [PATCH 117/556] hard coding correct size in demo_driver --- lilac/lilac/demo_driver.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index 9f6bd766cf..9422fc6eea 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -49,7 +49,10 @@ program demo_lilac_driver ! real atmosphere: begc = 1 - endc = 13824 + !endc = 10 + endc = 6912 + !endc = 13824 + !endc = 13968 start_time = 1 end_time = 10 From b1afc82b7c677578a50e80d1fdf8ffe2b74dea38 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 25 Jul 2019 11:15:57 -0600 Subject: [PATCH 118/556] changing dummy atmos and land to real atmos and land.... --- lilac/lilac/lilac_mod.F90 | 65 ++++++++++++++++++++------------------- 1 file changed, 34 insertions(+), 31 deletions(-) diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 4d5fb164e2..de009c4a9a 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -32,8 +32,8 @@ module lilac_mod type(ESMF_Calendar),target :: calendar integer :: yy,mm,dd,sec ! ! Gridded Components and Coupling Components - type(ESMF_GridComp) :: dummy_atmos_comp - type(ESMF_GridComp) :: dummy_land_comp + type(ESMF_GridComp) :: atmos_gcomp + type(ESMF_GridComp) :: land_gcomp type(ESMF_CplComp) :: cpl_atm2lnd_comp type(ESMF_CplComp) :: cpl_lnd2atm_comp type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state @@ -109,7 +109,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) open(fileunit, status="old", file="./namelist", action="read", iostat=rc) - if (rc == 0) then + if (rc .ne. 0) then call ESMF_LogSetError(rcToCheck=ESMF_RC_FILE_OPEN, msg="Failed to open namelist file 'namelist'", line=__LINE__, file=__FILE__) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif @@ -190,22 +190,22 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! ======================================================================= ! create_fldlist !------------------------------------------------------------------------- - ! Create Gridded Component! --- dummy atmosphere ( atmos_cap) + ! Create Gridded Component! -- atmosphere ( atmos_cap) !------------------------------------------------------------------------- - gcname1 = "Dummy Atmosphere or Atmosphere Cap" - dummy_atmos_comp = ESMF_GridCompCreate(name=gcname1, rc=rc) + gcname1 = " Atmosphere or Atmosphere Cap" + atmos_gcomp = ESMF_GridCompCreate(name=gcname1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Created "//trim(gcname1)//" component", ESMF_LOGMSG_INFO) - print *, "Dummy Atmosphere Gridded Component Created!" + print *, "Atmosphere Gridded Component Created!" !------------------------------------------------------------------------- - ! Create Gridded Component! --- dummy land ( land cap ) + ! Create Gridded Component! --- CTSM land ( land_capX ) !------------------------------------------------------------------------- - gcname2 = "Dummy Land or Land Cap" - dummy_land_comp = ESMF_GridCompCreate(name=gcname2, rc=rc) + gcname2 = " Land ctsm " + land_gcomp = ESMF_GridCompCreate(name=gcname2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Created "//trim(gcname2)//" component", ESMF_LOGMSG_INFO) - print *, "Dummy Land Gridded Component Created!" + print *, " Land (ctsm) Gridded Component Created!" !------------------------------------------------------------------------- ! Create Coupling Component! --- Coupler from atmos to land @@ -230,14 +230,14 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) !------------------------------------------------------------------------- ! Register section -- set services -- atmos_cap !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(dummy_atmos_comp, userRoutine=atmos_register, rc=rc) + call ESMF_GridCompSetServices(atmos_gcomp, userRoutine=atmos_register, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"dummy atmos SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Dummy Atmosphere Gridded Component SetServices finished!" + call ESMF_LogWrite(subname//" atmos SetServices finished!", ESMF_LOGMSG_INFO) + print *, " Atmosphere Gridded Component SetServices finished!" !------------------------------------------------------------------------- ! Register section -- set services -- land cap !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(dummy_land_comp, userRoutine=lnd_register, rc=rc) + call ESMF_GridCompSetServices(land_gcomp, userRoutine=lnd_register, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) print *, "Land Gridded Component SetServices finished!" @@ -314,14 +314,17 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! 3- cpl_atm2lnd 4- cpl_lnd2atm ! ! ------------------------------------------------------------------------- - call ESMF_GridCompInitialize(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + call ESMF_GridCompInitialize(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp initialized", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp initialized", ESMF_LOGMSG_INFO) print *, "atmos_cap initialize finished, rc =", rc - call ESMF_GridCompInitialize(dummy_land_comp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"now we are initializing CTSM ....", ESMF_LOGMSG_INFO) + print *, "now we are initializing CTSM, rc =", rc + call ESMF_GridCompInitialize(land_gcomp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp initialized", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"lnd_cap or land_gcomp initialized", ESMF_LOGMSG_INFO) print *, "lnd_cap initialize finished, rc =", rc ! All 4 states that are module variables are no longer empty - have been initialized @@ -391,9 +394,9 @@ subroutine lilac_run( ) !!! if we want to loop through clock in atmos cap. !do while (.NOT. ESMF_ClockIsStopTime(local_clock, rc=rc)) - call ESMF_GridCompRun(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=local_clock, rc=rc) + call ESMF_GridCompRun(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=local_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp is running", ESMF_LOGMSG_INFO) print *, "Running atmos_cap gridded component , rc =", rc call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=local_clock, rc=rc) @@ -401,9 +404,9 @@ subroutine lilac_run( ) call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc - call ESMF_GridCompRun(dummy_land_comp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=local_clock, rc=rc) + call ESMF_GridCompRun(land_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=local_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp is running", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"lnd_cap or land_gcomp is running", ESMF_LOGMSG_INFO) print *, "Running lnd_cap gridded component , rc =", rc call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=local_clock, rc=rc) @@ -447,11 +450,11 @@ subroutine lilac_final( ) print *, " Lilac Finalizing " print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" !------------------------------------------------------------------------- - ! Gridded Component Finalizing! --- dummy atmosphere + ! Gridded Component Finalizing! --- atmosphere !------------------------------------------------------------------------- - call ESMF_GridCompFinalize(dummy_atmos_comp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + call ESMF_GridCompFinalize(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos_cap or dummy_atmos_comp is running", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp is running", ESMF_LOGMSG_INFO) print *, "Finalizing atmos_cap gridded component , rc =", rc !------------------------------------------------------------------------- @@ -463,11 +466,11 @@ subroutine lilac_final( ) print *, "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc !------------------------------------------------------------------------- - ! Gridded Component Finalizing! --- dummy land + ! Gridded Component Finalizing! --- land !------------------------------------------------------------------------- - call ESMF_GridCompFinalize(dummy_land_comp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + call ESMF_GridCompFinalize(land_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"lnd_cap or dummy_land_comp is running", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"lnd_cap or land_gcomp is running", ESMF_LOGMSG_INFO) print *, "Finalizing lnd_cap gridded component , rc =", rc !------------------------------------------------------------------------- @@ -496,9 +499,9 @@ subroutine lilac_final( ) call ESMF_LogWrite(subname//"destroying all components ", ESMF_LOGMSG_INFO) print *, "ready to destroy all components" - call ESMF_GridCompDestroy(dummy_atmos_comp, rc=rc) + call ESMF_GridCompDestroy(atmos_gcomp, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_GridCompDestroy(dummy_land_comp, rc=rc) + call ESMF_GridCompDestroy(land_gcomp, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_CplCompDestroy(cpl_atm2lnd_comp, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) From 7416f57e5070669bbcc9963c0e49ae1c62e0cd44 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 25 Jul 2019 11:16:36 -0600 Subject: [PATCH 119/556] updating batch.script.... --- lilac/lilac/batch.sub | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lilac/lilac/batch.sub b/lilac/lilac/batch.sub index 746db8d477..5d968ed7c9 100644 --- a/lilac/lilac/batch.sub +++ b/lilac/lilac/batch.sub @@ -2,10 +2,12 @@ #PBS -N job_name #####PBS -A P54048000 #PBS -A P93300606 -#PBS -l walltime=00:05:00 -#PBS -q regular -#PBS -j oe -#PBS -l select=2:ncpus=2:mpiprocs=4 +#PBS -l walltime=00:10:00 +#PBS -q premium +##PBS -q regular +###PBS -j oe +##PBS -l select=2:ncpus=2:mpiprocs=4 +#PBS -l select=1:ncpus=1:mpiprocs=2 ##PBS -l select=1:ncpus=1:mpiprocs=1 ml @@ -19,4 +21,4 @@ echo "hello" ### Run the executable set MPI_SHEPHERD=true source /glade/scratch/negins/test_clean/.env_mach_specific.csh -mpiexec_mpt ./demo_driver +mpiexec_mpt ./demo_driver.exe From d3693bfc364eee109b00687b96808b3b271faeb5 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 25 Jul 2019 12:45:14 -0600 Subject: [PATCH 120/556] removing .mod and .o after making.... --- lilac/lilac/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index f835636887..40c5157b89 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -50,7 +50,7 @@ EXTRA_LIBS = -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothre demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(CTSM_INC) $(CTSM_LIB) $(EXTRA_LIBS) mv demo_driver demo_driver.exe - #rm *.o *.mod + rm *.o *.mod # module dependencies: #demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o From aa6be37deeb379dd68a7177fb7460deb6c16424b Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 25 Jul 2019 12:52:01 -0600 Subject: [PATCH 121/556] saving before adding the default values and units.... --- lilac/lilac/lilac_utils.F90 | 174 +++++++++++++++++++++++++++++++++--- 1 file changed, 163 insertions(+), 11 deletions(-) diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 index c4a665527e..ce57848dbb 100644 --- a/lilac/lilac/lilac_utils.F90 +++ b/lilac/lilac/lilac_utils.F90 @@ -20,6 +20,8 @@ module lilac_utils character(len=128) :: units real(ESMF_KIND_R8), pointer :: farrayptr1d(:) ! this will be filled in by lilac when it gets its data from the host atm real(ESMF_KIND_R8), pointer :: farrayptr2d(:,:) ! this will be filled in by lilac when it gets its data from the host atm + integer :: ungridded_lbound = 0 + integer :: ungridded_ubound = 0 end type fld_list_type !!! 1d for when we have mesh and 2d for when we have grids.... @@ -60,27 +62,38 @@ module lilac_utils contains !=============================================================================== - subroutine fldlist_add(num, fldlist, stdname, default_value, units) - ! This adds a field to a fieldlist! + subroutine fldlist_add(num, fldlist, stdname, default_value, units, ungridded_lbound, ungridded_ubound) + ! This adds a field to a fieldlist! + ! input/output variables integer, intent(inout) :: num type(fld_list_type), intent(inout) :: fldlist(:) character(len=*), intent(in) :: stdname real, optional, intent(in) :: default_value character(len=*), optional, intent(in) :: units + integer, optional, intent(in) :: ungridded_lbound + integer, optional, intent(in) :: ungridded_ubound ! local variables integer :: rc - character(len=*), parameter :: subname='(fldlist_add)' + character(len=*), parameter :: subname=':[fldlist_add]' !------------------------------------------------------------------------------- ! Set up a list of field information num = num + 1 if (num > fldsMax) then call ESMF_LogWrite(subname//"?!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) + return endif fldlist(num)%stdname = trim(stdname) + if (present(ungridded_lbound) .and. present(ungridded_ubound)) then + fldlist(num)%ungridded_lbound = ungridded_lbound + fldlist(num)%ungridded_ubound = ungridded_ubound + end if + if(present(default_value)) then fldlist(num)%default_value = default_value else @@ -94,17 +107,156 @@ subroutine fldlist_add(num, fldlist, stdname, default_value, units) end subroutine fldlist_add - subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist ) + subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist, rof_prognostic, glc_present ) + ! add all the necessary fields one by one to the fieldlist - type(fld_list_type), intent(inout) :: a2c_fldlist - type(fld_list_type), intent(inout) :: c2a_fldlist - type(fld_list_type), intent(inout) :: l2c_fldlist - type(fld_list_type), intent(inout) :: c2l_fldlist + type(fld_list_type), intent(inout) :: a2c_fldlist(fldsMax) + type(fld_list_type), intent(inout) :: c2a_fldlist(fldsMax) + type(fld_list_type), intent(inout) :: l2c_fldlist(fldsMax) + type(fld_list_type), intent(inout) :: c2l_fldlist(fldsMax) + + !type (fld_list_type) :: fldsToLnd(fldsMax) + !type (fld_list_type) :: fldsFrLnd(fldsMax) + + !integer :: fldsFrCpl_num, fldsToCpl_num + integer :: fldsToLnd_num != 0 ! From atmosphere to land (a2c and c2l) + integer :: fldsFrLnd_num != 0 ! From land to atmosphere (l2c and c2a) + integer, parameter :: fldsMax = 100 + + + logical , intent(in) :: glc_present ! .true. => running with a non-stub GLC model + logical , intent(in) :: rof_prognostic ! .true. => running with a prognostic ROF model + + ! TODO (NS) : I should add default value and units here..... + + !------------------------------------------------------------------------- + ! !---- from atm ----! a2c_fldlist & c2l_fldlist + !------------------------------------------------------------------------- + !--------------------------a2c_fldlist------------------------------------ + ! from atm - states + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_z' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_topo' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_u' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_v' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_ptem' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_pbot' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_tbot' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_shum' ) + !call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_methane' ) + + ! from atm - fluxes + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_lwdn' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_rainc' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_rainl' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_snowc' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_snowl' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_swndr' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_swvdr' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_swndf' ) + call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_swvdf' ) + + !--------------------------c2l_fldlist------------------------------------ + ! from atm - states + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_z' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_topo' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_u' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_v' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_ptem' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_pbot' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_tbot' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_shum' ) + !call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_methane' ) + + ! from atm - fluxes + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_lwdn' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_rainc' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_rainl' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_snowc' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_snowl' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swndr' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swvdr' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swndf' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swvdf' ) + + !------------------------------------------------------------------------- + ! !---- from lnd ----! l2c_fldlist & c2a_fldlist + !------------------------------------------------------------------------- + !--------------------------l2c_fldlist------------------------------------ + ! export land states + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_lfrin' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_t' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_tref' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_qref' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_avsdr' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_anidr' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_avsdf' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_anidf' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_snowh' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_u10' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_fv' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_ram1' ) + + + ! export fluxes to river + if (rof_prognostic) then + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofsur' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofgwl' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofsub' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofi' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_irrig' ) + end if + + ! export fluxes to atm + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_taux' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_tauy' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_lat' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_sen' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_lwup' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_evap' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_swnet' ) + + ! call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_methane' ) + + + !--------------------------c2a_fldlist------------------------------------ + ! export land states + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_lfrin' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_t' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_tref' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_qref' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_avsdr' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_anidr' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_avsdf' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_anidf' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_snowh' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_u10' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_fv' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_ram1' ) + + + ! export fluxes to river + if (rof_prognostic) then + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofsur' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofgwl' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofsub' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofi' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_irrig' ) + end if + + ! export fluxes to atm + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_taux' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_tauy' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_lat' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_sen' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_lwup' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_evap' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_swnet' ) + + ! call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_methane' ) + - integer :: fldsFrCpl_num, fldsToCpl_num - ! from atm - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=0.0, units='m') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=0.0, units='m') ! from lnd !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'lnd2atmos_var', default_value=0.0, units='m') From 4d4062285cb00ad67d0bc9356e7c0c45fafd9578 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 25 Jul 2019 12:55:00 -0600 Subject: [PATCH 122/556] working on CMake from other branch and building the necessary libraries....this builds a lilac.exe... --- lilac/CMakeLists.txt | 77 +++++++++++++++++++++++++++++++++++++++----- 1 file changed, 69 insertions(+), 8 deletions(-) diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 0506f8751b..864aa7a0a7 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -1,29 +1,90 @@ cmake_minimum_required(VERSION 2.8.12.1) -project(LILAC Fortran) + + +### ********** ### +set (CIME_ROOT "/glade/work/negins/UFSCOMP/cime") +message ("CIME_ROOT: ${CIME_ROOT}") +set (CIME_CMAKE_MODULE_DIRECTORY "/glade/work/negins/UFSCOMP/cime/src/CMake/") +message ("CIME_CMAKE_MODULE_DIRECTORY: ${CIME_CMAKE_MODULE_DIRECTORY}") + +list(APPEND CMAKE_MODULE_PATH ${CIME_CMAKE_MODULE_DIRECTORY}) +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") +include(CIME_initial_setup) + +message("----------------------------------------------------") + +project(LILAC Fortran C) enable_language(Fortran) -set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") +# We rely on pio for cmake utilities like findnetcdf.cmake, so that we don't +# need to duplicate this cmake code +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") +list(APPEND CMAKE_MODULE_PATH "${CIME_ROOT}/src/externals/pio2/cmake") +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") + +message("----------------------------------------------------") + +list(APPEND CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") +message ("CMAKE_CURRENT_SOURCE_DIR: ${CMAKE_CURRENT_SOURCE_DIR}") +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") +message("----------------------------------------------------") find_package(MPI REQUIRED) # TODO: This should be found from the find_package call but its not working #set(CMAKE_Fortran_COMPILER "/usr/lib64/mpich/bin/mpif90") find_package(ESMF REQUIRED) + +include(CIME_utils) +message("----------------------------------------------------") + +find_package(NetCDF COMPONENTS C Fortran) +include_directories(${NetCDF_C_INCLUDE_DIRS} ${NetCDF_Fortran_INCLUDE_DIRS}) +message("NetCDF_C_INCLUDE_DIRS: ${NetCDF_C_INCLUDE_DIRS}") +message("----------------------------------------------------") + +##=======## +#set(CESM_ROOT "/glade/work/negins/UFSCOMP/") +#set(CSM_SHR "/glade/work/negins/UFSCOMP/components/clm/src/unit_test_stubs/csm_share/") + +#add_subdirectory(${CESM_ROOT}/models/csm_share/shr csm_share) +#add_subdirectory(${CSM_SHR} ) + +#==============### +set(SHARE_ROOT "${CIME_ROOT}/src/share") +#add_subdirectory(${CIME_ROOT}/src/share/util csm_share) +#add_subdirectory(${CIME_ROOT}/src/share/unit_test_stubs/util csm_share_stubs) +#add_subdirectory(${CIME_ROOT}/src/share/esmf_wrf_timemgr esmf_wrf_timemgr) +#add_subdirectory(${CIME_ROOT}/src/drivers/mct/shr drv_share) +#message("----------------------------------------------------") + + +add_subdirectory(${SHARE_ROOT}/util csm_share) +add_subdirectory(${SHARE_ROOT}/unit_test_stubs/util csm_share_stubs) +include_directories(${SHARE_ROOT}/include) + +# esmf_wrf_timemgr not built here because it depends on csm_share. +#add_subdirectory(${SHARE_ROOT}/esmf_wrf_timemgr esmf_wrf_timemgr) +#include_directories(${SHARE_ROOT}/esmf_wrf_timemgr) + + + + # -lclm libclm.a SET(NAMES libclm.a) -find_library(LIB_TO_INCLUDE - libclm.a - PATHS /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) +#find_library(LIB_TO_INCLUDE +# libclm.a +# PATHS /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) #find_library(LIB_TO_INCLUDE /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) -message(STATUS "include_directories for ${NAMES}: ${LIB_TO_INCLUDE}") +#message(STATUS "include_directories for ${NAMES}: ${LIB_TO_INCLUDE}") #include_directories(${LIB_TO_INCLUDE}) #link_directories(${LIB_TO_INCLUDE}) -message(STATUS "include_directories for ${NAMES}: ${LIB_TO_INCLUDE}") +#message(STATUS "include_directories for ${NAMES}: ${LIB_TO_INCLUDE}") #find_library(LIB_TO_INCLUDE /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) -message(STATUS "include_directories: ${LIB_TO_INCLUDE}") +#message(STATUS "include_directories: ${LIB_TO_INCLUDE}") #target_link_libraries (${LIB_TO_INCLUDE}) # Local CMake modules From ef23451e5059dc1944238e77a0cdb392baf5a04f Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 2 Aug 2019 11:20:26 -0600 Subject: [PATCH 123/556] Land initialization complete: Successfully initialized the land model! :-) |||| Working with b9b543f8ea7989d4cc6414180db91a7050206c4f lnd_emsf_comp.F90 --- lilac/lilac/Makefile | 18 ++++++---- lilac/lilac/batch.sub | 10 +++--- lilac/lilac/demo_driver.F90 | 2 +- lilac/lilac/lilac_mod.F90 | 69 ++++++++++++++++++++++++++++++++++--- 4 files changed, 83 insertions(+), 16 deletions(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index 40c5157b89..0c26d0d75b 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -33,7 +33,7 @@ include $(ESMFMKFILE) $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREENOCPP) $< %.o : %.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(CTSM_INC) $(CTSM_LIB) $< + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) $(EXTRA_LIBS) $(MORE_LIBS) $< %.o : %.c $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< @@ -44,23 +44,27 @@ include $(ESMFMKFILE) CTSM_BLD_DIR = /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf CTSM_INC = -I$(CTSM_BLD_DIR)/include CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm +TRACEBACK_FLAGS = -g -traceback -debug all -check all # ----------------------------------------------------------------------------- -EXTRA_LIBS = -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2/lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib +#EXTRA_LIBS = -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2/lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib +EXTRA_LIBS = -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib +MORE_LIBS = -I/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ +#EXTRA_LIBS = $(EXTRA_LIBS) -I/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/pio/pio2 # ----------------------------------------------------------------------------- demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o - $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(CTSM_INC) $(CTSM_LIB) $(EXTRA_LIBS) + $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(CTSM_INC) $(CTSM_LIB) $(EXTRA_LIBS) $(TRACEBACK_FLAGS) $(MORE_LIBS) mv demo_driver demo_driver.exe - rm *.o *.mod + #rm *.o *.mod # module dependencies: #demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o -lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o +lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o #shr_pio_mod.o ###shr_string_mod.o: shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o atmos_cap.o: lilac_utils.o # ----------------------------------------------------------------------------- # ----------------------------------------------------------------------------- -.PHONY: dust clean distclean berzerk +.PHONY: dust clean distclean berzerk remake dust: rm -f PET*.ESMF_LogFile DE.nc FLAG.nc OMEGA.nc SIE.nc U_velocity.nc V_velocity.nc clean: @@ -68,3 +72,5 @@ clean: distclean: dust clean berzerk: rm -f PET*.ESMF_LogFile job_name* *.o *.mod *.exe +remake: + rm lilac_mod.o demo_driver.o demo_driver.exe & make diff --git a/lilac/lilac/batch.sub b/lilac/lilac/batch.sub index 5d968ed7c9..de2b1018ac 100644 --- a/lilac/lilac/batch.sub +++ b/lilac/lilac/batch.sub @@ -3,11 +3,13 @@ #####PBS -A P54048000 #PBS -A P93300606 #PBS -l walltime=00:10:00 -#PBS -q premium +##PBS -q premium +#PBS -q share ##PBS -q regular -###PBS -j oe -##PBS -l select=2:ncpus=2:mpiprocs=4 -#PBS -l select=1:ncpus=1:mpiprocs=2 +#PBS -j oe + +#PBS -l select=2:ncpus=2:mpiprocs=4 +##PBS -l select=1:ncpus=1:mpiprocs=2 ##PBS -l select=1:ncpus=1:mpiprocs=1 ml diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index 9422fc6eea..269df07b66 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -50,7 +50,7 @@ program demo_lilac_driver ! real atmosphere: begc = 1 !endc = 10 - endc = 6912 + endc = 6912/4 !endc = 13824 !endc = 13968 diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index de009c4a9a..fa2a31993b 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -13,6 +13,9 @@ module lilac_mod use lnd_comp_esmf , only : lnd_register use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register + use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS + use shr_pio_mod, only : shr_pio_init1, shr_pio_init2 + implicit none @@ -61,7 +64,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) !character(len=*) :: atm_mesh_filepath !!! For now this is hardcoded in the atmos init - integer :: rc , urc + integer :: rc , urc character(len=ESMF_MAXSTR) :: gcname1 , gcname2 ! Gridded components names character(len=ESMF_MAXSTR) :: ccname1 , ccname2 ! Coupling components names integer :: a2l_fldnum , l2a_fldnum @@ -78,6 +81,13 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) e_month, e_day, e_hour, e_min + integer :: COMP_COMM + integer :: ierr + integer :: ntasks,mytask ! mpicom size and rank + + integer :: ncomps = 1 ! land only + + !!! above: https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/pio-xlis-bld/xlis_main.F90 !------------------------------------------------------------------------ @@ -91,11 +101,58 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) print *, " Lilac Demo Application Start " print *, "---------------------------------------" + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + + ! this is coming from + ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 + call MPI_init(ierr) + COMP_COMM = MPI_COMM_WORLD + + !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 + if (ierr .ne. MPI_SUCCESS) then + print *,'Error starting MPI program. Terminating.' + call MPI_ABORT(MPI_COMM_WORLD, ierr) + end if + + + + ! + + call MPI_COMM_RANK(COMP_COMM, mytask, ierr) + call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) + + print *, "MPI initialization done ..., ntasks=", ntasks + + !----------------------------------------------------------------------------- + ! Initialize PIO + !----------------------------------------------------------------------------- + + ! this is coming from + ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 + ! with call shr_pio_init1(8, "drv_in", COMP_COMM) + + ! For planned future use of async io using pio2. The IO tasks are seperated from the compute tasks here + ! and COMP_COMM will be MPI_COMM_NULL on the IO tasks which then call shr_pio_init2 and do not return until + ! the model completes. All other tasks call ESMF_Initialize. 8 is the maximum number of component models + ! supported + + call shr_pio_init1(ncomps, "drv_in", COMP_COMM) + ! NS Question: How many should ncomps (above 1) be?????? + + if (COMP_COMM .eq. MPI_COMM_NULL) then + !call shr_pio_init2( + call mpi_finalize(ierror=rc) + stop + endif +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !------------------------------------------------------------------------- ! Initialize ESMF, set the default calendar and log type. !------------------------------------------------------------------------- - call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, rc=rc) + call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN,logappendflag=.false., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogSet(flush=.true.) call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) call ESMF_LogWrite(subname//"Initializing ESMF ", ESMF_LOGMSG_INFO) @@ -107,7 +164,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "---------------------------------------" - open(fileunit, status="old", file="./namelist", action="read", iostat=rc) + open(fileunit, status="old", file="namelist_lilac", action="read", iostat=rc) if (rc .ne. 0) then call ESMF_LogSetError(rcToCheck=ESMF_RC_FILE_OPEN, msg="Failed to open namelist file 'namelist'", line=__LINE__, file=__FILE__) @@ -128,6 +185,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) allocate (l2c_fldlist(l2a_fldnum)) allocate (c2l_fldlist(a2l_fldnum)) print *, "creating empty field lists !" + call ESMF_LogWrite(subname//"EMPTY field lists are created...", ESMF_LOGMSG_INFO) ! ======================================================================= ! maybe move to create_fldlist? ! call create_fldlists(c2a_fldlist, a2c_fldlist, ) @@ -320,8 +378,9 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) print *, "atmos_cap initialize finished, rc =", rc rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"now we are initializing CTSM ....", ESMF_LOGMSG_INFO) - print *, "now we are initializing CTSM, rc =", rc + print *, rc + call ESMF_LogWrite(subname//"Now we are initializing CTSM ....", ESMF_LOGMSG_INFO) + print *, "Now we are initializing CTSM, rc =", rc call ESMF_GridCompInitialize(land_gcomp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"lnd_cap or land_gcomp initialized", ESMF_LOGMSG_INFO) From d68c9e14bbc3b9086b8b31377a95b943c1fa8ef7 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 7 Aug 2019 11:17:34 -0600 Subject: [PATCH 124/556] using create_fldlists instead of manually allocating these.... --- lilac/lilac/lilac_mod.F90 | 71 ++++++++------------------------------- 1 file changed, 14 insertions(+), 57 deletions(-) diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index fa2a31993b..55e9797f73 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -94,8 +94,8 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! Initialize return code rc = ESMF_SUCCESS - a2l_fldnum = 3 - l2a_fldnum = 3 + a2l_fldnum = 14 + l2a_fldnum = 16 print *, "---------------------------------------" print *, " Lilac Demo Application Start " @@ -179,72 +179,29 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! value to them. !------------------------------------------------------------------------- - allocate (a2c_fldlist(a2l_fldnum)) - allocate (c2a_fldlist(l2a_fldnum)) + !allocate (a2c_fldlist(a2l_fldnum)) + !allocate (c2a_fldlist(l2a_fldnum)) - allocate (l2c_fldlist(l2a_fldnum)) - allocate (c2l_fldlist(a2l_fldnum)) + !allocate (l2c_fldlist(l2a_fldnum)) + !allocate (c2l_fldlist(a2l_fldnum)) + allocate (a2c_fldlist(fldsMax)) + allocate (c2a_fldlist(fldsMax)) + + allocate (l2c_fldlist(fldsmax)) + allocate (c2l_fldlist(fldsmax)) print *, "creating empty field lists !" call ESMF_LogWrite(subname//"EMPTY field lists are created...", ESMF_LOGMSG_INFO) ! ======================================================================= ! maybe move to create_fldlist? ! call create_fldlists(c2a_fldlist, a2c_fldlist, ) - + call create_fldlists(a2c_fldlist, c2a_fldlist,l2c_fldlist, c2l_fldlist) !------------------------------------------------------------------------- ! !---- from atm ----! a2c_fldlist & c2l_fldlist !------------------------------------------------------------------------- - a2c_fldlist(1)%stdname = 'uwind' - a2c_fldlist(1)%farrayptr1d => atm2lnd1d%uwind !*** this now sets the module variable memory in atmos_cap.F90 - print *, a2c_fldlist(1)%stdname - !print *, a2c_fldlist(1)%farrayptr1d(:) - a2c_fldlist(2)%stdname = 'vwind' - a2c_fldlist(2)%farrayptr1d => atm2lnd1d%vwind !*** this now sets the module variable memory in atmos_cap.F90 - print *, a2c_fldlist(2)%stdname - !print *, a2c_fldlist(2)%farrayptr1d(:) - a2c_fldlist(3)%stdname = 'tbot' - a2c_fldlist(3)%farrayptr1d => atm2lnd1d%vwind - print *, a2c_fldlist(3)%stdname - !print *, a2c_fldlist(3)%farrayptr1d - - - !!! Where should these point to? pointer to an empty array which will be filled in the land.... - - ! Similary we need c2a_fldlist - c2l_fldlist(1)%stdname = 'uwind' - print *, c2l_fldlist(1)%stdname - c2l_fldlist(2)%stdname = 'vwind' - print *, c2l_fldlist(1)%stdname - c2l_fldlist(3)%stdname = 'tbot' - print *, c2l_fldlist(1)%stdname - - !------------------------------------------------------------------------- ! !---- from land ----! l2c_fldlist & c2a_fldlist !------------------------------------------------------------------------- - - l2c_fldlist(1)%stdname = 'lwup' - l2c_fldlist(1)%farrayptr1d => lnd2atm1d%lwup - print *, l2c_fldlist(1)%stdname - - l2c_fldlist(2)%stdname = 'taux' - print *, l2c_fldlist(2)%stdname - l2c_fldlist(2)%farrayptr1d => lnd2atm1d%taux - - l2c_fldlist(3)%stdname = 'tauy' - print *, l2c_fldlist(3)%stdname - l2c_fldlist(3)%farrayptr1d => lnd2atm1d%taux - - - c2a_fldlist(1)%stdname = 'lwup' - print *, c2a_fldlist(1)%stdname - - c2a_fldlist(2)%stdname = 'taux' - print *, c2a_fldlist(2)%stdname - - c2a_fldlist(3)%stdname = 'tauy' - print *, c2a_fldlist(3)%stdname - ! ======================================================================= ! create_fldlist !------------------------------------------------------------------------- @@ -384,7 +341,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call ESMF_GridCompInitialize(land_gcomp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"lnd_cap or land_gcomp initialized", ESMF_LOGMSG_INFO) - print *, "lnd_cap initialize finished, rc =", rc + !print *, "lnd_cap initialize finished, rc =", rc ! All 4 states that are module variables are no longer empty - have been initialized @@ -414,7 +371,7 @@ subroutine lilac_run( ) integer :: rc, urc character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names - !integer, parameter :: fldsMax = 100 + integer, parameter :: fldsMax = 100 integer :: a2l_fldnum, l2a_fldnum ! input/output variables From 4b4a9fe23af7ff0d14f2a26250eabb19d7ac102a Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 8 Aug 2019 12:10:27 -0600 Subject: [PATCH 125/556] adding the default values for atm --> lnd --- lilac/lilac/lilac_utils.F90 | 101 +++++++++++++++++++++++++----------- 1 file changed, 72 insertions(+), 29 deletions(-) diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 index ce57848dbb..15be7b0153 100644 --- a/lilac/lilac/lilac_utils.F90 +++ b/lilac/lilac/lilac_utils.F90 @@ -13,6 +13,7 @@ module lilac_utils integer, parameter :: fldsMax = 100 + character(*) , parameter :: modname = "lilac_utils" ! !PUBLIC TYPES: type :: fld_list_type character(len=128) :: stdname @@ -75,8 +76,9 @@ subroutine fldlist_add(num, fldlist, stdname, default_value, units, ungridded_lb ! local variables integer :: rc - character(len=*), parameter :: subname=':[fldlist_add]' + character(len=*), parameter :: subname=trim(modname)//':[fldlist_add]' !------------------------------------------------------------------------------- + call ESMF_LogWrite(subname//"inside fldlist_add!", ESMF_LOGMSG_INFO) ! Set up a list of field information num = num + 1 @@ -107,7 +109,8 @@ subroutine fldlist_add(num, fldlist, stdname, default_value, units, ungridded_lb end subroutine fldlist_add - subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist, rof_prognostic, glc_present ) + !subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist, rof_prognostic, glc_present ) + subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist) ! add all the necessary fields one by one to the fieldlist type(fld_list_type), intent(inout) :: a2c_fldlist(fldsMax) @@ -115,45 +118,67 @@ subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist, r type(fld_list_type), intent(inout) :: l2c_fldlist(fldsMax) type(fld_list_type), intent(inout) :: c2l_fldlist(fldsMax) - !type (fld_list_type) :: fldsToLnd(fldsMax) - !type (fld_list_type) :: fldsFrLnd(fldsMax) - - !integer :: fldsFrCpl_num, fldsToCpl_num - integer :: fldsToLnd_num != 0 ! From atmosphere to land (a2c and c2l) - integer :: fldsFrLnd_num != 0 ! From land to atmosphere (l2c and c2a) + ! I use this as an index! + integer :: fldsToLnd_num != 0 ! From atmosphere to land (c2l) + integer :: fldsFrLnd_num != 0 ! From land to atmosphere (l2c) + integer :: fldsToAtm_num != 0 ! From land to atmosphere (c2a) + integer :: fldsFrAtm_num != 0 ! From atmosphere to land (a2c) integer, parameter :: fldsMax = 100 - logical , intent(in) :: glc_present ! .true. => running with a non-stub GLC model - logical , intent(in) :: rof_prognostic ! .true. => running with a prognostic ROF model + ! TODO (NS) : Should we move these to the land cap???? + logical :: glc_present ! .true. => running with a non-stub GLC model + logical :: rof_prognostic ! .true. => running with a prognostic ROF model + character(len=*), parameter :: subname=trim(modname)//':[create_fldlists]' ! TODO (NS) : I should add default value and units here..... + fldsToLnd_num= 0 + fldsFrLnd_num= 0 + fldsToAtm_num= 0 + fldsFrAtm_num= 0 + + call ESMF_LogWrite(subname//"is called!", ESMF_LOGMSG_INFO) + !------------------------------------------------------------------------- ! !---- from atm ----! a2c_fldlist & c2l_fldlist !------------------------------------------------------------------------- !--------------------------a2c_fldlist------------------------------------ ! from atm - states - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_z' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_topo' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_u' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_v' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_ptem' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_pbot' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_tbot' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_shum' ) - !call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Sa_methane' ) + !call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_z' ) + !call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_topo' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_z' , default_value=30.0 , units='m/s') + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_topo' , default_value=10.0 , units='m') + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_u' , default_value=0.0 , units='m/s') + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_v' , default_value=0.0 , units='m/s') + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_ptem' , default_value=280.0 , units='degK') + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_pbot' , default_value=100100.0 , units='pa' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_tbot' , default_value=280.0 , units='degk' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_shum' , default_value=0.0004 , units='kg/kg' ) + !call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_methane' ) + + call ESMF_LogWrite(subname//"from atmosphere states are added!" , ESMF_LOGMSG_INFO) + + + + ! from atm - fluxes - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_lwdn' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_rainc' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_rainl' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_snowc' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_snowl' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_swndr' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_swvdr' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_swndf' ) - call fldlist_add(fldsToLnd_num, a2c_fldlist, 'Faxa_swvdf' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_lwdn' , default_value=200.0 , units='W/m2' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_rainc' , default_value=4.0e-8 , units='kg/m2s' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_rainl' , default_value=3.0e-8 , units='kg/m2s' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_snowc' , default_value=1.0e-8 , units='kg/m2s' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_snowl' , default_value=2.0e-8 , units='kg/m2s' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swndr' , default_value=100.0 , units='W/m2' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swvdr' , default_value=90.0 , units='W/m2' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swndf' , default_value=20.0 , units='W/m2' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swvdf' , default_value=40.0 , units='W/m2' ) + + call ESMF_LogWrite(subname//"from atmosphere fluxes are added!", ESMF_LOGMSG_INFO) + + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') !--------------------------c2l_fldlist------------------------------------ ! from atm - states @@ -166,6 +191,7 @@ subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist, r call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_tbot' ) call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_shum' ) !call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_methane' ) + call ESMF_LogWrite(subname//"from atmosphere states are added!", ESMF_LOGMSG_INFO) ! from atm - fluxes call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_lwdn' ) @@ -177,6 +203,7 @@ subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist, r call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swvdr' ) call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swndf' ) call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swvdf' ) + call ESMF_LogWrite(subname//"from atmosphere fluxes are added!", ESMF_LOGMSG_INFO) !------------------------------------------------------------------------- ! !---- from lnd ----! l2c_fldlist & c2a_fldlist @@ -195,25 +222,41 @@ subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist, r call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_u10' ) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_fv' ) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_ram1' ) + call ESMF_LogWrite(subname//"l2c: from land states are added!", ESMF_LOGMSG_INFO) - + rof_prognostic = .false. ! export fluxes to river if (rof_prognostic) then + call ESMF_LogWrite(subname//"Okay we are in rof_prognostic", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofsur' ) + call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 13", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofgwl' ) + call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 14", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofsub' ) + call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 15", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofi' ) + call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 16", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_irrig' ) + call ESMF_LogWrite(subname//"l2c: from land states are added for rof_prognostic!", ESMF_LOGMSG_INFO) end if ! export fluxes to atm + call ESMF_LogWrite(subname//"l2c: now adding fluxes to atmosphere!", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_taux' ) + call ESMF_LogWrite(subname//"l2c: Fall_taux!", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_tauy' ) + call ESMF_LogWrite(subname//"l2c: Fall_taux!", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_lat' ) + call ESMF_LogWrite(subname//"l2c: Fall_lat!", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_sen' ) + call ESMF_LogWrite(subname//"l2c: Fall_sen!", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_lwup' ) + call ESMF_LogWrite(subname//"l2c: Fall_lwup!", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_evap' ) + call ESMF_LogWrite(subname//"l2c: Fall_evap!", ESMF_LOGMSG_INFO) call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_swnet' ) + call ESMF_LogWrite(subname//"l2c: Fall_lat!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"l2c: from land fluxes are added!", ESMF_LOGMSG_INFO) ! call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_methane' ) From 34e1a79ad819a281ae5e245b3f49f5b95d4f1c8c Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 8 Aug 2019 12:11:06 -0600 Subject: [PATCH 126/556] ptr with default values for atmos_cap --- lilac/lilac/atmos_cap.F90 | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 index 04b192b206..b0a4eeaa6c 100644 --- a/lilac/lilac/atmos_cap.F90 +++ b/lilac/lilac/atmos_cap.F90 @@ -5,7 +5,8 @@ module atmos_cap ! !USES use ESMF - use lilac_utils + use lilac_utils, only : fld_list_type + implicit none @@ -21,9 +22,8 @@ module atmos_cap !type (fld_list_type) :: a2c_fldlist(fldsMax) !type (fld_list_type) :: c2a_fldlist(fldsMax) - integer :: a2c_fldlist_num - integer :: c2a_fldlist_num - + integer :: a2c_fldlist_num + integer :: c2a_fldlist_num !private public :: atmos_register @@ -88,7 +88,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) mesh_switch = .True. if(mesh_switch) then - ! For now this is our dummy mesh: + ! For now this is our dummy mesh: !atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' !! Negin: This did not work.... atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv1.9x2.5_141008_ESMFmesh.nc' @@ -122,12 +122,11 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) a2c_fb = ESMF_FieldBundleCreate(name="a2c_fb", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"field bundle", ESMF_LOGMSG_INFO) ! Create individual fields and add to field bundle -- a2l !call fldlist_add(a2c_fldlist_num, a2c_fldlist, 'dum_var2' ) - a2c_fldlist_num = 3 + a2c_fldlist_num = 14 do n = 1,a2c_fldlist_num @@ -180,7 +179,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create individual fields and add to field bundle -- l2a - c2a_fldlist_num = 3 + c2a_fldlist_num = 16 do n = 1,c2a_fldlist_num @@ -191,9 +190,9 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! create field !!! Here we want to pass pointers if (mesh_switch) then - !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) + field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr1d, rc=rc) - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) @@ -225,6 +224,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "!lnd2atm_a_state is filld with dummy_var field bundle!" + ! Set Attributes needed by land + call ESMF_AttributeSet(lnd2atm_a_state, name="nextsw_cday", value=11, rc=rc) end subroutine atmos_init From 50350e4beedf5f0a1ed2a2cc90dd1fdcf720d8a2 Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 12 Aug 2019 16:38:55 -0600 Subject: [PATCH 127/556] so that there is no intereference with the suboutine... --- lilac/lilac/lnd_cap.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/lilac/lnd_cap.F90 b/lilac/lilac/lnd_cap.F90 index 0bf6d78dd4..3e73d4e6c1 100644 --- a/lilac/lilac/lnd_cap.F90 +++ b/lilac/lilac/lnd_cap.F90 @@ -1,6 +1,6 @@ module lnd_cap use ESMF - use lilac_utils + use lilac_utils, only : fld_list_type implicit none From 7beecf21f5980bc7cf4e6b412ef540ab3538cb0c Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 12 Aug 2019 16:39:46 -0600 Subject: [PATCH 128/556] FOR NOW, we are setting these default values.... --- lilac/lilac/demo_driver.F90 | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index 269df07b66..0ae762c74c 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -70,26 +70,37 @@ program demo_lilac_driver allocate ( rand1 (begc:endc) ) ; call random_number (rand1) allocate ( rand2 (begc:endc) ) ; call random_number (rand2) + !allocating these values of default for now! + allocate ( atm2lnd%Sa_z (begc:endc) ) ; atm2lnd%Sa_z (:) = 30.0 + allocate ( atm2lnd%Sa_topo (begc:endc) ) ; atm2lnd%Sa_topo (:) = 10.0 + allocate ( atm2lnd%Sa_u (begc:endc) ) ; atm2lnd%Sa_u (:) = 0.0 + allocate ( atm2lnd%Sa_v (begc:endc) ) ; atm2lnd%Sa_v (:) = 0.0 + allocate ( atm2lnd%Sa_ptem (begc:endc) ) ; atm2lnd%Sa_ptem (:) = 280.0 + allocate ( atm2lnd%Sa_pbot (begc:endc) ) ; atm2lnd%Sa_pbot (:) = 100100.0 + allocate ( atm2lnd%Sa_tbot (begc:endc) ) ; atm2lnd%Sa_tbot (:) = 280.0 + allocate ( atm2lnd%Sa_shum (begc:endc) ) ; atm2lnd%Sa_shum (:) = 0.0004 + allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) ; atm2lnd%Faxa_lwdn (:) = 500.0 !200.0 + allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 4.0e-8 + allocate ( atm2lnd%Faxa_rainl (begc:endc) ) ; atm2lnd%Faxa_rainl (:) = 3.0e-8 + allocate ( atm2lnd%Faxa_snowc (begc:endc) ) ; atm2lnd%Faxa_snowc (:) = 1.0e-8 + allocate ( atm2lnd%Faxa_snowl (begc:endc) ) ; atm2lnd%Faxa_snowl (:) = 2.0e-8 + allocate ( atm2lnd%Faxa_swndr (begc:endc) ) ; atm2lnd%Faxa_swndr (:) = 100.0 + allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) ; atm2lnd%Faxa_swvdr (:) = 90.0 + allocate ( atm2lnd%Faxa_swndf (begc:endc) ) ; atm2lnd%Faxa_swndf (:) = 20.0 + allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) ; atm2lnd%Faxa_swvdf (:) = 40.0 - allocate ( atm2lnd%uwind (begc:endc) ) ; atm2lnd%uwind (:) = rand1 - allocate ( atm2lnd%vwind (begc:endc) ) ; atm2lnd%vwind (:) = rand1 - allocate ( atm2lnd%tbot (begc:endc) ) ; atm2lnd%tbot (:) = rand1 !endc = 18048 ? should this be the size of the land or atmosphere??? + allocate ( lnd2atm%lwup (begc:endc) ) ; lnd2atm%lwup (:) = rand2 allocate ( lnd2atm%taux (begc:endc) ) ; lnd2atm%taux (:) = rand2 allocate ( lnd2atm%tauy (begc:endc) ) ; lnd2atm%tauy (:) = rand2 - - print *, "=======================================" - print *, atm2lnd%uwind(1:10) - print *, "=======================================" - !------------------------------------------------------------------------ ! looping over imaginary time .... !------------------------------------------------------------------------ do curr_time = start_time, end_time - if (curr_time == start_time) then + if (curr_time == start_time) then ! Initalization phase print *, "--------------------------" From be64eb43dd1a7e285d9f173171f8968c9a1f79af Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 12 Aug 2019 16:41:04 -0600 Subject: [PATCH 129/556] changing the atm2lnd datatype to encompass variables needed by CTSM --- lilac/lilac/lilac_utils.F90 | 84 ++++++++++++++++++++++++++++++------- 1 file changed, 68 insertions(+), 16 deletions(-) diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 index 15be7b0153..0758ac74f9 100644 --- a/lilac/lilac/lilac_utils.F90 +++ b/lilac/lilac/lilac_utils.F90 @@ -19,37 +19,85 @@ module lilac_utils character(len=128) :: stdname real*8 :: default_value character(len=128) :: units - real(ESMF_KIND_R8), pointer :: farrayptr1d(:) ! this will be filled in by lilac when it gets its data from the host atm + real(ESMF_KIND_R8), pointer :: farrayptr1d(:) ! this will be filled in by lilac when it gets its data from the host atm real(ESMF_KIND_R8), pointer :: farrayptr2d(:,:) ! this will be filled in by lilac when it gets its data from the host atm integer :: ungridded_lbound = 0 integer :: ungridded_ubound = 0 end type fld_list_type !!! 1d for when we have mesh and 2d for when we have grids.... - - type :: atm2lnd_data1d_type - real*8, pointer :: uwind (:) - real*8, pointer :: vwind (:) - real*8, pointer :: tbot (:) + type , public :: atm2lnd_data1d_type + real*8, pointer :: Sa_z (:) + real*8, pointer :: Sa_topo (:) + real*8, pointer :: Sa_u (:) + real*8, pointer :: Sa_v (:) + real*8, pointer :: Sa_ptem (:) + real*8, pointer :: Sa_pbot (:) + real*8, pointer :: Sa_tbot (:) + real*8, pointer :: Sa_shum (:) + !real*8, pointer :: Sa_methane (:) + ! from atm - fluxes + real*8, pointer :: Faxa_lwdn (:) + real*8, pointer :: Faxa_rainc (:) + real*8, pointer :: Faxa_rainl (:) + real*8, pointer :: Faxa_snowc (:) + real*8, pointer :: Faxa_snowl (:) + real*8, pointer :: Faxa_swndr (:) + real*8, pointer :: Faxa_swvdr (:) + real*8, pointer :: Faxa_swndf (:) + real*8, pointer :: Faxa_swvdf (:) end type atm2lnd_data1d_type +! + + type , public :: atm2lnd_data2d_type + real*8, pointer :: Sa_z (:,:) + real*8, pointer :: Sa_topo (:,:) + real*8, pointer :: Sa_u (:,:) + real*8, pointer :: Sa_v (:,:) + real*8, pointer :: Sa_ptem (:,:) + real*8, pointer :: Sa_pbot (:,:) + real*8, pointer :: Sa_tbot (:,:) + real*8, pointer :: Sa_shum (:,:) + !real*8, pointer :: Sa_methane (:,:) + ! from atm - fluxes + real*8, pointer :: Faxa_lwdn (:,:) + real*8, pointer :: Faxa_rainc (:,:) + real*8, pointer :: Faxa_rainl (:,:) + real*8, pointer :: Faxa_snowc (:,:) + real*8, pointer :: Faxa_snowl (:,:) + real*8, pointer :: Faxa_swndr (:,:) + real*8, pointer :: Faxa_swvdr (:,:) + real*8, pointer :: Faxa_swndf (:,:) + real*8, pointer :: Faxa_swvdf (:,:) + end type atm2lnd_data2d_type + + + + + !type :: atm2lnd_data1d_type + ! real*8, pointer :: uwind (:) + ! real*8, pointer :: vwind (:) + ! real*8, pointer :: tbot (:) + !end type atm2lnd_data1d_type + type :: lnd2atm_data1d_type real*8, pointer :: lwup (:) real*8, pointer :: taux (:) real*8, pointer :: tauy (:) end type lnd2atm_data1d_type - type :: atm2lnd_data2d_type - real*8, pointer :: uwind (:,:) - real*8, pointer :: vwind (:,:) - real*8, pointer :: tbot (:,:) - end type atm2lnd_data2d_type + !type :: atm2lnd_data2d_type + ! real*8, pointer :: uwind (:,:) + ! real*8, pointer :: vwind (:,:) + ! real*8, pointer :: tbot (:,:) + !end type atm2lnd_data2d_type - type :: lnd2atm_data2d_type - real*8, pointer :: lwup (:,:) - real*8, pointer :: taux (:,:) - real*8, pointer :: tauy (:,:) - end type lnd2atm_data2d_type + !type :: lnd2atm_data2d_type + ! real*8, pointer :: lwup (:,:) + ! real*8, pointer :: taux (:,:) + ! real*8, pointer :: tauy (:,:) + ! end type lnd2atm_data2d_type type :: this_clock integer, pointer :: yy @@ -107,6 +155,10 @@ subroutine fldlist_add(num, fldlist, stdname, default_value, units, ungridded_lb fldlist(num)%units = "" end if + !allocate (fldlist%farrayptr1d(fldsMax)) + + !fldlist%farrayptr1d = default_value + end subroutine fldlist_add !subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist, rof_prognostic, glc_present ) From c96b5176f7a96c9472bf27b5a3516dc0fcba8d08 Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 12 Aug 2019 16:41:55 -0600 Subject: [PATCH 130/556] Make the necessary changes in lila_mod to work with the new atm2lnd needed by CTSM --- lilac/lilac/lilac_mod.F90 | 96 +++++++++++++++++++++++++-------------- 1 file changed, 63 insertions(+), 33 deletions(-) diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 55e9797f73..904f171efe 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -6,10 +6,11 @@ module lilac_mod ! !USES use ESMF - use lilac_utils + use lilac_utils , only : fld_list_type, fldsMax, create_fldlists + use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type + use lilac_utils , only : atm2lnd_data2d_type , lnd2atm_data2d_type use atmos_cap , only : atmos_register !use lnd_shr_methods - !use lnd_comp_esmf use lnd_comp_esmf , only : lnd_register use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register @@ -18,6 +19,11 @@ module lilac_mod implicit none + !TODO (NS,2019-08-07): + ! We will move this later to lnd_cap (ctsm_cap) and atmos_cap + !use atmos_cap , only : a2l_fldnum + integer , public , parameter :: a2l_fldnum = 14 + integer , public , parameter :: l2a_fldnum = 16 public :: lilac_init public :: lilac_run @@ -48,8 +54,9 @@ module lilac_mod subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) - use atmos_cap , only : a2c_fldlist, c2a_fldlist - use lnd_cap, only : l2c_fldlist, c2l_fldlist + use atmos_cap , only : a2c_fldlist , c2a_fldlist + use lnd_cap , only : l2c_fldlist , c2l_fldlist + character(len=*), parameter :: subname=trim(modname)//': [lilac_init] ' ! input/output variables @@ -67,7 +74,6 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) integer :: rc , urc character(len=ESMF_MAXSTR) :: gcname1 , gcname2 ! Gridded components names character(len=ESMF_MAXSTR) :: ccname1 , ccname2 ! Coupling components names - integer :: a2l_fldnum , l2a_fldnum ! Namelist and related variables @@ -87,6 +93,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) integer :: ncomps = 1 ! land only + integer :: n !!! above: https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/pio-xlis-bld/xlis_main.F90 @@ -94,8 +101,6 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! Initialize return code rc = ESMF_SUCCESS - a2l_fldnum = 14 - l2a_fldnum = 16 print *, "---------------------------------------" print *, " Lilac Demo Application Start " @@ -146,7 +151,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call mpi_finalize(ierror=rc) stop endif -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !------------------------------------------------------------------------- ! Initialize ESMF, set the default calendar and log type. !------------------------------------------------------------------------- @@ -179,30 +184,61 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! value to them. !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + ! !---- from atm ----! a2c_fldlist & c2l_fldlist + !------------------------------------------------------------------------- !allocate (a2c_fldlist(a2l_fldnum)) - !allocate (c2a_fldlist(l2a_fldnum)) + !allocate (c2l_fldlist(a2l_fldnum)) + !------------------------------------------------------------------------- + ! !---- from land ----! l2c_fldlist & c2a_fldlist + !------------------------------------------------------------------------- + !allocate (c2a_fldlist(l2a_fldnum)) !allocate (l2c_fldlist(l2a_fldnum)) - !allocate (c2l_fldlist(a2l_fldnum)) + allocate (a2c_fldlist(fldsMax)) allocate (c2a_fldlist(fldsMax)) allocate (l2c_fldlist(fldsmax)) allocate (c2l_fldlist(fldsmax)) + print *, "creating empty field lists !" - call ESMF_LogWrite(subname//"EMPTY field lists are created...", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"fielldlists are allocated!", ESMF_LOGMSG_INFO) + + ! create field lists + call create_fldlists(a2c_fldlist, c2a_fldlist,l2c_fldlist, c2l_fldlist) + call ESMF_LogWrite(subname//"fielldlists are created!", ESMF_LOGMSG_INFO) - ! ======================================================================= ! maybe move to create_fldlist? - ! call create_fldlists(c2a_fldlist, a2c_fldlist, ) - call create_fldlists(a2c_fldlist, c2a_fldlist,l2c_fldlist, c2l_fldlist) !------------------------------------------------------------------------- - ! !---- from atm ----! a2c_fldlist & c2l_fldlist + ! !---- from atm ----! a2c_fldlist filling the arrayptr.. !------------------------------------------------------------------------- - ! !---- from land ----! l2c_fldlist & c2a_fldlist - !------------------------------------------------------------------------- - ! ======================================================================= ! create_fldlist + ! FIXME: This should go to the demo_driver or real atmosphere...... + !allocate( a2c_fldlist(fldsmax)%farrayptr1d(1728)) + !do n = 1,a2l_fldnum + ! print *, " index is ", n + ! a2c_fldlist(1)%farrayptr1d(:) = 300.0 + !end do + + a2c_fldlist(1)%farrayptr1d => atm2lnd1d%Sa_z + a2c_fldlist(2)%farrayptr1d => atm2lnd1d%Sa_topo + a2c_fldlist(3)%farrayptr1d => atm2lnd1d%Sa_u + a2c_fldlist(4)%farrayptr1d => atm2lnd1d%Sa_v + a2c_fldlist(5)%farrayptr1d => atm2lnd1d%Sa_ptem + a2c_fldlist(6)%farrayptr1d => atm2lnd1d%Sa_pbot + a2c_fldlist(7)%farrayptr1d => atm2lnd1d%Sa_shum + a2c_fldlist(8)%farrayptr1d => atm2lnd1d%Faxa_lwdn + a2c_fldlist(9)%farrayptr1d => atm2lnd1d%Faxa_rainc + a2c_fldlist(10)%farrayptr1d => atm2lnd1d%Faxa_rainl + a2c_fldlist(11)%farrayptr1d => atm2lnd1d%Faxa_snowc + a2c_fldlist(12)%farrayptr1d => atm2lnd1d%Faxa_snowl + a2c_fldlist(13)%farrayptr1d => atm2lnd1d%Faxa_swndr + a2c_fldlist(14)%farrayptr1d => atm2lnd1d%Faxa_swvdr + a2c_fldlist(15)%farrayptr1d => atm2lnd1d%Faxa_swndf + a2c_fldlist(16)%farrayptr1d => atm2lnd1d%Faxa_swvdf + + ! ======================================================================== !------------------------------------------------------------------------- ! Create Gridded Component! -- atmosphere ( atmos_cap) @@ -299,6 +335,8 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call ESMF_CalendarPrint ( calendar , rc=rc) print *, "---------------------------------------" + ! ======================================================================== + !------------------------------------------------------------------------- ! Create the necessary import and export states used to pass data ! between components. @@ -332,28 +370,22 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call ESMF_GridCompInitialize(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp initialized", ESMF_LOGMSG_INFO) - print *, "atmos_cap initialize finished, rc =", rc - rc = ESMF_SUCCESS - print *, rc - call ESMF_LogWrite(subname//"Now we are initializing CTSM ....", ESMF_LOGMSG_INFO) - print *, "Now we are initializing CTSM, rc =", rc call ESMF_GridCompInitialize(land_gcomp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"lnd_cap or land_gcomp initialized", ESMF_LOGMSG_INFO) - !print *, "lnd_cap initialize finished, rc =", rc ! All 4 states that are module variables are no longer empty - have been initialized call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) - print *, "coupler :: cpl_atm2lnd_comp initialize finished, rc =", rc + print *, "coupler :: cpl_atm2lnd_comp initialize finished" !, rc =", rc call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) - print *, "coupler :: cpl_lnd2atm_comp initialize finished, rc =", rc + print *, "coupler :: cpl_lnd2atm_comp initialize finished" !, rc =", rc end subroutine lilac_init @@ -371,8 +403,7 @@ subroutine lilac_run( ) integer :: rc, urc character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names - integer, parameter :: fldsMax = 100 - integer :: a2l_fldnum, l2a_fldnum + !integer, parameter :: fldsMax = 100 ! input/output variables !type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d @@ -413,22 +444,22 @@ subroutine lilac_run( ) call ESMF_GridCompRun(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=local_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp is running", ESMF_LOGMSG_INFO) - print *, "Running atmos_cap gridded component , rc =", rc + print *, "Running atmos_cap gridded component "!, rc =", rc call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=local_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) - print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc + print *, "Running coupler component..... cpl_atm2lnd_comp"! , rc =", rc call ESMF_GridCompRun(land_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=local_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"lnd_cap or land_gcomp is running", ESMF_LOGMSG_INFO) - print *, "Running lnd_cap gridded component , rc =", rc + print *, "Running lnd_cap gridded component"! , rc =", rc call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=local_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) - print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc + print *, "Running coupler component..... cpl_lnd2atm_comp" ! , rc =", rc ! Advance the time call ESMF_ClockAdvance(local_clock, rc=rc) @@ -455,7 +486,6 @@ subroutine lilac_final( ) character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names !integer, parameter :: fldsMax = 100 - integer :: a2l_fldnum, l2a_fldnum !------------------------------------------------------------------------ !------------------------------------------------------------------------ From 178ad5dd4fb8b1c70eabb8c488a2be20bf67f490 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 13 Aug 2019 12:09:56 -0600 Subject: [PATCH 131/556] saving before moving to the new branch for changing fieldbundles.... --- lilac/lilac/Makefile | 2 +- lilac/lilac/atmos_cap.F90 | 15 ++++++++++----- lilac/lilac/batch.sub | 4 ++-- lilac/lilac/lilac_utils.F90 | 10 +++++----- 4 files changed, 18 insertions(+), 13 deletions(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index 0c26d0d75b..a1509ffded 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -68,7 +68,7 @@ atmos_cap.o: lilac_utils.o dust: rm -f PET*.ESMF_LogFile DE.nc FLAG.nc OMEGA.nc SIE.nc U_velocity.nc V_velocity.nc clean: - rm -f *.exe *.o *.mod + rm -f *.exe distclean: dust clean berzerk: rm -f PET*.ESMF_LogFile job_name* *.o *.mod *.exe diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 index b0a4eeaa6c..4d88db09c8 100644 --- a/lilac/lilac/atmos_cap.F90 +++ b/lilac/lilac/atmos_cap.F90 @@ -126,13 +126,14 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! Create individual fields and add to field bundle -- a2l !call fldlist_add(a2c_fldlist_num, a2c_fldlist, 'dum_var2' ) - a2c_fldlist_num = 14 + a2c_fldlist_num = 16 do n = 1,a2c_fldlist_num print *, "**********************************************************" print *, "creating field for a2l:" print *, trim(a2c_fldlist(n)%stdname) + print *, a2c_fldlist(n)%farrayptr1d ! create field !!! Here we want to pass pointers @@ -143,6 +144,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) !call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8), rc=rc) !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, 'Here we are printing field!' call ESMF_FieldPrint(field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out !call ESMF_LogWrite(subname//"fieldget!", ESMF_LOGMSG_INFO) @@ -154,6 +156,9 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_StateAdd(atm2lnd_a_state, (/field/) , rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !print *, a2c_fldlist(n)%farrayptr1d !print *, "this field is created" @@ -163,8 +168,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" ! Add field bundle to state - call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"atm2lnd_a_state is filled with dummy_var field bundle!", ESMF_LOGMSG_INFO) print *, "!atm2lnd_a_state is filld with dummy_var field bundle!" @@ -190,8 +195,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! create field !!! Here we want to pass pointers if (mesh_switch) then - field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr1d, rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out diff --git a/lilac/lilac/batch.sub b/lilac/lilac/batch.sub index de2b1018ac..be736f5181 100644 --- a/lilac/lilac/batch.sub +++ b/lilac/lilac/batch.sub @@ -3,8 +3,8 @@ #####PBS -A P54048000 #PBS -A P93300606 #PBS -l walltime=00:10:00 -##PBS -q premium -#PBS -q share +#PBS -q premium +##PBS -q share ##PBS -q regular #PBS -j oe diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 index 0758ac74f9..467c977869 100644 --- a/lilac/lilac/lilac_utils.F90 +++ b/lilac/lilac/lilac_utils.F90 @@ -93,11 +93,11 @@ module lilac_utils ! real*8, pointer :: tbot (:,:) !end type atm2lnd_data2d_type - !type :: lnd2atm_data2d_type - ! real*8, pointer :: lwup (:,:) - ! real*8, pointer :: taux (:,:) - ! real*8, pointer :: tauy (:,:) - ! end type lnd2atm_data2d_type + type :: lnd2atm_data2d_type + real*8, pointer :: lwup (:,:) + real*8, pointer :: taux (:,:) + real*8, pointer :: tauy (:,:) + end type lnd2atm_data2d_type type :: this_clock integer, pointer :: yy From 744c7f26e05c162cf43e3c7be9ae4ca4db68d2b6 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 13 Aug 2019 16:10:10 -0600 Subject: [PATCH 132/556] after screwing things over, now ctsm initializes again.... --- lilac/lilac/Makefile | 10 +++++----- lilac/lilac/atmos_cap.F90 | 17 +++++++++-------- lilac/lilac/cpl_mod.F90 | 4 ++++ 3 files changed, 18 insertions(+), 13 deletions(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index a1509ffded..6773b5a5b8 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -41,15 +41,15 @@ include $(ESMFMKFILE) % : %.C $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< -CTSM_BLD_DIR = /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf +CTSM_BLD_DIR = /glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf CTSM_INC = -I$(CTSM_BLD_DIR)/include CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm TRACEBACK_FLAGS = -g -traceback -debug all -check all # ----------------------------------------------------------------------------- -#EXTRA_LIBS = -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2/lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib -EXTRA_LIBS = -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib -MORE_LIBS = -I/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -#EXTRA_LIBS = $(EXTRA_LIBS) -I/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/pio/pio2 +#EXTRA_LIBS = -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2/lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib +EXTRA_LIBS = -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib +MORE_LIBS = -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ +#EXTRA_LIBS = $(EXTRA_LIBS) -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/pio/pio2 # ----------------------------------------------------------------------------- demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(CTSM_INC) $(CTSM_LIB) $(EXTRA_LIBS) $(TRACEBACK_FLAGS) $(MORE_LIBS) diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 index 4d88db09c8..ff76d7a03c 100644 --- a/lilac/lilac/atmos_cap.F90 +++ b/lilac/lilac/atmos_cap.F90 @@ -26,7 +26,7 @@ module atmos_cap integer :: c2a_fldlist_num !private - public :: atmos_register + public :: atmos_register !real(kind=ESMF_KIND_R8), dimension(:), public, pointer, save :: fldptr !======================================================================== @@ -126,7 +126,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! Create individual fields and add to field bundle -- a2l !call fldlist_add(a2c_fldlist_num, a2c_fldlist, 'dum_var2' ) - a2c_fldlist_num = 16 + a2c_fldlist_num = 14 do n = 1,a2c_fldlist_num @@ -156,8 +156,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_StateAdd(atm2lnd_a_state, (/field/) , rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_StateAdd(atm2lnd_a_state, (/field/) , rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out !print *, a2c_fldlist(n)%farrayptr1d !print *, "this field is created" @@ -168,8 +168,9 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" ! Add field bundle to state - !call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atm2lnd_a_state is filled with dummy_var field bundle!", ESMF_LOGMSG_INFO) print *, "!atm2lnd_a_state is filld with dummy_var field bundle!" @@ -184,7 +185,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create individual fields and add to field bundle -- l2a - c2a_fldlist_num = 16 + c2a_fldlist_num = 14 do n = 1,c2a_fldlist_num @@ -213,7 +214,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! add field to field bundle call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"c2a fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"c2a fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) print *, "**********************************************************" print *, "creating field for c2a:" diff --git a/lilac/lilac/cpl_mod.F90 b/lilac/lilac/cpl_mod.F90 index 5372b007c9..bf45323496 100644 --- a/lilac/lilac/cpl_mod.F90 +++ b/lilac/lilac/cpl_mod.F90 @@ -88,6 +88,10 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + !call ESMF_FieldBundlePrint (import_fieldbundle, rc=rc) + call ESMF_FieldBundlePrint (export_fieldbundle, rc=rc) + call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) From 1e858ad4620de08517edf78045daae820aacb4ae Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 13 Aug 2019 16:27:01 -0600 Subject: [PATCH 133/556] back to the point 1...... after initialize.... --- lilac/lilac/cpl_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/lilac/cpl_mod.F90 b/lilac/lilac/cpl_mod.F90 index bf45323496..8d4afdf261 100644 --- a/lilac/lilac/cpl_mod.F90 +++ b/lilac/lilac/cpl_mod.F90 @@ -90,7 +90,7 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) !call ESMF_FieldBundlePrint (import_fieldbundle, rc=rc) - call ESMF_FieldBundlePrint (export_fieldbundle, rc=rc) + !call ESMF_FieldBundlePrint (export_fieldbundle, rc=rc) call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out From c89073163cf14b1436e471a7680a517f4cd6da26 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 15 Aug 2019 16:23:42 -0600 Subject: [PATCH 134/556] this versionof lilac initailizes CTSM successfdully and runs for three time steps..... the cap is 65c74cb --- lilac/lilac/atmos_cap.F90 | 63 +++++++++++++++++++------------- lilac/lilac/cpl_mod.F90 | 27 +++++++++++--- lilac/lilac/demo_driver.F90 | 23 ++++++++---- lilac/lilac/lilac_mod.F90 | 71 +++++++++++++++++++++++++------------ lilac/lilac/lilac_utils.F90 | 15 ++++++-- 5 files changed, 139 insertions(+), 60 deletions(-) diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 index ff76d7a03c..1d1792a9cd 100644 --- a/lilac/lilac/atmos_cap.F90 +++ b/lilac/lilac/atmos_cap.F90 @@ -6,10 +6,11 @@ module atmos_cap ! !USES use ESMF use lilac_utils, only : fld_list_type - - + use spmdMod , only : masterproc implicit none + include 'mpif.h' + character(*), parameter :: modname = "atmos_cap" !!integer, parameter :: fldsMax = 100 @@ -29,6 +30,12 @@ module atmos_cap public :: atmos_register !real(kind=ESMF_KIND_R8), dimension(:), public, pointer, save :: fldptr + + integer :: mpierror, numprocs + integer :: i, myid + integer status(MPI_STATUS_SIZE) + + !======================================================================== contains !======================================================================== @@ -86,6 +93,10 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! Read in the mesh ----or----- Generate the grid !------------------------------------------------------------------------- mesh_switch = .True. + call MPI_Comm_size(MPI_COMM_WORLD, numprocs, mpierror) + call MPI_Comm_rank(MPI_COMM_WORLD, myid, mpierror) + + if(mesh_switch) then ! For now this is our dummy mesh: @@ -126,15 +137,10 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! Create individual fields and add to field bundle -- a2l !call fldlist_add(a2c_fldlist_num, a2c_fldlist, 'dum_var2' ) - a2c_fldlist_num = 14 + a2c_fldlist_num = 17 do n = 1,a2c_fldlist_num - print *, "**********************************************************" - print *, "creating field for a2l:" - print *, trim(a2c_fldlist(n)%stdname) - print *, a2c_fldlist(n)%farrayptr1d - ! create field !!! Here we want to pass pointers !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2c_fldlist(n)%stdname), rc=rc) @@ -144,9 +150,15 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) !call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8), rc=rc) !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, 'Here we are printing field!' - call ESMF_FieldPrint(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (myid == 0) then + print *, 'Here we are printing field!' + print *, "**********************************************************" + print *, "creating field for a2l:" + print *, trim(a2c_fldlist(n)%stdname) + print *, a2c_fldlist(n)%farrayptr1d + call ESMF_FieldPrint(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if !call ESMF_LogWrite(subname//"fieldget!", ESMF_LOGMSG_INFO) !call ESMF_FieldGet(field, rc=rc) !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -185,19 +197,19 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out ! Create individual fields and add to field bundle -- l2a - c2a_fldlist_num = 14 + c2a_fldlist_num = 12 do n = 1,c2a_fldlist_num - print *, "**********************************************************" - print *, "creating field for l2a:" - print *, trim(c2a_fldlist(n)%stdname) + !print *, "**********************************************************" + !print *, "creating field for l2a:" + !print *, trim(c2a_fldlist(n)%stdname) ! create field !!! Here we want to pass pointers if (mesh_switch) then - !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) + field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr1d, rc=rc) !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -216,19 +228,22 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"c2a fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) - print *, "**********************************************************" - print *, "creating field for c2a:" - print *, trim(c2a_fldlist(n)%stdname) - !print *, c2a_fldlist(n)%farrayptr1d - + if (myid == 0) then + print *, "creating field for c2a:" + print *, n + print *, trim(c2a_fldlist(n)%stdname) + print *, c2a_fldlist(n)%farrayptr1d + !call ESMF_FieldPrint(field, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if enddo - print *, "!Fields For Coupler (c2a_fldlist) Field Bundle Created!" + !print *, "!Fields For Coupler (c2a_fldlist) Field Bundle Created!" ! Add field bundle to state call ESMF_StateAdd(lnd2atm_a_state, (/c2a_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!lnd2atm_a_state is filld with dummy_var field bundle!" + !print *, "!lnd2atm_a_state is filld with dummy_var field bundle!" ! Set Attributes needed by land call ESMF_AttributeSet(lnd2atm_a_state, name="nextsw_cday", value=11, rc=rc) diff --git a/lilac/lilac/cpl_mod.F90 b/lilac/lilac/cpl_mod.F90 index 8d4afdf261..e6573eaa3a 100644 --- a/lilac/lilac/cpl_mod.F90 +++ b/lilac/lilac/cpl_mod.F90 @@ -10,6 +10,8 @@ module cpl_mod use ESMF implicit none + include 'mpif.h' + private @@ -19,6 +21,12 @@ module cpl_mod character(*), parameter :: modname = " cpl_mod" type(ESMF_RouteHandle), save :: rh_atm2lnd, rh_lnd2atm + + integer :: mpierror, numprocs + integer :: i, myid + integer status(MPI_STATUS_SIZE) + + !====================================================================== contains !====================================================================== @@ -82,15 +90,26 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) print *, "Coupler for atmosphere to land initialize routine called" call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - call ESMF_StateGet(importState, "a2c_fb", import_fieldbundle, rc=rc) + call MPI_Comm_size(MPI_COMM_WORLD, numprocs, mpierror) + call MPI_Comm_rank(MPI_COMM_WORLD, myid, mpierror) + + + + call ESMF_StateGet(importState, trim("a2c_fb"), import_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) + call ESMF_StateGet(exportState, trim("c2l_fb"), export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !call ESMF_FieldBundlePrint (import_fieldbundle, rc=rc) - !call ESMF_FieldBundlePrint (export_fieldbundle, rc=rc) + if (myid == 0) then + print *, "PRINTING FIELDBUNDLES" + call ESMF_FieldBundlePrint (import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_FieldBundlePrint (export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if + call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index 0ae762c74c..c261bcf299 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -73,13 +73,13 @@ program demo_lilac_driver !allocating these values of default for now! allocate ( atm2lnd%Sa_z (begc:endc) ) ; atm2lnd%Sa_z (:) = 30.0 allocate ( atm2lnd%Sa_topo (begc:endc) ) ; atm2lnd%Sa_topo (:) = 10.0 - allocate ( atm2lnd%Sa_u (begc:endc) ) ; atm2lnd%Sa_u (:) = 0.0 - allocate ( atm2lnd%Sa_v (begc:endc) ) ; atm2lnd%Sa_v (:) = 0.0 + allocate ( atm2lnd%Sa_u (begc:endc) ) ; atm2lnd%Sa_u (:) = 20.0 + allocate ( atm2lnd%Sa_v (begc:endc) ) ; atm2lnd%Sa_v (:) = 40.0 allocate ( atm2lnd%Sa_ptem (begc:endc) ) ; atm2lnd%Sa_ptem (:) = 280.0 allocate ( atm2lnd%Sa_pbot (begc:endc) ) ; atm2lnd%Sa_pbot (:) = 100100.0 allocate ( atm2lnd%Sa_tbot (begc:endc) ) ; atm2lnd%Sa_tbot (:) = 280.0 allocate ( atm2lnd%Sa_shum (begc:endc) ) ; atm2lnd%Sa_shum (:) = 0.0004 - allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) ; atm2lnd%Faxa_lwdn (:) = 500.0 !200.0 + allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) ; atm2lnd%Faxa_lwdn (:) = 200.0 allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 4.0e-8 allocate ( atm2lnd%Faxa_rainl (begc:endc) ) ; atm2lnd%Faxa_rainl (:) = 3.0e-8 allocate ( atm2lnd%Faxa_snowc (begc:endc) ) ; atm2lnd%Faxa_snowc (:) = 1.0e-8 @@ -91,9 +91,20 @@ program demo_lilac_driver !endc = 18048 ? should this be the size of the land or atmosphere??? - allocate ( lnd2atm%lwup (begc:endc) ) ; lnd2atm%lwup (:) = rand2 - allocate ( lnd2atm%taux (begc:endc) ) ; lnd2atm%taux (:) = rand2 - allocate ( lnd2atm%tauy (begc:endc) ) ; lnd2atm%tauy (:) = rand2 + + + allocate ( lnd2atm%Sl_lfrin (begc:endc) ) ; lnd2atm%Sl_lfrin (:) = 0 + allocate ( lnd2atm%Sl_t (begc:endc) ) ; lnd2atm%Sl_t (:) = 0 + allocate ( lnd2atm%Sl_tref (begc:endc) ) ; lnd2atm%Sl_tref (:) = 0 + allocate ( lnd2atm%Sl_qref (begc:endc) ) ; lnd2atm%Sl_qref (:) = 0 + allocate ( lnd2atm%Sl_avsdr (begc:endc) ) ; lnd2atm%Sl_avsdr (:) = 0 + allocate ( lnd2atm%Sl_anidr (begc:endc) ) ; lnd2atm%Sl_anidr (:) = 0 + allocate ( lnd2atm%Sl_avsdf (begc:endc) ) ; lnd2atm%Sl_avsdf (:) = 0 + allocate ( lnd2atm%Sl_anidf (begc:endc) ) ; lnd2atm%Sl_anidf (:) = 0 + allocate ( lnd2atm%Sl_snowh (begc:endc) ) ; lnd2atm%Sl_snowh (:) = 0 + allocate ( lnd2atm%Sl_u10 (begc:endc) ) ; lnd2atm%Sl_u10 (:) = 0 + allocate ( lnd2atm%Sl_fv (begc:endc) ) ; lnd2atm%Sl_fv (:) = 0 + allocate ( lnd2atm%Sl_ram1 (begc:endc) ) ; lnd2atm%Sl_ram1 (:) = 0 !------------------------------------------------------------------------ ! looping over imaginary time .... diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 904f171efe..252d623eaa 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -22,8 +22,8 @@ module lilac_mod !TODO (NS,2019-08-07): ! We will move this later to lnd_cap (ctsm_cap) and atmos_cap !use atmos_cap , only : a2l_fldnum - integer , public , parameter :: a2l_fldnum = 14 - integer , public , parameter :: l2a_fldnum = 16 + integer , public , parameter :: a2l_fldnum = 17 + integer , public , parameter :: l2a_fldnum = 12 public :: lilac_init public :: lilac_run @@ -71,7 +71,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) !character(len=*) :: atm_mesh_filepath !!! For now this is hardcoded in the atmos init - integer :: rc , urc + integer :: rc , userRC character(len=ESMF_MAXSTR) :: gcname1 , gcname2 ! Gridded components names character(len=ESMF_MAXSTR) :: ccname1 , ccname2 ! Coupling components names @@ -227,16 +227,37 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) a2c_fldlist(4)%farrayptr1d => atm2lnd1d%Sa_v a2c_fldlist(5)%farrayptr1d => atm2lnd1d%Sa_ptem a2c_fldlist(6)%farrayptr1d => atm2lnd1d%Sa_pbot - a2c_fldlist(7)%farrayptr1d => atm2lnd1d%Sa_shum - a2c_fldlist(8)%farrayptr1d => atm2lnd1d%Faxa_lwdn - a2c_fldlist(9)%farrayptr1d => atm2lnd1d%Faxa_rainc - a2c_fldlist(10)%farrayptr1d => atm2lnd1d%Faxa_rainl - a2c_fldlist(11)%farrayptr1d => atm2lnd1d%Faxa_snowc - a2c_fldlist(12)%farrayptr1d => atm2lnd1d%Faxa_snowl - a2c_fldlist(13)%farrayptr1d => atm2lnd1d%Faxa_swndr - a2c_fldlist(14)%farrayptr1d => atm2lnd1d%Faxa_swvdr - a2c_fldlist(15)%farrayptr1d => atm2lnd1d%Faxa_swndf - a2c_fldlist(16)%farrayptr1d => atm2lnd1d%Faxa_swvdf + a2c_fldlist(7)%farrayptr1d => atm2lnd1d%Sa_tbot + a2c_fldlist(8)%farrayptr1d => atm2lnd1d%Sa_shum + + a2c_fldlist(9)%farrayptr1d => atm2lnd1d%Faxa_lwdn + a2c_fldlist(10)%farrayptr1d => atm2lnd1d%Faxa_rainc + a2c_fldlist(11)%farrayptr1d => atm2lnd1d%Faxa_rainl + a2c_fldlist(12)%farrayptr1d => atm2lnd1d%Faxa_snowc + a2c_fldlist(13)%farrayptr1d => atm2lnd1d%Faxa_snowl + a2c_fldlist(14)%farrayptr1d => atm2lnd1d%Faxa_swndr + a2c_fldlist(15)%farrayptr1d => atm2lnd1d%Faxa_swvdr + a2c_fldlist(16)%farrayptr1d => atm2lnd1d%Faxa_swndf + a2c_fldlist(17)%farrayptr1d => atm2lnd1d%Faxa_swvdf + !------------------------------------------------------------------------- + + ! should I point to zero??? + + c2a_fldlist(1)%farrayptr1d => lnd2atm1d%Sl_lfrin + c2a_fldlist(2)%farrayptr1d => lnd2atm1d%Sl_t + c2a_fldlist(3)%farrayptr1d => lnd2atm1d%Sl_tref + c2a_fldlist(4)%farrayptr1d => lnd2atm1d%Sl_qref + c2a_fldlist(5)%farrayptr1d => lnd2atm1d%Sl_avsdr + c2a_fldlist(6)%farrayptr1d => lnd2atm1d%Sl_anidr + c2a_fldlist(7)%farrayptr1d => lnd2atm1d%Sl_avsdf + c2a_fldlist(8)%farrayptr1d => lnd2atm1d%Sl_anidf + + c2a_fldlist(9)%farrayptr1d => lnd2atm1d%Sl_snowh + c2a_fldlist(10)%farrayptr1d => lnd2atm1d%Sl_u10 + c2a_fldlist(11)%farrayptr1d => lnd2atm1d%Sl_fv + c2a_fldlist(12)%farrayptr1d => lnd2atm1d%Sl_ram1 + + ! ======================================================================== @@ -400,7 +421,7 @@ subroutine lilac_run( ) type(ESMF_State) :: importState, exportState ! local variables - integer :: rc, urc + integer :: rc, userRC character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names !integer, parameter :: fldsMax = 100 @@ -441,25 +462,29 @@ subroutine lilac_run( ) !!! if we want to loop through clock in atmos cap. !do while (.NOT. ESMF_ClockIsStopTime(local_clock, rc=rc)) - call ESMF_GridCompRun(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=local_clock, rc=rc) + call ESMF_GridCompRun(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=local_clock, rc=rc, userRC=userRC) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp is running", ESMF_LOGMSG_INFO) - print *, "Running atmos_cap gridded component "!, rc =", rc + print *, "Running atmos_cap gridded component , rc =", rc - call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=local_clock, rc=rc) + call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=local_clock, rc=rc , userRC=userRC) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) - print *, "Running coupler component..... cpl_atm2lnd_comp"! , rc =", rc + print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc - call ESMF_GridCompRun(land_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=local_clock, rc=rc) + call ESMF_GridCompRun(land_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=local_clock, rc=rc, userRC=userRC) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"lnd_cap or land_gcomp is running", ESMF_LOGMSG_INFO) - print *, "Running lnd_cap gridded component"! , rc =", rc + print *, "Running lnd_cap gridded component , rc =", rc - call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=local_clock, rc=rc) + call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=local_clock, rc=rc, userRC=userRC) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) - print *, "Running coupler component..... cpl_lnd2atm_comp" ! , rc =", rc + print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc ! Advance the time call ESMF_ClockAdvance(local_clock, rc=rc) @@ -482,7 +507,7 @@ subroutine lilac_final( ) type(ESMF_State) :: importState, exportState ! local variables - integer :: rc, urc + integer :: rc, userRC character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names !integer, parameter :: fldsMax = 100 diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 index 467c977869..29e45dad99 100644 --- a/lilac/lilac/lilac_utils.F90 +++ b/lilac/lilac/lilac_utils.F90 @@ -82,9 +82,18 @@ module lilac_utils !end type atm2lnd_data1d_type type :: lnd2atm_data1d_type - real*8, pointer :: lwup (:) - real*8, pointer :: taux (:) - real*8, pointer :: tauy (:) + real*8, pointer :: Sl_lfrin (:) + real*8, pointer :: Sl_t (:) + real*8, pointer :: Sl_tref (:) + real*8, pointer :: Sl_qref (:) + real*8, pointer :: Sl_avsdr (:) + real*8, pointer :: Sl_anidr (:) + real*8, pointer :: Sl_avsdf (:) + real*8, pointer :: Sl_anidf (:) + real*8, pointer :: Sl_snowh (:) + real*8, pointer :: Sl_u10 (:) + real*8, pointer :: Sl_fv (:) + real*8, pointer :: Sl_ram1 (:) end type lnd2atm_data1d_type !type :: atm2lnd_data2d_type From 58f138d93304f29b12831447d682c491a304b9e2 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 23 Aug 2019 11:30:51 -0600 Subject: [PATCH 135/556] this version of lilac initailizes CTSM successfdully and runs until it finishes...YAY!........... the cap is 65c74cb --- lilac/lilac/batch.sub | 4 ++-- lilac/lilac/demo_driver.F90 | 2 +- lilac/lilac/lilac_mod.F90 | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lilac/lilac/batch.sub b/lilac/lilac/batch.sub index be736f5181..5a25dd32b9 100644 --- a/lilac/lilac/batch.sub +++ b/lilac/lilac/batch.sub @@ -3,8 +3,8 @@ #####PBS -A P54048000 #PBS -A P93300606 #PBS -l walltime=00:10:00 -#PBS -q premium -##PBS -q share +###PBS -q premium +#PBS -q share ##PBS -q regular #PBS -j oe diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index c261bcf299..66914b37c0 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -55,7 +55,7 @@ program demo_lilac_driver !endc = 13968 start_time = 1 - end_time = 10 + end_time = 50 itime_step = 1 seed_val = 0 diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 252d623eaa..84c29384a9 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -346,7 +346,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1 , s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=03, dd=01, s=0, calendar=Calendar, rc=rc) call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) From 19f0d9e23f5ade9b297fb698d3b202c193fea676 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 29 Aug 2019 12:02:19 -0600 Subject: [PATCH 136/556] temporary Makefile for Lilac -- hard-coded everythin. --- lilac/lilac/Makefile | 101 +++++++++++++++++++++++++------------------ 1 file changed, 58 insertions(+), 43 deletions(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index 6773b5a5b8..3cc63fd44e 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -1,22 +1,26 @@ -# GNU Makefile template for user ESMF application - -################################################################################ -################################################################################ -## This Makefile must be able to find the "esmf.mk" Makefile fragment in the ## -## 'include' line below. Following the ESMF User's Guide, a complete ESMF ## -## installation should ensure that a single environment variable "ESMFMKFILE" ## -## is made available on the system. This variable should point to the ## -## "esmf.mk" file. ## -## ## -## This example Makefile uses the "ESMFMKFILE" environment variable. ## -## ## -## If you notice that this Makefile cannot find variable ESMFMKFILE then ## -## please contact the person responsible for the ESMF installation on your ## -## system. ## -## As a work-around you can simply hardcode the path to "esmf.mk" in the ## -## include line below. However, doing so will render this Makefile a lot less ## -## flexible and non-portable. ## -################################################################################ + +#================================================================================ +# Makefile to compile the lilac program +#================================================================================ +## This is temporary Makefile for building lilac against CTSM pre-compiled library + + + +#================================================================================ +### Finding and including esmf.mk +#================================================================================ + +# Note: This fully portable Makefile template depends on finding environment +# # variable "ESMFMKFILE" set to point to the appropriate "esmf.mk" file, +# # as is discussed in the User's Guide. +# # However, you can still use this Makefile template even if the person +# # that installed ESMF on your system did not provide for a mechanism to +# # automatically set the environment variable "ESMFMKFILE". In this case +# # either manually set "ESMFMKFILE" in your environment or hard code the +# # location of "esmf.mk" into the include statement below. +# # Notice that the latter approach has negative impact on flexibility and +# # portability. + ifneq ($(origin ESMFMKFILE), environment) $(error Environment variable ESMFMKFILE was not set.) @@ -24,53 +28,64 @@ endif include $(ESMFMKFILE) -################################################################################ -################################################################################ +#================================================================================ +### Define directory paths +#================================================================================ +# Temporarily hard-coded +# TODO: Please fix this part. +CTSM_BLD_DIR = /glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf +CTSM_INC = -I$(CTSM_BLD_DIR)/include +CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm +TRACEBACK_FLAGS = -g -traceback -debug all -check all +# ----------------------------------------------------------------------------- +#EXTRA_LIBS = $(EXTRA_LIBS) -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/pio/pio2 +EXTRA_LIBS = -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib +MORE_LIBSi = -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ +# ----------------------------------------------------------------------------- + + +#================================================================================ +### Compiler and linker rules using ESMF_ variables supplied by esmf.mk +#================================================================================ .SUFFIXES: .f90 .F90 .c .C %.o : %.f90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREENOCPP) $< + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREENOCPP) $< %.o : %.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) $(EXTRA_LIBS) $(MORE_LIBS) $< - + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< + %.o : %.c - $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< + $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) \ + $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< % : %.C - $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< + $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) \ + $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< -CTSM_BLD_DIR = /glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf -CTSM_INC = -I$(CTSM_BLD_DIR)/include -CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm -TRACEBACK_FLAGS = -g -traceback -debug all -check all -# ----------------------------------------------------------------------------- -#EXTRA_LIBS = -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2/lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib -EXTRA_LIBS = -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib -MORE_LIBS = -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -#EXTRA_LIBS = $(EXTRA_LIBS) -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/pio/pio2 -# ----------------------------------------------------------------------------- demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(CTSM_INC) $(CTSM_LIB) $(EXTRA_LIBS) $(TRACEBACK_FLAGS) $(MORE_LIBS) mv demo_driver demo_driver.exe - #rm *.o *.mod + rm *.o *.mod # module dependencies: #demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o #shr_pio_mod.o -###shr_string_mod.o: shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o atmos_cap.o: lilac_utils.o + # ----------------------------------------------------------------------------- -# ----------------------------------------------------------------------------- -.PHONY: dust clean distclean berzerk remake -dust: - rm -f PET*.ESMF_LogFile DE.nc FLAG.nc OMEGA.nc SIE.nc U_velocity.nc V_velocity.nc + +.PHONY: clean berzerk remake clean: rm -f *.exe -distclean: dust clean berzerk: rm -f PET*.ESMF_LogFile job_name* *.o *.mod *.exe remake: rm lilac_mod.o demo_driver.o demo_driver.exe & make +# ----------------------------------------------------------------------------- From 57d676e3061387b35917da3b5f8858a0feb65156 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 29 Aug 2019 12:35:05 -0600 Subject: [PATCH 137/556] removing the swap file (.swp) that was pushed by mistake... --- lilac/lilac/.cpl_mod.F90.swp | Bin 12288 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 lilac/lilac/.cpl_mod.F90.swp diff --git a/lilac/lilac/.cpl_mod.F90.swp b/lilac/lilac/.cpl_mod.F90.swp deleted file mode 100644 index f5b5fe720ede7c4567a1fb56a69411949340a14d..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 12288 zcmeI2&2JM&7>6emLQMG*J+(#ZBvmB`Suv!Qsv@}}b!=gjgvgG2C`e|r9w#f-v#Z^) z+Hl~bYB-XfIPeD`1P3^CK;l-Ztwaw!_t1X;BCXZGE9 zpP6^omUsF1x0QMR<3A|g z2FL&zAOmE843GgbKnC6+1Iis?SCH?nDCfoKbtLr~?a~VwAOmE843GgbKnBPF86X2> zfDDiUGVl%>Fq(|r+0EGQQ6!Jw|GVG+pB-ZCDfk=w0iJ*d;AgM_u7h>31oGezI0*hZ z$k+?;JNOM;01Vtcz}PwPazA7Dz$|$FKKg)P!7b1Mb?`O#Yah-9Hoy(g0s=I_C*Wm< zu|L6mumL1!g97*r>;oAv1|E(vb`!YZ3^)cdU<^Fk%h+x3Be({xf-B$z$bcvCau=+F zpTIdV15SaX;A8L+_z;YOJwUsB570&i$N(95`wa-$#z- z%J2|#WuhMg{ltp!a$Nr-Ro0R??Ib^W646-@3xCv_E3(0fine23oDAMa7gO(T(yOKn zC3?NAw(EE*crVAr551jD4lKHM(P_K-P#xa2P3#5zh6u?<{csJhI8!dnG>2=N9AX)U zr(rs@j1;iFO7WoJmg8~Tz|bj&BZ%X>tHKk|YAMUGtxJOU2Gp=^(d>;udISdi57 z@Sv%$gcq$joLj9dCVM`)piFWTlQmpp%9ae~aTX)ivW=BOuppEcW*al#oUJbD;wtF+ z3MW$kxTvOULY1WQ))pO1`2N)dLFP+Kr_atdDhrjR%FJBlyAldEmaDFzWcYqrmS-w+ z^=c_R>+4FXUjtE6uU}}=zWSL5Yl*(t)C|^{ch~El2isf=;A#&XDg;x#l zG6gfdPc&M3l#{agTak9PzL4XaW$bliD&HNpycNmusT@^sD#|Xa82+RES&g~ocx&gFHLY~(*OVf From 1ba00d8d6b2b89de990aab1c58b8328bbd9f039e Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 29 Aug 2019 12:36:33 -0600 Subject: [PATCH 138/556] updating the .gitignore file... --- lilac/lilac/.gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/lilac/.gitignore b/lilac/lilac/.gitignore index 3ddd2df7eb..d52decad68 100644 --- a/lilac/lilac/.gitignore +++ b/lilac/lilac/.gitignore @@ -2,4 +2,4 @@ job_name* PET* *.exe -#batch.sub +batch.sub From 4b2f343c008f75a9cc4f2f0e2aaf0b54169d9803 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 29 Aug 2019 12:38:37 -0600 Subject: [PATCH 139/556] removing the redundant files..... --- lilac/lilac/batch.sub | 26 - lilac/lilac_joe/CMakeLists.txt | 4 - lilac/lilac_joe/core.f90 | 464 ------------------ lilac/lilac_joe/drivers/lilac_data_driver.f90 | 207 -------- lilac/lilac_joe/esmf_utils.f90 | 224 --------- lilac/lilac_joe/lilac_utils.f90 | 121 ----- 6 files changed, 1046 deletions(-) delete mode 100644 lilac/lilac/batch.sub delete mode 100644 lilac/lilac_joe/CMakeLists.txt delete mode 100644 lilac/lilac_joe/core.f90 delete mode 100644 lilac/lilac_joe/drivers/lilac_data_driver.f90 delete mode 100644 lilac/lilac_joe/esmf_utils.f90 delete mode 100644 lilac/lilac_joe/lilac_utils.f90 diff --git a/lilac/lilac/batch.sub b/lilac/lilac/batch.sub deleted file mode 100644 index 5a25dd32b9..0000000000 --- a/lilac/lilac/batch.sub +++ /dev/null @@ -1,26 +0,0 @@ -#!/bin/tcsh -#PBS -N job_name -#####PBS -A P54048000 -#PBS -A P93300606 -#PBS -l walltime=00:10:00 -###PBS -q premium -#PBS -q share -##PBS -q regular -#PBS -j oe - -#PBS -l select=2:ncpus=2:mpiprocs=4 -##PBS -l select=1:ncpus=1:mpiprocs=2 -##PBS -l select=1:ncpus=1:mpiprocs=1 - -ml - -### Set TMPDIR as recommended -setenv TMPDIR /glade/scratch/$USER/temp -mkdir -p $TMPDIR - - -echo "hello" -### Run the executable -set MPI_SHEPHERD=true -source /glade/scratch/negins/test_clean/.env_mach_specific.csh -mpiexec_mpt ./demo_driver.exe diff --git a/lilac/lilac_joe/CMakeLists.txt b/lilac/lilac_joe/CMakeLists.txt deleted file mode 100644 index a92669e0ff..0000000000 --- a/lilac/lilac_joe/CMakeLists.txt +++ /dev/null @@ -1,4 +0,0 @@ -# Compile LILAC library -file(GLOB_RECURSE LILAC_SOURCES *.f90 *.h) -add_library(lilac ${LILAC_SOURCES}) -target_include_directories(lilac PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/lilac/lilac_joe/core.f90 b/lilac/lilac_joe/core.f90 deleted file mode 100644 index af33240e6d..0000000000 --- a/lilac/lilac_joe/core.f90 +++ /dev/null @@ -1,464 +0,0 @@ -module lilac - - use ESMF - use esmf_utils - - use lilac_utils , only create_fldlists, fldsMax - - - implicit none - - character(*), parameter :: modname = "(core)" - integer, parameter :: LILAC_SUCCESS = ESMF_SUCCESS - - ! shared module level variables - character(len=*) :: atm_mesh_filepath - type(LilacFields) :: a2x_state - type(LilacFields) :: x2a_state - - !-------------------------------------------------------------------------- - ! Public interfaces - !-------------------------------------------------------------------------- - public :: start - public :: init - public :: run - public :: final - - private :: atmos_register - private :: land_register - private :: cpl_register - - type, public :: LilacType - private - - type(ESMFInfoType) :: esmf_info - - contains - procedure, public :: init => init - procedure, public :: run => run - procedure, public :: final => final - - ! register methods - procedure, nopass, private :: atmos_register => atmos_register - procedure, nopass, private :: land_register => land_register - procedure, nopass, private :: cpl_register => cpl_register - - ! Init methods - procedure, nopass, private :: atmos_init => atmos_init - procedure, nopass, private :: land_init => land_init - procedure, nopass, private :: coupler_init => coupler_init - - ! Run methods - procedure, nopass, private :: atmos_copy_atm_to_lilac => atmos_copy_atm_to_lilac - procedure, nopass, private :: atmos_copy_lilac_to_atm => atmos_copy_lilac_to_atm - procedure, nopass, private :: land_run => land_run - procedure, nopass, private :: coupler_run => coupler_run - - ! Final methods - procedure, nopass, private :: atmos_final => atmos_final - procedure, nopass, private :: land_final => land_final - procedure, nopass, private :: coupler_final => coupler_final - - end type LilacType - - type, public :: LilacFields - private - - real, dimension(:, :), allocatable :: fields - character(len=:), allocatable :: field_names(:) - - contains - procedure, public :: init => init_lilac_state - procedure, public :: get => get_lilac_field - end type LilacFields - -contains - - subroutine start(self, rc) - implicit none - class(LilacType), intent(inout) :: self - integer, intent(in) :: rc=ESMF_SUCCESS - - character(len=*), parameter :: subname=trim(modname)//':(init) ' - - call ESMF_LogWrite(subname//"Starting lilac and setting up ESMF", ESMF_LOGMSG_INFO) - - ! Initialize ESMF structures - call self%esmf_info%start(rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - end subroutine start - - subroutine init(self, clock, x2a_state, a2x_state, rc) - implicit none - class(LilacType), intent(inout) :: self - type(ESMF_Clock) :: clock ! Input synchronization clock - type(LilacFields) :: x2a_state - type(LilacFields) :: a2x_state - integer, intent(in) :: rc=ESMF_SUCCESS - - character(len=*), parameter :: subname=trim(modname)//':(init) ' - - call ESMF_LogWrite(subname//"Initializing lilac", ESMF_LOGMSG_INFO) - - call self%esmf_info%start(atmos_register, land_register, cpl_register, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - end subroutine init - - subroutine run(self, clock, x2a_state, a2x_state, rc) - implicit none - class(LilacType), intent(inout) :: self - type(ESMF_Clock) :: clock ! Input synchronization clock - type(LilacFields) :: x2a_state - type(LilacFields) :: a2x_state - integer, intent(in) :: rc=ESMF_SUCCESS - - character(len=*), parameter :: subname=trim(modname)//':(run) ' - - call ESMF_LogWrite(subname//"Running lilac", ESMF_LOGMSG_INFO) - - ! save states to module level variable here - - call self%esmf_info%run(rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - end subroutine run - - subroutine final(self, rc) - implicit none - class(LilacType), intent(inout) :: self - integer, intent(in) :: rc=ESMF_SUCCESS - - character(len=*), parameter :: subname=trim(modname)//':(final) ' - - call ESMF_LogWrite(subname//"Finalizing lilac", ESMF_LOGMSG_INFO) - - call self%esmf_info%final(rc) - - end subroutine final - - subroutine atmos_register(comp, rc) - type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(in) :: rc=ESMF_SUCCESS - - character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' - - ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_atm_to_lilac, phase=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_copy_lilac_to_atm, phase=2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - rc = ESMF_SUCCESS - - end subroutine atmos_register - - subroutine land_register(comp, rc) - type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(out) :: rc ! must not be optional - character(len=*), parameter :: subname=trim(modname)//':(lnd_register) ' - - ! land_* comes from ctsm esmf cap - - ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=land_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=land_run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=land_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - rc = ESMF_SUCCESS - - end subroutine land_register - - subroutine cpl_register(comp, rc) - type(ESMF_CplComp) :: comp ! must not be optional - integer, intent(out) :: rc ! must not be optional - character(len=*), parameter :: subname=trim(modname)//':(cpl_register) ' - - rc = ESMF_FAILURE - - ! Register the callback routines. - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=coupler_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_LogWrite(subname//"CouplerMod: Registered Initialize, Run, and Finalize routines", ESMF_LOGMSG_INFO) - - rc = ESMF_SUCCESS - - end subroutine cpl_register - - subroutine atmos_init(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - type (fld_list_type) :: fldsToCpl(fldsMax) - type (fld_list_type) :: fldsFrCpl(fldsMax) - integer :: fldsToCpl_num - integer :: fldsFrCpl_num - - character(len=*), parameter :: subname=trim(modname)//':(atmos_init) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - ! read in the mesh - if (masterproc) then - write(iulog,*)'mesh file for domain is ',trim(atm_mesh_filepath) - end if - ! move to lilac dummy atmosphere init? - EMesh = ESMF_MeshCreate(filename=trim(atm_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! create field lists - call create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) - - ! Create States - x2a_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - a2x_state = ESMF_StateCreate(name="x2a_state", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Coupler to Atmosphere Fields - FBout = ESMF_FieldBundleCreate(name="x2a_fields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Create individual states and add to field bundle - do n = 1,fldsFrCpl_num - ! create field - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsFrCpl(n)%stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! add field to field bundle - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - enddo - - ! Add FB to state - call ESMF_StateAdd(x2a_state, (/FBout/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Atmosphere to Coupler Fields - FBout = ESMF_FieldBundleCreate(name="a2x_fields", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Create individual states and add to field bundle - do n = 1,fldsToCpl_num - ! create field - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=trim(fldsToCpl(n)%stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! initialize with default value - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ldptr = fldsToCpl(n)%default_value - - ! add field to field bundle - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - enddo - - ! Add FB to state - call ESMF_StateAdd(a2x_state, (/FBout/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - end subroutine atmos_init - - subroutine land_init(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(land_init) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"land_init has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine land_init - - subroutine coupler_init(comp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(coupler_init) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"coupler_init has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine coupler_init - - subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_atm_to_lilac) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) - - ! loop over fields, copying pointer from import to export state - - end subroutine atmos_copy_atm_to_lilac - - subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_lilac_to_atm) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine atmos_copy_lilac_to_atm - - subroutine land_run(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(land_run) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"land_run has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine land_run - - subroutine coupler_run(comp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(coupler_run) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"coupler_run has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine coupler_run - - subroutine atmos_final(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_final) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"atmos_final has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine atmos_final - - subroutine land_final(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(land_final) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"land_final has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine land_final - - subroutine coupler_final(comp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(coupler_final) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"coupler_final has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine coupler_final - - subroutine init_lilac_state(self, field_list, nlocal) - implicit none - class(LilacFields), intent(inout) :: self - type(fld_list_type), intent(inout) :: field_list(:) - integer, intent(in) :: nlocal - - integer :: nfields, i - - nfields = size(field_list) - - allocate(character(MAXCHAR) :: self%field_names(nfields)) - allocate(self%fields(nfields, nlocal)) - - do i = 1, nfields - self%field_names(i) = field_list(i)%stdname - self%fields(i) = field_list(i)%default_value - enddo - - end subroutine init_lilac_state - - - function get_lilac_field(self, field_name) result(array_ptr) - implicit none - class(LilacFields) :: self - character(len=*) :: field_name - pointer :: array_ptr - - integer :: i - - nfields = size(self%field_names) - - do i = 1, nfields - if (field_name .eq. (self%field_names(i))) then - ptr => self%fields(i, :) - return - endif - enddo - - ! Raise error here - call ESMF_LogWrite("KeyError: Did not find variable in LilacFields object" // field_name, ESMF_LOGMSG_INFO) - - end function get_lilac_field - -end module lilac diff --git a/lilac/lilac_joe/drivers/lilac_data_driver.f90 b/lilac/lilac_joe/drivers/lilac_data_driver.f90 deleted file mode 100644 index b1dfe32665..0000000000 --- a/lilac/lilac_joe/drivers/lilac_data_driver.f90 +++ /dev/null @@ -1,207 +0,0 @@ - -program lilac_data_driver - - use seq_infodata_mod, only: seq_infodata_putdata - use shr_sys_mod , only: shr_sys_flush - use shr_orb_mod , only: shr_orb_params - use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel - use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 - use ESMF - - use lilac_utils , only create_fldlists, fldsMax - - - implicit none - -#include ! mpi library include file - - !----- Clocks ----- - type(ESMF_Clock) :: EClock ! Input synchronization clock - type(ESMF_Time) :: CurrTime, StartTime, StopTime - type(ESMF_TimeInterval) :: TimeStep - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar),target :: Calendar - integer :: yy,mm,dd,sec - - !----- MPI/MCT ----- - integer :: mpicom_lilac_drv ! local mpicom - integer :: ID_lilac_drv ! mct ID - integer :: ncomps ! number of separate components for MCT - integer :: ntasks,mytask ! mpicom size and rank - integer :: global_comm ! copy of mpi_comm_world for pio - integer,allocatable :: comp_id(:) ! for pio init2 - logical,allocatable :: comp_iamin(:) ! for pio init2 - character(len=64),allocatable :: comp_name(:) ! for pio init2 - integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 - - !----- Land Coupling Data ----- - type(LilacGrid) :: gridComp - type(LilacFields) :: a2x_state - type(LilacFields) :: x2a_state - - integer :: orb_iyear ! Orbitalle - real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp - character(len=128) :: case_name, case_desc, model_version, hostname, username - character(len=128) :: start_type - logical :: brnch_retain_casename, single_column, atm_aero - real*8 :: scmlat, scmlon - - !----- Atm Model ----- - integer :: atm_nx, atm_ny - integer :: gsize, lsize, gstart, gend ! domain decomp info - integer, allocatable :: gindex(:) ! domain decomp info - type(mct_aVect) :: x2l_a ! data for land on atm decomp - type(mct_aVect) :: l2x_a ! data from land on atm decomp - type(mct_gsMap) :: gsmap_atm ! gsmap data for atm - type(mct_rearr) :: rearr_atm2lnd ! rearranger for atm to land - type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm - - !----- Other ----- - integer :: n,m ! counter - character(len=128) :: string ! temporary string - integer :: ierr, rc ! local error status - integer :: iunit = 250 ! lilac_drv log unit number - integer :: sunit = 249 ! share log unit number - character(len=*),parameter :: subname = 'lilac_drv' - - type (fld_list_type) :: fldsToCpl(fldsMax) - type (fld_list_type) :: fldsFrCpl(fldsMax) - - !---------------------------------------------- - - !---------------------------------------------- - !--- MPI/MCT --- - !---------------------------------------------- - - call MPI_Init(ierr) - call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_lilac_drv, ierr) - call MPI_COMM_RANK(mpicom_lilac_drv, mytask, ierr) - call MPI_COMM_SIZE(mpicom_lilac_drv, ntasks, ierr) - - call lilac%start() - - !---------------------------------------------- - !--- Log File and PIO --- - !---------------------------------------------- - - global_comm = MPI_COMM_WORLD - call shr_pio_init1(ncomps, 'pio_in', global_comm) - allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) - do n = 1,ncomps - comp_id(n) = ID_lilac_drv - comp_name(n) = 'LND' - comp_iamin(n) = .true. - comp_comm(n) = mpicom_lilac_drv - comp_comm_iam(n) = mytask - enddo - call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) - deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) - - write(string,'(a,i4.4)') 'lilac_drv.log.',mytask - open(iunit, file=trim(string)) - write(iunit,*) subname,' STARTING' - call shr_sys_flush(iunit) - - write(iunit,*) subname,' ntasks = ',ntasks - write(iunit,*) subname,' mytask = ',mytask - write(iunit,*) subname,' mct ID = ',ID_lilac_drv - call shr_sys_flush(iunit) - call shr_file_setLogUnit(sunit) - call shr_file_setLogLevel(1) - - !---------------------------------------------- - !--- Clocks --- - !---------------------------------------------- - Calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - EClock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - - EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop', clock=EClock, ringTime=StopTime, rc=rc) - EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', clock=EClock, ringTime=StopTime, rc=rc) - - call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec - call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - !--- set orbital params - orb_iyear = 1990 - call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp, .true.) - - !--- set case information - case_name = 'lilac_drv' - case_desc = 'lilac_drv with clm' - model_version = 'lilac_drv0.1' - hostname = 'undefined' - username = 'undefined' - start_type = 'startup' - brnch_retain_casename = .true. - single_column = .false. - scmlat = 0.0 - scmlon = 0.0 - atm_aero = .true. - call seq_infodata_putData(infodata, case_name=case_name, & - case_desc=case_desc, single_column=single_column, & - scmlat=scmlat, scmlon=scmlon, & - brnch_retain_casename=brnch_retain_casename, & - start_type=start_type, model_version=model_version, & - hostname=hostname, username=username, & - atm_aero=atm_aero ) - - !---------------------------------------------- - !--- lnd_init --- - !---------------------------------------------- - - write(iunit,*) subname,' calling lilac%init' - call shr_sys_flush(iunit) - - call create_fldlists(fldsFrCpl, fldsToCpl) - - - call lilac%init(EClock, x2a_state, a2x_state, rc=rc) - - !---------------------------------------------- - !--- atm and atm/lnd coupling init --- - !---------------------------------------------- - - !---------------------------------------------- - !--- Time Loop --- - !---------------------------------------------- - - call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) - do while (CurrTime < StopTime) - call ESMF_ClockAdvance(EClock, rc=rc) - call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) - call ESMF_TimeGet(CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' lilac_drv ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - ! can manually override the alarms as needed - call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) - if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) - - ! run lilac - write(iunit,*) subname,' call lilac%run',yy,mm,dd,sec - call lilac%run(EClock, x2a_state, a2x_state, rc=rc) - enddo - - !---------------------------------------------- - !--- lnd_final --- - !---------------------------------------------- - - write(iunit,*) subname,' calling lilac%final()' - call shr_sys_flush(iunit) - call lilac%final() - - !---------------------------------------------- - !--- Done --- - !---------------------------------------------- - - write(iunit,*) subname,' DONE' - call shr_sys_flush(iunit) - call MPI_Finalize(ierr) - -end program lilac_data_driver diff --git a/lilac/lilac_joe/esmf_utils.f90 b/lilac/lilac_joe/esmf_utils.f90 deleted file mode 100644 index 527d8081a1..0000000000 --- a/lilac/lilac_joe/esmf_utils.f90 +++ /dev/null @@ -1,224 +0,0 @@ -module esmf_utils - - ! Wrappers and derived types exposing ESMF components to LILAC - -#include "ESMF.h" - use ESMF - - implicit none - private - - character(*), parameter :: modname = "(esmf_utils)" - - interface - subroutine userRoutine(gridcomp, rc) - use ESMF_CompMod - implicit none - type(ESMF_GridComp) :: gridcomp ! must not be optional - integer, intent(out) :: rc ! must not be optional - end subroutine userRoutine - end interface - - interface - subroutine userCplRoutine(cplcomp, rc) - use ESMF_CompMod - implicit none - type(ESMF_CplComp) :: cplcomp ! must not be optional - integer, intent(out) :: rc ! must not be optional - end subroutine userCplRoutine - end interface - - ! Consider renaming ESMFInfoType (add lilac to name) - type, public :: ESMFInfoType - private - - type(ESMF_VM) :: vm - type(ESMF_State) :: land_import - type(ESMF_State) :: land_export - type(ESMF_State) :: atmos_import - type(ESMF_State) :: atmos_export - type(ESMF_GridComp) :: atmos_comp - type(ESMF_GridComp) :: land_comp - type(ESMF_CplComp) :: cpl_comp - - contains - procedure, public :: init => init - procedure, public :: run => run - procedure, public :: final => final - - end type ESMFInfoType - -contains - - subroutine start(self, rc) - implicit none - integer, intent(in) :: rc=ESMF_SUCCESS - - integer :: localPet, petCount - - character(len=*), parameter :: subname=trim(modname)//':(start) ' - - call ESMF_LogWrite(subname//"esmf_info%start()", ESMF_LOGMSG_INFO) - - ! Initialize framework and get back default global VM - - ! only run if not esmf_isintialized() - call ESMF_Initialize(vm=self%vm, defaultlogfilename="lilac.log", logkindflag=ESMF_LOGKIND_MULTI, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Get number of PETs we are running with - call ESMF_VMGet(self%vm, petCount=petCount, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - end subroutine start - - subroutine init(self, atmos_register, land_register, cpl_register, rc) - implicit none - class(ESMFInfoType), intent(inout) :: self - procedure(userRoutine) :: atmos_register - procedure(userRoutine) :: land_register - procedure(userCplRoutine) :: cpl_register - integer, intent(in) :: rc=ESMF_SUCCESS - - ! Local variables - character(len=ESMF_MAXSTR) :: cname1, cname2, cplname - integer :: rc=ESMF_SUCCESS - - character(len=*), parameter :: subname=trim(modname)//':(init) ' - - call ESMF_LogWrite(subname//"esmf_info%init()", ESMF_LOGMSG_INFO) - - ! Create section - !------------------------------------------------------------------------- - ! Create the 2 model components and a coupler - cname1 = "land" - ! use petList to define land on all PET - self%land_comp = ESMF_GridCompCreate(name=cname1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname1)//" component", ESMF_LOGMSG_INFO) - - cname2 = "atmosphere" - ! use petList to define atmosphere on all PET - self%atmos_comp = ESMF_GridCompCreate(name=cname2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) - - cplname = "lilac coupler" - ! no petList means that coupler component runs on all PETs - self%cpl_comp = ESMF_CplCompCreate(name=cplname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cplname)//" component", ESMF_LOGMSG_INFO) - - call ESMF_LogWrite(subname//"Comp Creates finished", ESMF_LOGMSG_INFO) - - ! Register section - !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(self%atmos_comp, userRoutine=atmos_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos SetServices finished", ESMF_LOGMSG_INFO) - - call ESMF_GridCompSetServices(self%land_comp, userRoutine=land_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"land SetServices finished", ESMF_LOGMSG_INFO) - - call ESMF_CplCompSetServices(self%cpl_comp, userRoutine=cpl_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Cpl SetServices finished", ESMF_LOGMSG_INFO) - - ! Init section - !------------------------------------------------------------------------- - ! land import/export states - self%land_import = ESMF_StateCreate(name="land import", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - self%land_export = ESMF_StateCreate(name="land export", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Land Initialize finished", ESMF_LOGMSG_INFO) - - ! atmosphere import/export state - self%atmos_import = ESMF_StateCreate(name="atmos import", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - self%atmos_export = ESMF_StateCreate(name="atmos export", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompInitialize(self%atmos_comp, exportState=self%atmos_export, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Atmosphere Initialize finished", ESMF_LOGMSG_INFO) - - end subroutine init - - subroutine run(self, rc) - implicit none - class(ESMFInfoType), intent(inout) :: self - integer :: rc=ESMF_SUCCESS - character(len=*), parameter :: subname=trim(modname)//':(run) ' - - call ESMF_LogWrite(subname//"esmf_info%run()", ESMF_LOGMSG_INFO) - - ! atmosphere run - ! atmos_run phase 1: copy the atmos state and put it into atmos export - call ESMF_GridCompRun(self%atmos_comp, exportState=self%atmos_export, phase=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Atmosphere Run returned", ESMF_LOGMSG_INFO) - - ! coupler run - call ESMF_CplCompRun(self%cpl_comp, importState=self%atmos_export, exportState=self%land_import, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Coupler Run returned", ESMF_LOGMSG_INFO) - - ! land run - call ESMF_GridCompRun(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Land Run returned", ESMF_LOGMSG_INFO) - - ! coupler run - call ESMF_CplCompRun(self%cpl_comp, importState=self%land_export, exportState=self%atmos_import, rc=rc) - call ESMF_LogWrite(subname//"Coupler Run returned", ESMF_LOGMSG_INFO) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! atmos run phase 2: copy the atmos state and put it into atmos export - call ESMF_GridCompRun(self%atmos_comp, importState=self%atmos_import, phase=2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Atmosphere Run returned", ESMF_LOGMSG_INFO) - - end subroutine run - - subroutine final(self, rc) - implicit none - class(ESMFInfoType), intent(inout) :: self - integer :: rc=ESMF_SUCCESS - character(len=*), parameter :: subname=trim(modname)//':(final) ' - - call ESMF_LogWrite(subname//"esmf_info%final()", ESMF_LOGMSG_INFO) - - ! Destroy section - call ESMF_GridCompDestroy(self%atmos_comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompDestroy(self%land_comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_CplCompDestroy(self%cpl_comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_StateDestroy(self%land_export, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_StateDestroy(self%land_import, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_StateDestroy(self%atmos_export, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_StateDestroy(self%atmos_import, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_LogWrite(subname//"All Destroy routines done", ESMF_LOGMSG_INFO) - - end subroutine final - -end module esmf_utils diff --git a/lilac/lilac_joe/lilac_utils.f90 b/lilac/lilac_joe/lilac_utils.f90 deleted file mode 100644 index be5d0df6db..0000000000 --- a/lilac/lilac_joe/lilac_utils.f90 +++ /dev/null @@ -1,121 +0,0 @@ -module lilac_utils - - integer, parameter :: fldsMax = 100 - - - type fld_list_type - character(len=128) :: stdname - real*8 :: default_value - character(len=128) :: units - end type fld_list_type - - subroutine fldlist_add(num, fldlist, stdname, default_value, units) - integer intent(inout) :: num - type(fld_list_type) intent(inout) :: fldlist(:) - character(len=*) intent(in) :: stdname - real, optional intent(in) :: default_value - character(len=*), optional intent(in) :: units - - ! local variables - integer :: rc - character(len=*), parameter :: subname='(fldlist_add)' - !------------------------------------------------------------------------------- - - ! Set up a list of field information - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=rc) return - endif - fldlist(num)%stdname = trim(stdname) - if(present(default_value)) then - fldlist(num)%default_value = default_value - else - fldlist(num)%default_value = 0. - end if - if(present(units)) then - fldlist(num)%units = trim(units) - else - fldlist(num)%units = "" - end if - - end subroutine fldlist_add - - subroutine create_fldlists(fldsFrCpl, fldsToCpl, fldsToCpl_num, fldsFrCpl_num) - type(fld_list_type) intent(inout) :: fldsFrCpl(:) - type(fld_list_type) intent(inout) :: fldsToCpl(:) - integer, intent(out) :: fldsToCpl_num = 0 - integer, intent(out) :: fldsFrCpl_num = 0 - - ! import fields - ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) - - integer :: fldsFrCpl_num, fldsToCpl_num - - ! land states - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) - - ! fluxes to atm - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) - call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) - - ! call fldlist_add(fldsToCpl_num, fldsToCpl, trim(flds_scalar_name)) - - ! from atm - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_z', default_value=30.0, units='m') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, 'degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) - - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') - call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) - - ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 - end subroutine create_fldlists - -end module lilac_utils From bd5d0f45616a4211e1498e7cdfca7c0c945cf914 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 29 Aug 2019 15:28:09 -0600 Subject: [PATCH 140/556] Some clean ups for the PR --- lilac/CMakeLists.txt | 142 ++++++++++++++++++++++++++++-------- lilac/lilac/Makefile | 2 +- lilac/lilac/atmos_cap.F90 | 123 +++++++++++++------------------ lilac/lilac/demo_driver.F90 | 3 +- 4 files changed, 165 insertions(+), 105 deletions(-) diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 864aa7a0a7..7d45799a7d 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -1,41 +1,136 @@ cmake_minimum_required(VERSION 2.8.12.1) +##include("/glade/work/negins/UFSCOMP/cime/tools/Macros.cmake") - -### ********** ### set (CIME_ROOT "/glade/work/negins/UFSCOMP/cime") message ("CIME_ROOT: ${CIME_ROOT}") + +set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") + + set (CIME_CMAKE_MODULE_DIRECTORY "/glade/work/negins/UFSCOMP/cime/src/CMake/") message ("CIME_CMAKE_MODULE_DIRECTORY: ${CIME_CMAKE_MODULE_DIRECTORY}") + list(APPEND CMAKE_MODULE_PATH ${CIME_CMAKE_MODULE_DIRECTORY}) +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") + +set (MACRO_ROOT "/glade/work/negins/UFSCOMP/cime/tools/") +include(${MACRO_ROOT}/Macros.cmake) + +list(APPEND CMAKE_MODULE_PATH ${MACRO_ROOT}) message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") -include(CIME_initial_setup) -message("----------------------------------------------------") +set (CLM_ROOT "/glade/work/negins/UFSCOMP/components/clm") + +message("~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~") + +include_directories (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/genf90_utils.cmake) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/Sourcelist_utils.cmake) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/pFUnit_utils.cmake) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/FindpFUnit.cmake) + + +#include (Macros.cmake) +#include(CIME_initial_setup) + +message("~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~") + +### ------------------------------------------------------------- + +# project name project(LILAC Fortran C) enable_language(Fortran) + +# This definition is needed to avoid having ESMF depend on mpi +add_definitions(-DHIDE_MPI) + + +message("----------------------------------------------------") +message ("CMAKE_CURRENT_SOURCE_DIR: ${CMAKE_CURRENT_SOURCE_DIR}") +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") +message("----------------------------------------------------") + + + +message("----------------------------------------------------") +# Add source directories from other share code (csm_share, etc.). This should be +# done first, so that in case of name collisions, the CLM versions take +# precedence (when there are two files with the same name, the one added later +# wins). +add_subdirectory(${CIME_ROOT}/src/share/util csm_share) +add_subdirectory(${CIME_ROOT}/src/share/unit_test_stubs/util csm_share_stubs) +add_subdirectory(${CIME_ROOT}/src/share/esmf_wrf_timemgr esmf_wrf_timemgr) +add_subdirectory(${CIME_ROOT}/src/drivers/mct/shr drv_share) +message("----------------------------------------------------") + +# Extract just the files we need from drv_share +set (drv_sources_needed_base + glc_elevclass_mod.F90 + ) +extract_sources("${drv_sources_needed_base}" "${drv_sources}" drv_sources_needed) + +message("~~~~~~~~~~~~~~~~~~~~~~CLM_ROOT~~~~~~~~~~~~~~~~~~~~~~") +# Add CLM source directories (these add their own test directories) +add_subdirectory(${CLM_ROOT}/src/utils clm_utils) +add_subdirectory(${CLM_ROOT}/src/biogeochem clm_biogeochem) +add_subdirectory(${CLM_ROOT}/src/soilbiogeochem clm_soilbiogeochem) +add_subdirectory(${CLM_ROOT}/src/biogeophys clm_biogeophys) +add_subdirectory(${CLM_ROOT}/src/dyn_subgrid clm_dyn_subgrid) +add_subdirectory(${CLM_ROOT}/src/main clm_main) +add_subdirectory(${CLM_ROOT}/src/init_interp clm_init_interp) +add_subdirectory(${CLM_ROOT}/src/fates/main fates_main) + +# Add general unit test directories (stubbed out files, etc.) +add_subdirectory(unit_test_stubs) +add_subdirectory(unit_test_shr) + + +# Remove shr_mpi_mod from share_sources. +# This is needed because we want to use the mock shr_mpi_mod in place of the real one +# +# TODO: this should be moved into a general-purpose function in Sourcelist_utils. +# Then this block of code could be replaced with a single call, like: +# remove_source_file(${share_sources} "shr_mpi_mod.F90")} + +foreach (sourcefile ${share_sources}) + string(REGEX MATCH "shr_mpi_mod.F90" match_found ${sourcefile}) + if(match_found) + list(REMOVE_ITEM share_sources ${sourcefile}) + endif() +endforeach() + + # We rely on pio for cmake utilities like findnetcdf.cmake, so that we don't # need to duplicate this cmake code message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") -list(APPEND CMAKE_MODULE_PATH "${CIME_ROOT}/src/externals/pio2/cmake") +list (APPEND CMAKE_MODULE_PATH "${CIME_ROOT}/src/externals/pio2/cmake") message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") -message("----------------------------------------------------") -list(APPEND CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") -message ("CMAKE_CURRENT_SOURCE_DIR: ${CMAKE_CURRENT_SOURCE_DIR}") -message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") +add_subdirectory (${CIME_ROOT}/src/externals/pio2/test) + +message("----------------------------------------------------") +option(ENABLE_PFUNIT "Enable pfUnit testing Framework" ON) +if (ENABLE_PFUNIT) + find_package(pfUnit) + include(pfUnit_utils) + include_directories("${PFUNIT_INCLUDE_DIRS}") +endif (ENABLE_PFUNIT) message("----------------------------------------------------") + find_package(MPI REQUIRED) # TODO: This should be found from the find_package call but its not working #set(CMAKE_Fortran_COMPILER "/usr/lib64/mpich/bin/mpif90") find_package(ESMF REQUIRED) +message("------------include (CIME_utils)--------------------") include(CIME_utils) message("----------------------------------------------------") @@ -51,23 +146,7 @@ message("----------------------------------------------------") #add_subdirectory(${CESM_ROOT}/models/csm_share/shr csm_share) #add_subdirectory(${CSM_SHR} ) -#==============### -set(SHARE_ROOT "${CIME_ROOT}/src/share") -#add_subdirectory(${CIME_ROOT}/src/share/util csm_share) -#add_subdirectory(${CIME_ROOT}/src/share/unit_test_stubs/util csm_share_stubs) -#add_subdirectory(${CIME_ROOT}/src/share/esmf_wrf_timemgr esmf_wrf_timemgr) -#add_subdirectory(${CIME_ROOT}/src/drivers/mct/shr drv_share) -#message("----------------------------------------------------") - - -add_subdirectory(${SHARE_ROOT}/util csm_share) -add_subdirectory(${SHARE_ROOT}/unit_test_stubs/util csm_share_stubs) -include_directories(${SHARE_ROOT}/include) - -# esmf_wrf_timemgr not built here because it depends on csm_share. -#add_subdirectory(${SHARE_ROOT}/esmf_wrf_timemgr esmf_wrf_timemgr) -#include_directories(${SHARE_ROOT}/esmf_wrf_timemgr) - +message("----------------------------------------------------") @@ -87,6 +166,7 @@ SET(NAMES libclm.a) #message(STATUS "include_directories: ${LIB_TO_INCLUDE}") #target_link_libraries (${LIB_TO_INCLUDE}) + # Local CMake modules if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") @@ -107,10 +187,11 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") + # TODO: This should not be necessary but certain header files are missing from the build #set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I /usr/include/ -I/usr/src/lilac/external/esmf/src/Infrastructure/Util/include -I/usr/src/lilac/external/esmf/build_config/Linux.gfortran.default -I /usr/src/lilac/external/esmf/src/include") #set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/usr/include/ -I/usr/src/esmf/src/Infrastructure/Util/include/ -I/usr/src/esmf/build_config/Linux.gfortran.default -I /usr/src/esmf/src/include") -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/include -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib -lclm -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2/lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib ") +#set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/include -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib -lclm -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2/lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib ") message(STATUS "==============================================================") @@ -125,14 +206,15 @@ message(STATUS "==============================================================") # # Compile. # -file(GLOB_RECURSE sources lilac/*.F90) +file(GLOB_RECURSE SOURCES lilac/*.F90) +#add_subdirectory(lilac) #add_executable(${PROJECT_NAME}.exe ../lilac/demo_driver.F90 # ../lilac/lilac_mod.F90 ../lilac/atmos_cap.F90 ../lilac/lilac_utils.F90 # ../lilac/lnd_cap.F90 ../lilac/cpl_mod.F90) -add_executable(${PROJECT_NAME}.exe ${sources}) +add_executable (${PROJECT_NAME}.exe ${SOURCES}) target_link_libraries(${PROJECT_NAME}.exe ${LIB_TO_INCLUDE}) -#emo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o +#demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o #add_subdirectory(lilac) #add_subdirectory(tests) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index 3cc63fd44e..6c377917b7 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -40,7 +40,7 @@ TRACEBACK_FLAGS = -g -traceback -debug all -check all # ----------------------------------------------------------------------------- #EXTRA_LIBS = $(EXTRA_LIBS) -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/pio/pio2 EXTRA_LIBS = -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib -MORE_LIBSi = -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ +MORE_LIBS = -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/clm/obj/ -I//glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/csm_share/ # ----------------------------------------------------------------------------- diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 index 1d1792a9cd..e295ad2718 100644 --- a/lilac/lilac/atmos_cap.F90 +++ b/lilac/lilac/atmos_cap.F90 @@ -2,39 +2,29 @@ module atmos_cap !----------------------------------------------------------------------- ! !DESCRIPTION: + ! This is a dummy atmosphere cap for setting up lilac structure. ! !USES use ESMF - use lilac_utils, only : fld_list_type - use spmdMod , only : masterproc + use lilac_utils , only : fld_list_type + use spmdMod , only : masterproc implicit none include 'mpif.h' - character(*), parameter :: modname = "atmos_cap" - - !!integer, parameter :: fldsMax = 100 - - type(ESMF_Field), public, save :: field - - type(fld_list_type), public, allocatable :: c2a_fldlist(:) - type(fld_list_type), public, allocatable :: a2c_fldlist(:) - - !type (fld_list_type) :: a2c_fldlist(fldsMax) - !type (fld_list_type) :: c2a_fldlist(fldsMax) - - integer :: a2c_fldlist_num - integer :: c2a_fldlist_num - !private - - public :: atmos_register + character(*), parameter :: modname = "atmos_cap" + !!integer, parameter :: fldsMax = 100 + type(ESMF_Field), public , save :: field + type(fld_list_type), public , allocatable :: c2a_fldlist(:) + type(fld_list_type), public , allocatable :: a2c_fldlist(:) + integer :: a2c_fldlist_num + integer :: c2a_fldlist_num + public :: atmos_register !real(kind=ESMF_KIND_R8), dimension(:), public, pointer, save :: fldptr - - - integer :: mpierror, numprocs - integer :: i, myid - integer status(MPI_STATUS_SIZE) - + integer :: mpierror, numprocs + integer :: i, myid + integer status(MPI_STATUS_SIZE) ! Status of message + integer, parameter :: debug = 0 ! internal debug leve !======================================================================== contains @@ -46,9 +36,13 @@ subroutine atmos_register (comp, rc) integer, intent(out) :: rc character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' + !------------------------------------------------------------------------- + print *, "in user register routine" + ! Initialize return code rc = ESMF_SUCCESS + ! Set the entry points for standard ESMF Component methods call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -64,6 +58,7 @@ end subroutine atmos_register subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) + type (ESMF_GridComp) :: comp type (ESMF_State) :: lnd2atm_a_state, atm2lnd_a_state type (ESMF_Clock) :: clock @@ -81,6 +76,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) logical :: mesh_switch character(len=*), parameter :: subname=trim(modname)//': [atmos_init] ' !integer :: regDecomp(:,:) + !------------------------------------------------------------------------- ! Initialize return code rc = ESMF_SUCCESS @@ -99,6 +95,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) if(mesh_switch) then + ! TODO: hard-coded mesh file name shoulb be corrected. ! For now this is our dummy mesh: !atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' !! Negin: This did not work.... atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv1.9x2.5_141008_ESMFmesh.nc' @@ -109,6 +106,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) print *, "!Mesh for atmosphere is created!" else + !TODO: Fix how you want to create the grid here if mesh_switch is off !atmos_grid= ESMF_GridCreateNoPeriDimUfrmR( maxIndex=(/180,360 /), & ! minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & ! maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & @@ -125,7 +123,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) endif !------------------------------------------------------------------------- - ! Atmosphere to Coupler (land) Fields -- a2l + ! Atmosphere to Coupler (land) Fields -- atmos --> land ! I- Create empty field bundle -- a2c_fb ! II- Create Fields and add them to field bundle ! III - Add a2c_fb to state (atm2lnd_a_state) @@ -134,9 +132,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) a2c_fb = ESMF_FieldBundleCreate(name="a2c_fb", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! Create individual fields and add to field bundle -- a2l + ! Create individual fields and add to field bundle -- a2c - !call fldlist_add(a2c_fldlist_num, a2c_fldlist, 'dum_var2' ) a2c_fldlist_num = 17 do n = 1,a2c_fldlist_num @@ -150,15 +147,16 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) !call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8), rc=rc) !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if (myid == 0) then - print *, 'Here we are printing field!' - print *, "**********************************************************" - print *, "creating field for a2l:" + if (myid == 0 .and debug > 0) then + print *, "***************************************************" + print *, "Here we are printing field!" + print *, "creating field for a2c:" print *, trim(a2c_fldlist(n)%stdname) print *, a2c_fldlist(n)%farrayptr1d call ESMF_FieldPrint(field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end if + end if + !call ESMF_LogWrite(subname//"fieldget!", ESMF_LOGMSG_INFO) !call ESMF_FieldGet(field, rc=rc) !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -167,83 +165,64 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + enddo - !call ESMF_StateAdd(atm2lnd_a_state, (/field/) , rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - !print *, a2c_fldlist(n)%farrayptr1d - !print *, "this field is created" - enddo call ESMF_LogWrite(subname//"fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) - print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" ! Add field bundle to state call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - + call ESMF_LogWrite(subname//"atm2lnd_a_state is filled with dummy_var field bundle!", ESMF_LOGMSG_INFO) print *, "!atm2lnd_a_state is filld with dummy_var field bundle!" !------------------------------------------------------------------------- - ! Coupler (land) to Atmosphere Fields -- l2a - ! I- Create Field Bundle -- c2a_fb for now - ! II- Create Fields and add them to field bundle + ! Coupler (land) to Atmosphere Fields -- c2a + ! I- Create Field Bundle -- c2a_fb for because we are in atmos + ! II- Create Fields and add them to field bundle ! III - Add c2a_fb to state (lnd2atm_a_state) !------------------------------------------------------------------------- c2a_fb = ESMF_FieldBundleCreate (name="c2a_fb", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! Create individual fields and add to field bundle -- l2a + ! Create individual fields and add to field bundle -- c2a c2a_fldlist_num = 12 do n = 1,c2a_fldlist_num - !print *, "**********************************************************" - !print *, "creating field for l2a:" - !print *, trim(c2a_fldlist(n)%stdname) - ! create field - !!! Here we want to pass pointers if (mesh_switch) then field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr1d, rc=rc) - !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) - !call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8)*5.5, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - else field = ESMF_FieldCreate(atmos_grid, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end if - call ESMF_LogWrite(subname//"line 208 and going.... .... !", ESMF_LOGMSG_INFO) - ! add field to field bundle - call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"c2a fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) - - if (myid == 0) then - print *, "creating field for c2a:" - print *, n - print *, trim(c2a_fldlist(n)%stdname) - print *, c2a_fldlist(n)%farrayptr1d - !call ESMF_FieldPrint(field, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end if + ! add field to field bundle + call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + if (myid == 0 .and debug > 0) then + print *, "creating field for c2a:" + print *, n + print *, trim(c2a_fldlist(n)%stdname) + print *, c2a_fldlist(n)%farrayptr1d + call ESMF_FieldPrint(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if enddo - !print *, "!Fields For Coupler (c2a_fldlist) Field Bundle Created!" + call ESMF_LogWrite(subname//"c2a fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) ! Add field bundle to state call ESMF_StateAdd(lnd2atm_a_state, (/c2a_fb/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !print *, "!lnd2atm_a_state is filld with dummy_var field bundle!" ! Set Attributes needed by land call ESMF_AttributeSet(lnd2atm_a_state, name="nextsw_cday", value=11, rc=rc) @@ -261,7 +240,7 @@ subroutine atmos_run(comp, importState, exportState, clock, rc) ! Initialize return code rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"SHOULD ATMOS_RUN DO ANYTHING REALLY?? ", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Should atmos_run ", ESMF_LOGMSG_INFO) end subroutine atmos_run subroutine atmos_final(comp, importState, exportState, clock, rc) diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index 66914b37c0..a0af468dda 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -49,7 +49,6 @@ program demo_lilac_driver ! real atmosphere: begc = 1 - !endc = 10 endc = 6912/4 !endc = 13824 !endc = 13968 @@ -70,7 +69,7 @@ program demo_lilac_driver allocate ( rand1 (begc:endc) ) ; call random_number (rand1) allocate ( rand2 (begc:endc) ) ; call random_number (rand2) - !allocating these values of default for now! + !allocating these values from atmosphere for now! allocate ( atm2lnd%Sa_z (begc:endc) ) ; atm2lnd%Sa_z (:) = 30.0 allocate ( atm2lnd%Sa_topo (begc:endc) ) ; atm2lnd%Sa_topo (:) = 10.0 allocate ( atm2lnd%Sa_u (begc:endc) ) ; atm2lnd%Sa_u (:) = 20.0 From 8b81aa6d2e9dc82eed29c907bd6a0724b85b190d Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 30 Aug 2019 12:21:00 -0600 Subject: [PATCH 141/556] typo fixed --- lilac/lilac/atmos_cap.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 index e295ad2718..55228da5d8 100644 --- a/lilac/lilac/atmos_cap.F90 +++ b/lilac/lilac/atmos_cap.F90 @@ -147,7 +147,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) !call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8), rc=rc) !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if (myid == 0 .and debug > 0) then + if (myid == 0 .and. debug > 0) then print *, "***************************************************" print *, "Here we are printing field!" print *, "creating field for a2c:" @@ -208,7 +208,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if (myid == 0 .and debug > 0) then + if (myid == 0 .and. debug > 0) then print *, "creating field for c2a:" print *, n print *, trim(c2a_fldlist(n)%stdname) From 3b2b32b280839de218023199569a3d5242df1784 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 1 Oct 2019 11:16:50 -0600 Subject: [PATCH 142/556] changes necessary for the CTSM LILAC cap. --- src/cpl/lilac/for_negin | 19 + src/cpl/lilac/lnd_comp_esmf.F90 | 1024 ++++++++++++++++++ src/cpl/lilac/lnd_import_export.F90 | 1519 +++++++++++++++++++++++++++ src/cpl/lilac/lnd_shr_methods.F90 | 794 ++++++++++++++ src/cpl/lilac/shr_utils_mod.F90 | 47 + src/cpl/mct/clm_cpl_indices.F90 | 330 ++++++ src/cpl/mct/lnd_comp_mct.F90 | 688 ++++++++++++ src/cpl/mct/lnd_import_export.F90 | 431 ++++++++ 8 files changed, 4852 insertions(+) create mode 100644 src/cpl/lilac/for_negin create mode 100644 src/cpl/lilac/lnd_comp_esmf.F90 create mode 100644 src/cpl/lilac/lnd_import_export.F90 create mode 100644 src/cpl/lilac/lnd_shr_methods.F90 create mode 100644 src/cpl/lilac/shr_utils_mod.F90 create mode 100644 src/cpl/mct/clm_cpl_indices.F90 create mode 100644 src/cpl/mct/lnd_comp_mct.F90 create mode 100644 src/cpl/mct/lnd_import_export.F90 diff --git a/src/cpl/lilac/for_negin b/src/cpl/lilac/for_negin new file mode 100644 index 0000000000..c5986a0408 --- /dev/null +++ b/src/cpl/lilac/for_negin @@ -0,0 +1,19 @@ + ! Initialize PIO + + integer, pointer :: comms(:), comps(:) + character(len=32), allocatable :: compLabels(:) + logical, allocatable :: comp_iamin(:) + integer, allocatable :: comp_comm_iam(:) + + allocate(comms(1), comps(1), compLabels(1), comp_iamin(1), comp_comm_iam(1)) + + comms(1) = Global_Comm + comps(1) = 1 + compLabels(1) = 'lnd' + comp_iamin(1) = .true. + + call ESMF_VMGet(vm, mpiCommunicator=comms(1), localPet=comp_comm_iam(1), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_pio_init2(comps, compLabel, comp_iamin, comms, comp_comm_iam) + diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 new file mode 100644 index 0000000000..48f17e9525 --- /dev/null +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -0,0 +1,1024 @@ +module lnd_comp_esmf + + !---------------------------------------------------------------------------- + ! This is the ESMF cap for CTSM + !---------------------------------------------------------------------------- + use ESMF + use shr_kind_mod , only : shr_kind_r8, SHR_KIND_CL + use shr_string_mod , only : shr_string_listGetNum + use abortutils , only : endrun + use domainMod , only : ldomain + use decompMod , only : ldecomp, bounds_type, get_proc_bounds + use clm_varctl , only : iulog + !use clm_initializeMod , only : lnd2atm_inst, atm2lnd_inst + !use clm_cpl_indices + use lnd_import_export + + use ESMF + use mct_mod , only : mct_world_init, mct_world_clean, mct_die + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use shr_orb_mod , only : shr_orb_decl + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use spmdMod , only : masterproc, mpicom, spmd_init + use decompMod , only : bounds_type, ldecomp, get_proc_bounds + use domainMod , only : ldomain + use controlMod , only : control_setNL + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use clm_varctl , only : single_column, clm_varctl_set, iulog + use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch + use clm_time_manager , only : set_timemgr_init, advance_timestep + use clm_time_manager , only : set_nextsw_cday, update_rad_dtime + use clm_time_manager , only : get_nstep, get_step_size + use clm_time_manager , only : get_curr_date, get_curr_calday + use clm_initializeMod , only : initialize1, initialize2 + use clm_driver , only : clm_drv + use perf_mod , only : t_startf, t_stopf, t_barrierf + use lnd_import_export , only : import_fields, export_fields + use lnd_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit + use lnd_shr_methods , only : log_clock_advance + !use lnd_import_export , only : realize_fields + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + private ! By default make data private except + ! + public :: lnd_register ! register clm initial, run, final methods + public :: lnd_init ! clm initialization + public :: lnd_run ! clm run phase + public :: lnd_final ! clm finalization/cleanup + + !NS: from https://github.com/amangupta2/CAM_Trunk/blob/33b0fd4bc2c3b945b93655ee8b5e20f1acf5625b/components/cam/src/cpl/nuopc/atm_comp_nuopc.F90 + !-------------------------------------------------------------------------- + ! Private module data + !-------------------------------------------------------------------------- + + !type fld_list_type + ! character(len=128) :: stdname + !end type fld_list_type + + integer , parameter :: dbug_flag = 6 + type(ESMF_Field), public, save :: field + !type(cam_in_t) , pointer :: cam_in(:) + !type(cam_out_t) , pointer :: cam_out(:) + !integer , pointer :: dof(:) ! global index space decomposition + !integer :: shrlogunit ! original log unit + !integer :: shrloglev ! original log level + !character(len=256) :: rsfilename_spec_cam ! Filename specifier for restart surface file + !character(*) ,parameter :: modName = "ctsm_lilac" + !character(*) ,parameter :: u_FILE_u = & + ! __FILE__ + + + + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 + logical :: glc_present = .false. ! .true. => running with a non-stubGLC model + logical :: rof_prognostic = .false. ! .true. => running with a prognostic ROF model + integer, parameter :: dbug = 1 + !character(*),parameter :: modName = "(lnd_comp_nuopc)" + character(*) ,parameter :: modName = "ctsm_lilac" + character(*),parameter :: u_FILE_u = & + __FILE__! + type(ESMF_Mesh) :: Emesh, EMeshTemp, lnd_mesh ! esmf meshes +!=============================================================================== +contains +!=============================================================================== + + subroutine lnd_register(comp, rc) + + ! Register the clm initial, run, and final phase methods with ESMF. + + ! input/output argumenents + type(ESMF_GridComp) :: comp ! CLM grid component + integer, intent(out) :: rc ! return status + + ! local variables + character(len=*), parameter :: subname=trim(modname)//': [lnd_register] ' + !----------------------------------------------------------------------- + + print *, "in lnd register routine" + rc = ESMF_SUCCESS + call ESMF_LogSet ( flush =.true.) + call ESMF_LogWrite(subname//"lnd gridcompset entry points setting ....!", ESMF_LOGMSG_INFO) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, lnd_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, lnd_run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, lnd_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_LogWrite(subname//"lnd gridcompset entry points finished!", ESMF_LOGMSG_INFO) + end subroutine lnd_register + + !=============================================================================== + + subroutine lnd_init(comp, import_state, export_state, clock, rc) + + ! Initialize land surface model and obtain relevant atmospheric model arrays + ! back from (i.e. albedos, surface temperature and snow cover over land). + + use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel + use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel + use shr_file_mod , only : shr_file_getUnit, shr_file_setIO + use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, set_nextsw_cday + !use clm_initializeMod, only : initialize1, initialize2, lnd2atm_inst, lnd2glc_inst + use clm_initializeMod, only : initialize1, initialize2 + use clm_varctl , only : finidat,single_column, clm_varctl_set, noland + + use clm_varctl , only : inst_index, inst_suffix, inst_name + use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use controlMod , only : control_setNL + use spmdMod , only : masterproc, spmd_init + !NS + use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst + use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE + use shr_pio_mod, only : shr_pio_init1, shr_pio_init2 + use glc_elevclass_mod , only : glc_elevclass_init + ! input/output variables + type(ESMF_GridComp) :: comp ! CLM gridded component + type(ESMF_State) :: import_state ! CLM import state + type(ESMF_State) :: export_state ! CLM export state + type(ESMF_Clock) :: clock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + + ! local variable + integer :: mpicom_lnd, mpicom_vm, gsize + type(ESMF_ArraySpec) :: arrayspec + type(ESMF_DistGrid) :: distgrid + type(ESMF_Array) :: dom, l2x, x2l + type(ESMF_VM) :: vm + integer :: lsize ! size of attribute vector + integer :: g,i,j ! indices + integer :: dtime_sync ! coupling time-step from the input synchronization clock + integer :: dtime_clm ! clm time-step + logical :: exists ! true if file exists + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + character(len=SHR_KIND_CL) :: caseid ! case identifier name + character(len=SHR_KIND_CL) :: ctitle ! case description title + character(len=SHR_KIND_CL) :: starttype ! start-type (startup, continue, branch, hybrid) + character(len=SHR_KIND_CL) :: calendar ! calendar type name + character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on + character(len=SHR_KIND_CL) :: version ! Model version + character(len=SHR_KIND_CL) :: username ! user running the model + integer :: nsrest ! clm restart type + integer :: ref_ymd ! reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (sec) + integer :: start_ymd ! start date (YYYYMMDD) + integer :: start_tod ! start time of day (sec) + integer :: stop_ymd ! stop date (YYYYMMDD) + integer :: stop_tod ! stop time of day (sec) + logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type + logical :: atm_aero ! Flag if aerosol data sent from atm model + integer :: lbnum ! input to memory diagnostic + integer :: shrlogunit,shrloglev ! old values for log unit and log level + integer :: logunit ! original log unit + + type(bounds_type) :: bounds ! bounds + integer :: nfields + real(R8), pointer :: fptr(:, :) + character(ESMF_MAXSTR) :: convCIM, purpComp + integer :: ierr + + ! MCT + integer :: ncomps = 1 + integer, pointer :: comps(:) ! array with component ids + integer, pointer :: comms(:) ! array with mpicoms + character(len=32), allocatable :: compLabels(:) + integer,allocatable :: comp_id(:) ! for pio init2 + character(len=64),allocatable :: comp_name(:) ! for pio init2 + integer,allocatable :: comp_comm(:) ! for pio_init2 + logical,allocatable :: comp_iamin(:) ! for pio init2 + integer,allocatable :: comp_comm_iam(:) ! for pio_init2 + + ! + character(len=32), parameter :: sub = 'lnd_init' + character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" + + + integer :: ymd ! CTSM current date (YYYYMMDD) + integer :: orb_iyear_align ! associated with model year + integer :: orb_cyear ! orbital year for current orbital computation + integer :: orb_iyear ! orbital year for current orbital computation + integer :: orb_eccen ! orbital year for current orbital computation + integer :: yy, mm ,dd , curr_tod, curr_ymd ! orbital year for current orbital computation + + !----------------------------------------------------------------------- + ! NS : from + ! https://github.com/amangupta2/CAM_Trunk/blob/33b0fd4bc2c3b945b93655ee8b5e20f1acf5625b/components/cam/src/cpl/nuopc/atm_comp_nuopc.F90 + + !local variables + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: startTime ! Start time + type(ESMF_Time) :: stopTime ! Stop time + type(ESMF_Time) :: refTime ! Ref time + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Calendar) :: esmf_calendar ! esmf calendar + type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type + !type(ESMF_DistGrid) :: distGrid + !type(ESMF_Field) :: field + + + character(len=*), parameter :: subname=trim(modName)//': [lnd_init_lilac_cap] ' + + ! NS: From : + integer, pointer :: gindex(:) ! global index space for land and ocean points + integer, pointer :: gindex_lnd(:) ! global index space for just land points + integer, pointer :: gindex_ocn(:) ! global index space for just ocean points + character(ESMF_MAXSTR) :: cvalue ! config data + integer :: nlnd, nocn ! local size ofarrays + !integer :: g,n ! indices + integer :: n ! indices + + + integer :: dtime ! time step increment (sec) + + type(ESMF_FieldBundle) :: c2l_fb + type(ESMF_FieldBundle) :: l2c_fb + + + type(ESMF_State) :: importState, exportState + + + integer :: glc_nec = 10 ! number of glc elevation classes + !! FIXME(ns, 2019-07-29) + !! glc_nec should be set from driver or higher level lilac? + integer :: compid ! component id + !------------------------------------------------------------------------ + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' is called!', ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------ + ! Initialize clm MPI communicator + !------------------------------------------------------------------------ + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call ESMF_LogWrite(subname//"ESMF_VMGetCurrent", ESMF_LOGMSG_INFO) + call ESMF_VMPrint (vm, rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_LogWrite(subname//"ESMF_VMGet", ESMF_LOGMSG_INFO) + + ! duplicate the mpi communicator from the current VM + call MPI_Comm_dup(mpicom_vm, mpicom_lnd, rc) + call ESMF_LogWrite(subname//"MPI_Comm_dup...", ESMF_LOGMSG_INFO) + + !!!! NS : BOTH MPI_INIT and PIO_INIT1 are in lilac_mod.F90 + + + !------------------------------------------------------------------------ + ! Initialize mct + ! (needed for data models and cice prescribed capability) + ! (needed for data model share code - e.g. nitrogen deposition) + !------------------------------------------------------------------------ + ! TODO: FIX THIS PLEASE!!!! + + allocate(comms(1), comps(1), compLabels(1), comp_iamin(1), comp_comm_iam(1), comp_name(1),stat=ierr) + + comms(1) = mpicom_lnd !or call MPI_Comm_dup(mpicom_vm, comms(1), ierr) + comps(1) = 1 + compLabels(1) = 'LND' + comp_iamin(1) = .true. + comp_name(1) = 'LND' + + call ESMF_VMGet(vm, mpiCommunicator=comms(1), localPet=comp_comm_iam(1), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_pio_init2(comps, compLabels, comp_iamin, comms, comp_comm_iam) + + call ESMF_LogWrite(subname//"after shr_pio_init2", ESMF_LOGMSG_INFO) + + call ESMF_LogWrite(subname//"Now calling mct_world_init", ESMF_LOGMSG_INFO) + call mct_world_init(ncomps, mpicom_lnd, comms, comps) + call ESMF_LogWrite(subname//"mct world initialized! ", ESMF_LOGMSG_INFO) + + !deallocate(comms, comps, compLabels, comp_iamin, comp_comm_iam, comp_name) ??? + + ! Initialize model mpi info + compid = 1 + call spmd_init( mpicom_lnd, compid) + call ESMF_LogWrite(subname//"initialized model mpi info using spmd_init", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------ + !--- Log File --- + !------------------------------------------------------------------------ + + inst_name = 'LND' + inst_index = 1 + inst_suffix = "" + + ! Initialize io log unit + !! TODO: Put this in a subroutine..... + call shr_file_getLogUnit (shrlogunit) + if (masterproc) then + inquire(file='lnd_modelio.nml'//trim(inst_suffix),exist=exists) + if (exists) then + iulog = shr_file_getUnit() + call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),iulog) + end if + write(iulog,format) "CLM land model initialization" + else + iulog = shrlogunit + end if + + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + !------------------------------------------------------------------------ + !--- Orbital Values --- + !------------------------------------------------------------------------ + + + ! TODO: orbital values should be provided by lilac - but for now lets use defaults + !! hard wire these these in and we can decide on maybe having a + !namelist/ + + !call shr_cal_date2ymd(ymd,year,month,day) + !orb_cyear = orb_iyear + (year - orb_iyear_align) + + ! call shr_orb_params(& + ! orb_cyear=2000, orb_eccen=orb_eccen, orb_obliq=orb_obliq, orb_mvelp=orb_mvelpp, & + ! orb_obliqr=obliqr, orb_lambm0=orb_lambm0, orb_mvelpp=orb_mvelpp, masterproc) + + !---------------------- + ! Consistency check on namelist filename + !---------------------- + call control_setNL("lnd_in") + + !---------------------- + ! Get properties from clock + !---------------------- + + + call ESMF_ClockGet( clock, & + currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, & + timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + + call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,start_ymd) + + call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,stop_ymd) + + call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,ref_ymd) + + call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (esmf_caltype == ESMF_CALKIND_NOLEAP) then + calendar = shr_cal_noleap + else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then + calendar = shr_cal_gregorian + else + call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) + end if + + ! TODO: how do we set case_name and nsrest - should we hardwire for now? + caseid = 'test_lilac' + nsrest = nsrStartup + call ESMF_LogWrite(subname//"time manager Initialized....", ESMF_LOGMSG_INFO) + + !---------------------- + ! Initialize CTSM time manager + !---------------------- + + call set_timemgr_init( & + calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & + ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, stop_ymd_in=stop_ymd, & + stop_tod_in=stop_tod) + call ESMF_LogWrite(subname//"time manager is set now!", ESMF_LOGMSG_INFO) + + !---------------------- + ! Read namelist, grid and surface data + !---------------------- + + ! set default values for run control variables + call clm_varctl_set(caseid_in=caseid, nsrest_in=nsrest) + call ESMF_LogWrite(subname//"default values for run control variables are set...", ESMF_LOGMSG_INFO) + + + + !---------------------- + ! Initialize glc_elevclass module + !---------------------- + call glc_elevclass_init(glc_nec) + + !---------------------- + ! Initialize1 + !---------------------- + + ! note that the memory for gindex_ocn will be allocated in the following call + call initialize1(gindex_ocn) + ! call initialize1() + + call ESMF_LogWrite(subname//"initialize1 done...", ESMF_LOGMSG_INFO) + + ! obtain global index array for just land points which includes mask=0 or ocean points + call get_proc_bounds( bounds ) + + !print ,* "bound is :", bounds + !print ,* "bounds%begg :", bounds%begg + !print ,* "bounds%endg : ", bounds%endg + nlnd = bounds%endg - bounds%begg + 1 + allocate(gindex_lnd(nlnd)) + !print ,* "nlnd is :", nlnd + do g = bounds%begg,bounds%endg + n = 1 + (g - bounds%begg) + gindex_lnd(n) = ldecomp%gdc2glo(g) + end do + + call ESMF_LogWrite(subname//"obtained global index", ESMF_LOGMSG_INFO) + + ! create a global index that includes both land and ocean points + nocn = size(gindex_ocn) + allocate(gindex(nlnd + nocn)) + do n = 1,nlnd+nocn + if (n <= nlnd) then + gindex(n) = gindex_lnd(n) + else + gindex(n) = gindex_ocn(n-nlnd) + end if + end do + + ! create distGrid from global index array + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + deallocate(gindex) + call ESMF_LogWrite(subname//"DistGrid created......", ESMF_LOGMSG_INFO) + + !-------------------------------- + ! generate the mesh on ctsm distribution + !-------------------------------- + + ! TODO: mesh file should come into clm as a namelist for lilac only + ! for now need to hardwire this in cvalue here + cvalue = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' ! this will need to be filled in to run + + EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (masterproc) then + write(iulog,*)'mesh file for domain is ',trim(cvalue) + end if + + ! recreate the mesh using the above distGrid + EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_LogWrite(subname//" Create Mesh using distgrid ....", ESMF_LOGMSG_INFO) + lnd_mesh = EMesh + !-------------------------------- + ! Finish initializing ctsm + !-------------------------------- + call ESMF_LogWrite(subname//"before initialize2", ESMF_LOGMSG_INFO) + + call initialize2() + + call ESMF_LogWrite(subname//"initialize2 done...", ESMF_LOGMSG_INFO) + + !-------------------------------- + ! Check that ctsm internal dtime aligns with ctsm coupling interval + !-------------------------------- + call ESMF_LogWrite(subname//"cheking CTSM dtime and coupling intervals....", ESMF_LOGMSG_INFO) + + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_TimeIntervalGet( timeStep, s=dtime_sync, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + dtime_clm = get_step_size() + + if (masterproc) then + write(iulog,*)'dtime_sync= ',dtime_sync,' dtime_ctsm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) + end if + if (mod(dtime_sync,dtime_clm) /= 0) then + write(iulog,*)'ctsm dtime ',dtime_clm,' and clock dtime ',dtime_sync,' never align' + rc = ESMF_FAILURE + return + end if + + !-------------------------------- + ! Create import state (only assume input from atm - not rof and glc) + !-------------------------------- + + c2l_fb = ESMF_FieldBundleCreate ( name='c2l_fb', rc=rc) + + + call fldbundle_add( 'Sa_z' , c2l_fb,rc) !1 + call fldbundle_add( 'Sa_topo' , c2l_fb,rc) !2 + call fldbundle_add( 'Sa_u' , c2l_fb,rc) !3 + call fldbundle_add( 'Sa_v' , c2l_fb,rc) !4 + call fldbundle_add( 'Sa_ptem' , c2l_fb,rc) !5 + call fldbundle_add( 'Sa_pbot' , c2l_fb,rc) !6 + call fldbundle_add( 'Sa_tbot' , c2l_fb,rc) !7 + call fldbundle_add( 'Sa_shum' , c2l_fb,rc) !8 + + call fldbundle_add( 'Faxa_lwdn' , c2l_fb,rc) !9 + call fldbundle_add( 'Faxa_rainc' , c2l_fb,rc) !10 + call fldbundle_add( 'Faxa_rainl' , c2l_fb,rc) !11 + call fldbundle_add( 'Faxa_snowc' , c2l_fb,rc) !12 + call fldbundle_add( 'Faxa_snowl' , c2l_fb,rc) !13 + call fldbundle_add( 'Faxa_swndr' , c2l_fb,rc) !14 + call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) !15 + call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) !16 + call fldbundle_add( 'Faxa_swvdf' , c2l_fb,rc) !17 + call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb/), rc=rc) + !call ESMF_StateAdd(importState, fieldbundleList = (/c2l_fb/), rc=rc) + + ! Create export state + + l2c_fb = ESMF_FieldBundleCreate(name='l2c_fb', rc=rc) + !call fldbundle_add( 'Sl_lfrint' , l2c_fb,rc) !1 + call fldbundle_add( 'Sl_lfrin' , l2c_fb,rc) !1 + call fldbundle_add( 'Sl_t' , l2c_fb,rc) !2 + call fldbundle_add( 'Sl_tref' , l2c_fb,rc) !3 + call fldbundle_add( 'Sl_qref' , l2c_fb,rc) !4 + call fldbundle_add( 'Sl_avsdr' , l2c_fb,rc) !5 + call fldbundle_add( 'Sl_anidr' , l2c_fb,rc) !6 + call fldbundle_add( 'Sl_avsdf' , l2c_fb,rc) !7 + call fldbundle_add( 'Sl_anidf' , l2c_fb,rc) !8 + call fldbundle_add( 'Sl_snowh' , l2c_fb,rc) !9 + call fldbundle_add( 'Fall_u10' , l2c_fb,rc) !10 + call fldbundle_add( 'Fall_fv' , l2c_fb,rc) !11 + call fldbundle_add( 'Fall_ram1' , l2c_fb,rc) !12 + !call fldbundle_add( 'Fall_taux' , l2c_fb,rc) !10 + !call fldbundle_add( 'Fall_lwup' , l2c_fb,rc) !14 + !call fldbundle_add( 'Fall_evap' , l2c_fb,rc) !15 + !call fldbundle_add( 'Fall_swniet' , l2c_fb,rc) !16 + call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb/), rc=rc) + !call ESMF_StateAdd(exportState, fieldbundleList = (/l2c_fb/), rc=rc) + + + + + + + + + + + + !-------------------------------- + ! Create land export state + !-------------------------------- + call ESMF_LogWrite(subname//"Creating land export state", ESMF_LOGMSG_INFO) + + ! FIXME (NS, 2019-07-30) + ! FIX THIS EXPORT STATES!!!!!! MAYBE REWRITE WITH THE ORIGINAL STRUCTURE + ! IN MIND + + ! Fill in export state at end of initialization + call export_fields(comp, bounds, glc_present, rof_prognostic, & + water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//"Getting Calendar Day of nextsw calculation...", ESMF_LOGMSG_INFO) + + ! Get calendar day of next sw (shortwave) calculation (nextsw_cday) + if (nsrest == nsrStartup) then + call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if + + + ! Set nextsw_cday + call ESMF_LogWrite(subname//"Setting nextsw cday......", ESMF_LOGMSG_INFO) + !call ESMF_LogWrite(subname//nextsw_cday, ESMF_LOGMSG_INFO) + call set_nextsw_cday( nextsw_cday ) + + ! Set Attributes + call ESMF_LogWrite(subname//"setting attribute!", ESMF_LOGMSG_INFO) + + call ESMF_AttributeSet(export_state, name="lnd_nx", value=ldomain%ni, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"setting attribute! lnd_nx", ESMF_LOGMSG_INFO) + + call ESMF_AttributeSet(export_state, name="lnd_ny", value=ldomain%nj, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"setting attribute-lnd_ny!", ESMF_LOGMSG_INFO) + + + + + call ESMF_LogWrite(subname//"State_SetScalar....!", ESMF_LOGMSG_INFO) + !Set scalars in export state + !call State_SetScalar(dble(ldomain%ni), flds_scalar_index_nx, export_state, & + ! flds_scalar_name, flds_scalar_num, rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !call State_SetScalar(dble(ldomain%nj), flds_scalar_index_ny, exportState, & + ! flds_scalar_name, flds_scalar_num, rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + + !-------------------------------- + ! diagnostics + !-------------------------------- + + if (dbug > 1) then + call State_diagnose(export_state, subname//':ExportState',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + + + ! Reset shr logging to original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#ifdef USE_ESMF_METADATA + convCIM = "CIM" + purpComp = "Model Component Simulation Description" + call ESMF_AttributeAdd(comp, convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "ShortName", "CTSM", convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "LongName", "Community Land Model", convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "Description", "Community Land Model", convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "ReleaseDate", "2017", convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "ModelType", "Terrestrial", convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "Name", "TBD", convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "EmailAddress", TBD, convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", convention=convCIM, purpose=purpComp, rc=rc) +#endif + + +#if (defined _MEMTRACE) + if(masterproc) then + write(iulog,*) TRIM(Sub) // ':end::' + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_int:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + call ESMF_LogWrite(subname//' CTSM INITIALIZATION DONE SUCCESSFULLY!!!! ', ESMF_LOGMSG_INFO) + + end subroutine lnd_init + + !--------------------------------------------------------------------------- + + !subroutine fldbundle_add(stdname, fldptr, fieldbundle,rc) + subroutine fldbundle_add(stdname, fieldbundle,rc) + type(ESMF_Field) :: field + !type(ESMF_Mesh) :: lnd_mesh + character(len=*), intent(in) :: stdname + type (ESMF_FieldBundle) :: fieldbundle + integer, intent(out) :: rc + + print *, "in lnd register routine" + + rc = ESMF_SUCCESS + + !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(stdname), rc=rc) + field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_FieldBundleAdd(fieldbundle, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end subroutine fldbundle_add + + !--------------------------------------------------------------------------- + subroutine lnd_run(gcomp, import_state, export_state, clock, rc) + + !------------------------ + ! Run CTSM + !------------------------ + + use clm_instMod , only : water_inst, atm2lnd_inst, glc2lnd_inst, lnd2atm_inst, lnd2glc_inst + use lnd_import_export , only : import_fields, export_fields + use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst + + ! input/output variables + type(ESMF_GridComp) :: gcomp ! CLM gridded component + type(ESMF_State) :: import_state ! CLM import state + type(ESMF_State) :: export_state ! CLM export state + type(ESMF_Clock) :: clock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + + ! local variables: + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: currTime + type(ESMF_Time) :: nextTime + type(ESMF_State) :: importState, exportState + character(ESMF_MAXSTR) :: cvalue + character(ESMF_MAXSTR) :: case_name ! case name + integer :: ymd ! CTSM current date (YYYYMMDD) + integer :: yr ! CTSM current year + integer :: mon ! CTSM current month + integer :: day ! CTSM current day + integer :: tod ! CTSM current time of day (sec) + integer :: ymd_sync ! Sync date (YYYYMMDD) + integer :: yr_sync ! Sync current year + integer :: mon_sync ! Sync current month + integer :: day_sync ! Sync current day + integer :: tod_sync ! Sync current time of day (sec) + integer :: dtime ! time step increment (sec) + integer :: nstep ! time step index + logical :: rstwr ! .true. ==> write restart file before returning + logical :: nlend ! .true. ==> last time-step + logical :: dosend ! true => send data back to driver + logical :: doalb ! .true. ==> do albedo calculation on this time step + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + real(r8) :: caldayp1 ! ctsm calday plus dtime offset + integer :: lbnum ! input to memory diagnostic + integer :: g,i ! counters + real(r8) :: calday ! calendar day for nstep + real(r8) :: declin ! solar declination angle in radians for nstep + real(r8) :: declinp1 ! solar declination angle in radians for nstep+1 + real(r8) :: eccf ! earth orbit eccentricity factor + type(bounds_type) :: bounds ! bounds + character(len=32) :: rdate ! date char string for restart file names + integer :: shrlogunit ! original log unit + character(len=*),parameter :: subname=trim(modName)//':[lnd_run] ' + !------------------------------------------------------------------------------- + + + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + call shr_file_getLogUnit (shrlogunit) + call shr_file_setLogUnit (iulog) + call ESMF_LogWrite(subname//' shr_file_getLogunits....', ESMF_LOGMSG_INFO) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_comp_nuopc_ModelAdvance:start::',lbnum) + endif +#endif + + !-------------------------------- + ! Determine time of next atmospheric shortwave calculation + !-------------------------------- + + !call ESMF_AttributeGet(export_state, name="nextsw_cday", value=nextsw_cday, rc=rc) + !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !call set_nextsw_cday( nextsw_cday ) + + ! in nuopc it is like this...... + !call State_GetScalar(import_state, & + ! flds_scalar_index_nextsw_cday, nextsw_cday, & + ! flds_scalar_name, flds_scalar_num, rc) + !call ESMF_LogWrite(subname//'after state_getscalar for determining nextsw_cday', ESMF_LOGMSG_INFO) + !call set_nextsw_cday( nextsw_cday ) + !call ESMF_LogWrite(subname//'settitng nextsw_cday', ESMF_LOGMSG_INFO) + + + !---------------------- + ! Obtain orbital values + !---------------------- + + !call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) eccen + + !call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) obliqr + + !call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) lambm0 + + !call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) mvelpp + + + + + !-------------------------------- + ! Unpack import state + !-------------------------------- + + call t_startf ('lc_lnd_import') + + call get_proc_bounds(bounds) + call ESMF_LogWrite(subname//'after get_proc_bounds', ESMF_LOGMSG_INFO) + !call import_fields( import_state, bounds, glc_present, rof_prognostic, atm2lnd_inst, glc2lnd_inst, water_inst%wateratm2lndbulk_inst, rc ) + call import_fields( gcomp , bounds, glc_present, rof_prognostic, atm2lnd_inst, glc2lnd_inst, water_inst%wateratm2lndbulk_inst, rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call t_stopf ('lc_lnd_import') + + !-------------------------------- + ! Run model + !-------------------------------- + + dtime = get_step_size() + dosend = .false. + do while(.not. dosend) + + ! TODO: This is currently hard-wired - is there a better way for nuopc? + ! Note that the model clock is updated at the end of the time step not at the beginning + nstep = get_nstep() + if (nstep > 0) then + dosend = .true. + end if + + !-------------------------------- + ! Determine doalb based on nextsw_cday sent from atm model + !-------------------------------- + + caldayp1 = get_curr_calday(offset=dtime) + + if (nstep == 0) then + doalb = .false. + else if (nstep == 1) then + doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) + else + doalb = (nextsw_cday >= -0.5_r8) + end if + call update_rad_dtime(doalb) + + !-------------------------------- + ! Determine if time to write restart + !-------------------------------- + + !call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !rstwr = .true. + !call ESMF_AlarmRingerOff( alarm, rc=rc ) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !else + !rstwr = .false. + !endif + + !-------------------------------- + ! Determine if time to stop + !-------------------------------- + + !call ESMF_ClockGetAlarm(clock, alarmname='alarm_stop', alarm=alarm, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !nlend = .true. + !call ESMF_AlarmRingerOff( alarm, rc=rc ) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !else + ! nlend = .false. + !endif + + !-------------------------------- + ! Run CTSM + !-------------------------------- + + call t_barrierf('sync_ctsm_run1', mpicom) + + call t_startf ('shr_orb_decl') + calday = get_curr_calday() + call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) + call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) + call t_stopf ('shr_orb_decl') + + call t_startf ('ctsm_run') + + ! Restart File - use nexttimestr rather than currtimestr here since that is the time at the end of + ! the timestep and is preferred for restart file names + + call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync, mon_sync, day_sync, tod_sync + + call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic) + + call t_stopf ('ctsm_run') + + !-------------------------------- + ! Pack export state + !-------------------------------- + + call t_startf ('lc_lnd_export') + + !call export_fields(exportState, bounds, glc_present, rof_prognostic, & + ! water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) + !call export_fields(exportState, bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call t_stopf ('lc_lnd_export') + + !-------------------------------- + ! Advance ctsm time step + !-------------------------------- + + call t_startf ('lc_ctsm2_adv_timestep') + call advance_timestep() + call t_stopf ('lc_ctsm2_adv_timestep') + + end do + + ! Check that internal clock is in sync with master clock + ! Note that the driver clock has not been updated yet - so at this point + ! CTSM is actually 1 coupling intervals ahead of the driver clock + + call get_curr_date( yr, mon, day, tod, offset=-2*dtime ) + ymd = yr*10000 + mon*100 + day + tod = tod + + call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) + + if ( (ymd /= ymd_sync) .and. (tod /= tod_sync) ) then + write(iulog,*)'ctsm ymd=',ymd ,' ctsm tod= ',tod + write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync + rc = ESMF_FAILURE + call ESMF_LogWrite(subname//" CTSM clock not in sync with Master Sync clock",ESMF_LOGMSG_ERROR) + end if + + !-------------------------------- + ! diagnostics + !-------------------------------- + + !if (dbug > 1) then + ! call State_diagnose(exportState,subname//':ES',rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (masterproc) then + ! call log_clock_advance(clock, 'CTSM', iulog, rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! end if + !end if + + !-------------------------------- + ! Reset shr logging to my original values + !-------------------------------- + + call shr_file_setLogUnit (shrlogunit) + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_comp_nuopc_ModelAdvance:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + end subroutine lnd_run + + !--------------------------------------------------------------------------- + + subroutine lnd_final(comp, import_state, export_state, clock, rc) + ! + ! !DESCRIPTION: + ! Finalize land surface model + ! + ! !ARGUMENTS: + type(ESMF_GridComp) :: comp ! CLM gridded component + type(ESMF_State) :: import_state ! CLM import state + type(ESMF_State) :: export_state ! CLM export state + type(ESMF_Clock) :: clock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + !--------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Destroy ESMF objects + !call esmfshr_util_StateArrayDestroy(export_state,'domain',rc) + !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !call esmfshr_util_StateArrayDestroy(export_state,'d2x',rc) + !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !call esmfshr_util_StateArrayDestroy(import_state,'x2d',rc) + !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + end subroutine lnd_final + + end module lnd_comp_esmf diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 new file mode 100644 index 0000000000..1514cd6aac --- /dev/null +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -0,0 +1,1519 @@ +module lnd_import_export + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet + use ESMF , only : ESMF_StatePrint + use ESMF , only : ESMF_GridCompGet + use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError + use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag + use ESMF , only : operator(/=), operator(==) + !use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected + !use NUOPC_Model , only : NUOPC_ModelGet + use shr_kind_mod , only : r8 => shr_kind_r8, cx=>shr_kind_cx, cxx=>shr_kind_cxx, cs=>shr_kind_cs + use shr_infnan_mod , only : isnan => shr_infnan_isnan + use shr_string_mod , only : shr_string_listGetName, shr_string_listGetNum + use shr_sys_mod , only : shr_sys_abort + use clm_varctl , only : iulog + use clm_time_manager , only : get_nstep + use decompmod , only : bounds_type + use lnd2atmType , only : lnd2atm_type + use lnd2glcMod , only : lnd2glc_type + use atm2lndType , only : atm2lnd_type + use glc2lndMod , only : glc2lnd_type + use domainMod , only : ldomain + use spmdMod , only : masterproc + use seq_drydep_mod , only : seq_drydep_readnl, n_drydep, seq_drydep_init + use shr_megan_mod , only : shr_megan_readnl, shr_megan_mechcomps_n + use shr_fire_emis_mod , only : shr_fire_emis_readnl, shr_fire_emis_mechcomps_n + use shr_carma_mod , only : shr_carma_readnl + use shr_ndep_mod , only : shr_ndep_readnl + use glc_elevclass_mod , only : glc_elevclass_init + use lnd_shr_methods , only : chkerr + + implicit none + private ! except + +! public :: advertise_fields +! public :: realize_fields + public :: import_fields + public :: export_fields + + private :: fldlist_add + private :: fldlist_realize + private :: state_getimport + private :: state_setexport + private :: state_getfldptr + private :: check_for_nans + + type fld_list_type + character(len=128) :: stdname + integer :: ungridded_lbound = 0 + integer :: ungridded_ubound = 0 + end type fld_list_type + + integer, parameter :: fldsMax = 100 + integer :: fldsToLnd_num = 0 + integer :: fldsFrLnd_num = 0 + type (fld_list_type) :: fldsToLnd(fldsMax) + type (fld_list_type) :: fldsFrLnd(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + + ! from atm->lnd + integer :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn + + ! from lnd->atm + character(len=cx) :: carma_fields ! List of CARMA fields from lnd->atm + integer :: drydep_nflds ! number of dry deposition velocity fields lnd-> atm + integer :: megan_nflds ! number of MEGAN voc fields from lnd-> atm + integer :: emis_nflds ! number of fire emission fields from lnd-> atm + + logical :: flds_co2a ! use case + logical :: flds_co2b ! use case + logical :: flds_co2c ! use case + integer :: glc_nec ! number of glc elevation classes + integer, parameter :: debug = 1 ! internal debug level + + character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" + character(*),parameter :: u_FILE_u = & + __FILE__ + character(*),parameter :: modname = "[lnd_import_export]: " + +!=============================================================================== +contains +!=============================================================================== + +! subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, rof_prognostic, rc) +! +! use clm_varctl, only : ndep_from_cpl +! +! ! input/output variables +! type(ESMF_GridComp) :: gcomp +! character(len=*) , intent(in) :: flds_scalar_name +! logical , intent(in) :: glc_present +! logical , intent(in) :: rof_prognostic +! integer , intent(out) :: rc +! +! ! local variables +! type(ESMF_State) :: importState +! type(ESMF_State) :: exportState +! character(ESMF_MAXSTR) :: stdname +! character(ESMF_MAXSTR) :: cvalue +! character(len=2) :: nec_str +! integer :: n, num +! character(len=128) :: fldname +! character(len=*), parameter :: subname='(lnd_import_export:advertise_fields)' +! !------------------------------------------------------------------------------- +! +! rc = ESMF_SUCCESS +! +! call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! !-------------------------------- +! ! determine necessary toggles for below +! !-------------------------------- +! +! 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) +! +! 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) +! +! 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) +! +! ! Determine number of elevation classes +! call NUOPC_CompAttributeGet(gcomp, name='glc_nec', value=cvalue, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! read(cvalue,*) glc_nec +! call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO) +! if (glc_nec < 1) then +! call shr_sys_abort('ERROR: In CLM4.5 and later, glc_nec must be at least 1.') +! end if +! +! ! Initialize glc_elevclass module +! call glc_elevclass_init(glc_nec) +! +! !-------------------------------- +! ! Advertise export fields +! !-------------------------------- +! +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, trim(flds_scalar_name)) +! +! ! export land states +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_t' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_tref' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_qref' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdr' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidr' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdf' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidf' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_snowh' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_u10' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_fv' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_ram1' ) +! +! ! export fluxes to river +! if (rof_prognostic) then +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsur' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofgwl' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsub' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofi' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_irrig' ) +! end if +! +! ! export fluxes to atm +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_taux' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_tauy' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lat' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_sen' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lwup' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap' ) +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_swnet' ) +! +! ! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_methane' ) +! +! ! dust fluxes from land (4 sizes) +! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_flxdst', ungridded_lbound=1, ungridded_ubound=4) +! +! ! co2 fields from land +! if (flds_co2b .or. flds_co2c) then +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_fco2_lnd' ) +! end if +! +! ! Dry Deposition velocities from land - ALSO initialize drydep here +! call seq_drydep_readnl("drv_flds_in", drydep_nflds) +! if (n_drydep .ne. drydep_nflds) call shr_sys_abort('ERROR: drydep field count mismatch') +! if (n_drydep > 0) then +! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_ddvel', ungridded_lbound=1, ungridded_ubound=drydep_nflds) +! end if +! call seq_drydep_init( ) +! +! ! MEGAN VOC emissions fluxes from land +! megan_nflds=0 +! call shr_megan_readnl('drv_flds_in', megan_nflds) +! if (shr_megan_mechcomps_n .ne. megan_nflds) call shr_sys_abort('ERROR: megan field count mismatch') +! if (shr_megan_mechcomps_n > 0) then +! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_voc', ungridded_lbound=1, ungridded_ubound=megan_nflds) +! end if +! +! ! Fire emissions fluxes from land +! call shr_fire_emis_readnl('drv_flds_in', emis_nflds) +! if (shr_fire_emis_mechcomps_n .ne. emis_nflds) call shr_sys_abort('ERROR: fire_emis field count mismatch') +! if (shr_fire_emis_mechcomps_n > 0) then +! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_fire', ungridded_lbound=1, ungridded_ubound=emis_nflds) +! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_fztop') +! end if +! ! CARMA volumetric soil water from land +! ! TODO: is the following correct - the CARMA field exchange is very confusing in mct +! call shr_carma_readnl('drv_flds_in', carma_fields) +! if (carma_fields /= ' ') then +! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_soilw') ! optional for carma +! end if +! +! if (glc_present) then +! ! lnd->glc states from land all lnd->glc elevation classes (1:glc_nec) plus bare land (index 0). +! ! The following puts all of the elevation class fields as an +! ! undidstributed dimension in the export state field +! +! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_tsrf_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) +! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_topo_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) +! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Flgl_qice_elev', ungridded_lbound=1, ungridded_ubound=glc_nec+1) +! end if +! +! ! Now advertise above export fields +! do n = 1,fldsFrLnd_num +! call NUOPC_Advertise(exportState, standardName=fldsFrLnd(n)%stdname, & +! TransferOfferGeomObject='will provide', rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! enddo +! +! !-------------------------------- +! ! Advertise import fields +! !-------------------------------- +! +! call fldlist_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) +! +! ! from atm - states +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_z' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_topo' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_u' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_v' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_ptem' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_pbot' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_tbot' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_shum' ) +! !call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_methane' ) +! +! ! from atm - fluxes +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_lwdn' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainc' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainl' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowc' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowl' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndr' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdr' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndf' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdf' ) +! +! ! from atm - black carbon deposition fluxes (3) +! ! (1) => bcphidry, (2) => bcphodry, (3) => bcphiwet +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_bcph', ungridded_lbound=1, ungridded_ubound=3) +! +! ! from atm - organic carbon deposition fluxes (3) +! ! (1) => ocphidry, (2) => ocphodry, (3) => ocphiwet +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_ocph', ungridded_lbound=1, ungridded_ubound=3) +! +! ! from atm - wet dust deposition frluxes (4 sizes) +! ! (1) => dstwet1, (2) => dstwet2, (3) => dstwet3, (4) => dstwet4 +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) +! +! ! from - atm dry dust deposition frluxes (4 sizes) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) +! +! ! from atm - nitrogen deposition +! call shr_ndep_readnl("drv_flds_in", ndep_nflds) +! if (ndep_nflds > 0) then +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=ndep_nflds) +! ! This sets a variable in clm_varctl +! ndep_from_cpl = .true. +! end if +! +! ! from atm - co2 exchange scenarios +! if (flds_co2a .or. flds_co2b .or. flds_co2c) then +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_co2prog') +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_co2diag') +! end if +! +! if (rof_prognostic) then +! ! from river +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_flood' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_volr' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_volrmch' ) +! end if +! +! if (glc_present) then +! ! from land-ice (glc) - no elevation classes +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_icemask' ) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_icemask_coupled_fluxes') +! +! ! from land-ice (glc) - fields for all glc->lnd elevation classes (1:glc_nec) plus bare land (index 0) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_ice_covered_elev', ungridded_lbound=1, ungridded_ubound=glc_nec+1) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_topo_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) +! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flgg_hflx_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) +! end if +! +! ! Now advertise import fields +! do n = 1,fldsToLnd_num +! call NUOPC_Advertise(importState, standardName=fldsToLnd(n)%stdname, & +! TransferOfferGeomObject='will provide', rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! enddo +! +! end subroutine advertise_fields +! +! !=============================================================================== +! +! subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) +! +! ! input/output variables +! type(ESMF_GridComp) , intent(inout) :: gcomp +! type(ESMF_Mesh) , intent(in) :: Emesh +! character(len=*) , intent(in) :: flds_scalar_name +! integer , intent(in) :: flds_scalar_num +! integer , intent(out) :: rc +! +! ! local variables +! type(ESMF_State) :: importState +! type(ESMF_State) :: exportState +! character(len=*), parameter :: subname='(lnd_import_export:realize_fields)' +! !--------------------------------------------------------------------------- +! +! rc = ESMF_SUCCESS +! +! call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! call fldlist_realize( & +! state=ExportState, & +! fldList=fldsFrLnd, & +! numflds=fldsFrLnd_num, & +! flds_scalar_name=flds_scalar_name, & +! flds_scalar_num=flds_scalar_num, & +! tag=subname//':clmExport',& +! mesh=Emesh, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! call fldlist_realize( & +! state=importState, & +! fldList=fldsToLnd, & +! numflds=fldsToLnd_num, & +! flds_scalar_name=flds_scalar_name, & +! flds_scalar_num=flds_scalar_num, & +! tag=subname//':clmImport',& +! mesh=Emesh, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! end subroutine realize_fields + + !=============================================================================== + + subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & + atm2lnd_inst, glc2lnd_inst, wateratm2lndbulk_inst, rc) + + !--------------------------------------------------------------------------- + ! Convert the input data from the mediator to the land model + !--------------------------------------------------------------------------- + + use clm_varctl , only: co2_type, co2_ppmv, use_c13, ndep_from_cpl + use clm_varcon , only: rair, o2_molar_const, c13ratio + use shr_const_mod , only: SHR_CONST_TKFRZ + use Wateratm2lndBulkType , only: wateratm2lndbulk_type + + ! input/output variabes + type(ESMF_GridComp) :: gcomp + type(bounds_type) , intent(in) :: bounds ! bounds + logical , intent(in) :: glc_present ! .true. => running with a non-stub GLC model + logical , intent(in) :: rof_prognostic ! .true. => running with a prognostic ROF model + type(atm2lnd_type) , intent(inout) :: atm2lnd_inst ! clm internal input data type + type(glc2lnd_type) , intent(inout) :: glc2lnd_inst ! clm internal input data type + type(Wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst + integer , intent(out) :: rc + + ! local variables + type(ESMF_State) :: importState + type(ESMF_StateItem_Flag) :: itemFlag + real(r8), pointer :: dataPtr(:) + character(len=128) :: fldname + integer :: num + integer :: begg, endg ! bounds + integer :: g,i,k ! indices + real(r8) :: e ! vapor pressure (Pa) + real(r8) :: qsat ! saturation specific humidity (kg/kg) + real(r8) :: co2_ppmv_diag(bounds%begg:bounds%endg) ! temporary + real(r8) :: co2_ppmv_prog(bounds%begg:bounds%endg) ! temporary + real(r8) :: co2_ppmv_val ! temporary + real(r8) :: esatw ! saturation vapor pressure over water (Pa) + real(r8) :: esati ! saturation vapor pressure over ice (Pa) + real(r8) :: a0,a1,a2,a3,a4,a5,a6 ! coefficients for esat over water + real(r8) :: b0,b1,b2,b3,b4,b5,b6 ! coefficients for esat over ice + real(r8) :: tdc, t ! Kelvins to Celcius function and its input + real(r8) :: forc_t ! atmospheric temperature (Kelvin) + real(r8) :: forc_q ! atmospheric specific humidity (kg/kg) + real(r8) :: forc_pbot ! atmospheric pressure (Pa) + real(r8) :: forc_rainc(bounds%begg:bounds%endg) ! rainxy Atm flux mm/s + real(r8) :: forc_rainl(bounds%begg:bounds%endg) ! rainxy Atm flux mm/s + real(r8) :: forc_snowc(bounds%begg:bounds%endg) ! snowfxy Atm flux mm/s + real(r8) :: forc_snowl(bounds%begg:bounds%endg) ! snowfxl Atm flux mm/s + real(r8) :: forc_noy(bounds%begg:bounds%endg) + real(r8) :: forc_nhx(bounds%begg:bounds%endg) + real(r8) :: frac_grc(bounds%begg:bounds%endg, 0:glc_nec) + real(r8) :: topo_grc(bounds%begg:bounds%endg, 0:glc_nec) + real(r8) :: hflx_grc(bounds%begg:bounds%endg, 0:glc_nec) + real(r8) :: icemask_grc(bounds%begg:bounds%endg) + real(r8) :: icemask_coupled_fluxes_grc(bounds%begg:bounds%endg) + character(len=*), parameter :: subname='(lnd_import_export:import_fields)' + !character(len=* ) , parameter :: subname=trim(modname ) //' : (import_fields) ' + + ! Constants to compute vapor pressure + parameter (a0=6.107799961_r8 , a1=4.436518521e-01_r8, & + a2=1.428945805e-02_r8, a3=2.650648471e-04_r8, & + a4=3.031240396e-06_r8, a5=2.034080948e-08_r8, & + a6=6.136820929e-11_r8) + + parameter (b0=6.109177956_r8 , b1=5.034698970e-01_r8, & + b2=1.886013408e-02_r8, b3=4.176223716e-04_r8, & + b4=5.824720280e-06_r8, b5=4.838803174e-08_r8, & + b6=1.838826904e-10_r8) + + ! function declarations + tdc(t) = min( 50._r8, max(-50._r8,(t-SHR_CONST_TKFRZ)) ) + esatw(t) = 100._r8*(a0+t*(a1+t*(a2+t*(a3+t*(a4+t*(a5+t*a6)))))) + esati(t) = 100._r8*(b0+t*(b1+t*(b2+t*(b3+t*(b4+t*(b5+t*b6)))))) + !--------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + ! Get import state + !call NUOPC_ModelGet(gcomp, importState=importState, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get import state + call ESMF_GridCompGet(gcomp, importState=importState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set bounds + begg = bounds%begg; endg=bounds%endg + + ! Note: precipitation fluxes received from the coupler + ! are in units of kg/s/m^2. To convert these precipitation rates + ! in units of mm/sec, one must divide by 1000 kg/m^3 and multiply + ! by 1000 mm/m resulting in an overall factor of unity. + ! Below the units are therefore given in mm/s. + + !-------------------------- + ! Required atmosphere input fields + !-------------------------- + + call state_getimport(importState, 'Sa_z', bounds, output=atm2lnd_inst%forc_hgt_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Sa_topo', bounds, output=atm2lnd_inst%forc_topo_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Sa_u', bounds, output=atm2lnd_inst%forc_u_grc, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Sa_v', bounds, output=atm2lnd_inst%forc_v_grc, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Sa_ptem', bounds, output=atm2lnd_inst%forc_th_not_downscaled_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Sa_shum', bounds, output=wateratm2lndbulk_inst%forc_q_not_downscaled_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Sa_pbot', bounds, output=atm2lnd_inst%forc_pbot_not_downscaled_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Sa_tbot', bounds, output=atm2lnd_inst%forc_t_not_downscaled_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Faxa_rainc', bounds, output=forc_rainc, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Faxa_rainl', bounds, output=forc_rainl, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Faxa_snowc', bounds, output=forc_snowc, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Faxa_snowl', bounds, output=forc_snowl, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Faxa_lwdn', bounds, output=atm2lnd_inst%forc_lwrad_not_downscaled_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Faxa_swvdr', bounds, output=atm2lnd_inst%forc_solad_grc(:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Faxa_swndr', bounds, output=atm2lnd_inst%forc_solad_grc(:,2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Faxa_swvdf', bounds, output=atm2lnd_inst%forc_solai_grc(:,1), rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Faxa_swndf', bounds, output=atm2lnd_inst%forc_solai_grc(:,2), rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + + +!!!# ! Atmosphere prognostic/prescribed aerosol fields +!!!# +!!!# ! bcphidry +!!!# call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,1), & +!!!# ungridded_index=1, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# ! bcphodry +!!!# call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,2), & +!!!# ungridded_index=2, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# ! bcphiwet +!!!# call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,3), & +!!!# ungridded_index=3, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# +!!!# ! ocphidry +!!!# call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,4), & +!!!# ungridded_index=1, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# ! bcphodry +!!!# call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,5), & +!!!# ungridded_index=2, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# ! bcphiwet +!!!# call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,6), & +!!!# ungridded_index=3, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# +!!!# call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,7), & +!!!# ungridded_index=1, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,8), & +!!!# ungridded_index=1, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# +!!!# call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,9), & +!!!# ungridded_index=2, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,10), & +!!!# ungridded_index=2, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# +!!!# call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,11), & +!!!# ungridded_index=3, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,12), & +!!!# ungridded_index=3, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# +!!!# call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,13), & +!!!# ungridded_index=4, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,14), & +!!!# ungridded_index=4, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# +!!!# call state_getimport(importState, 'Sa_methane', bounds, output=atm2lnd_inst%forc_pch4_grc, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# +!!!# ! The mediator is sending ndep in units if kgN/m2/s - and ctsm uses units of gN/m2/sec +!!!# ! so the following conversion needs to happen +!!!# +!!!# call state_getimport(importState, 'Faxa_nhx', bounds, output=forc_nhx, ungridded_index=1, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# call state_getimport(importState, 'Faxa_noy', bounds, output=forc_noy, ungridded_index=2, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# do g = begg,endg +!!!# atm2lnd_inst%forc_ndep_grc(g) = (forc_nhx(g) + forc_noy(g))*1000._r8 +!!!# end do +!!!# +!!!# !-------------------------- +!!!# ! Atmosphere co2 +!!!# !-------------------------- +!!!# +!!!# fldName = 'Sa_co2prog' +!!!# call ESMF_StateGet(importState, trim(fldname), itemFlag, rc=rc) +!!!# if ( ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# if (itemflag == ESMF_STATEITEM_NOTFOUND .and. co2_type == 'prognostic') then +!!!# call shr_sys_abort( subname//' ERROR: must have nonzero Sa_co2prog for co2_type equal to prognostic' ) +!!!# end if +!!!# if (itemflag /= ESMF_STATEITEM_NOTFOUND) then +!!!# call state_getfldptr(importState, trim(fldname), dataPtr, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# do g = begg,endg +!!!# co2_ppmv_prog(g) = dataPtr(g-begg+1) ! co2 atm prognostic +!!!# end do +!!!# else +!!!# do g = begg,endg +!!!# co2_ppmv_prog(g) = co2_ppmv +!!!# end do +!!!# end if +!!!# +!!!# fldName = 'Sa_co2diag' +!!!# call ESMF_StateGet(importState, trim(fldname), itemFlag, rc=rc) +!!!# if ( ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# if (itemflag == ESMF_STATEITEM_NOTFOUND .and. co2_type == 'diagnostic') then +!!!# call shr_sys_abort( subname//' ERROR: must have nonzero Sa_co2prog for co2_type equal to prognostic' ) +!!!# end if +!!!# if (itemflag /= ESMF_STATEITEM_NOTFOUND) then +!!!# call state_getfldptr(importState, trim(fldname), dataPtr, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# do g = begg,endg +!!!# co2_ppmv_diag(g) = dataPtr(g-begg+1) ! co2 atm diagnostic +!!!# end do +!!!# else +!!!# do g = begg,endg +!!!# co2_ppmv_diag(g) = co2_ppmv +!!!# end do +!!!# end if +!!!# +!!!# ! Note that the following does unit conversions from ppmv to partial pressures (Pa) +!!!# ! Note that forc_pbot is in Pa +!!!# do g = begg,endg +!!!# if (co2_type == 'prognostic') then +!!!# co2_ppmv_val = co2_ppmv_prog(g) +!!!# else if (co2_type == 'diagnostic') then +!!!# co2_ppmv_val = co2_ppmv_diag(g) +!!!# else +!!!# co2_ppmv_val = co2_ppmv +!!!# end if +!!!# forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) +!!!# atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot +!!!# if (use_c13) then +!!!# atm2lnd_inst%forc_pc13o2_grc(g) = co2_ppmv_val * c13ratio * 1.e-6_r8 * forc_pbot +!!!# end if +!!!# end do +!!!# +!!!# !-------------------------- +!!!# ! Flooding back from river +!!!# !-------------------------- +!!!# +!!!# ! sign convention is positive downward and hierarchy is atm/glc/lnd/rof/ice/ocn. +!!!# ! so water sent from rof to land is negative, +!!!# ! change the sign to indicate addition of water to system. +!!!# +!!!# if (rof_prognostic) then +!!!# call state_getimport(importState, 'Flrr_flood', bounds, output=wateratm2lndbulk_inst%forc_flood_grc, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# wateratm2lndbulk_inst%forc_flood_grc(:) = -wateratm2lndbulk_inst%forc_flood_grc(:) +!!!# else + wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 +!!!# end if +!!!# +!!!# if (rof_prognostic) then +!!!# call state_getimport(importState, 'Flrr_volr', bounds, output=wateratm2lndbulk_inst%volr_grc, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# wateratm2lndbulk_inst%volr_grc(:) = wateratm2lndbulk_inst%volr_grc(:) * (ldomain%area(:) * 1.e6_r8) +!!!# else +!!!# wateratm2lndbulk_inst%volr_grc(:) = 0._r8 +!!!# end if +!!!# +!!!# if (rof_prognostic) then +!!!# call state_getimport(importState, 'Flrr_volrmch', bounds, output=wateratm2lndbulk_inst%volrmch_grc, rc=rc ) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# wateratm2lndbulk_inst%volrmch_grc(:) = wateratm2lndbulk_inst%volrmch_grc(:) * (ldomain%area(:) * 1.e6_r8) +!!!# else +!!!# wateratm2lndbulk_inst%volrmch_grc(:) = 0._r8 +!!!# end if +!!!# +!!!# !-------------------------- +!!!# ! Land-ice (glc) fields +!!!# !-------------------------- +!!!# +!!!# if (glc_present) then +!!!# ! We could avoid setting these fields if glc_present is .false., if that would +!!!# ! help with performance. (The downside would be that we wouldn't have these fields +!!!# ! available for diagnostic purposes or to force a later T compset with dlnd.) +!!!# +!!!# do num = 0,glc_nec +!!!# call state_getimport(importState, 'Sg_ice_covered_elev', bounds, frac_grc(:,num), ungridded_index=num+1, rc=rc) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# call state_getimport(importState, 'Sg_topo_elev' , bounds, topo_grc(:,num), ungridded_index=num+1, rc=rc) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# call state_getimport(importState, 'Flgg_hflx_elev' , bounds, hflx_grc(:,num), ungridded_index=num+1, rc=rc) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# end do +!!!# call state_getimport(importState, 'Sg_icemask' , bounds, icemask_grc, rc=rc) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# call state_getimport(importState, 'Sg_icemask_coupled_fluxes', bounds, icemask_grc, rc=rc) +!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return +!!!# +!!!# call glc2lnd_inst%set_glc2lnd_fields_nuopc( bounds, glc_present, & +!!!# frac_grc, topo_grc, hflx_grc, icemask_grc, icemask_coupled_fluxes_grc) +!!!# end if + + !-------------------------- + ! Derived quantities + !-------------------------- + + do g = begg, endg + forc_t = atm2lnd_inst%forc_t_not_downscaled_grc(g) + forc_q = wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) + forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) + + atm2lnd_inst%forc_hgt_u_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of wind [m] + atm2lnd_inst%forc_hgt_t_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of temperature [m] + atm2lnd_inst%forc_hgt_q_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of humidity [m] + + atm2lnd_inst%forc_vp_grc(g) = forc_q * forc_pbot / (0.622_r8 + 0.378_r8 * forc_q) + + atm2lnd_inst%forc_rho_not_downscaled_grc(g) = & + (forc_pbot - 0.378_r8 * atm2lnd_inst%forc_vp_grc(g)) / (rair * forc_t) + + atm2lnd_inst%forc_po2_grc(g) = o2_molar_const * forc_pbot + + atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv * 1.e-6_r8 * forc_pbot + + atm2lnd_inst%forc_wind_grc(g) = sqrt(atm2lnd_inst%forc_u_grc(g)**2 + atm2lnd_inst%forc_v_grc(g)**2) + + atm2lnd_inst%forc_solar_grc(g) = atm2lnd_inst%forc_solad_grc(g,1) + atm2lnd_inst%forc_solai_grc(g,1) + & + atm2lnd_inst%forc_solad_grc(g,2) + atm2lnd_inst%forc_solai_grc(g,2) + + wateratm2lndbulk_inst%forc_rain_not_downscaled_grc(g) = forc_rainc(g) + forc_rainl(g) + wateratm2lndbulk_inst%forc_snow_not_downscaled_grc(g) = forc_snowc(g) + forc_snowl(g) + + if (forc_t > SHR_CONST_TKFRZ) then + e = esatw(tdc(forc_t)) + else + e = esati(tdc(forc_t)) + end if + qsat = 0.622_r8*e / (forc_pbot - 0.378_r8*e) + + ! modify specific humidity if precip occurs + if (1==2) then + if ((forc_rainc(g)+forc_rainl(g)) > 0._r8) then + forc_q = 0.95_r8*qsat + !forc_q = qsat + wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = forc_q + endif + endif + + wateratm2lndbulk_inst%forc_rh_grc(g) = 100.0_r8*(forc_q / qsat) + wateratm2lndbulk_inst%volr_grc(g) = 0._r8 + wateratm2lndbulk_inst%volrmch_grc(g) = 0._r8 + end do + + !-------------------------- + ! Error checks + !-------------------------- + + ! Check that solar, specific-humidity and LW downward aren't negative + do g = begg,endg + if ( atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) <= 0.0_r8 ) then + call shr_sys_abort( subname//& + ' ERROR: Longwave down sent from the atmosphere model is negative or zero' ) + end if + if ( (atm2lnd_inst%forc_solad_grc(g,1) < 0.0_r8) .or. & + (atm2lnd_inst%forc_solad_grc(g,2) < 0.0_r8) .or. & + (atm2lnd_inst%forc_solai_grc(g,1) < 0.0_r8) .or. & + (atm2lnd_inst%forc_solai_grc(g,2) < 0.0_r8) ) then + call shr_sys_abort( subname//& + ' ERROR: One of the solar fields (indirect/diffuse, vis or near-IR)'// & + ' from the atmosphere model is negative or zero' ) + end if + if ( wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) < 0.0_r8 )then + call shr_sys_abort( subname//& + ' ERROR: Bottom layer specific humidty sent from the atmosphere model is less than zero' ) + end if + end do + + ! Make sure relative humidity is properly bounded + ! atm2lnd_inst%forc_rh_grc(g) = min( 100.0_r8, atm2lnd_inst%forc_rh_grc(g) ) + ! atm2lnd_inst%forc_rh_grc(g) = max( 0.0_r8, atm2lnd_inst%forc_rh_grc(g) ) + + end subroutine import_fields + +!============================================================================== + + subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & + waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) + + !------------------------------- + ! Pack the export state + !------------------------------- + + use Waterlnd2atmBulkType , only: waterlnd2atmbulk_type + + ! input/output variables + type(ESMF_GridComp) :: gcomp + type(bounds_type) , intent(in) :: bounds ! bounds + logical , intent(in) :: glc_present + logical , intent(in) :: rof_prognostic + type(waterlnd2atmbulk_type) , intent(inout) :: waterlnd2atmbulk_inst + type(lnd2atm_type) , intent(inout) :: lnd2atm_inst ! land to atmosphere exchange data type + type(lnd2glc_type) , intent(inout) :: lnd2glc_inst ! land to atmosphere exchange data type + integer , intent(out) :: rc + + !type(datawrapper) :: wrap2 + ! local variables + type(ESMF_State) :: exportState + integer :: i, g, num + real(r8) :: array(bounds%begg:bounds%endg) + character(len=*), parameter :: subname='(lnd_import_export:export_fields)' + !--------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Get export state + !call NUOPC_ModelGet(gcomp, exportState=exportState, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get export state (ESMF) + call ESMF_GridCompGet(gcomp, exportState=exportState, rc=rc) ! do we need the clock now? + !call ESMF_GridCompGet(gcomp, exportState, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ----------------------- + ! output to mediator + ! ----------------------- + + call state_setexport(exportState, 'Sl_lfrin', bounds, input=ldomain%frac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ----------------------- + ! output to atm + ! ----------------------- + + call state_setexport(exportState, 'Sl_t', bounds, input=lnd2atm_inst%t_rad_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Sl_snowh', bounds, & + input=waterlnd2atmbulk_inst%h2osno_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Sl_avsdr', bounds, input=lnd2atm_inst%albd_grc(bounds%begg:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Sl_anidr', bounds, input=lnd2atm_inst%albd_grc(bounds%begg:,2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Sl_avsdf', bounds, input=lnd2atm_inst%albi_grc(bounds%begg:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Sl_anidf', bounds, input=lnd2atm_inst%albi_grc(bounds%begg:,2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Sl_tref', bounds, input=lnd2atm_inst%t_ref2m_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Sl_qref', bounds, input=waterlnd2atmbulk_inst%q_ref2m_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Sl_u10', bounds, input=lnd2atm_inst%u_ref10m_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Fall_taux', bounds, input=lnd2atm_inst%taux_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Fall_tauy', bounds, input=lnd2atm_inst%tauy_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Fall_lat', bounds, input=lnd2atm_inst%eflx_lh_tot_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Fall_sen', bounds, input=lnd2atm_inst%eflx_sh_tot_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Fall_lwup', bounds, input=lnd2atm_inst%eflx_lwrad_out_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Fall_evap', bounds, input=waterlnd2atmbulk_inst%qflx_evap_tot_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Fall_swnet', bounds, input=lnd2atm_inst%fsa_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,1), & + minus=.true., ungridded_index=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,2), & + minus=.true., ungridded_index=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,3), & + minus=.true., ungridded_index=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,4), & + minus=.true., ungridded_index=4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Fall_methane', bounds, input=lnd2atm_inst%flux_ch4_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Sl_ram1', bounds, input=lnd2atm_inst%ram1_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Sl_fv', bounds, input=lnd2atm_inst%fv_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Sl_soilw', bounds, & + input=waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! co2 from land + if (flds_co2b .or. flds_co2c) then + call state_setexport(exportState, 'Fall_fco2_lnd', bounds, lnd2atm_inst%net_carbon_exchange_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! dry dep velocities + do num = 1, drydep_nflds + call state_setexport(exportState, 'Sl_ddvel', bounds, input=lnd2atm_inst%ddvel_grc(:,num), & + ungridded_index=num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + ! MEGAN VOC emis fluxes + do num = 1, shr_megan_mechcomps_n + call state_setexport(exportState, 'Fall_voc', bounds, input=lnd2atm_inst%flxvoc_grc(:,num), minus=.true., & + ungridded_index=num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + ! fire emis fluxes + do num = 1, emis_nflds + call state_setexport(exportState, 'Fall_fire', bounds, input=lnd2atm_inst%fireflx_grc(:,num), minus=.true., & + ungridded_index=num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + if (emis_nflds > 0) then + call state_setexport(exportState, 'Sl_fztopo', bounds, input=lnd2atm_inst%fireztop_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + ! sign convention is positive downward with hierarchy of atm/glc/lnd/rof/ice/ocn. + ! i.e. water sent from land to rof is positive + + ! ----------------------- + ! output to river + ! ----------------------- + + ! surface runoff is the sum of qflx_over, qflx_h2osfc_surf + ! do g = bounds%begg,bounds%endg + ! array(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) + ! end do + call state_setexport(exportState, 'Flrl_rofsur', bounds, input=waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain + do g = bounds%begg,bounds%endg + array(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) + end do + call state_setexport(exportState, 'Flrl_rofsub', bounds, input=array, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! qgwl sent individually to coupler + call state_setexport(exportState, 'Flrl_rofgwl', bounds, input=waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ice sent individually to coupler + call state_setexport(exportState, 'Flrl_rofi', bounds, input=waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! irrigation flux to be removed from main channel storage (negative) + call state_setexport(exportState, 'Flrl_irrig', bounds, input=waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ----------------------- + ! output to glc + ! ----------------------- + + ! We could avoid setting these fields if glc_present is .false., if that would + ! help with performance. (The downside would be that we wouldn't have these fields + ! available for diagnostic purposes or to force a later T compset with dlnd.) + + do num = 0,glc_nec + call state_setexport(exportState, 'Sl_tsrf_elev', bounds, input=lnd2glc_inst%tsrf_grc(:,num), & + ungridded_index=num+1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'Sl_topo_elev', bounds, input=lnd2glc_inst%topo_grc(:,num), & + ungridded_index=num+1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'Flgl_qice_elev', bounds, input=lnd2glc_inst%qice_grc(:,num), & + ungridded_index=num+1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + end subroutine export_fields + + !=============================================================================== + + subroutine fldlist_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 + integer, optional, intent(in) :: ungridded_lbound + integer, optional, intent(in) :: ungridded_ubound + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(lnd_import_export:fldlist_add)' + !------------------------------------------------------------------------------- + + ! Set up a list of field information + + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) + 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 fldlist_add + + !=============================================================================== + + subroutine fldlist_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, ESMF_FieldBundle + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleAdd, ESMF_StateAdd + use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + type(fld_list_type) , intent(in) :: fldList(:) + integer , intent(in) :: numflds + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(in) :: flds_scalar_num + character(len=*) , intent(in) :: tag + type(ESMF_Mesh) , intent(in) :: mesh + integer , intent(inout) :: rc + + ! local variables + integer :: n + type(ESMF_Field) :: field + character(len=80) :: stdname + character(len=*),parameter :: subname='(lnd_import_export:fldlist_realize)' + type (ESMF_FieldBundle) :: l2c_fb , c2l_fb + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + +!! do n = 1, numflds +!! stdname = fldList(n)%stdname +!! 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) +!! ! 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 +!! ! Create the field +!! 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 +!! call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & +!! ESMF_LOGMSG_INFO) +!! endif +!! +!! ! NOW call NUOPC_Realize +!! call NUOPC_Realize(state, field=field, rc=rc) +!! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return +!! else +!! if (stdname /= trim(flds_scalar_name)) then +!! call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(stdname) // " is not connected.", & +!! 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 +!! end if +!! end do + + + + + + + l2c_fb = ESMF_FieldBundleCreate (name="l2c_fb", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + do n = 1, numflds + stdname = fldList(n)%stdname + 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) + ! 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 + ! Create the field + 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 + call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & + ESMF_LOGMSG_INFO) + endif + call ESMF_FieldBundleAdd(l2c_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_StateAdd(state, (/l2c_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + if (masterproc .and. debug > 0) then + write(iulog,F01)' lnd2atm_l_state is filld with l2c_fb field bundle!' + end if + end do + + + + + + + + + + + contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + 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 + integer , intent(in) :: flds_scalar_num + integer , intent(inout) :: rc + + ! local variables + type(ESMF_Distgrid) :: distgrid + type(ESMF_Grid) :: grid + character(len=*), parameter :: subname='(lnd_import_export:SetScalarField)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! create a DistGrid with a single index space element, which gets mapped onto DE 0. + distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + grid = ESMF_GridCreate(distgrid, rc=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/), gridToFieldMap=(/2/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + end subroutine SetScalarField + + end subroutine fldlist_realize + + !=============================================================================== + + subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) + + use ESMF , only : ESMF_Field, ESMF_FieldBundle + use ESMF , only : ESMF_FieldBundleGet + ! ---------------------------------------------- + ! Map import state field to output array + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + type(bounds_type) , intent(in) :: bounds + character(len=*) , intent(in) :: fldname + real(r8) , intent(out) :: output(bounds%begg:bounds%endg) + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: g, i,n + + integer :: fieldcount + + real(R8), pointer :: fldptr1d(:) + real(R8), pointer :: fldptr2d(:,:) + type(ESMF_StateItem_Flag) :: itemFlag + character(len=cs) :: cvalue + character(len=*), parameter :: subname='(lnd_import_export:state_getimport)' + + type (ESMF_FieldBundle):: field + type(ESMF_Field) :: lfield + type (ESMF_FieldBundle):: fieldBundle + logical :: isPresent + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + ! Determine if field with name fldname exists in state + + !call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! print out what is in our state??? + if (masterproc .and. debug > 0) then + write(iulog,F01)' Show me what is in the state? for '//trim(fldname) + call ESMF_StatePrint(state, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Determine if fieldbundle exists in state + call ESMF_StateGet(state, "c2l_fb", itemFlag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) + + ! if fieldbundle exists then create output array - else do nothing + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + ! Get the field bundle??? + call ESMF_StateGet(state, "c2l_fb", fieldBundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//'c2l_fb found and now ... getting '//trim(fldname), ESMF_LOGMSG_INFO) + call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=field, isPresent=isPresent, rc=rc) + !call ESMF_FieldBundleGet(fieldBundle,field=field, rc=rc) + !call ESMF_FieldBundleGet(fieldBundle, fieldCount=fieldCount, rc=rc) + + + ! Now for error checking we can put ... if (isPresent...) + ! get field pointer + if (present(ungridded_index)) then + write(cvalue,*) ungridded_index + call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname)//" index "//trim(cvalue), & + ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname),ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! determine output array + if (present(ungridded_index)) then + if (gridToFieldMap == 1) then + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + output(g) = fldptr2d(n,ungridded_index) + end do + else if (gridToFieldMap == 2) then + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + output(g) = fldptr2d(ungridded_index,n) + end do + end if + else + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + output(g) = fldptr1d(n) + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + write(iulog,F01)' n, g , fldptr1d(n) '//trim(fldname)//' = ',n, g, fldptr1d(n) + end if + end do + end if + + ! write debug output if appropriate + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + do g = bounds%begg,bounds%endg + i = 1 + g - bounds%begg + write(iulog,F01)'import: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,output(g) + end do + end if + + ! check for nans + call check_for_nans(output, trim(fldname), bounds%begg) + end if + + end subroutine state_getimport + + !=============================================================================== + + subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index, rc) + + ! ---------------------------------------------- + ! Map input array to export state field + ! ---------------------------------------------- + + use shr_const_mod, only : fillvalue=>SHR_CONST_SPVAL + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + type(bounds_type) , intent(in) :: bounds + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: input(bounds%begg:bounds%endg) + logical, optional , intent(in) :: minus + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: g, i, n + real(R8), pointer :: fldptr1d(:) + real(R8), pointer :: fldptr2d(:,:) + character(len=cs) :: cvalue + type(ESMF_StateItem_Flag) :: itemFlag + character(len=*), parameter :: subname='(lnd_import_export:state_setexport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine if field with name fldname exists in state + call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) + if (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 + if (present(ungridded_index)) then + call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname)//" index "//trim(cvalue), & + ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname), ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! TODO: if fillvalue = shr_const_spval the snowhl sent to the atm will have the spval over some points + ! rather than 0 - this is very odd and needs to be understood + ! fldptr(:) = fillvalue + + ! determine output array + if (present(ungridded_index)) then + if (gridToFieldMap == 1) then + fldptr2d(:,ungridded_index) = 0._r8 + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + fldptr2d(n,ungridded_index) = input(g) + end do + if (present(minus)) then + fldptr2d(:,ungridded_index) = -fldptr2d(:,ungridded_index) + end if + else if (gridToFieldMap == 2) then + fldptr2d(ungridded_index,:) = 0._r8 + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + fldptr2d(ungridded_index,n) = input(g) + end do + if (present(minus)) then + fldptr2d(ungridded_index,:) = -fldptr2d(ungridded_index,:) + end if + end if + else + fldptr1d(:) = 0._r8 + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + fldptr1d(n) = input(g) + end do + if (present(minus)) then + fldptr1d(:) = -fldptr1d(:) + end if + end if + + ! write debug output if appropriate + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + do g = bounds%begg,bounds%endg + i = 1 + g - bounds%begg + write(iulog,F01)'export: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,input(g) + end do + end if + + ! check for nans + call check_for_nans(input, trim(fldname), bounds%begg) + end if + + end subroutine state_setexport + + !=============================================================================== + + subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) + + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + + use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag + use ESMF , only : ESMF_FieldBundle + use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet + use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE + use ESMF , only : ESMF_FieldBundleGet + + ! input/output variables + type(ESMF_State), intent(in) :: State + character(len=*), intent(in) :: fldname + real(R8), pointer, optional , intent(out) :: fldptr1d(:) + real(R8), pointer, optional , intent(out) :: fldptr2d(:,:) + integer, intent(out) :: rc + + ! local variables + type(ESMF_FieldStatus_Flag) :: status + type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh + integer :: nnodes, nelements + character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' + + type(ESMF_StateItem_Flag) :: itemFlag + type(ESMF_FieldBundle) :: fieldBundle + logical :: isPresent + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine if this field bundle exist.... + ! TODO: combine the error checks.... + + call ESMF_StateGet(state, "c2l_fb", itemFlag, rc=rc) + !call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get the fieldbundle from state... + call ESMF_StateGet(state, "c2l_fb", fieldBundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + + call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, isPresent=isPresent, rc=rc) + !call ESMF_FieldBundleGet(fieldBundle,trim(fldname), lfield, isPresent, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(lfield, status=status, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + 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 (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (nnodes == 0 .and. nelements == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + if (present(fldptr1d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc .and. debug > 0) then + write(iulog,F01)' in '//trim(subname)//'fldptr1d for '//trim(fldname)//' is ' + end if + !print *, "FLDPTR1D is" + !print *, FLDPTR1d + else if (present(fldptr2d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") + end if + endif ! status + + end subroutine state_getfldptr + + !=============================================================================== + + subroutine check_for_nans(array, fname, begg) + + ! input/output variables + real(r8) , intent(in) :: array(:) + character(len=*) , intent(in) :: fname + integer , intent(in) :: begg +! + ! local variables + integer :: i + !------------------------------------------------------------------------------- + + ! Check if any input from mediator or output to mediator is NaN + + if (any(isnan(array))) then + write(iulog,*) '# of NaNs = ', count(isnan(array)) + write(iulog,*) 'Which are NaNs = ', isnan(array) + do i = 1, size(array) + if (isnan(array(i))) then + write(iulog,*) "NaN found in field ", trim(fname), ' at gridcell index ',begg+i-1 + end if + end do + call shr_sys_abort(' ERROR: One or more of the output from CLM to the coupler are NaN ' ) + end if + end subroutine check_for_nans + +end module lnd_import_export diff --git a/src/cpl/lilac/lnd_shr_methods.F90 b/src/cpl/lilac/lnd_shr_methods.F90 new file mode 100644 index 0000000000..d0fda756fa --- /dev/null +++ b/src/cpl/lilac/lnd_shr_methods.F90 @@ -0,0 +1,794 @@ +module lnd_shr_methods + + use ESMF , only : operator(<), operator(/=), operator(+) + use ESMF , only : operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR, ESMF_MAXSTR + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_State, ESMF_StateGet + use ESMF , only : ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet + use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldStatus_Flag + use ESMF , only : ESMF_Mesh, ESMF_MeshGet + use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE + use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet + use ESMF , only : ESMF_ClockPrint, ESMF_ClockAdvance + use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet + use ESMF , only : ESMF_Calendar, ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN + use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMGetCurrent + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit + + implicit none + private + + public :: memcheck + public :: log_clock_advance + public :: state_getscalar + public :: state_setscalar + public :: state_diagnose + public :: alarmInit + public :: chkerr + + private :: timeInit + private :: field_getfldptr + + ! Clock and alarm options + character(len=*), private, parameter :: & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNStep = "nstep" , & + optNSeconds = "nseconds" , & + optNSecond = "nsecond" , & + optNMinutes = "nminutes" , & + optNMinute = "nminute" , & + optNHours = "nhours" , & + optNHour = "nhour" , & + optNDays = "ndays" , & + optNDay = "nday" , & + optNMonths = "nmonths" , & + optNMonth = "nmonth" , & + optNYears = "nyears" , & + optNYear = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & + optIfdays0 = "ifdays0" + + ! Module data + integer, parameter :: SecPerDay = 86400 ! Seconds per day + integer, parameter :: memdebug_level=1 + character(len=1024) :: msgString + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine memcheck(string, level, mastertask) + + ! input/output variables + character(len=*) , intent(in) :: string + integer , intent(in) :: level + logical , intent(in) :: mastertask + + ! local variables + integer :: ierr + integer, external :: GPTLprint_memusage + !----------------------------------------------------------------------- + + if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + ierr = GPTLprint_memusage(string) + endif + + end subroutine memcheck + +!=============================================================================== + + subroutine log_clock_advance(clock, component, logunit, rc) + + ! input/output variables + type(ESMF_Clock) :: clock + character(len=*) , intent(in) :: component + integer , intent(in) :: logunit + integer , intent(out) :: rc + + ! local variables + character(len=CL) :: cvalue, prestring + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + write(prestring, *) "------>Advancing ",trim(component)," from: " + call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, preString=trim(prestring), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & + preString="--------------------------------> to: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + end subroutine log_clock_advance + +!=============================================================================== + + subroutine 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 + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State), intent(in) :: state + integer, intent(in) :: scalar_id + real(r8), intent(out) :: scalar_value + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask, ierr, len + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + real(r8), pointer :: farrayptr(:,:) + real(r8) :: tmp(1) + character(len=*), parameter :: subname='(state_getscalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//'after VMGetCurrent', ESMF_LOGMSG_INFO) + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//'after VMGet', ESMF_LOGMSG_INFO) + + call ESMF_LogWrite(subname//'before ESMF_StateGet', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//'or field is '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//'after ESMF_StateGet', ESMF_LOGMSG_INFO) + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (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 = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + tmp(:) = farrayptr(scalar_id,:) + endif + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + scalar_value = tmp(1) + + end subroutine state_getscalar + +!================================================================================ + + subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + + ! ---------------------------------------------- + ! Set scalar data from State for a particular name + ! ---------------------------------------------- + + ! 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 + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask + type(ESMF_Field) :: lfield + type(ESMF_VM) :: vm + real(r8), pointer :: farrayptr(:,:) + character(len=*), parameter :: subname='(state_setscalar)' + ! ---------------------------------------------- + + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//'after VMGetCurrent', ESMF_LOGMSG_INFO) + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + call ESMF_LogWrite(subname//'after VMGet', ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + print *, trim(flds_scalar_name) + + call ESMF_LogWrite(subname//'before ESMF_StateSet', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//'itemName:'//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + !call ESMF_LogWrite(subname//'State: '//State, ESMF_LOGMSG_INFO) + !print *, 'itemName:', trim(flds_scalar_name) + !print *, 'lfield:', lfield + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_LogWrite(subname//'before FieldGet', ESMF_LOGMSG_INFO) + !print *, 'lfield:', lfield + !print *, 'this farrayptr is ', farrayptr + call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) + if (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) + rc = ESMF_FAILURE + return + endif + farrayptr(scalar_id,1) = scalar_value + endif + + end subroutine state_setscalar + +!=============================================================================== + + subroutine state_diagnose(State, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + type(ESMf_Field) :: lfield + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(r8), pointer :: dataPtr1d(:) + real(r8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(state_diagnose)' + ! ---------------------------------------------- + + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + + call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" + endif + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," 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) + enddo + + deallocate(lfieldnamelist) + + end subroutine state_diagnose + +!=============================================================================== + + subroutine 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 + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_Field) , intent(in) :: field + real(r8), pointer , intent(inout), optional :: fldptr1(:) + real(r8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out) , optional :: rank + logical , intent(in) , optional :: abort + integer , intent(out) , optional :: rc + + ! local variables + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_FieldStatus_Flag) :: status + type(ESMF_Mesh) :: lmesh + integer :: lrank, nnodes, nelements + logical :: labort + character(len=*), parameter :: subname='(field_getfldptr)' + ! ---------------------------------------------- + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + labort = .true. + if (present(abort)) then + labort = abort + endif + lrank = -99 + + call ESMF_FieldGet(field, status=status, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + lrank = 0 + if (labort) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + endif + else + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nnodes == 0 .and. nelements == 0) lrank = 0 + else + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif ! geomtype + + if (lrank == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & + 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 = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) + if (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 = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) + if (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 = ESMF_FAILURE + return + endif + + endif ! status + + if (present(rank)) then + rank = lrank + endif + + end subroutine field_getfldptr + +!=============================================================================== + + subroutine alarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! Setup an alarm in a clock + ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm + ! time. If you send an arbitrary but proper ringtime from the + ! past and the ring interval, the alarm will always go off on the + ! next clock advance and this will cause serious problems. Even + ! if it makes sense to initialize an alarm with some reference + ! time and the alarm interval, that reference time has to be + ! advance forward to be >= the current time. In the logic below + ! we set an appropriate "NextAlarm" and then we make sure to + ! advance it properly based on the ring interval. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , optional , intent(in) :: opt_tod ! alarm tod (sec) + type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time + character(len=*) , optional , intent(in) :: alarmname ! alarm name + integer , intent(inout) :: rc ! Return code + + ! local variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! time info + character(len=64) :: lalarmname ! local alarm name + logical :: update_nextalarm ! update next alarm + type(ESMF_Time) :: CurrTime ! Current Time + type(ESMF_Time) :: NextAlarm ! Next restart alarm time + type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval + integer :: sec + character(len=*), parameter :: subname = '(set_alarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lalarmname = 'alarm_unknown' + if (present(alarmname)) lalarmname = trim(alarmname) + ltod = 0 + if (present(opt_tod)) ltod = opt_tod + lymd = -1 + if (present(opt_ymd)) lymd = opt_ymd + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! initial guess of next alarm, this will be updated below + if (present(RefTime)) then + NextAlarm = RefTime + else + NextAlarm = CurrTime + endif + + ! Determine calendar + call ESMF_ClockGet(clock, calendar=cal) + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optDate) + if (.not. present(opt_ymd)) then + call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + end if + if (lymd < 0 .or. ltod < 0) then + call shr_sys_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call timeInit(NextAlarm, lymd, cal, ltod, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + end if + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNSteps) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNStep) + if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') + if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSecond) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinute) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHour) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDay) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonth) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNYears) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNYear) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case default + call shr_sys_abort(subname//'unknown option '//trim(option)) + + end select + + ! -------------------------------------------------------------------------------- + ! --- AlarmInterval and NextAlarm should be set --- + ! -------------------------------------------------------------------------------- + + ! --- advance Next Alarm so it won't ring on first timestep for + ! --- most options above. go back one alarminterval just to be careful + + if (update_nextalarm) then + NextAlarm = NextAlarm - AlarmInterval + do while (NextAlarm <= CurrTime) + NextAlarm = NextAlarm + AlarmInterval + enddo + endif + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & + ringInterval=AlarmInterval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end subroutine alarmInit + +!=============================================================================== + + subroutine timeInit( Time, ymd, cal, tod, rc) + + ! Create the ESMF_Time object corresponding to the given input time, + ! given in YMD (Year Month Day) and TOD (Time-of-day) format. + ! Set the time by an integer as YYYYMMDD and integer seconds in the day + + ! input/output parameters: + type(ESMF_Time) , intent(inout) :: Time ! ESMF time + integer , intent(in) :: ymd ! year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar + integer , intent(in) :: tod ! time of day in seconds + integer , intent(out) :: rc + + ! local variables + integer :: year, mon, day ! year, month, day as integers + integer :: tdate ! temporary date + integer :: date ! coded-date (yyyymmdd) + character(len=*), parameter :: subname='(timeInit)' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if ( (ymd < 0) .or. (tod < 0) .or. (tod > SecPerDay) )then + call shr_sys_abort( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) + end if + + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) year = -year + mon = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + + call ESMF_TimeSet( Time, yy=year, mm=mon, dd=day, s=tod, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end subroutine timeInit + +!=============================================================================== + + logical function chkerr(rc, line, file) + + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + + integer :: lrc + + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif + end function chkerr + + + + + ! FROM + +end module lnd_shr_methods diff --git a/src/cpl/lilac/shr_utils_mod.F90 b/src/cpl/lilac/shr_utils_mod.F90 new file mode 100644 index 0000000000..90aba85801 --- /dev/null +++ b/src/cpl/lilac/shr_utils_mod.F90 @@ -0,0 +1,47 @@ +module shr_utils_mod + + use shr_sys_mod, only : shr_sys_abort + implicit none + private + + public :: shr_utils_ChkErr + + character(*), parameter :: u_FILE_u = __FILE__ + +!========================================================= +contains +!========================================================= + + logical function shr_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 + + ! input/output arguments + integer , intent(in) :: rc + integer , intent(in) :: line + character(len=*) , intent(in) :: file + logical, optional , intent(in) :: mpierr + + ! local variables + character(MPI_MAX_ERROR_STRING) :: lstring + integer :: dbrc, lrc, len, ierr + !------------------------------------------ + + shr_utils_ChkErr = .false. + lrc = rc + if (present(mpierr) .and. mpierr) then + if (rc == MPI_SUCCESS) return + call MPI_ERROR_STRING(rc, lstring, len, ierr) + call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file, rc=dbrc) + lrc = ESMF_FAILURE + endif + + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + shr_utils_ChkErr = .true. + endif + + end function shr_utils_ChkErr + +end module shr_utils_mod diff --git a/src/cpl/mct/clm_cpl_indices.F90 b/src/cpl/mct/clm_cpl_indices.F90 new file mode 100644 index 0000000000..525b709cc6 --- /dev/null +++ b/src/cpl/mct/clm_cpl_indices.F90 @@ -0,0 +1,330 @@ +module clm_cpl_indices + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing the indices for the fields passed between CLM and + ! the driver. Includes the River Transport Model fields (RTM) and the + ! fields needed by the land-ice component (sno). + ! + ! !USES: + + use shr_sys_mod, only : shr_sys_abort + implicit none + + SAVE + private ! By default make data private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: clm_cpl_indices_set ! Set the coupler indices + ! + ! !PUBLIC DATA MEMBERS: + ! + integer , public :: glc_nec ! number of elevation classes for glacier_mec landunits + ! (from coupler) - must equal maxpatch_glcmec from namelist + + ! lnd -> drv (required) + + integer, public ::index_l2x_Flrl_rofsur ! lnd->rtm input liquid surface fluxes + integer, public ::index_l2x_Flrl_rofgwl ! lnd->rtm input liquid gwl fluxes + integer, public ::index_l2x_Flrl_rofsub ! lnd->rtm input liquid subsurface fluxes + integer, public ::index_l2x_Flrl_rofi ! lnd->rtm input frozen fluxes + integer, public ::index_l2x_Flrl_irrig ! irrigation withdrawal + + integer, public ::index_l2x_Sl_t ! temperature + integer, public ::index_l2x_Sl_tref ! 2m reference temperature + integer, public ::index_l2x_Sl_qref ! 2m reference specific humidity + integer, public ::index_l2x_Sl_avsdr ! albedo: direct , visible + integer, public ::index_l2x_Sl_anidr ! albedo: direct , near-ir + integer, public ::index_l2x_Sl_avsdf ! albedo: diffuse, visible + integer, public ::index_l2x_Sl_anidf ! albedo: diffuse, near-ir + integer, public ::index_l2x_Sl_snowh ! snow height + integer, public ::index_l2x_Sl_u10 ! 10m wind + integer, public ::index_l2x_Sl_ddvel ! dry deposition velocities (optional) + integer, public ::index_l2x_Sl_fv ! friction velocity + integer, public ::index_l2x_Sl_ram1 ! aerodynamical resistance + integer, public ::index_l2x_Sl_soilw ! volumetric soil water + integer, public ::index_l2x_Fall_taux ! wind stress, zonal + integer, public ::index_l2x_Fall_tauy ! wind stress, meridional + integer, public ::index_l2x_Fall_lat ! latent heat flux + integer, public ::index_l2x_Fall_sen ! sensible heat flux + integer, public ::index_l2x_Fall_lwup ! upward longwave heat flux + integer, public ::index_l2x_Fall_evap ! evaporation water flux + integer, public ::index_l2x_Fall_swnet ! heat flux shortwave net + integer, public ::index_l2x_Fall_fco2_lnd ! co2 flux **For testing set to 0 + integer, public ::index_l2x_Fall_flxdst1 ! dust flux size bin 1 + integer, public ::index_l2x_Fall_flxdst2 ! dust flux size bin 2 + integer, public ::index_l2x_Fall_flxdst3 ! dust flux size bin 3 + integer, public ::index_l2x_Fall_flxdst4 ! dust flux size bin 4 + integer, public ::index_l2x_Fall_flxvoc ! MEGAN fluxes + integer, public ::index_l2x_Fall_flxfire ! Fire fluxes + integer, public ::index_l2x_Sl_ztopfire ! Top of fire emissions (m) + + ! In the following, index 0 is bare land, other indices are glc elevation classes + integer, allocatable, public ::index_l2x_Sl_tsrf(:) ! glc MEC temperature + integer, allocatable, public ::index_l2x_Sl_topo(:) ! glc MEC topo height + integer, allocatable, public ::index_l2x_Flgl_qice(:) ! glc MEC ice flux + + integer, public ::index_x2l_Sa_methane + integer, public ::index_l2x_Fall_methane + + integer, public :: nflds_l2x = 0 + + ! drv -> lnd (required) + + integer, public ::index_x2l_Sa_z ! bottom atm level height + integer, public ::index_x2l_Sa_topo ! atm surface height (m) + integer, public ::index_x2l_Sa_u ! bottom atm level zon wind + integer, public ::index_x2l_Sa_v ! bottom atm level mer wind + integer, public ::index_x2l_Sa_ptem ! bottom atm level pot temp + integer, public ::index_x2l_Sa_shum ! bottom atm level spec hum + integer, public ::index_x2l_Sa_pbot ! bottom atm level pressure + integer, public ::index_x2l_Sa_tbot ! bottom atm level temp + integer, public ::index_x2l_Faxa_lwdn ! downward lw heat flux + integer, public ::index_x2l_Faxa_rainc ! prec: liquid "convective" + integer, public ::index_x2l_Faxa_rainl ! prec: liquid "large scale" + integer, public ::index_x2l_Faxa_snowc ! prec: frozen "convective" + integer, public ::index_x2l_Faxa_snowl ! prec: frozen "large scale" + integer, public ::index_x2l_Faxa_swndr ! sw: nir direct downward + integer, public ::index_x2l_Faxa_swvdr ! sw: vis direct downward + integer, public ::index_x2l_Faxa_swndf ! sw: nir diffuse downward + integer, public ::index_x2l_Faxa_swvdf ! sw: vis diffuse downward + integer, public ::index_x2l_Sa_co2prog ! bottom atm level prognostic co2 + integer, public ::index_x2l_Sa_co2diag ! bottom atm level diagnostic co2 + integer, public ::index_x2l_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition + integer, public ::index_x2l_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition + integer, public ::index_x2l_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition + integer, public ::index_x2l_Faxa_ocphidry ! flux: Organic Carbon hydrophilic dry deposition + integer, public ::index_x2l_Faxa_ocphodry ! flux: Organic Carbon hydrophobic dry deposition + integer, public ::index_x2l_Faxa_ocphiwet ! flux: Organic Carbon hydrophilic dry deposition + integer, public ::index_x2l_Faxa_dstwet1 ! flux: Size 1 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstwet2 ! flux: Size 2 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstwet3 ! flux: Size 3 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstwet4 ! flux: Size 4 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstdry1 ! flux: Size 1 dust -- dry deposition + integer, public ::index_x2l_Faxa_dstdry2 ! flux: Size 2 dust -- dry deposition + integer, public ::index_x2l_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition + integer, public ::index_x2l_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition + + integer, public ::index_x2l_Faxa_nhx ! flux nhx from atm + integer, public ::index_x2l_Faxa_noy ! flux noy from atm + + integer, public ::index_x2l_Flrr_flood ! rtm->lnd rof flood flux + integer, public ::index_x2l_Flrr_volr ! rtm->lnd rof volr total volume + integer, public ::index_x2l_Flrr_volrmch ! rtm->lnd rof volr main channel volume + + ! In the following, index 0 is bare land, other indices are glc elevation classes + integer, allocatable, public ::index_x2l_Sg_ice_covered(:) ! Fraction of glacier from glc model + integer, allocatable, public ::index_x2l_Sg_topo(:) ! Topo height from glc model + integer, allocatable, public ::index_x2l_Flgg_hflx(:) ! Heat flux from glc model + + integer, public ::index_x2l_Sg_icemask + integer, public ::index_x2l_Sg_icemask_coupled_fluxes + + integer, public :: nflds_x2l = 0 + + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine clm_cpl_indices_set( ) + ! + ! !DESCRIPTION: + ! Set the coupler indices needed by the land model coupler + ! interface. + ! + ! !USES: + use seq_flds_mod , only: seq_flds_x2l_fields, seq_flds_l2x_fields + use mct_mod , only: mct_aVect, mct_aVect_init, mct_avect_indexra + use mct_mod , only: mct_aVect_clean, mct_avect_nRattr + use seq_drydep_mod , only: drydep_fields_token, lnd_drydep + use shr_megan_mod , only: shr_megan_fields_token, shr_megan_mechcomps_n + use shr_fire_emis_mod,only: shr_fire_emis_fields_token, shr_fire_emis_ztop_token, shr_fire_emis_mechcomps_n + use clm_varctl , only: ndep_from_cpl + use glc_elevclass_mod, only: glc_get_num_elevation_classes, glc_elevclass_as_string + ! + ! !ARGUMENTS: + implicit none + ! + ! !REVISION HISTORY: + ! Author: Mariana Vertenstein + ! 01/2011, Erik Kluzek: Added protex headers + ! + ! !LOCAL VARIABLES: + type(mct_aVect) :: l2x ! temporary, land to coupler + type(mct_aVect) :: x2l ! temporary, coupler to land + integer :: num + character(len=:), allocatable :: nec_str ! string version of glc elev. class number + character(len=64) :: name + character(len=32) :: subname = 'clm_cpl_indices_set' ! subroutine name + !----------------------------------------------------------------------- + + ! Determine attribute vector indices + + ! create temporary attribute vectors + call mct_aVect_init(x2l, rList=seq_flds_x2l_fields, lsize=1) + nflds_x2l = mct_avect_nRattr(x2l) + + call mct_aVect_init(l2x, rList=seq_flds_l2x_fields, lsize=1) + nflds_l2x = mct_avect_nRattr(l2x) + + !------------------------------------------------------------- + ! clm -> drv + !------------------------------------------------------------- + + index_l2x_Flrl_rofsur = mct_avect_indexra(l2x,'Flrl_rofsur') + index_l2x_Flrl_rofgwl = mct_avect_indexra(l2x,'Flrl_rofgwl') + index_l2x_Flrl_rofsub = mct_avect_indexra(l2x,'Flrl_rofsub') + index_l2x_Flrl_rofi = mct_avect_indexra(l2x,'Flrl_rofi') + index_l2x_Flrl_irrig = mct_avect_indexra(l2x,'Flrl_irrig') + + index_l2x_Sl_t = mct_avect_indexra(l2x,'Sl_t') + index_l2x_Sl_snowh = mct_avect_indexra(l2x,'Sl_snowh') + index_l2x_Sl_avsdr = mct_avect_indexra(l2x,'Sl_avsdr') + index_l2x_Sl_anidr = mct_avect_indexra(l2x,'Sl_anidr') + index_l2x_Sl_avsdf = mct_avect_indexra(l2x,'Sl_avsdf') + index_l2x_Sl_anidf = mct_avect_indexra(l2x,'Sl_anidf') + index_l2x_Sl_tref = mct_avect_indexra(l2x,'Sl_tref') + index_l2x_Sl_qref = mct_avect_indexra(l2x,'Sl_qref') + index_l2x_Sl_u10 = mct_avect_indexra(l2x,'Sl_u10') + index_l2x_Sl_ram1 = mct_avect_indexra(l2x,'Sl_ram1') + index_l2x_Sl_fv = mct_avect_indexra(l2x,'Sl_fv') + index_l2x_Sl_soilw = mct_avect_indexra(l2x,'Sl_soilw',perrwith='quiet') + + if ( lnd_drydep )then + index_l2x_Sl_ddvel = mct_avect_indexra(l2x, trim(drydep_fields_token)) + else + index_l2x_Sl_ddvel = 0 + end if + + index_l2x_Fall_taux = mct_avect_indexra(l2x,'Fall_taux') + index_l2x_Fall_tauy = mct_avect_indexra(l2x,'Fall_tauy') + index_l2x_Fall_lat = mct_avect_indexra(l2x,'Fall_lat') + index_l2x_Fall_sen = mct_avect_indexra(l2x,'Fall_sen') + index_l2x_Fall_lwup = mct_avect_indexra(l2x,'Fall_lwup') + index_l2x_Fall_evap = mct_avect_indexra(l2x,'Fall_evap') + index_l2x_Fall_swnet = mct_avect_indexra(l2x,'Fall_swnet') + index_l2x_Fall_flxdst1 = mct_avect_indexra(l2x,'Fall_flxdst1') + index_l2x_Fall_flxdst2 = mct_avect_indexra(l2x,'Fall_flxdst2') + index_l2x_Fall_flxdst3 = mct_avect_indexra(l2x,'Fall_flxdst3') + index_l2x_Fall_flxdst4 = mct_avect_indexra(l2x,'Fall_flxdst4') + + index_l2x_Fall_fco2_lnd = mct_avect_indexra(l2x,'Fall_fco2_lnd',perrwith='quiet') + + index_l2x_Fall_methane = mct_avect_indexra(l2x,'Fall_methane',perrWith='quiet') + + ! MEGAN fluxes + if (shr_megan_mechcomps_n>0) then + index_l2x_Fall_flxvoc = mct_avect_indexra(l2x,trim(shr_megan_fields_token)) + else + index_l2x_Fall_flxvoc = 0 + endif + + ! Fire fluxes + if (shr_fire_emis_mechcomps_n>0) then + index_l2x_Fall_flxfire = mct_avect_indexra(l2x,trim(shr_fire_emis_fields_token)) + index_l2x_Sl_ztopfire = mct_avect_indexra(l2x,trim(shr_fire_emis_ztop_token)) + else + index_l2x_Fall_flxfire = 0 + index_l2x_Sl_ztopfire = 0 + endif + + !------------------------------------------------------------- + ! drv -> clm + !------------------------------------------------------------- + + index_x2l_Sa_z = mct_avect_indexra(x2l,'Sa_z') + index_x2l_Sa_topo = mct_avect_indexra(x2l,'Sa_topo') + index_x2l_Sa_u = mct_avect_indexra(x2l,'Sa_u') + index_x2l_Sa_v = mct_avect_indexra(x2l,'Sa_v') + index_x2l_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') + index_x2l_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') + index_x2l_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') + index_x2l_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') + index_x2l_Sa_co2prog = mct_avect_indexra(x2l,'Sa_co2prog',perrwith='quiet') + index_x2l_Sa_co2diag = mct_avect_indexra(x2l,'Sa_co2diag',perrwith='quiet') + + index_x2l_Sa_methane = mct_avect_indexra(x2l,'Sa_methane',perrWith='quiet') + + index_x2l_Flrr_volr = mct_avect_indexra(x2l,'Flrr_volr') + index_x2l_Flrr_volrmch = mct_avect_indexra(x2l,'Flrr_volrmch') + + index_x2l_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') + index_x2l_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') + index_x2l_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') + index_x2l_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') + index_x2l_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') + index_x2l_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') + index_x2l_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') + index_x2l_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') + index_x2l_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') + index_x2l_Faxa_bcphidry = mct_avect_indexra(x2l,'Faxa_bcphidry') + index_x2l_Faxa_bcphodry = mct_avect_indexra(x2l,'Faxa_bcphodry') + index_x2l_Faxa_bcphiwet = mct_avect_indexra(x2l,'Faxa_bcphiwet') + index_x2l_Faxa_ocphidry = mct_avect_indexra(x2l,'Faxa_ocphidry') + index_x2l_Faxa_ocphodry = mct_avect_indexra(x2l,'Faxa_ocphodry') + index_x2l_Faxa_ocphiwet = mct_avect_indexra(x2l,'Faxa_ocphiwet') + index_x2l_Faxa_dstdry1 = mct_avect_indexra(x2l,'Faxa_dstdry1') + index_x2l_Faxa_dstdry2 = mct_avect_indexra(x2l,'Faxa_dstdry2') + index_x2l_Faxa_dstdry3 = mct_avect_indexra(x2l,'Faxa_dstdry3') + index_x2l_Faxa_dstdry4 = mct_avect_indexra(x2l,'Faxa_dstdry4') + index_x2l_Faxa_dstwet1 = mct_avect_indexra(x2l,'Faxa_dstwet1') + index_x2l_Faxa_dstwet2 = mct_avect_indexra(x2l,'Faxa_dstwet2') + index_x2l_Faxa_dstwet3 = mct_avect_indexra(x2l,'Faxa_dstwet3') + index_x2l_Faxa_dstwet4 = mct_avect_indexra(x2l,'Faxa_dstwet4') + + index_x2l_Faxa_nhx = mct_avect_indexra(x2l,'Faxa_nhx', perrWith='quiet') + index_x2l_Faxa_noy = mct_avect_indexra(x2l,'Faxa_noy', perrWith='quiet') + + if (index_x2l_Faxa_nhx > 0 .and. index_x2l_Faxa_noy > 0) then + ndep_from_cpl = .true. + end if + + index_x2l_Flrr_flood = mct_avect_indexra(x2l,'Flrr_flood') + + !------------------------------------------------------------- + ! glc coupling + !------------------------------------------------------------- + + index_x2l_Sg_icemask = mct_avect_indexra(x2l,'Sg_icemask') + index_x2l_Sg_icemask_coupled_fluxes = mct_avect_indexra(x2l,'Sg_icemask_coupled_fluxes') + + glc_nec = glc_get_num_elevation_classes() + if (glc_nec < 1) then + call shr_sys_abort('ERROR: In CLM4.5 and later, glc_nec must be at least 1.') + end if + + ! Create coupling fields for all glc elevation classes (1:glc_nec) plus bare land + ! (index 0). + allocate(index_l2x_Sl_tsrf(0:glc_nec)) + allocate(index_l2x_Sl_topo(0:glc_nec)) + allocate(index_l2x_Flgl_qice(0:glc_nec)) + allocate(index_x2l_Sg_ice_covered(0:glc_nec)) + allocate(index_x2l_Sg_topo(0:glc_nec)) + allocate(index_x2l_Flgg_hflx(0:glc_nec)) + + do num = 0,glc_nec + nec_str = glc_elevclass_as_string(num) + + name = 'Sg_ice_covered' // nec_str + index_x2l_Sg_ice_covered(num) = mct_avect_indexra(x2l,trim(name)) + name = 'Sg_topo' // nec_str + index_x2l_Sg_topo(num) = mct_avect_indexra(x2l,trim(name)) + name = 'Flgg_hflx' // nec_str + index_x2l_Flgg_hflx(num) = mct_avect_indexra(x2l,trim(name)) + + name = 'Sl_tsrf' // nec_str + index_l2x_Sl_tsrf(num) = mct_avect_indexra(l2x,trim(name)) + name = 'Sl_topo' // nec_str + index_l2x_Sl_topo(num) = mct_avect_indexra(l2x,trim(name)) + name = 'Flgl_qice' // nec_str + index_l2x_Flgl_qice(num) = mct_avect_indexra(l2x,trim(name)) + end do + + call mct_aVect_clean(x2l) + call mct_aVect_clean(l2x) + + end subroutine clm_cpl_indices_set + +!======================================================================= + +end module clm_cpl_indices diff --git a/src/cpl/mct/lnd_comp_mct.F90 b/src/cpl/mct/lnd_comp_mct.F90 new file mode 100644 index 0000000000..42e038ea48 --- /dev/null +++ b/src/cpl/mct/lnd_comp_mct.F90 @@ -0,0 +1,688 @@ +module lnd_comp_mct + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Interface of the active land model component of CESM the CLM (Community Land Model) + ! with the main CESM driver. This is a thin interface taking CESM driver information + ! in MCT (Model Coupling Toolkit) format and converting it to use by CLM. + ! + ! !uses: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mct_mod , only : mct_avect, mct_gsmap, mct_gGrid + use decompmod , only : bounds_type, ldecomp + use lnd_import_export, only : lnd_import, lnd_export + ! + ! !public member functions: + implicit none + save + private ! by default make data private + ! + ! !public member functions: + public :: lnd_init_mct ! clm initialization + public :: lnd_run_mct ! clm run phase + public :: lnd_final_mct ! clm finalization/cleanup + ! + ! !private member functions: + private :: lnd_setgsmap_mct ! set the land model mct gs map + private :: lnd_domain_mct ! set the land model domain information + private :: lnd_handle_resume ! handle pause/resume signals from the coupler + !--------------------------------------------------------------------------- + +contains + + !==================================================================================== + + subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) + ! + ! !DESCRIPTION: + ! Initialize land surface model and obtain relevant atmospheric model arrays + ! back from (i.e. albedos, surface temperature and snow cover over land). + ! + ! !USES: + use shr_kind_mod , only : shr_kind_cl + use abortutils , only : endrun + use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, set_nextsw_cday + use clm_initializeMod, only : initialize1, initialize2 + use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst + use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog, noland + use clm_varctl , only : inst_index, inst_suffix, inst_name + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use controlMod , only : control_setNL + use decompMod , only : get_proc_bounds + use domainMod , only : ldomain + use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel + use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel + use shr_file_mod , only : shr_file_getUnit, shr_file_setIO + use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs + use seq_timemgr_mod , only : seq_timemgr_EClockGetData + use seq_infodata_mod , only : seq_infodata_type, seq_infodata_GetData, seq_infodata_PutData, & + seq_infodata_start_type_start, seq_infodata_start_type_cont, & + seq_infodata_start_type_brnch + use seq_comm_mct , only : seq_comm_suffix, seq_comm_inst, seq_comm_name + use seq_flds_mod , only : seq_flds_x2l_fields, seq_flds_l2x_fields + use spmdMod , only : masterproc, spmd_init + use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch + use clm_cpl_indices , only : clm_cpl_indices_set + use mct_mod , only : mct_aVect_init, mct_aVect_zero, mct_gsMap_lsize + use ESMF + ! + ! !ARGUMENTS: + type(ESMF_Clock), intent(inout) :: EClock ! Input synchronization clock + type(seq_cdata), intent(inout) :: cdata_l ! Input land-model driver data + type(mct_aVect), intent(inout) :: x2l_l, l2x_l ! land model import and export states + character(len=*), optional, intent(in) :: NLFilename ! Namelist filename to read + ! + ! !LOCAL VARIABLES: + integer :: LNDID ! Land identifyer + integer :: mpicom_lnd ! MPI communicator + type(mct_gsMap), pointer :: GSMap_lnd ! Land model MCT GS map + type(mct_gGrid), pointer :: dom_l ! Land model domain + type(seq_infodata_type), pointer :: infodata ! CESM driver level info data + integer :: lsize ! size of attribute vector + integer :: g,i,j ! indices + integer :: dtime_sync ! coupling time-step from the input synchronization clock + integer :: dtime_clm ! clm time-step + logical :: exists ! true if file exists + logical :: atm_aero ! Flag if aerosol data sent from atm model + real(r8) :: scmlat ! single-column latitude + real(r8) :: scmlon ! single-column longitude + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + character(len=SHR_KIND_CL) :: caseid ! case identifier name + character(len=SHR_KIND_CL) :: ctitle ! case description title + character(len=SHR_KIND_CL) :: starttype ! start-type (startup, continue, branch, hybrid) + character(len=SHR_KIND_CL) :: calendar ! calendar type name + character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on + character(len=SHR_KIND_CL) :: version ! Model version + character(len=SHR_KIND_CL) :: username ! user running the model + integer :: nsrest ! clm restart type + integer :: ref_ymd ! reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (sec) + integer :: start_ymd ! start date (YYYYMMDD) + integer :: start_tod ! start time of day (sec) + integer :: stop_ymd ! stop date (YYYYMMDD) + integer :: stop_tod ! stop time of day (sec) + logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type + integer :: lbnum ! input to memory diagnostic + integer :: shrlogunit,shrloglev ! old values for log unit and log level + type(bounds_type) :: bounds ! bounds + character(len=32), parameter :: sub = 'lnd_init_mct' + character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" + !----------------------------------------------------------------------- + + ! Set cdata data + + call seq_cdata_setptrs(cdata_l, ID=LNDID, mpicom=mpicom_lnd, & + gsMap=GSMap_lnd, dom=dom_l, infodata=infodata) + + ! Determine attriute vector indices + + call clm_cpl_indices_set() + + ! Initialize clm MPI communicator + + call spmd_init( mpicom_lnd, LNDID ) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_init_mct:start::',lbnum) + endif +#endif + + inst_name = seq_comm_name(LNDID) + inst_index = seq_comm_inst(LNDID) + inst_suffix = seq_comm_suffix(LNDID) + + ! Initialize io log unit + + call shr_file_getLogUnit (shrlogunit) + if (masterproc) then + inquire(file='lnd_modelio.nml'//trim(inst_suffix),exist=exists) + if (exists) then + iulog = shr_file_getUnit() + call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),iulog) + end if + write(iulog,format) "CLM land model initialization" + else + iulog = shrlogunit + end if + + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + ! Use infodata to set orbital values + + call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & + orb_lambm0=lambm0, orb_obliqr=obliqr ) + + ! Consistency check on namelist filename + + call control_setNL("lnd_in"//trim(inst_suffix)) + + ! Initialize clm + ! initialize1 reads namelist, grid and surface data (need this to initialize gsmap) + ! initialize2 performs rest of initialization + + call seq_timemgr_EClockGetData(EClock, & + start_ymd=start_ymd, & + start_tod=start_tod, ref_ymd=ref_ymd, & + ref_tod=ref_tod, stop_ymd=stop_ymd, & + stop_tod=stop_tod, & + calendar=calendar ) + call seq_infodata_GetData(infodata, case_name=caseid, & + case_desc=ctitle, single_column=single_column, & + scmlat=scmlat, scmlon=scmlon, & + brnch_retain_casename=brnch_retain_casename, & + start_type=starttype, model_version=version, & + hostname=hostname, username=username ) + call set_timemgr_init( calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & + ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, stop_ymd_in=stop_ymd, & + stop_tod_in=stop_tod) + if ( trim(starttype) == trim(seq_infodata_start_type_start)) then + nsrest = nsrStartup + else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then + nsrest = nsrContinue + else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then + nsrest = nsrBranch + else + call endrun( sub//' ERROR: unknown starttype' ) + end if + + call clm_varctl_set(caseid_in=caseid, ctitle_in=ctitle, & + brnch_retain_casename_in=brnch_retain_casename, & + single_column_in=single_column, scmlat_in=scmlat, & + scmlon_in=scmlon, nsrest_in=nsrest, version_in=version, & + hostname_in=hostname, username_in=username) + + ! Read namelist, grid and surface data + + call initialize1( ) + + ! If no land then exit out of initialization + + if ( noland ) then + call seq_infodata_PutData( infodata, lnd_present =.false.) + call seq_infodata_PutData( infodata, lnd_prognostic=.false.) + return + end if + + ! Determine if aerosol and dust deposition come from atmosphere component + + call seq_infodata_GetData(infodata, atm_aero=atm_aero ) + if ( .not. atm_aero )then + call endrun( sub//' ERROR: atmosphere model MUST send aerosols to CLM' ) + end if + + ! Initialize clm gsMap, clm domain and clm attribute vectors + + call get_proc_bounds( bounds ) + + call lnd_SetgsMap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) + lsize = mct_gsMap_lsize(gsMap_lnd, mpicom_lnd) + + call lnd_domain_mct( bounds, lsize, gsMap_lnd, dom_l ) + + call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsize) + call mct_aVect_zero(x2l_l) + + call mct_aVect_init(l2x_l, rList=seq_flds_l2x_fields, lsize=lsize) + call mct_aVect_zero(l2x_l) + + ! Finish initializing clm + + call initialize2() + + ! Check that clm internal dtime aligns with clm coupling interval + + call seq_timemgr_EClockGetData(EClock, dtime=dtime_sync ) + dtime_clm = get_step_size() + if (masterproc) then + write(iulog,*)'dtime_sync= ',dtime_sync,& + ' dtime_clm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) + end if + if (mod(dtime_sync,dtime_clm) /= 0) then + write(iulog,*)'clm dtime ',dtime_clm,' and Eclock dtime ',& + dtime_sync,' never align' + call endrun( sub//' ERROR: time out of sync' ) + end if + + ! Create land export state + + call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) + + ! Fill in infodata settings + + call seq_infodata_PutData(infodata, lnd_prognostic=.true.) + call seq_infodata_PutData(infodata, lnd_nx=ldomain%ni, lnd_ny=ldomain%nj) + + ! Get infodata info + + call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) + call set_nextsw_cday(nextsw_cday) + call lnd_handle_resume( cdata_l ) + + ! Reset shr logging to original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#if (defined _MEMTRACE) + if(masterproc) then + write(iulog,*) TRIM(Sub) // ':end::' + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_int_mct:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + end subroutine lnd_init_mct + + !==================================================================================== + + subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) + ! + ! !DESCRIPTION: + ! Run clm model + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_instMod , only : water_inst, lnd2atm_inst, atm2lnd_inst, lnd2glc_inst, glc2lnd_inst + use clm_driver , only : clm_drv + use clm_time_manager, only : get_curr_date, get_nstep, get_curr_calday, get_step_size + use clm_time_manager, only : advance_timestep, set_nextsw_cday,update_rad_dtime + use decompMod , only : get_proc_bounds + use abortutils , only : endrun + use clm_varctl , only : iulog + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel + use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel + use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs + use seq_timemgr_mod , only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn + use seq_timemgr_mod , only : seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync + use seq_infodata_mod, only : seq_infodata_type, seq_infodata_GetData + use spmdMod , only : masterproc, mpicom + use perf_mod , only : t_startf, t_stopf, t_barrierf + use shr_orb_mod , only : shr_orb_decl + use ESMF + ! + ! !ARGUMENTS: + type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver + type(seq_cdata) , intent(inout) :: cdata_l ! Input driver data for land model + type(mct_aVect) , intent(inout) :: x2l_l ! Import state to land model + type(mct_aVect) , intent(inout) :: l2x_l ! Export state from land model + ! + ! !LOCAL VARIABLES: + integer :: ymd_sync ! Sync date (YYYYMMDD) + integer :: yr_sync ! Sync current year + integer :: mon_sync ! Sync current month + integer :: day_sync ! Sync current day + integer :: tod_sync ! Sync current time of day (sec) + integer :: ymd ! CLM current date (YYYYMMDD) + integer :: yr ! CLM current year + integer :: mon ! CLM current month + integer :: day ! CLM current day + integer :: tod ! CLM current time of day (sec) + integer :: dtime ! time step increment (sec) + integer :: nstep ! time step index + logical :: rstwr_sync ! .true. ==> write restart file before returning + logical :: rstwr ! .true. ==> write restart file before returning + logical :: nlend_sync ! Flag signaling last time-step + logical :: nlend ! .true. ==> last time-step + logical :: dosend ! true => send data back to driver + logical :: doalb ! .true. ==> do albedo calculation on this time step + logical :: rof_prognostic ! .true. => running with a prognostic ROF model + logical :: glc_present ! .true. => running with a non-stub GLC model + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + real(r8) :: caldayp1 ! clm calday plus dtime offset + integer :: shrlogunit,shrloglev ! old values for share log unit and log level + integer :: lbnum ! input to memory diagnostic + integer :: g,i,lsize ! counters + real(r8) :: calday ! calendar day for nstep + real(r8) :: declin ! solar declination angle in radians for nstep + real(r8) :: declinp1 ! solar declination angle in radians for nstep+1 + real(r8) :: eccf ! earth orbit eccentricity factor + real(r8) :: recip ! reciprical + logical,save :: first_call = .true. ! first call work + type(seq_infodata_type),pointer :: infodata ! CESM information from the driver + type(mct_gGrid), pointer :: dom_l ! Land model domain data + type(bounds_type) :: bounds ! bounds + character(len=32) :: rdate ! date char string for restart file names + character(len=32), parameter :: sub = "lnd_run_mct" + !--------------------------------------------------------------------------- + + ! Determine processor bounds + + call get_proc_bounds(bounds) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_run_mct:start::',lbnum) + endif +#endif + + ! Reset shr logging to my log file + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + ! Determine time of next atmospheric shortwave calculation + call seq_cdata_setptrs(cdata_l, infodata=infodata, dom=dom_l) + call seq_timemgr_EClockGetData(EClock, & + curr_ymd=ymd, curr_tod=tod_sync, & + curr_yr=yr_sync, curr_mon=mon_sync, curr_day=day_sync) + call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) + + call set_nextsw_cday( nextsw_cday ) + dtime = get_step_size() + + ! Handle pause/resume signals from coupler + call lnd_handle_resume( cdata_l ) + + write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync,mon_sync,day_sync,tod_sync + nlend_sync = seq_timemgr_StopAlarmIsOn( EClock ) + rstwr_sync = seq_timemgr_RestartAlarmIsOn( EClock ) + + ! Determine if we're running with a prognostic ROF model, and if we're running with a + ! non-stub GLC model. These won't change throughout the run, but we can't count on + ! their being set in initialization, so need to get them in the run method. + + call seq_infodata_GetData( infodata, & + rof_prognostic=rof_prognostic, & + glc_present=glc_present) + + ! Map MCT to land data type + ! Perform downscaling if appropriate + + + ! Map to clm (only when state and/or fluxes need to be updated) + + call t_startf ('lc_lnd_import') + call lnd_import( bounds, & + x2l = x2l_l%rattr, & + glc_present = glc_present, & + atm2lnd_inst = atm2lnd_inst, & + glc2lnd_inst = glc2lnd_inst, & + wateratm2lndbulk_inst = water_inst%wateratm2lndbulk_inst) + call t_stopf ('lc_lnd_import') + + ! Use infodata to set orbital values if updated mid-run + + call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & + orb_lambm0=lambm0, orb_obliqr=obliqr ) + + ! Loop over time steps in coupling interval + + dosend = .false. + do while(.not. dosend) + + ! Determine if dosend + ! When time is not updated at the beginning of the loop - then return only if + ! are in sync with clock before time is updated + + call get_curr_date( yr, mon, day, tod ) + ymd = yr*10000 + mon*100 + day + tod = tod + dosend = (seq_timemgr_EClockDateInSync( EClock, ymd, tod)) + + ! Determine doalb based on nextsw_cday sent from atm model + + nstep = get_nstep() + caldayp1 = get_curr_calday(offset=dtime) + if (nstep == 0) then + doalb = .false. + else if (nstep == 1) then + doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) + else + doalb = (nextsw_cday >= -0.5_r8) + end if + call update_rad_dtime(doalb) + + ! Determine if time to write cam restart and stop + + rstwr = .false. + if (rstwr_sync .and. dosend) rstwr = .true. + nlend = .false. + if (nlend_sync .and. dosend) nlend = .true. + + ! Run clm + + call t_barrierf('sync_clm_run1', mpicom) + call t_startf ('clm_run') + call t_startf ('shr_orb_decl') + calday = get_curr_calday() + call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) + call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) + call t_stopf ('shr_orb_decl') + call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic) + call t_stopf ('clm_run') + + ! Create l2x_l export state - add river runoff input to l2x_l if appropriate + + call t_startf ('lc_lnd_export') + call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) + call t_stopf ('lc_lnd_export') + + ! Advance clm time step + + call t_startf ('lc_clm2_adv_timestep') + call advance_timestep() + call t_stopf ('lc_clm2_adv_timestep') + + end do + + ! Check that internal clock is in sync with master clock + + call get_curr_date( yr, mon, day, tod, offset=-dtime ) + ymd = yr*10000 + mon*100 + day + tod = tod + if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then + call seq_timemgr_EclockGetData( EClock, curr_ymd=ymd_sync, curr_tod=tod_sync ) + write(iulog,*)' clm ymd=',ymd ,' clm tod= ',tod + write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync + call endrun( sub//":: CLM clock not in sync with Master Sync clock" ) + end if + + ! Reset shr logging to my original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_run_mct:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + first_call = .false. + + end subroutine lnd_run_mct + + !==================================================================================== + + subroutine lnd_final_mct( EClock, cdata_l, x2l_l, l2x_l) + ! + ! !DESCRIPTION: + ! Finalize land surface model + + use seq_cdata_mod ,only : seq_cdata, seq_cdata_setptrs + use seq_timemgr_mod ,only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn + use seq_timemgr_mod ,only : seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync + use esmf + ! + ! !ARGUMENTS: + type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver + type(seq_cdata) , intent(inout) :: cdata_l ! Input driver data for land model + type(mct_aVect) , intent(inout) :: x2l_l ! Import state to land model + type(mct_aVect) , intent(inout) :: l2x_l ! Export state from land model + !--------------------------------------------------------------------------- + + ! fill this in + end subroutine lnd_final_mct + + !==================================================================================== + + subroutine lnd_setgsmap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) + ! + ! !DESCRIPTION: + ! Set the MCT GS map for the land model + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use domainMod , only : ldomain + use mct_mod , only : mct_gsMap, mct_gsMap_init + implicit none + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: mpicom_lnd ! MPI communicator for the clm land model + integer , intent(in) :: LNDID ! Land model identifyer number + type(mct_gsMap) , intent(out) :: gsMap_lnd ! Resulting MCT GS map for the land model + ! + ! !LOCAL VARIABLES: + integer,allocatable :: gindex(:) ! Number the local grid points + integer :: i, j, n, gi ! Indices + integer :: lsize,gsize ! GS Map size + integer :: ier ! Error code + !--------------------------------------------------------------------------- + + ! Build the land grid numbering for MCT + ! NOTE: Numbering scheme is: West to East and South to North + ! starting at south pole. Should be the same as what's used in SCRIP + + allocate(gindex(bounds%begg:bounds%endg),stat=ier) + + ! number the local grid + + do n = bounds%begg, bounds%endg + gindex(n) = ldecomp%gdc2glo(n) + end do + lsize = bounds%endg - bounds%begg + 1 + gsize = ldomain%ni * ldomain%nj + + call mct_gsMap_init( gsMap_lnd, gindex, mpicom_lnd, LNDID, lsize, gsize ) + + deallocate(gindex) + + end subroutine lnd_SetgsMap_mct + + !==================================================================================== + + subroutine lnd_domain_mct( bounds, lsize, gsMap_l, dom_l ) + ! + ! !DESCRIPTION: + ! Send the land model domain information to the coupler + ! + ! !USES: + use clm_varcon , only: re + use domainMod , only: ldomain + use spmdMod , only: iam + use mct_mod , only: mct_gGrid_importIAttr + use mct_mod , only: mct_gGrid_importRAttr, mct_gGrid_init, mct_gsMap_orderedPoints + use seq_flds_mod, only: seq_flds_dom_coord, seq_flds_dom_other + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: lsize ! land model domain data size + type(mct_gsMap), intent(inout) :: gsMap_l ! Output land model MCT GS map + type(mct_ggrid), intent(out) :: dom_l ! Output domain information for land model + ! + ! Local Variables + integer :: g,i,j ! index + real(r8), pointer :: data(:) ! temporary + integer , pointer :: idata(:) ! temporary + !--------------------------------------------------------------------------- + ! + ! Initialize mct domain type + ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) + ! Note that in addition land carries around landfrac for the purposes of domain checking + ! + call mct_gGrid_init( GGrid=dom_l, CoordChars=trim(seq_flds_dom_coord), & + OtherChars=trim(seq_flds_dom_other), lsize=lsize ) + ! + ! Allocate memory + ! + allocate(data(lsize)) + ! + ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT + ! + call mct_gsMap_orderedPoints(gsMap_l, iam, idata) + call mct_gGrid_importIAttr(dom_l,'GlobGridNum',idata,lsize) + ! + ! Determine domain (numbering scheme is: West to East and South to North to South pole) + ! Initialize attribute vector with special value + ! + data(:) = -9999.0_R8 + call mct_gGrid_importRAttr(dom_l,"lat" ,data,lsize) + call mct_gGrid_importRAttr(dom_l,"lon" ,data,lsize) + call mct_gGrid_importRAttr(dom_l,"area" ,data,lsize) + call mct_gGrid_importRAttr(dom_l,"aream",data,lsize) + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_l,"mask" ,data,lsize) + ! + ! Fill in correct values for domain components + ! Note aream will be filled in in the atm-lnd mapper + ! + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%lonc(g) + end do + call mct_gGrid_importRattr(dom_l,"lon",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%latc(g) + end do + call mct_gGrid_importRattr(dom_l,"lat",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%area(g)/(re*re) + end do + call mct_gGrid_importRattr(dom_l,"area",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = real(ldomain%mask(g), r8) + end do + call mct_gGrid_importRattr(dom_l,"mask",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = real(ldomain%frac(g), r8) + end do + call mct_gGrid_importRattr(dom_l,"frac",data,lsize) + + deallocate(data) + deallocate(idata) + + end subroutine lnd_domain_mct + + !==================================================================================== + + subroutine lnd_handle_resume( cdata_l ) + ! + ! !DESCRIPTION: + ! Handle resume signals for Data Assimilation (DA) + ! + ! !USES: + use clm_time_manager , only : update_DA_nstep + use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs + implicit none + ! !ARGUMENTS: + type(seq_cdata), intent(inout) :: cdata_l ! Input land-model driver data + ! !LOCAL VARIABLES: + logical :: resume_from_data_assim ! flag if we are resuming after data assimulation was done + !--------------------------------------------------------------------------- + + ! Check to see if restart was modified and we are resuming from data + ! assimilation + call seq_cdata_setptrs(cdata_l, post_assimilation=resume_from_data_assim) + if ( resume_from_data_assim ) call update_DA_nstep() + + end subroutine lnd_handle_resume + +end module lnd_comp_mct diff --git a/src/cpl/mct/lnd_import_export.F90 b/src/cpl/mct/lnd_import_export.F90 new file mode 100644 index 0000000000..f3784bc55f --- /dev/null +++ b/src/cpl/mct/lnd_import_export.F90 @@ -0,0 +1,431 @@ +module lnd_import_export + + use shr_kind_mod , only: r8 => shr_kind_r8, cl=>shr_kind_cl + use abortutils , only: endrun + use decompmod , only: bounds_type + use lnd2atmType , only: lnd2atm_type + use lnd2glcMod , only: lnd2glc_type + use atm2lndType , only: atm2lnd_type + use glc2lndMod , only: glc2lnd_type + use Waterlnd2atmBulkType , only: waterlnd2atmbulk_type + use Wateratm2lndBulkType , only: wateratm2lndbulk_type + use clm_cpl_indices + ! + implicit none + !=============================================================================== + +contains + + !=============================================================================== + subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst, wateratm2lndbulk_inst) + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Convert the input data from the coupler to the land model + ! + ! !USES: + use seq_flds_mod , only: seq_flds_x2l_fields + use clm_varctl , only: co2_type, co2_ppmv, iulog, use_c13 + use clm_varctl , only: ndep_from_cpl + use clm_varcon , only: rair, o2_molar_const, c13ratio + use shr_const_mod , only: SHR_CONST_TKFRZ + use shr_string_mod , only: shr_string_listGetName + use domainMod , only: ldomain + use shr_infnan_mod , only : isnan => shr_infnan_isnan + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + real(r8) , intent(in) :: x2l(:,:) ! driver import state to land model + logical , intent(in) :: glc_present ! .true. => running with a non-stub GLC model + type(atm2lnd_type) , intent(inout) :: atm2lnd_inst ! clm internal input data type + type(glc2lnd_type) , intent(inout) :: glc2lnd_inst ! clm internal input data type + type(wateratm2lndbulk_type), intent(inout) :: wateratm2lndbulk_inst ! clm internal input data type + ! + ! !LOCAL VARIABLES: + integer :: g,i,k,nstep,ier ! indices, number of steps, and error code + real(r8) :: forc_rainc ! rainxy Atm flux mm/s + real(r8) :: e ! vapor pressure (Pa) + real(r8) :: qsat ! saturation specific humidity (kg/kg) + real(r8) :: forc_t ! atmospheric temperature (Kelvin) + real(r8) :: forc_q ! atmospheric specific humidity (kg/kg) + real(r8) :: forc_pbot ! atmospheric pressure (Pa) + real(r8) :: forc_rainl ! rainxy Atm flux mm/s + real(r8) :: forc_snowc ! snowfxy Atm flux mm/s + real(r8) :: forc_snowl ! snowfxl Atm flux mm/s + real(r8) :: co2_ppmv_diag ! temporary + real(r8) :: co2_ppmv_prog ! temporary + real(r8) :: co2_ppmv_val ! temporary + integer :: co2_type_idx ! integer flag for co2_type options + real(r8) :: esatw ! saturation vapor pressure over water (Pa) + real(r8) :: esati ! saturation vapor pressure over ice (Pa) + real(r8) :: a0,a1,a2,a3,a4,a5,a6 ! coefficients for esat over water + real(r8) :: b0,b1,b2,b3,b4,b5,b6 ! coefficients for esat over ice + real(r8) :: tdc, t ! Kelvins to Celcius function and its input + character(len=32) :: fname ! name of field that is NaN + character(len=32), parameter :: sub = 'lnd_import' + + ! Constants to compute vapor pressure + parameter (a0=6.107799961_r8 , a1=4.436518521e-01_r8, & + a2=1.428945805e-02_r8, a3=2.650648471e-04_r8, & + a4=3.031240396e-06_r8, a5=2.034080948e-08_r8, & + a6=6.136820929e-11_r8) + + parameter (b0=6.109177956_r8 , b1=5.034698970e-01_r8, & + b2=1.886013408e-02_r8, b3=4.176223716e-04_r8, & + b4=5.824720280e-06_r8, b5=4.838803174e-08_r8, & + b6=1.838826904e-10_r8) + ! + ! function declarations + ! + tdc(t) = min( 50._r8, max(-50._r8,(t-SHR_CONST_TKFRZ)) ) + esatw(t) = 100._r8*(a0+t*(a1+t*(a2+t*(a3+t*(a4+t*(a5+t*a6)))))) + esati(t) = 100._r8*(b0+t*(b1+t*(b2+t*(b3+t*(b4+t*(b5+t*b6)))))) + !--------------------------------------------------------------------------- + + co2_type_idx = 0 + if (co2_type == 'prognostic') then + co2_type_idx = 1 + else if (co2_type == 'diagnostic') then + co2_type_idx = 2 + end if + if (co2_type == 'prognostic' .and. index_x2l_Sa_co2prog == 0) then + call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2prog for co2_type equal to prognostic' ) + else if (co2_type == 'diagnostic' .and. index_x2l_Sa_co2diag == 0) then + call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2diag for co2_type equal to diagnostic' ) + end if + + ! Note that the precipitation fluxes received from the coupler + ! are in units of kg/s/m^2. To convert these precipitation rates + ! in units of mm/sec, one must divide by 1000 kg/m^3 and multiply + ! by 1000 mm/m resulting in an overall factor of unity. + ! Below the units are therefore given in mm/s. + + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + + ! Determine flooding input, sign convention is positive downward and + ! hierarchy is atm/glc/lnd/rof/ice/ocn. so water sent from rof to land is negative, + ! change the sign to indicate addition of water to system. + + wateratm2lndbulk_inst%forc_flood_grc(g) = -x2l(index_x2l_Flrr_flood,i) + + wateratm2lndbulk_inst%volr_grc(g) = x2l(index_x2l_Flrr_volr,i) * (ldomain%area(g) * 1.e6_r8) + wateratm2lndbulk_inst%volrmch_grc(g)= x2l(index_x2l_Flrr_volrmch,i) * (ldomain%area(g) * 1.e6_r8) + + ! Determine required receive fields + + atm2lnd_inst%forc_hgt_grc(g) = x2l(index_x2l_Sa_z,i) ! zgcmxy Atm state m + atm2lnd_inst%forc_topo_grc(g) = x2l(index_x2l_Sa_topo,i) ! Atm surface height (m) + atm2lnd_inst%forc_u_grc(g) = x2l(index_x2l_Sa_u,i) ! forc_uxy Atm state m/s + atm2lnd_inst%forc_v_grc(g) = x2l(index_x2l_Sa_v,i) ! forc_vxy Atm state m/s + atm2lnd_inst%forc_solad_grc(g,2) = x2l(index_x2l_Faxa_swndr,i) ! forc_sollxy Atm flux W/m^2 + atm2lnd_inst%forc_solad_grc(g,1) = x2l(index_x2l_Faxa_swvdr,i) ! forc_solsxy Atm flux W/m^2 + atm2lnd_inst%forc_solai_grc(g,2) = x2l(index_x2l_Faxa_swndf,i) ! forc_solldxy Atm flux W/m^2 + atm2lnd_inst%forc_solai_grc(g,1) = x2l(index_x2l_Faxa_swvdf,i) ! forc_solsdxy Atm flux W/m^2 + + atm2lnd_inst%forc_th_not_downscaled_grc(g) = x2l(index_x2l_Sa_ptem,i) ! forc_thxy Atm state K + wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = x2l(index_x2l_Sa_shum,i) ! forc_qxy Atm state kg/kg + atm2lnd_inst%forc_pbot_not_downscaled_grc(g) = x2l(index_x2l_Sa_pbot,i) ! ptcmxy Atm state Pa + atm2lnd_inst%forc_t_not_downscaled_grc(g) = x2l(index_x2l_Sa_tbot,i) ! forc_txy Atm state K + atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) = x2l(index_x2l_Faxa_lwdn,i) ! flwdsxy Atm flux W/m^2 + + forc_rainc = x2l(index_x2l_Faxa_rainc,i) ! mm/s + forc_rainl = x2l(index_x2l_Faxa_rainl,i) ! mm/s + forc_snowc = x2l(index_x2l_Faxa_snowc,i) ! mm/s + forc_snowl = x2l(index_x2l_Faxa_snowl,i) ! mm/s + + ! atmosphere coupling, for prognostic/prescribed aerosols + atm2lnd_inst%forc_aer_grc(g,1) = x2l(index_x2l_Faxa_bcphidry,i) + atm2lnd_inst%forc_aer_grc(g,2) = x2l(index_x2l_Faxa_bcphodry,i) + atm2lnd_inst%forc_aer_grc(g,3) = x2l(index_x2l_Faxa_bcphiwet,i) + atm2lnd_inst%forc_aer_grc(g,4) = x2l(index_x2l_Faxa_ocphidry,i) + atm2lnd_inst%forc_aer_grc(g,5) = x2l(index_x2l_Faxa_ocphodry,i) + atm2lnd_inst%forc_aer_grc(g,6) = x2l(index_x2l_Faxa_ocphiwet,i) + atm2lnd_inst%forc_aer_grc(g,7) = x2l(index_x2l_Faxa_dstwet1,i) + atm2lnd_inst%forc_aer_grc(g,8) = x2l(index_x2l_Faxa_dstdry1,i) + atm2lnd_inst%forc_aer_grc(g,9) = x2l(index_x2l_Faxa_dstwet2,i) + atm2lnd_inst%forc_aer_grc(g,10) = x2l(index_x2l_Faxa_dstdry2,i) + atm2lnd_inst%forc_aer_grc(g,11) = x2l(index_x2l_Faxa_dstwet3,i) + atm2lnd_inst%forc_aer_grc(g,12) = x2l(index_x2l_Faxa_dstdry3,i) + atm2lnd_inst%forc_aer_grc(g,13) = x2l(index_x2l_Faxa_dstwet4,i) + atm2lnd_inst%forc_aer_grc(g,14) = x2l(index_x2l_Faxa_dstdry4,i) + + ! Determine optional receive fields + + if (index_x2l_Sa_co2prog /= 0) then + co2_ppmv_prog = x2l(index_x2l_Sa_co2prog,i) ! co2 atm state prognostic + else + co2_ppmv_prog = co2_ppmv + end if + + if (index_x2l_Sa_co2diag /= 0) then + co2_ppmv_diag = x2l(index_x2l_Sa_co2diag,i) ! co2 atm state diagnostic + else + co2_ppmv_diag = co2_ppmv + end if + + if (index_x2l_Sa_methane /= 0) then + atm2lnd_inst%forc_pch4_grc(g) = x2l(index_x2l_Sa_methane,i) + endif + + ! Determine derived quantities for required fields + + forc_t = atm2lnd_inst%forc_t_not_downscaled_grc(g) + forc_q = wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) + forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) + + atm2lnd_inst%forc_hgt_u_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of wind [m] + atm2lnd_inst%forc_hgt_t_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of temperature [m] + atm2lnd_inst%forc_hgt_q_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of humidity [m] + atm2lnd_inst%forc_vp_grc(g) = forc_q * forc_pbot / (0.622_r8 + 0.378_r8 * forc_q) + atm2lnd_inst%forc_rho_not_downscaled_grc(g) = & + (forc_pbot - 0.378_r8 * atm2lnd_inst%forc_vp_grc(g)) / (rair * forc_t) + atm2lnd_inst%forc_po2_grc(g) = o2_molar_const * forc_pbot + atm2lnd_inst%forc_wind_grc(g) = sqrt(atm2lnd_inst%forc_u_grc(g)**2 + atm2lnd_inst%forc_v_grc(g)**2) + atm2lnd_inst%forc_solar_grc(g) = atm2lnd_inst%forc_solad_grc(g,1) + atm2lnd_inst%forc_solai_grc(g,1) + & + atm2lnd_inst%forc_solad_grc(g,2) + atm2lnd_inst%forc_solai_grc(g,2) + + wateratm2lndbulk_inst%forc_rain_not_downscaled_grc(g) = forc_rainc + forc_rainl + wateratm2lndbulk_inst%forc_snow_not_downscaled_grc(g) = forc_snowc + forc_snowl + + if (forc_t > SHR_CONST_TKFRZ) then + e = esatw(tdc(forc_t)) + else + e = esati(tdc(forc_t)) + end if + qsat = 0.622_r8*e / (forc_pbot - 0.378_r8*e) + + !modify specific humidity if precip occurs + if(1==2) then + if((forc_rainc+forc_rainl) > 0._r8) then + forc_q = 0.95_r8*qsat + ! forc_q = qsat + wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = forc_q + endif + endif + + wateratm2lndbulk_inst%forc_rh_grc(g) = 100.0_r8*(forc_q / qsat) + + ! Check that solar, specific-humidity and LW downward aren't negative + if ( atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) <= 0.0_r8 )then + call endrun( sub//' ERROR: Longwave down sent from the atmosphere model is negative or zero' ) + end if + if ( (atm2lnd_inst%forc_solad_grc(g,1) < 0.0_r8) .or. (atm2lnd_inst%forc_solad_grc(g,2) < 0.0_r8) & + .or. (atm2lnd_inst%forc_solai_grc(g,1) < 0.0_r8) .or. (atm2lnd_inst%forc_solai_grc(g,2) < 0.0_r8) ) then + call endrun( sub//' ERROR: One of the solar fields (indirect/diffuse, vis or near-IR)'// & + ' from the atmosphere model is negative or zero' ) + end if + if ( wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) < 0.0_r8 )then + call endrun( sub//' ERROR: Bottom layer specific humidty sent from the atmosphere model is less than zero' ) + end if + + ! Check if any input from the coupler is NaN + if ( any(isnan(x2l(:,i))) )then + write(iulog,*) '# of NaNs = ', count(isnan(x2l(:,i))) + write(iulog,*) 'Which are NaNs = ', isnan(x2l(:,i)) + do k = 1, size(x2l(:,i)) + if ( isnan(x2l(k,i)) )then + call shr_string_listGetName( seq_flds_x2l_fields, k, fname ) + write(iulog,*) trim(fname) + end if + end do + write(iulog,*) 'gridcell index = ', g + call endrun( sub//' ERROR: One or more of the input from the atmosphere model are NaN '// & + '(Not a Number from a bad floating point calculation)' ) + end if + + ! Make sure relative humidity is properly bounded + ! wateratm2lndbulk_inst%forc_rh_grc(g) = min( 100.0_r8, wateratm2lndbulk_inst%forc_rh_grc(g) ) + ! wateratm2lndbulk_inst%forc_rh_grc(g) = max( 0.0_r8, wateratm2lndbulk_inst%forc_rh_grc(g) ) + + ! Determine derived quantities for optional fields + ! Note that the following does unit conversions from ppmv to partial pressures (Pa) + ! Note that forc_pbot is in Pa + + if (co2_type_idx == 1) then + co2_ppmv_val = co2_ppmv_prog + else if (co2_type_idx == 2) then + co2_ppmv_val = co2_ppmv_diag + else + co2_ppmv_val = co2_ppmv + end if + if ( (co2_ppmv_val < 10.0_r8) .or. (co2_ppmv_val > 15000.0_r8) )then + call endrun( sub//' ERROR: CO2 is outside of an expected range' ) + end if + atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot + if (use_c13) then + atm2lnd_inst%forc_pc13o2_grc(g) = co2_ppmv_val * c13ratio * 1.e-6_r8 * forc_pbot + end if + + if (ndep_from_cpl) then + ! The coupler is sending ndep in units if kgN/m2/s - and clm uses units of gN/m2/sec - so the + ! following conversion needs to happen + atm2lnd_inst%forc_ndep_grc(g) = (x2l(index_x2l_Faxa_nhx, i) + x2l(index_x2l_faxa_noy, i))*1000._r8 + end if + + end do + + call glc2lnd_inst%set_glc2lnd_fields( & + bounds = bounds, & + glc_present = glc_present, & + ! NOTE(wjs, 2017-12-13) the x2l argument doesn't have the typical bounds + ! subsetting (bounds%begg:bounds%endg). This mirrors the lack of these bounds in + ! the call to lnd_import from lnd_run_mct. This is okay as long as this code is + ! outside a clump loop. + x2l = x2l, & + index_x2l_Sg_ice_covered = index_x2l_Sg_ice_covered, & + index_x2l_Sg_topo = index_x2l_Sg_topo, & + index_x2l_Flgg_hflx = index_x2l_Flgg_hflx, & + index_x2l_Sg_icemask = index_x2l_Sg_icemask, & + index_x2l_Sg_icemask_coupled_fluxes = index_x2l_Sg_icemask_coupled_fluxes) + + end subroutine lnd_import + + !=============================================================================== + + subroutine lnd_export( bounds, waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x) + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Convert the data to be sent from the clm model to the coupler + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use seq_flds_mod , only : seq_flds_l2x_fields + use clm_varctl , only : iulog + use clm_time_manager , only : get_nstep + use seq_drydep_mod , only : n_drydep + use shr_megan_mod , only : shr_megan_mechcomps_n + use shr_fire_emis_mod , only : shr_fire_emis_mechcomps_n + use domainMod , only : ldomain + use shr_string_mod , only : shr_string_listGetName + use shr_infnan_mod , only : isnan => shr_infnan_isnan + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + type(lnd2atm_type), intent(inout) :: lnd2atm_inst ! clm land to atmosphere exchange data type + type(lnd2glc_type), intent(inout) :: lnd2glc_inst ! clm land to atmosphere exchange data type + type(waterlnd2atmbulk_type), intent(in) :: waterlnd2atmbulk_inst + real(r8) , intent(out) :: l2x(:,:)! land to coupler export state on land grid + ! + ! !LOCAL VARIABLES: + integer :: g,i,k ! indices + integer :: ier ! error status + integer :: nstep ! time step index + integer :: dtime ! time step + integer :: num ! counter + character(len=32) :: fname ! name of field that is NaN + character(len=32), parameter :: sub = 'lnd_export' + !--------------------------------------------------------------------------- + + ! cesm sign convention is that fluxes are positive downward + + l2x(:,:) = 0.0_r8 + + do g = bounds%begg,bounds%endg + i = 1 + (g-bounds%begg) + l2x(index_l2x_Sl_t,i) = lnd2atm_inst%t_rad_grc(g) + l2x(index_l2x_Sl_snowh,i) = waterlnd2atmbulk_inst%h2osno_grc(g) + l2x(index_l2x_Sl_avsdr,i) = lnd2atm_inst%albd_grc(g,1) + l2x(index_l2x_Sl_anidr,i) = lnd2atm_inst%albd_grc(g,2) + l2x(index_l2x_Sl_avsdf,i) = lnd2atm_inst%albi_grc(g,1) + l2x(index_l2x_Sl_anidf,i) = lnd2atm_inst%albi_grc(g,2) + l2x(index_l2x_Sl_tref,i) = lnd2atm_inst%t_ref2m_grc(g) + l2x(index_l2x_Sl_qref,i) = waterlnd2atmbulk_inst%q_ref2m_grc(g) + l2x(index_l2x_Sl_u10,i) = lnd2atm_inst%u_ref10m_grc(g) + l2x(index_l2x_Fall_taux,i) = -lnd2atm_inst%taux_grc(g) + l2x(index_l2x_Fall_tauy,i) = -lnd2atm_inst%tauy_grc(g) + l2x(index_l2x_Fall_lat,i) = -lnd2atm_inst%eflx_lh_tot_grc(g) + l2x(index_l2x_Fall_sen,i) = -lnd2atm_inst%eflx_sh_tot_grc(g) + l2x(index_l2x_Fall_lwup,i) = -lnd2atm_inst%eflx_lwrad_out_grc(g) + l2x(index_l2x_Fall_evap,i) = -waterlnd2atmbulk_inst%qflx_evap_tot_grc(g) + l2x(index_l2x_Fall_swnet,i) = lnd2atm_inst%fsa_grc(g) + if (index_l2x_Fall_fco2_lnd /= 0) then + l2x(index_l2x_Fall_fco2_lnd,i) = -lnd2atm_inst%net_carbon_exchange_grc(g) + end if + + ! Additional fields for DUST, PROGSSLT, dry-deposition and VOC + ! These are now standard fields, but the check on the index makes sure the driver handles them + if (index_l2x_Sl_ram1 /= 0 ) l2x(index_l2x_Sl_ram1,i) = lnd2atm_inst%ram1_grc(g) + if (index_l2x_Sl_fv /= 0 ) l2x(index_l2x_Sl_fv,i) = lnd2atm_inst%fv_grc(g) + if (index_l2x_Sl_soilw /= 0 ) l2x(index_l2x_Sl_soilw,i) = waterlnd2atmbulk_inst%h2osoi_vol_grc(g,1) + if (index_l2x_Fall_flxdst1 /= 0 ) l2x(index_l2x_Fall_flxdst1,i)= -lnd2atm_inst%flxdst_grc(g,1) + if (index_l2x_Fall_flxdst2 /= 0 ) l2x(index_l2x_Fall_flxdst2,i)= -lnd2atm_inst%flxdst_grc(g,2) + if (index_l2x_Fall_flxdst3 /= 0 ) l2x(index_l2x_Fall_flxdst3,i)= -lnd2atm_inst%flxdst_grc(g,3) + if (index_l2x_Fall_flxdst4 /= 0 ) l2x(index_l2x_Fall_flxdst4,i)= -lnd2atm_inst%flxdst_grc(g,4) + + + ! for dry dep velocities + if (index_l2x_Sl_ddvel /= 0 ) then + l2x(index_l2x_Sl_ddvel:index_l2x_Sl_ddvel+n_drydep-1,i) = & + lnd2atm_inst%ddvel_grc(g,:n_drydep) + end if + + ! for MEGAN VOC emis fluxes + if (index_l2x_Fall_flxvoc /= 0 ) then + l2x(index_l2x_Fall_flxvoc:index_l2x_Fall_flxvoc+shr_megan_mechcomps_n-1,i) = & + -lnd2atm_inst%flxvoc_grc(g,:shr_megan_mechcomps_n) + end if + + + ! for fire emis fluxes + if (index_l2x_Fall_flxfire /= 0 ) then + l2x(index_l2x_Fall_flxfire:index_l2x_Fall_flxfire+shr_fire_emis_mechcomps_n-1,i) = & + -lnd2atm_inst%fireflx_grc(g,:shr_fire_emis_mechcomps_n) + l2x(index_l2x_Sl_ztopfire,i) = lnd2atm_inst%fireztop_grc(g) + end if + + if (index_l2x_Fall_methane /= 0) then + l2x(index_l2x_Fall_methane,i) = -lnd2atm_inst%flux_ch4_grc(g) + endif + + ! sign convention is positive downward with + ! hierarchy of atm/glc/lnd/rof/ice/ocn. + ! I.e. water sent from land to rof is positive + + l2x(index_l2x_Flrl_rofsur,i) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + + ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain + l2x(index_l2x_Flrl_rofsub,i) = waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) & + + waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) + + ! qgwl sent individually to coupler + l2x(index_l2x_Flrl_rofgwl,i) = waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) + + ! ice sent individually to coupler + l2x(index_l2x_Flrl_rofi,i) = waterlnd2atmbulk_inst%qflx_rofice_grc(g) + + ! irrigation flux to be removed from main channel storage (negative) + l2x(index_l2x_Flrl_irrig,i) = - waterlnd2atmbulk_inst%qirrig_grc(g) + + ! glc coupling + ! We could avoid setting these fields if glc_present is .false., if that would + ! help with performance. (The downside would be that we wouldn't have these fields + ! available for diagnostic purposes or to force a later T compset with dlnd.) + do num = 0,glc_nec + l2x(index_l2x_Sl_tsrf(num),i) = lnd2glc_inst%tsrf_grc(g,num) + l2x(index_l2x_Sl_topo(num),i) = lnd2glc_inst%topo_grc(g,num) + l2x(index_l2x_Flgl_qice(num),i) = lnd2glc_inst%qice_grc(g,num) + end do + + ! Check if any output sent to the coupler is NaN + if ( any(isnan(l2x(:,i))) )then + write(iulog,*) '# of NaNs = ', count(isnan(l2x(:,i))) + write(iulog,*) 'Which are NaNs = ', isnan(l2x(:,i)) + do k = 1, size(l2x(:,i)) + if ( isnan(l2x(k,i)) )then + call shr_string_listGetName( seq_flds_l2x_fields, k, fname ) + write(iulog,*) trim(fname) + end if + end do + write(iulog,*) 'gridcell index = ', g + call endrun( sub//' ERROR: One or more of the output from CLM to the coupler are NaN ' ) + end if + + end do + + end subroutine lnd_export + +end module lnd_import_export From 0aad0e1793e8b323a05ad38dc6ef0b486ff66172 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 9 Oct 2019 11:41:30 -0600 Subject: [PATCH 143/556] changing the mesh file --- lilac/lilac/atmos_cap.F90 | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 index 55228da5d8..145af984fa 100644 --- a/lilac/lilac/atmos_cap.F90 +++ b/lilac/lilac/atmos_cap.F90 @@ -8,6 +8,7 @@ module atmos_cap use ESMF use lilac_utils , only : fld_list_type use spmdMod , only : masterproc + use clm_varctl , only : iulog implicit none include 'mpif.h' @@ -26,6 +27,13 @@ module atmos_cap integer status(MPI_STATUS_SIZE) ! Status of message integer, parameter :: debug = 0 ! internal debug leve + + + character(len=128) :: fldname + integer, parameter :: begc = 1 !-- internal debug level + integer, parameter :: endc = 3312/4/2/2 !-- internal debug level + character(*),parameter :: F02 = "('[atmos_cap]',a,i5,2x,d26.19)" + !======================================================================== contains !======================================================================== @@ -98,7 +106,9 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! TODO: hard-coded mesh file name shoulb be corrected. ! For now this is our dummy mesh: !atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' !! Negin: This did not work.... - atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv1.9x2.5_141008_ESMFmesh.nc' + !atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv1.9x2.5_141008_ESMFmesh.nc' + atmos_mesh_filepath = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out @@ -167,14 +177,18 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) enddo + fldname = 'Sa_topo' + do i=begc, endc + write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, a2c_fldlist(2)%farrayptr1d(i) + enddo + call ESMF_LogWrite(subname//"fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" ! Add field bundle to state call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"atm2lnd_a_state is filled with dummy_var field bundle!", ESMF_LOGMSG_INFO) print *, "!atm2lnd_a_state is filld with dummy_var field bundle!" From d608acbf9dcbac666623661108b58ab4510acfeb Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 9 Oct 2019 11:45:45 -0600 Subject: [PATCH 144/556] some clean up of printing statements during debugging phase. --- lilac/lilac/lilac_mod.F90 | 71 ++++++++++++++++++++++++------------- lilac/lilac/lilac_utils.F90 | 6 ++-- 2 files changed, 50 insertions(+), 27 deletions(-) diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 84c29384a9..8f69f2e492 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -6,17 +6,19 @@ module lilac_mod ! !USES use ESMF - use lilac_utils , only : fld_list_type, fldsMax, create_fldlists - use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type - use lilac_utils , only : atm2lnd_data2d_type , lnd2atm_data2d_type + use lilac_utils , only : fld_list_type, fldsMax, create_fldlists + use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type + use lilac_utils , only : atm2lnd_data2d_type , lnd2atm_data2d_type use atmos_cap , only : atmos_register !use lnd_shr_methods use lnd_comp_esmf , only : lnd_register use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register - use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS - use shr_pio_mod, only : shr_pio_init1, shr_pio_init2 + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS + use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 + use clm_varctl , only : iulog + use spmdMod , only : masterproc implicit none !TODO (NS,2019-08-07): @@ -87,24 +89,29 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) e_month, e_day, e_hour, e_min - integer :: COMP_COMM - integer :: ierr - integer :: ntasks,mytask ! mpicom size and rank - - integer :: ncomps = 1 ! land only - - integer :: n + integer :: COMP_COMM + integer :: ierr + integer :: ntasks,mytask ! mpicom size and rank + integer :: ncomps = 1 ! land only + integer :: n + integer :: i + integer, parameter :: debug = 1 !-- internal debug level !!! above: https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/pio-xlis-bld/xlis_main.F90 + character(len=128) :: fldname + integer, parameter :: begc = 1 !-- internal debug level + integer, parameter :: endc = 3312/4/2/2 !-- internal debug level + character(*),parameter :: F02 = "('[lilac_mod]',a,i5,2x,d26.19)" !------------------------------------------------------------------------ ! Initialize return code rc = ESMF_SUCCESS - - print *, "---------------------------------------" - print *, " Lilac Demo Application Start " - print *, "---------------------------------------" + if (masterproc) then + print *, "---------------------------------------" + print *, " Lilac Demo Application Start " + print *, "---------------------------------------" + end if !----------------------------------------------------------------------------- ! Initiallize MPI @@ -121,14 +128,14 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) call MPI_ABORT(MPI_COMM_WORLD, ierr) end if - - ! call MPI_COMM_RANK(COMP_COMM, mytask, ierr) call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) - print *, "MPI initialization done ..., ntasks=", ntasks + if (masterproc) then + print *, "MPI initialization done ..., ntasks=", ntasks + end if !----------------------------------------------------------------------------- ! Initialize PIO @@ -167,7 +174,10 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! Read in namelist file ... call ESMF_UtilIOUnitGet(unit=fileunit, rc=rc) ! get an available Fortran unit number if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "---------------------------------------" + + if (masterproc) then + print *, "---------------------------------------" + end if open(fileunit, status="old", file="namelist_lilac", action="read", iostat=rc) @@ -202,7 +212,10 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) allocate (l2c_fldlist(fldsmax)) allocate (c2l_fldlist(fldsmax)) - print *, "creating empty field lists !" + if (masterproc) then + print *, "creating empty field lists !" + end if + call ESMF_LogWrite(subname//"fielldlists are allocated!", ESMF_LOGMSG_INFO) ! create field lists @@ -223,6 +236,13 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) a2c_fldlist(1)%farrayptr1d => atm2lnd1d%Sa_z a2c_fldlist(2)%farrayptr1d => atm2lnd1d%Sa_topo + + !if (masterproc .and. debug > 0) then + fldname = 'Sa_topo' + do i=begc, endc + write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, a2c_fldlist(2)%farrayptr1d(i) + end do + !end if a2c_fldlist(3)%farrayptr1d => atm2lnd1d%Sa_u a2c_fldlist(4)%farrayptr1d => atm2lnd1d%Sa_v a2c_fldlist(5)%farrayptr1d => atm2lnd1d%Sa_ptem @@ -347,13 +367,14 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1 , s=0, calendar=Calendar, rc=rc) call ESMF_TimeSet(StopTime , yy=2000, mm=03, dd=01, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + !call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=1800, rc=rc) clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) print *, "---------------------------------------" - call ESMF_ClockPrint (clock, rc=rc) + !call ESMF_ClockPrint (clock, rc=rc) print *, "=======================================" - call ESMF_CalendarPrint ( calendar , rc=rc) + !call ESMF_CalendarPrint ( calendar , rc=rc) print *, "---------------------------------------" ! ======================================================================== @@ -450,7 +471,7 @@ subroutine lilac_run( ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out print *, "Run Loop Start time" - call ESMF_ClockPrint(local_clock, options="currtime string", rc=rc) + !call ESMF_ClockPrint(local_clock, options="currtime string", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out !------------------------------------------------------------------------- diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 index 29e45dad99..ef1074a909 100644 --- a/lilac/lilac/lilac_utils.F90 +++ b/lilac/lilac/lilac_utils.F90 @@ -35,9 +35,9 @@ module lilac_utils real*8, pointer :: Sa_pbot (:) real*8, pointer :: Sa_tbot (:) real*8, pointer :: Sa_shum (:) - !real*8, pointer :: Sa_methane (:) + real*8, pointer :: Sa_methane (:) ! from atm - fluxes - real*8, pointer :: Faxa_lwdn (:) + real*8, pointer :: Faxa_lwdn (:) real*8, pointer :: Faxa_rainc (:) real*8, pointer :: Faxa_rainl (:) real*8, pointer :: Faxa_snowc (:) @@ -46,6 +46,8 @@ module lilac_utils real*8, pointer :: Faxa_swvdr (:) real*8, pointer :: Faxa_swndf (:) real*8, pointer :: Faxa_swvdf (:) + + real*8, pointer :: Faxa_bcph (:) end type atm2lnd_data1d_type ! From 2abed4b4d9d782c1f63849b50213606890ed07d0 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 9 Oct 2019 11:46:42 -0600 Subject: [PATCH 145/556] changing regrid to redist for getting bfb... --- lilac/lilac/cpl_mod.F90 | 117 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 110 insertions(+), 7 deletions(-) diff --git a/lilac/lilac/cpl_mod.F90 b/lilac/lilac/cpl_mod.F90 index e6573eaa3a..0fbe51677c 100644 --- a/lilac/lilac/cpl_mod.F90 +++ b/lilac/lilac/cpl_mod.F90 @@ -8,6 +8,7 @@ module cpl_mod !----------------------------------------------------------------------- ! !USES use ESMF + use clm_varctl , only : iulog implicit none include 'mpif.h' @@ -26,7 +27,12 @@ module cpl_mod integer :: i, myid integer status(MPI_STATUS_SIZE) - + character(len=128) :: fldname + integer, parameter :: begc = 1 !-- internal debug level + integer, parameter :: endc = 3312/4/2/2 !-- internal debug level + character(*),parameter :: F01 = "('[cpl_mod] ',a,i5,2x,i5,2x,d21.14)" + character(*),parameter :: F02 = "('[cpl_mod]',a,i5,2x,d26.19)" + integer, parameter :: debug = 1 !-- internaldebug level !====================================================================== contains !====================================================================== @@ -111,7 +117,8 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) end if - call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + !call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) end subroutine cpl_atm2lnd_init @@ -136,7 +143,8 @@ subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + !call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) end subroutine cpl_lnd2atm_init @@ -155,6 +163,8 @@ subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_run] ' + real, pointer :: fldptr1d(:) + rc = ESMF_SUCCESS print *, "Running cpl_atm2lnd_run" call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) @@ -168,7 +178,11 @@ subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//" got c2l fieldbundle!", ESMF_LOGMSG_INFO) - call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + !fldname = 'Sa_topo' + !call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + + !call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//" regridding fieldbundles from atmos to land!", ESMF_LOGMSG_INFO) @@ -195,7 +209,8 @@ subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + !call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//" regridding fieldbundles from land to atmos!", ESMF_LOGMSG_INFO) @@ -249,8 +264,96 @@ subroutine cpl_lnd2atm_final(cplcomp, importState, exportState, clock, rc) end subroutine cpl_lnd2atm_final - - + !=============================================================================== + + subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) + + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + + use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag + use ESMF , only : ESMF_FieldBundle + use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet + use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE + use ESMF , only : ESMF_FieldBundleGet + + ! input/output variables + type(ESMF_State), intent(in) :: State + character(len=*), intent(in) :: fldname + real , pointer, optional , intent(out) :: fldptr1d(:) + real , pointer, optional , intent(out) :: fldptr2d(:,:) + integer, intent(out) :: rc + + ! local variables + type(ESMF_FieldStatus_Flag) :: status + type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh + integer :: nnodes, nelements + character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' + + type(ESMF_StateItem_Flag) :: itemFlag + type(ESMF_FieldBundle) :: fieldBundle + logical :: isPresent + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine if this field bundle exist.... + ! TODO: combine the error checks.... + + + call ESMF_StateGet(state, "c2l_fb", itemFlag, rc=rc) + !call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Get the fieldbundle from state... + call ESMF_StateGet(state, "c2l_fb", fieldBundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, isPresent=isPresent, rc=rc) + !call ESMF_FieldBundleGet(fieldBundle,trim(fldname), lfield, isPresent, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_FieldGet(lfield, status=status, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + if (nnodes == 0 .and. nelements == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + if (present(fldptr1d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if ( debug > 0) then + write(iulog,F01)' in '//trim(subname)//'fldptr1d for '//trim(fldname)//' is ' + end if + !print *, "FLDPTR1D is" + !print *, FLDPTR1d + else if (present(fldptr2d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + else + !call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") + end if + endif ! status + + + end subroutine state_getfldptr From 80a8959518cb78079b7ffcba008e09d0f24c3980 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 9 Oct 2019 11:49:12 -0600 Subject: [PATCH 146/556] makefile changes to make with debug options of ctsm debug mode.... --- lilac/lilac/Makefile | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index 6c377917b7..77ebef6d87 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -33,14 +33,22 @@ include $(ESMFMKFILE) #================================================================================ # Temporarily hard-coded # TODO: Please fix this part. -CTSM_BLD_DIR = /glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf +CASE_NAME = why01-g +#CASE_NAME = ctsm1.0.dev066_MCT_I2000Clm50SpRsGs_testing +#CASE_NAME = ctsm1.0.dev066_MCT_I2000Clm50Sp_03 +#CASE_NAME = lilac_ctsm +CTSM_BLD_DIR = /glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf CTSM_INC = -I$(CTSM_BLD_DIR)/include CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm -TRACEBACK_FLAGS = -g -traceback -debug all -check all +#TRACEBACK_FLAGS = -g -traceback -debug all -check all -O2 -r8 +#TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O2 -debug minimal -DLINUX -DCESMCOUPLED -DFORTRANUNDERSCORE -DCPRINTEL -DNDEBUG -DUSE_ESMF_LIB -DMCT_INTERFACE -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=8 -DESMF_VERSION_MINOR=0 -DATM_PRESENT -DICE_PRESENT -DLND_PRESENT -DOCN_PRESENT -DROF_PRESENT -DGLC_PRESENT -DWAV_PRESENT -DESP_PRESENT -free -DUSE_CONTIGUOUS=contiguous +#TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DCESMCOUPLED -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DUSE_ESMF_LIB -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -DATM_PRESENT -DICE_PRESENT -DLND_PRESENT -DOCN_PRESENT -DROF_PRESENT -DGLC_PRESENT -DWAV_PRESENT -DESP_PRESENT -free -DUSE_CONTIGUOUS=contiguous +TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DCESMCOUPLED -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DUSE_ESMF_LIB -DMCT_INTERFACE -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -DATM_PRESENT -DICE_PRESENT -DLND_PRESENT -DOCN_PRESENT -DROF_PRESENT -DGLC_PRESENT -DWAV_PRESENT -DESP_PRESENT -free -DUSE_CONTIGUOUS=contiguous + # ----------------------------------------------------------------------------- -#EXTRA_LIBS = $(EXTRA_LIBS) -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/pio/pio2 -EXTRA_LIBS = -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib -MORE_LIBS = -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -L/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nuopc/nuopc/esmf/c1a1l1/csm_share/ -I/glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/clm/obj/ -I//glade/scratch/negins/lilac_ctsm/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/csm_share/ +#EXTRA_LIBS = $(EXTRA_LIBS) -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/nuopc/pio/pio2 +EXTRA_LIBS = -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -lcsm_share -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib +MORE_LIBS = -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/clm/obj/ -I//glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ # ----------------------------------------------------------------------------- @@ -83,7 +91,7 @@ atmos_cap.o: lilac_utils.o .PHONY: clean berzerk remake clean: - rm -f *.exe + rm -f *.exe *.o berzerk: rm -f PET*.ESMF_LogFile job_name* *.o *.mod *.exe remake: From 1afe65a4d797c698301a682d8edd7d29cdc2e083 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 9 Oct 2019 11:51:02 -0600 Subject: [PATCH 147/556] clean up and changint the values of both swvdr and swndf to 20.0... --- lilac/lilac/demo_driver.F90 | 73 ++++++++++++++++++++++++------------- 1 file changed, 47 insertions(+), 26 deletions(-) diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index a0af468dda..221b1c5f3a 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -22,8 +22,9 @@ program demo_lilac_driver ! modules use ESMF use lilac_mod - use lilac_utils, only : atm2lnd_data1d_type , lnd2atm_data1d_type, atm2lnd_data2d_type, atm2lnd_data2d_type , this_clock - + use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type, atm2lnd_data2d_type, atm2lnd_data2d_type , this_clock + use clm_varctl , only : iulog + use spmdMod , only : masterproc implicit none ! TO DO: change the name and the derived data types @@ -44,17 +45,24 @@ program demo_lilac_driver integer :: end_time !-- end_time end time integer :: curr_time !-- cur_time current time integer :: itime_step !-- itime_step counter of time steps + integer :: g,i,k !-- indices + integer, parameter :: debug = 1 !-- internal debug level + + character(len=128) :: fldname + character(*),parameter :: F01 = "(a,i4,d26.19)" + character(*),parameter :: F02 = "('[demo_driver]',a,i5,2x,d26.19)" !------------------------------------------------------------------------ ! real atmosphere: begc = 1 - endc = 6912/4 + !endc = 6912/4/2 + endc = 3312/4/2/2 !endc = 13824 !endc = 13968 start_time = 1 - end_time = 50 + end_time = 5 itime_step = 1 seed_val = 0 @@ -70,27 +78,40 @@ program demo_lilac_driver allocate ( rand2 (begc:endc) ) ; call random_number (rand2) !allocating these values from atmosphere for now! - allocate ( atm2lnd%Sa_z (begc:endc) ) ; atm2lnd%Sa_z (:) = 30.0 - allocate ( atm2lnd%Sa_topo (begc:endc) ) ; atm2lnd%Sa_topo (:) = 10.0 - allocate ( atm2lnd%Sa_u (begc:endc) ) ; atm2lnd%Sa_u (:) = 20.0 - allocate ( atm2lnd%Sa_v (begc:endc) ) ; atm2lnd%Sa_v (:) = 40.0 - allocate ( atm2lnd%Sa_ptem (begc:endc) ) ; atm2lnd%Sa_ptem (:) = 280.0 - allocate ( atm2lnd%Sa_pbot (begc:endc) ) ; atm2lnd%Sa_pbot (:) = 100100.0 - allocate ( atm2lnd%Sa_tbot (begc:endc) ) ; atm2lnd%Sa_tbot (:) = 280.0 - allocate ( atm2lnd%Sa_shum (begc:endc) ) ; atm2lnd%Sa_shum (:) = 0.0004 - allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) ; atm2lnd%Faxa_lwdn (:) = 200.0 - allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 4.0e-8 - allocate ( atm2lnd%Faxa_rainl (begc:endc) ) ; atm2lnd%Faxa_rainl (:) = 3.0e-8 - allocate ( atm2lnd%Faxa_snowc (begc:endc) ) ; atm2lnd%Faxa_snowc (:) = 1.0e-8 - allocate ( atm2lnd%Faxa_snowl (begc:endc) ) ; atm2lnd%Faxa_snowl (:) = 2.0e-8 - allocate ( atm2lnd%Faxa_swndr (begc:endc) ) ; atm2lnd%Faxa_swndr (:) = 100.0 - allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) ; atm2lnd%Faxa_swvdr (:) = 90.0 - allocate ( atm2lnd%Faxa_swndf (begc:endc) ) ; atm2lnd%Faxa_swndf (:) = 20.0 - allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) ; atm2lnd%Faxa_swvdf (:) = 40.0 + allocate ( atm2lnd%Sa_z (begc:endc) ) ; atm2lnd%Sa_z (:) = 30.0d0 + allocate ( atm2lnd%Sa_topo (begc:endc) ) ; atm2lnd%Sa_topo (:) = 10.0d0 + allocate ( atm2lnd%Sa_u (begc:endc) ) ; atm2lnd%Sa_u (:) = 20.0d0 + allocate ( atm2lnd%Sa_v (begc:endc) ) ; atm2lnd%Sa_v (:) = 40.0d0 + allocate ( atm2lnd%Sa_ptem (begc:endc) ) ; atm2lnd%Sa_ptem (:) = 280.0d0 + allocate ( atm2lnd%Sa_pbot (begc:endc) ) ; atm2lnd%Sa_pbot (:) = 100100.0d0 + allocate ( atm2lnd%Sa_tbot (begc:endc) ) ; atm2lnd%Sa_tbot (:) = 280.0d0 + allocate ( atm2lnd%Sa_shum (begc:endc) ) ; atm2lnd%Sa_shum (:) = 0.0004d0 + allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) ; atm2lnd%Faxa_lwdn (:) = 200.0d0 + !allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 4.0d-8 + allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 0.0d0 + allocate ( atm2lnd%Faxa_rainl (begc:endc) ) ; atm2lnd%Faxa_rainl (:) = 3.0d-8 + allocate ( atm2lnd%Faxa_snowc (begc:endc) ) ; atm2lnd%Faxa_snowc (:) = 1.0d-8 + allocate ( atm2lnd%Faxa_snowl (begc:endc) ) ; atm2lnd%Faxa_snowl (:) = 2.0d-8 + allocate ( atm2lnd%Faxa_swndr (begc:endc) ) ; atm2lnd%Faxa_swndr (:) = 100.0d0 + allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) ; atm2lnd%Faxa_swvdr (:) = 20.0d0 + allocate ( atm2lnd%Faxa_swndf (begc:endc) ) ; atm2lnd%Faxa_swndf (:) = 20.0d0 + allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) ; atm2lnd%Faxa_swvdf (:) = 40.0d0 + + + fldname = 'Sa_topo' + if (debug > 0) then + do i=begc, endc + write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, atm2lnd%Sa_topo(i) + !write (iulog,F01)'i = ',i, atm2lnd%Sa_topo(i) + enddo + end if + !allocate ( atm2lnd%Faxa_bcph (begc:endc) ) ; atm2lnd%Faxa_bcph (:) = 0.0d0 !endc = 18048 ? should this be the size of the land or atmosphere??? + !print *, atm2lnd%Sa_topo(1:100) + allocate ( lnd2atm%Sl_lfrin (begc:endc) ) ; lnd2atm%Sl_lfrin (:) = 0 allocate ( lnd2atm%Sl_t (begc:endc) ) ; lnd2atm%Sl_t (:) = 0 @@ -111,12 +132,12 @@ program demo_lilac_driver do curr_time = start_time, end_time if (curr_time == start_time) then - ! Initalization phase - print *, "--------------------------" - print *, " LILAC Initalization phase" - print *, "--------------------------" - + !if (masterproc) then + print *, "--------------------------" + print *, " LILAC Initalization phase" + print *, "--------------------------" + !end if call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) else if (curr_time == end_time ) then ! Finalization phase From 1fb0ab73e83c7675a46b40eec3185beeacff5602 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 9 Oct 2019 12:46:49 -0600 Subject: [PATCH 148/556] adding the correct lilac cap file to this branch.... this is working for the first time step except for 3 fields. --- src/cpl/lilac/lnd_comp_esmf.F90 | 87 ++++++++++++++++++++++++++++----- 1 file changed, 74 insertions(+), 13 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 48f17e9525..10a5c2513e 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -141,6 +141,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE use shr_pio_mod, only : shr_pio_init1, shr_pio_init2 use glc_elevclass_mod , only : glc_elevclass_init + use shr_orb_mod , only : shr_orb_params ! input/output variables type(ESMF_GridComp) :: comp ! CLM gridded component type(ESMF_State) :: import_state ! CLM import state @@ -235,6 +236,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) integer :: nlnd, nocn ! local size ofarrays !integer :: g,n ! indices integer :: n ! indices + integer :: year, month, day integer :: dtime ! time step increment (sec) @@ -346,9 +348,26 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !call shr_cal_date2ymd(ymd,year,month,day) !orb_cyear = orb_iyear + (year - orb_iyear_align) - ! call shr_orb_params(& - ! orb_cyear=2000, orb_eccen=orb_eccen, orb_obliq=orb_obliq, orb_mvelp=orb_mvelpp, & - ! orb_obliqr=obliqr, orb_lambm0=orb_lambm0, orb_mvelpp=orb_mvelpp, masterproc) + orb_cyear = 2000 + call shr_orb_params(orb_cyear, eccen, obliqr, mvelpp, & + obliqr, lambm0, mvelpp, masterproc) + + ! for now hard-coding: + !nextsw_cday = 1.02083333333333 + !eccen = 1.670366039276560E-002 + !mvelpp = 4.93745779048816 + !lambm0 = -3.247249566152933E-0020 + !obliqr = 0.409101122579779 + + !if ((debug >1) .and. (masterproc)) then + if (masterproc) then + write(iulog,*) 'shr_obs_params is setting these:', eccen + write(iulog,*) 'eccen is : ', eccen + write(iulog,*) 'mvelpp is : ', mvelpp + + write(iulog,*) 'lambm0 is : ', lambm0 + write(iulog,*) 'obliqr is : ', obliqr + end if !---------------------- ! Consistency check on namelist filename @@ -537,11 +556,10 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call fldbundle_add( 'Faxa_snowc' , c2l_fb,rc) !12 call fldbundle_add( 'Faxa_snowl' , c2l_fb,rc) !13 call fldbundle_add( 'Faxa_swndr' , c2l_fb,rc) !14 - call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) !15 - call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) !16 + call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) !15 + call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) !16 call fldbundle_add( 'Faxa_swvdf' , c2l_fb,rc) !17 call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb/), rc=rc) - !call ESMF_StateAdd(importState, fieldbundleList = (/c2l_fb/), rc=rc) ! Create export state @@ -604,10 +622,12 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Set nextsw_cday - call ESMF_LogWrite(subname//"Setting nextsw cday......", ESMF_LOGMSG_INFO) - !call ESMF_LogWrite(subname//nextsw_cday, ESMF_LOGMSG_INFO) call set_nextsw_cday( nextsw_cday ) + if (masterproc) then + write(iulog,*) 'TimeGet ... nextsw_cday is : ', nextsw_cday + end if + ! Set Attributes call ESMF_LogWrite(subname//"setting attribute!", ESMF_LOGMSG_INFO) @@ -619,9 +639,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) call ESMF_LogWrite(subname//"setting attribute-lnd_ny!", ESMF_LOGMSG_INFO) - - - call ESMF_LogWrite(subname//"State_SetScalar....!", ESMF_LOGMSG_INFO) !Set scalars in export state !call State_SetScalar(dble(ldomain%ni), flds_scalar_index_nx, export_state, & @@ -663,6 +680,8 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call ESMF_AttributeSet(comp, "Name", "TBD", convention=convCIM, purpose=purpComp, rc=rc) call ESMF_AttributeSet(comp, "EmailAddress", TBD, convention=convCIM, purpose=purpComp, rc=rc) call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", convention=convCIM, purpose=purpComp, rc=rc) + ! adding this nextsw_cday + call ESMF_AttributeSet(comp, "nextsw_cday", nextsw_cday, convention=convCIM, purpose=purpComp, rc=rc) #endif @@ -754,6 +773,8 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) character(len=32) :: rdate ! date char string for restart file names integer :: shrlogunit ! original log unit character(len=*),parameter :: subname=trim(modName)//':[lnd_run] ' + + character(*),parameter :: F02 = "('[lnd_comp_esmf] ',d26.19)" !------------------------------------------------------------------------------- @@ -776,11 +797,22 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) ! Determine time of next atmospheric shortwave calculation !-------------------------------- + !call ESMF_AttributeGet(export_state, name="nextsw_cday", value=nextsw_cday, rc=rc) !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) !call set_nextsw_cday( nextsw_cday ) + call State_GetScalar(import_state, & + flds_scalar_index_nextsw_cday, nextsw_cday, & + flds_scalar_name, flds_scalar_num, rc) + call set_nextsw_cday( nextsw_cday ) + + + if (masterproc) then + write(iulog,*) 'State_GetScalar ... nextsw_cday is : ', nextsw_cday + end if + ! in nuopc it is like this...... !call State_GetScalar(import_state, & ! flds_scalar_index_nextsw_cday, nextsw_cday, & @@ -848,6 +880,13 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) caldayp1 = get_curr_calday(offset=dtime) + nextsw_cday = caldayp1 + if (masterproc) then + write(iulog,*) 'dtime : ', dtime + write(iulog,*) 'caldayp1 : ', caldayp1 + write(iulog,*) 'nextsw_cday : ', nextsw_cday + end if + !nextsw_cday = 1.02083333333333 if (nstep == 0) then doalb = .false. else if (nstep == 1) then @@ -855,6 +894,10 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) else doalb = (nextsw_cday >= -0.5_r8) end if + + if (masterproc) then + write(iulog,*) 'doalb is: ', doalb + end if call update_rad_dtime(doalb) !-------------------------------- @@ -897,8 +940,26 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) call t_startf ('shr_orb_decl') calday = get_curr_calday() + + if (masterproc) then + write(iulog, *)'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' + write(iulog, *)'call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf )' + write(iulog, *)'call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf )' + write(iulog,*) 'calday is : ', calday + write(iulog,*) 'previous nextsw_cday is : ', nextsw_cday + end if + + !nextsw_cday = 1.02083333333333 + call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) + + if (masterproc) then + write(iulog,*) 'hardwired nextsw_cday is : ', nextsw_cday + write(iulog,*) 'declin is : ', declin + write(iulog,*) 'declinp1 is : ', declinp1 + end if + call t_stopf ('shr_orb_decl') call t_startf ('ctsm_run') @@ -922,8 +983,8 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) call t_startf ('lc_lnd_export') - !call export_fields(exportState, bounds, glc_present, rof_prognostic, & - ! water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) + call export_fields(gcomp, bounds, glc_present, rof_prognostic, & + water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) !call export_fields(exportState, bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, rc) !if (ChkErr(rc,__LINE__,u_FILE_u)) return From 3c5b395d445efebac0cc6a19410d635f3bd97231 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 11 Oct 2019 11:43:26 -0600 Subject: [PATCH 149/556] adding some debuging print statements.... --- src/cpl/lilac/lnd_comp_esmf.F90 | 62 ++++++++++++++++++----------- src/cpl/lilac/lnd_import_export.F90 | 6 ++- 2 files changed, 43 insertions(+), 25 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 10a5c2513e..ac980e4b4b 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -774,7 +774,7 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) integer :: shrlogunit ! original log unit character(len=*),parameter :: subname=trim(modName)//':[lnd_run] ' - character(*),parameter :: F02 = "('[lnd_comp_esmf] ',d26.19)" + character(*),parameter :: F02 = "('[lnd_comp_esmf] ',a, d26.19)" !------------------------------------------------------------------------------- @@ -878,26 +878,39 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) ! Determine doalb based on nextsw_cday sent from atm model !-------------------------------- + calday = get_curr_calday() caldayp1 = get_curr_calday(offset=dtime) - nextsw_cday = caldayp1 - if (masterproc) then - write(iulog,*) 'dtime : ', dtime - write(iulog,*) 'caldayp1 : ', caldayp1 - write(iulog,*) 'nextsw_cday : ', nextsw_cday - end if - !nextsw_cday = 1.02083333333333 + !TODO(NS): nextsw_cday should come directly from atmosphere! What + !should we do + ! For now I am setting nextsw_cday to be the same caldayp1 + + + nextsw_cday = calday if (nstep == 0) then - doalb = .false. + doalb = .false. + nextsw_cday = caldayp1 else if (nstep == 1) then - doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) - else + !doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) + doalb = .false. + else doalb = (nextsw_cday >= -0.5_r8) end if if (masterproc) then write(iulog,*) 'doalb is: ', doalb end if + + if (masterproc) then + write(iulog,*) '------------ LILAC ----------------' + write(iulog,*) 'nstep : ', nstep + write(iulog,*) 'dtime : ', dtime + write(iulog,*) 'calday : ', calday + write(iulog,*) 'caldayp1 : ', caldayp1 + write(iulog,*) 'nextsw_cday : ', nextsw_cday + write(iulog,*) '-------------------------------------' + end if + call update_rad_dtime(doalb) !-------------------------------- @@ -941,23 +954,26 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) call t_startf ('shr_orb_decl') calday = get_curr_calday() - if (masterproc) then - write(iulog, *)'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' - write(iulog, *)'call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf )' - write(iulog, *)'call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf )' - write(iulog,*) 'calday is : ', calday - write(iulog,*) 'previous nextsw_cday is : ', nextsw_cday - end if - - !nextsw_cday = 1.02083333333333 call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) + if (masterproc) then - write(iulog,*) 'hardwired nextsw_cday is : ', nextsw_cday - write(iulog,*) 'declin is : ', declin - write(iulog,*) 'declinp1 is : ', declinp1 + write(iulog,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' + write(iulog,*) 'call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, decl' + write(iulog,*) 'call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, decl' + write(iulog,F02) 'calday is : ', calday + write(iulog,F02) 'eccen is : ', eccen + write(iulog,F02) 'mvelpp is : ', mvelpp + write(iulog,F02) 'lambm0 is : ', lambm0 + write(iulog,F02) 'obliqr is : ', obliqr + write(iulog,F02) 'clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic)' + write(iulog,* ) 'doalb : ', doalb + write(iulog,F02) 'declin is : ', declin + write(iulog,F02) 'declinp1 is : ', declinp1 + write(iulog,F02) 'rof_prognostic : ', rof_prognostic + write(iulog,* ) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' end if call t_stopf ('shr_orb_decl') diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 1514cd6aac..e1b9435b23 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -73,6 +73,7 @@ module lnd_import_export integer, parameter :: debug = 1 ! internal debug level character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" + character(*),parameter :: F02 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d26.19)" character(*),parameter :: u_FILE_u = & __FILE__ character(*),parameter :: modname = "[lnd_import_export]: " @@ -729,6 +730,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & wateratm2lndbulk_inst%forc_rain_not_downscaled_grc(g) = forc_rainc(g) + forc_rainl(g) wateratm2lndbulk_inst%forc_snow_not_downscaled_grc(g) = forc_snowc(g) + forc_snowl(g) + if (forc_t > SHR_CONST_TKFRZ) then e = esatw(tdc(forc_t)) else @@ -1282,7 +1284,7 @@ subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) n = g - bounds%begg + 1 output(g) = fldptr1d(n) if (masterproc .and. debug > 0 .and. get_nstep() < 5) then - write(iulog,F01)' n, g , fldptr1d(n) '//trim(fldname)//' = ',n, g, fldptr1d(n) + write(iulog,F02)' n, g , fldptr1d(n) '//trim(fldname)//' = ',n, g, fldptr1d(n) end if end do end if @@ -1291,7 +1293,7 @@ subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) if (masterproc .and. debug > 0 .and. get_nstep() < 5) then do g = bounds%begg,bounds%endg i = 1 + g - bounds%begg - write(iulog,F01)'import: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,output(g) + write(iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,output(g) end do end if From 44638c7501262bb7afc6440e02741e2d3ec93412 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 11 Oct 2019 11:44:48 -0600 Subject: [PATCH 150/556] deleting the extra files of MCT --- src/cpl/clm_cpl_indices.F90 | 330 ---------------- src/cpl/lnd_comp_mct.F90 | 688 ---------------------------------- src/cpl/lnd_import_export.F90 | 431 --------------------- 3 files changed, 1449 deletions(-) delete mode 100644 src/cpl/clm_cpl_indices.F90 delete mode 100644 src/cpl/lnd_comp_mct.F90 delete mode 100644 src/cpl/lnd_import_export.F90 diff --git a/src/cpl/clm_cpl_indices.F90 b/src/cpl/clm_cpl_indices.F90 deleted file mode 100644 index 525b709cc6..0000000000 --- a/src/cpl/clm_cpl_indices.F90 +++ /dev/null @@ -1,330 +0,0 @@ -module clm_cpl_indices - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! Module containing the indices for the fields passed between CLM and - ! the driver. Includes the River Transport Model fields (RTM) and the - ! fields needed by the land-ice component (sno). - ! - ! !USES: - - use shr_sys_mod, only : shr_sys_abort - implicit none - - SAVE - private ! By default make data private - ! - ! !PUBLIC MEMBER FUNCTIONS: - public :: clm_cpl_indices_set ! Set the coupler indices - ! - ! !PUBLIC DATA MEMBERS: - ! - integer , public :: glc_nec ! number of elevation classes for glacier_mec landunits - ! (from coupler) - must equal maxpatch_glcmec from namelist - - ! lnd -> drv (required) - - integer, public ::index_l2x_Flrl_rofsur ! lnd->rtm input liquid surface fluxes - integer, public ::index_l2x_Flrl_rofgwl ! lnd->rtm input liquid gwl fluxes - integer, public ::index_l2x_Flrl_rofsub ! lnd->rtm input liquid subsurface fluxes - integer, public ::index_l2x_Flrl_rofi ! lnd->rtm input frozen fluxes - integer, public ::index_l2x_Flrl_irrig ! irrigation withdrawal - - integer, public ::index_l2x_Sl_t ! temperature - integer, public ::index_l2x_Sl_tref ! 2m reference temperature - integer, public ::index_l2x_Sl_qref ! 2m reference specific humidity - integer, public ::index_l2x_Sl_avsdr ! albedo: direct , visible - integer, public ::index_l2x_Sl_anidr ! albedo: direct , near-ir - integer, public ::index_l2x_Sl_avsdf ! albedo: diffuse, visible - integer, public ::index_l2x_Sl_anidf ! albedo: diffuse, near-ir - integer, public ::index_l2x_Sl_snowh ! snow height - integer, public ::index_l2x_Sl_u10 ! 10m wind - integer, public ::index_l2x_Sl_ddvel ! dry deposition velocities (optional) - integer, public ::index_l2x_Sl_fv ! friction velocity - integer, public ::index_l2x_Sl_ram1 ! aerodynamical resistance - integer, public ::index_l2x_Sl_soilw ! volumetric soil water - integer, public ::index_l2x_Fall_taux ! wind stress, zonal - integer, public ::index_l2x_Fall_tauy ! wind stress, meridional - integer, public ::index_l2x_Fall_lat ! latent heat flux - integer, public ::index_l2x_Fall_sen ! sensible heat flux - integer, public ::index_l2x_Fall_lwup ! upward longwave heat flux - integer, public ::index_l2x_Fall_evap ! evaporation water flux - integer, public ::index_l2x_Fall_swnet ! heat flux shortwave net - integer, public ::index_l2x_Fall_fco2_lnd ! co2 flux **For testing set to 0 - integer, public ::index_l2x_Fall_flxdst1 ! dust flux size bin 1 - integer, public ::index_l2x_Fall_flxdst2 ! dust flux size bin 2 - integer, public ::index_l2x_Fall_flxdst3 ! dust flux size bin 3 - integer, public ::index_l2x_Fall_flxdst4 ! dust flux size bin 4 - integer, public ::index_l2x_Fall_flxvoc ! MEGAN fluxes - integer, public ::index_l2x_Fall_flxfire ! Fire fluxes - integer, public ::index_l2x_Sl_ztopfire ! Top of fire emissions (m) - - ! In the following, index 0 is bare land, other indices are glc elevation classes - integer, allocatable, public ::index_l2x_Sl_tsrf(:) ! glc MEC temperature - integer, allocatable, public ::index_l2x_Sl_topo(:) ! glc MEC topo height - integer, allocatable, public ::index_l2x_Flgl_qice(:) ! glc MEC ice flux - - integer, public ::index_x2l_Sa_methane - integer, public ::index_l2x_Fall_methane - - integer, public :: nflds_l2x = 0 - - ! drv -> lnd (required) - - integer, public ::index_x2l_Sa_z ! bottom atm level height - integer, public ::index_x2l_Sa_topo ! atm surface height (m) - integer, public ::index_x2l_Sa_u ! bottom atm level zon wind - integer, public ::index_x2l_Sa_v ! bottom atm level mer wind - integer, public ::index_x2l_Sa_ptem ! bottom atm level pot temp - integer, public ::index_x2l_Sa_shum ! bottom atm level spec hum - integer, public ::index_x2l_Sa_pbot ! bottom atm level pressure - integer, public ::index_x2l_Sa_tbot ! bottom atm level temp - integer, public ::index_x2l_Faxa_lwdn ! downward lw heat flux - integer, public ::index_x2l_Faxa_rainc ! prec: liquid "convective" - integer, public ::index_x2l_Faxa_rainl ! prec: liquid "large scale" - integer, public ::index_x2l_Faxa_snowc ! prec: frozen "convective" - integer, public ::index_x2l_Faxa_snowl ! prec: frozen "large scale" - integer, public ::index_x2l_Faxa_swndr ! sw: nir direct downward - integer, public ::index_x2l_Faxa_swvdr ! sw: vis direct downward - integer, public ::index_x2l_Faxa_swndf ! sw: nir diffuse downward - integer, public ::index_x2l_Faxa_swvdf ! sw: vis diffuse downward - integer, public ::index_x2l_Sa_co2prog ! bottom atm level prognostic co2 - integer, public ::index_x2l_Sa_co2diag ! bottom atm level diagnostic co2 - integer, public ::index_x2l_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition - integer, public ::index_x2l_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition - integer, public ::index_x2l_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition - integer, public ::index_x2l_Faxa_ocphidry ! flux: Organic Carbon hydrophilic dry deposition - integer, public ::index_x2l_Faxa_ocphodry ! flux: Organic Carbon hydrophobic dry deposition - integer, public ::index_x2l_Faxa_ocphiwet ! flux: Organic Carbon hydrophilic dry deposition - integer, public ::index_x2l_Faxa_dstwet1 ! flux: Size 1 dust -- wet deposition - integer, public ::index_x2l_Faxa_dstwet2 ! flux: Size 2 dust -- wet deposition - integer, public ::index_x2l_Faxa_dstwet3 ! flux: Size 3 dust -- wet deposition - integer, public ::index_x2l_Faxa_dstwet4 ! flux: Size 4 dust -- wet deposition - integer, public ::index_x2l_Faxa_dstdry1 ! flux: Size 1 dust -- dry deposition - integer, public ::index_x2l_Faxa_dstdry2 ! flux: Size 2 dust -- dry deposition - integer, public ::index_x2l_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition - integer, public ::index_x2l_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition - - integer, public ::index_x2l_Faxa_nhx ! flux nhx from atm - integer, public ::index_x2l_Faxa_noy ! flux noy from atm - - integer, public ::index_x2l_Flrr_flood ! rtm->lnd rof flood flux - integer, public ::index_x2l_Flrr_volr ! rtm->lnd rof volr total volume - integer, public ::index_x2l_Flrr_volrmch ! rtm->lnd rof volr main channel volume - - ! In the following, index 0 is bare land, other indices are glc elevation classes - integer, allocatable, public ::index_x2l_Sg_ice_covered(:) ! Fraction of glacier from glc model - integer, allocatable, public ::index_x2l_Sg_topo(:) ! Topo height from glc model - integer, allocatable, public ::index_x2l_Flgg_hflx(:) ! Heat flux from glc model - - integer, public ::index_x2l_Sg_icemask - integer, public ::index_x2l_Sg_icemask_coupled_fluxes - - integer, public :: nflds_x2l = 0 - - !----------------------------------------------------------------------- - -contains - - !----------------------------------------------------------------------- - subroutine clm_cpl_indices_set( ) - ! - ! !DESCRIPTION: - ! Set the coupler indices needed by the land model coupler - ! interface. - ! - ! !USES: - use seq_flds_mod , only: seq_flds_x2l_fields, seq_flds_l2x_fields - use mct_mod , only: mct_aVect, mct_aVect_init, mct_avect_indexra - use mct_mod , only: mct_aVect_clean, mct_avect_nRattr - use seq_drydep_mod , only: drydep_fields_token, lnd_drydep - use shr_megan_mod , only: shr_megan_fields_token, shr_megan_mechcomps_n - use shr_fire_emis_mod,only: shr_fire_emis_fields_token, shr_fire_emis_ztop_token, shr_fire_emis_mechcomps_n - use clm_varctl , only: ndep_from_cpl - use glc_elevclass_mod, only: glc_get_num_elevation_classes, glc_elevclass_as_string - ! - ! !ARGUMENTS: - implicit none - ! - ! !REVISION HISTORY: - ! Author: Mariana Vertenstein - ! 01/2011, Erik Kluzek: Added protex headers - ! - ! !LOCAL VARIABLES: - type(mct_aVect) :: l2x ! temporary, land to coupler - type(mct_aVect) :: x2l ! temporary, coupler to land - integer :: num - character(len=:), allocatable :: nec_str ! string version of glc elev. class number - character(len=64) :: name - character(len=32) :: subname = 'clm_cpl_indices_set' ! subroutine name - !----------------------------------------------------------------------- - - ! Determine attribute vector indices - - ! create temporary attribute vectors - call mct_aVect_init(x2l, rList=seq_flds_x2l_fields, lsize=1) - nflds_x2l = mct_avect_nRattr(x2l) - - call mct_aVect_init(l2x, rList=seq_flds_l2x_fields, lsize=1) - nflds_l2x = mct_avect_nRattr(l2x) - - !------------------------------------------------------------- - ! clm -> drv - !------------------------------------------------------------- - - index_l2x_Flrl_rofsur = mct_avect_indexra(l2x,'Flrl_rofsur') - index_l2x_Flrl_rofgwl = mct_avect_indexra(l2x,'Flrl_rofgwl') - index_l2x_Flrl_rofsub = mct_avect_indexra(l2x,'Flrl_rofsub') - index_l2x_Flrl_rofi = mct_avect_indexra(l2x,'Flrl_rofi') - index_l2x_Flrl_irrig = mct_avect_indexra(l2x,'Flrl_irrig') - - index_l2x_Sl_t = mct_avect_indexra(l2x,'Sl_t') - index_l2x_Sl_snowh = mct_avect_indexra(l2x,'Sl_snowh') - index_l2x_Sl_avsdr = mct_avect_indexra(l2x,'Sl_avsdr') - index_l2x_Sl_anidr = mct_avect_indexra(l2x,'Sl_anidr') - index_l2x_Sl_avsdf = mct_avect_indexra(l2x,'Sl_avsdf') - index_l2x_Sl_anidf = mct_avect_indexra(l2x,'Sl_anidf') - index_l2x_Sl_tref = mct_avect_indexra(l2x,'Sl_tref') - index_l2x_Sl_qref = mct_avect_indexra(l2x,'Sl_qref') - index_l2x_Sl_u10 = mct_avect_indexra(l2x,'Sl_u10') - index_l2x_Sl_ram1 = mct_avect_indexra(l2x,'Sl_ram1') - index_l2x_Sl_fv = mct_avect_indexra(l2x,'Sl_fv') - index_l2x_Sl_soilw = mct_avect_indexra(l2x,'Sl_soilw',perrwith='quiet') - - if ( lnd_drydep )then - index_l2x_Sl_ddvel = mct_avect_indexra(l2x, trim(drydep_fields_token)) - else - index_l2x_Sl_ddvel = 0 - end if - - index_l2x_Fall_taux = mct_avect_indexra(l2x,'Fall_taux') - index_l2x_Fall_tauy = mct_avect_indexra(l2x,'Fall_tauy') - index_l2x_Fall_lat = mct_avect_indexra(l2x,'Fall_lat') - index_l2x_Fall_sen = mct_avect_indexra(l2x,'Fall_sen') - index_l2x_Fall_lwup = mct_avect_indexra(l2x,'Fall_lwup') - index_l2x_Fall_evap = mct_avect_indexra(l2x,'Fall_evap') - index_l2x_Fall_swnet = mct_avect_indexra(l2x,'Fall_swnet') - index_l2x_Fall_flxdst1 = mct_avect_indexra(l2x,'Fall_flxdst1') - index_l2x_Fall_flxdst2 = mct_avect_indexra(l2x,'Fall_flxdst2') - index_l2x_Fall_flxdst3 = mct_avect_indexra(l2x,'Fall_flxdst3') - index_l2x_Fall_flxdst4 = mct_avect_indexra(l2x,'Fall_flxdst4') - - index_l2x_Fall_fco2_lnd = mct_avect_indexra(l2x,'Fall_fco2_lnd',perrwith='quiet') - - index_l2x_Fall_methane = mct_avect_indexra(l2x,'Fall_methane',perrWith='quiet') - - ! MEGAN fluxes - if (shr_megan_mechcomps_n>0) then - index_l2x_Fall_flxvoc = mct_avect_indexra(l2x,trim(shr_megan_fields_token)) - else - index_l2x_Fall_flxvoc = 0 - endif - - ! Fire fluxes - if (shr_fire_emis_mechcomps_n>0) then - index_l2x_Fall_flxfire = mct_avect_indexra(l2x,trim(shr_fire_emis_fields_token)) - index_l2x_Sl_ztopfire = mct_avect_indexra(l2x,trim(shr_fire_emis_ztop_token)) - else - index_l2x_Fall_flxfire = 0 - index_l2x_Sl_ztopfire = 0 - endif - - !------------------------------------------------------------- - ! drv -> clm - !------------------------------------------------------------- - - index_x2l_Sa_z = mct_avect_indexra(x2l,'Sa_z') - index_x2l_Sa_topo = mct_avect_indexra(x2l,'Sa_topo') - index_x2l_Sa_u = mct_avect_indexra(x2l,'Sa_u') - index_x2l_Sa_v = mct_avect_indexra(x2l,'Sa_v') - index_x2l_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') - index_x2l_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') - index_x2l_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') - index_x2l_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') - index_x2l_Sa_co2prog = mct_avect_indexra(x2l,'Sa_co2prog',perrwith='quiet') - index_x2l_Sa_co2diag = mct_avect_indexra(x2l,'Sa_co2diag',perrwith='quiet') - - index_x2l_Sa_methane = mct_avect_indexra(x2l,'Sa_methane',perrWith='quiet') - - index_x2l_Flrr_volr = mct_avect_indexra(x2l,'Flrr_volr') - index_x2l_Flrr_volrmch = mct_avect_indexra(x2l,'Flrr_volrmch') - - index_x2l_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') - index_x2l_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') - index_x2l_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') - index_x2l_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') - index_x2l_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') - index_x2l_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') - index_x2l_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') - index_x2l_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') - index_x2l_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') - index_x2l_Faxa_bcphidry = mct_avect_indexra(x2l,'Faxa_bcphidry') - index_x2l_Faxa_bcphodry = mct_avect_indexra(x2l,'Faxa_bcphodry') - index_x2l_Faxa_bcphiwet = mct_avect_indexra(x2l,'Faxa_bcphiwet') - index_x2l_Faxa_ocphidry = mct_avect_indexra(x2l,'Faxa_ocphidry') - index_x2l_Faxa_ocphodry = mct_avect_indexra(x2l,'Faxa_ocphodry') - index_x2l_Faxa_ocphiwet = mct_avect_indexra(x2l,'Faxa_ocphiwet') - index_x2l_Faxa_dstdry1 = mct_avect_indexra(x2l,'Faxa_dstdry1') - index_x2l_Faxa_dstdry2 = mct_avect_indexra(x2l,'Faxa_dstdry2') - index_x2l_Faxa_dstdry3 = mct_avect_indexra(x2l,'Faxa_dstdry3') - index_x2l_Faxa_dstdry4 = mct_avect_indexra(x2l,'Faxa_dstdry4') - index_x2l_Faxa_dstwet1 = mct_avect_indexra(x2l,'Faxa_dstwet1') - index_x2l_Faxa_dstwet2 = mct_avect_indexra(x2l,'Faxa_dstwet2') - index_x2l_Faxa_dstwet3 = mct_avect_indexra(x2l,'Faxa_dstwet3') - index_x2l_Faxa_dstwet4 = mct_avect_indexra(x2l,'Faxa_dstwet4') - - index_x2l_Faxa_nhx = mct_avect_indexra(x2l,'Faxa_nhx', perrWith='quiet') - index_x2l_Faxa_noy = mct_avect_indexra(x2l,'Faxa_noy', perrWith='quiet') - - if (index_x2l_Faxa_nhx > 0 .and. index_x2l_Faxa_noy > 0) then - ndep_from_cpl = .true. - end if - - index_x2l_Flrr_flood = mct_avect_indexra(x2l,'Flrr_flood') - - !------------------------------------------------------------- - ! glc coupling - !------------------------------------------------------------- - - index_x2l_Sg_icemask = mct_avect_indexra(x2l,'Sg_icemask') - index_x2l_Sg_icemask_coupled_fluxes = mct_avect_indexra(x2l,'Sg_icemask_coupled_fluxes') - - glc_nec = glc_get_num_elevation_classes() - if (glc_nec < 1) then - call shr_sys_abort('ERROR: In CLM4.5 and later, glc_nec must be at least 1.') - end if - - ! Create coupling fields for all glc elevation classes (1:glc_nec) plus bare land - ! (index 0). - allocate(index_l2x_Sl_tsrf(0:glc_nec)) - allocate(index_l2x_Sl_topo(0:glc_nec)) - allocate(index_l2x_Flgl_qice(0:glc_nec)) - allocate(index_x2l_Sg_ice_covered(0:glc_nec)) - allocate(index_x2l_Sg_topo(0:glc_nec)) - allocate(index_x2l_Flgg_hflx(0:glc_nec)) - - do num = 0,glc_nec - nec_str = glc_elevclass_as_string(num) - - name = 'Sg_ice_covered' // nec_str - index_x2l_Sg_ice_covered(num) = mct_avect_indexra(x2l,trim(name)) - name = 'Sg_topo' // nec_str - index_x2l_Sg_topo(num) = mct_avect_indexra(x2l,trim(name)) - name = 'Flgg_hflx' // nec_str - index_x2l_Flgg_hflx(num) = mct_avect_indexra(x2l,trim(name)) - - name = 'Sl_tsrf' // nec_str - index_l2x_Sl_tsrf(num) = mct_avect_indexra(l2x,trim(name)) - name = 'Sl_topo' // nec_str - index_l2x_Sl_topo(num) = mct_avect_indexra(l2x,trim(name)) - name = 'Flgl_qice' // nec_str - index_l2x_Flgl_qice(num) = mct_avect_indexra(l2x,trim(name)) - end do - - call mct_aVect_clean(x2l) - call mct_aVect_clean(l2x) - - end subroutine clm_cpl_indices_set - -!======================================================================= - -end module clm_cpl_indices diff --git a/src/cpl/lnd_comp_mct.F90 b/src/cpl/lnd_comp_mct.F90 deleted file mode 100644 index 42e038ea48..0000000000 --- a/src/cpl/lnd_comp_mct.F90 +++ /dev/null @@ -1,688 +0,0 @@ -module lnd_comp_mct - - !--------------------------------------------------------------------------- - ! !DESCRIPTION: - ! Interface of the active land model component of CESM the CLM (Community Land Model) - ! with the main CESM driver. This is a thin interface taking CESM driver information - ! in MCT (Model Coupling Toolkit) format and converting it to use by CLM. - ! - ! !uses: - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_sys_mod , only : shr_sys_flush - use mct_mod , only : mct_avect, mct_gsmap, mct_gGrid - use decompmod , only : bounds_type, ldecomp - use lnd_import_export, only : lnd_import, lnd_export - ! - ! !public member functions: - implicit none - save - private ! by default make data private - ! - ! !public member functions: - public :: lnd_init_mct ! clm initialization - public :: lnd_run_mct ! clm run phase - public :: lnd_final_mct ! clm finalization/cleanup - ! - ! !private member functions: - private :: lnd_setgsmap_mct ! set the land model mct gs map - private :: lnd_domain_mct ! set the land model domain information - private :: lnd_handle_resume ! handle pause/resume signals from the coupler - !--------------------------------------------------------------------------- - -contains - - !==================================================================================== - - subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) - ! - ! !DESCRIPTION: - ! Initialize land surface model and obtain relevant atmospheric model arrays - ! back from (i.e. albedos, surface temperature and snow cover over land). - ! - ! !USES: - use shr_kind_mod , only : shr_kind_cl - use abortutils , only : endrun - use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, set_nextsw_cday - use clm_initializeMod, only : initialize1, initialize2 - use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst - use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog, noland - use clm_varctl , only : inst_index, inst_suffix, inst_name - use clm_varorb , only : eccen, obliqr, lambm0, mvelpp - use controlMod , only : control_setNL - use decompMod , only : get_proc_bounds - use domainMod , only : ldomain - use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel - use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel - use shr_file_mod , only : shr_file_getUnit, shr_file_setIO - use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs - use seq_timemgr_mod , only : seq_timemgr_EClockGetData - use seq_infodata_mod , only : seq_infodata_type, seq_infodata_GetData, seq_infodata_PutData, & - seq_infodata_start_type_start, seq_infodata_start_type_cont, & - seq_infodata_start_type_brnch - use seq_comm_mct , only : seq_comm_suffix, seq_comm_inst, seq_comm_name - use seq_flds_mod , only : seq_flds_x2l_fields, seq_flds_l2x_fields - use spmdMod , only : masterproc, spmd_init - use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch - use clm_cpl_indices , only : clm_cpl_indices_set - use mct_mod , only : mct_aVect_init, mct_aVect_zero, mct_gsMap_lsize - use ESMF - ! - ! !ARGUMENTS: - type(ESMF_Clock), intent(inout) :: EClock ! Input synchronization clock - type(seq_cdata), intent(inout) :: cdata_l ! Input land-model driver data - type(mct_aVect), intent(inout) :: x2l_l, l2x_l ! land model import and export states - character(len=*), optional, intent(in) :: NLFilename ! Namelist filename to read - ! - ! !LOCAL VARIABLES: - integer :: LNDID ! Land identifyer - integer :: mpicom_lnd ! MPI communicator - type(mct_gsMap), pointer :: GSMap_lnd ! Land model MCT GS map - type(mct_gGrid), pointer :: dom_l ! Land model domain - type(seq_infodata_type), pointer :: infodata ! CESM driver level info data - integer :: lsize ! size of attribute vector - integer :: g,i,j ! indices - integer :: dtime_sync ! coupling time-step from the input synchronization clock - integer :: dtime_clm ! clm time-step - logical :: exists ! true if file exists - logical :: atm_aero ! Flag if aerosol data sent from atm model - real(r8) :: scmlat ! single-column latitude - real(r8) :: scmlon ! single-column longitude - real(r8) :: nextsw_cday ! calday from clock of next radiation computation - character(len=SHR_KIND_CL) :: caseid ! case identifier name - character(len=SHR_KIND_CL) :: ctitle ! case description title - character(len=SHR_KIND_CL) :: starttype ! start-type (startup, continue, branch, hybrid) - character(len=SHR_KIND_CL) :: calendar ! calendar type name - character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on - character(len=SHR_KIND_CL) :: version ! Model version - character(len=SHR_KIND_CL) :: username ! user running the model - integer :: nsrest ! clm restart type - integer :: ref_ymd ! reference date (YYYYMMDD) - integer :: ref_tod ! reference time of day (sec) - integer :: start_ymd ! start date (YYYYMMDD) - integer :: start_tod ! start time of day (sec) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) - logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type - integer :: lbnum ! input to memory diagnostic - integer :: shrlogunit,shrloglev ! old values for log unit and log level - type(bounds_type) :: bounds ! bounds - character(len=32), parameter :: sub = 'lnd_init_mct' - character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" - !----------------------------------------------------------------------- - - ! Set cdata data - - call seq_cdata_setptrs(cdata_l, ID=LNDID, mpicom=mpicom_lnd, & - gsMap=GSMap_lnd, dom=dom_l, infodata=infodata) - - ! Determine attriute vector indices - - call clm_cpl_indices_set() - - ! Initialize clm MPI communicator - - call spmd_init( mpicom_lnd, LNDID ) - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','lnd_init_mct:start::',lbnum) - endif -#endif - - inst_name = seq_comm_name(LNDID) - inst_index = seq_comm_inst(LNDID) - inst_suffix = seq_comm_suffix(LNDID) - - ! Initialize io log unit - - call shr_file_getLogUnit (shrlogunit) - if (masterproc) then - inquire(file='lnd_modelio.nml'//trim(inst_suffix),exist=exists) - if (exists) then - iulog = shr_file_getUnit() - call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),iulog) - end if - write(iulog,format) "CLM land model initialization" - else - iulog = shrlogunit - end if - - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (iulog) - - ! Use infodata to set orbital values - - call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & - orb_lambm0=lambm0, orb_obliqr=obliqr ) - - ! Consistency check on namelist filename - - call control_setNL("lnd_in"//trim(inst_suffix)) - - ! Initialize clm - ! initialize1 reads namelist, grid and surface data (need this to initialize gsmap) - ! initialize2 performs rest of initialization - - call seq_timemgr_EClockGetData(EClock, & - start_ymd=start_ymd, & - start_tod=start_tod, ref_ymd=ref_ymd, & - ref_tod=ref_tod, stop_ymd=stop_ymd, & - stop_tod=stop_tod, & - calendar=calendar ) - call seq_infodata_GetData(infodata, case_name=caseid, & - case_desc=ctitle, single_column=single_column, & - scmlat=scmlat, scmlon=scmlon, & - brnch_retain_casename=brnch_retain_casename, & - start_type=starttype, model_version=version, & - hostname=hostname, username=username ) - call set_timemgr_init( calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & - ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, stop_ymd_in=stop_ymd, & - stop_tod_in=stop_tod) - if ( trim(starttype) == trim(seq_infodata_start_type_start)) then - nsrest = nsrStartup - else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then - nsrest = nsrContinue - else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then - nsrest = nsrBranch - else - call endrun( sub//' ERROR: unknown starttype' ) - end if - - call clm_varctl_set(caseid_in=caseid, ctitle_in=ctitle, & - brnch_retain_casename_in=brnch_retain_casename, & - single_column_in=single_column, scmlat_in=scmlat, & - scmlon_in=scmlon, nsrest_in=nsrest, version_in=version, & - hostname_in=hostname, username_in=username) - - ! Read namelist, grid and surface data - - call initialize1( ) - - ! If no land then exit out of initialization - - if ( noland ) then - call seq_infodata_PutData( infodata, lnd_present =.false.) - call seq_infodata_PutData( infodata, lnd_prognostic=.false.) - return - end if - - ! Determine if aerosol and dust deposition come from atmosphere component - - call seq_infodata_GetData(infodata, atm_aero=atm_aero ) - if ( .not. atm_aero )then - call endrun( sub//' ERROR: atmosphere model MUST send aerosols to CLM' ) - end if - - ! Initialize clm gsMap, clm domain and clm attribute vectors - - call get_proc_bounds( bounds ) - - call lnd_SetgsMap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) - lsize = mct_gsMap_lsize(gsMap_lnd, mpicom_lnd) - - call lnd_domain_mct( bounds, lsize, gsMap_lnd, dom_l ) - - call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsize) - call mct_aVect_zero(x2l_l) - - call mct_aVect_init(l2x_l, rList=seq_flds_l2x_fields, lsize=lsize) - call mct_aVect_zero(l2x_l) - - ! Finish initializing clm - - call initialize2() - - ! Check that clm internal dtime aligns with clm coupling interval - - call seq_timemgr_EClockGetData(EClock, dtime=dtime_sync ) - dtime_clm = get_step_size() - if (masterproc) then - write(iulog,*)'dtime_sync= ',dtime_sync,& - ' dtime_clm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) - end if - if (mod(dtime_sync,dtime_clm) /= 0) then - write(iulog,*)'clm dtime ',dtime_clm,' and Eclock dtime ',& - dtime_sync,' never align' - call endrun( sub//' ERROR: time out of sync' ) - end if - - ! Create land export state - - call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) - - ! Fill in infodata settings - - call seq_infodata_PutData(infodata, lnd_prognostic=.true.) - call seq_infodata_PutData(infodata, lnd_nx=ldomain%ni, lnd_ny=ldomain%nj) - - ! Get infodata info - - call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) - call set_nextsw_cday(nextsw_cday) - call lnd_handle_resume( cdata_l ) - - ! Reset shr logging to original values - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - -#if (defined _MEMTRACE) - if(masterproc) then - write(iulog,*) TRIM(Sub) // ':end::' - lbnum=1 - call memmon_dump_fort('memmon.out','lnd_int_mct:end::',lbnum) - call memmon_reset_addr() - endif -#endif - - end subroutine lnd_init_mct - - !==================================================================================== - - subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) - ! - ! !DESCRIPTION: - ! Run clm model - ! - ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use clm_instMod , only : water_inst, lnd2atm_inst, atm2lnd_inst, lnd2glc_inst, glc2lnd_inst - use clm_driver , only : clm_drv - use clm_time_manager, only : get_curr_date, get_nstep, get_curr_calday, get_step_size - use clm_time_manager, only : advance_timestep, set_nextsw_cday,update_rad_dtime - use decompMod , only : get_proc_bounds - use abortutils , only : endrun - use clm_varctl , only : iulog - use clm_varorb , only : eccen, obliqr, lambm0, mvelpp - use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel - use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel - use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs - use seq_timemgr_mod , only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn - use seq_timemgr_mod , only : seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync - use seq_infodata_mod, only : seq_infodata_type, seq_infodata_GetData - use spmdMod , only : masterproc, mpicom - use perf_mod , only : t_startf, t_stopf, t_barrierf - use shr_orb_mod , only : shr_orb_decl - use ESMF - ! - ! !ARGUMENTS: - type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver - type(seq_cdata) , intent(inout) :: cdata_l ! Input driver data for land model - type(mct_aVect) , intent(inout) :: x2l_l ! Import state to land model - type(mct_aVect) , intent(inout) :: l2x_l ! Export state from land model - ! - ! !LOCAL VARIABLES: - integer :: ymd_sync ! Sync date (YYYYMMDD) - integer :: yr_sync ! Sync current year - integer :: mon_sync ! Sync current month - integer :: day_sync ! Sync current day - integer :: tod_sync ! Sync current time of day (sec) - integer :: ymd ! CLM current date (YYYYMMDD) - integer :: yr ! CLM current year - integer :: mon ! CLM current month - integer :: day ! CLM current day - integer :: tod ! CLM current time of day (sec) - integer :: dtime ! time step increment (sec) - integer :: nstep ! time step index - logical :: rstwr_sync ! .true. ==> write restart file before returning - logical :: rstwr ! .true. ==> write restart file before returning - logical :: nlend_sync ! Flag signaling last time-step - logical :: nlend ! .true. ==> last time-step - logical :: dosend ! true => send data back to driver - logical :: doalb ! .true. ==> do albedo calculation on this time step - logical :: rof_prognostic ! .true. => running with a prognostic ROF model - logical :: glc_present ! .true. => running with a non-stub GLC model - real(r8) :: nextsw_cday ! calday from clock of next radiation computation - real(r8) :: caldayp1 ! clm calday plus dtime offset - integer :: shrlogunit,shrloglev ! old values for share log unit and log level - integer :: lbnum ! input to memory diagnostic - integer :: g,i,lsize ! counters - real(r8) :: calday ! calendar day for nstep - real(r8) :: declin ! solar declination angle in radians for nstep - real(r8) :: declinp1 ! solar declination angle in radians for nstep+1 - real(r8) :: eccf ! earth orbit eccentricity factor - real(r8) :: recip ! reciprical - logical,save :: first_call = .true. ! first call work - type(seq_infodata_type),pointer :: infodata ! CESM information from the driver - type(mct_gGrid), pointer :: dom_l ! Land model domain data - type(bounds_type) :: bounds ! bounds - character(len=32) :: rdate ! date char string for restart file names - character(len=32), parameter :: sub = "lnd_run_mct" - !--------------------------------------------------------------------------- - - ! Determine processor bounds - - call get_proc_bounds(bounds) - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','lnd_run_mct:start::',lbnum) - endif -#endif - - ! Reset shr logging to my log file - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (iulog) - - ! Determine time of next atmospheric shortwave calculation - call seq_cdata_setptrs(cdata_l, infodata=infodata, dom=dom_l) - call seq_timemgr_EClockGetData(EClock, & - curr_ymd=ymd, curr_tod=tod_sync, & - curr_yr=yr_sync, curr_mon=mon_sync, curr_day=day_sync) - call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) - - call set_nextsw_cday( nextsw_cday ) - dtime = get_step_size() - - ! Handle pause/resume signals from coupler - call lnd_handle_resume( cdata_l ) - - write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync,mon_sync,day_sync,tod_sync - nlend_sync = seq_timemgr_StopAlarmIsOn( EClock ) - rstwr_sync = seq_timemgr_RestartAlarmIsOn( EClock ) - - ! Determine if we're running with a prognostic ROF model, and if we're running with a - ! non-stub GLC model. These won't change throughout the run, but we can't count on - ! their being set in initialization, so need to get them in the run method. - - call seq_infodata_GetData( infodata, & - rof_prognostic=rof_prognostic, & - glc_present=glc_present) - - ! Map MCT to land data type - ! Perform downscaling if appropriate - - - ! Map to clm (only when state and/or fluxes need to be updated) - - call t_startf ('lc_lnd_import') - call lnd_import( bounds, & - x2l = x2l_l%rattr, & - glc_present = glc_present, & - atm2lnd_inst = atm2lnd_inst, & - glc2lnd_inst = glc2lnd_inst, & - wateratm2lndbulk_inst = water_inst%wateratm2lndbulk_inst) - call t_stopf ('lc_lnd_import') - - ! Use infodata to set orbital values if updated mid-run - - call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & - orb_lambm0=lambm0, orb_obliqr=obliqr ) - - ! Loop over time steps in coupling interval - - dosend = .false. - do while(.not. dosend) - - ! Determine if dosend - ! When time is not updated at the beginning of the loop - then return only if - ! are in sync with clock before time is updated - - call get_curr_date( yr, mon, day, tod ) - ymd = yr*10000 + mon*100 + day - tod = tod - dosend = (seq_timemgr_EClockDateInSync( EClock, ymd, tod)) - - ! Determine doalb based on nextsw_cday sent from atm model - - nstep = get_nstep() - caldayp1 = get_curr_calday(offset=dtime) - if (nstep == 0) then - doalb = .false. - else if (nstep == 1) then - doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) - else - doalb = (nextsw_cday >= -0.5_r8) - end if - call update_rad_dtime(doalb) - - ! Determine if time to write cam restart and stop - - rstwr = .false. - if (rstwr_sync .and. dosend) rstwr = .true. - nlend = .false. - if (nlend_sync .and. dosend) nlend = .true. - - ! Run clm - - call t_barrierf('sync_clm_run1', mpicom) - call t_startf ('clm_run') - call t_startf ('shr_orb_decl') - calday = get_curr_calday() - call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) - call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) - call t_stopf ('shr_orb_decl') - call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic) - call t_stopf ('clm_run') - - ! Create l2x_l export state - add river runoff input to l2x_l if appropriate - - call t_startf ('lc_lnd_export') - call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) - call t_stopf ('lc_lnd_export') - - ! Advance clm time step - - call t_startf ('lc_clm2_adv_timestep') - call advance_timestep() - call t_stopf ('lc_clm2_adv_timestep') - - end do - - ! Check that internal clock is in sync with master clock - - call get_curr_date( yr, mon, day, tod, offset=-dtime ) - ymd = yr*10000 + mon*100 + day - tod = tod - if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then - call seq_timemgr_EclockGetData( EClock, curr_ymd=ymd_sync, curr_tod=tod_sync ) - write(iulog,*)' clm ymd=',ymd ,' clm tod= ',tod - write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync - call endrun( sub//":: CLM clock not in sync with Master Sync clock" ) - end if - - ! Reset shr logging to my original values - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','lnd_run_mct:end::',lbnum) - call memmon_reset_addr() - endif -#endif - - first_call = .false. - - end subroutine lnd_run_mct - - !==================================================================================== - - subroutine lnd_final_mct( EClock, cdata_l, x2l_l, l2x_l) - ! - ! !DESCRIPTION: - ! Finalize land surface model - - use seq_cdata_mod ,only : seq_cdata, seq_cdata_setptrs - use seq_timemgr_mod ,only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn - use seq_timemgr_mod ,only : seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync - use esmf - ! - ! !ARGUMENTS: - type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver - type(seq_cdata) , intent(inout) :: cdata_l ! Input driver data for land model - type(mct_aVect) , intent(inout) :: x2l_l ! Import state to land model - type(mct_aVect) , intent(inout) :: l2x_l ! Export state from land model - !--------------------------------------------------------------------------- - - ! fill this in - end subroutine lnd_final_mct - - !==================================================================================== - - subroutine lnd_setgsmap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) - ! - ! !DESCRIPTION: - ! Set the MCT GS map for the land model - ! - ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use domainMod , only : ldomain - use mct_mod , only : mct_gsMap, mct_gsMap_init - implicit none - ! - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds ! bounds - integer , intent(in) :: mpicom_lnd ! MPI communicator for the clm land model - integer , intent(in) :: LNDID ! Land model identifyer number - type(mct_gsMap) , intent(out) :: gsMap_lnd ! Resulting MCT GS map for the land model - ! - ! !LOCAL VARIABLES: - integer,allocatable :: gindex(:) ! Number the local grid points - integer :: i, j, n, gi ! Indices - integer :: lsize,gsize ! GS Map size - integer :: ier ! Error code - !--------------------------------------------------------------------------- - - ! Build the land grid numbering for MCT - ! NOTE: Numbering scheme is: West to East and South to North - ! starting at south pole. Should be the same as what's used in SCRIP - - allocate(gindex(bounds%begg:bounds%endg),stat=ier) - - ! number the local grid - - do n = bounds%begg, bounds%endg - gindex(n) = ldecomp%gdc2glo(n) - end do - lsize = bounds%endg - bounds%begg + 1 - gsize = ldomain%ni * ldomain%nj - - call mct_gsMap_init( gsMap_lnd, gindex, mpicom_lnd, LNDID, lsize, gsize ) - - deallocate(gindex) - - end subroutine lnd_SetgsMap_mct - - !==================================================================================== - - subroutine lnd_domain_mct( bounds, lsize, gsMap_l, dom_l ) - ! - ! !DESCRIPTION: - ! Send the land model domain information to the coupler - ! - ! !USES: - use clm_varcon , only: re - use domainMod , only: ldomain - use spmdMod , only: iam - use mct_mod , only: mct_gGrid_importIAttr - use mct_mod , only: mct_gGrid_importRAttr, mct_gGrid_init, mct_gsMap_orderedPoints - use seq_flds_mod, only: seq_flds_dom_coord, seq_flds_dom_other - ! - ! !ARGUMENTS: - type(bounds_type), intent(in) :: bounds ! bounds - integer , intent(in) :: lsize ! land model domain data size - type(mct_gsMap), intent(inout) :: gsMap_l ! Output land model MCT GS map - type(mct_ggrid), intent(out) :: dom_l ! Output domain information for land model - ! - ! Local Variables - integer :: g,i,j ! index - real(r8), pointer :: data(:) ! temporary - integer , pointer :: idata(:) ! temporary - !--------------------------------------------------------------------------- - ! - ! Initialize mct domain type - ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) - ! Note that in addition land carries around landfrac for the purposes of domain checking - ! - call mct_gGrid_init( GGrid=dom_l, CoordChars=trim(seq_flds_dom_coord), & - OtherChars=trim(seq_flds_dom_other), lsize=lsize ) - ! - ! Allocate memory - ! - allocate(data(lsize)) - ! - ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT - ! - call mct_gsMap_orderedPoints(gsMap_l, iam, idata) - call mct_gGrid_importIAttr(dom_l,'GlobGridNum',idata,lsize) - ! - ! Determine domain (numbering scheme is: West to East and South to North to South pole) - ! Initialize attribute vector with special value - ! - data(:) = -9999.0_R8 - call mct_gGrid_importRAttr(dom_l,"lat" ,data,lsize) - call mct_gGrid_importRAttr(dom_l,"lon" ,data,lsize) - call mct_gGrid_importRAttr(dom_l,"area" ,data,lsize) - call mct_gGrid_importRAttr(dom_l,"aream",data,lsize) - data(:) = 0.0_R8 - call mct_gGrid_importRAttr(dom_l,"mask" ,data,lsize) - ! - ! Fill in correct values for domain components - ! Note aream will be filled in in the atm-lnd mapper - ! - do g = bounds%begg,bounds%endg - i = 1 + (g - bounds%begg) - data(i) = ldomain%lonc(g) - end do - call mct_gGrid_importRattr(dom_l,"lon",data,lsize) - - do g = bounds%begg,bounds%endg - i = 1 + (g - bounds%begg) - data(i) = ldomain%latc(g) - end do - call mct_gGrid_importRattr(dom_l,"lat",data,lsize) - - do g = bounds%begg,bounds%endg - i = 1 + (g - bounds%begg) - data(i) = ldomain%area(g)/(re*re) - end do - call mct_gGrid_importRattr(dom_l,"area",data,lsize) - - do g = bounds%begg,bounds%endg - i = 1 + (g - bounds%begg) - data(i) = real(ldomain%mask(g), r8) - end do - call mct_gGrid_importRattr(dom_l,"mask",data,lsize) - - do g = bounds%begg,bounds%endg - i = 1 + (g - bounds%begg) - data(i) = real(ldomain%frac(g), r8) - end do - call mct_gGrid_importRattr(dom_l,"frac",data,lsize) - - deallocate(data) - deallocate(idata) - - end subroutine lnd_domain_mct - - !==================================================================================== - - subroutine lnd_handle_resume( cdata_l ) - ! - ! !DESCRIPTION: - ! Handle resume signals for Data Assimilation (DA) - ! - ! !USES: - use clm_time_manager , only : update_DA_nstep - use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs - implicit none - ! !ARGUMENTS: - type(seq_cdata), intent(inout) :: cdata_l ! Input land-model driver data - ! !LOCAL VARIABLES: - logical :: resume_from_data_assim ! flag if we are resuming after data assimulation was done - !--------------------------------------------------------------------------- - - ! Check to see if restart was modified and we are resuming from data - ! assimilation - call seq_cdata_setptrs(cdata_l, post_assimilation=resume_from_data_assim) - if ( resume_from_data_assim ) call update_DA_nstep() - - end subroutine lnd_handle_resume - -end module lnd_comp_mct diff --git a/src/cpl/lnd_import_export.F90 b/src/cpl/lnd_import_export.F90 deleted file mode 100644 index f3784bc55f..0000000000 --- a/src/cpl/lnd_import_export.F90 +++ /dev/null @@ -1,431 +0,0 @@ -module lnd_import_export - - use shr_kind_mod , only: r8 => shr_kind_r8, cl=>shr_kind_cl - use abortutils , only: endrun - use decompmod , only: bounds_type - use lnd2atmType , only: lnd2atm_type - use lnd2glcMod , only: lnd2glc_type - use atm2lndType , only: atm2lnd_type - use glc2lndMod , only: glc2lnd_type - use Waterlnd2atmBulkType , only: waterlnd2atmbulk_type - use Wateratm2lndBulkType , only: wateratm2lndbulk_type - use clm_cpl_indices - ! - implicit none - !=============================================================================== - -contains - - !=============================================================================== - subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst, wateratm2lndbulk_inst) - - !--------------------------------------------------------------------------- - ! !DESCRIPTION: - ! Convert the input data from the coupler to the land model - ! - ! !USES: - use seq_flds_mod , only: seq_flds_x2l_fields - use clm_varctl , only: co2_type, co2_ppmv, iulog, use_c13 - use clm_varctl , only: ndep_from_cpl - use clm_varcon , only: rair, o2_molar_const, c13ratio - use shr_const_mod , only: SHR_CONST_TKFRZ - use shr_string_mod , only: shr_string_listGetName - use domainMod , only: ldomain - use shr_infnan_mod , only : isnan => shr_infnan_isnan - ! - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds ! bounds - real(r8) , intent(in) :: x2l(:,:) ! driver import state to land model - logical , intent(in) :: glc_present ! .true. => running with a non-stub GLC model - type(atm2lnd_type) , intent(inout) :: atm2lnd_inst ! clm internal input data type - type(glc2lnd_type) , intent(inout) :: glc2lnd_inst ! clm internal input data type - type(wateratm2lndbulk_type), intent(inout) :: wateratm2lndbulk_inst ! clm internal input data type - ! - ! !LOCAL VARIABLES: - integer :: g,i,k,nstep,ier ! indices, number of steps, and error code - real(r8) :: forc_rainc ! rainxy Atm flux mm/s - real(r8) :: e ! vapor pressure (Pa) - real(r8) :: qsat ! saturation specific humidity (kg/kg) - real(r8) :: forc_t ! atmospheric temperature (Kelvin) - real(r8) :: forc_q ! atmospheric specific humidity (kg/kg) - real(r8) :: forc_pbot ! atmospheric pressure (Pa) - real(r8) :: forc_rainl ! rainxy Atm flux mm/s - real(r8) :: forc_snowc ! snowfxy Atm flux mm/s - real(r8) :: forc_snowl ! snowfxl Atm flux mm/s - real(r8) :: co2_ppmv_diag ! temporary - real(r8) :: co2_ppmv_prog ! temporary - real(r8) :: co2_ppmv_val ! temporary - integer :: co2_type_idx ! integer flag for co2_type options - real(r8) :: esatw ! saturation vapor pressure over water (Pa) - real(r8) :: esati ! saturation vapor pressure over ice (Pa) - real(r8) :: a0,a1,a2,a3,a4,a5,a6 ! coefficients for esat over water - real(r8) :: b0,b1,b2,b3,b4,b5,b6 ! coefficients for esat over ice - real(r8) :: tdc, t ! Kelvins to Celcius function and its input - character(len=32) :: fname ! name of field that is NaN - character(len=32), parameter :: sub = 'lnd_import' - - ! Constants to compute vapor pressure - parameter (a0=6.107799961_r8 , a1=4.436518521e-01_r8, & - a2=1.428945805e-02_r8, a3=2.650648471e-04_r8, & - a4=3.031240396e-06_r8, a5=2.034080948e-08_r8, & - a6=6.136820929e-11_r8) - - parameter (b0=6.109177956_r8 , b1=5.034698970e-01_r8, & - b2=1.886013408e-02_r8, b3=4.176223716e-04_r8, & - b4=5.824720280e-06_r8, b5=4.838803174e-08_r8, & - b6=1.838826904e-10_r8) - ! - ! function declarations - ! - tdc(t) = min( 50._r8, max(-50._r8,(t-SHR_CONST_TKFRZ)) ) - esatw(t) = 100._r8*(a0+t*(a1+t*(a2+t*(a3+t*(a4+t*(a5+t*a6)))))) - esati(t) = 100._r8*(b0+t*(b1+t*(b2+t*(b3+t*(b4+t*(b5+t*b6)))))) - !--------------------------------------------------------------------------- - - co2_type_idx = 0 - if (co2_type == 'prognostic') then - co2_type_idx = 1 - else if (co2_type == 'diagnostic') then - co2_type_idx = 2 - end if - if (co2_type == 'prognostic' .and. index_x2l_Sa_co2prog == 0) then - call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2prog for co2_type equal to prognostic' ) - else if (co2_type == 'diagnostic' .and. index_x2l_Sa_co2diag == 0) then - call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2diag for co2_type equal to diagnostic' ) - end if - - ! Note that the precipitation fluxes received from the coupler - ! are in units of kg/s/m^2. To convert these precipitation rates - ! in units of mm/sec, one must divide by 1000 kg/m^3 and multiply - ! by 1000 mm/m resulting in an overall factor of unity. - ! Below the units are therefore given in mm/s. - - - do g = bounds%begg,bounds%endg - i = 1 + (g - bounds%begg) - - ! Determine flooding input, sign convention is positive downward and - ! hierarchy is atm/glc/lnd/rof/ice/ocn. so water sent from rof to land is negative, - ! change the sign to indicate addition of water to system. - - wateratm2lndbulk_inst%forc_flood_grc(g) = -x2l(index_x2l_Flrr_flood,i) - - wateratm2lndbulk_inst%volr_grc(g) = x2l(index_x2l_Flrr_volr,i) * (ldomain%area(g) * 1.e6_r8) - wateratm2lndbulk_inst%volrmch_grc(g)= x2l(index_x2l_Flrr_volrmch,i) * (ldomain%area(g) * 1.e6_r8) - - ! Determine required receive fields - - atm2lnd_inst%forc_hgt_grc(g) = x2l(index_x2l_Sa_z,i) ! zgcmxy Atm state m - atm2lnd_inst%forc_topo_grc(g) = x2l(index_x2l_Sa_topo,i) ! Atm surface height (m) - atm2lnd_inst%forc_u_grc(g) = x2l(index_x2l_Sa_u,i) ! forc_uxy Atm state m/s - atm2lnd_inst%forc_v_grc(g) = x2l(index_x2l_Sa_v,i) ! forc_vxy Atm state m/s - atm2lnd_inst%forc_solad_grc(g,2) = x2l(index_x2l_Faxa_swndr,i) ! forc_sollxy Atm flux W/m^2 - atm2lnd_inst%forc_solad_grc(g,1) = x2l(index_x2l_Faxa_swvdr,i) ! forc_solsxy Atm flux W/m^2 - atm2lnd_inst%forc_solai_grc(g,2) = x2l(index_x2l_Faxa_swndf,i) ! forc_solldxy Atm flux W/m^2 - atm2lnd_inst%forc_solai_grc(g,1) = x2l(index_x2l_Faxa_swvdf,i) ! forc_solsdxy Atm flux W/m^2 - - atm2lnd_inst%forc_th_not_downscaled_grc(g) = x2l(index_x2l_Sa_ptem,i) ! forc_thxy Atm state K - wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = x2l(index_x2l_Sa_shum,i) ! forc_qxy Atm state kg/kg - atm2lnd_inst%forc_pbot_not_downscaled_grc(g) = x2l(index_x2l_Sa_pbot,i) ! ptcmxy Atm state Pa - atm2lnd_inst%forc_t_not_downscaled_grc(g) = x2l(index_x2l_Sa_tbot,i) ! forc_txy Atm state K - atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) = x2l(index_x2l_Faxa_lwdn,i) ! flwdsxy Atm flux W/m^2 - - forc_rainc = x2l(index_x2l_Faxa_rainc,i) ! mm/s - forc_rainl = x2l(index_x2l_Faxa_rainl,i) ! mm/s - forc_snowc = x2l(index_x2l_Faxa_snowc,i) ! mm/s - forc_snowl = x2l(index_x2l_Faxa_snowl,i) ! mm/s - - ! atmosphere coupling, for prognostic/prescribed aerosols - atm2lnd_inst%forc_aer_grc(g,1) = x2l(index_x2l_Faxa_bcphidry,i) - atm2lnd_inst%forc_aer_grc(g,2) = x2l(index_x2l_Faxa_bcphodry,i) - atm2lnd_inst%forc_aer_grc(g,3) = x2l(index_x2l_Faxa_bcphiwet,i) - atm2lnd_inst%forc_aer_grc(g,4) = x2l(index_x2l_Faxa_ocphidry,i) - atm2lnd_inst%forc_aer_grc(g,5) = x2l(index_x2l_Faxa_ocphodry,i) - atm2lnd_inst%forc_aer_grc(g,6) = x2l(index_x2l_Faxa_ocphiwet,i) - atm2lnd_inst%forc_aer_grc(g,7) = x2l(index_x2l_Faxa_dstwet1,i) - atm2lnd_inst%forc_aer_grc(g,8) = x2l(index_x2l_Faxa_dstdry1,i) - atm2lnd_inst%forc_aer_grc(g,9) = x2l(index_x2l_Faxa_dstwet2,i) - atm2lnd_inst%forc_aer_grc(g,10) = x2l(index_x2l_Faxa_dstdry2,i) - atm2lnd_inst%forc_aer_grc(g,11) = x2l(index_x2l_Faxa_dstwet3,i) - atm2lnd_inst%forc_aer_grc(g,12) = x2l(index_x2l_Faxa_dstdry3,i) - atm2lnd_inst%forc_aer_grc(g,13) = x2l(index_x2l_Faxa_dstwet4,i) - atm2lnd_inst%forc_aer_grc(g,14) = x2l(index_x2l_Faxa_dstdry4,i) - - ! Determine optional receive fields - - if (index_x2l_Sa_co2prog /= 0) then - co2_ppmv_prog = x2l(index_x2l_Sa_co2prog,i) ! co2 atm state prognostic - else - co2_ppmv_prog = co2_ppmv - end if - - if (index_x2l_Sa_co2diag /= 0) then - co2_ppmv_diag = x2l(index_x2l_Sa_co2diag,i) ! co2 atm state diagnostic - else - co2_ppmv_diag = co2_ppmv - end if - - if (index_x2l_Sa_methane /= 0) then - atm2lnd_inst%forc_pch4_grc(g) = x2l(index_x2l_Sa_methane,i) - endif - - ! Determine derived quantities for required fields - - forc_t = atm2lnd_inst%forc_t_not_downscaled_grc(g) - forc_q = wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) - forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) - - atm2lnd_inst%forc_hgt_u_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of wind [m] - atm2lnd_inst%forc_hgt_t_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of temperature [m] - atm2lnd_inst%forc_hgt_q_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of humidity [m] - atm2lnd_inst%forc_vp_grc(g) = forc_q * forc_pbot / (0.622_r8 + 0.378_r8 * forc_q) - atm2lnd_inst%forc_rho_not_downscaled_grc(g) = & - (forc_pbot - 0.378_r8 * atm2lnd_inst%forc_vp_grc(g)) / (rair * forc_t) - atm2lnd_inst%forc_po2_grc(g) = o2_molar_const * forc_pbot - atm2lnd_inst%forc_wind_grc(g) = sqrt(atm2lnd_inst%forc_u_grc(g)**2 + atm2lnd_inst%forc_v_grc(g)**2) - atm2lnd_inst%forc_solar_grc(g) = atm2lnd_inst%forc_solad_grc(g,1) + atm2lnd_inst%forc_solai_grc(g,1) + & - atm2lnd_inst%forc_solad_grc(g,2) + atm2lnd_inst%forc_solai_grc(g,2) - - wateratm2lndbulk_inst%forc_rain_not_downscaled_grc(g) = forc_rainc + forc_rainl - wateratm2lndbulk_inst%forc_snow_not_downscaled_grc(g) = forc_snowc + forc_snowl - - if (forc_t > SHR_CONST_TKFRZ) then - e = esatw(tdc(forc_t)) - else - e = esati(tdc(forc_t)) - end if - qsat = 0.622_r8*e / (forc_pbot - 0.378_r8*e) - - !modify specific humidity if precip occurs - if(1==2) then - if((forc_rainc+forc_rainl) > 0._r8) then - forc_q = 0.95_r8*qsat - ! forc_q = qsat - wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = forc_q - endif - endif - - wateratm2lndbulk_inst%forc_rh_grc(g) = 100.0_r8*(forc_q / qsat) - - ! Check that solar, specific-humidity and LW downward aren't negative - if ( atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) <= 0.0_r8 )then - call endrun( sub//' ERROR: Longwave down sent from the atmosphere model is negative or zero' ) - end if - if ( (atm2lnd_inst%forc_solad_grc(g,1) < 0.0_r8) .or. (atm2lnd_inst%forc_solad_grc(g,2) < 0.0_r8) & - .or. (atm2lnd_inst%forc_solai_grc(g,1) < 0.0_r8) .or. (atm2lnd_inst%forc_solai_grc(g,2) < 0.0_r8) ) then - call endrun( sub//' ERROR: One of the solar fields (indirect/diffuse, vis or near-IR)'// & - ' from the atmosphere model is negative or zero' ) - end if - if ( wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) < 0.0_r8 )then - call endrun( sub//' ERROR: Bottom layer specific humidty sent from the atmosphere model is less than zero' ) - end if - - ! Check if any input from the coupler is NaN - if ( any(isnan(x2l(:,i))) )then - write(iulog,*) '# of NaNs = ', count(isnan(x2l(:,i))) - write(iulog,*) 'Which are NaNs = ', isnan(x2l(:,i)) - do k = 1, size(x2l(:,i)) - if ( isnan(x2l(k,i)) )then - call shr_string_listGetName( seq_flds_x2l_fields, k, fname ) - write(iulog,*) trim(fname) - end if - end do - write(iulog,*) 'gridcell index = ', g - call endrun( sub//' ERROR: One or more of the input from the atmosphere model are NaN '// & - '(Not a Number from a bad floating point calculation)' ) - end if - - ! Make sure relative humidity is properly bounded - ! wateratm2lndbulk_inst%forc_rh_grc(g) = min( 100.0_r8, wateratm2lndbulk_inst%forc_rh_grc(g) ) - ! wateratm2lndbulk_inst%forc_rh_grc(g) = max( 0.0_r8, wateratm2lndbulk_inst%forc_rh_grc(g) ) - - ! Determine derived quantities for optional fields - ! Note that the following does unit conversions from ppmv to partial pressures (Pa) - ! Note that forc_pbot is in Pa - - if (co2_type_idx == 1) then - co2_ppmv_val = co2_ppmv_prog - else if (co2_type_idx == 2) then - co2_ppmv_val = co2_ppmv_diag - else - co2_ppmv_val = co2_ppmv - end if - if ( (co2_ppmv_val < 10.0_r8) .or. (co2_ppmv_val > 15000.0_r8) )then - call endrun( sub//' ERROR: CO2 is outside of an expected range' ) - end if - atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot - if (use_c13) then - atm2lnd_inst%forc_pc13o2_grc(g) = co2_ppmv_val * c13ratio * 1.e-6_r8 * forc_pbot - end if - - if (ndep_from_cpl) then - ! The coupler is sending ndep in units if kgN/m2/s - and clm uses units of gN/m2/sec - so the - ! following conversion needs to happen - atm2lnd_inst%forc_ndep_grc(g) = (x2l(index_x2l_Faxa_nhx, i) + x2l(index_x2l_faxa_noy, i))*1000._r8 - end if - - end do - - call glc2lnd_inst%set_glc2lnd_fields( & - bounds = bounds, & - glc_present = glc_present, & - ! NOTE(wjs, 2017-12-13) the x2l argument doesn't have the typical bounds - ! subsetting (bounds%begg:bounds%endg). This mirrors the lack of these bounds in - ! the call to lnd_import from lnd_run_mct. This is okay as long as this code is - ! outside a clump loop. - x2l = x2l, & - index_x2l_Sg_ice_covered = index_x2l_Sg_ice_covered, & - index_x2l_Sg_topo = index_x2l_Sg_topo, & - index_x2l_Flgg_hflx = index_x2l_Flgg_hflx, & - index_x2l_Sg_icemask = index_x2l_Sg_icemask, & - index_x2l_Sg_icemask_coupled_fluxes = index_x2l_Sg_icemask_coupled_fluxes) - - end subroutine lnd_import - - !=============================================================================== - - subroutine lnd_export( bounds, waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x) - - !--------------------------------------------------------------------------- - ! !DESCRIPTION: - ! Convert the data to be sent from the clm model to the coupler - ! - ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use seq_flds_mod , only : seq_flds_l2x_fields - use clm_varctl , only : iulog - use clm_time_manager , only : get_nstep - use seq_drydep_mod , only : n_drydep - use shr_megan_mod , only : shr_megan_mechcomps_n - use shr_fire_emis_mod , only : shr_fire_emis_mechcomps_n - use domainMod , only : ldomain - use shr_string_mod , only : shr_string_listGetName - use shr_infnan_mod , only : isnan => shr_infnan_isnan - ! - ! !ARGUMENTS: - implicit none - type(bounds_type) , intent(in) :: bounds ! bounds - type(lnd2atm_type), intent(inout) :: lnd2atm_inst ! clm land to atmosphere exchange data type - type(lnd2glc_type), intent(inout) :: lnd2glc_inst ! clm land to atmosphere exchange data type - type(waterlnd2atmbulk_type), intent(in) :: waterlnd2atmbulk_inst - real(r8) , intent(out) :: l2x(:,:)! land to coupler export state on land grid - ! - ! !LOCAL VARIABLES: - integer :: g,i,k ! indices - integer :: ier ! error status - integer :: nstep ! time step index - integer :: dtime ! time step - integer :: num ! counter - character(len=32) :: fname ! name of field that is NaN - character(len=32), parameter :: sub = 'lnd_export' - !--------------------------------------------------------------------------- - - ! cesm sign convention is that fluxes are positive downward - - l2x(:,:) = 0.0_r8 - - do g = bounds%begg,bounds%endg - i = 1 + (g-bounds%begg) - l2x(index_l2x_Sl_t,i) = lnd2atm_inst%t_rad_grc(g) - l2x(index_l2x_Sl_snowh,i) = waterlnd2atmbulk_inst%h2osno_grc(g) - l2x(index_l2x_Sl_avsdr,i) = lnd2atm_inst%albd_grc(g,1) - l2x(index_l2x_Sl_anidr,i) = lnd2atm_inst%albd_grc(g,2) - l2x(index_l2x_Sl_avsdf,i) = lnd2atm_inst%albi_grc(g,1) - l2x(index_l2x_Sl_anidf,i) = lnd2atm_inst%albi_grc(g,2) - l2x(index_l2x_Sl_tref,i) = lnd2atm_inst%t_ref2m_grc(g) - l2x(index_l2x_Sl_qref,i) = waterlnd2atmbulk_inst%q_ref2m_grc(g) - l2x(index_l2x_Sl_u10,i) = lnd2atm_inst%u_ref10m_grc(g) - l2x(index_l2x_Fall_taux,i) = -lnd2atm_inst%taux_grc(g) - l2x(index_l2x_Fall_tauy,i) = -lnd2atm_inst%tauy_grc(g) - l2x(index_l2x_Fall_lat,i) = -lnd2atm_inst%eflx_lh_tot_grc(g) - l2x(index_l2x_Fall_sen,i) = -lnd2atm_inst%eflx_sh_tot_grc(g) - l2x(index_l2x_Fall_lwup,i) = -lnd2atm_inst%eflx_lwrad_out_grc(g) - l2x(index_l2x_Fall_evap,i) = -waterlnd2atmbulk_inst%qflx_evap_tot_grc(g) - l2x(index_l2x_Fall_swnet,i) = lnd2atm_inst%fsa_grc(g) - if (index_l2x_Fall_fco2_lnd /= 0) then - l2x(index_l2x_Fall_fco2_lnd,i) = -lnd2atm_inst%net_carbon_exchange_grc(g) - end if - - ! Additional fields for DUST, PROGSSLT, dry-deposition and VOC - ! These are now standard fields, but the check on the index makes sure the driver handles them - if (index_l2x_Sl_ram1 /= 0 ) l2x(index_l2x_Sl_ram1,i) = lnd2atm_inst%ram1_grc(g) - if (index_l2x_Sl_fv /= 0 ) l2x(index_l2x_Sl_fv,i) = lnd2atm_inst%fv_grc(g) - if (index_l2x_Sl_soilw /= 0 ) l2x(index_l2x_Sl_soilw,i) = waterlnd2atmbulk_inst%h2osoi_vol_grc(g,1) - if (index_l2x_Fall_flxdst1 /= 0 ) l2x(index_l2x_Fall_flxdst1,i)= -lnd2atm_inst%flxdst_grc(g,1) - if (index_l2x_Fall_flxdst2 /= 0 ) l2x(index_l2x_Fall_flxdst2,i)= -lnd2atm_inst%flxdst_grc(g,2) - if (index_l2x_Fall_flxdst3 /= 0 ) l2x(index_l2x_Fall_flxdst3,i)= -lnd2atm_inst%flxdst_grc(g,3) - if (index_l2x_Fall_flxdst4 /= 0 ) l2x(index_l2x_Fall_flxdst4,i)= -lnd2atm_inst%flxdst_grc(g,4) - - - ! for dry dep velocities - if (index_l2x_Sl_ddvel /= 0 ) then - l2x(index_l2x_Sl_ddvel:index_l2x_Sl_ddvel+n_drydep-1,i) = & - lnd2atm_inst%ddvel_grc(g,:n_drydep) - end if - - ! for MEGAN VOC emis fluxes - if (index_l2x_Fall_flxvoc /= 0 ) then - l2x(index_l2x_Fall_flxvoc:index_l2x_Fall_flxvoc+shr_megan_mechcomps_n-1,i) = & - -lnd2atm_inst%flxvoc_grc(g,:shr_megan_mechcomps_n) - end if - - - ! for fire emis fluxes - if (index_l2x_Fall_flxfire /= 0 ) then - l2x(index_l2x_Fall_flxfire:index_l2x_Fall_flxfire+shr_fire_emis_mechcomps_n-1,i) = & - -lnd2atm_inst%fireflx_grc(g,:shr_fire_emis_mechcomps_n) - l2x(index_l2x_Sl_ztopfire,i) = lnd2atm_inst%fireztop_grc(g) - end if - - if (index_l2x_Fall_methane /= 0) then - l2x(index_l2x_Fall_methane,i) = -lnd2atm_inst%flux_ch4_grc(g) - endif - - ! sign convention is positive downward with - ! hierarchy of atm/glc/lnd/rof/ice/ocn. - ! I.e. water sent from land to rof is positive - - l2x(index_l2x_Flrl_rofsur,i) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) - - ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain - l2x(index_l2x_Flrl_rofsub,i) = waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) & - + waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) - - ! qgwl sent individually to coupler - l2x(index_l2x_Flrl_rofgwl,i) = waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) - - ! ice sent individually to coupler - l2x(index_l2x_Flrl_rofi,i) = waterlnd2atmbulk_inst%qflx_rofice_grc(g) - - ! irrigation flux to be removed from main channel storage (negative) - l2x(index_l2x_Flrl_irrig,i) = - waterlnd2atmbulk_inst%qirrig_grc(g) - - ! glc coupling - ! We could avoid setting these fields if glc_present is .false., if that would - ! help with performance. (The downside would be that we wouldn't have these fields - ! available for diagnostic purposes or to force a later T compset with dlnd.) - do num = 0,glc_nec - l2x(index_l2x_Sl_tsrf(num),i) = lnd2glc_inst%tsrf_grc(g,num) - l2x(index_l2x_Sl_topo(num),i) = lnd2glc_inst%topo_grc(g,num) - l2x(index_l2x_Flgl_qice(num),i) = lnd2glc_inst%qice_grc(g,num) - end do - - ! Check if any output sent to the coupler is NaN - if ( any(isnan(l2x(:,i))) )then - write(iulog,*) '# of NaNs = ', count(isnan(l2x(:,i))) - write(iulog,*) 'Which are NaNs = ', isnan(l2x(:,i)) - do k = 1, size(l2x(:,i)) - if ( isnan(l2x(k,i)) )then - call shr_string_listGetName( seq_flds_l2x_fields, k, fname ) - write(iulog,*) trim(fname) - end if - end do - write(iulog,*) 'gridcell index = ', g - call endrun( sub//' ERROR: One or more of the output from CLM to the coupler are NaN ' ) - end if - - end do - - end subroutine lnd_export - -end module lnd_import_export From fcfcbdc138b038df211d036b15514684075b8e67 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 11 Oct 2019 14:55:13 -0600 Subject: [PATCH 151/556] some clean ups.... --- lilac/lilac/atmos_cap.F90 | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 index 145af984fa..a897c60e51 100644 --- a/lilac/lilac/atmos_cap.F90 +++ b/lilac/lilac/atmos_cap.F90 @@ -25,7 +25,7 @@ module atmos_cap integer :: mpierror, numprocs integer :: i, myid integer status(MPI_STATUS_SIZE) ! Status of message - integer, parameter :: debug = 0 ! internal debug leve + integer, parameter :: debug = 1 ! internal debug leve @@ -113,7 +113,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) - print *, "!Mesh for atmosphere is created!" + !print *, "!Mesh for atmosphere is created!" else !TODO: Fix how you want to create the grid here if mesh_switch is off @@ -129,7 +129,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) regDecomp=(/1,petcount/),& rc=rc) call ESMF_LogWrite(subname//"Grid for atmosphere is created!", ESMF_LOGMSG_INFO) - print *, "Grid for atmosphere is created!" + !print *, "Grid for atmosphere is created!" endif !------------------------------------------------------------------------- @@ -163,8 +163,8 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) print *, "creating field for a2c:" print *, trim(a2c_fldlist(n)%stdname) print *, a2c_fldlist(n)%farrayptr1d - call ESMF_FieldPrint(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_FieldPrint(field, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end if !call ESMF_LogWrite(subname//"fieldget!", ESMF_LOGMSG_INFO) @@ -177,11 +177,14 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) enddo - fldname = 'Sa_topo' - do i=begc, endc - write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, a2c_fldlist(2)%farrayptr1d(i) - enddo - + if (myid == 0 .and. debug > 0) then + do n = 1,a2c_fldlist_num + do i=begc, endc + fldname = a2c_fldlist(n)%stdname + write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, a2c_fldlist(n)%farrayptr1d(i) + enddo + enddo + end if call ESMF_LogWrite(subname//"fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" From a5e2510d6a03bae179d61067a481ba613f1efa1f Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 11 Oct 2019 14:57:25 -0600 Subject: [PATCH 152/556] changing the way driver used to work to run for all time steps.... --- lilac/lilac/demo_driver.F90 | 45 ++++++++++++++++++++++--------------- lilac/lilac/lilac_mod.F90 | 1 + 2 files changed, 28 insertions(+), 18 deletions(-) diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index 221b1c5f3a..698ac94d68 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -62,7 +62,7 @@ program demo_lilac_driver !endc = 13968 start_time = 1 - end_time = 5 + end_time = 48 itime_step = 1 seed_val = 0 @@ -93,7 +93,8 @@ program demo_lilac_driver allocate ( atm2lnd%Faxa_snowc (begc:endc) ) ; atm2lnd%Faxa_snowc (:) = 1.0d-8 allocate ( atm2lnd%Faxa_snowl (begc:endc) ) ; atm2lnd%Faxa_snowl (:) = 2.0d-8 allocate ( atm2lnd%Faxa_swndr (begc:endc) ) ; atm2lnd%Faxa_swndr (:) = 100.0d0 - allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) ; atm2lnd%Faxa_swvdr (:) = 20.0d0 + + allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) ; atm2lnd%Faxa_swvdr (:) = 50.0d0 allocate ( atm2lnd%Faxa_swndf (begc:endc) ) ; atm2lnd%Faxa_swndf (:) = 20.0d0 allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) ; atm2lnd%Faxa_swvdf (:) = 40.0d0 @@ -102,7 +103,6 @@ program demo_lilac_driver if (debug > 0) then do i=begc, endc write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, atm2lnd%Sa_topo(i) - !write (iulog,F01)'i = ',i, atm2lnd%Sa_topo(i) enddo end if !allocate ( atm2lnd%Faxa_bcph (begc:endc) ) ; atm2lnd%Faxa_bcph (:) = 0.0d0 @@ -130,24 +130,33 @@ program demo_lilac_driver ! looping over imaginary time .... !------------------------------------------------------------------------ + call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) do curr_time = start_time, end_time - if (curr_time == start_time) then - ! Initalization phase - !if (masterproc) then - print *, "--------------------------" - print *, " LILAC Initalization phase" - print *, "--------------------------" - !end if - call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) - else if (curr_time == end_time ) then - ! Finalization phase - call lilac_final ( ) - call ESMF_Finalize ( ) - else call lilac_run ( ) - endif - itime_step = itime_step + 1 + itime_step = itime_step + 1 end do + call lilac_final ( ) + call ESMF_Finalize ( ) + + + !do curr_time = start_time, end_time + ! if (curr_time == start_time) then + ! ! Initalization phase + ! !if (masterproc) then + ! print *, "--------------------------" + ! print *, " LILAC Initalization phase" + ! print *, "--------------------------" + ! !end if + ! call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) + ! else if (curr_time == end_time ) then + ! ! Finalization phase + ! call lilac_final ( ) + ! call ESMF_Finalize ( ) + ! else + ! call lilac_run ( ) + ! endif + ! itime_step = itime_step + 1 + !end do print *, "=======================================" print *, " ............. DONE ..................." diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 8f69f2e492..d462bc3c66 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -255,6 +255,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) a2c_fldlist(11)%farrayptr1d => atm2lnd1d%Faxa_rainl a2c_fldlist(12)%farrayptr1d => atm2lnd1d%Faxa_snowc a2c_fldlist(13)%farrayptr1d => atm2lnd1d%Faxa_snowl + a2c_fldlist(14)%farrayptr1d => atm2lnd1d%Faxa_swndr a2c_fldlist(15)%farrayptr1d => atm2lnd1d%Faxa_swvdr a2c_fldlist(16)%farrayptr1d => atm2lnd1d%Faxa_swndf From 27d3c83c599f85632e9d7b985486868cba81071c Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 21 Oct 2019 14:53:20 -0600 Subject: [PATCH 153/556] working with Bill on sending and reiceving back decomposition from the atmosphere. --- lilac/lilac/demo_driver.F90 | 126 +++++++++++++++++++++++++++++------- lilac/lilac/lilac_mod.F90 | 1 - 2 files changed, 103 insertions(+), 24 deletions(-) diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index 698ac94d68..dd17d17094 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -1,3 +1,94 @@ +module demo_mod +!---------------------------------------------------------------------------- + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS + use spmdMod , only : masterproc + implicit none + private + public :: demo_init + integer :: ierr + integer :: COMP_COMM + integer :: npts ! domain global size + integer :: num_local +!---------------------------------------------------------------------------- +contains +!---------------------------------------------------------------------------- + subroutine demo_init(gindex_atm) + !! TODO: IS THE INTENT CORRECT FOR GINDEX_ATM + integer , allocatable, intent(inout) :: gindex_atm(:) + integer :: ntasks + integer :: mytask + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + + npts = 3312 + ! this is coming from + ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 + call MPI_init(ierr) + COMP_COMM = MPI_COMM_WORLD + + !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 + if (ierr .ne. MPI_SUCCESS) then + print *,'Error starting MPI program. Terminating.' + call MPI_ABORT(MPI_COMM_WORLD, ierr) + end if + + ! + + call MPI_COMM_RANK(COMP_COMM, mytask, ierr) + call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) + + if (masterproc) then + print *, "MPI initialization done ..., ntasks=", ntasks + end if + + call decompInit_atm( ntasks, mytask, gindex_atm) + print *, "gindex_atm for ", mytask,"is: ", gindex_atm + print *, "size gindex_atm for ", mytask,"is: ", size(gindex_atm) + end subroutine demo_init + + subroutine decompInit_atm( ntasks, mytask, gindex_atm) + + ! !DESCRIPTION: + + ! !USES: + + ! !ARGUMENTS: + integer , intent(in) :: ntasks + integer , intent(in) :: mytask + integer , allocatable, intent(out) :: gindex_atm(:) ! this variable is allocated here, and is assumed to start unallocated + ! !LOCAL VARIABLES: + integer :: my_start + integer :: my_end + integer :: i_local + integer :: i_global + !------------------------------------------------------------------------------ + ! create the a global index array for ocean points + + num_local = npts / ntasks + + my_start = num_local*mytask + min(mytask, mod(npts, ntasks)) + 1 + ! The first mod(npts,ntasks) of ntasks are the ones that have an extra point + if (mytask < mod(npts, ntasks)) then + num_local = num_local + 1 + end if + my_end = my_start + num_local - 1 + + allocate(gindex_atm(num_local)) + + i_global = my_start + do i_local = 1, num_local + gindex_atm(i_local) = i_global + i_global = i_global +1 + end do + + end subroutine decompInit_atm + + +end module demo_mod + + + program demo_lilac_driver !---------------------------------------------------------------------------- @@ -12,7 +103,7 @@ program demo_lilac_driver ! atmos cap land cap ____________. ......... gridded components ! | | | ! | | river cap - ! oceaan (MOM, POM)? | | + ! ocean (MOM, POM)? | | ! | Mizzouroute... ! CTSM ! @@ -22,9 +113,10 @@ program demo_lilac_driver ! modules use ESMF use lilac_mod - use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type, atm2lnd_data2d_type, atm2lnd_data2d_type , this_clock + use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type , atm2lnd_data2d_type , atm2lnd_data2d_type , this_clock use clm_varctl , only : iulog use spmdMod , only : masterproc + use demo_mod , only : demo_init implicit none ! TO DO: change the name and the derived data types @@ -52,8 +144,8 @@ program demo_lilac_driver character(*),parameter :: F01 = "(a,i4,d26.19)" character(*),parameter :: F02 = "('[demo_driver]',a,i5,2x,d26.19)" + integer , allocatable :: gindex_atm(:) !------------------------------------------------------------------------ - ! real atmosphere: begc = 1 !endc = 6912/4/2 @@ -126,6 +218,14 @@ program demo_lilac_driver allocate ( lnd2atm%Sl_fv (begc:endc) ) ; lnd2atm%Sl_fv (:) = 0 allocate ( lnd2atm%Sl_ram1 (begc:endc) ) ; lnd2atm%Sl_ram1 (:) = 0 + + + !------------------------------------------------------------------------ + ! The newly added demo_init + !------------------------------------------------------------------------ + + call demo_init(gindex_atm) + !------------------------------------------------------------------------ ! looping over imaginary time .... !------------------------------------------------------------------------ @@ -138,26 +238,6 @@ program demo_lilac_driver call lilac_final ( ) call ESMF_Finalize ( ) - - !do curr_time = start_time, end_time - ! if (curr_time == start_time) then - ! ! Initalization phase - ! !if (masterproc) then - ! print *, "--------------------------" - ! print *, " LILAC Initalization phase" - ! print *, "--------------------------" - ! !end if - ! call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) - ! else if (curr_time == end_time ) then - ! ! Finalization phase - ! call lilac_final ( ) - ! call ESMF_Finalize ( ) - ! else - ! call lilac_run ( ) - ! endif - ! itime_step = itime_step + 1 - !end do - print *, "=======================================" print *, " ............. DONE ..................." print *, "=======================================" diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index d462bc3c66..b0545d4105 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -119,7 +119,6 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) ! this is coming from ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 - call MPI_init(ierr) COMP_COMM = MPI_COMM_WORLD !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 From a0549941e107afdca541d13c30ddbea51a5d7d65 Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 21 Oct 2019 14:59:06 -0600 Subject: [PATCH 154/556] just cleanup --- lilac/lilac/demo_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index dd17d17094..ef98c2da48 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -189,6 +189,7 @@ program demo_lilac_driver allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) ; atm2lnd%Faxa_swvdr (:) = 50.0d0 allocate ( atm2lnd%Faxa_swndf (begc:endc) ) ; atm2lnd%Faxa_swndf (:) = 20.0d0 allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) ; atm2lnd%Faxa_swvdf (:) = 40.0d0 + !allocate ( atm2lnd%Faxa_bcph (begc:endc) ) ; atm2lnd%Faxa_bcph (:) = 0.0d0 fldname = 'Sa_topo' @@ -197,7 +198,6 @@ program demo_lilac_driver write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, atm2lnd%Sa_topo(i) enddo end if - !allocate ( atm2lnd%Faxa_bcph (begc:endc) ) ; atm2lnd%Faxa_bcph (:) = 0.0d0 !endc = 18048 ? should this be the size of the land or atmosphere??? From 44ddbbcad845ea65a4f3d6521e7c8e430870356f Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 25 Nov 2019 13:45:14 -0700 Subject: [PATCH 155/556] adding decomposition stuff and everything else --- lilac/lilac/atmos_cap.F90 | 12 +- lilac/lilac/demo_driver.F90 | 391 ++++++++++++++++++++++++++++-------- lilac/lilac/demo_mod.F90 | 231 +++++++++++++++++++++ lilac/lilac/demo_utils.F90 | 160 +++++++++++++++ lilac/lilac/lilac_mod.F90 | 21 +- 5 files changed, 717 insertions(+), 98 deletions(-) create mode 100644 lilac/lilac/demo_mod.F90 create mode 100644 lilac/lilac/demo_utils.F90 diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 index a897c60e51..c56c66cfe7 100644 --- a/lilac/lilac/atmos_cap.F90 +++ b/lilac/lilac/atmos_cap.F90 @@ -18,6 +18,8 @@ module atmos_cap type(ESMF_Field), public , save :: field type(fld_list_type), public , allocatable :: c2a_fldlist(:) type(fld_list_type), public , allocatable :: a2c_fldlist(:) + integer , public , allocatable :: dummy_gindex_atm(:) + integer :: a2c_fldlist_num integer :: c2a_fldlist_num public :: atmos_register @@ -76,11 +78,12 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) type (ESMF_FieldBundle) :: c2a_fb , a2c_fb integer :: n type(ESMF_Mesh) :: atmos_mesh + type(ESMF_Mesh) :: atmos_mesh_tmp character(len=ESMF_MAXSTR) :: atmos_mesh_filepath integer :: petCount, localrc, urc integer :: mid, by2, quart, by4 type(ESMF_Grid) :: atmos_grid - type(ESMF_DistGrid) :: distgridIN, distgridFS + type(ESMF_DistGrid) :: atmos_distgrid logical :: mesh_switch character(len=*), parameter :: subname=trim(modname)//': [atmos_init] ' !integer :: regDecomp(:,:) @@ -110,10 +113,15 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) atmos_mesh_filepath = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + atmos_mesh_tmp = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) !print *, "!Mesh for atmosphere is created!" + + atmos_distgrid = ESMF_DistGridCreate (arbSeqIndexList=dummy_gindex_atm, rc=rc) + + ! recreate the mesh using the above distgrid + atmos_mesh = ESMF_MeshCreate(atmos_mesh_tmp, elementDistgrid=atmos_distgrid, rc=rc) else !TODO: Fix how you want to create the grid here if mesh_switch is off diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 index ef98c2da48..2cefc3b73d 100644 --- a/lilac/lilac/demo_driver.F90 +++ b/lilac/lilac/demo_driver.F90 @@ -2,28 +2,37 @@ module demo_mod !---------------------------------------------------------------------------- use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS use spmdMod , only : masterproc + use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type , atm2lnd_data2d_type , atm2lnd_data2d_type , this_clock implicit none private - public :: demo_init - integer :: ierr - integer :: COMP_COMM - integer :: npts ! domain global size - integer :: num_local + public :: demo_init + public :: read_netcdf_mesh + integer :: ierr + integer :: COMP_COMM + integer :: npts ! domain global size + integer :: num_local + integer :: n_points + real, dimension(:,:), allocatable :: centerCoords !---------------------------------------------------------------------------- contains !---------------------------------------------------------------------------- - subroutine demo_init(gindex_atm) + subroutine demo_init(gindex_atm, atm2lnd, lnd2atm) !! TODO: IS THE INTENT CORRECT FOR GINDEX_ATM - integer , allocatable, intent(inout) :: gindex_atm(:) - integer :: ntasks - integer :: mytask + integer , allocatable, intent(inout) :: gindex_atm(:) + type (atm2lnd_data1d_type), intent(inout) :: atm2lnd + type (lnd2atm_data1d_type), intent(inout) :: lnd2atm + integer :: ntasks + integer :: mytask + character(len=128) :: filename + integer :: endc !----------------------------------------------------------------------------- ! Initiallize MPI !----------------------------------------------------------------------------- npts = 3312 - ! this is coming from - ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 + + write(*, *) "MPI initialization starts ..." + call MPI_init(ierr) COMP_COMM = MPI_COMM_WORLD @@ -38,52 +47,295 @@ subroutine demo_init(gindex_atm) call MPI_COMM_RANK(COMP_COMM, mytask, ierr) call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) - if (masterproc) then + if (mytask == 0 ) then print *, "MPI initialization done ..., ntasks=", ntasks end if - + + + !----------------------------------------------------------------------------- + ! Read mesh file to get number of points (n_points) + !----------------------------------------------------------------------------- + filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + call read_netcdf_mesh(filename, n_points) + + !----------------------------------------------------------------------------- + ! atmosphere domain decomposition + !----------------------------------------------------------------------------- + + npts = n_points + print *, "npts for ", mytask, "is:", npts call decompInit_atm( ntasks, mytask, gindex_atm) print *, "gindex_atm for ", mytask,"is: ", gindex_atm print *, "size gindex_atm for ", mytask,"is: ", size(gindex_atm) + + !----------------------------------------------------------------------------- + ! allocate and fill in atm2lnd + !----------------------------------------------------------------------------- + + endc = npts /ntasks + call fill_in (atm2lnd, lnd2atm, 1, endc, gindex_atm) end subroutine demo_init subroutine decompInit_atm( ntasks, mytask, gindex_atm) - ! !DESCRIPTION: + ! !DESCRIPTION: + ! !USES: + + ! !ARGUMENTS: + integer , intent(in) :: ntasks + integer , intent(in) :: mytask + integer , allocatable, intent(out) :: gindex_atm(:) ! this variable is allocated here, and is assumed to start unallocated + ! !LOCAL VARIABLES: + integer :: my_start + integer :: my_end + integer :: i_local + integer :: i_global + !------------------------------------------------------------------------------ + ! create the a global index array for ocean points + + num_local = npts / ntasks + + my_start = num_local*mytask + min(mytask, mod(npts, ntasks)) + 1 + ! The first mod(npts,ntasks) of ntasks are the ones that have an extra point + if (mytask < mod(npts, ntasks)) then + num_local = num_local + 1 + end if + my_end = my_start + num_local - 1 - ! !USES: + allocate(gindex_atm(num_local)) - ! !ARGUMENTS: - integer , intent(in) :: ntasks - integer , intent(in) :: mytask - integer , allocatable, intent(out) :: gindex_atm(:) ! this variable is allocated here, and is assumed to start unallocated - ! !LOCAL VARIABLES: - integer :: my_start - integer :: my_end - integer :: i_local - integer :: i_global - !------------------------------------------------------------------------------ - ! create the a global index array for ocean points + i_global = my_start + do i_local = 1, num_local + gindex_atm(i_local) = i_global + i_global = i_global +1 + end do - num_local = npts / ntasks + end subroutine decompInit_atm - my_start = num_local*mytask + min(mytask, mod(npts, ntasks)) + 1 - ! The first mod(npts,ntasks) of ntasks are the ones that have an extra point - if (mytask < mod(npts, ntasks)) then - num_local = num_local + 1 - end if - my_end = my_start + num_local - 1 + subroutine read_netcdf_mesh(filename, n_points) - allocate(gindex_atm(num_local)) + use netcdf + implicit none - i_global = my_start - do i_local = 1, num_local - gindex_atm(i_local) = i_global - i_global = i_global +1 - end do + ! + ! Parameters + ! - end subroutine decompInit_atm + ! + ! Arguments | Global Variables + ! + character(*) , intent(in) :: filename + integer , intent(inout) :: n_points + + ! + ! Local Variables + ! + integer :: idfile + + integer :: ierror + integer :: dimid_node + integer :: dimid_elem + integer :: dimid_maxnodepe + integer :: dimid_coordDim + + integer :: iddim_node + integer :: iddim_elem + integer :: iddim_maxnodepe + integer :: iddim_coordDim + + integer :: idvar_nodeCoords + integer :: idvar_CenterCoords + + character (len=100) :: string + + + integer :: nnode + integer :: nelem + integer :: maxnodePE + integer :: coordDim + real, dimension(:,:), allocatable :: nodeCoords + !----------------------------------------------------------------------------- + ! Open mesh file and get the idfile + ierror = nf90_open ( filename, NF90_NOWRITE, idfile) ; call nc_check_err(ierror, "opening file", filename) + + ! Get the dimid of dimensions + ierror = nf90_inq_dimid(idfile, 'nodeCount' , dimid_node ) ; call nc_check_err(ierror, "inq_dimid nodeCount", filename) + ierror = nf90_inq_dimid(idfile, 'elementCount' , dimid_elem ); call nc_check_err(ierror, "inq_dimid elementCount", filename) + ierror = nf90_inq_dimid(idfile, 'maxNodePElement' , dimid_maxnodepe ); call nc_check_err(ierror, "inq_dimid maxNodePElement", filename) + ierror = nf90_inq_dimid(idfile, 'coordDim' , dimid_coordDim ); call nc_check_err(ierror, "coordDim", filename) + + ! Inquire dimensions based on their dimeid(s) + ierror = nf90_inquire_dimension(idfile, dimid_node , string, nnode ); call nc_check_err(ierror, "inq_dim nodeCount", filename) + ierror = nf90_inquire_dimension(idfile, dimid_elem , string, nelem ); call nc_check_err(ierror, "inq_dim elementCount", filename) + ierror = nf90_inquire_dimension(idfile, dimid_maxnodepe , string, maxnodePE ); call nc_check_err(ierror, "inq_dim maxNodePElement", filename) + ierror = nf90_inquire_dimension(idfile, dimid_coordDim , string, coordDim ); call nc_check_err(ierror, "inq_dim coordDim", filename) + + print *, "=======================================" + print *, "nnode is : ", nnode + print *, "nelem is : ", nelem + print *, "coordDim is :", coordDim + print *, "=======================================" + + allocate (nodeCoords(coordDim, nnode)) + allocate (centerCoords(coordDim, nelem)) + ! Get variable IDs (varid) + ierror = nf90_inq_varid(idfile, 'nodeCoords' , idvar_nodeCoords ); call nc_check_err(ierror, "inq_varid nodeCoords", filename) + ierror = nf90_inq_varid(idfile, 'centerCoords' , idvar_centerCoords ); call nc_check_err(ierror, "inq_varid centerCoords", filename) + + ! Get variables values from varids + ierror = nf90_get_var(idfile, idvar_nodeCoords , nodeCoords , start=(/ 1,1/) , count=(/ coordDim, nnode /) ); call nc_check_err(ierror,"get_var nodeCoords", filename) + ierror = nf90_get_var(idfile, idvar_CenterCoords , centerCoords , start=(/ 1,1/) , count=(/ coordDim, nelem /) ); call nc_check_err(ierror,"get_var CenterCoords", filename) + + !print *, "lons : ",centerCoords(1,:) + + n_points = nelem + + end subroutine read_netcdf_mesh + + subroutine nc_check_err(ierror, description, filename) + !------------------------------------------------------------------------------- + ! $HeadURL: https://svn.oss.deltares.nl/repos/delft3d/trunk/src/engines_gpl/wave/packages/data/src/nc_check_err.f90 $ + !!--declarations---------------------------------------------------------------- + use netcdf + ! + implicit none + ! + ! Global variables + ! + integer , intent(in) :: ierror + character(*), intent(in) :: description + character(*), intent(in) :: filename + ! + ! Local variables + ! + ! + ! real, parameter :: PI = 3.1415927 + + !! executable statements ------------------------------------------------------- + ! + if (ierror /= nf90_noerr) then + print *, "ERROR" + write (*,'(6a)') 'ERROR ', trim(description), '. NetCDF file : "', trim(filename), '". Error message:', nf90_strerror(ierror) + endif + end subroutine nc_check_err + + subroutine fill_in (atm2lnd , lnd2atm , begc, endc , gindex_atm) + ! !ARGUMENTS: + type (atm2lnd_data1d_type), intent(inout) :: atm2lnd + type (lnd2atm_data1d_type), intent(inout) :: lnd2atm + + integer , intent(in) :: begc + integer , intent(in) :: endc + + + real :: lat + real :: lon + + integer , allocatable, intent(in) :: gindex_atm(:) + !integer :: i + integer :: i_local + integer :: i_global + + + ! tbot is going to be analytical function + + allocate ( atm2lnd%Sa_z (begc:endc) ) !; atm2lnd%Sa_z (:) = 30.0d0 + allocate ( atm2lnd%Sa_topo (begc:endc) ) !; atm2lnd%Sa_topo (:) = 10.0d0 + allocate ( atm2lnd%Sa_u (begc:endc) ) !; atm2lnd%Sa_u (:) = 20.0d0 + allocate ( atm2lnd%Sa_v (begc:endc) ) !; atm2lnd%Sa_v (:) = 40.0d0 + allocate ( atm2lnd%Sa_ptem (begc:endc) ) !; atm2lnd%Sa_ptem (:) = 280.0d0 + allocate ( atm2lnd%Sa_pbot (begc:endc) ) !; atm2lnd%Sa_pbot (:) = 100100.0d0 + allocate ( atm2lnd%Sa_tbot (begc:endc) ) !; atm2lnd%Sa_tbot (:) = 280.0 + allocate ( atm2lnd%Sa_shum (begc:endc) ) !; atm2lnd%Sa_shum (:) = 0.0004d0 + + allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) !; atm2lnd%Faxa_lwdn (:) = 200.0d0 + allocate ( atm2lnd%Faxa_rainc (begc:endc) ) !; atm2lnd%Faxa_rainc (:) = 0.0d0 + allocate ( atm2lnd%Faxa_rainl (begc:endc) ) !; atm2lnd%Faxa_rainl (:) = 3.0d-8 + allocate ( atm2lnd%Faxa_snowc (begc:endc) ) !; atm2lnd%Faxa_snowc (:) = 1.0d-8 + allocate ( atm2lnd%Faxa_snowl (begc:endc) ) !; atm2lnd%Faxa_snowl (:) = 2.0d-8 + + allocate ( atm2lnd%Faxa_swndr (begc:endc) ) !; atm2lnd%Faxa_swndr (:) = 100.0d0 + allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) !; atm2lnd%Faxa_swvdr (:) = 50.0d0 + allocate ( atm2lnd%Faxa_swndf (begc:endc) ) !; atm2lnd%Faxa_swndf (:) = 20.0d0 + allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) !; atm2lnd%Faxa_swvdf (:) = 40.0d0 + + do i_local = begc, endc + + i_global = gindex_atm(i_local) + lon = centerCoords(1,i_global) + lat = centerCoords(2,i_global) + + ! rounding to nearest int + lon = real(nint(lon)) + lat = real(nint(lat)) + ! This is i_local + print *, "i_local is:", i_local, "i_global is :", i_global, "lon:", lon, "lat:", lat + !atm2lnd%Sa_tbot(i_local) = 280.0d0 + (sin (lat)+ cos(lon))*1.0d0 + !atm2lnd%Sa_tbot(i_local) = 280.0d0 + cos(lon)*1.0d0 + + atm2lnd%Sa_z (i_local) = 30.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_topo (i_local) = 10.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_u (i_local) = 20.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_v (i_local) = 40.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_ptem (i_local) = 280.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_pbot (i_local) = 100100.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_tbot (i_local) = 280.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_shum (i_local) = 0.0004d0 !+(lat*0.01d0 + lon*0.01d0)*1.0e-8 + atm2lnd%Faxa_lwdn (i_local) = 200.0d0 + lat *0.01d0 + lon *0.01d0 + + !atm2lnd%Faxa_rainc (i_local) = 0.0d0 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 + atm2lnd%Faxa_rainl (i_local) = 3.0d-8 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 + atm2lnd%Faxa_snowc (i_local) = 1.0d-8 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 + atm2lnd%Faxa_snowl (i_local) = 2.0d-8 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 + atm2lnd%Faxa_swndr (i_local) = 100.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Faxa_swvdr (i_local) = 50.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Faxa_swndf (i_local) = 20.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Faxa_swvdf (i_local) = 40.0d0 + lat *0.01d0 + lon *0.01d0 + !atm2lnd%Sa_tbot(i) = 280.0 + sin ( lat )*1.0 + !atm2lnd%Sa_tbot(i) = 280.0 + cos(lon)*1.0 + + ! radian instead of degrees: + !lon = lon* PI/180.0 + !lat = lat* PI/180.0 + end do + + !allocating these values from atmosphere for now! + !allocate ( atm2lnd%Sa_z (begc:endc) ) ; atm2lnd%Sa_z (:) = 30.0d0 + !allocate ( atm2lnd%Sa_topo (begc:endc) ) ; atm2lnd%Sa_topo (:) = 10.0d0 + !allocate ( atm2lnd%Sa_u (begc:endc) ) ; atm2lnd%Sa_u (:) = 20.0d0 + !allocate ( atm2lnd%Sa_v (begc:endc) ) ; atm2lnd%Sa_v (:) = 40.0d0 + !allocate ( atm2lnd%Sa_ptem (begc:endc) ) ; atm2lnd%Sa_ptem (:) = 280.0d0 + !allocate ( atm2lnd%Sa_pbot (begc:endc) ) ; atm2lnd%Sa_pbot (:) = 100100.0d0 + !allocate ( atm2lnd%Sa_tbot (begc:endc) ) ; atm2lnd%Sa_tbot (:) = 280.0d0 + !allocate ( atm2lnd%Sa_shum (begc:endc) ) ; atm2lnd%Sa_shum (:) = 0.0004d0 + !allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) ; atm2lnd%Faxa_lwdn (:) = 200.0d0 + !allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 4.0d-8 + allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 0.0d0 + !allocate ( atm2lnd%Faxa_rainl (begc:endc) ) ; atm2lnd%Faxa_rainl (:) = 3.0d-8 + !allocate ( atm2lnd%Faxa_snowc (begc:endc) ) ; atm2lnd%Faxa_snowc (:) = 1.0d-8 + !allocate ( atm2lnd%Faxa_snowl (begc:endc) ) ; atm2lnd%Faxa_snowl (:) = 2.0d-8 + + !allocate ( atm2lnd%Faxa_swndr (begc:endc) ) ; atm2lnd%Faxa_swndr (:) = 100.0d0 + !allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) ; atm2lnd%Faxa_swvdr (:) = 50.0d0 + !allocate ( atm2lnd%Faxa_swndf (begc:endc) ) ; atm2lnd%Faxa_swndf (:) = 20.0d0 + !allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) ; atm2lnd%Faxa_swvdf (:) = 40.0d0 + !allocate ( atm2lnd%Faxa_bcph (begc:endc) ) ; atm2lnd%Faxa_bcph (:) = 0.0d0 + + + allocate ( lnd2atm%Sl_lfrin (begc:endc) ) ; lnd2atm%Sl_lfrin (:) = 0 + allocate ( lnd2atm%Sl_t (begc:endc) ) ; lnd2atm%Sl_t (:) = 0 + allocate ( lnd2atm%Sl_tref (begc:endc) ) ; lnd2atm%Sl_tref (:) = 0 + allocate ( lnd2atm%Sl_qref (begc:endc) ) ; lnd2atm%Sl_qref (:) = 0 + allocate ( lnd2atm%Sl_avsdr (begc:endc) ) ; lnd2atm%Sl_avsdr (:) = 0 + allocate ( lnd2atm%Sl_anidr (begc:endc) ) ; lnd2atm%Sl_anidr (:) = 0 + allocate ( lnd2atm%Sl_avsdf (begc:endc) ) ; lnd2atm%Sl_avsdf (:) = 0 + allocate ( lnd2atm%Sl_anidf (begc:endc) ) ; lnd2atm%Sl_anidf (:) = 0 + allocate ( lnd2atm%Sl_snowh (begc:endc) ) ; lnd2atm%Sl_snowh (:) = 0 + allocate ( lnd2atm%Sl_u10 (begc:endc) ) ; lnd2atm%Sl_u10 (:) = 0 + allocate ( lnd2atm%Sl_fv (begc:endc) ) ; lnd2atm%Sl_fv (:) = 0 + allocate ( lnd2atm%Sl_ram1 (begc:endc) ) ; lnd2atm%Sl_ram1 (:) = 0 + end subroutine fill_in end module demo_mod @@ -117,6 +369,7 @@ program demo_lilac_driver use clm_varctl , only : iulog use spmdMod , only : masterproc use demo_mod , only : demo_init + use demo_mod , only : read_netcdf_mesh implicit none ! TO DO: change the name and the derived data types @@ -145,6 +398,7 @@ program demo_lilac_driver character(*),parameter :: F01 = "(a,i4,d26.19)" character(*),parameter :: F02 = "('[demo_driver]',a,i5,2x,d26.19)" integer , allocatable :: gindex_atm(:) + !------------------------------------------------------------------------ ! real atmosphere: begc = 1 @@ -169,68 +423,31 @@ program demo_lilac_driver allocate ( rand1 (begc:endc) ) ; call random_number (rand1) allocate ( rand2 (begc:endc) ) ; call random_number (rand2) - !allocating these values from atmosphere for now! - allocate ( atm2lnd%Sa_z (begc:endc) ) ; atm2lnd%Sa_z (:) = 30.0d0 - allocate ( atm2lnd%Sa_topo (begc:endc) ) ; atm2lnd%Sa_topo (:) = 10.0d0 - allocate ( atm2lnd%Sa_u (begc:endc) ) ; atm2lnd%Sa_u (:) = 20.0d0 - allocate ( atm2lnd%Sa_v (begc:endc) ) ; atm2lnd%Sa_v (:) = 40.0d0 - allocate ( atm2lnd%Sa_ptem (begc:endc) ) ; atm2lnd%Sa_ptem (:) = 280.0d0 - allocate ( atm2lnd%Sa_pbot (begc:endc) ) ; atm2lnd%Sa_pbot (:) = 100100.0d0 - allocate ( atm2lnd%Sa_tbot (begc:endc) ) ; atm2lnd%Sa_tbot (:) = 280.0d0 - allocate ( atm2lnd%Sa_shum (begc:endc) ) ; atm2lnd%Sa_shum (:) = 0.0004d0 - allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) ; atm2lnd%Faxa_lwdn (:) = 200.0d0 - !allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 4.0d-8 - allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 0.0d0 - allocate ( atm2lnd%Faxa_rainl (begc:endc) ) ; atm2lnd%Faxa_rainl (:) = 3.0d-8 - allocate ( atm2lnd%Faxa_snowc (begc:endc) ) ; atm2lnd%Faxa_snowc (:) = 1.0d-8 - allocate ( atm2lnd%Faxa_snowl (begc:endc) ) ; atm2lnd%Faxa_snowl (:) = 2.0d-8 - allocate ( atm2lnd%Faxa_swndr (begc:endc) ) ; atm2lnd%Faxa_swndr (:) = 100.0d0 - - allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) ; atm2lnd%Faxa_swvdr (:) = 50.0d0 - allocate ( atm2lnd%Faxa_swndf (begc:endc) ) ; atm2lnd%Faxa_swndf (:) = 20.0d0 - allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) ; atm2lnd%Faxa_swvdf (:) = 40.0d0 - !allocate ( atm2lnd%Faxa_bcph (begc:endc) ) ; atm2lnd%Faxa_bcph (:) = 0.0d0 - - - fldname = 'Sa_topo' - if (debug > 0) then - do i=begc, endc - write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, atm2lnd%Sa_topo(i) - enddo - end if - - !endc = 18048 ? should this be the size of the land or atmosphere??? - - !print *, atm2lnd%Sa_topo(1:100) + !fldname = 'Sa_topo' + !if (debug > 0) then + ! do i=begc, endc + ! write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, atm2lnd%Sa_topo(i) + ! enddo + ! end if - allocate ( lnd2atm%Sl_lfrin (begc:endc) ) ; lnd2atm%Sl_lfrin (:) = 0 - allocate ( lnd2atm%Sl_t (begc:endc) ) ; lnd2atm%Sl_t (:) = 0 - allocate ( lnd2atm%Sl_tref (begc:endc) ) ; lnd2atm%Sl_tref (:) = 0 - allocate ( lnd2atm%Sl_qref (begc:endc) ) ; lnd2atm%Sl_qref (:) = 0 - allocate ( lnd2atm%Sl_avsdr (begc:endc) ) ; lnd2atm%Sl_avsdr (:) = 0 - allocate ( lnd2atm%Sl_anidr (begc:endc) ) ; lnd2atm%Sl_anidr (:) = 0 - allocate ( lnd2atm%Sl_avsdf (begc:endc) ) ; lnd2atm%Sl_avsdf (:) = 0 - allocate ( lnd2atm%Sl_anidf (begc:endc) ) ; lnd2atm%Sl_anidf (:) = 0 - allocate ( lnd2atm%Sl_snowh (begc:endc) ) ; lnd2atm%Sl_snowh (:) = 0 - allocate ( lnd2atm%Sl_u10 (begc:endc) ) ; lnd2atm%Sl_u10 (:) = 0 - allocate ( lnd2atm%Sl_fv (begc:endc) ) ; lnd2atm%Sl_fv (:) = 0 - allocate ( lnd2atm%Sl_ram1 (begc:endc) ) ; lnd2atm%Sl_ram1 (:) = 0 + !print *, atm2lnd%Sa_topo(1:100) !------------------------------------------------------------------------ ! The newly added demo_init + ! all allocate will go here: !------------------------------------------------------------------------ - call demo_init(gindex_atm) + call demo_init(gindex_atm, atm2lnd , lnd2atm) !------------------------------------------------------------------------ ! looping over imaginary time .... !------------------------------------------------------------------------ - call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm ) + call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm , gindex_atm = gindex_atm ) do curr_time = start_time, end_time call lilac_run ( ) itime_step = itime_step + 1 diff --git a/lilac/lilac/demo_mod.F90 b/lilac/lilac/demo_mod.F90 new file mode 100644 index 0000000000..7b077afcbf --- /dev/null +++ b/lilac/lilac/demo_mod.F90 @@ -0,0 +1,231 @@ +module demo_mod +!---------------------------------------------------------------------------- + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS + use spmdMod , only : masterproc + implicit none + private + public :: demo_init + public :: read_netcdf_mesh + integer :: ierr + integer :: COMP_COMM + integer :: npts ! domain global size + integer :: num_local +!---------------------------------------------------------------------------- +contains +!---------------------------------------------------------------------------- + subroutine demo_init(gindex_atm) + !! TODO: IS THE INTENT CORRECT FOR GINDEX_ATM + integer , allocatable, intent(inout) :: gindex_atm(:) + integer :: ntasks + integer :: mytask + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + + npts = 3312 + ! this is coming from + ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 + call MPI_init(ierr) + COMP_COMM = MPI_COMM_WORLD + + !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 + if (ierr .ne. MPI_SUCCESS) then + print *,'Error starting MPI program. Terminating.' + call MPI_ABORT(MPI_COMM_WORLD, ierr) + end if + + ! + + call MPI_COMM_RANK(COMP_COMM, mytask, ierr) + call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) + + if (masterproc) then + print *, "MPI initialization done ..., ntasks=", ntasks + end if + + call decompInit_atm( ntasks, mytask, gindex_atm) + print *, "gindex_atm for ", mytask,"is: ", gindex_atm + print *, "size gindex_atm for ", mytask,"is: ", size(gindex_atm) + end subroutine demo_init + + subroutine decompInit_atm( ntasks, mytask, gindex_atm) + + ! !DESCRIPTION: + + ! !USES: + + ! !ARGUMENTS: + integer , intent(in) :: ntasks + integer , intent(in) :: mytask + integer , allocatable, intent(out) :: gindex_atm(:) ! this variable is allocated here, and is assumed to start unallocated + ! !LOCAL VARIABLES: + integer :: my_start + integer :: my_end + integer :: i_local + integer :: i_global + !------------------------------------------------------------------------------ + ! create the a global index array for ocean points + + num_local = npts / ntasks + + my_start = num_local*mytask + min(mytask, mod(npts, ntasks)) + 1 + ! The first mod(npts,ntasks) of ntasks are the ones that have an extra point + if (mytask < mod(npts, ntasks)) then + num_local = num_local + 1 + end if + my_end = my_start + num_local - 1 + + allocate(gindex_atm(num_local)) + + i_global = my_start + do i_local = 1, num_local + gindex_atm(i_local) = i_global + i_global = i_global +1 + end do + + end subroutine decompInit_atm + + subroutine read_netcdf_mesh(filename) + + use netcdf + implicit none + + ! + ! Parameters + ! + + ! + ! Arguments | Global Variables + ! + character(*) , intent(in) :: filename + + + ! + ! Local Variables + ! + + integer :: idfile + + integer :: ierror + integer :: dimid_node + integer :: dimid_elem + integer :: dimid_maxnodepe + integer :: dimid_coordDim + + integer :: iddim_node + integer :: iddim_elem + integer :: iddim_maxnodepe + integer :: iddim_coordDim + + integer :: idvar_nodeCoords + integer :: idvar_CenterCoords + + character (len=100) :: string + + + integer :: nnode + integer :: nelem + integer :: maxnodePE + integer :: coordDim + real, dimension(:,:), allocatable :: centerCoords + real, dimension(:,:), allocatable :: nodeCoords + !----------------------------------------------------------------------------- + ! Open mesh file and get the idfile + ierror = nf90_open ( filename, NF90_NOWRITE, idfile) ; call nc_check_err(ierror, "opening file", filename) + + ! Get the dimid of dimensions + ierror = nf90_inq_dimid(idfile, 'nodeCount' , dimid_node ) ; call nc_check_err(ierror, "inq_dimid nodeCount", filename) + ierror = nf90_inq_dimid(idfile, 'elementCount' , dimid_elem ); call nc_check_err(ierror, "inq_dimid elementCount", filename) + ierror = nf90_inq_dimid(idfile, 'maxNodePElement' , dimid_maxnodepe ); call nc_check_err(ierror, "inq_dimid maxNodePElement", filename) + ierror = nf90_inq_dimid(idfile, 'coordDim' , dimid_coordDim ); call nc_check_err(ierror, "coordDim", filename) + + ! Inquire dimensions based on their dimeid(s) + ierror = nf90_inquire_dimension(idfile, dimid_node , string, nnode ); call nc_check_err(ierror, "inq_dim nodeCount", filename) + ierror = nf90_inquire_dimension(idfile, dimid_elem , string, nelem ); call nc_check_err(ierror, "inq_dim elementCount", filename) + ierror = nf90_inquire_dimension(idfile, dimid_maxnodepe , string, maxnodePE ); call nc_check_err(ierror, "inq_dim maxNodePElement", filename) + ierror = nf90_inquire_dimension(idfile, dimid_coordDim , string, coordDim ); call nc_check_err(ierror, "inq_dim coordDim", filename) + + print *, "=======================================" + print *, "nnode is : ", nnode + print *, "nelem is : ", nelem + print *, "coordDim is :", coordDim + print *, "=======================================" + + allocate (nodeCoords(coordDim, nnode)) + allocate (centerCoords(coordDim, nelem)) + ! Get variable IDs (varid) + ierror = nf90_inq_varid(idfile, 'nodeCoords' , idvar_nodeCoords ); call nc_check_err(ierror, "inq_varid nodeCoords", filename) + ierror = nf90_inq_varid(idfile, 'centerCoords' , idvar_centerCoords ); call nc_check_err(ierror, "inq_varid centerCoords", filename) + + ! Get variables values from varids + ierror = nf90_get_var(idfile, idvar_nodeCoords , nodeCoords , start=(/ 1,1/) , count=(/ coordDim, nnode /) ); call nc_check_err(ierror,"get_var nodeCoords", filename) + ierror = nf90_get_var(idfile, idvar_CenterCoords , centerCoords , start=(/ 1,1/) , count=(/ coordDim, nelem /) ); call nc_check_err(ierror,"get_var CenterCoords", filename) + + print *, "lons : ",centerCoords(1,:) + + end subroutine read_netcdf_mesh + +subroutine nc_check_err(ierror, description, filename) +!----- GPL --------------------------------------------------------------------- +! +! Copyright (C) Stichting Deltares, 2011-2018. +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation version 3. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see . +! +! contact: delft3d.support@deltares.nl +! Stichting Deltares +! P.O. Box 177 +! 2600 MH Delft, The Netherlands +! +! All indications and logos of, and references to, "Delft3D" and "Deltares" +! are registered trademarks of Stichting Deltares, and remain the property of +! Stichting Deltares. All rights reserved. +! +!------------------------------------------------------------------------------- +! $Id: nc_check_err.f90 7992 2018-01-09 10:27:35Z mourits $ +! $HeadURL: https://svn.oss.deltares.nl/repos/delft3d/trunk/src/engines_gpl/wave/packages/data/src/nc_check_err.f90 $ +!!--description----------------------------------------------------------------- +! NONE +!!--pseudo code and references-------------------------------------------------- +! NONE +!!--declarations---------------------------------------------------------------- + use netcdf + ! + implicit none +! +! Global variables +! + integer , intent(in) :: ierror + character(*), intent(in) :: description + character(*), intent(in) :: filename +! +! Local variables +! +! +!! executable statements ------------------------------------------------------- +! + if (ierror /= nf90_noerr) then + print *, "ERROR" + write (*,'(6a)') 'ERROR ', trim(description), '. NetCDF file : "', trim(filename), '". Error message:', nf90_strerror(ierror) + endif +end subroutine nc_check_err + + + + + + + +end module demo_mod + + diff --git a/lilac/lilac/demo_utils.F90 b/lilac/lilac/demo_utils.F90 new file mode 100644 index 0000000000..6189145936 --- /dev/null +++ b/lilac/lilac/demo_utils.F90 @@ -0,0 +1,160 @@ +module demo_utils +!---------------------------------------------------------------------------- + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS + use spmdMod , only : masterproc + implicit none + private + public :: demo_init + public :: read_netcdf_mesh + integer :: ierr + integer :: COMP_COMM + integer :: npts ! domain global size + integer :: num_local +!---------------------------------------------------------------------------- +contains +!---------------------------------------------------------------------------- + subroutine demo_init(gindex_atm) + !! TODO: IS THE INTENT CORRECT FOR GINDEX_ATM + integer , allocatable, intent(inout) :: gindex_atm(:) + integer :: ntasks + integer :: mytask + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + + npts = 3312 + ! this is coming from + ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 + call MPI_init(ierr) + COMP_COMM = MPI_COMM_WORLD + + !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 + if (ierr .ne. MPI_SUCCESS) then + print *,'Error starting MPI program. Terminating.' + call MPI_ABORT(MPI_COMM_WORLD, ierr) + end if + + ! + + call MPI_COMM_RANK(COMP_COMM, mytask, ierr) + call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) + + if (masterproc) then + print *, "MPI initialization done ..., ntasks=", ntasks + end if + + call decompInit_atm( ntasks, mytask, gindex_atm) + print *, "gindex_atm for ", mytask,"is: ", gindex_atm + print *, "size gindex_atm for ", mytask,"is: ", size(gindex_atm) + end subroutine demo_init + + subroutine decompInit_atm( ntasks, mytask, gindex_atm) + + ! !DESCRIPTION: + + ! !USES: + + ! !ARGUMENTS: + integer , intent(in) :: ntasks + integer , intent(in) :: mytask + integer , allocatable, intent(out) :: gindex_atm(:) ! this variable is allocated here, and is assumed to start unallocated + ! !LOCAL VARIABLES: + integer :: my_start + integer :: my_end + integer :: i_local + integer :: i_global + !------------------------------------------------------------------------------ + ! create the a global index array for ocean points + + num_local = npts / ntasks + + my_start = num_local*mytask + min(mytask, mod(npts, ntasks)) + 1 + ! The first mod(npts,ntasks) of ntasks are the ones that have an extra point + if (mytask < mod(npts, ntasks)) then + num_local = num_local + 1 + end if + my_end = my_start + num_local - 1 + + allocate(gindex_atm(num_local)) + + i_global = my_start + do i_local = 1, num_local + gindex_atm(i_local) = i_global + i_global = i_global +1 + end do + + end subroutine decompInit_atm + + subroutine read_netcdf_mesh(filename) + + use netcdf + implicit none + + ! + ! Parameters + ! + + ! + ! Arguments | Global Variables + ! + character(*) , intent(in) :: filename + + + ! + ! Local Variables + ! + + integer :: idfile + + integer :: ierror + integer :: dimid_node + integer :: dimid_elem + integer :: dimid_maxnodepe + integer :: dimid_coordDim + + integer :: iddim_node + integer :: iddim_elem + integer :: iddim_maxnodepe + integer :: iddim_coordDim + + integer :: idvar_nodeCoords + integer :: idvar_CenterCoords + + character (len=100) :: string + + integer :: nnode + integer :: nelem + integer :: maxnodePE + integer :: coordDim + !----------------------------------------------------------------------------- + ! Open mesh file and get the idfile + ierror = nf90_open ( filename, NF90_NOWRITE, idfile); call nc_check_err(ierror, "opening file", filename) + + ! Get the dimid of dimensions + ierror = nf90_inq_dimid(idfile, 'nodeCount' , dimid_node ); call nc_check_err(ierror, "inq_dimid nodeCount", filename) + ierror = nf90_inq_dimid(idfile, 'elementCount' , dimid_elem ); call nc_check_err(ierror, "inq_dimid elementCount", filename) + ierror = nf90_inq_dimid(idfile, 'maxNodePElement' , dimid_maxnodepe ); call nc_check_err(ierror, "inq_dimid maxNodePElement", filename) + ierror = nf90_inq_dimid(idfile, 'coordDim' , dimid_coordDim ); call nc_check_err(ierror, "coordDim", filename) + + ! Inquire dimensions based on their dimeid(s) + ierror = nf90_inquire_dimension(idfile, iddim_node , string, nnode ); call nc_check_err(ierror, "inq_dim nodeCount", filename) + ierror = nf90_inquire_dimension(idfile, iddim_elem , string, nelem ); call nc_check_err(ierror, "inq_dim elementCount", filename) + ierror = nf90_inquire_dimension(idfile, iddim_maxnodepe , string, maxnodePE ); call nc_check_err(ierror, "inq_dim maxNodePElement", filename) + ierror = nf90_inquire_dimension(idfile, iddim_coordDim , string, coordDim ); call nc_check_err(ierror, "inq_dim coordDim", filename) + + + ! Get variable IDs (varid) + ierror = nf90_inq_varid(idfile, 'nodeCoords' , idvar_nodeCoords ); call nc_check_err(ierror, "inq_varid nodeCoords", filename) + ierror = nf90_inq_varid(idfile, 'CenterCoords' , idvar_CenterCoords ); call nc_check_err(ierror, "inq_varid CenterCoords", filename) + + ! Get variables values from varids + !ierror = nf90_get_var(idfile, idvar_nodeCoords , nodeCoords , start=(/ 1,1/) , count=(/ nnode, coordDim /) ); call nc_check_err(ierror,"get_var nodeCoords", filename) + !ierror = nf90_get_var(idfile, idvar_CenterCoords , CenterCoords , start=(/ 1,1/) , count=(/ nelem, coordDim /) ); call nc_check_err(ierror,"get_var CenterCoords", filename) + + + + + end subroutine read_netcdf_mesh + +end module demo_utils + diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index b0545d4105..1e53604cb6 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -54,19 +54,21 @@ module lilac_mod contains !======================================================================== - subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) + subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d, gindex_atm) use atmos_cap , only : a2c_fldlist , c2a_fldlist + use atmos_cap , only : dummy_gindex_atm use lnd_cap , only : l2c_fldlist , c2l_fldlist character(len=*), parameter :: subname=trim(modname)//': [lilac_init] ' ! input/output variables - type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d - type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d - type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d - type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d + type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d + type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d + type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d + type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d + integer , allocatable :: gindex_atm(:) ! local variables type(ESMF_State) :: importState, exportState @@ -122,10 +124,10 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) COMP_COMM = MPI_COMM_WORLD !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 - if (ierr .ne. MPI_SUCCESS) then - print *,'Error starting MPI program. Terminating.' - call MPI_ABORT(MPI_COMM_WORLD, ierr) - end if + !if (ierr .ne. MPI_SUCCESS) then + ! print *,'Error starting MPI program. Terminating.' + ! call MPI_ABORT(MPI_COMM_WORLD, ierr) + !end if ! @@ -279,6 +281,7 @@ subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d) + dummy_gindex_atm = gindex_atm ! ======================================================================== !------------------------------------------------------------------------- From afd735fb0bc9bf7fedec851336b5c01ec2ba289a Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 25 Nov 2019 23:21:14 -0700 Subject: [PATCH 156/556] small changes in the Makefile... --- lilac/lilac/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile index 77ebef6d87..feab757abf 100644 --- a/lilac/lilac/Makefile +++ b/lilac/lilac/Makefile @@ -83,10 +83,10 @@ demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_c # module dependencies: #demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o -demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o +demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o demo_utils.o demo_mod.o lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o #shr_pio_mod.o atmos_cap.o: lilac_utils.o - +demo_mod.o: # ----------------------------------------------------------------------------- .PHONY: clean berzerk remake From dc10dd23b91d92e34accbae99ef0a8c1ec812ad6 Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 25 Nov 2019 23:22:36 -0700 Subject: [PATCH 157/556] the latest version of the CMakeLists. This is not working... --- lilac/CMakeLists.txt | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 7d45799a7d..89ae531242 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -188,11 +188,6 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") -# TODO: This should not be necessary but certain header files are missing from the build -#set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I /usr/include/ -I/usr/src/lilac/external/esmf/src/Infrastructure/Util/include -I/usr/src/lilac/external/esmf/build_config/Linux.gfortran.default -I /usr/src/lilac/external/esmf/src/include") -#set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/usr/include/ -I/usr/src/esmf/src/Infrastructure/Util/include/ -I/usr/src/esmf/build_config/Linux.gfortran.default -I /usr/src/esmf/src/include") -#set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/include -L/glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib -lclm -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/c1a1l1/lib -lcsm_share -L/glade/scratch/negins/test_clean/bld/intel/mpt/nodebug/nothreads/nuopc/lib -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2/lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib ") - message(STATUS "==============================================================") message(STATUS "Fortran Compiler : ${CMAKE_Fortran_COMPILER}") @@ -215,6 +210,6 @@ file(GLOB_RECURSE SOURCES lilac/*.F90) add_executable (${PROJECT_NAME}.exe ${SOURCES}) target_link_libraries(${PROJECT_NAME}.exe ${LIB_TO_INCLUDE}) -#demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o + #add_subdirectory(lilac) #add_subdirectory(tests) From 4ce5985f451dfc8cdfc5afe9a1cc31696e7ee47c Mon Sep 17 00:00:00 2001 From: negin513 Date: Mon, 25 Nov 2019 23:27:57 -0700 Subject: [PATCH 158/556] tiny changes in printing outputs.... --- src/cpl/lilac/lnd_comp_esmf.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index ac980e4b4b..ddf03eb6a8 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -897,22 +897,23 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) doalb = (nextsw_cday >= -0.5_r8) end if - if (masterproc) then - write(iulog,*) 'doalb is: ', doalb - end if if (masterproc) then write(iulog,*) '------------ LILAC ----------------' write(iulog,*) 'nstep : ', nstep write(iulog,*) 'dtime : ', dtime - write(iulog,*) 'calday : ', calday - write(iulog,*) 'caldayp1 : ', caldayp1 - write(iulog,*) 'nextsw_cday : ', nextsw_cday + write(iulog,F02) 'calday : ', calday + write(iulog,F02) 'caldayp1 : ', caldayp1 + write(iulog,F02) 'nextsw_cday : ', nextsw_cday write(iulog,*) '-------------------------------------' end if call update_rad_dtime(doalb) + if (masterproc) then + write(iulog,*) 'doalb is: ', doalb + end if + !-------------------------------- ! Determine if time to write restart !-------------------------------- @@ -961,6 +962,7 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) if (masterproc) then write(iulog,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' + write(iulog,* ) 'doalb : ', doalb write(iulog,*) 'call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, decl' write(iulog,*) 'call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, decl' write(iulog,F02) 'calday is : ', calday @@ -969,7 +971,6 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) write(iulog,F02) 'lambm0 is : ', lambm0 write(iulog,F02) 'obliqr is : ', obliqr write(iulog,F02) 'clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic)' - write(iulog,* ) 'doalb : ', doalb write(iulog,F02) 'declin is : ', declin write(iulog,F02) 'declinp1 is : ', declinp1 write(iulog,F02) 'rof_prognostic : ', rof_prognostic From cdb48e599a87ecea39339782769ec69c3adf5e61 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 26 Nov 2019 10:27:43 -0700 Subject: [PATCH 159/556] renamed files in lilac/ and created a new atm_driver directory and moved the atm_driver.F90 to there --- lilac/{lilac => atm_driver}/Makefile | 0 .../atm_driver.F90} | 0 lilac/lilac/demo_mod.F90 | 231 ---------------- lilac/lilac/demo_utils.F90 | 160 ----------- .../lilac/{atmos_cap.F90 => lilac_atmcap.F90} | 0 lilac/lilac/{cpl_mod.F90 => lilac_cpl.F90} | 0 lilac/lilac/lnd_cap.F90 | 250 ------------------ 7 files changed, 641 deletions(-) rename lilac/{lilac => atm_driver}/Makefile (100%) rename lilac/{lilac/demo_driver.F90 => atm_driver/atm_driver.F90} (100%) delete mode 100644 lilac/lilac/demo_mod.F90 delete mode 100644 lilac/lilac/demo_utils.F90 rename lilac/lilac/{atmos_cap.F90 => lilac_atmcap.F90} (100%) rename lilac/lilac/{cpl_mod.F90 => lilac_cpl.F90} (100%) delete mode 100644 lilac/lilac/lnd_cap.F90 diff --git a/lilac/lilac/Makefile b/lilac/atm_driver/Makefile similarity index 100% rename from lilac/lilac/Makefile rename to lilac/atm_driver/Makefile diff --git a/lilac/lilac/demo_driver.F90 b/lilac/atm_driver/atm_driver.F90 similarity index 100% rename from lilac/lilac/demo_driver.F90 rename to lilac/atm_driver/atm_driver.F90 diff --git a/lilac/lilac/demo_mod.F90 b/lilac/lilac/demo_mod.F90 deleted file mode 100644 index 7b077afcbf..0000000000 --- a/lilac/lilac/demo_mod.F90 +++ /dev/null @@ -1,231 +0,0 @@ -module demo_mod -!---------------------------------------------------------------------------- - use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS - use spmdMod , only : masterproc - implicit none - private - public :: demo_init - public :: read_netcdf_mesh - integer :: ierr - integer :: COMP_COMM - integer :: npts ! domain global size - integer :: num_local -!---------------------------------------------------------------------------- -contains -!---------------------------------------------------------------------------- - subroutine demo_init(gindex_atm) - !! TODO: IS THE INTENT CORRECT FOR GINDEX_ATM - integer , allocatable, intent(inout) :: gindex_atm(:) - integer :: ntasks - integer :: mytask - !----------------------------------------------------------------------------- - ! Initiallize MPI - !----------------------------------------------------------------------------- - - npts = 3312 - ! this is coming from - ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 - call MPI_init(ierr) - COMP_COMM = MPI_COMM_WORLD - - !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 - if (ierr .ne. MPI_SUCCESS) then - print *,'Error starting MPI program. Terminating.' - call MPI_ABORT(MPI_COMM_WORLD, ierr) - end if - - ! - - call MPI_COMM_RANK(COMP_COMM, mytask, ierr) - call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) - - if (masterproc) then - print *, "MPI initialization done ..., ntasks=", ntasks - end if - - call decompInit_atm( ntasks, mytask, gindex_atm) - print *, "gindex_atm for ", mytask,"is: ", gindex_atm - print *, "size gindex_atm for ", mytask,"is: ", size(gindex_atm) - end subroutine demo_init - - subroutine decompInit_atm( ntasks, mytask, gindex_atm) - - ! !DESCRIPTION: - - ! !USES: - - ! !ARGUMENTS: - integer , intent(in) :: ntasks - integer , intent(in) :: mytask - integer , allocatable, intent(out) :: gindex_atm(:) ! this variable is allocated here, and is assumed to start unallocated - ! !LOCAL VARIABLES: - integer :: my_start - integer :: my_end - integer :: i_local - integer :: i_global - !------------------------------------------------------------------------------ - ! create the a global index array for ocean points - - num_local = npts / ntasks - - my_start = num_local*mytask + min(mytask, mod(npts, ntasks)) + 1 - ! The first mod(npts,ntasks) of ntasks are the ones that have an extra point - if (mytask < mod(npts, ntasks)) then - num_local = num_local + 1 - end if - my_end = my_start + num_local - 1 - - allocate(gindex_atm(num_local)) - - i_global = my_start - do i_local = 1, num_local - gindex_atm(i_local) = i_global - i_global = i_global +1 - end do - - end subroutine decompInit_atm - - subroutine read_netcdf_mesh(filename) - - use netcdf - implicit none - - ! - ! Parameters - ! - - ! - ! Arguments | Global Variables - ! - character(*) , intent(in) :: filename - - - ! - ! Local Variables - ! - - integer :: idfile - - integer :: ierror - integer :: dimid_node - integer :: dimid_elem - integer :: dimid_maxnodepe - integer :: dimid_coordDim - - integer :: iddim_node - integer :: iddim_elem - integer :: iddim_maxnodepe - integer :: iddim_coordDim - - integer :: idvar_nodeCoords - integer :: idvar_CenterCoords - - character (len=100) :: string - - - integer :: nnode - integer :: nelem - integer :: maxnodePE - integer :: coordDim - real, dimension(:,:), allocatable :: centerCoords - real, dimension(:,:), allocatable :: nodeCoords - !----------------------------------------------------------------------------- - ! Open mesh file and get the idfile - ierror = nf90_open ( filename, NF90_NOWRITE, idfile) ; call nc_check_err(ierror, "opening file", filename) - - ! Get the dimid of dimensions - ierror = nf90_inq_dimid(idfile, 'nodeCount' , dimid_node ) ; call nc_check_err(ierror, "inq_dimid nodeCount", filename) - ierror = nf90_inq_dimid(idfile, 'elementCount' , dimid_elem ); call nc_check_err(ierror, "inq_dimid elementCount", filename) - ierror = nf90_inq_dimid(idfile, 'maxNodePElement' , dimid_maxnodepe ); call nc_check_err(ierror, "inq_dimid maxNodePElement", filename) - ierror = nf90_inq_dimid(idfile, 'coordDim' , dimid_coordDim ); call nc_check_err(ierror, "coordDim", filename) - - ! Inquire dimensions based on their dimeid(s) - ierror = nf90_inquire_dimension(idfile, dimid_node , string, nnode ); call nc_check_err(ierror, "inq_dim nodeCount", filename) - ierror = nf90_inquire_dimension(idfile, dimid_elem , string, nelem ); call nc_check_err(ierror, "inq_dim elementCount", filename) - ierror = nf90_inquire_dimension(idfile, dimid_maxnodepe , string, maxnodePE ); call nc_check_err(ierror, "inq_dim maxNodePElement", filename) - ierror = nf90_inquire_dimension(idfile, dimid_coordDim , string, coordDim ); call nc_check_err(ierror, "inq_dim coordDim", filename) - - print *, "=======================================" - print *, "nnode is : ", nnode - print *, "nelem is : ", nelem - print *, "coordDim is :", coordDim - print *, "=======================================" - - allocate (nodeCoords(coordDim, nnode)) - allocate (centerCoords(coordDim, nelem)) - ! Get variable IDs (varid) - ierror = nf90_inq_varid(idfile, 'nodeCoords' , idvar_nodeCoords ); call nc_check_err(ierror, "inq_varid nodeCoords", filename) - ierror = nf90_inq_varid(idfile, 'centerCoords' , idvar_centerCoords ); call nc_check_err(ierror, "inq_varid centerCoords", filename) - - ! Get variables values from varids - ierror = nf90_get_var(idfile, idvar_nodeCoords , nodeCoords , start=(/ 1,1/) , count=(/ coordDim, nnode /) ); call nc_check_err(ierror,"get_var nodeCoords", filename) - ierror = nf90_get_var(idfile, idvar_CenterCoords , centerCoords , start=(/ 1,1/) , count=(/ coordDim, nelem /) ); call nc_check_err(ierror,"get_var CenterCoords", filename) - - print *, "lons : ",centerCoords(1,:) - - end subroutine read_netcdf_mesh - -subroutine nc_check_err(ierror, description, filename) -!----- GPL --------------------------------------------------------------------- -! -! Copyright (C) Stichting Deltares, 2011-2018. -! -! This program is free software: you can redistribute it and/or modify -! it under the terms of the GNU General Public License as published by -! the Free Software Foundation version 3. -! -! This program is distributed in the hope that it will be useful, -! but WITHOUT ANY WARRANTY; without even the implied warranty of -! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -! GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License -! along with this program. If not, see . -! -! contact: delft3d.support@deltares.nl -! Stichting Deltares -! P.O. Box 177 -! 2600 MH Delft, The Netherlands -! -! All indications and logos of, and references to, "Delft3D" and "Deltares" -! are registered trademarks of Stichting Deltares, and remain the property of -! Stichting Deltares. All rights reserved. -! -!------------------------------------------------------------------------------- -! $Id: nc_check_err.f90 7992 2018-01-09 10:27:35Z mourits $ -! $HeadURL: https://svn.oss.deltares.nl/repos/delft3d/trunk/src/engines_gpl/wave/packages/data/src/nc_check_err.f90 $ -!!--description----------------------------------------------------------------- -! NONE -!!--pseudo code and references-------------------------------------------------- -! NONE -!!--declarations---------------------------------------------------------------- - use netcdf - ! - implicit none -! -! Global variables -! - integer , intent(in) :: ierror - character(*), intent(in) :: description - character(*), intent(in) :: filename -! -! Local variables -! -! -!! executable statements ------------------------------------------------------- -! - if (ierror /= nf90_noerr) then - print *, "ERROR" - write (*,'(6a)') 'ERROR ', trim(description), '. NetCDF file : "', trim(filename), '". Error message:', nf90_strerror(ierror) - endif -end subroutine nc_check_err - - - - - - - -end module demo_mod - - diff --git a/lilac/lilac/demo_utils.F90 b/lilac/lilac/demo_utils.F90 deleted file mode 100644 index 6189145936..0000000000 --- a/lilac/lilac/demo_utils.F90 +++ /dev/null @@ -1,160 +0,0 @@ -module demo_utils -!---------------------------------------------------------------------------- - use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS - use spmdMod , only : masterproc - implicit none - private - public :: demo_init - public :: read_netcdf_mesh - integer :: ierr - integer :: COMP_COMM - integer :: npts ! domain global size - integer :: num_local -!---------------------------------------------------------------------------- -contains -!---------------------------------------------------------------------------- - subroutine demo_init(gindex_atm) - !! TODO: IS THE INTENT CORRECT FOR GINDEX_ATM - integer , allocatable, intent(inout) :: gindex_atm(:) - integer :: ntasks - integer :: mytask - !----------------------------------------------------------------------------- - ! Initiallize MPI - !----------------------------------------------------------------------------- - - npts = 3312 - ! this is coming from - ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 - call MPI_init(ierr) - COMP_COMM = MPI_COMM_WORLD - - !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 - if (ierr .ne. MPI_SUCCESS) then - print *,'Error starting MPI program. Terminating.' - call MPI_ABORT(MPI_COMM_WORLD, ierr) - end if - - ! - - call MPI_COMM_RANK(COMP_COMM, mytask, ierr) - call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) - - if (masterproc) then - print *, "MPI initialization done ..., ntasks=", ntasks - end if - - call decompInit_atm( ntasks, mytask, gindex_atm) - print *, "gindex_atm for ", mytask,"is: ", gindex_atm - print *, "size gindex_atm for ", mytask,"is: ", size(gindex_atm) - end subroutine demo_init - - subroutine decompInit_atm( ntasks, mytask, gindex_atm) - - ! !DESCRIPTION: - - ! !USES: - - ! !ARGUMENTS: - integer , intent(in) :: ntasks - integer , intent(in) :: mytask - integer , allocatable, intent(out) :: gindex_atm(:) ! this variable is allocated here, and is assumed to start unallocated - ! !LOCAL VARIABLES: - integer :: my_start - integer :: my_end - integer :: i_local - integer :: i_global - !------------------------------------------------------------------------------ - ! create the a global index array for ocean points - - num_local = npts / ntasks - - my_start = num_local*mytask + min(mytask, mod(npts, ntasks)) + 1 - ! The first mod(npts,ntasks) of ntasks are the ones that have an extra point - if (mytask < mod(npts, ntasks)) then - num_local = num_local + 1 - end if - my_end = my_start + num_local - 1 - - allocate(gindex_atm(num_local)) - - i_global = my_start - do i_local = 1, num_local - gindex_atm(i_local) = i_global - i_global = i_global +1 - end do - - end subroutine decompInit_atm - - subroutine read_netcdf_mesh(filename) - - use netcdf - implicit none - - ! - ! Parameters - ! - - ! - ! Arguments | Global Variables - ! - character(*) , intent(in) :: filename - - - ! - ! Local Variables - ! - - integer :: idfile - - integer :: ierror - integer :: dimid_node - integer :: dimid_elem - integer :: dimid_maxnodepe - integer :: dimid_coordDim - - integer :: iddim_node - integer :: iddim_elem - integer :: iddim_maxnodepe - integer :: iddim_coordDim - - integer :: idvar_nodeCoords - integer :: idvar_CenterCoords - - character (len=100) :: string - - integer :: nnode - integer :: nelem - integer :: maxnodePE - integer :: coordDim - !----------------------------------------------------------------------------- - ! Open mesh file and get the idfile - ierror = nf90_open ( filename, NF90_NOWRITE, idfile); call nc_check_err(ierror, "opening file", filename) - - ! Get the dimid of dimensions - ierror = nf90_inq_dimid(idfile, 'nodeCount' , dimid_node ); call nc_check_err(ierror, "inq_dimid nodeCount", filename) - ierror = nf90_inq_dimid(idfile, 'elementCount' , dimid_elem ); call nc_check_err(ierror, "inq_dimid elementCount", filename) - ierror = nf90_inq_dimid(idfile, 'maxNodePElement' , dimid_maxnodepe ); call nc_check_err(ierror, "inq_dimid maxNodePElement", filename) - ierror = nf90_inq_dimid(idfile, 'coordDim' , dimid_coordDim ); call nc_check_err(ierror, "coordDim", filename) - - ! Inquire dimensions based on their dimeid(s) - ierror = nf90_inquire_dimension(idfile, iddim_node , string, nnode ); call nc_check_err(ierror, "inq_dim nodeCount", filename) - ierror = nf90_inquire_dimension(idfile, iddim_elem , string, nelem ); call nc_check_err(ierror, "inq_dim elementCount", filename) - ierror = nf90_inquire_dimension(idfile, iddim_maxnodepe , string, maxnodePE ); call nc_check_err(ierror, "inq_dim maxNodePElement", filename) - ierror = nf90_inquire_dimension(idfile, iddim_coordDim , string, coordDim ); call nc_check_err(ierror, "inq_dim coordDim", filename) - - - ! Get variable IDs (varid) - ierror = nf90_inq_varid(idfile, 'nodeCoords' , idvar_nodeCoords ); call nc_check_err(ierror, "inq_varid nodeCoords", filename) - ierror = nf90_inq_varid(idfile, 'CenterCoords' , idvar_CenterCoords ); call nc_check_err(ierror, "inq_varid CenterCoords", filename) - - ! Get variables values from varids - !ierror = nf90_get_var(idfile, idvar_nodeCoords , nodeCoords , start=(/ 1,1/) , count=(/ nnode, coordDim /) ); call nc_check_err(ierror,"get_var nodeCoords", filename) - !ierror = nf90_get_var(idfile, idvar_CenterCoords , CenterCoords , start=(/ 1,1/) , count=(/ nelem, coordDim /) ); call nc_check_err(ierror,"get_var CenterCoords", filename) - - - - - end subroutine read_netcdf_mesh - -end module demo_utils - diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/lilac_atmcap.F90 similarity index 100% rename from lilac/lilac/atmos_cap.F90 rename to lilac/lilac/lilac_atmcap.F90 diff --git a/lilac/lilac/cpl_mod.F90 b/lilac/lilac/lilac_cpl.F90 similarity index 100% rename from lilac/lilac/cpl_mod.F90 rename to lilac/lilac/lilac_cpl.F90 diff --git a/lilac/lilac/lnd_cap.F90 b/lilac/lilac/lnd_cap.F90 deleted file mode 100644 index 3e73d4e6c1..0000000000 --- a/lilac/lilac/lnd_cap.F90 +++ /dev/null @@ -1,250 +0,0 @@ -module lnd_cap - use ESMF - use lilac_utils, only : fld_list_type - - implicit none - - character(*), parameter :: modname = " lnd_cap" - - !!integer, parameter :: fldsMax = 100 - - type(ESMF_Field), public, save :: field - type(ESMF_Field), public, save :: field_sie, field_u - - type(fld_list_type), public, allocatable :: c2l_fldlist(:) - type(fld_list_type), public, allocatable :: l2c_fldlist(:) - - !private - - public lnd_register - !public :: add_fields - !public :: import_fields - !public :: export_fields - - contains - -!------------------------------------------------------------------------- -! land register -!------------------------------------------------------------------------- - subroutine lnd_register(comp, rc) - - type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//': [lnd_register] ' - - print *, "in lnd register routine" - - rc = ESMF_SUCCESS - ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=lnd_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=lnd_run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=lnd_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - end subroutine lnd_register - -!------------------------------------------------------------------------- -! land init -!------------------------------------------------------------------------- - - subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) - - type (ESMF_GridComp) :: comp - type (ESMF_State) :: atm2lnd_l_state, lnd2atm_l_state - type (ESMF_Clock) :: clock - integer, intent(out) :: rc - - type (ESMF_FieldBundle) :: l2c_fb , c2l_fb - integer :: n - - - logical mesh_switch - integer :: petCount, localrc, urc - type(ESMF_Mesh) :: lnd_mesh - character(len=ESMF_MAXSTR) :: lnd_mesh_filepath - - character(len=*), parameter :: subname=trim(modname)//': [lnd_init] ' - - type(ESMF_Grid) :: lnd_grid - - integer :: c2l_fldlist_num - integer :: l2c_fldlist_num - !integer :: regDecomp(:,:) - - ! Initialize return code - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) - - call ESMF_GridCompGet(comp, petcount=petcount, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - - print *, " Empty land is created !!!!" - print *, "in land routine routine" - !------------------------------------------------------------------------- - ! Read in the mesh ----or----- Generate the grid - !------------------------------------------------------------------------- - mesh_switch = .true. - if(mesh_switch) then - print *, "creating mesh for land" - ! For now this is our dummy mesh: - !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' !! T31 and T62 did not work.... - !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T62_040121_ESMFmesh.nc' - lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Mesh for land is created!", ESMF_LOGMSG_INFO) - print *, "!Mesh for land is created!" - else - lnd_grid = ESMF_GridCreateNoPeriDimUfrm( minIndex= (/1,1/), maxIndex=(/180,360 /), & - maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & - minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & - coordSys=ESMF_COORDSYS_CART,& - regDecomp=(/petcount,1/),& - rc=rc) - call ESMF_GridCompGet(comp, grid= lnd_grid , petcount=petcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Grid for land is created!", ESMF_LOGMSG_INFO) - print *, "Grid for land is created!" - endif - - - - !------------------------------------------------------------------------- - ! Coupler (land) to Atmosphere Fields -- l2a - ! I- Create Field Bundle -- l2c_fb for now - ! II- Create Fields and add them to field bundle - ! III - Add l2c_fb to state (lnd2atm_l_state) - !------------------------------------------------------------------------- - - l2c_fb = ESMF_FieldBundleCreate (name="l2c_fb", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, 'l2c_fb is created' - ! Create individual fields and add to field bundle -- l2a - l2c_fldlist_num = 3 - - do n = 1,l2c_fldlist_num - - ! create field - !!! Here we want to pass pointers - if (mesh_switch) then - field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(l2c_fldlist(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(l2c_fldlist(n)%stdname), farrayPtr=l2c_fldlist(n)%farrayptr1d, rc= - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - else - field = ESMF_FieldCreate(lnd_grid, name=trim(l2c_fldlist(n)%stdname), farrayPtr=l2c_fldlist(n)%farrayptr2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end if - ! add field to field bundle - call ESMF_FieldBundleAdd(l2c_fb, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - print *, "**********************************************************" - print *, "creating field for l2a:" - print *, trim(l2c_fldlist(n)%stdname) - print *, l2c_fldlist(n)%farrayptr1d - - enddo - - print *, "!Fields For Coupler (l2c_fldlist) Field Bundle Created!" - - ! Add field bundle to state - call ESMF_StateAdd(lnd2atm_l_state, (/l2c_fb/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!lnd2atm_l_state is filld with dummy_var field bundle!" - - - !------------------------------------------------------------------------- - ! Atmosphere to Coupler (land) Fields -- a2l - ! I- Create empty field bundle -- c2l_fb - ! II- Create Fields and add them to field bundle - ! III - Add c2l_fb to state (atm2lnd_l_state) - !------------------------------------------------------------------------- - - c2l_fb = ESMF_FieldBundleCreate(name="c2l_fb", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Create individual fields and add to field bundle -- a2l - - !call fldlist_add(c2l_fldlist_num, c2l_fldlist, 'dum_var2' ) - c2l_fldlist_num = 3 - - do n = 1,c2l_fldlist_num - - ! create field - !!! Here we want to pass pointers - field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2l_fldlist(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2l_fldlist(n)%stdname), farrayPtr=c2l_fldlist(n)%farrayptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) - !fldptr = c2l_fldlist(n)%default_value - - ! add field to field bundle - call ESMF_FieldBundleAdd(c2l_fb, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - - print *, "**********************************************************" - print *, "creating field for a2l:" - print *, trim(c2l_fldlist(n)%stdname) - print *, c2l_fldlist(n)%farrayptr1d - - enddo - - print *, "!Fields to Coupler (atmos to land ) (c2l_fb) Field Bundle Created!" - - ! Add field bundle to state - call ESMF_StateAdd(atm2lnd_l_state, (/c2l_fb/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - print *, "!atm2lnd_l_state is filld with dummy_var field bundle!" - - - - end subroutine lnd_init - -!------------------------------------------------------------------------- -! land run -!------------------------------------------------------------------------- - subroutine lnd_run(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//': [lnd_run] ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"lnd_run has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine lnd_run - -!------------------------------------------------------------------------- -! land final -!------------------------------------------------------------------------- - subroutine lnd_final(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//': [lnd_final] ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"lnd_final is called but has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine lnd_final - !=============================================================================== - - - - - -end module lnd_cap From a1dcf769a455782bae42000772865d4e50e20b34 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 26 Nov 2019 11:49:19 -0700 Subject: [PATCH 160/556] updates that reproduce Negin's last baselines --- lilac/atm_driver/Makefile | 85 ++- lilac/atm_driver/atm_driver.F90 | 718 ++++++++------------ lilac/atm_driver/cheyenne.sub | 39 ++ lilac/atm_driver/drv_flds_in | 7 + lilac/atm_driver/drv_in | 268 ++++++++ lilac/atm_driver/lnd_in | 238 +++++++ lilac/atm_driver/namelist_lilac | 10 + lilac/lilac/lilac_atmcap.F90 | 471 ++++++-------- lilac/lilac/lilac_cpl.F90 | 583 ++++++++--------- lilac/lilac/lilac_mod.F90 | 1078 ++++++++++++++----------------- lilac/lilac/lilac_utils.F90 | 759 +++++++++------------- 11 files changed, 2179 insertions(+), 2077 deletions(-) create mode 100644 lilac/atm_driver/cheyenne.sub create mode 100644 lilac/atm_driver/drv_flds_in create mode 100644 lilac/atm_driver/drv_in create mode 100644 lilac/atm_driver/lnd_in create mode 100644 lilac/atm_driver/namelist_lilac diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index feab757abf..ee3fb76810 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -18,14 +18,15 @@ # # automatically set the environment variable "ESMFMKFILE". In this case # # either manually set "ESMFMKFILE" in your environment or hard code the # # location of "esmf.mk" into the include statement below. -# # Notice that the latter approach has negative impact on flexibility and +# # Notice that the latter approach has negative impact on flexibility and # # portability. -ifneq ($(origin ESMFMKFILE), environment) -$(error Environment variable ESMFMKFILE was not set.) -endif +#ifneq ($(origin ESMFMKFILE), environment) +#$(error Environment variable ESMFMKFILE was not set.) +#endif +ESMFMKFILE = /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libO/Linux.intel.64.mpt.default/esmf.mk include $(ESMFMKFILE) #================================================================================ @@ -33,24 +34,20 @@ include $(ESMFMKFILE) #================================================================================ # Temporarily hard-coded # TODO: Please fix this part. -CASE_NAME = why01-g -#CASE_NAME = ctsm1.0.dev066_MCT_I2000Clm50SpRsGs_testing -#CASE_NAME = ctsm1.0.dev066_MCT_I2000Clm50Sp_03 -#CASE_NAME = lilac_ctsm -CTSM_BLD_DIR = /glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf -CTSM_INC = -I$(CTSM_BLD_DIR)/include -CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm -#TRACEBACK_FLAGS = -g -traceback -debug all -check all -O2 -r8 -#TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O2 -debug minimal -DLINUX -DCESMCOUPLED -DFORTRANUNDERSCORE -DCPRINTEL -DNDEBUG -DUSE_ESMF_LIB -DMCT_INTERFACE -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=8 -DESMF_VERSION_MINOR=0 -DATM_PRESENT -DICE_PRESENT -DLND_PRESENT -DOCN_PRESENT -DROF_PRESENT -DGLC_PRESENT -DWAV_PRESENT -DESP_PRESENT -free -DUSE_CONTIGUOUS=contiguous -#TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DCESMCOUPLED -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DUSE_ESMF_LIB -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -DATM_PRESENT -DICE_PRESENT -DLND_PRESENT -DOCN_PRESENT -DROF_PRESENT -DGLC_PRESENT -DWAV_PRESENT -DESP_PRESENT -free -DUSE_CONTIGUOUS=contiguous -TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DCESMCOUPLED -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DUSE_ESMF_LIB -DMCT_INTERFACE -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -DATM_PRESENT -DICE_PRESENT -DLND_PRESENT -DOCN_PRESENT -DROF_PRESENT -DGLC_PRESENT -DWAV_PRESENT -DESP_PRESENT -free -DUSE_CONTIGUOUS=contiguous +CASE_NAME = why01-g +CTSM_BLD_DIR = /glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf +CTSM_INC = -I$(CTSM_BLD_DIR)/include +CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm +#TRACEBACK_FLAGS = -g -traceback -debug all -check all -O2 -r8 +TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free # ----------------------------------------------------------------------------- -#EXTRA_LIBS = $(EXTRA_LIBS) -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/nuopc/pio/pio2 -EXTRA_LIBS = -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -lcsm_share -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib -MORE_LIBS = -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/clm/obj/ -I//glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ +EXTRA_LIBS = -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -lcsm_share -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib +MORE_LIBS = -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/clm/obj/ -I//glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ # ----------------------------------------------------------------------------- +DRIVER_DIR = $(CURDIR) +LILAC_DIR = $(DRIVER_DIR)/../lilac #================================================================================ ### Compiler and linker rules using ESMF_ variables supplied by esmf.mk @@ -59,7 +56,7 @@ MORE_LIBS = -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mc .SUFFIXES: .f90 .F90 .c .C %.o : %.f90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ $(ESMF_F90COMPILEFREENOCPP) $< %.o : %.F90 @@ -68,25 +65,47 @@ MORE_LIBS = -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mc $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ $(EXTRA_LIBS) $(MORE_LIBS) $< -%.o : %.c - $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) \ - $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< +lilac_atmcap.o : $(LILAC_DIR)/lilac_atmcap.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< + +lilac_cpl.o : $(LILAC_DIR)/lilac_cpl.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< + +lilac_utils.o : $(LILAC_DIR)/lilac_utils.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< + +lilac_mod.o : $(LILAC_DIR)/lilac_mod.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< -% : %.C - $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) \ - $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< +atm_driver.o : $(DRIVER_DIR)/atm_driver.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< -demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o +atm_driver: atm_driver.o lilac_atmcap.o lilac_mod.o lilac_utils.o lilac_cpl.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(CTSM_INC) $(CTSM_LIB) $(EXTRA_LIBS) $(TRACEBACK_FLAGS) $(MORE_LIBS) - mv demo_driver demo_driver.exe + mv atm_driver atm_driver.exe rm *.o *.mod # module dependencies: -#demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o -demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o demo_utils.o demo_mod.o -lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o #shr_pio_mod.o -atmos_cap.o: lilac_utils.o -demo_mod.o: +#atm_driver.o: lilac_mod.o lilac_atmcap.o lilac_utils.o lilac_cpl.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o +atm_driver.o: lilac_mod.o lilac_atmcap.o lilac_utils.o lilac_cpl.o +lilac_mod.o: lilac_atmcap.o lilac_utils.o lilac_cpl.o #shr_pio_mod.o +lilac_atmcap.o: lilac_utils.o + # ----------------------------------------------------------------------------- .PHONY: clean berzerk remake @@ -95,5 +114,5 @@ clean: berzerk: rm -f PET*.ESMF_LogFile job_name* *.o *.mod *.exe remake: - rm lilac_mod.o demo_driver.o demo_driver.exe & make + rm lilac_mod.o atm_driver.o atm_driver.exe & make # ----------------------------------------------------------------------------- diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 2cefc3b73d..7a264b7eb9 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -1,464 +1,312 @@ -module demo_mod -!---------------------------------------------------------------------------- - use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS - use spmdMod , only : masterproc - use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type , atm2lnd_data2d_type , atm2lnd_data2d_type , this_clock - implicit none - private - public :: demo_init - public :: read_netcdf_mesh - integer :: ierr - integer :: COMP_COMM - integer :: npts ! domain global size - integer :: num_local - integer :: n_points - real, dimension(:,:), allocatable :: centerCoords -!---------------------------------------------------------------------------- +program atm_driver + + !---------------------------------------------------------------------------- + ! This is a driver for running lilac with CTSM + ! There can be no references to ESMF in the driver (the host atmosphere cannot + ! be required to know or use ESMF) + ! + ! hierarchy seen here: + ! + ! atm driver* (WRF, atm_driver, ...) + ! | + ! | + ! lilac (not an ESMF gridded component!) + ! | |________________________.____________.......... gridded components + ! | | | + ! ESMF lilac_atmcap ESMF land cap ESMF river cap + ! | | + ! CTSM Mizzouroute... + !---------------------------------------------------------------------------- + + use lilac_mod , only : lilac_init, lilac_run, lilac_final + use lilac_utils , only : lilac_atm2lnd, lilac_lnd2atm, gindex_atm + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS + + implicit none + + integer :: comp_comm + integer :: ierr + real , allocatable :: centerCoords(:,:) + real , allocatable :: lon(:), lat(:) + integer :: mytask, ntasks + integer :: my_start, my_end + integer :: i_local, i_global + integer :: nlocal, nglobal + integer :: start_time !-- start_time start time + integer :: end_time !-- end_time end time + integer :: curr_time !-- cur_time current time + integer :: itime_step !-- itime_step counter of time steps + integer :: g,i,k !-- indices + character(len=128) :: filename + !------------------------------------------------------------------------ + + start_time = 1 + end_time = 48 + + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + + write(*, *) "MPI initialization starts ..." + + call MPI_init(ierr) + if (ierr .ne. MPI_SUCCESS) then + print *,'Error starting MPI program. Terminating.' + call MPI_ABORT(MPI_COMM_WORLD, ierr) + end if + + comp_comm = MPI_COMM_WORLD + call MPI_COMM_RANK(comp_comm, mytask, ierr) + call MPI_COMM_SIZE(comp_comm, ntasks, ierr) + + if (mytask == 0 ) then + print *, "MPI initialization done ..., ntasks=", ntasks + end if + + !----------------------------------------------------------------------------- + ! Read mesh file to get number of points (n_points) + !----------------------------------------------------------------------------- + filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + call read_netcdf_mesh(filename, nglobal) + if (mytask == 0 ) then + print *, "number of global points is is:", nglobal + end if + + !----------------------------------------------------------------------------- + ! atmosphere domain decomposition + !----------------------------------------------------------------------------- + + nlocal = nglobal / ntasks + + my_start = nlocal*mytask + min(mytask, mod(nglobal, ntasks)) + 1 + ! The first mod(nglobal,ntasks) of ntasks are the ones that have an extra point + if (mytask < mod(nglobal, ntasks)) then + nlocal = nlocal + 1 + end if + my_end = my_start + nlocal - 1 + + allocate(gindex_atm(nlocal)) + + i_global = my_start + do i_local = 1, nlocal + gindex_atm(i_local) = i_global + i_global = i_global + 1 + end do + + !------------------------------------------------------------------------ + ! Initialize lilac + !------------------------------------------------------------------------ + + call lilac_init(nlocal) + + !------------------------------------------------------------------------ + ! Fill in atm2lnd type pointer data + !------------------------------------------------------------------------ + + ! first determine lats and lons + allocate(lon(nlocal)) + allocate(lat(nlocal)) + do i = 1,nlocal + i_global = gindex_atm(i) + lon(i) = centerCoords(1,i_global) + lon(i) = real(nint(lon(i))) ! rounding to nearest int + lat(i) = centerCoords(2,i_global) + lat(i) = real(nint(lat(i))) ! rounding to nearest int + end do + + ! now fill in the dataptr values + call atm_to_lilac (lon, lat) + + !------------------------------------------------------------------------ + ! Run lilac + !------------------------------------------------------------------------ + + itime_step = 1 + do curr_time = start_time, end_time + call lilac_run( ) + itime_step = itime_step + 1 + end do + + !------------------------------------------------------------------------ + ! Finalize lilac + !------------------------------------------------------------------------ + + call lilac_final( ) + + if (mytask == 0 ) then + print *, "=======================================" + print *, " ............. DONE ..................." + print *, "=======================================" + end if + + !===================== contains -!---------------------------------------------------------------------------- - subroutine demo_init(gindex_atm, atm2lnd, lnd2atm) - !! TODO: IS THE INTENT CORRECT FOR GINDEX_ATM - integer , allocatable, intent(inout) :: gindex_atm(:) - type (atm2lnd_data1d_type), intent(inout) :: atm2lnd - type (lnd2atm_data1d_type), intent(inout) :: lnd2atm - integer :: ntasks - integer :: mytask - character(len=128) :: filename - integer :: endc - !----------------------------------------------------------------------------- - ! Initiallize MPI - !----------------------------------------------------------------------------- - - npts = 3312 - - write(*, *) "MPI initialization starts ..." - - call MPI_init(ierr) - COMP_COMM = MPI_COMM_WORLD - - !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 - if (ierr .ne. MPI_SUCCESS) then - print *,'Error starting MPI program. Terminating.' - call MPI_ABORT(MPI_COMM_WORLD, ierr) - end if - - ! - - call MPI_COMM_RANK(COMP_COMM, mytask, ierr) - call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) - - if (mytask == 0 ) then - print *, "MPI initialization done ..., ntasks=", ntasks - end if - - - !----------------------------------------------------------------------------- - ! Read mesh file to get number of points (n_points) - !----------------------------------------------------------------------------- - filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - call read_netcdf_mesh(filename, n_points) - - !----------------------------------------------------------------------------- - ! atmosphere domain decomposition - !----------------------------------------------------------------------------- - - npts = n_points - print *, "npts for ", mytask, "is:", npts - call decompInit_atm( ntasks, mytask, gindex_atm) - print *, "gindex_atm for ", mytask,"is: ", gindex_atm - print *, "size gindex_atm for ", mytask,"is: ", size(gindex_atm) - - !----------------------------------------------------------------------------- - ! allocate and fill in atm2lnd - !----------------------------------------------------------------------------- - - endc = npts /ntasks - call fill_in (atm2lnd, lnd2atm, 1, endc, gindex_atm) - end subroutine demo_init - - subroutine decompInit_atm( ntasks, mytask, gindex_atm) - - ! !DESCRIPTION: - ! !USES: - - ! !ARGUMENTS: - integer , intent(in) :: ntasks - integer , intent(in) :: mytask - integer , allocatable, intent(out) :: gindex_atm(:) ! this variable is allocated here, and is assumed to start unallocated - ! !LOCAL VARIABLES: - integer :: my_start - integer :: my_end - integer :: i_local - integer :: i_global - !------------------------------------------------------------------------------ - ! create the a global index array for ocean points - - num_local = npts / ntasks - - my_start = num_local*mytask + min(mytask, mod(npts, ntasks)) + 1 - ! The first mod(npts,ntasks) of ntasks are the ones that have an extra point - if (mytask < mod(npts, ntasks)) then - num_local = num_local + 1 - end if - my_end = my_start + num_local - 1 - - allocate(gindex_atm(num_local)) - - i_global = my_start - do i_local = 1, num_local - gindex_atm(i_local) = i_global - i_global = i_global +1 - end do - - end subroutine decompInit_atm - - subroutine read_netcdf_mesh(filename, n_points) - - use netcdf - implicit none - - ! - ! Parameters - ! - - ! - ! Arguments | Global Variables - ! - character(*) , intent(in) :: filename - integer , intent(inout) :: n_points - - ! - ! Local Variables - ! - - integer :: idfile - - integer :: ierror - integer :: dimid_node - integer :: dimid_elem - integer :: dimid_maxnodepe - integer :: dimid_coordDim - - integer :: iddim_node - integer :: iddim_elem - integer :: iddim_maxnodepe - integer :: iddim_coordDim - - integer :: idvar_nodeCoords - integer :: idvar_CenterCoords - - character (len=100) :: string - - - integer :: nnode - integer :: nelem - integer :: maxnodePE - integer :: coordDim - real, dimension(:,:), allocatable :: nodeCoords - !----------------------------------------------------------------------------- - ! Open mesh file and get the idfile - ierror = nf90_open ( filename, NF90_NOWRITE, idfile) ; call nc_check_err(ierror, "opening file", filename) - - ! Get the dimid of dimensions - ierror = nf90_inq_dimid(idfile, 'nodeCount' , dimid_node ) ; call nc_check_err(ierror, "inq_dimid nodeCount", filename) - ierror = nf90_inq_dimid(idfile, 'elementCount' , dimid_elem ); call nc_check_err(ierror, "inq_dimid elementCount", filename) - ierror = nf90_inq_dimid(idfile, 'maxNodePElement' , dimid_maxnodepe ); call nc_check_err(ierror, "inq_dimid maxNodePElement", filename) - ierror = nf90_inq_dimid(idfile, 'coordDim' , dimid_coordDim ); call nc_check_err(ierror, "coordDim", filename) - - ! Inquire dimensions based on their dimeid(s) - ierror = nf90_inquire_dimension(idfile, dimid_node , string, nnode ); call nc_check_err(ierror, "inq_dim nodeCount", filename) - ierror = nf90_inquire_dimension(idfile, dimid_elem , string, nelem ); call nc_check_err(ierror, "inq_dim elementCount", filename) - ierror = nf90_inquire_dimension(idfile, dimid_maxnodepe , string, maxnodePE ); call nc_check_err(ierror, "inq_dim maxNodePElement", filename) - ierror = nf90_inquire_dimension(idfile, dimid_coordDim , string, coordDim ); call nc_check_err(ierror, "inq_dim coordDim", filename) - - print *, "=======================================" - print *, "nnode is : ", nnode - print *, "nelem is : ", nelem - print *, "coordDim is :", coordDim - print *, "=======================================" - - allocate (nodeCoords(coordDim, nnode)) - allocate (centerCoords(coordDim, nelem)) - ! Get variable IDs (varid) - ierror = nf90_inq_varid(idfile, 'nodeCoords' , idvar_nodeCoords ); call nc_check_err(ierror, "inq_varid nodeCoords", filename) - ierror = nf90_inq_varid(idfile, 'centerCoords' , idvar_centerCoords ); call nc_check_err(ierror, "inq_varid centerCoords", filename) - - ! Get variables values from varids - ierror = nf90_get_var(idfile, idvar_nodeCoords , nodeCoords , start=(/ 1,1/) , count=(/ coordDim, nnode /) ); call nc_check_err(ierror,"get_var nodeCoords", filename) - ierror = nf90_get_var(idfile, idvar_CenterCoords , centerCoords , start=(/ 1,1/) , count=(/ coordDim, nelem /) ); call nc_check_err(ierror,"get_var CenterCoords", filename) - - !print *, "lons : ",centerCoords(1,:) - - n_points = nelem - - end subroutine read_netcdf_mesh - - subroutine nc_check_err(ierror, description, filename) - !------------------------------------------------------------------------------- - ! $HeadURL: https://svn.oss.deltares.nl/repos/delft3d/trunk/src/engines_gpl/wave/packages/data/src/nc_check_err.f90 $ - !!--declarations---------------------------------------------------------------- - use netcdf - ! - implicit none - ! - ! Global variables - ! - integer , intent(in) :: ierror - character(*), intent(in) :: description - character(*), intent(in) :: filename - ! - ! Local variables - ! - ! - ! real, parameter :: PI = 3.1415927 - - !! executable statements ------------------------------------------------------- - ! - if (ierror /= nf90_noerr) then - print *, "ERROR" - write (*,'(6a)') 'ERROR ', trim(description), '. NetCDF file : "', trim(filename), '". Error message:', nf90_strerror(ierror) - endif - end subroutine nc_check_err - - subroutine fill_in (atm2lnd , lnd2atm , begc, endc , gindex_atm) - ! !ARGUMENTS: - type (atm2lnd_data1d_type), intent(inout) :: atm2lnd - type (lnd2atm_data1d_type), intent(inout) :: lnd2atm - - integer , intent(in) :: begc - integer , intent(in) :: endc - - - real :: lat - real :: lon - - integer , allocatable, intent(in) :: gindex_atm(:) - !integer :: i - integer :: i_local - integer :: i_global - - - ! tbot is going to be analytical function - - allocate ( atm2lnd%Sa_z (begc:endc) ) !; atm2lnd%Sa_z (:) = 30.0d0 - allocate ( atm2lnd%Sa_topo (begc:endc) ) !; atm2lnd%Sa_topo (:) = 10.0d0 - allocate ( atm2lnd%Sa_u (begc:endc) ) !; atm2lnd%Sa_u (:) = 20.0d0 - allocate ( atm2lnd%Sa_v (begc:endc) ) !; atm2lnd%Sa_v (:) = 40.0d0 - allocate ( atm2lnd%Sa_ptem (begc:endc) ) !; atm2lnd%Sa_ptem (:) = 280.0d0 - allocate ( atm2lnd%Sa_pbot (begc:endc) ) !; atm2lnd%Sa_pbot (:) = 100100.0d0 - allocate ( atm2lnd%Sa_tbot (begc:endc) ) !; atm2lnd%Sa_tbot (:) = 280.0 - allocate ( atm2lnd%Sa_shum (begc:endc) ) !; atm2lnd%Sa_shum (:) = 0.0004d0 - - allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) !; atm2lnd%Faxa_lwdn (:) = 200.0d0 - allocate ( atm2lnd%Faxa_rainc (begc:endc) ) !; atm2lnd%Faxa_rainc (:) = 0.0d0 - allocate ( atm2lnd%Faxa_rainl (begc:endc) ) !; atm2lnd%Faxa_rainl (:) = 3.0d-8 - allocate ( atm2lnd%Faxa_snowc (begc:endc) ) !; atm2lnd%Faxa_snowc (:) = 1.0d-8 - allocate ( atm2lnd%Faxa_snowl (begc:endc) ) !; atm2lnd%Faxa_snowl (:) = 2.0d-8 - - allocate ( atm2lnd%Faxa_swndr (begc:endc) ) !; atm2lnd%Faxa_swndr (:) = 100.0d0 - allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) !; atm2lnd%Faxa_swvdr (:) = 50.0d0 - allocate ( atm2lnd%Faxa_swndf (begc:endc) ) !; atm2lnd%Faxa_swndf (:) = 20.0d0 - allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) !; atm2lnd%Faxa_swvdf (:) = 40.0d0 - - do i_local = begc, endc - - i_global = gindex_atm(i_local) - lon = centerCoords(1,i_global) - lat = centerCoords(2,i_global) - - ! rounding to nearest int - lon = real(nint(lon)) - lat = real(nint(lat)) - ! This is i_local - print *, "i_local is:", i_local, "i_global is :", i_global, "lon:", lon, "lat:", lat - !atm2lnd%Sa_tbot(i_local) = 280.0d0 + (sin (lat)+ cos(lon))*1.0d0 - !atm2lnd%Sa_tbot(i_local) = 280.0d0 + cos(lon)*1.0d0 - - atm2lnd%Sa_z (i_local) = 30.0d0 + lat *0.01d0 + lon *0.01d0 - atm2lnd%Sa_topo (i_local) = 10.0d0 + lat *0.01d0 + lon *0.01d0 - atm2lnd%Sa_u (i_local) = 20.0d0 + lat *0.01d0 + lon *0.01d0 - atm2lnd%Sa_v (i_local) = 40.0d0 + lat *0.01d0 + lon *0.01d0 - atm2lnd%Sa_ptem (i_local) = 280.0d0 + lat *0.01d0 + lon *0.01d0 - atm2lnd%Sa_pbot (i_local) = 100100.0d0 + lat *0.01d0 + lon *0.01d0 - atm2lnd%Sa_tbot (i_local) = 280.0d0 + lat *0.01d0 + lon *0.01d0 - atm2lnd%Sa_shum (i_local) = 0.0004d0 !+(lat*0.01d0 + lon*0.01d0)*1.0e-8 - atm2lnd%Faxa_lwdn (i_local) = 200.0d0 + lat *0.01d0 + lon *0.01d0 - - !atm2lnd%Faxa_rainc (i_local) = 0.0d0 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 - atm2lnd%Faxa_rainl (i_local) = 3.0d-8 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 - atm2lnd%Faxa_snowc (i_local) = 1.0d-8 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 - atm2lnd%Faxa_snowl (i_local) = 2.0d-8 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 - atm2lnd%Faxa_swndr (i_local) = 100.0d0 + lat *0.01d0 + lon *0.01d0 - atm2lnd%Faxa_swvdr (i_local) = 50.0d0 + lat *0.01d0 + lon *0.01d0 - atm2lnd%Faxa_swndf (i_local) = 20.0d0 + lat *0.01d0 + lon *0.01d0 - atm2lnd%Faxa_swvdf (i_local) = 40.0d0 + lat *0.01d0 + lon *0.01d0 - !atm2lnd%Sa_tbot(i) = 280.0 + sin ( lat )*1.0 - !atm2lnd%Sa_tbot(i) = 280.0 + cos(lon)*1.0 - - ! radian instead of degrees: - !lon = lon* PI/180.0 - !lat = lat* PI/180.0 - end do - - !allocating these values from atmosphere for now! - !allocate ( atm2lnd%Sa_z (begc:endc) ) ; atm2lnd%Sa_z (:) = 30.0d0 - !allocate ( atm2lnd%Sa_topo (begc:endc) ) ; atm2lnd%Sa_topo (:) = 10.0d0 - !allocate ( atm2lnd%Sa_u (begc:endc) ) ; atm2lnd%Sa_u (:) = 20.0d0 - !allocate ( atm2lnd%Sa_v (begc:endc) ) ; atm2lnd%Sa_v (:) = 40.0d0 - !allocate ( atm2lnd%Sa_ptem (begc:endc) ) ; atm2lnd%Sa_ptem (:) = 280.0d0 - !allocate ( atm2lnd%Sa_pbot (begc:endc) ) ; atm2lnd%Sa_pbot (:) = 100100.0d0 - !allocate ( atm2lnd%Sa_tbot (begc:endc) ) ; atm2lnd%Sa_tbot (:) = 280.0d0 - !allocate ( atm2lnd%Sa_shum (begc:endc) ) ; atm2lnd%Sa_shum (:) = 0.0004d0 - !allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) ; atm2lnd%Faxa_lwdn (:) = 200.0d0 - !allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 4.0d-8 - allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 0.0d0 - !allocate ( atm2lnd%Faxa_rainl (begc:endc) ) ; atm2lnd%Faxa_rainl (:) = 3.0d-8 - !allocate ( atm2lnd%Faxa_snowc (begc:endc) ) ; atm2lnd%Faxa_snowc (:) = 1.0d-8 - !allocate ( atm2lnd%Faxa_snowl (begc:endc) ) ; atm2lnd%Faxa_snowl (:) = 2.0d-8 - - !allocate ( atm2lnd%Faxa_swndr (begc:endc) ) ; atm2lnd%Faxa_swndr (:) = 100.0d0 - !allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) ; atm2lnd%Faxa_swvdr (:) = 50.0d0 - !allocate ( atm2lnd%Faxa_swndf (begc:endc) ) ; atm2lnd%Faxa_swndf (:) = 20.0d0 - !allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) ; atm2lnd%Faxa_swvdf (:) = 40.0d0 - !allocate ( atm2lnd%Faxa_bcph (begc:endc) ) ; atm2lnd%Faxa_bcph (:) = 0.0d0 - - - allocate ( lnd2atm%Sl_lfrin (begc:endc) ) ; lnd2atm%Sl_lfrin (:) = 0 - allocate ( lnd2atm%Sl_t (begc:endc) ) ; lnd2atm%Sl_t (:) = 0 - allocate ( lnd2atm%Sl_tref (begc:endc) ) ; lnd2atm%Sl_tref (:) = 0 - allocate ( lnd2atm%Sl_qref (begc:endc) ) ; lnd2atm%Sl_qref (:) = 0 - allocate ( lnd2atm%Sl_avsdr (begc:endc) ) ; lnd2atm%Sl_avsdr (:) = 0 - allocate ( lnd2atm%Sl_anidr (begc:endc) ) ; lnd2atm%Sl_anidr (:) = 0 - allocate ( lnd2atm%Sl_avsdf (begc:endc) ) ; lnd2atm%Sl_avsdf (:) = 0 - allocate ( lnd2atm%Sl_anidf (begc:endc) ) ; lnd2atm%Sl_anidf (:) = 0 - allocate ( lnd2atm%Sl_snowh (begc:endc) ) ; lnd2atm%Sl_snowh (:) = 0 - allocate ( lnd2atm%Sl_u10 (begc:endc) ) ; lnd2atm%Sl_u10 (:) = 0 - allocate ( lnd2atm%Sl_fv (begc:endc) ) ; lnd2atm%Sl_fv (:) = 0 - allocate ( lnd2atm%Sl_ram1 (begc:endc) ) ; lnd2atm%Sl_ram1 (:) = 0 - end subroutine fill_in - -end module demo_mod - - - -program demo_lilac_driver - - !---------------------------------------------------------------------------- - !*** All the components are in the hierarchy seen here: - ! - ! main driver* (WRF) - ! | - ! | - ! lilac (not a gridded component!) - ! | |________________________. - ! | | - ! atmos cap land cap ____________. ......... gridded components - ! | | | - ! | | river cap - ! ocean (MOM, POM)? | | - ! | Mizzouroute... - ! CTSM - ! - ! - !---------------------------------------------------------------------------- - - ! modules - use ESMF - use lilac_mod - use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type , atm2lnd_data2d_type , atm2lnd_data2d_type , this_clock - use clm_varctl , only : iulog - use spmdMod , only : masterproc - use demo_mod , only : demo_init - use demo_mod , only : read_netcdf_mesh + !===================== + + subroutine read_netcdf_mesh(filename, nglobal) + + use netcdf implicit none - ! TO DO: change the name and the derived data types - ! data types for 1d arrays for meshes - type (atm2lnd_data1d_type) :: atm2lnd - type (lnd2atm_data1d_type) :: lnd2atm + ! input/output variables + character(*) , intent(in) :: filename + integer , intent(out) :: nglobal + + ! local Variables + integer :: idfile + integer :: ierror + integer :: dimid_elem + integer :: dimid_coordDim + integer :: iddim_elem + integer :: iddim_coordDim + integer :: idvar_CenterCoords + integer :: nelem + integer :: coordDim + character (len=100) :: string + !----------------------------------------------------------------------------- + + ! Open mesh file and get the idfile + ierror = nf90_open(filename, NF90_NOWRITE, idfile) + call nc_check_err(ierror, "opening file", filename) + + ! Get the dimid of dimensions + ierror = nf90_inq_dimid(idfile, 'elementCount', dimid_elem) + call nc_check_err(ierror, "inq_dimid elementCount", filename) + ierror = nf90_inq_dimid(idfile, 'coordDim', dimid_coordDim) + call nc_check_err(ierror, "coordDim", filename) + + ! Inquire dimensions based on their dimeid(s) + ierror = nf90_inquire_dimension(idfile, dimid_elem, string, nelem) + call nc_check_err(ierror, "inq_dim elementCount", filename) + ierror = nf90_inquire_dimension(idfile, dimid_coordDim, string, coordDim) + call nc_check_err(ierror, "inq_dim coordDim", filename) + + if (mytask == 0 ) then + print *, "=======================================" + print *, "number of elements is : ", nelem + print *, "coordDim is :", coordDim + print *, "=======================================" + end if + + ! Get coordinate values + allocate (centerCoords(coordDim, nelem)) + + ierror = nf90_inq_varid(idfile, 'centerCoords' , idvar_centerCoords) + call nc_check_err(ierror, "inq_varid centerCoords", filename) + ierror = nf90_get_var(idfile, idvar_CenterCoords, centerCoords, start=(/1,1/), count=(/coordDim, nelem/)) + call nc_check_err(ierror,"get_var CenterCoords", filename) + + nglobal = nelem + + end subroutine read_netcdf_mesh + + !======================================================================== + subroutine nc_check_err(ierror, description, filename) + use netcdf + integer , intent(in) :: ierror + character(*), intent(in) :: description + character(*), intent(in) :: filename + + if (ierror /= nf90_noerr) then + write (*,'(6a)') 'ERROR ', trim(description),'. NetCDF file : "', trim(filename),& + '". Error message:', nf90_strerror(ierror) + endif + end subroutine nc_check_err - type (this_clock) :: this_time + !======================================================================== + subroutine atm_to_lilac (lon, lat) - real , allocatable :: rand1(:) - real , allocatable :: rand2(:) + ! input/output variables + real, intent(in) :: lon(:) + real, intent(in) :: lat(:) - integer , allocatable :: seed(:) - integer :: seed_val, n + ! local variables + integer :: lsize + real*8, allocatable :: data(:) + integer :: i + integer :: i_local + ! -------------------------------------------------------- - integer :: begc,endc - integer :: start_time !-- start_time start time - integer :: end_time !-- end_time end time - integer :: curr_time !-- cur_time current time - integer :: itime_step !-- itime_step counter of time steps - integer :: g,i,k !-- indices - integer, parameter :: debug = 1 !-- internal debug level + lsize = size(lon) + allocate(data(lsize)) - character(len=128) :: fldname + data(:) = 30.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Sa_z', data) - character(*),parameter :: F01 = "(a,i4,d26.19)" - character(*),parameter :: F02 = "('[demo_driver]',a,i5,2x,d26.19)" - integer , allocatable :: gindex_atm(:) + data(:) = 10.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Sa_topo', data) - !------------------------------------------------------------------------ - ! real atmosphere: - begc = 1 - !endc = 6912/4/2 - endc = 3312/4/2/2 - !endc = 13824 - !endc = 13968 + data(:) = 20.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Sa_u', data) - start_time = 1 - end_time = 48 - itime_step = 1 + data(:) = 40.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Sa_v', data) - seed_val = 0 - n = endc - begc + 1 + data(:) = 280.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Sa_ptem', data) + data(:) = 100100.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Sa_pbot', data) - ! making 2 random arrays with a seed. - call random_seed (size = n ) - allocate ( seed (n ) ) ; seed (:) = seed_val - call random_seed (put = seed ) + data(:) = 280.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Sa_tbot', data) + + data(:) = 0.0004d0 !+(lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 + call lilac_atm2lnd('Sa_shum', data) + + data(:) = 200.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Faxa_lwdn', data) - allocate ( rand1 (begc:endc) ) ; call random_number (rand1) - allocate ( rand2 (begc:endc) ) ; call random_number (rand2) + data(:) = 0.0d0 + call lilac_atm2lnd('Faxa_rainc', data) + data(:) = 3.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 + call lilac_atm2lnd('Faxa_rainl', data) - !fldname = 'Sa_topo' - !if (debug > 0) then - ! do i=begc, endc - ! write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, atm2lnd%Sa_topo(i) - ! enddo - ! end if + data(:) = 1.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 + call lilac_atm2lnd('Faxa_snowc', data) + data(:) = 2.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 + call lilac_atm2lnd('Faxa_snowl', data) - !print *, atm2lnd%Sa_topo(1:100) + data(:) = 100.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Faxa_swndr', data) + data(:) = 50.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Faxa_swvdr', data) + data(:) = 20.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Faxa_swndf', data) - !------------------------------------------------------------------------ - ! The newly added demo_init - ! all allocate will go here: - !------------------------------------------------------------------------ + data(:) = 40.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + call lilac_atm2lnd('Faxa_swvdf', data) - call demo_init(gindex_atm, atm2lnd , lnd2atm) + end subroutine atm_to_lilac - !------------------------------------------------------------------------ - ! looping over imaginary time .... - !------------------------------------------------------------------------ + !======================================================================== + subroutine lilac_to_atm () - call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm , gindex_atm = gindex_atm ) - do curr_time = start_time, end_time - call lilac_run ( ) - itime_step = itime_step + 1 - end do - call lilac_final ( ) - call ESMF_Finalize ( ) + ! local variables + integer :: lsize + real*8, allocatable :: data(:) + ! -------------------------------------------- - print *, "=======================================" - print *, " ............. DONE ..................." - print *, "=======================================" + lsize = size(gindex_atm) + allocate(data(lsize)) + call lilac_lnd2atm('Sl_lfrin' , data) + call lilac_lnd2atm('Sl_t' , data) + call lilac_lnd2atm('Sl_tref' , data) + call lilac_lnd2atm('Sl_qref' , data) + call lilac_lnd2atm('Sl_avsdr' , data) + call lilac_lnd2atm('Sl_anidr' , data) + call lilac_lnd2atm('Sl_avsdf' , data) + call lilac_lnd2atm('Sl_anidf' , data) + call lilac_lnd2atm('Sl_snowh' , data) + call lilac_lnd2atm('Sl_u10' , data) + call lilac_lnd2atm('Sl_fv' , data) + call lilac_lnd2atm('Sl_ram1' , data) -end program demo_lilac_driver + end subroutine lilac_to_atm +end program diff --git a/lilac/atm_driver/cheyenne.sub b/lilac/atm_driver/cheyenne.sub new file mode 100644 index 0000000000..fab83413c0 --- /dev/null +++ b/lilac/atm_driver/cheyenne.sub @@ -0,0 +1,39 @@ +#!/bin/tcsh +#PBS -N job_name +#PBS -A P93300606 +#PBS -l walltime=00:10:00 +#PBS -q premium +##PBS -q share +##PBS -q regular +#PBS -j oe + +#PBS -l select=2:ncpus=4:mpiprocs=8 +##PBS -l select=1:ncpus=1:mpiprocs=2 +##PBS -l select=1:ncpus=1:mpiprocs=1 + +#ml ??? + +### Set TMPDIR as recommended +setenv TMPDIR /glade/scratch/$USER +mkdir -p $TMPDIR + +echo "hello" +### Run the executable +set MPI_SHEPHERD=true + +source /glade/u/apps/ch/opt/lmod/7.5.3/lmod/lmod/init/csh +module purge +module load ncarenv/1.2 intel/19.0.2 esmf_libs mkl mpt/2.19 netcdf-mpi/4.6.1 pnetcdf/1.11.0 ncarcompilers/0.4.1 +setenv OMP_STACKSIZE 256M +setenv MPI_TYPE_DEPTH 16 +setenv MPI_IB_CONGESTED 1 +setenv MPI_USE_ARRAY None +setenv ESMFMKFILE /glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default/esmf.mk +setenv ESMF_RUNTIME_PROFILE ON +setenv ESMF_RUNTIME_PROFILE_OUTPUT SUMMARY +setenv UGCSINPUTPATH /glade/work/turuncu/FV3GFS/benchmark-inputs/2012010100/gfs/fcst +setenv UGCSFIXEDFILEPATH /glade/work/turuncu/FV3GFS/fix_am +setenv UGCSADDONPATH /glade/work/turuncu/FV3GFS/addon +#setenv MPI_USE_ARRAY false + +mpiexec_mpt ./atm_driver.exe diff --git a/lilac/atm_driver/drv_flds_in b/lilac/atm_driver/drv_flds_in new file mode 100644 index 0000000000..bca8f84a0b --- /dev/null +++ b/lilac/atm_driver/drv_flds_in @@ -0,0 +1,7 @@ +&megan_emis_nl + megan_factors_file = '/glade/p/cesmdata/cseg/inputdata/atm/cam/chem/trop_mozart/emis/megan21_emis_factors_78pft_c20161108.nc' + megan_specifier = 'ISOP = isoprene', + 'C10H16 = pinene_a + carene_3 + thujene_a', 'CH3OH = methanol', + 'C2H5OH = ethanol', 'CH2O = formaldehyde', 'CH3CHO = acetaldehyde', + 'CH3COOH = acetic_acid', 'CH3COCH3 = acetone' +/ diff --git a/lilac/atm_driver/drv_in b/lilac/atm_driver/drv_in new file mode 100644 index 0000000000..76d084e624 --- /dev/null +++ b/lilac/atm_driver/drv_in @@ -0,0 +1,268 @@ +&cime_driver_inst + ninst_driver = 1 +/ +&cime_pes + atm_layout = "concurrent" + atm_ntasks = 36 + atm_nthreads = 1 + atm_pestride = 1 + atm_rootpe = 0 + cpl_ntasks = 36 + cpl_nthreads = 1 + cpl_pestride = 1 + cpl_rootpe = 36 + esp_layout = "concurrent" + esp_ntasks = 1 + esp_nthreads = 1 + esp_pestride = 1 + esp_rootpe = 0 + glc_layout = "concurrent" + glc_ntasks = 36 + glc_nthreads = 1 + glc_pestride = 1 + glc_rootpe = 36 + iac_layout = "concurrent" + iac_ntasks = 1 + iac_nthreads = 1 + iac_pestride = 1 + iac_rootpe = 0 + ice_layout = "concurrent" + ice_ntasks = 36 + ice_nthreads = 1 + ice_pestride = 1 + ice_rootpe = 36 + info_taskmap_comp = 0 + info_taskmap_model = 0 + lnd_layout = "concurrent" + lnd_ntasks = 36 + lnd_nthreads = 1 + lnd_pestride = 1 + lnd_rootpe = 36 + ocn_layout = "concurrent" + ocn_ntasks = 36 + ocn_nthreads = 1 + ocn_pestride = 1 + ocn_rootpe = 36 + rof_layout = "concurrent" + rof_ntasks = 36 + rof_nthreads = 1 + rof_pestride = 1 + rof_rootpe = 36 + wav_layout = "concurrent" + wav_ntasks = 36 + wav_nthreads = 1 + wav_pestride = 1 + wav_rootpe = 36 +/ +&esmf_inparm + esmf_logfile_kind = "ESMF_LOGKIND_NONE" +/ +&papi_inparm + papi_ctr1_str = "PAPI_FP_OPS" + papi_ctr2_str = "PAPI_NO_CTR" + papi_ctr3_str = "PAPI_NO_CTR" + papi_ctr4_str = "PAPI_NO_CTR" +/ +&pio_default_inparm + pio_async_interface = .false. + pio_blocksize = -1 + pio_buffer_size_limit = -1 + pio_debug_level = 0 + pio_rearr_comm_enable_hs_comp2io = .true. + pio_rearr_comm_enable_hs_io2comp = .false. + pio_rearr_comm_enable_isend_comp2io = .false. + pio_rearr_comm_enable_isend_io2comp = .true. + pio_rearr_comm_fcd = "2denable" + pio_rearr_comm_max_pend_req_comp2io = 0 + pio_rearr_comm_max_pend_req_io2comp = 64 + pio_rearr_comm_type = "p2p" +/ +&prof_inparm + profile_add_detail = .false. + profile_barrier = .false. + profile_depth_limit = 4 + profile_detail_limit = 2 + profile_disable = .false. + profile_global_stats = .true. + profile_outpe_num = 1 + profile_outpe_stride = 0 + profile_ovhd_measurement = .false. + profile_papi_enable = .false. + profile_single_file = .false. + profile_timer = 4 +/ +&seq_cplflds_inparm + flds_bgc_oi = .false. + flds_co2_dmsa = .false. + flds_co2a = .false. + flds_co2b = .false. + flds_co2c = .false. + flds_wiso = .false. + glc_nec = 10 + ice_ncat = 1 + nan_check_component_fields = .true. + seq_flds_i2o_per_cat = .false. +/ +&seq_cplflds_userspec + cplflds_custom = "" +/ +&seq_infodata_inparm + aoflux_grid = "ocn" + aqua_planet = .false. + aqua_planet_sst = 1 + atm_gnam = "4x5" + bfbflag = .false. + brnch_retain_casename = .false. + budget_ann = 1 + budget_daily = 0 + budget_inst = 0 + budget_ltann = 1 + budget_ltend = 0 + budget_month = 1 + case_desc = "UNSET" + case_name = "datm_test_mct01" + cime_model = "cesm" + coldair_outbreak_mod = .true. + cpl_decomp = 0 + cpl_seq_option = "CESM1_MOD" + do_budgets = .false. + do_histinit = .false. + drv_threading = .false. + eps_aarea = 9e-07 + eps_agrid = 1e-12 + eps_amask = 1e-13 + eps_frac = 1.0e-02 + eps_oarea = 0.1 + eps_ogrid = 0.01 + eps_omask = 1e-06 + flux_albav = .false. + flux_convergence = 0.01 + flux_diurnal = .false. + flux_epbal = "off" + flux_max_iteration = 5 + force_stop_at = "month" + glc_gnam = "null" + glc_renormalize_smb = "on_if_glc_coupled_fluxes" + histaux_a2x = .false. + histaux_a2x1hr = .false. + histaux_a2x1hri = .false. + histaux_a2x24hr = .false. + histaux_a2x3hr = .false. + histaux_a2x3hrp = .false. + histaux_double_precision = .false. + histaux_l2x = .false. + histaux_l2x1yrg = .false. + histaux_r2x = .false. + histavg_atm = .true. + histavg_glc = .true. + histavg_iac = .true. + histavg_ice = .true. + histavg_lnd = .true. + histavg_ocn = .true. + histavg_rof = .true. + histavg_wav = .true. + histavg_xao = .true. + hostname = "cheyenne" + iac_gnam = "null" + ice_gnam = "null" + info_debug = 1 + lnd_gnam = "4x5" + logfilepostfix = ".log" + max_cplstep_time = 0.0 + mct_usealltoall = .false. + mct_usevector = .false. + model_doi_url = "https://doi.org/10.5065/D67H1H0V" + model_version = "cesm-cmeps-v0.8-19-gae1c5be" + ocn_gnam = "null" + orb_eccen = 1.e36 + orb_iyear = 2000 + orb_iyear_align = 2000 + orb_mode = "fixed_year" + orb_mvelp = 1.e36 + orb_obliq = 1.e36 + outpathroot = "./" + reprosum_allow_infnan = .false. + reprosum_diffmax = -1.0e-8 + reprosum_recompute = .false. + reprosum_use_ddpdd = .false. + restart_file = "str_undefined" + rof_gnam = "null" + run_barriers = .false. + scmlat = -999. + scmlon = -999. + shr_map_dopole = .true. + single_column = .false. + start_type = "startup" + tchkpt_dir = "./timing/checkpoints" + tfreeze_option = "mushy" + timing_dir = "./timing" + username = "negins" + vect_map = "cart3d" + wall_time_limit = -1.0 + wav_gnam = "null" + wv_sat_scheme = "GoffGratch" + wv_sat_table_spacing = 1.0D0 + wv_sat_transition_start = 20.0D0 + wv_sat_use_tables = .false. +/ +&seq_timemgr_inparm + atm_cpl_dt = 1800 + atm_cpl_offset = 0 + barrier_n = 1 + barrier_option = "ndays" + barrier_ymd = -999 + calendar = "NO_LEAP" + data_assimilation_atm = .false. + data_assimilation_cpl = .false. + data_assimilation_glc = .false. + data_assimilation_iac = .false. + data_assimilation_ice = .false. + data_assimilation_lnd = .false. + data_assimilation_ocn = .false. + data_assimilation_rof = .false. + data_assimilation_wav = .false. + end_restart = .false. + esp_cpl_offset = 0 + esp_run_on_pause = .true. + glc_avg_period = "yearly" + glc_cpl_dt = 1800 + glc_cpl_offset = 0 + histavg_n = -999 + histavg_option = "never" + histavg_ymd = -999 + history_n = -999 + history_option = "never" + history_ymd = -999 + iac_cpl_offset = 0 + ice_cpl_dt = 1800 + ice_cpl_offset = 0 + lnd_cpl_dt = 1800 + lnd_cpl_offset = 0 + ocn_cpl_dt = 1800 + ocn_cpl_offset = 0 + pause_active_atm = .false. + pause_active_cpl = .false. + pause_active_glc = .false. + pause_active_iac = .false. + pause_active_ice = .false. + pause_active_lnd = .false. + pause_active_ocn = .false. + pause_active_rof = .false. + pause_active_wav = .false. + pause_n = 0 + pause_option = "never" + restart_n = 5 + restart_option = "ndays" + restart_ymd = -999 + rof_cpl_dt = 1800 + start_tod = 0 + start_ymd = 00010101 + stop_n = 5 + stop_option = "ndays" + stop_ymd = -999 + tprof_n = -999 + tprof_option = "never" + tprof_ymd = -999 + wav_cpl_dt = 1800 + wav_cpl_offset = 0 +/ diff --git a/lilac/atm_driver/lnd_in b/lilac/atm_driver/lnd_in new file mode 100644 index 0000000000..2a0b650433 --- /dev/null +++ b/lilac/atm_driver/lnd_in @@ -0,0 +1,238 @@ +&clm_inparm + albice = 0.50,0.30 + co2_ppmv = 367.0 + co2_type = 'constant' + collapse_urban = .false. + create_crop_landunit = .true. + crop_fsat_equals_zero = .false. + dtime = 1800 + fatmlndfrc = '/glade/p/cesmdata/cseg/inputdata/share/domains/domain.lnd.fv4x5_gx3v7.091218.nc' + finidat = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/initdata_map/clmi.I2000Clm50BgcCrop.2011-01-01.1.9x2.5_gx1v7_gl4_simyr2000_c180715.nc' + fsnowaging = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc' + fsnowoptics = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/snicardata/snicar_optics_5bnd_c090915.nc' + fsurdat = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/surfdata_map/surfdata_4x5_16pfts_Irrig_CMIP6_simyr2000_c170824.nc' + glc_do_dynglacier = .false. + glc_snow_persistence_max_days = 0 + h2osno_max = 10000.0 + hist_mfilt = 1 + hist_ndens = 1 + hist_nhtfrq = 1 + irrigate = .true. + maxpatch_glcmec = 10 + maxpatch_pft = 17 + n_dom_landunits = 0 + n_dom_pfts = 0 + nlevsno = 12 + nsegspc = 35 + paramfile = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/paramdata/clm5_params.c190829.nc' + run_zero_weight_urban = .false. + snow_cover_fraction_method = 'SwensonLawrence2012' + soil_layerstruct_predefined = '20SL_8.5m' + spinup_state = 0 + toosmall_crop = 0.d00 + toosmall_glacier = 0.d00 + toosmall_lake = 0.d00 + toosmall_soil = 0.d00 + toosmall_urban = 0.d00 + toosmall_wetland = 0.d00 + use_bedrock = .true. + use_century_decomp = .false. + use_cn = .false. + use_crop = .false. + use_dynroot = .false. + use_fates = .false. + use_fertilizer = .false. + use_fun = .false. + use_grainproduct = .false. + use_hydrstress = .true. + use_init_interp = .true. + use_lai_streams = .false. + use_lch4 = .false. + use_luna = .true. + use_nitrif_denitrif = .false. + use_subgrid_fluxes = .true. + use_vertsoilc = .false. +/ +&ndepdyn_nml +/ +&popd_streams +/ +&urbantv_streams + stream_fldfilename_urbantv = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/urbandata/CLM50_tbuildmax_Oleson_2016_0.9x1.25_simyr1849-2106_c160923.nc' + stream_year_first_urbantv = 2000 + stream_year_last_urbantv = 2000 + urbantvmapalgo = 'nn' +/ +&light_streams +/ +&lai_streams + lai_mapalgo = 'bilinear' + model_year_align_lai = 2001 + stream_fldfilename_lai = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/lai_streams/MODISPFTLAI_0.5x0.5_c140711.nc' + stream_year_first_lai = 2001 + stream_year_last_lai = 2013 +/ +&atm2lnd_inparm + glcmec_downscale_longwave = .true. + lapse_rate = 0.006 + lapse_rate_longwave = 0.032 + longwave_downscaling_limit = 0.5 + precip_repartition_glc_all_rain_t = 0. + precip_repartition_glc_all_snow_t = -2. + precip_repartition_nonglc_all_rain_t = 2. + precip_repartition_nonglc_all_snow_t = 0. + repartition_rain_snow = .true. +/ +&lnd2atm_inparm + melt_non_icesheet_ice_runoff = .true. +/ +&clm_canopyhydrology_inparm + interception_fraction = 1.0 + maximum_leaf_wetted_fraction = 0.05 + use_clm5_fpi = .true. +/ +&cnphenology +/ +&clm_soilhydrology_inparm +/ +&dynamic_subgrid + reset_dynbal_baselines = .false. +/ +&cnvegcarbonstate +/ +&finidat_consistency_checks +/ +&dynpft_consistency_checks +/ +&clm_initinterp_inparm + init_interp_method = 'general' +/ +¢ury_soilbgcdecompcascade +/ +&soilhydrology_inparm + baseflow_scalar = 0.001d00 +/ +&luna + jmaxb1 = 0.093563 +/ +&friction_velocity + zetamaxstable = 0.5d00 +/ +&mineral_nitrogen_dynamics +/ +&soilwater_movement_inparm + dtmin = 60. + expensive = 42 + flux_calculation = 1 + inexpensive = 1 + lower_boundary_condition = 2 + soilwater_movement_method = 1 + upper_boundary_condition = 1 + verysmall = 1.e-8 + xtolerlower = 1.e-2 + xtolerupper = 1.e-1 +/ +&rooting_profile_inparm + rooting_profile_method_carbon = 1 + rooting_profile_method_water = 1 +/ +&soil_resis_inparm + soil_resis_method = 1 +/ +&bgc_shared +/ +&canopyfluxes_inparm + itmax_canopy_fluxes = 40 + use_undercanopy_stability = .false. +/ +&aerosol + fresh_snw_rds_max = 204.526d00 +/ +&clmu_inparm + building_temp_method = 1 + urban_hac = 'ON_WASTEHEAT' + urban_traffic = .false. +/ +&clm_soilstate_inparm + organic_frac_squared = .false. +/ +&clm_nitrogen + lnc_opt = .false. +/ +&clm_snowhydrology_inparm + lotmp_snowdensity_method = 'Slater2017' + reset_snow = .false. + reset_snow_glc = .false. + reset_snow_glc_ela = 1.e9 + snow_dzmax_l_1 = 0.03d00 + snow_dzmax_l_2 = 0.07d00 + snow_dzmax_u_1 = 0.02d00 + snow_dzmax_u_2 = 0.05d00 + snow_dzmin_1 = 0.010d00 + snow_dzmin_2 = 0.015d00 + snow_overburden_compaction_method = 'Vionnet2012' + upplim_destruct_metamorph = 175.d00 + wind_dependent_snow_density = .true. +/ +&cnprecision_inparm +/ +&clm_glacier_behavior + glacier_region_behavior = 'single_at_atm_topo','virtual','virtual','multiple' + glacier_region_ice_runoff_behavior = 'melted','melted','remains_ice','remains_ice' + glacier_region_melt_behavior = 'remains_in_place','replaced_by_ice','replaced_by_ice','replaced_by_ice' +/ +&crop +/ +&irrigation_inparm + irrig_depth = 0.6 + irrig_length = 14400 + irrig_method_default = 'drip' + irrig_min_lai = 0.0 + irrig_start_time = 21600 + irrig_target_smp = -3400. + irrig_threshold_fraction = 1.0 + limit_irrigation_if_rof_enabled = .false. + use_groundwater_irrigation = .false. +/ +&surfacealbedo_inparm + snowveg_affects_radiation = .true. +/ +&water_tracers_inparm + enable_water_isotopes = .false. + enable_water_tracer_consistency_checks = .false. +/ +&clm_humanindex_inparm + calc_human_stress_indices = 'FAST' +/ +&cnmresp_inparm +/ +&photosyns_inparm + leafresp_method = 0 + light_inhibit = .true. + modifyphoto_and_lmr_forcrop = .true. + rootstem_acc = .false. + stomatalcond_method = 'Medlyn2011' +/ +&cnfire_inparm +/ +&cn_general +/ +&nitrif_inparm +/ +&lifire_inparm +/ +&ch4finundated +/ +&clm_canopy_inparm + leaf_mr_vcm = 0.015d00 +/ +&scf_swenson_lawrence_2012_inparm + int_snow_max = 2000. + n_melt_glcmec = 10.0d00 +/ +!#-------------------------------------------------------------------------------------------------------------------------- +!# lnd_in:: Comment: +!# This namelist was created using the following command-line: +!# /glade/work/negins/ctsm_negin/bld/CLM build-namelist -cimeroot /glade/work/negins/ctsm_negin/cime/scripts/Tools/../.. -infile /glade/scratch/negins/ctsm1.0.dev066_MCT_I2000Clm50SpRsGs_lilac_2/Buildconf/clmconf/namelist -csmdata /glade/p/cesmdata/cseg/inputdata -inputdata /glade/scratch/negins/ctsm1.0.dev066_MCT_I2000Clm50SpRsGs_lilac_2/Buildconf/clm.input_data_list -ignore_ic_year -namelist &clm_inparm start_ymd=20000101 / -use_case 2000_control -res 4x5 -clm_start_type default -envxml_dir /glade/scratch/negins/ctsm1.0.dev066_MCT_I2000Clm50SpRsGs_lilac_2 -l_ncpl 48 -configuration clm -structure standard -lnd_frac /glade/p/cesmdata/cseg/inputdata/share/domains/domain.lnd.fv4x5_gx3v7.091218.nc -glc_nec 10 -co2_ppmv 367.0 -co2_type constant -config /glade/scratch/negins/ctsm1.0.dev066_MCT_I2000Clm50SpRsGs_lilac_2/Buildconf/clmconf/config_cache.xml -bgc sp -clm_accelerated_spinup off -lnd_tuning_mode clm5_0_GSWP3v1 -mask gx3v7 +!# For help on options use: /glade/work/negins/ctsm_negin/bld/CLM build-namelist -help +!#-------------------------------------------------------------------------------------------------------------------------- diff --git a/lilac/atm_driver/namelist_lilac b/lilac/atm_driver/namelist_lilac new file mode 100644 index 0000000000..d766ab7ef7 --- /dev/null +++ b/lilac/atm_driver/namelist_lilac @@ -0,0 +1,10 @@ +&input + s_month = 5, + s_day = 15, + s_hour = 9, + s_min = 0, + e_month = 5, + e_day = 15, + e_hour = 9, + e_min = 30 +/ diff --git a/lilac/lilac/lilac_atmcap.F90 b/lilac/lilac/lilac_atmcap.F90 index c56c66cfe7..3fbd3bb189 100644 --- a/lilac/lilac/lilac_atmcap.F90 +++ b/lilac/lilac/lilac_atmcap.F90 @@ -1,297 +1,226 @@ -module atmos_cap +module lilac_atmcap - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! This is a dummy atmosphere cap for setting up lilac structure. + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! This is a dummy atmosphere cap for setting up lilac structure. + !----------------------------------------------------------------------- - ! !USES - use ESMF - use lilac_utils , only : fld_list_type - use spmdMod , only : masterproc - use clm_varctl , only : iulog - implicit none + ! !USES + use ESMF + use lilac_utils , only : atm2lnd, lnd2atm, gindex_atm + implicit none - include 'mpif.h' + include 'mpif.h' - character(*), parameter :: modname = "atmos_cap" - !!integer, parameter :: fldsMax = 100 - type(ESMF_Field), public , save :: field - type(fld_list_type), public , allocatable :: c2a_fldlist(:) - type(fld_list_type), public , allocatable :: a2c_fldlist(:) - integer , public , allocatable :: dummy_gindex_atm(:) + public :: atmos_register - integer :: a2c_fldlist_num - integer :: c2a_fldlist_num - public :: atmos_register - !real(kind=ESMF_KIND_R8), dimension(:), public, pointer, save :: fldptr - integer :: mpierror, numprocs - integer :: i, myid - integer status(MPI_STATUS_SIZE) ! Status of message - integer, parameter :: debug = 1 ! internal debug leve + integer :: mytask + character(*), parameter :: modname = "atmos_cap" + integer, parameter :: debug = 0 ! internal debug level +!======================================================================== +contains +!======================================================================== + subroutine atmos_register (comp, rc) - character(len=128) :: fldname - integer, parameter :: begc = 1 !-- internal debug level - integer, parameter :: endc = 3312/4/2/2 !-- internal debug level - character(*),parameter :: F02 = "('[atmos_cap]',a,i5,2x,d26.19)" + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' + !------------------------------------------------------------------------- + + call ESMF_VMGetGlobal(vm=vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - !======================================================================== - contains - !======================================================================== + if (mytask == 0) then + print *, "in user register routine" + end if + + ! Initialize return code + rc = ESMF_SUCCESS + + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine atmos_register + +!======================================================================== + + subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) + + ! input/output variables + type (ESMF_GridComp) :: comp + type (ESMF_State) :: lnd2atm_a_state, atm2lnd_a_state + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(ESMF_Mesh) :: atmos_mesh + type(ESMF_DistGrid) :: atmos_distgrid + type(ESMF_Field) :: field + type(ESMF_FieldBundle) :: c2a_fb , a2c_fb + character(len=ESMF_MAXSTR) :: atmos_mesh_filepath + integer :: n, i, myid + integer :: mpierror, numprocs + integer :: petCount, localrc, urc + character(*),parameter :: F02 = "('[atmos_cap]',a,i5,2x,d26.19)" + character(len=*), parameter :: subname=trim(modname)//': [atmos_init] ' + !------------------------------------------------------------------------- + + ! Initialize return code + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) + + call ESMF_GridCompGet (comp, petcount=petcount, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !------------------------------------------------------------------------- + ! Read in the mesh + !------------------------------------------------------------------------- + + ! TODO: use ESMF VM calls + call MPI_Comm_size(MPI_COMM_WORLD, numprocs, mpierror) + call MPI_Comm_rank(MPI_COMM_WORLD, myid, mpierror) + + atmos_mesh_filepath = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - subroutine atmos_register (comp, rc) - - type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' - - !------------------------------------------------------------------------- - - print *, "in user register routine" - - ! Initialize return code - rc = ESMF_SUCCESS + atmos_distgrid = ESMF_DistGridCreate (arbSeqIndexList=gindex_atm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + elementDistGrid=atmos_distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + !print *, "!Mesh for atmosphere is created!" + end if - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !------------------------------------------------------------------------- + ! Atmosphere to Coupler (land) Fields -- atmos --> land + ! - Create empty field bundle -- a2c_fb + ! - Create Fields and add them to field bundle + ! - Add a2c_fb to state (atm2lnd_a_state) + !------------------------------------------------------------------------- + + ! Create individual fields and add to field bundle -- a2c + a2c_fb = ESMF_FieldBundleCreate(name="a2c_fb", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - end subroutine atmos_register - - - - subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) - - type (ESMF_GridComp) :: comp - type (ESMF_State) :: lnd2atm_a_state, atm2lnd_a_state - type (ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - type (ESMF_FieldBundle) :: c2a_fb , a2c_fb - integer :: n - type(ESMF_Mesh) :: atmos_mesh - type(ESMF_Mesh) :: atmos_mesh_tmp - character(len=ESMF_MAXSTR) :: atmos_mesh_filepath - integer :: petCount, localrc, urc - integer :: mid, by2, quart, by4 - type(ESMF_Grid) :: atmos_grid - type(ESMF_DistGrid) :: atmos_distgrid - logical :: mesh_switch - character(len=*), parameter :: subname=trim(modname)//': [atmos_init] ' - !integer :: regDecomp(:,:) - - !------------------------------------------------------------------------- - ! Initialize return code - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) - - call ESMF_GridCompGet (comp, petcount=petcount, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !------------------------------------------------------------------------- - ! Read in the mesh ----or----- Generate the grid - !------------------------------------------------------------------------- - mesh_switch = .True. - call MPI_Comm_size(MPI_COMM_WORLD, numprocs, mpierror) - call MPI_Comm_rank(MPI_COMM_WORLD, myid, mpierror) - - - - if(mesh_switch) then - ! TODO: hard-coded mesh file name shoulb be corrected. - ! For now this is our dummy mesh: - !atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' !! Negin: This did not work.... - !atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv1.9x2.5_141008_ESMFmesh.nc' - atmos_mesh_filepath = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - - - atmos_mesh_tmp = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) - !print *, "!Mesh for atmosphere is created!" - - atmos_distgrid = ESMF_DistGridCreate (arbSeqIndexList=dummy_gindex_atm, rc=rc) - - ! recreate the mesh using the above distgrid - atmos_mesh = ESMF_MeshCreate(atmos_mesh_tmp, elementDistgrid=atmos_distgrid, rc=rc) - - else - !TODO: Fix how you want to create the grid here if mesh_switch is off - !atmos_grid= ESMF_GridCreateNoPeriDimUfrmR( maxIndex=(/180,360 /), & - ! minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & - ! maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & - ! regDecomp=(/petcount,1/), rc=rc) - - atmos_grid = ESMF_GridCreateNoPeriDimUfrm( minIndex= (/1,1/), maxIndex=(/180,360 /), & - maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & - minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & - coordSys=ESMF_COORDSYS_CART,& - regDecomp=(/1,petcount/),& - rc=rc) - call ESMF_LogWrite(subname//"Grid for atmosphere is created!", ESMF_LOGMSG_INFO) - !print *, "Grid for atmosphere is created!" - endif - - !------------------------------------------------------------------------- - ! Atmosphere to Coupler (land) Fields -- atmos --> land - ! I- Create empty field bundle -- a2c_fb - ! II- Create Fields and add them to field bundle - ! III - Add a2c_fb to state (atm2lnd_a_state) - !------------------------------------------------------------------------- - - a2c_fb = ESMF_FieldBundleCreate(name="a2c_fb", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Create individual fields and add to field bundle -- a2c - - a2c_fldlist_num = 17 - - do n = 1,a2c_fldlist_num - - ! create field - !!! Here we want to pass pointers - !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2c_fldlist(n)%stdname), rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) - !call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8), rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if (myid == 0 .and. debug > 0) then - print *, "***************************************************" - print *, "Here we are printing field!" - print *, "creating field for a2c:" - print *, trim(a2c_fldlist(n)%stdname) - print *, a2c_fldlist(n)%farrayptr1d - !call ESMF_FieldPrint(field, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end if - - !call ESMF_LogWrite(subname//"fieldget!", ESMF_LOGMSG_INFO) - !call ESMF_FieldGet(field, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! add field to field bundle - call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - enddo - - if (myid == 0 .and. debug > 0) then - do n = 1,a2c_fldlist_num - do i=begc, endc - fldname = a2c_fldlist(n)%stdname - write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, a2c_fldlist(n)%farrayptr1d(i) - enddo - enddo - end if - - call ESMF_LogWrite(subname//"fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) - print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" - - ! Add field bundle to state - call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atm2lnd_a_state is filled with dummy_var field bundle!", ESMF_LOGMSG_INFO) - print *, "!atm2lnd_a_state is filld with dummy_var field bundle!" - - !------------------------------------------------------------------------- - ! Coupler (land) to Atmosphere Fields -- c2a - ! I- Create Field Bundle -- c2a_fb for because we are in atmos - ! II- Create Fields and add them to field bundle - ! III - Add c2a_fb to state (lnd2atm_a_state) - !------------------------------------------------------------------------- - - c2a_fb = ESMF_FieldBundleCreate (name="c2a_fb", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Create individual fields and add to field bundle -- c2a - c2a_fldlist_num = 12 - - do n = 1,c2a_fldlist_num - - ! create field - if (mesh_switch) then - field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) - !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - else - field = ESMF_FieldCreate(atmos_grid, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end if - - ! add field to field bundle - call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - if (myid == 0 .and. debug > 0) then - print *, "creating field for c2a:" - print *, n - print *, trim(c2a_fldlist(n)%stdname) - print *, c2a_fldlist(n)%farrayptr1d - call ESMF_FieldPrint(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end if - enddo - - call ESMF_LogWrite(subname//"c2a fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) + ! create fields and add to field bundle + do n = 1, size(atm2lnd) + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(atm2lnd(n)%fldname), farrayPtr=atm2lnd(n)%dataptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end do - ! Add field bundle to state - call ESMF_StateAdd(lnd2atm_a_state, (/c2a_fb/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" + end if - ! Set Attributes needed by land - call ESMF_AttributeSet(lnd2atm_a_state, name="nextsw_cday", value=11, rc=rc) - - end subroutine atmos_init - - subroutine atmos_run(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//': [atmos_run] ' - - ! Initialize return code - rc = ESMF_SUCCESS + ! Add field bundle to state + call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite(subname//"Should atmos_run ", ESMF_LOGMSG_INFO) - end subroutine atmos_run + call ESMF_LogWrite(subname//"atm2lnd_a_state is filled with dummy_var field bundle!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "!atm2lnd_a_state is filld with dummy_var field bundle!" + end if - subroutine atmos_final(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc + !------------------------------------------------------------------------- + ! Coupler (land) to Atmosphere Fields -- c2a + ! - Create Field Bundle -- c2a_fb for because we are in atmos + ! - Create Fields and add them to field bundle + ! - Add c2a_fb to state (lnd2atm_a_state) + !------------------------------------------------------------------------- - character(len=*), parameter :: subname=trim(modname)//': [atmos_final] ' - type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + c2a_fb = ESMF_FieldBundleCreate (name="c2a_fb", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! Initialize return code - rc = ESMF_SUCCESS + ! create fields and add to field bundle + do n = 1, size(lnd2atm) + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(lnd2atm(n)%fldname), farrayPtr=lnd2atm(n)%dataptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (debug > 0) then + call ESMF_FieldPrint(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + end do + call ESMF_LogWrite(subname//"c2a fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) + + ! Add field bundle to state + call ESMF_StateAdd(lnd2atm_a_state, (/c2a_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_StateGet(importState, "c2a_fb", import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! Set Attributes needed by land + call ESMF_AttributeSet(lnd2atm_a_state, name="nextsw_cday", value=11, rc=rc) ! TODO: mv what in the world is this??? - call ESMF_StateGet(exportState, "a2c_fb", export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail ou + end subroutine atmos_init +!======================================================================== - call ESMF_FieldBundleDestroy(import_fieldbundle, rc=rc) - call ESMF_FieldBundleDestroy(export_fieldbundle, rc=rc) + subroutine atmos_run(comp, importState, exportState, clock, rc) - call ESMF_LogWrite(subname//"?? Are there any other thing for destroying in atmos_final??", ESMF_LOGMSG_INFO) + ! input/output variables + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc - end subroutine atmos_final + ! local variables + character(len=*), parameter :: subname=trim(modname)//': [atmos_run] ' -end module atmos_cap + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"Should atmos_run ", ESMF_LOGMSG_INFO) + + end subroutine atmos_run + +!======================================================================== + + subroutine atmos_final(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//': [atmos_final] ' + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_StateGet(importState, "c2a_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateGet(exportState, "a2c_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_FieldBundleDestroy(import_fieldbundle, rc=rc) + call ESMF_FieldBundleDestroy(export_fieldbundle, rc=rc) + + call ESMF_LogWrite(subname//"?? Are there any other thing for destroying in atmos_final??", ESMF_LOGMSG_INFO) + + end subroutine atmos_final + +end module lilac_atmcap diff --git a/lilac/lilac/lilac_cpl.F90 b/lilac/lilac/lilac_cpl.F90 index 0fbe51677c..b88b4e361a 100644 --- a/lilac/lilac/lilac_cpl.F90 +++ b/lilac/lilac/lilac_cpl.F90 @@ -1,362 +1,363 @@ -module cpl_mod +module lilac_cpl - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! Module containing all routines for both couplers - ! 1- coupler 1 : atm ---> lnd (cpl_atm2lnd) - ! 2- coupler 2 : lnd ---> atm (cpl_lnd2atm) - !----------------------------------------------------------------------- - ! !USES - use ESMF - use clm_varctl , only : iulog - implicit none + !----------------------------------------------------------------------- + ! Module containing all routines for both couplers + ! 1- coupler 1 : atm ---> lnd (cpl_atm2lnd) + ! 2- coupler 2 : lnd ---> atm (cpl_lnd2atm) + !----------------------------------------------------------------------- - include 'mpif.h' + use ESMF + implicit none - private + include 'mpif.h' !TODO: remove this and use ESMF + private - public :: cpl_atm2lnd_register - public :: cpl_lnd2atm_register + public :: cpl_atm2lnd_register + public :: cpl_lnd2atm_register - character(*), parameter :: modname = " cpl_mod" - type(ESMF_RouteHandle), save :: rh_atm2lnd, rh_lnd2atm + type(ESMF_RouteHandle) :: rh_atm2lnd + type(ESMF_RouteHandle) :: rh_lnd2atm + integer :: mytask + character(*), parameter :: modname = "lilac_cpl" - integer :: mpierror, numprocs - integer :: i, myid - integer status(MPI_STATUS_SIZE) +!====================================================================== +contains +!====================================================================== - character(len=128) :: fldname - integer, parameter :: begc = 1 !-- internal debug level - integer, parameter :: endc = 3312/4/2/2 !-- internal debug level - character(*),parameter :: F01 = "('[cpl_mod] ',a,i5,2x,i5,2x,d21.14)" - character(*),parameter :: F02 = "('[cpl_mod]',a,i5,2x,d26.19)" - integer, parameter :: debug = 1 !-- internaldebug level - !====================================================================== - contains - !====================================================================== + subroutine cpl_atm2lnd_register(cplcomp, rc) - subroutine cpl_atm2lnd_register(cplcomp, rc) - type(ESMF_CplComp ) :: cplcomp - integer, intent(out ) :: rc - character(len=* ) , parameter :: subname=trim(modname ) //' : [cpl_atm2lnd_register] ' - - rc = ESMF_SUCCESS - print *, "in cpl_atm2lnd_register routine" - - ! Register the callback routines. - ! Set the entry points for coupler ESMF Component methods - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine= cpl_atm2lnd_init, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_atm2lnd_run , rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_atm2lnd_final, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - end subroutine cpl_atm2lnd_register - - subroutine cpl_lnd2atm_register(cplcomp, rc) - type(ESMF_CplComp ) :: cplcomp - integer, intent(out ) :: rc - character(len=* ) , parameter :: subname=trim(modname ) //' : [cpl_lnd2atm_register] ' - - - rc = ESMF_SUCCESS - print *, "in cpl_lnd2atm_register routine" - - ! Register the callback routines. - ! Set the entry points for coupler ESMF Component methods - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_lnd2atm_init, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_lnd2atm_run , rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_lnd2atm_final, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - end subroutine cpl_lnd2atm_register - - !-------------------------------------------------------------------------- - ! couplers init.... - !-------------------------------------------------------------------------- - - subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) - - type (ESMF_CplComp ) :: cplcomp - type (ESMF_State ) :: importState - type (ESMF_State ) :: exportState - type (ESMF_Clock ) :: clock - type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - integer, intent(out ) :: rc - character(len=* ) , parameter :: subname=trim(modname) //': [cpl_atm2lnd_init] ' - - rc = ESMF_SUCCESS - print *, "Coupler for atmosphere to land initialize routine called" - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - - call MPI_Comm_size(MPI_COMM_WORLD, numprocs, mpierror) - call MPI_Comm_rank(MPI_COMM_WORLD, myid, mpierror) - - - - call ESMF_StateGet(importState, trim("a2c_fb"), import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_StateGet(exportState, trim("c2l_fb"), export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - - if (myid == 0) then - print *, "PRINTING FIELDBUNDLES" - call ESMF_FieldBundlePrint (import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldBundlePrint (export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end if - - - call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) - !call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) - end subroutine cpl_atm2lnd_init - - subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) - - type (ESMF_CplComp ) :: cplcomp - type (ESMF_State ) :: importState - type (ESMF_State ) :: exportState - type (ESMF_Clock ) :: clock - type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle - integer, intent(out ) :: rc - character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_lnd2atm_init] ' + ! input/output variables + type(ESMF_CplComp ) :: cplcomp + integer, intent(out ) :: rc - rc = ESMF_SUCCESS - print *, "Coupler for land to atmosphere initialize routine called" - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + ! local variables + type(ESMF_VM) :: vm + character(len=*) , parameter :: subname=trim(modname ) //' : [cpl_atm2lnd_register] ' + !--------------------------------------------------- - call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + rc = ESMF_SUCCESS - call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_VMGetGlobal(vm=vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - !call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) - end subroutine cpl_lnd2atm_init + print *,'mytask= ',mytask + if (mytask == 0) then + print *, "in cpl_atm2lnd_register routine" + end if - !-------------------------------------------------------------------------- - ! Couplers Run phase - !-------------------------------------------------------------------------- + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine= cpl_atm2lnd_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_atm2lnd_run , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - type(ESMF_CplComp ) :: cplcomp - type(ESMF_State ) :: importState - type(ESMF_State ) :: exportState - type(ESMF_Clock ) :: clock - integer, intent(out ) :: rc - type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle - character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_run] ' + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_atm2lnd_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end subroutine cpl_atm2lnd_register - real, pointer :: fldptr1d(:) +!====================================================================== - rc = ESMF_SUCCESS - print *, "Running cpl_atm2lnd_run" - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + subroutine cpl_lnd2atm_register(cplcomp, rc) - call ESMF_StateGet(importState, trim("a2c_fb"), import_fieldbundle, rc=rc) - !call ESMF_StateGet(importState, itemName=trim("a2c_fb"), item=import_fieldbundle, rc=rc) ! this syntax was not working??? - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//" got a2c fieldbundle!", ESMF_LOGMSG_INFO) + type(ESMF_CplComp) :: cplcomp + integer, intent(out ) :: rc - call ESMF_StateGet(exportState, trim("c2l_fb"), export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//" got c2l fieldbundle!", ESMF_LOGMSG_INFO) + ! local variables + character(len=* ) , parameter :: subname=trim(modname ) //' : [cpl_lnd2atm_register] ' + !--------------------------------------------------- - !fldname = 'Sa_topo' - !call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "in cpl_lnd2atm_register routine" + end if - !call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) - call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//" regridding fieldbundles from atmos to land!", ESMF_LOGMSG_INFO) + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_lnd2atm_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - end subroutine cpl_atm2lnd_run + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_lnd2atm_run , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_lnd2atm_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end subroutine cpl_lnd2atm_register - subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) +!====================================================================== - type(ESMF_CplComp ) :: cplcomp - type(ESMF_State ) :: importState - type(ESMF_State ) :: exportState - type(ESMF_Clock ) :: clock - integer, intent(out ) :: rc - type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle - character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_lnd2atm_run] ' + subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) - rc = ESMF_SUCCESS - print *, "Running cpl_lnd2atm_run" - call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + ! input/output variables + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + integer, intent(out ) :: rc - call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle + type (ESMF_FieldBundle) :: export_fieldbundle + integer :: n + integer :: fieldcount + character(len=128), allocatable :: fieldlist(:) + character(len=128) :: cvalue + character(len=*), parameter :: subname=trim(modname) //': [cpl_atm2lnd_init] ' + !--------------------------------------------------- - call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Coupler for atmosphere to land initialize routine called" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "a2c_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_FieldBundleGet(import_fieldbundle, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + write(cvalue,*) fieldcount + call ESMF_LogWrite(subname//" a2c_fb field count = "//trim(cvalue), ESMF_LOGMSG_INFO) + allocate(fieldlist(fieldcount)) + call ESMF_FieldBundleGet(import_fieldbundle, fieldNameList=fieldlist, rc=rc) + do n = 1,fieldCount + write(cvalue,*) n + call ESMF_LogWrite(subname//" a2c_fb field "//trim(cvalue)//' = '//trim(fieldlist(n)), ESMF_LOGMSG_INFO) + end do + deallocate(fieldlist) + if (mytask == 0) then + print *, ' a2c_fb field count = ',fieldcount + end if + + call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_FieldBundleGet(export_fieldbundle, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + write(cvalue,*) fieldcount + call ESMF_LogWrite(subname//" c2l_fb field count = "//trim(cvalue), ESMF_LOGMSG_INFO) + allocate(fieldlist(fieldcount)) + call ESMF_FieldBundleGet(export_fieldbundle, fieldNameList=fieldlist, rc=rc) + do n = 1,fieldCount + write(cvalue,*) n + call ESMF_LogWrite(subname//" c2l_fb field "//trim(cvalue)//' = '//trim(fieldlist(n)), ESMF_LOGMSG_INFO) + end do + deallocate(fieldlist) + if (mytask == 0) then + print *, ' c2l_fb field count = ',fieldcount + end if + + if (mytask == 0) then + print *, "PRINTING FIELDBUNDLES from atm->lnd" + call ESMF_FieldBundlePrint (import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldBundlePrint (export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + + call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) + + end subroutine cpl_atm2lnd_init + +!====================================================================== + + subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + integer, intent(out ) :: rc - call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - !call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//" regridding fieldbundles from land to atmos!", ESMF_LOGMSG_INFO) + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle + type (ESMF_FieldBundle) :: export_fieldbundle + integer :: n + integer :: fieldcount + character(len=128), allocatable :: fieldlist(:) + character(len=128) :: cvalue + character(len=*) , parameter :: subname=trim(modname ) //': [cpl_lnd2atm_init] ' + !--------------------------------------------------- - end subroutine cpl_lnd2atm_run + rc = ESMF_SUCCESS - !-------------------------------------------------------------------------- - ! couplers final phase - !-------------------------------------------------------------------------- + if (mytask == 0) then + print *, "Coupler for land to atmosphere initialize routine called" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_FieldBundleGet(import_fieldbundle, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + write(cvalue,*) fieldcount + call ESMF_LogWrite(subname//" l2c_fb field count = "//trim(cvalue), ESMF_LOGMSG_INFO) + allocate(fieldlist(fieldcount)) + call ESMF_FieldBundleGet(import_fieldbundle, fieldNameList=fieldlist, rc=rc) + do n = 1,fieldCount + write(cvalue,*) n + call ESMF_LogWrite(subname//" l2c_fb field "//trim(cvalue)//' = '//trim(fieldlist(n)), ESMF_LOGMSG_INFO) + end do + deallocate(fieldlist) + if (mytask == 0) then + print *, ' l2c_fb field count = ',fieldcount + end if + + call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_FieldBundleGet(export_fieldbundle, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + write(cvalue,*) fieldcount + call ESMF_LogWrite(subname//" c2a_fb field count = "//trim(cvalue), ESMF_LOGMSG_INFO) + allocate(fieldlist(fieldcount)) + call ESMF_FieldBundleGet(export_fieldbundle, fieldNameList=fieldlist, rc=rc) + do n = 1,fieldCount + write(cvalue,*) n + call ESMF_LogWrite(subname//" c2a_fb field "//trim(cvalue)//' = '//trim(fieldlist(n)), ESMF_LOGMSG_INFO) + end do + deallocate(fieldlist) + if (mytask == 0) then + print *, ' c2a_fb field count = ',fieldcount + end if + + call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2atm_init + +!====================================================================== + + subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) + + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc - subroutine cpl_atm2lnd_final(cplcomp, importState, exportState, clock, rc) + ! local variables + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_run] ' + !--------------------------------------------------- - type (ESMF_CplComp ) :: cplcomp - type (ESMF_State ) :: importState - type (ESMF_State ) :: exportState - type (ESMF_Clock ) :: clock - type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle - integer, intent(out ) :: rc - character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_final] ' + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Running cpl_atm2lnd_run" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - rc = ESMF_SUCCESS + call ESMF_StateGet(importState, trim("a2c_fb"), import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//" got a2c fieldbundle!", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + call ESMF_StateGet(exportState, trim("c2l_fb"), export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//" got c2l fieldbundle!", ESMF_LOGMSG_INFO) - ! Only thing to do here is release redist (or regrid) and route handles - call ESMF_FieldBundleRegridRelease (routehandle=rh_atm2lnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//" regridding fieldbundles from atmos to land!", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//" rh_atm2lnd route handle released!", ESMF_LOGMSG_INFO) + end subroutine cpl_atm2lnd_run - end subroutine cpl_atm2lnd_final +!====================================================================== - subroutine cpl_lnd2atm_final(cplcomp, importState, exportState, clock, rc) + subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) - type (ESMF_CplComp ) :: cplcomp - type (ESMF_State ) :: importState - type (ESMF_State ) :: exportState - type (ESMF_Clock ) :: clock - type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle - integer, intent(out ) :: rc - character(len=* ) , parameter :: subname=trim(modname) //': [cpl_lnd2atm_final] ' + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc - rc = ESMF_SUCCESS + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + character(len=*) , parameter :: subname=trim(modname ) //': [cpl_lnd2atm_run] ' + !--------------------------------------------------- - call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) - ! Only thing to do here is release redist (or regrid) and route handles - call ESMF_FieldBundleRegridRelease (routehandle=rh_lnd2atm , rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Running cpl_lnd2atm_run" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//" rh_lnd2atm route handle released!", ESMF_LOGMSG_INFO) + call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end subroutine cpl_lnd2atm_final + call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - !=============================================================================== + call ESMF_LogWrite(subname//" regridding fieldbundles from land to atmos!", ESMF_LOGMSG_INFO) - subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) + end subroutine cpl_lnd2atm_run - ! ---------------------------------------------- - ! Get pointer to a state field - ! ---------------------------------------------- +!====================================================================== - use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_FieldBundle - use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet - use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE - use ESMF , only : ESMF_FieldBundleGet + subroutine cpl_atm2lnd_final(cplcomp, importState, exportState, clock, rc) ! input/output variables - type(ESMF_State), intent(in) :: State - character(len=*), intent(in) :: fldname - real , pointer, optional , intent(out) :: fldptr1d(:) - real , pointer, optional , intent(out) :: fldptr2d(:,:) - integer, intent(out) :: rc + type (ESMF_CplComp) :: cplcomp + type (ESMF_State) :: importState + type (ESMF_State) :: exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc ! local variables - type(ESMF_FieldStatus_Flag) :: status - type(ESMF_Field) :: lfield - type(ESMF_Mesh) :: lmesh - integer :: nnodes, nelements - character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' - - type(ESMF_StateItem_Flag) :: itemFlag - type(ESMF_FieldBundle) :: fieldBundle - logical :: isPresent - ! ---------------------------------------------- + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=*) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_final] ' + !--------------------------------------------------- rc = ESMF_SUCCESS - ! Determine if this field bundle exist.... - ! TODO: combine the error checks.... - + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) - call ESMF_StateGet(state, "c2l_fb", itemFlag, rc=rc) - !call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_atm2lnd, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! Get the fieldbundle from state... - call ESMF_StateGet(state, "c2l_fb", fieldBundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//" rh_atm2lnd route handle released!", ESMF_LOGMSG_INFO) + end subroutine cpl_atm2lnd_final - call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, isPresent=isPresent, rc=rc) - !call ESMF_FieldBundleGet(fieldBundle,trim(fldname), lfield, isPresent, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out +!====================================================================== - call ESMF_FieldGet(lfield, status=status, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + subroutine cpl_lnd2atm_final(cplcomp, importState, exportState, clock, rc) - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - if (nnodes == 0 .and. nelements == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - - if (present(fldptr1d)) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if ( debug > 0) then - write(iulog,F01)' in '//trim(subname)//'fldptr1d for '//trim(fldname)//' is ' - end if - !print *, "FLDPTR1D is" - !print *, FLDPTR1d - else if (present(fldptr2d)) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - else - !call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") - end if - endif ! status + type (ESMF_CplComp) :: cplcomp + type (ESMF_State) :: importState + type (ESMF_State) :: exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + ! local variables + character(len=*) , parameter :: subname=trim(modname) //': [cpl_lnd2atm_final] ' + !--------------------------------------------------- - end subroutine state_getfldptr + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_lnd2atm , rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//" rh_lnd2atm route handle released!", ESMF_LOGMSG_INFO) -end module cpl_mod + end subroutine cpl_lnd2atm_final +end module lilac_cpl diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 1e53604cb6..25a72c6287 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -1,614 +1,476 @@ module lilac_mod + !----------------------------------------------------------------------- + ! !DESCRIPTION: + !----------------------------------------------------------------------- + + use ESMF + implicit none + + public :: lilac_init + public :: lilac_run + + ! Clock, TimeInterval, and Times + type(ESMF_Clock) :: clock + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_Time) :: stopTime + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar),target :: calendar + integer :: yy,mm,dd,sec + + ! Gridded Components and Coupling Components + type(ESMF_GridComp) :: atm_gcomp + type(ESMF_GridComp) :: lnd_gcomp + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp + type(ESMF_State) :: atm2lnd_l_state, atm2lnd_a_state + type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state + character(*) , parameter :: modname = "lilac_mod" + + integer :: mytask + +!======================================================================== +contains +!======================================================================== + + subroutine lilac_init(lsize) + + ! -------------------------------------------------------------------------------- + ! This is called by the host atmosphere + ! -------------------------------------------------------------------------------- + + use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd + use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register + use lilac_atmcap , only : atmos_register + use lnd_comp_esmf , only : lnd_register !ctsm routine + use shr_pio_mod , only : shr_pio_init1 + + ! input/output variables + integer, intent(in) :: lsize + + ! local variables + type(ESMF_State) :: importState, exportState + type(ESMF_VM) :: vm + integer :: rc + character(len=ESMF_MAXSTR) :: cname !components or cpl names + integer :: COMP_COMM + integer :: ierr + integer :: mpic ! mpi communicator + integer :: n, i + integer :: fileunit + integer, parameter :: debug = 1 !-- internal debug level + character(len=*), parameter :: subname=trim(modname)//': [lilac_init] ' + + ! Namelist and related variables + integer :: s_month, s_day, s_hour, s_min + integer :: e_month, e_day, e_hour, e_min + namelist /input/ s_month, s_day, s_hour, s_min, e_month, e_day, e_hour, e_min + !------------------------------------------------------------------------ - !----------------------------------------------------------------------- - ! !DESCRIPTION: - - ! !USES - use ESMF - use lilac_utils , only : fld_list_type, fldsMax, create_fldlists - use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type - use lilac_utils , only : atm2lnd_data2d_type , lnd2atm_data2d_type - use atmos_cap , only : atmos_register - !use lnd_shr_methods - use lnd_comp_esmf , only : lnd_register - use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register - - use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS - use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 - - use clm_varctl , only : iulog - use spmdMod , only : masterproc - implicit none - - !TODO (NS,2019-08-07): - ! We will move this later to lnd_cap (ctsm_cap) and atmos_cap - !use atmos_cap , only : a2l_fldnum - integer , public , parameter :: a2l_fldnum = 17 - integer , public , parameter :: l2a_fldnum = 12 - - public :: lilac_init - public :: lilac_run - - character(*) , parameter :: modname = "lilac_mod" - !type(fld_list_type), public :: a2c_fldlist, c2a_fldlist !defined in atmosphere and land caps.... - + ! Initialize return code + rc = ESMF_SUCCESS + + !------------------------------------------------------------------------- + ! Initialize ESMF, set the default calendar and log type. + !------------------------------------------------------------------------- + + ! TODO: cannot assume that the calendar is always gregorian unless CTSM assumes this as well + ! Need to coordinate the calendar info between lilac and the host component + call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, logappendflag=.false., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_LogSet(flush=.true.) + + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Initializing ESMF ", ESMF_LOGMSG_INFO) + + ! Initialize pio (needed by CTSM) - TODO: this should be done within CTSM not here + + call ESMF_VMGetGlobal(vm=vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_VMGet(vm, localPet=mytask, mpiCommunicator=mpic, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call shr_pio_init1(ncomps=1, nlfilename="drv_in", Global_Comm=mpic) ! TODO: make the filename lilac_in + + ! Initialize atm2lnd and lnd2atm data types + call lilac_init_atm2lnd(lsize) + call lilac_init_lnd2atm(lsize) + + !------------------------------------------------------------------------- + ! Read in configuration data -- namelist.input from host atmosphere(wrf) + !------------------------------------------------------------------------- + + ! Read in namelist file ... + + if (mytask == 0) then + print *, "---------------------------------------" + end if + + ! TODO: put checks for error below + ! TODO: only the master lilac proc should read the namelist file and do a broadcast to the + ! other processors + open(newunit=fileunit, status="old", file="namelist_lilac", action="read", iostat=rc) + read(fileunit, input) + close(fileunit) + + !------------------------------------------------------------------------- + ! Create Gridded Component! -- atmosphere ( atmos_cap) + !------------------------------------------------------------------------- + cname = " Atmosphere or Atmosphere Cap" + atm_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Atmosphere Gridded Component Created!" + end if + + !------------------------------------------------------------------------- + ! Create Gridded Component! --- CTSM land ( land_capX ) + !------------------------------------------------------------------------- + cname = " Land ctsm " + lnd_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, " Land (ctsm) Gridded Component Created!" + end if + + !------------------------------------------------------------------------- + ! Create Coupling Component! --- Coupler from atmos to land + !------------------------------------------------------------------------- + cname = "Coupler from atmosphere to land" + cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "1st Coupler Component (atmosphere to land ) Created!" + end if + + !------------------------------------------------------------------------- + ! Create Coupling Component! -- Coupler from land to atmos + !------------------------------------------------------------------------- + cname = "Coupler from land to atmosphere" + cpl_lnd2atm_comp = ESMF_CplCompCreate(name=cname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "2nd Coupler Component (land to atmosphere) Created!" + end if + + !------------------------------------------------------------------------- + ! Register section -- set services -- atmos_cap + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(atm_gcomp, userRoutine=atmos_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//" atmos SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, " Atmosphere Gridded Component SetServices finished!" + end if + + !------------------------------------------------------------------------- + ! Register section -- set services -- land cap + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(lnd_gcomp, userRoutine=lnd_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Land Gridded Component SetServices finished!" + end if + + !------------------------------------------------------------------------- + ! Register section -- set services -- coupler atmosphere to land + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Coupler from atmosphere to land SetServices finished!" + end if + + !------------------------------------------------------------------------- + ! Register section -- set services -- coupler land to atmosphere + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_lnd2atm_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Coupler from land to atmosphere SetServices finished!" + end if + !------------------------------------------------------------------------- + ! Create and initialize a clock! + ! Clock is initialized here from namelist.input from WRF..... still we + ! are looping over time from host atmosphere + !------------------------------------------------------------------------- + calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + call ESMF_TimeIntervalSet(TimeStep, s=2, rc=rc) ! time step every 2second + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + !call ESMF_TimeSet(startTime, yy=2003, mm=s_month, dd=s_day, h=s_hour, m=s_min, s=0, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + !call ESMF_TimeSet(stopTime, yy=2003, mm=e_month, dd=e_day, h=e_hour, m=e_min, s=0, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1 , s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=03, dd=01, s=0, calendar=Calendar, rc=rc) + !call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=1800, rc=rc) + clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, & + RefTime=StartTime, stopTime=stopTime, rc=rc) + + if (mytask == 0) then + print *, "---------------------------------------" + end if + !call ESMF_ClockPrint (clock, rc=rc) + if (mytask == 0) then + print *, "=======================================" + end if + !call ESMF_CalendarPrint ( calendar , rc=rc) + if (mytask == 0) then + print *, "---------------------------------------" + end if + + ! ------------------------------------------------------------------------- + ! Initialze lilac_atm gridded component + ! First Create the empty import and export states used to pass data + ! between components. (these are module variables) + ! ------------------------------------------------------------------------- + + atm2lnd_a_state = ESMF_StateCreate(name='atm_state_on_atm_mesh', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + lnd2atm_a_state = ESMF_StateCreate(name='lnd_state_on_lnd_mesh', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompInitialize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp initialized", ESMF_LOGMSG_INFO) + + call ESMF_LogWrite(subname//"lilac_atm gridded component initialized", ESMF_LOGMSG_INFO) + + ! ------------------------------------------------------------------------- + ! Initialze CTSM Gridded Component + ! First Create the empty import and export states used to pass data + ! between components. (these are module variables) + ! ------------------------------------------------------------------------- + + atm2lnd_l_state = ESMF_StateCreate(name='atm_state_on_lnd_mesh', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + lnd2atm_l_state = ESMF_StateCreate(name='lnd_state_on_atm_mesh', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompInitialize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp initialized", ESMF_LOGMSG_INFO) + + call ESMF_LogWrite(subname//"CTSM gridded component initialized", ESMF_LOGMSG_INFO) + + ! ------------------------------------------------------------------------- + ! Initialze LILAC coupler components + ! ------------------------------------------------------------------------- + + call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "coupler :: cpl_atm2lnd_comp initialize finished" !, rc =", rc + end if + + call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "coupler :: cpl_lnd2atm_comp initialize finished" !, rc =", rc + end if + + end subroutine lilac_init + + !======================================================================== + + subroutine lilac_run( ) + + ! local variables + type(ESMF_State) :: importState, exportState + integer :: rc, userRC + type (ESMF_Clock) :: local_clock + character(len=*), parameter :: subname=trim(modname)//': [lilac_run] ' !------------------------------------------------------------------------ - ! !Clock, TimeInterval, and Times - type(ESMF_Clock) :: clock - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime - type(ESMF_Time) :: stopTime - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar),target :: calendar - integer :: yy,mm,dd,sec - ! ! Gridded Components and Coupling Components - type(ESMF_GridComp) :: atmos_gcomp - type(ESMF_GridComp) :: land_gcomp - type(ESMF_CplComp) :: cpl_atm2lnd_comp - type(ESMF_CplComp) :: cpl_lnd2atm_comp - type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state - type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state - - !======================================================================== - contains - !======================================================================== - - subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d, gindex_atm) - - use atmos_cap , only : a2c_fldlist , c2a_fldlist - use atmos_cap , only : dummy_gindex_atm - use lnd_cap , only : l2c_fldlist , c2l_fldlist - - character(len=*), parameter :: subname=trim(modname)//': [lilac_init] ' - - ! input/output variables - type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d - type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d - type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d - type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d - - integer , allocatable :: gindex_atm(:) - ! local variables - - type(ESMF_State) :: importState, exportState - - !character(len=*) :: atm_mesh_filepath !!! For now this is hardcoded in the atmos init - - integer :: rc , userRC - character(len=ESMF_MAXSTR) :: gcname1 , gcname2 ! Gridded components names - character(len=ESMF_MAXSTR) :: ccname1 , ccname2 ! Coupling components names - - - ! Namelist and related variables - integer :: fileunit - integer :: i_max, j_max - real(ESMF_KIND_R8) :: x_min, x_max, y_min, y_max - integer :: s_month, s_day, s_hour, s_min - integer :: e_month, e_day, e_hour, e_min - namelist /input/ i_max, j_max, x_min, x_max, y_min, y_max, & - s_month, s_day, s_hour, s_min, & - e_month, e_day, e_hour, e_min - - - integer :: COMP_COMM - integer :: ierr - integer :: ntasks,mytask ! mpicom size and rank - integer :: ncomps = 1 ! land only - integer :: n - integer :: i - integer, parameter :: debug = 1 !-- internal debug level - !!! above: https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/pio-xlis-bld/xlis_main.F90 - - - character(len=128) :: fldname - integer, parameter :: begc = 1 !-- internal debug level - integer, parameter :: endc = 3312/4/2/2 !-- internal debug level - character(*),parameter :: F02 = "('[lilac_mod]',a,i5,2x,d26.19)" - !------------------------------------------------------------------------ - ! Initialize return code - rc = ESMF_SUCCESS - - if (masterproc) then - print *, "---------------------------------------" - print *, " Lilac Demo Application Start " - print *, "---------------------------------------" - end if - - !----------------------------------------------------------------------------- - ! Initiallize MPI - !----------------------------------------------------------------------------- - - ! this is coming from - ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 - COMP_COMM = MPI_COMM_WORLD - - !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 - !if (ierr .ne. MPI_SUCCESS) then - ! print *,'Error starting MPI program. Terminating.' - ! call MPI_ABORT(MPI_COMM_WORLD, ierr) - !end if - - ! - - call MPI_COMM_RANK(COMP_COMM, mytask, ierr) - call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) - - if (masterproc) then - print *, "MPI initialization done ..., ntasks=", ntasks - end if - - !----------------------------------------------------------------------------- - ! Initialize PIO - !----------------------------------------------------------------------------- - - ! this is coming from - ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 - ! with call shr_pio_init1(8, "drv_in", COMP_COMM) - - ! For planned future use of async io using pio2. The IO tasks are seperated from the compute tasks here - ! and COMP_COMM will be MPI_COMM_NULL on the IO tasks which then call shr_pio_init2 and do not return until - ! the model completes. All other tasks call ESMF_Initialize. 8 is the maximum number of component models - ! supported - - call shr_pio_init1(ncomps, "drv_in", COMP_COMM) - ! NS Question: How many should ncomps (above 1) be?????? - - if (COMP_COMM .eq. MPI_COMM_NULL) then - !call shr_pio_init2( - call mpi_finalize(ierror=rc) - stop - endif - - !------------------------------------------------------------------------- - ! Initialize ESMF, set the default calendar and log type. - !------------------------------------------------------------------------- - call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN,logappendflag=.false., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogSet(flush=.true.) - call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//"Initializing ESMF ", ESMF_LOGMSG_INFO) - - !------------------------------------------------------------------------- - ! Read in configuration data -- namelist.input from host atmosphere(wrf) - !------------------------------------------------------------------------- - ! Read in namelist file ... - call ESMF_UtilIOUnitGet(unit=fileunit, rc=rc) ! get an available Fortran unit number - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - if (masterproc) then - print *, "---------------------------------------" - end if - - open(fileunit, status="old", file="namelist_lilac", action="read", iostat=rc) - - if (rc .ne. 0) then - call ESMF_LogSetError(rcToCheck=ESMF_RC_FILE_OPEN, msg="Failed to open namelist file 'namelist'", line=__LINE__, file=__FILE__) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - read(fileunit, input) - continue - close(fileunit) - - !------------------------------------------------------------------------- - ! Create Field lists -- Basically create a list of fields and add a default - ! value to them. - !------------------------------------------------------------------------- - - !------------------------------------------------------------------------- - ! !---- from atm ----! a2c_fldlist & c2l_fldlist - !------------------------------------------------------------------------- - !allocate (a2c_fldlist(a2l_fldnum)) - !allocate (c2l_fldlist(a2l_fldnum)) - - !------------------------------------------------------------------------- - ! !---- from land ----! l2c_fldlist & c2a_fldlist - !------------------------------------------------------------------------- - !allocate (c2a_fldlist(l2a_fldnum)) - !allocate (l2c_fldlist(l2a_fldnum)) - - allocate (a2c_fldlist(fldsMax)) - allocate (c2a_fldlist(fldsMax)) - - allocate (l2c_fldlist(fldsmax)) - allocate (c2l_fldlist(fldsmax)) - - if (masterproc) then - print *, "creating empty field lists !" - end if - - call ESMF_LogWrite(subname//"fielldlists are allocated!", ESMF_LOGMSG_INFO) - - ! create field lists - call create_fldlists(a2c_fldlist, c2a_fldlist,l2c_fldlist, c2l_fldlist) - call ESMF_LogWrite(subname//"fielldlists are created!", ESMF_LOGMSG_INFO) - - !------------------------------------------------------------------------- - ! !---- from atm ----! a2c_fldlist filling the arrayptr.. - !------------------------------------------------------------------------- - - - ! FIXME: This should go to the demo_driver or real atmosphere...... - !allocate( a2c_fldlist(fldsmax)%farrayptr1d(1728)) - !do n = 1,a2l_fldnum - ! print *, " index is ", n - ! a2c_fldlist(1)%farrayptr1d(:) = 300.0 - !end do - - a2c_fldlist(1)%farrayptr1d => atm2lnd1d%Sa_z - a2c_fldlist(2)%farrayptr1d => atm2lnd1d%Sa_topo - - !if (masterproc .and. debug > 0) then - fldname = 'Sa_topo' - do i=begc, endc - write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, a2c_fldlist(2)%farrayptr1d(i) - end do - !end if - a2c_fldlist(3)%farrayptr1d => atm2lnd1d%Sa_u - a2c_fldlist(4)%farrayptr1d => atm2lnd1d%Sa_v - a2c_fldlist(5)%farrayptr1d => atm2lnd1d%Sa_ptem - a2c_fldlist(6)%farrayptr1d => atm2lnd1d%Sa_pbot - a2c_fldlist(7)%farrayptr1d => atm2lnd1d%Sa_tbot - a2c_fldlist(8)%farrayptr1d => atm2lnd1d%Sa_shum - - a2c_fldlist(9)%farrayptr1d => atm2lnd1d%Faxa_lwdn - a2c_fldlist(10)%farrayptr1d => atm2lnd1d%Faxa_rainc - a2c_fldlist(11)%farrayptr1d => atm2lnd1d%Faxa_rainl - a2c_fldlist(12)%farrayptr1d => atm2lnd1d%Faxa_snowc - a2c_fldlist(13)%farrayptr1d => atm2lnd1d%Faxa_snowl - - a2c_fldlist(14)%farrayptr1d => atm2lnd1d%Faxa_swndr - a2c_fldlist(15)%farrayptr1d => atm2lnd1d%Faxa_swvdr - a2c_fldlist(16)%farrayptr1d => atm2lnd1d%Faxa_swndf - a2c_fldlist(17)%farrayptr1d => atm2lnd1d%Faxa_swvdf - !------------------------------------------------------------------------- - - ! should I point to zero??? - - c2a_fldlist(1)%farrayptr1d => lnd2atm1d%Sl_lfrin - c2a_fldlist(2)%farrayptr1d => lnd2atm1d%Sl_t - c2a_fldlist(3)%farrayptr1d => lnd2atm1d%Sl_tref - c2a_fldlist(4)%farrayptr1d => lnd2atm1d%Sl_qref - c2a_fldlist(5)%farrayptr1d => lnd2atm1d%Sl_avsdr - c2a_fldlist(6)%farrayptr1d => lnd2atm1d%Sl_anidr - c2a_fldlist(7)%farrayptr1d => lnd2atm1d%Sl_avsdf - c2a_fldlist(8)%farrayptr1d => lnd2atm1d%Sl_anidf - - c2a_fldlist(9)%farrayptr1d => lnd2atm1d%Sl_snowh - c2a_fldlist(10)%farrayptr1d => lnd2atm1d%Sl_u10 - c2a_fldlist(11)%farrayptr1d => lnd2atm1d%Sl_fv - c2a_fldlist(12)%farrayptr1d => lnd2atm1d%Sl_ram1 - - - - dummy_gindex_atm = gindex_atm - ! ======================================================================== - - !------------------------------------------------------------------------- - ! Create Gridded Component! -- atmosphere ( atmos_cap) - !------------------------------------------------------------------------- - gcname1 = " Atmosphere or Atmosphere Cap" - atmos_gcomp = ESMF_GridCompCreate(name=gcname1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(gcname1)//" component", ESMF_LOGMSG_INFO) - print *, "Atmosphere Gridded Component Created!" - - !------------------------------------------------------------------------- - ! Create Gridded Component! --- CTSM land ( land_capX ) - !------------------------------------------------------------------------- - gcname2 = " Land ctsm " - land_gcomp = ESMF_GridCompCreate(name=gcname2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(gcname2)//" component", ESMF_LOGMSG_INFO) - print *, " Land (ctsm) Gridded Component Created!" - - !------------------------------------------------------------------------- - ! Create Coupling Component! --- Coupler from atmos to land - !------------------------------------------------------------------------- - ccname1 = "Coupler from atmosphere to land" - cpl_atm2lnd_comp = ESMF_CplCompCreate(name=ccname1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(ccname1)//" component", ESMF_LOGMSG_INFO) - print *, "1st Coupler Component (atmosphere to land ) Created!" - - !------------------------------------------------------------------------- - ! Create Coupling Component! -- Coupler from land to atmos - !------------------------------------------------------------------------- - ccname2 = "Coupler from land to atmosphere" - cpl_lnd2atm_comp = ESMF_CplCompCreate(name=ccname2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(ccname2)//" component", ESMF_LOGMSG_INFO) - print *, "2nd Coupler Component (land to atmosphere) Created!" - - ! ======================================================================== - - !------------------------------------------------------------------------- - ! Register section -- set services -- atmos_cap - !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(atmos_gcomp, userRoutine=atmos_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//" atmos SetServices finished!", ESMF_LOGMSG_INFO) - print *, " Atmosphere Gridded Component SetServices finished!" - !------------------------------------------------------------------------- - ! Register section -- set services -- land cap - !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(land_gcomp, userRoutine=lnd_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Land Gridded Component SetServices finished!" - !------------------------------------------------------------------------- - ! Register section -- set services -- coupler atmosphere to land - !------------------------------------------------------------------------- - call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Coupler from atmosphere to land SetServices finished!" - !------------------------------------------------------------------------- - ! Register section -- set services -- coupler land to atmosphere - !------------------------------------------------------------------------- - call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_lnd2atm_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) - print *, "Coupler from land to atmosphere SetServices finished!" - - ! ======================================================================== - - !------------------------------------------------------------------------- - ! Create and initialize a clock! - ! Clock is initialized here from namelist.input from WRF..... still we - ! are looping over time from host atmosphere - !------------------------------------------------------------------------- - calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeIntervalSet(TimeStep, s=2, rc=rc) ! time step every 2second - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - !call ESMF_TimeSet(startTime, yy=2003, mm=s_month, dd=s_day, h=s_hour, m=s_min, s=0, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !call ESMF_TimeSet(stopTime, yy=2003, mm=e_month, dd=e_day, h=e_hour, m=e_min, s=0, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1 , s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=03, dd=01, s=0, calendar=Calendar, rc=rc) - !call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=1800, rc=rc) - clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) - - print *, "---------------------------------------" - !call ESMF_ClockPrint (clock, rc=rc) - print *, "=======================================" - !call ESMF_CalendarPrint ( calendar , rc=rc) - print *, "---------------------------------------" - - ! ======================================================================== - - !------------------------------------------------------------------------- - ! Create the necessary import and export states used to pass data - ! between components. - !------------------------------------------------------------------------- - - ! following 4 states are lilac module variables: - ! 1- atm2lnd_a_state 2- atm2lnd_l_state 3- lnd2atm_a_state 4-lnd2atm_l_state - - atm2lnd_a_state = ESMF_StateCreate(name=gcname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - atm2lnd_l_state = ESMF_StateCreate(name=gcname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - lnd2atm_a_state = ESMF_StateCreate(name=gcname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - lnd2atm_l_state = ESMF_StateCreate(name=gcname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_LogWrite(subname//"Empty import and export states are created!!", ESMF_LOGMSG_INFO) - print *, "Empty import and export states are created!!" - - ! returns a valid state_to_lnd_atm and an empty state_from_land_atmgrid - - ! ------------------------------------------------------------------------- - ! Grid Componenet Initialization -- 1- atmos cap 2- lnd cap ! - ! 3- cpl_atm2lnd 4- cpl_lnd2atm ! - ! ------------------------------------------------------------------------- - - call ESMF_GridCompInitialize(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp initialized", ESMF_LOGMSG_INFO) - - call ESMF_GridCompInitialize(land_gcomp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"lnd_cap or land_gcomp initialized", ESMF_LOGMSG_INFO) - - ! All 4 states that are module variables are no longer empty - have been initialized - - call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) - print *, "coupler :: cpl_atm2lnd_comp initialize finished" !, rc =", rc - - call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) - print *, "coupler :: cpl_lnd2atm_comp initialize finished" !, rc =", rc - - end subroutine lilac_init - - !======================================================================== - - subroutine lilac_run( ) - - use atmos_cap, only : a2c_fldlist, c2a_fldlist - use lnd_cap, only : l2c_fldlist, c2l_fldlist - - character(len=*), parameter :: subname=trim(modname)//': [lilac_run] ' - type(ESMF_State) :: importState, exportState - - ! local variables - integer :: rc, userRC - character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names - character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names - !integer, parameter :: fldsMax = 100 - - ! input/output variables - !type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d - !type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d - !type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d - !type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d - - type (ESMF_Clock) :: local_clock - - !------------------------------------------------------------------------ - ! Initialize return code - rc = ESMF_SUCCESS - - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" - print *, " Lilac Run " - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" - - !------------------------------------------------------------------------- - ! Create a local clock from the general clock! - !------------------------------------------------------------------------- - - local_clock = ESMF_ClockCreate(clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - print *, "Run Loop Start time" - !call ESMF_ClockPrint(local_clock, options="currtime string", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - !------------------------------------------------------------------------- - ! We are running components in this order: - ! 1- atmos_cap 2- cpl_atm2lnd - ! 3- lnd_cap 4- cpl_lnd2atm - !------------------------------------------------------------------------- - ! lilac run the RunComponent phase in a time loop - - !!! if we want to loop through clock in atmos cap. - !do while (.NOT. ESMF_ClockIsStopTime(local_clock, rc=rc)) - call ESMF_GridCompRun(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=local_clock, rc=rc, userRC=userRC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp is running", ESMF_LOGMSG_INFO) - print *, "Running atmos_cap gridded component , rc =", rc - - call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=local_clock, rc=rc , userRC=userRC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) - print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc - - call ESMF_GridCompRun(land_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=local_clock, rc=rc, userRC=userRC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"lnd_cap or land_gcomp is running", ESMF_LOGMSG_INFO) - print *, "Running lnd_cap gridded component , rc =", rc - - call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=local_clock, rc=rc, userRC=userRC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) - print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc - - ! Advance the time - call ESMF_ClockAdvance(local_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"time is icremented now... (ClockAdvance)", ESMF_LOGMSG_INFO) - print *, "time is icremented now... (ClockAdvance) , rc =", rc - - !end do - - end subroutine lilac_run - - - subroutine lilac_final( ) - - use atmos_cap, only : a2c_fldlist, c2a_fldlist - use lnd_cap, only : l2c_fldlist, c2l_fldlist - - - character(len=*), parameter :: subname=trim(modname)//': [lilac_final] ' - type(ESMF_State) :: importState, exportState - - ! local variables - integer :: rc, userRC - character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names - character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names - !integer, parameter :: fldsMax = 100 - - !------------------------------------------------------------------------ - !------------------------------------------------------------------------ - ! Initialize return code - rc = ESMF_SUCCESS - - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" - print *, " Lilac Finalizing " - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" - !------------------------------------------------------------------------- - ! Gridded Component Finalizing! --- atmosphere - !------------------------------------------------------------------------- - call ESMF_GridCompFinalize(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp is running", ESMF_LOGMSG_INFO) - print *, "Finalizing atmos_cap gridded component , rc =", rc - - !------------------------------------------------------------------------- - ! Coupler component Finalizing --- coupler atmos to land - !------------------------------------------------------------------------- - call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) - print *, "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc - - !------------------------------------------------------------------------- - ! Gridded Component Finalizing! --- land - !------------------------------------------------------------------------- - call ESMF_GridCompFinalize(land_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"lnd_cap or land_gcomp is running", ESMF_LOGMSG_INFO) - print *, "Finalizing lnd_cap gridded component , rc =", rc - - !------------------------------------------------------------------------- - ! Coupler component Finalizing --- coupler land to atmos - !------------------------------------------------------------------------- - call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) - print *, "Finalizing coupler component..... cpl_lnd2atm_comp , rc =", rc - - - ! Then clean them up - call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//"destroying all states ", ESMF_LOGMSG_INFO) - - print *, "ready to destroy all states" - call ESMF_StateDestroy(atm2lnd_a_state , rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateDestroy(atm2lnd_l_state, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateDestroy(lnd2atm_a_state, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateDestroy(lnd2atm_l_state, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_LogWrite(subname//"destroying all components ", ESMF_LOGMSG_INFO) - print *, "ready to destroy all components" - - call ESMF_GridCompDestroy(atmos_gcomp, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_GridCompDestroy(land_gcomp, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_CplCompDestroy(cpl_atm2lnd_comp, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_CplCompDestroy(cpl_lnd2atm_comp, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - - call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) - print *, "end of Lilac Finalization routine" - - end subroutine lilac_final - - - end module lilac_mod + ! Initialize return code + rc = ESMF_SUCCESS + + if (mytask == 0) then + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + print *, " Lilac Run " + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + end if + + !------------------------------------------------------------------------- + ! Create a local clock from the general clock! + !------------------------------------------------------------------------- + + local_clock = ESMF_ClockCreate(clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (mytask == 0) then + print *, "Run Loop Start time" + end if + !call ESMF_ClockPrint(local_clock, options="currtime string", rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + !------------------------------------------------------------------------- + ! We are running components in this order: + ! 1- atmos_cap 2- cpl_atm2lnd! 3- lnd_cap 4- cpl_lnd2atm + !------------------------------------------------------------------------- + + ! if we want to loop through clock in atmos cap. + !do while (.NOT. ESMF_ClockIsStopTime(local_clock, rc=rc)) + call ESMF_GridCompRun(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, & + clock=local_clock, rc=rc, userRC=userRC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp is running", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Running atmos_cap gridded component , rc =", rc + end if + + call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, & + clock=local_clock, rc=rc , userRC=userRC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc + end if + + call ESMF_GridCompRun(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, & + clock=local_clock, rc=rc, userRC=userRC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp is running", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Running lnd_cap gridded component , rc =", rc + end if + + call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, & + clock=local_clock, rc=rc, userRC=userRC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc + end if + + ! Advance the time + call ESMF_ClockAdvance(local_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"time is icremented now... (ClockAdvance)", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "time is icremented now... (ClockAdvance) , rc =", rc + end if + + end subroutine lilac_run + +!======================================================================== + + subroutine lilac_final( ) + + ! local variables + type(ESMF_State) :: importState, exportState + integer :: rc, userRC + character(len=*), parameter :: subname=trim(modname)//': [lilac_final] ' + !------------------------------------------------------------------------ + ! Initialize return code + rc = ESMF_SUCCESS + + if (mytask == 0) then + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + print *, " Lilac Finalizing " + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + end if + + !------------------------------------------------------------------------- + ! Gridded Component Finalizing! --- atmosphere + !------------------------------------------------------------------------- + call ESMF_GridCompFinalize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp is running", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Finalizing atmos_cap gridded component , rc =", rc + end if + + !------------------------------------------------------------------------- + ! Coupler component Finalizing --- coupler atmos to land + !------------------------------------------------------------------------- + call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc + end if + + !------------------------------------------------------------------------- + ! Gridded Component Finalizing! --- land + !------------------------------------------------------------------------- + call ESMF_GridCompFinalize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp is running", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Finalizing lnd_cap gridded component , rc =", rc + end if + + !------------------------------------------------------------------------- + ! Coupler component Finalizing --- coupler land to atmos + !------------------------------------------------------------------------- + call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "Finalizing coupler component..... cpl_lnd2atm_comp , rc =", rc + end if + + ! Then clean them up + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"destroying all states ", ESMF_LOGMSG_INFO) + + if (mytask == 0) then + print *, "ready to destroy all states" + end if + call ESMF_StateDestroy(atm2lnd_a_state , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(atm2lnd_l_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(lnd2atm_a_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(lnd2atm_l_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_LogWrite(subname//"destroying all components ", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "ready to destroy all components" + end if + + call ESMF_GridCompDestroy(atm_gcomp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_GridCompDestroy(lnd_gcomp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompDestroy(cpl_atm2lnd_comp, rc=rc) + + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompDestroy(cpl_lnd2atm_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, "end of Lilac Finalization routine" + end if + + ! Finalize ESMF + call ESMF_Finalize ( ) + + end subroutine lilac_final + +end module lilac_mod diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 index ef1074a909..7bce4b8f99 100644 --- a/lilac/lilac/lilac_utils.F90 +++ b/lilac/lilac/lilac_utils.F90 @@ -1,443 +1,324 @@ module lilac_utils - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! - !!! NS: THIS IS FROM JH WORK - - use ESMF - - implicit none - - public fldlist_add , create_fldlists - - integer, parameter :: fldsMax = 100 - - character(*) , parameter :: modname = "lilac_utils" - ! !PUBLIC TYPES: - type :: fld_list_type - character(len=128) :: stdname - real*8 :: default_value - character(len=128) :: units - real(ESMF_KIND_R8), pointer :: farrayptr1d(:) ! this will be filled in by lilac when it gets its data from the host atm - real(ESMF_KIND_R8), pointer :: farrayptr2d(:,:) ! this will be filled in by lilac when it gets its data from the host atm - integer :: ungridded_lbound = 0 - integer :: ungridded_ubound = 0 - end type fld_list_type - - !!! 1d for when we have mesh and 2d for when we have grids.... - type , public :: atm2lnd_data1d_type - real*8, pointer :: Sa_z (:) - real*8, pointer :: Sa_topo (:) - real*8, pointer :: Sa_u (:) - real*8, pointer :: Sa_v (:) - real*8, pointer :: Sa_ptem (:) - real*8, pointer :: Sa_pbot (:) - real*8, pointer :: Sa_tbot (:) - real*8, pointer :: Sa_shum (:) - real*8, pointer :: Sa_methane (:) - ! from atm - fluxes - real*8, pointer :: Faxa_lwdn (:) - real*8, pointer :: Faxa_rainc (:) - real*8, pointer :: Faxa_rainl (:) - real*8, pointer :: Faxa_snowc (:) - real*8, pointer :: Faxa_snowl (:) - real*8, pointer :: Faxa_swndr (:) - real*8, pointer :: Faxa_swvdr (:) - real*8, pointer :: Faxa_swndf (:) - real*8, pointer :: Faxa_swvdf (:) - - real*8, pointer :: Faxa_bcph (:) - end type atm2lnd_data1d_type - -! - - type , public :: atm2lnd_data2d_type - real*8, pointer :: Sa_z (:,:) - real*8, pointer :: Sa_topo (:,:) - real*8, pointer :: Sa_u (:,:) - real*8, pointer :: Sa_v (:,:) - real*8, pointer :: Sa_ptem (:,:) - real*8, pointer :: Sa_pbot (:,:) - real*8, pointer :: Sa_tbot (:,:) - real*8, pointer :: Sa_shum (:,:) - !real*8, pointer :: Sa_methane (:,:) - ! from atm - fluxes - real*8, pointer :: Faxa_lwdn (:,:) - real*8, pointer :: Faxa_rainc (:,:) - real*8, pointer :: Faxa_rainl (:,:) - real*8, pointer :: Faxa_snowc (:,:) - real*8, pointer :: Faxa_snowl (:,:) - real*8, pointer :: Faxa_swndr (:,:) - real*8, pointer :: Faxa_swvdr (:,:) - real*8, pointer :: Faxa_swndf (:,:) - real*8, pointer :: Faxa_swvdf (:,:) - end type atm2lnd_data2d_type - - - - - !type :: atm2lnd_data1d_type - ! real*8, pointer :: uwind (:) - ! real*8, pointer :: vwind (:) - ! real*8, pointer :: tbot (:) - !end type atm2lnd_data1d_type - - type :: lnd2atm_data1d_type - real*8, pointer :: Sl_lfrin (:) - real*8, pointer :: Sl_t (:) - real*8, pointer :: Sl_tref (:) - real*8, pointer :: Sl_qref (:) - real*8, pointer :: Sl_avsdr (:) - real*8, pointer :: Sl_anidr (:) - real*8, pointer :: Sl_avsdf (:) - real*8, pointer :: Sl_anidf (:) - real*8, pointer :: Sl_snowh (:) - real*8, pointer :: Sl_u10 (:) - real*8, pointer :: Sl_fv (:) - real*8, pointer :: Sl_ram1 (:) - end type lnd2atm_data1d_type - - !type :: atm2lnd_data2d_type - ! real*8, pointer :: uwind (:,:) - ! real*8, pointer :: vwind (:,:) - ! real*8, pointer :: tbot (:,:) - !end type atm2lnd_data2d_type - - type :: lnd2atm_data2d_type - real*8, pointer :: lwup (:,:) - real*8, pointer :: taux (:,:) - real*8, pointer :: tauy (:,:) - end type lnd2atm_data2d_type - - type :: this_clock - integer, pointer :: yy - integer, pointer :: mm - integer, pointer :: dd - integer, pointer :: hh - integer, pointer :: mn - integer, pointer :: ss - end type this_clock - !=============================================================================== - contains - !=============================================================================== - - subroutine fldlist_add(num, fldlist, stdname, default_value, units, ungridded_lbound, ungridded_ubound) - ! This adds a field to a fieldlist! - ! input/output variables - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname - real, optional, intent(in) :: default_value - character(len=*), optional, intent(in) :: units - integer, optional, intent(in) :: ungridded_lbound - integer, optional, intent(in) :: ungridded_ubound - - ! local variables - integer :: rc - character(len=*), parameter :: subname=trim(modname)//':[fldlist_add]' - !------------------------------------------------------------------------------- - call ESMF_LogWrite(subname//"inside fldlist_add!", ESMF_LOGMSG_INFO) - - ! Set up a list of field information - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(subname//"?!", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - return - endif - - fldlist(num)%stdname = trim(stdname) - - if (present(ungridded_lbound) .and. present(ungridded_ubound)) then - fldlist(num)%ungridded_lbound = ungridded_lbound - fldlist(num)%ungridded_ubound = ungridded_ubound - end if - - if(present(default_value)) then - fldlist(num)%default_value = default_value - else - fldlist(num)%default_value = 0. - end if - if(present(units)) then - fldlist(num)%units = trim(units) - else - fldlist(num)%units = "" - end if - - !allocate (fldlist%farrayptr1d(fldsMax)) - - !fldlist%farrayptr1d = default_value - - end subroutine fldlist_add - - !subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist, rof_prognostic, glc_present ) - subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist) - - ! add all the necessary fields one by one to the fieldlist - type(fld_list_type), intent(inout) :: a2c_fldlist(fldsMax) - type(fld_list_type), intent(inout) :: c2a_fldlist(fldsMax) - type(fld_list_type), intent(inout) :: l2c_fldlist(fldsMax) - type(fld_list_type), intent(inout) :: c2l_fldlist(fldsMax) - - ! I use this as an index! - integer :: fldsToLnd_num != 0 ! From atmosphere to land (c2l) - integer :: fldsFrLnd_num != 0 ! From land to atmosphere (l2c) - integer :: fldsToAtm_num != 0 ! From land to atmosphere (c2a) - integer :: fldsFrAtm_num != 0 ! From atmosphere to land (a2c) - integer, parameter :: fldsMax = 100 - - - ! TODO (NS) : Should we move these to the land cap???? - logical :: glc_present ! .true. => running with a non-stub GLC model - logical :: rof_prognostic ! .true. => running with a prognostic ROF model - - character(len=*), parameter :: subname=trim(modname)//':[create_fldlists]' - ! TODO (NS) : I should add default value and units here..... - - fldsToLnd_num= 0 - fldsFrLnd_num= 0 - fldsToAtm_num= 0 - fldsFrAtm_num= 0 - - call ESMF_LogWrite(subname//"is called!", ESMF_LOGMSG_INFO) - - !------------------------------------------------------------------------- - ! !---- from atm ----! a2c_fldlist & c2l_fldlist - !------------------------------------------------------------------------- - !--------------------------a2c_fldlist------------------------------------ - ! from atm - states - !call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_z' ) - !call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_topo' ) - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_z' , default_value=30.0 , units='m/s') - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_topo' , default_value=10.0 , units='m') - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_u' , default_value=0.0 , units='m/s') - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_v' , default_value=0.0 , units='m/s') - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_ptem' , default_value=280.0 , units='degK') - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_pbot' , default_value=100100.0 , units='pa' ) - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_tbot' , default_value=280.0 , units='degk' ) - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_shum' , default_value=0.0004 , units='kg/kg' ) - !call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_methane' ) - - call ESMF_LogWrite(subname//"from atmosphere states are added!" , ESMF_LOGMSG_INFO) - - - - - - ! from atm - fluxes - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_lwdn' , default_value=200.0 , units='W/m2' ) - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_rainc' , default_value=4.0e-8 , units='kg/m2s' ) - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_rainl' , default_value=3.0e-8 , units='kg/m2s' ) - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_snowc' , default_value=1.0e-8 , units='kg/m2s' ) - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_snowl' , default_value=2.0e-8 , units='kg/m2s' ) - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swndr' , default_value=100.0 , units='W/m2' ) - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swvdr' , default_value=90.0 , units='W/m2' ) - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swndf' , default_value=20.0 , units='W/m2' ) - call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swvdf' , default_value=40.0 , units='W/m2' ) - - call ESMF_LogWrite(subname//"from atmosphere fluxes are added!", ESMF_LOGMSG_INFO) - - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') - - !--------------------------c2l_fldlist------------------------------------ - ! from atm - states - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_z' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_topo' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_u' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_v' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_ptem' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_pbot' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_tbot' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_shum' ) - !call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_methane' ) - call ESMF_LogWrite(subname//"from atmosphere states are added!", ESMF_LOGMSG_INFO) - - ! from atm - fluxes - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_lwdn' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_rainc' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_rainl' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_snowc' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_snowl' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swndr' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swvdr' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swndf' ) - call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swvdf' ) - call ESMF_LogWrite(subname//"from atmosphere fluxes are added!", ESMF_LOGMSG_INFO) - - !------------------------------------------------------------------------- - ! !---- from lnd ----! l2c_fldlist & c2a_fldlist - !------------------------------------------------------------------------- - !--------------------------l2c_fldlist------------------------------------ - ! export land states - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_lfrin' ) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_t' ) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_tref' ) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_qref' ) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_avsdr' ) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_anidr' ) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_avsdf' ) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_anidf' ) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_snowh' ) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_u10' ) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_fv' ) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_ram1' ) - call ESMF_LogWrite(subname//"l2c: from land states are added!", ESMF_LOGMSG_INFO) - - rof_prognostic = .false. - ! export fluxes to river - if (rof_prognostic) then - call ESMF_LogWrite(subname//"Okay we are in rof_prognostic", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofsur' ) - call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 13", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofgwl' ) - call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 14", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofsub' ) - call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 15", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofi' ) - call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 16", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_irrig' ) - call ESMF_LogWrite(subname//"l2c: from land states are added for rof_prognostic!", ESMF_LOGMSG_INFO) - end if - - ! export fluxes to atm - call ESMF_LogWrite(subname//"l2c: now adding fluxes to atmosphere!", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_taux' ) - call ESMF_LogWrite(subname//"l2c: Fall_taux!", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_tauy' ) - call ESMF_LogWrite(subname//"l2c: Fall_taux!", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_lat' ) - call ESMF_LogWrite(subname//"l2c: Fall_lat!", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_sen' ) - call ESMF_LogWrite(subname//"l2c: Fall_sen!", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_lwup' ) - call ESMF_LogWrite(subname//"l2c: Fall_lwup!", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_evap' ) - call ESMF_LogWrite(subname//"l2c: Fall_evap!", ESMF_LOGMSG_INFO) - call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_swnet' ) - call ESMF_LogWrite(subname//"l2c: Fall_lat!", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//"l2c: from land fluxes are added!", ESMF_LOGMSG_INFO) - - ! call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_methane' ) - - - !--------------------------c2a_fldlist------------------------------------ - ! export land states - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_lfrin' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_t' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_tref' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_qref' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_avsdr' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_anidr' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_avsdf' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_anidf' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_snowh' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_u10' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_fv' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_ram1' ) - - - ! export fluxes to river - if (rof_prognostic) then - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofsur' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofgwl' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofsub' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofi' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_irrig' ) - end if - - ! export fluxes to atm - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_taux' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_tauy' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_lat' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_sen' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_lwup' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_evap' ) - call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_swnet' ) - - ! call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_methane' ) - - - - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=0.0, units='m') - ! from lnd - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'lnd2atmos_var', default_value=0.0, units='m') - - - ! sets the module variable memory in atmos_cap.F9 print *, a2c_fldlist(1)%stdname - !!! First from atmosphere to land fields - ! import fields - ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) - - !call fldlist_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) - - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, units= 'degK') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) - - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') - !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) - ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) - - ! land states - - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) - - ! fluxes to atm - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) - !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) - - - - ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 - end subroutine create_fldlists + implicit none + private + + public :: this_clock + public :: lilac_init_atm2lnd + public :: lilac_init_lnd2atm + public :: lilac_atm2lnd + public :: lilac_lnd2atm + + ! Global index space info for atm data + ! the HOST ATMOSPHERE is also responsible for filling in the gindex information + ! this is used to create the distgrid for the mesh in lilac *** + integer, public, allocatable :: gindex_atm (:) + + type :: atm2lnd_type + character(len=128) :: fldname + real*8, pointer :: dataptr(:) + character(len=64) :: units + logical :: provided_by_atm + logical :: required_fr_atm + end type atm2lnd_type + type(atm2lnd_type), pointer, public :: atm2lnd(:) + + type :: lnd2atm_type + character(len=128) :: fldname + real*8, pointer :: dataptr(:) + character(len=64) :: units + end type lnd2atm_type + type(atm2lnd_type), pointer, public :: lnd2atm(:) + + type :: this_clock + integer, pointer :: yy + integer, pointer :: mm + integer, pointer :: dd + integer, pointer :: hh + integer, pointer :: mn + integer, pointer :: ss + end type this_clock + +!======================================================================== +contains +!======================================================================== + + ! *** NOTE - THE HOST ATMOSPHERE IS RESPONSIBLE for calling + ! lilac_init that then calls the initialization routines for atm2lnd and lnd2atm + + ! host atm init call will simply be + ! call lilac_init() + + ! host atm run phase will be + ! call lilac_atm2lnd(fldname, data1d) + + subroutine lilac_init_atm2lnd(lsize) + integer, intent(in) :: lsize + integer :: n + + ! TODO: how is the atm going to specify which fields are not provided = + ! should it pass an array of character strings or a colon deliminited set of fields + ! to specify the fields it will not provide - and then these are checked against those fields + + call atm2lnd_add_fld (atm2lnd, fldname='Sa_z' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_topo' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_u' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_v' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_ptem' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_pbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_tbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_shum' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_lwdn' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainc' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainl' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowc' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowl' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndr' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdr' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndf' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdf' , units='unknown', required_fr_atm=.true. , lsize=lsize) + + ! TODO: optional fields - if these are uncommented then need to make sure that they are also appear in the lnd + ! import state + ! CRITICAL the fields in the export state from lilac_atmcap MUST match the fields in the import state to the land + ! this is not being checked currently and msut be + !call atm2lnd_add_fld (atm2lnd, fldname='Sa_methane' , units='unknown', required_fr_atm=.false. , lsize=lsize) + !call atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcph' , units='unknown', required_fr_atm=.false. , lsize=lsize) + + ! now add dataptr memory for all of the fields and set default values of provided_by_atm to false + do n = 1,size(atm2lnd) + allocate(atm2lnd(n)%dataptr(lsize)) + atm2lnd(n)%provided_by_atm = .false. + end do + end subroutine lilac_init_atm2lnd + +!======================================================================== + + subroutine lilac_init_lnd2atm(lsize) + integer, intent(in) :: lsize + integer :: n + + call lnd2atm_add_fld (lnd2atm, fldname='Sl_lfrin' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_t' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_tref' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_qref' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdr' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_anidr' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdf' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_anidf' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_snowh' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_u10' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_fv' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_ram1' , units='unknown', lsize=lsize) + + ! TODO: for now are commenting these since they are in the lnd send - however this + ! is not correct and the lnd send should reintroduce these as soon as possible and + ! the following should be uncommented + !call lnd2atm_add_fld (lnd2atm, fldname='Fall_lwup' , units='unknown', lsize=lsize) + !call lnd2atm_add_fld (lnd2atm, fldname='Fall_taux' , units='unknown', lsize=lsize) + !call lnd2atm_add_fld (lnd2atm, fldname='Fall_tauy' , units='unknown', lsize=lsize) + + ! now add dataptr memory for all of the fields + do n = 1,size(lnd2atm) + allocate(lnd2atm(n)%dataptr(lsize)) + end do + end subroutine lilac_init_lnd2atm + +!======================================================================== + + subroutine lilac_atm2lnd(fldname, data) + + ! input/output variables + character(len=*), intent(in) :: fldname + real*8, intent(in) :: data(:) + + ! local variables + integer :: n + logical :: found + ! -------------------------------------------- + + found = .false. + do n = 1,size(atm2lnd) + if (trim(fldname) == atm2lnd(n)%fldname) then + found = .true. + if (size(data) /= size(atm2lnd(n)%dataptr)) then + ! call abort - TODO: what is the abort call in lilac + else + atm2lnd(n)%dataptr(:) = data(:) + end if + atm2lnd(n)%provided_by_atm = .true. + exit + end if + end do + if (.not. found) then + ! abort + end if + + end subroutine lilac_atm2lnd + + subroutine lilac_atm2lnd_check() + + ! local variables + integer :: n + ! -------------------------------------------- + + ! if there are fields that the atmosphere does not provide but that are required - then abort + do n = 1,size(atm2lnd) + if (atm2lnd(n)%required_fr_atm .and. (.not. atm2lnd(n)%provided_by_atm)) then + ! call abort or provide default values? + else if (.not. atm2lnd(n)%provided_by_atm) then + ! create default values + end if + end do + end subroutine lilac_atm2lnd_check + +!======================================================================== + + subroutine lilac_lnd2atm(fldname, data) + ! input/output variables + character(len=*), intent(in) :: fldname + real*8, intent(out) :: data(:) + + ! local variables + integer :: n + ! -------------------------------------------- + + do n = 1,size(lnd2atm) + if (trim(fldname) == lnd2atm(n)%fldname) then + if (size(data) /= size(lnd2atm(n)%dataptr)) then + ! call abort - TODO: what is the abort call in lilac + else + data(:) = lnd2atm(n)%dataptr(:) + end if + end if + end do + end subroutine lilac_lnd2atm + +!======================================================================== + + subroutine atm2lnd_add_fld(flds, fldname, units, required_fr_atm, lsize) + + ! ---------------------------------------------- + ! Add an entry to to the flds array + ! Use pointers to create an extensible allocatable array. + ! to allow the size of flds to grow, the process for + ! adding a new field is: + ! 1) allocate newflds to be N (one element larger than flds) + ! 2) copy flds into first N-1 elements of newflds + ! 3) newest flds entry is Nth element of newflds + ! 4) deallocate / nullify flds + ! 5) point flds => newflds + ! ---------------------------------------------- + + type(atm2lnd_type), pointer :: flds(:) + character(len=*) , intent(in) :: fldname + character(len=*) , intent(in) :: units + logical , intent(in) :: required_fr_atm + integer , intent(in) :: lsize + + ! local variables + integer :: n,oldsize,newsize + type(atm2lnd_type), pointer :: newflds(:) + character(len=*), parameter :: subname='(lilac_utils_add_atm2lnd_fld)' + ! ---------------------------------------------- + + if (associated(flds)) then + oldsize = size(flds) + else + oldsize = 0 + end if + newsize = oldsize + 1 + + if (oldsize > 0) then + ! 1) allocate newfld to be size (one element larger than input flds) + allocate(newflds(newsize)) + + ! 2) copy flds into first N-1 elements of newflds + do n = 1,oldsize + newflds(n)%fldname = flds(n)%fldname + newflds(n)%units = flds(n)%units + newflds(n)%required_fr_atm = flds(n)%required_fr_atm + end do + + ! 3) deallocate / nullify flds + if (oldsize > 0) then + deallocate(flds) + nullify(flds) + end if + + ! 4) point flds => new_flds + flds => newflds + + ! 5) update flds information for new entry + flds(newsize)%fldname = trim(fldname) + flds(newsize)%units = trim(units) + flds(newsize)%required_fr_atm = required_fr_atm + + else + allocate(flds(newsize)) + flds(newsize)%fldname = trim(fldname) + flds(newsize)%units = trim(units) + flds(newsize)%required_fr_atm = required_fr_atm + end if + + end subroutine atm2lnd_add_fld + +!======================================================================== + + subroutine lnd2atm_add_fld(flds, fldname, units, lsize) + + ! ---------------------------------------------- + ! Add an entry to to the flds array + ! Use pointers to create an extensible allocatable array. + ! to allow the size of flds to grow, the process for + ! adding a new field is: + ! 1) allocate newflds to be N (one element larger than flds) + ! 2) copy flds into first N-1 elements of newflds + ! 3) newest flds entry is Nth element of newflds + ! 4) deallocate / nullify flds + ! 5) point flds => newflds + ! ---------------------------------------------- + + type(atm2lnd_type), pointer :: flds(:) + character(len=*) , intent(in) :: fldname + character(len=*) , intent(in) :: units + integer , intent(in) :: lsize + + ! local variables + integer :: n,oldsize,newsize + type(atm2lnd_type), pointer :: newflds(:) + character(len=*), parameter :: subname='(lilac_init_lnd2atm)' + ! ---------------------------------------------- + + if (associated(flds)) then + oldsize = size(flds) + else + oldsize = 0 + end if + newsize = oldsize + 1 + + ! 1) allocate newfld to be size (one element larger than input flds) + allocate(newflds(newsize)) + + ! 2) copy flds into first N-1 elements of newflds + do n = 1,oldsize + newflds(n)%fldname = flds(n)%fldname + newflds(n)%units = flds(n)%units + end do + + ! 3) deallocate / nullify flds + if (oldsize > 0) then + deallocate(flds) + nullify(flds) + end if + + ! 4) point flds => new_flds + flds => newflds + + ! 5) now update flds information for new entry + flds(newsize)%fldname = trim(fldname) + flds(newsize)%units = trim(units) + + end subroutine lnd2atm_add_fld end module lilac_utils From 62787851ab9c31979da5763a4394a1679009930c Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 26 Nov 2019 16:20:55 -0700 Subject: [PATCH 161/556] adding the new compset for LILAC testing.... --- cime_config/config_compsets.xml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 912bac56ef..33fa57651f 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -53,6 +53,11 @@ 2000_DATM%GSWP3v1_CLM50%SP_SICE_SOCN_MOSART_CISM2%NOEVOLVE_SWAV + + I2000Clm50SpRsGs + 2000_DATM%GSWP3v1_CLM50%SP_SICE_SOCN_SROF_SGLC_SWAV + + I2000Clm50BgcCru 2000_DATM%CRUv7_CLM50%BGC_SICE_SOCN_MOSART_CISM2%NOEVOLVE_SWAV From f6d81e122e0799893a1035d55759225035657a11 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 26 Nov 2019 16:22:02 -0700 Subject: [PATCH 162/556] changes in buildlib to build lilac directory instead of mct. --- cime_config/buildlib | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cime_config/buildlib b/cime_config/buildlib index 86f1e479fa..f4cd613a6c 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -52,7 +52,9 @@ def _main_func(): os.path.join(lnd_root,"src","fates","biogeochem"), os.path.join(lnd_root,"src","fates","fire"), os.path.join(lnd_root,"src","utils"), - os.path.join(lnd_root,"src","cpl")] + os.path.join(lnd_root,"src","cpl"), + #os.path.join(lnd_root,"src","cpl","mct"), + os.path.join(lnd_root,"src","cpl","lilac")] with open(filepath_file, "w") as filepath: filepath.write("\n".join(paths)) filepath.write("\n") From 379e032d5acf8df4b9c18f5aa659afdbb4bfb017 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 26 Nov 2019 16:29:11 -0700 Subject: [PATCH 163/556] adding gindex_ocn to initlization subroutine. --- src/main/clm_initializeMod.F90 | 112 ++++++++++++++++++--------------- 1 file changed, 60 insertions(+), 52 deletions(-) diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index aa27b18a6c..4cd1073488 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -17,19 +17,20 @@ module clm_initializeMod use perf_mod , only : t_startf, t_stopf use readParamsMod , only : readParameters use ncdio_pio , only : file_desc_t - use GridcellType , only : grc ! instance - use LandunitType , only : lun ! instance - use ColumnType , only : col ! instance - use PatchType , only : patch ! instance + use GridcellType , only : grc ! instance + use LandunitType , only : lun ! instance + use ColumnType , only : col ! instance + use PatchType , only : patch ! instance use reweightMod , only : reweight_wrapup use filterMod , only : allocFilters, filter, filter_inactive_and_active use FatesInterfaceMod, only : set_fates_global_elements use dynSubgridControlMod, only: dynSubgridControl_init, get_reset_dynbal_baselines - use clm_instMod - ! + use clm_instMod + ! implicit none - private ! By default everything is private + private ! By default everything is private + ! public :: initialize1 ! Phase one initialization public :: initialize2 ! Phase two initialization @@ -38,18 +39,19 @@ module clm_initializeMod contains !----------------------------------------------------------------------- - subroutine initialize1( ) + subroutine initialize1(gindex_ocn) ! ! !DESCRIPTION: - ! CLM initialization first phase + ! CLM initialization first phase ! ! !USES: use clm_varpar , only: clm_varpar_init, natpft_lb, natpft_ub, cft_lb, cft_ub, maxpatch_glcmec use clm_varcon , only: clm_varcon_init use landunit_varcon , only: landunit_varcon_init, max_lunit - use clm_varctl , only: fsurdat, fatmlndfrc, noland, version - use pftconMod , only: pftcon + use clm_varctl , only: fsurdat, fatmlndfrc, noland, version + use pftconMod , only: pftcon use decompInitMod , only: decompInit_lnd, decompInit_clumps, decompInit_glcp + use decompInitMod , only: decompInit_ocn use domainMod , only: domain_check, ldomain, domain_init use surfrdMod , only: surfrd_get_globmask, surfrd_get_grid, surfrd_get_data, surfrd_get_num_patches use controlMod , only: control_init, control_print, NLFilename @@ -57,6 +59,10 @@ subroutine initialize1( ) use initGridCellsMod , only: initGridCells use ch4varcon , only: ch4conrd use UrbanParamsType , only: UrbanInput, IsSimpleBuildTemp + use dynSubgridControlMod, only: dynSubgridControl_init + ! + ! !ARGUMENTS + integer, pointer, optional :: gindex_ocn(:) ! ! !LOCAL VARIABLES: integer :: ier ! error status @@ -64,7 +70,7 @@ subroutine initialize1( ) integer :: nl ! gdc and glo lnd indices integer :: ns, ni, nj ! global grid sizes integer :: begg, endg ! processor bounds - type(bounds_type) :: bounds_proc + type(bounds_type) :: bounds_proc type(bounds_type) :: bounds_clump integer :: nclumps ! number of clumps on this processor integer :: nc ! clump index @@ -123,10 +129,13 @@ subroutine initialize1( ) ! ------------------------------------------------------------------------ call decompInit_lnd(ni, nj, amask) + if (present(gindex_ocn)) then + call decompInit_ocn(ni, nj, amask, gindex_ocn=gindex_ocn) + end if deallocate(amask) ! *** Get JUST gridcell processor bounds *** - ! Remaining bounds (landunits, columns, patches) will be determined + ! Remaining bounds (landunits, columns, patches) will be determined ! after the call to decompInit_glcp - so get_proc_bounds is called ! twice and the gridcell information is just filled in twice @@ -172,7 +181,6 @@ subroutine initialize1( ) call pftcon%Init() ! Read surface dataset and set up subgrid weight arrays - call surfrd_get_data(begg, endg, ldomain, fsurdat, actual_numcft) ! ------------------------------------------------------------------------ @@ -184,11 +192,11 @@ subroutine initialize1( ) ! Sets: ! fates_maxElementsPerPatch ! fates_maxElementsPerSite (where a site is roughly equivalent to a column) - ! + ! ! (Note: fates_maxELementsPerSite is the critical variable used by CLM ! to allocate space) ! ------------------------------------------------------------------------ - + call set_fates_global_elements(use_fates) ! ------------------------------------------------------------------------ @@ -200,7 +208,7 @@ subroutine initialize1( ) ! *** Get ALL processor bounds - for gridcells, landunit, columns and patches *** call get_proc_bounds(bounds_proc) - + ! Allocate memory for subgrid data structures ! This is needed here BEFORE the following call to initGridcells ! Note that the assumption is made that none of the subgrid initialization @@ -237,7 +245,7 @@ subroutine initialize1( ) ! ------------------------------------------------------------------------ ! Set CH4 Model Parameters from namelist. - ! Need to do before initTimeConst so that it knows whether to + ! Need to do before initTimeConst so that it knows whether to ! look for several optional parameters on surfdata file. if (use_lch4) then @@ -265,7 +273,7 @@ subroutine initialize2( ) use shr_orb_mod , only : shr_orb_decl use shr_scam_mod , only : shr_scam_getCloseLatLon use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND - use accumulMod , only : print_accum_fields + use accumulMod , only : print_accum_fields use clm_varpar , only : nlevsno use clm_varcon , only : spval use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, fsurdat @@ -273,7 +281,7 @@ subroutine initialize2( ) use clm_varctl , only : use_crop, ndep_from_cpl use clm_varorb , only : eccen, mvelpp, lambm0, obliqr use clm_time_manager , only : get_step_size_real, get_curr_calday - use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep + use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep use clm_time_manager , only : timemgr_init, timemgr_restart_io, timemgr_restart, is_restart use CIsoAtmTimeseriesMod , only : C14_init_BombSpike, use_c14_bombspike, C13_init_TimeSeries, use_c13_timeseries use DaylengthMod , only : InitDaylength @@ -285,9 +293,9 @@ subroutine initialize2( ) use histFileMod , only : hist_htapes_build, htapes_fieldlist, hist_printflds use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal use restFileMod , only : restFile_getfile, restFile_open, restFile_close - use restFileMod , only : restFile_read, restFile_write + use restFileMod , only : restFile_read, restFile_write use ndepStreamMod , only : ndep_init, ndep_interp - use LakeCon , only : LakeConInit + use LakeCon , only : LakeConInit use SatellitePhenologyMod , only : SatellitePhenologyInit, readAnnualVegetation, interpMonthlyVeg use SnowSnicarMod , only : SnowAge_init, SnowOptics_init use lnd2atmMod , only : lnd2atm_minimal @@ -296,7 +304,7 @@ subroutine initialize2( ) use clm_instMod , only : clm_fates use BalanceCheckMod , only : BalanceCheckInit ! - ! !ARGUMENTS + ! !ARGUMENTS ! ! !LOCAL VARIABLES: integer :: c,i,j,k,l,p! indices @@ -306,7 +314,7 @@ subroutine initialize2( ) integer :: ncsec ! current time of day [seconds] integer :: nc ! clump index integer :: nclumps ! number of clumps on this processor - character(len=256) :: fnamer ! name of netcdf restart file + character(len=256) :: fnamer ! name of netcdf restart file character(len=256) :: pnamer ! full pathname of netcdf restart file character(len=256) :: locfn ! local file name type(file_desc_t) :: ncid ! netcdf id @@ -326,7 +334,7 @@ subroutine initialize2( ) integer :: begc, endc integer :: begl, endl real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays - character(len=32) :: subname = 'initialize2' + character(len=32) :: subname = 'initialize2' !---------------------------------------------------------------------- call t_startf('clm_init2') @@ -352,7 +360,7 @@ subroutine initialize2( ) ! Initialize time manager ! ------------------------------------------------------------------------ - if (nsrest == nsrStartup) then + if (nsrest == nsrStartup) then call timemgr_init() else call restFile_getfile(file=fnamer, path=pnamer) @@ -376,12 +384,12 @@ subroutine initialize2( ) call shr_orb_decl( caldaym1, eccen, mvelpp, lambm0, obliqr, declinm1, eccf ) call t_stopf('init_orbd') - + call InitDaylength(bounds_proc, declin=declin, declinm1=declinm1, obliquity=obliqr) ! Initialize Balance checking (after time-manager) call BalanceCheckInit() - + ! History file variables if (use_cn) then @@ -395,7 +403,7 @@ subroutine initialize2( ) end if ! ------------------------------------------------------------------------ - ! Initialize component data structures + ! Initialize component data structures ! ------------------------------------------------------------------------ ! Note: new logic is in place that sets all the history fields to spval so @@ -485,7 +493,7 @@ subroutine initialize2( ) ! be moved into bgc_vegetation_inst%Init2 if (n_drydep > 0 .and. drydep_method == DD_XLND) then - ! Must do this also when drydeposition is used so that estimates of monthly + ! Must do this also when drydeposition is used so that estimates of monthly ! differences in LAI can be computed call SatellitePhenologyInit(bounds_proc) end if @@ -502,10 +510,10 @@ subroutine initialize2( ) end if - + ! ------------------------------------------------------------------------ - ! On restart only - process the history namelist. + ! On restart only - process the history namelist. ! ------------------------------------------------------------------------ ! Later the namelist from the restart file will be used. This allows basic @@ -516,7 +524,7 @@ subroutine initialize2( ) end if ! ------------------------------------------------------------------------ - ! Read restart/initial info + ! Read restart/initial info ! ------------------------------------------------------------------------ is_cold_start = .false. @@ -530,13 +538,13 @@ subroutine initialize2( ) if (masterproc) then write(iulog,*)'Using cold start initial conditions ' end if - else + else if (masterproc) then write(iulog,*)'Interpolating initial conditions from ',trim(finidat_interp_source),& ' and creating new initial conditions ', trim(finidat_interp_dest) end if end if - else + else if (masterproc) then write(iulog,*)'Reading initial conditions from ',trim(finidat) end if @@ -578,7 +586,7 @@ subroutine initialize2( ) ! Read new interpolated conditions file back in call restFile_read(bounds_proc, finidat_interp_dest, glc_behavior) - ! Reset finidat to now be finidat_interp_dest + ! Reset finidat to now be finidat_interp_dest ! (to be compatible with routines still using finidat) finidat = trim(finidat_interp_dest) @@ -630,11 +638,11 @@ subroutine initialize2( ) end if ! ------------------------------------------------------------------------ - ! Initialize active history fields. + ! Initialize active history fields. ! ------------------------------------------------------------------------ - ! This is only done if not a restart run. If a restart run, then this - ! information has already been obtained from the restart data read above. + ! This is only done if not a restart run. If a restart run, then this + ! information has already been obtained from the restart data read above. ! Note that routine hist_htapes_build needs time manager information, ! so this call must be made after the restart information has been read. @@ -647,7 +655,7 @@ subroutine initialize2( ) ! ------------------------------------------------------------------------ ! The following is called for both initial and restart runs and must - ! must be called after the restart file is read + ! must be called after the restart file is read call atm2lnd_inst%initAccVars(bounds_proc) call temperature_inst%initAccVars(bounds_proc) @@ -661,11 +669,11 @@ subroutine initialize2( ) call crop_inst%initAccVars(bounds_proc) end if - !------------------------------------------------------------ + !------------------------------------------------------------ ! Read monthly vegetation - !------------------------------------------------------------ + !------------------------------------------------------------ - ! Even if CN is on, and dry-deposition is active, read CLMSP annual vegetation + ! Even if CN is on, and dry-deposition is active, read CLMSP annual vegetation ! to get estimates of monthly LAI if ( n_drydep > 0 .and. drydep_method == DD_XLND )then @@ -677,9 +685,9 @@ subroutine initialize2( ) end if end if - !------------------------------------------------------------ + !------------------------------------------------------------ ! Determine gridcell averaged properties to send to atm - !------------------------------------------------------------ + !------------------------------------------------------------ if (nsrest == nsrStartup) then call t_startf('init_map2gc') @@ -688,9 +696,9 @@ subroutine initialize2( ) call t_stopf('init_map2gc') end if - !------------------------------------------------------------ + !------------------------------------------------------------ ! Initialize sno export state to send to glc - !------------------------------------------------------------ + !------------------------------------------------------------ !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) do nc = 1,nclumps @@ -705,9 +713,9 @@ subroutine initialize2( ) end do !$OMP END PARALLEL DO - !------------------------------------------------------------ + !------------------------------------------------------------ ! Deallocate wt_nat_patch - !------------------------------------------------------------ + !------------------------------------------------------------ ! wt_nat_patch was allocated in initialize1, but needed to be kept around through ! initialize2 for some consistency checking; now it can be deallocated @@ -717,7 +725,7 @@ subroutine initialize2( ) ! -------------------------------------------------------------- ! Initialise the fates model state structure ! -------------------------------------------------------------- - + if ( use_fates .and. .not.is_restart() .and. finidat == ' ') then call clm_fates%init_coldstart(water_inst%waterstatebulk_inst, & water_inst%waterdiagnosticbulk_inst, canopystate_inst, & @@ -730,9 +738,9 @@ subroutine initialize2( ) deallocate(topo_glc_mec, fert_cft, irrig_method) - !------------------------------------------------------------ + !------------------------------------------------------------ ! Write log output for end of initialization - !------------------------------------------------------------ + !------------------------------------------------------------ call t_startf('init_wlog') if (masterproc) then From 0ba99a2cc3f2bb100b213cc5b6ea4658c1650bbb Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 26 Nov 2019 16:30:12 -0700 Subject: [PATCH 164/556] adding decomposition initalization for ocean to src/main/decompInitMod.F90 --- src/main/decompInitMod.F90 | 106 ++++++++++++++++++++++++++++--------- 1 file changed, 81 insertions(+), 25 deletions(-) diff --git a/src/main/decompInitMod.F90 b/src/main/decompInitMod.F90 index 709c0b5e36..c5f743085b 100644 --- a/src/main/decompInitMod.F90 +++ b/src/main/decompInitMod.F90 @@ -14,8 +14,8 @@ module decompInitMod use clm_varctl , only : iulog, use_fates use clm_varcon , only : grlnd use GridcellType , only : grc - use LandunitType , only : lun - use ColumnType , only : col + use LandunitType , only : lun + use ColumnType , only : col use PatchType , only : patch use glcBehaviorMod , only : glc_behavior_type use decompMod @@ -26,8 +26,9 @@ module decompInitMod implicit none ! ! !PUBLIC MEMBER FUNCTIONS: - public decompInit_lnd ! initializes lnd grid decomposition into clumps and processors - public decompInit_clumps ! initializes atm grid decomposition into clumps + public decompInit_lnd ! initializes grid land points decomposition into clumps and processors + public decompInit_ocn ! initializes grid ocean points decomposition + public decompInit_clumps ! initializes grid decomposition into clumps public decompInit_glcp ! initializes g,l,c,p decomp info ! ! !PRIVATE TYPES: @@ -87,8 +88,8 @@ subroutine decompInit_lnd(lni,lnj,amask) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - ! allocate and initialize procinfo and clumps - ! beg and end indices initialized for simple addition of cells later + ! allocate and initialize procinfo and clumps + ! beg and end indices initialized for simple addition of cells later allocate(procinfo%cid(clump_pproc), stat=ier) if (ier /= 0) then @@ -135,7 +136,7 @@ subroutine decompInit_lnd(lni,lnj,amask) clumps(:)%endp = 0 clumps(:)%endCohort = 0 - ! assign clumps to proc round robin + ! assign clumps to proc round robin cid = 0 do n = 1,nclumps pid = mod(n-1,npes) @@ -207,7 +208,7 @@ subroutine decompInit_lnd(lni,lnj,amask) !--- give gridcell cell to pe that owns cid --- !--- this needs to be done to subsequently use function - !--- get_proc_bounds(begg,endg) + !--- get_proc_bounds(begg,endg) if (iam == clumps(cid)%owner) then procinfo%ncells = procinfo%ncells + 1 endif @@ -226,7 +227,7 @@ subroutine decompInit_lnd(lni,lnj,amask) (clumps(m)%owner == clumps(cid)%owner .and. m > cid)) then clumps(m)%begg = clumps(m)%begg + 1 endif - + if ((clumps(m)%owner > clumps(cid)%owner) .or. & (clumps(m)%owner == clumps(cid)%owner .and. m >= cid)) then clumps(m)%endg = clumps(m)%endg + 1 @@ -312,6 +313,61 @@ subroutine decompInit_lnd(lni,lnj,amask) end subroutine decompInit_lnd + !------------------------------------------------------------------------------ + subroutine decompInit_ocn(ni, nj, amask, gindex_ocn) + + ! !DESCRIPTION: + ! calculate a decomposition of only ocn points (needed for the nuopc interface) + + ! !USES: + use spmdMod , only : npes, iam + + ! !ARGUMENTS: + integer , intent(in) :: amask(:) + integer , intent(in) :: ni,nj ! domain global size + integer , pointer :: gindex_ocn(:) + + ! !LOCAL VARIABLES: + integer :: n,i,j,nocn + integer :: nlnd_global + integer :: nocn_global + integer :: nocn_local + integer :: my_ocn_start, my_ocn_end + !------------------------------------------------------------------------------ + + ! count total land and ocean gridcells + nlnd_global = 0 + nocn_global = 0 + do n = 1,ni*nj + if (amask(n) == 1) then + nlnd_global = nlnd_global + 1 + else + nocn_global = nocn_global + 1 + endif + enddo + + ! create the a global index array for ocean points + nocn_local = nocn_global / npes + + my_ocn_start = nocn_local*iam + min(iam, mod(nocn_global, npes)) + 1 + if (iam < mod(nocn_global, npes)) then + nocn_local = nocn_local + 1 + end if + my_ocn_end = my_ocn_start + nocn_local - 1 + + allocate(gindex_ocn(nocn_local)) + nocn = 0 + do n = 1,ni*nj + if (amask(n) == 0) then + nocn = nocn + 1 + if (nocn >= my_ocn_start .and. nocn <= my_ocn_end) then + gindex_ocn(nocn - my_ocn_start + 1) = n + end if + end if + end do + + end subroutine decompInit_ocn + !------------------------------------------------------------------------------ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior) ! @@ -354,15 +410,15 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior) allocate(allvecl(nclumps,5)) ! local clumps [gcells,lunit,cols,patches,coh] allocate(allvecg(nclumps,5)) ! global clumps [gcells,lunit,cols,patches,coh] - ! Determine the number of gridcells, landunits, columns, and patches, cohorts - ! on this processor + ! Determine the number of gridcells, landunits, columns, and patches, cohorts + ! on this processor ! Determine number of landunits, columns and patches for each global ! gridcell index (an) that is associated with the local gridcell index (ln) ilunits=0 icols=0 ipatches=0 - icohorts=0 + icohorts=0 allvecg= 0 allvecl= 0 @@ -375,8 +431,8 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior) allvecl(cid,1) = allvecl(cid,1) + 1 allvecl(cid,2) = allvecl(cid,2) + ilunits ! number of landunits for local clump cid allvecl(cid,3) = allvecl(cid,3) + icols ! number of columns for local clump cid - allvecl(cid,4) = allvecl(cid,4) + ipatches ! number of patches for local clump cid - allvecl(cid,5) = allvecl(cid,5) + icohorts ! number of cohorts for local clump cid + allvecl(cid,4) = allvecl(cid,4) + ipatches ! number of patches for local clump cid + allvecl(cid,5) = allvecl(cid,5) + icohorts ! number of cohorts for local clump cid enddo call mpi_allreduce(allvecl,allvecg,size(allvecg),MPI_INTEGER,MPI_SUM,mpicom,ier) @@ -405,7 +461,7 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior) !--- give gridcell to cid --- !--- increment the beg and end indices --- - clumps(cid)%nlunits = clumps(cid)%nlunits + ilunits + clumps(cid)%nlunits = clumps(cid)%nlunits + ilunits clumps(cid)%ncols = clumps(cid)%ncols + icols clumps(cid)%npatches = clumps(cid)%npatches + ipatches clumps(cid)%nCohorts = clumps(cid)%nCohorts + icohorts @@ -464,7 +520,7 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior) write(iulog ,*) 'decompInit_glcp(): allvecg error ncols ',iam,n,clumps(n)%ncols ,allvecg(n,3) write(iulog ,*) 'decompInit_glcp(): allvecg error patches',iam,n,clumps(n)%npatches ,allvecg(n,4) write(iulog ,*) 'decompInit_glcp(): allvecg error cohorts',iam,n,clumps(n)%nCohorts ,allvecg(n,5) - + call endrun(msg=errMsg(sourcefile, __LINE__)) endif enddo @@ -527,7 +583,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) character(len=32), parameter :: subname = 'decompInit_glcp' !------------------------------------------------------------------------------ - !init + !init call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp, & begCohort, endCohort) @@ -557,7 +613,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) endif allocate(coCount(begg:endg)) coCount(:) = 0 - allocate(ioff(begg:endg)) + allocate(ioff(begg:endg)) ioff(:) = 0 ! Determine gcount, lcount, ccount and pcount @@ -595,7 +651,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) endif call scatter_data_from_master(gstart, arrayglob, grlnd) - ! lstart for gridcell (n) is the total number of the landunits + ! lstart for gridcell (n) is the total number of the landunits ! over gridcells 1->n-1 arrayglob(:) = 0 @@ -687,7 +743,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) do li = begl,endl gi = lun%gridcell(li) !===this is determined internally from how landunits are spread out in memory gindex(li) = lstart(gi) + ioff(gi) !=== the output gindex is ALWAYS the same regardless of how landuntis are spread out in memory - ioff(gi) = ioff(gi) + 1 + ioff(gi) = ioff(gi) + 1 ! check that this is less than [lstart(gi) + lcount(gi)] enddo locsize = endl-begl+1 @@ -702,7 +758,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) do ci = begc,endc gi = col%gridcell(ci) gindex(ci) = cstart(gi) + ioff(gi) - ioff(gi) = ioff(gi) + 1 + ioff(gi) = ioff(gi) + 1 ! check that this is less than [cstart(gi) + ccount(gi)] enddo locsize = endc-begc+1 @@ -717,7 +773,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) do pi = begp,endp gi = patch%gridcell(pi) gindex(pi) = pstart(gi) + ioff(gi) - ioff(gi) = ioff(gi) + 1 + ioff(gi) = ioff(gi) + 1 ! check that this is less than [pstart(gi) + pcount(gi)] enddo locsize = endp-begp+1 @@ -726,7 +782,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) deallocate(gindex) ! FATES gsmap for the cohort/element vector - + if ( use_fates ) then allocate(gindex(begCohort:endCohort)) ioff(:) = 0 @@ -775,7 +831,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) write(iulog,*) end if - ! Write out clump and proc info, one pe at a time, + ! Write out clump and proc info, one pe at a time, ! barrier to control pes overwriting each other on stdout call shr_sys_flush(iulog) @@ -870,7 +926,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) ' clump id= ',procinfo%cid(n), & ' beg patch = ',clumps(cid)%begp, & ' end patch = ',clumps(cid)%endp, & - ' total patches per clump = ',clumps(cid)%npatches + ' total patches per clump = ',clumps(cid)%npatches write(iulog,*)'proc= ',pid,' clump no = ',n, & ' clump id= ',procinfo%cid(n), & ' beg cohort = ',clumps(cid)%begCohort, & From d774f21621afb1b83b07e0fe1c12bba8deef7276 Mon Sep 17 00:00:00 2001 From: negin513 Date: Tue, 26 Nov 2019 16:33:35 -0700 Subject: [PATCH 165/556] making changes in mct_gGrid_init CoordChars to get 'lat:lon:hgt' --- src/main/ndepStreamMod.F90 | 76 +++++++++++++++++++------------------- 1 file changed, 37 insertions(+), 39 deletions(-) diff --git a/src/main/ndepStreamMod.F90 b/src/main/ndepStreamMod.F90 index e4acd648b8..ac8548a8c1 100644 --- a/src/main/ndepStreamMod.F90 +++ b/src/main/ndepStreamMod.F90 @@ -1,13 +1,13 @@ module ndepStreamMod - !----------------------------------------------------------------------- - ! !DESCRIPTION: + !----------------------------------------------------------------------- + ! !DESCRIPTION: ! Contains methods for reading in nitrogen deposition data file - ! Also includes functions for dynamic ndep file handling and + ! Also includes functions for dynamic ndep file handling and ! interpolation. ! ! !USES - use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl + use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl use shr_strdata_mod, only: shr_strdata_type, shr_strdata_create use shr_strdata_mod, only: shr_strdata_print, shr_strdata_advance use mct_mod , only: mct_ggrid @@ -15,7 +15,7 @@ module ndepStreamMod use clm_varctl , only: iulog use abortutils , only: endrun use fileutils , only: getavu, relavu - use decompMod , only: bounds_type, ldecomp, gsmap_lnd_gdc2glo + use decompMod , only: bounds_type, ldecomp, gsmap_lnd_gdc2glo use domainMod , only: ldomain ! !PUBLIC TYPES: @@ -34,7 +34,7 @@ module ndepStreamMod type(shr_strdata_type) :: sdat ! input data stream integer :: stream_year_first_ndep ! first year in stream to use integer :: stream_year_last_ndep ! last year in stream to use - integer :: model_year_align_ndep ! align stream_year_firstndep with + integer :: model_year_align_ndep ! align stream_year_firstndep with logical :: divide_by_secs_per_yr = .true. ! divide by the number of seconds per year character(len=*), parameter, private :: sourcefile = & @@ -46,8 +46,8 @@ module ndepStreamMod !============================================================================== subroutine ndep_init(bounds, NLFilename) - ! - ! Initialize data stream information. + ! + ! Initialize data stream information. ! ! Uses: use shr_kind_mod , only : CS => shr_kind_cs @@ -61,13 +61,13 @@ subroutine ndep_init(bounds, NLFilename) ! ! arguments implicit none - type(bounds_type), intent(in) :: bounds + type(bounds_type), intent(in) :: bounds character(len=*), intent(in) :: NLFilename ! Namelist filename ! ! local variables integer :: nu_nml ! unit for namelist file integer :: nml_error ! namelist i/o error flag - type(mct_ggrid) :: dom_clm ! domain information + type(mct_ggrid) :: dom_clm ! domain information character(len=CL) :: stream_fldFileName_ndep character(len=CL) :: ndepmapalgo = 'bilinear' character(len=CS) :: ndep_taxmode = 'extend' @@ -118,9 +118,9 @@ subroutine ndep_init(bounds, NLFilename) if (masterproc) then write(iulog,*) ' ' write(iulog,*) 'ndepdyn stream settings:' - write(iulog,*) ' stream_year_first_ndep = ',stream_year_first_ndep - write(iulog,*) ' stream_year_last_ndep = ',stream_year_last_ndep - write(iulog,*) ' model_year_align_ndep = ',model_year_align_ndep + write(iulog,*) ' stream_year_first_ndep = ',stream_year_first_ndep + write(iulog,*) ' stream_year_last_ndep = ',stream_year_last_ndep + write(iulog,*) ' model_year_align_ndep = ',model_year_align_ndep write(iulog,*) ' stream_fldFileName_ndep = ',stream_fldFileName_ndep write(iulog,*) ' ndep_varList = ',ndep_varList write(iulog,*) ' ndep_taxmode = ',ndep_taxmode @@ -133,7 +133,7 @@ subroutine ndep_init(bounds, NLFilename) call clm_domain_mct (bounds, dom_clm) call shr_strdata_create(sdat,name="clmndep", & - pio_subsystem=pio_subsystem, & + pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & @@ -146,7 +146,7 @@ subroutine ndep_init(bounds, NLFilename) domFileName=trim(stream_fldFileName_ndep), & domTvarName='time', & domXvarName='lon' , & - domYvarName='lat' , & + domYvarName='lat' , & domAreaName='area', & domMaskName='mask', & filePath='', & @@ -165,7 +165,7 @@ subroutine ndep_init(bounds, NLFilename) end subroutine ndep_init !================================================================ - + subroutine check_units( stream_fldFileName_ndep, ndep_varList ) !------------------------------------------------------------------- ! Check that units are correct on the file and if need any conversion @@ -222,11 +222,11 @@ subroutine ndep_interp(bounds, atm2lnd_inst) use atm2lndType , only : atm2lnd_type ! ! Arguments - type(bounds_type) , intent(in) :: bounds + type(bounds_type) , intent(in) :: bounds type(atm2lnd_type), intent(inout) :: atm2lnd_inst ! ! Local variables - integer :: g, ig + integer :: g, ig integer :: year ! year (0, ...) for nstep+1 integer :: mon ! month (1, ..., 12) for nstep+1 integer :: day ! day of month (1, ..., 31) for nstep+1 @@ -254,7 +254,7 @@ subroutine ndep_interp(bounds, atm2lnd_inst) atm2lnd_inst%forc_ndep_grc(g) = sdat%avs(1)%rAttr(1,ig) end do end if - + end subroutine ndep_interp !============================================================================== @@ -264,14 +264,13 @@ subroutine clm_domain_mct(bounds, dom_clm) ! Set domain data type for internal clm grid use clm_varcon , only : re use domainMod , only : ldomain - use seq_flds_mod use mct_mod , only : mct_ggrid, mct_gsMap_lsize, mct_gGrid_init use mct_mod , only : mct_gsMap_orderedPoints, mct_gGrid_importIAttr use mct_mod , only : mct_gGrid_importRAttr implicit none - ! + ! ! arguments - type(bounds_type), intent(in) :: bounds + type(bounds_type), intent(in) :: bounds type(mct_ggrid), intent(out) :: dom_clm ! Output domain information for land model ! ! local variables @@ -284,10 +283,10 @@ subroutine clm_domain_mct(bounds, dom_clm) ! Initialize mct domain type ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) ! Note that in addition land carries around landfrac for the purposes of domain checking - ! + ! lsize = mct_gsMap_lsize(gsmap_lnd_gdc2glo, mpicom) - call mct_gGrid_init( GGrid=dom_clm, CoordChars=trim(seq_flds_dom_coord), & - OtherChars=trim(seq_flds_dom_other), lsize=lsize ) + call mct_gGrid_init( GGrid=dom_clm, & + CoordChars='lat:lon:hgt', OtherChars='area:aream:mask:frac', lsize=lsize ) ! ! Allocate memory ! @@ -301,13 +300,13 @@ subroutine clm_domain_mct(bounds, dom_clm) ! Determine domain (numbering scheme is: West to East and South to North to South pole) ! Initialize attribute vector with special value ! - data(:) = -9999.0_R8 - call mct_gGrid_importRAttr(dom_clm,"lat" ,data,lsize) - call mct_gGrid_importRAttr(dom_clm,"lon" ,data,lsize) - call mct_gGrid_importRAttr(dom_clm,"area" ,data,lsize) - call mct_gGrid_importRAttr(dom_clm,"aream",data,lsize) - data(:) = 0.0_R8 - call mct_gGrid_importRAttr(dom_clm,"mask" ,data,lsize) + data(:) = -9999.0_R8 + call mct_gGrid_importRAttr(dom_clm,"lat" ,data,lsize) + call mct_gGrid_importRAttr(dom_clm,"lon" ,data,lsize) + call mct_gGrid_importRAttr(dom_clm,"area" ,data,lsize) + call mct_gGrid_importRAttr(dom_clm,"aream",data,lsize) + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_clm,"mask" ,data,lsize) ! ! Determine bounds ! @@ -318,36 +317,35 @@ subroutine clm_domain_mct(bounds, dom_clm) i = 1 + (g - bounds%begg) data(i) = ldomain%lonc(g) end do - call mct_gGrid_importRattr(dom_clm,"lon",data,lsize) + call mct_gGrid_importRattr(dom_clm,"lon",data,lsize) do g = bounds%begg,bounds%endg i = 1 + (g - bounds%begg) data(i) = ldomain%latc(g) end do - call mct_gGrid_importRattr(dom_clm,"lat",data,lsize) + call mct_gGrid_importRattr(dom_clm,"lat",data,lsize) do g = bounds%begg,bounds%endg i = 1 + (g - bounds%begg) data(i) = ldomain%area(g)/(re*re) end do - call mct_gGrid_importRattr(dom_clm,"area",data,lsize) + call mct_gGrid_importRattr(dom_clm,"area",data,lsize) do g = bounds%begg,bounds%endg i = 1 + (g - bounds%begg) data(i) = real(ldomain%mask(g), r8) end do - call mct_gGrid_importRattr(dom_clm,"mask",data,lsize) + call mct_gGrid_importRattr(dom_clm,"mask",data,lsize) do g = bounds%begg,bounds%endg i = 1 + (g - bounds%begg) data(i) = real(ldomain%frac(g), r8) end do - call mct_gGrid_importRattr(dom_clm,"frac",data,lsize) + call mct_gGrid_importRattr(dom_clm,"frac",data,lsize) deallocate(data) deallocate(idata) end subroutine clm_domain_mct - -end module ndepStreamMod +end module ndepStreamMod From 96f8d3426ba470e127847aadfb758603a9246153 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 27 Nov 2019 09:06:15 -0700 Subject: [PATCH 166/556] more updates to make the driver more flexible and start cleaning up the Makefile --- lilac/atm_driver/Makefile | 30 ++---- lilac/atm_driver/atm_driver.F90 | 133 ++++++++++++++--------- lilac/atm_driver/atm_driver_in | 16 +++ lilac/atm_driver/cheyenne.sub | 2 +- lilac/atm_driver/namelist_lilac | 10 -- lilac/lilac/lilac_atmcap.F90 | 92 ++++++++-------- lilac/lilac/lilac_cpl.F90 | 4 - lilac/lilac/lilac_mod.F90 | 181 ++++++++++++++++---------------- lilac/lilac/lilac_utils.F90 | 7 +- 9 files changed, 244 insertions(+), 231 deletions(-) create mode 100644 lilac/atm_driver/atm_driver_in delete mode 100644 lilac/atm_driver/namelist_lilac diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index ee3fb76810..860c6743d7 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -1,32 +1,14 @@ - #================================================================================ # Makefile to compile the lilac program #================================================================================ ## This is temporary Makefile for building lilac against CTSM pre-compiled library - - #================================================================================ ### Finding and including esmf.mk #================================================================================ -# Note: This fully portable Makefile template depends on finding environment -# # variable "ESMFMKFILE" set to point to the appropriate "esmf.mk" file, -# # as is discussed in the User's Guide. -# # However, you can still use this Makefile template even if the person -# # that installed ESMF on your system did not provide for a mechanism to -# # automatically set the environment variable "ESMFMKFILE". In this case -# # either manually set "ESMFMKFILE" in your environment or hard code the -# # location of "esmf.mk" into the include statement below. -# # Notice that the latter approach has negative impact on flexibility and -# # portability. - - -#ifneq ($(origin ESMFMKFILE), environment) -#$(error Environment variable ESMFMKFILE was not set.) -#endif - -ESMFMKFILE = /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libO/Linux.intel.64.mpt.default/esmf.mk +ESMFMKFILE = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default/esmf.mk +ESMF_LIB_DIR = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default include $(ESMFMKFILE) #================================================================================ @@ -35,15 +17,15 @@ include $(ESMFMKFILE) # Temporarily hard-coded # TODO: Please fix this part. CASE_NAME = why01-g -CTSM_BLD_DIR = /glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf +CTSM_BLD_DIR = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf CTSM_INC = -I$(CTSM_BLD_DIR)/include CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm #TRACEBACK_FLAGS = -g -traceback -debug all -check all -O2 -r8 TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free # ----------------------------------------------------------------------------- -EXTRA_LIBS = -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -lcsm_share -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib -MORE_LIBS = -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/clm/obj/ -I//glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ +EXTRA_LIBS = -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -lcsm_share -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib +MORE_LIBS = -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/clm/obj/ -I//glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ # ----------------------------------------------------------------------------- DRIVER_DIR = $(CURDIR) @@ -110,7 +92,7 @@ lilac_atmcap.o: lilac_utils.o .PHONY: clean berzerk remake clean: - rm -f *.exe *.o + rm -f *.exe *.o *.mod *.optr* berzerk: rm -f PET*.ESMF_LogFile job_name* *.o *.mod *.exe remake: diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 7a264b7eb9..32d42f18f9 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -13,42 +13,54 @@ program atm_driver ! lilac (not an ESMF gridded component!) ! | |________________________.____________.......... gridded components ! | | | - ! ESMF lilac_atmcap ESMF land cap ESMF river cap - ! | | - ! CTSM Mizzouroute... + ! ESMF lilac_atmcap ESMF CTSM cap ESMF river cap (Mizzouroute, Mosart) !---------------------------------------------------------------------------- use lilac_mod , only : lilac_init, lilac_run, lilac_final - use lilac_utils , only : lilac_atm2lnd, lilac_lnd2atm, gindex_atm + use lilac_utils , only : lilac_atm2lnd, lilac_lnd2atm + use shr_sys_mod , only : shr_sys_abort use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS implicit none - integer :: comp_comm - integer :: ierr - real , allocatable :: centerCoords(:,:) - real , allocatable :: lon(:), lat(:) - integer :: mytask, ntasks - integer :: my_start, my_end - integer :: i_local, i_global - integer :: nlocal, nglobal - integer :: start_time !-- start_time start time - integer :: end_time !-- end_time end time - integer :: curr_time !-- cur_time current time - integer :: itime_step !-- itime_step counter of time steps - integer :: g,i,k !-- indices - character(len=128) :: filename + integer :: comp_comm + integer :: ierr + real , allocatable :: centerCoords(:,:) + real , allocatable :: lon(:), lat(:) + integer , allocatable :: atm_global_index(:) + integer :: mytask, ntasks + integer :: my_start, my_end + integer :: i_local, i_global + integer :: nlocal, nglobal + integer :: nstep ! time step counter + integer :: g,i,k ! indices + integer :: fileunit ! for namelist input + + ! Namelist and related variables + character(len=512) :: atm_mesh_filename + character(len=128) :: atm_calendar + integer :: atm_timestep + integer :: atm_start_year ! (yyyy) + integer :: atm_start_mon ! (mm) + integer :: atm_start_day + integer :: atm_start_secs + integer :: atm_stop_year ! (yyyy) + integer :: atm_stop_mon ! (mm) + integer :: atm_stop_day + integer :: atm_stop_secs + integer :: atm_timestep_start ! for internal time loop only + integer :: atm_timestep_stop ! for internal time loop only + + namelist /lilac_input/ atm_mesh_filename, atm_calendar, atm_timestep, & + atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & + atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, & + atm_timestep_start, atm_timestep_stop !------------------------------------------------------------------------ - start_time = 1 - end_time = 48 - !----------------------------------------------------------------------------- ! Initiallize MPI !----------------------------------------------------------------------------- - write(*, *) "MPI initialization starts ..." - call MPI_init(ierr) if (ierr .ne. MPI_SUCCESS) then print *,'Error starting MPI program. Terminating.' @@ -63,13 +75,33 @@ program atm_driver print *, "MPI initialization done ..., ntasks=", ntasks end if + !----------------------------------------------------------------------------- + ! Read in namelist file ... + !----------------------------------------------------------------------------- + + if (mytask == 0) then + print *,"---------------------------------------" + print *, "MPI initialized in atm_driver ..." + end if + + ! The following will read this on all processors - might want to do a read just on the + ! master processor and broadcast in the future + + open(newunit=fileunit, status="old", file="atm_driver_in") + read(fileunit, lilac_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of atm_driver_in') + end if + close(fileunit) + !----------------------------------------------------------------------------- ! Read mesh file to get number of points (n_points) !----------------------------------------------------------------------------- - filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - call read_netcdf_mesh(filename, nglobal) + + call read_netcdf_mesh(atm_mesh_filename, nglobal) if (mytask == 0 ) then - print *, "number of global points is is:", nglobal + print *, " atm_driver mesh file ",trim(atm_mesh_filename) + print *, "number of global points in mesh is:", nglobal end if !----------------------------------------------------------------------------- @@ -85,11 +117,11 @@ program atm_driver end if my_end = my_start + nlocal - 1 - allocate(gindex_atm(nlocal)) + allocate(atm_global_index(nlocal)) i_global = my_start do i_local = 1, nlocal - gindex_atm(i_local) = i_global + atm_global_index(i_local) = i_global i_global = i_global + 1 end do @@ -97,7 +129,12 @@ program atm_driver ! Initialize lilac !------------------------------------------------------------------------ - call lilac_init(nlocal) + if (mytask == 0 ) then + print *, " initializing lilac " + end if + call lilac_init(atm_global_index, atm_mesh_filename, atm_calendar, atm_timestep, & + atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & + atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs) !------------------------------------------------------------------------ ! Fill in atm2lnd type pointer data @@ -107,7 +144,7 @@ program atm_driver allocate(lon(nlocal)) allocate(lat(nlocal)) do i = 1,nlocal - i_global = gindex_atm(i) + i_global = atm_global_index(i) lon(i) = centerCoords(1,i_global) lon(i) = real(nint(lon(i))) ! rounding to nearest int lat(i) = centerCoords(2,i_global) @@ -121,10 +158,8 @@ program atm_driver ! Run lilac !------------------------------------------------------------------------ - itime_step = 1 - do curr_time = start_time, end_time + do nstep = atm_timestep_start, atm_timestep_stop call lilac_run( ) - itime_step = itime_step + 1 end do !------------------------------------------------------------------------ @@ -154,7 +189,7 @@ subroutine read_netcdf_mesh(filename, nglobal) ! local Variables integer :: idfile - integer :: ierror + integer :: ierr integer :: dimid_elem integer :: dimid_coordDim integer :: iddim_elem @@ -166,20 +201,20 @@ subroutine read_netcdf_mesh(filename, nglobal) !----------------------------------------------------------------------------- ! Open mesh file and get the idfile - ierror = nf90_open(filename, NF90_NOWRITE, idfile) - call nc_check_err(ierror, "opening file", filename) + ierr = nf90_open(filename, NF90_NOWRITE, idfile) + call nc_check_err(ierr, "opening file", filename) ! Get the dimid of dimensions - ierror = nf90_inq_dimid(idfile, 'elementCount', dimid_elem) - call nc_check_err(ierror, "inq_dimid elementCount", filename) - ierror = nf90_inq_dimid(idfile, 'coordDim', dimid_coordDim) - call nc_check_err(ierror, "coordDim", filename) + ierr = nf90_inq_dimid(idfile, 'elementCount', dimid_elem) + call nc_check_err(ierr, "inq_dimid elementCount", filename) + ierr = nf90_inq_dimid(idfile, 'coordDim', dimid_coordDim) + call nc_check_err(ierr, "coordDim", filename) ! Inquire dimensions based on their dimeid(s) - ierror = nf90_inquire_dimension(idfile, dimid_elem, string, nelem) - call nc_check_err(ierror, "inq_dim elementCount", filename) - ierror = nf90_inquire_dimension(idfile, dimid_coordDim, string, coordDim) - call nc_check_err(ierror, "inq_dim coordDim", filename) + ierr = nf90_inquire_dimension(idfile, dimid_elem, string, nelem) + call nc_check_err(ierr, "inq_dim elementCount", filename) + ierr = nf90_inquire_dimension(idfile, dimid_coordDim, string, coordDim) + call nc_check_err(ierr, "inq_dim coordDim", filename) if (mytask == 0 ) then print *, "=======================================" @@ -191,10 +226,10 @@ subroutine read_netcdf_mesh(filename, nglobal) ! Get coordinate values allocate (centerCoords(coordDim, nelem)) - ierror = nf90_inq_varid(idfile, 'centerCoords' , idvar_centerCoords) - call nc_check_err(ierror, "inq_varid centerCoords", filename) - ierror = nf90_get_var(idfile, idvar_CenterCoords, centerCoords, start=(/1,1/), count=(/coordDim, nelem/)) - call nc_check_err(ierror,"get_var CenterCoords", filename) + ierr = nf90_inq_varid(idfile, 'centerCoords' , idvar_centerCoords) + call nc_check_err(ierr, "inq_varid centerCoords", filename) + ierr = nf90_get_var(idfile, idvar_CenterCoords, centerCoords, start=(/1,1/), count=(/coordDim, nelem/)) + call nc_check_err(ierr,"get_var CenterCoords", filename) nglobal = nelem @@ -291,7 +326,7 @@ subroutine lilac_to_atm () real*8, allocatable :: data(:) ! -------------------------------------------- - lsize = size(gindex_atm) + lsize = size(atm_global_index) allocate(data(lsize)) call lilac_lnd2atm('Sl_lfrin' , data) diff --git a/lilac/atm_driver/atm_driver_in b/lilac/atm_driver/atm_driver_in new file mode 100644 index 0000000000..ba32e9e528 --- /dev/null +++ b/lilac/atm_driver/atm_driver_in @@ -0,0 +1,16 @@ +&lilac_input + atm_start_year = 2000 + atm_start_mon = 1 + atm_start_day = 1 + atm_start_secs = 0 + atm_stop_year = 2000 + atm_stop_mon = 1 + atm_stop_day = 2 + atm_stop_secs = 0 + atm_timestep = 1800 + atm_calendar = 'NOLEAP' + atm_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + atm_timestep_start = 1 + atm_timestep_stop = 48 + +/ diff --git a/lilac/atm_driver/cheyenne.sub b/lilac/atm_driver/cheyenne.sub index fab83413c0..4733e8ae3e 100644 --- a/lilac/atm_driver/cheyenne.sub +++ b/lilac/atm_driver/cheyenne.sub @@ -36,4 +36,4 @@ setenv UGCSFIXEDFILEPATH /glade/work/turuncu/FV3GFS/fix_am setenv UGCSADDONPATH /glade/work/turuncu/FV3GFS/addon #setenv MPI_USE_ARRAY false -mpiexec_mpt ./atm_driver.exe +mpiexec_mpt -p "%g:" ./atm_driver.exe diff --git a/lilac/atm_driver/namelist_lilac b/lilac/atm_driver/namelist_lilac deleted file mode 100644 index d766ab7ef7..0000000000 --- a/lilac/atm_driver/namelist_lilac +++ /dev/null @@ -1,10 +0,0 @@ -&input - s_month = 5, - s_day = 15, - s_hour = 9, - s_min = 0, - e_month = 5, - e_day = 15, - e_hour = 9, - e_min = 30 -/ diff --git a/lilac/lilac/lilac_atmcap.F90 b/lilac/lilac/lilac_atmcap.F90 index 3fbd3bb189..2909dfdbab 100644 --- a/lilac/lilac/lilac_atmcap.F90 +++ b/lilac/lilac/lilac_atmcap.F90 @@ -7,29 +7,26 @@ module lilac_atmcap ! !USES use ESMF - use lilac_utils , only : atm2lnd, lnd2atm, gindex_atm + use lilac_utils , only : atm2lnd, lnd2atm, gindex_atm, atm_mesh_filename implicit none - include 'mpif.h' + public :: lilac_atmos_register - public :: atmos_register - - integer :: mytask - character(*), parameter :: modname = "atmos_cap" - integer, parameter :: debug = 0 ! internal debug level + integer :: mytask + integer, parameter :: debug = 0 ! internal debug level !======================================================================== contains !======================================================================== - subroutine atmos_register (comp, rc) + subroutine lilac_atmos_register (comp, rc) type(ESMF_GridComp) :: comp ! must not be optional integer, intent(out) :: rc ! local variables type(ESMF_VM) :: vm - character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' + character(len=*), parameter :: subname='(lilac_atmos_register): ' !------------------------------------------------------------------------- call ESMF_VMGetGlobal(vm=vm, rc=rc) @@ -45,67 +42,58 @@ subroutine atmos_register (comp, rc) rc = ESMF_SUCCESS ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=lilac_atmos_init, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_run, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=lilac_atmos_run, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=lilac_atmos_final, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end subroutine atmos_register + end subroutine lilac_atmos_register !======================================================================== - subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) + subroutine lilac_atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! input/output variables - type (ESMF_GridComp) :: comp - type (ESMF_State) :: lnd2atm_a_state, atm2lnd_a_state - type (ESMF_Clock) :: clock - integer, intent(out) :: rc + type (ESMF_GridComp) :: comp + type (ESMF_State) :: lnd2atm_a_state, atm2lnd_a_state + type (ESMF_Clock) :: clock + integer, intent(out) :: rc ! local variables - type(ESMF_Mesh) :: atmos_mesh - type(ESMF_DistGrid) :: atmos_distgrid + type(ESMF_Mesh) :: atm_mesh + type(ESMF_DistGrid) :: atm_distgrid type(ESMF_Field) :: field type(ESMF_FieldBundle) :: c2a_fb , a2c_fb - character(len=ESMF_MAXSTR) :: atmos_mesh_filepath - integer :: n, i, myid - integer :: mpierror, numprocs - integer :: petCount, localrc, urc - character(*),parameter :: F02 = "('[atmos_cap]',a,i5,2x,d26.19)" - character(len=*), parameter :: subname=trim(modname)//': [atmos_init] ' + integer :: n, i + character(len=*), parameter :: subname='(lilac_atmos_init): ' !------------------------------------------------------------------------- ! Initialize return code rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) - call ESMF_GridCompGet (comp, petcount=petcount, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) !------------------------------------------------------------------------- - ! Read in the mesh + ! Read in the atm mesh !------------------------------------------------------------------------- - ! TODO: use ESMF VM calls - call MPI_Comm_size(MPI_COMM_WORLD, numprocs, mpierror) - call MPI_Comm_rank(MPI_COMM_WORLD, myid, mpierror) - - atmos_mesh_filepath = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + ! Note that in the call to lilac_atm the host atmospere sent both the gindex_atm and + ! the atm_mesh_filename that were then set as module variables in lilac_utils - atmos_distgrid = ESMF_DistGridCreate (arbSeqIndexList=gindex_atm, rc=rc) + atm_distgrid = ESMF_DistGridCreate (arbSeqIndexList=gindex_atm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - atmos_mesh = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, & - elementDistGrid=atmos_distgrid, rc=rc) + atm_mesh = ESMF_MeshCreate(filename=trim(atm_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + elementDistGrid=atm_distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//"Mesh for atmosphere is created for "//trim(atm_mesh_filename), ESMF_LOGMSG_INFO) if (mytask == 0) then - !print *, "!Mesh for atmosphere is created!" + print *, trim(subname) // "Mesh for atmosphere is created for "//trim(atm_mesh_filename) end if !------------------------------------------------------------------------- @@ -121,7 +109,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! create fields and add to field bundle do n = 1, size(atm2lnd) - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & + field = ESMF_FieldCreate(atm_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & name=trim(atm2lnd(n)%fldname), farrayPtr=atm2lnd(n)%dataptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) @@ -154,7 +142,7 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! create fields and add to field bundle do n = 1, size(lnd2atm) - field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & + field = ESMF_FieldCreate(atm_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & name=trim(lnd2atm(n)%fldname), farrayPtr=lnd2atm(n)%dataptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) @@ -174,11 +162,11 @@ subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! Set Attributes needed by land call ESMF_AttributeSet(lnd2atm_a_state, name="nextsw_cday", value=11, rc=rc) ! TODO: mv what in the world is this??? - end subroutine atmos_init + end subroutine lilac_atmos_init !======================================================================== - subroutine atmos_run(comp, importState, exportState, clock, rc) + subroutine lilac_atmos_run(comp, importState, exportState, clock, rc) ! input/output variables type(ESMF_GridComp) :: comp @@ -187,25 +175,29 @@ subroutine atmos_run(comp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - character(len=*), parameter :: subname=trim(modname)//': [atmos_run] ' + character(len=*), parameter :: subname='(lilac_atmos_run):' ! Initialize return code rc = ESMF_SUCCESS call ESMF_LogWrite(subname//"Should atmos_run ", ESMF_LOGMSG_INFO) - end subroutine atmos_run + end subroutine lilac_atmos_run !======================================================================== - subroutine atmos_final(comp, importState, exportState, clock, rc) + subroutine lilac_atmos_final(comp, importState, exportState, clock, rc) + + ! input/output variables type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc - character(len=*), parameter :: subname=trim(modname)//': [atmos_final] ' - type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + character(len=*), parameter :: subname='( lilac_atmos_final): ' + !------------------------------------------------------------------------- ! Initialize return code rc = ESMF_SUCCESS @@ -221,6 +213,6 @@ subroutine atmos_final(comp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"?? Are there any other thing for destroying in atmos_final??", ESMF_LOGMSG_INFO) - end subroutine atmos_final + end subroutine lilac_atmos_final end module lilac_atmcap diff --git a/lilac/lilac/lilac_cpl.F90 b/lilac/lilac/lilac_cpl.F90 index b88b4e361a..c28de3c7e3 100644 --- a/lilac/lilac/lilac_cpl.F90 +++ b/lilac/lilac/lilac_cpl.F90 @@ -8,9 +8,6 @@ module lilac_cpl use ESMF implicit none - - include 'mpif.h' !TODO: remove this and use ESMF - private public :: cpl_atm2lnd_register @@ -44,7 +41,6 @@ subroutine cpl_atm2lnd_register(cplcomp, rc) call ESMF_VMGet(vm, localPet=mytask, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - print *,'mytask= ',mytask if (mytask == 0) then print *, "in cpl_atm2lnd_register routine" end if diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 25a72c6287..84dbda6ef5 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -11,13 +11,8 @@ module lilac_mod public :: lilac_run ! Clock, TimeInterval, and Times - type(ESMF_Clock) :: clock - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime - type(ESMF_Time) :: stopTime - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar),target :: calendar - integer :: yy,mm,dd,sec + type(ESMF_Clock) :: lilac_clock + type(ESMF_Calendar),target :: lilac_calendar ! Gridded Components and Coupling Components type(ESMF_GridComp) :: atm_gcomp @@ -34,38 +29,52 @@ module lilac_mod contains !======================================================================== - subroutine lilac_init(lsize) + subroutine lilac_init(atm_global_index, atm_mesh_filepath, atm_calendar, atm_timestep, & + atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & + atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs) ! -------------------------------------------------------------------------------- ! This is called by the host atmosphere ! -------------------------------------------------------------------------------- - use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd + use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd, gindex_atm, atm_mesh_filename use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register - use lilac_atmcap , only : atmos_register + use lilac_atmcap , only : lilac_atmos_register use lnd_comp_esmf , only : lnd_register !ctsm routine use shr_pio_mod , only : shr_pio_init1 ! input/output variables - integer, intent(in) :: lsize + ! input/output variables + integer , intent(in) :: atm_global_index(:) + character(len=*) , intent(in) :: atm_mesh_filepath + character(len=*) , intent(in) :: atm_calendar + integer , intent(in) :: atm_timestep + integer , intent(in) :: atm_start_year !(yyyy) + integer , intent(in) :: atm_start_mon !(mm) + integer , intent(in) :: atm_start_day + integer , intent(in) :: atm_start_secs + integer , intent(in) :: atm_stop_year !(yyyy) + integer , intent(in) :: atm_stop_mon !(mm) + integer , intent(in) :: atm_stop_day + integer , intent(in) :: atm_stop_secs ! local variables + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_Time) :: stopTime + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + integer :: yy,mm,dd,sec + integer :: lsize type(ESMF_State) :: importState, exportState type(ESMF_VM) :: vm integer :: rc character(len=ESMF_MAXSTR) :: cname !components or cpl names - integer :: COMP_COMM integer :: ierr integer :: mpic ! mpi communicator integer :: n, i integer :: fileunit integer, parameter :: debug = 1 !-- internal debug level character(len=*), parameter :: subname=trim(modname)//': [lilac_init] ' - - ! Namelist and related variables - integer :: s_month, s_day, s_hour, s_min - integer :: e_month, e_day, e_hour, e_min - namelist /input/ s_month, s_day, s_hour, s_min, e_month, e_day, e_hour, e_min !------------------------------------------------------------------------ ! Initialize return code @@ -94,47 +103,38 @@ subroutine lilac_init(lsize) call shr_pio_init1(ncomps=1, nlfilename="drv_in", Global_Comm=mpic) ! TODO: make the filename lilac_in - ! Initialize atm2lnd and lnd2atm data types - call lilac_init_atm2lnd(lsize) - call lilac_init_lnd2atm(lsize) - - !------------------------------------------------------------------------- - ! Read in configuration data -- namelist.input from host atmosphere(wrf) - !------------------------------------------------------------------------- - - ! Read in namelist file ... + ! Initialize lilac_util module variable gindex_atm + lsize = size(atm_global_index) + allocate(gindex_atm(lsize)) + gindex_atm(:) = atm_global_index(:) - if (mytask == 0) then - print *, "---------------------------------------" - end if + ! Initialize lilac_util module variable for atm mesh file + atm_mesh_filename = atm_mesh_filepath - ! TODO: put checks for error below - ! TODO: only the master lilac proc should read the namelist file and do a broadcast to the - ! other processors - open(newunit=fileunit, status="old", file="namelist_lilac", action="read", iostat=rc) - read(fileunit, input) - close(fileunit) + ! Initialize lilac_util module data atm2lnd and lnd2atm + call lilac_init_atm2lnd(lsize) + call lilac_init_lnd2atm(lsize) !------------------------------------------------------------------------- - ! Create Gridded Component! -- atmosphere ( atmos_cap) + ! Create Gridded Component -- lilac atmos_cap !------------------------------------------------------------------------- - cname = " Atmosphere or Atmosphere Cap" + cname = " LILAC atm cap " atm_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "Atmosphere Gridded Component Created!" + print *, trim(subname) // "lilac atm cap gridded component created" end if !------------------------------------------------------------------------- - ! Create Gridded Component! --- CTSM land ( land_capX ) + ! Create Gridded Component -- CTSM land !------------------------------------------------------------------------- - cname = " Land ctsm " + cname = " CTSM " lnd_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, " Land (ctsm) Gridded Component Created!" + print *, trim(subname) // " ctsm gridded component created" end if !------------------------------------------------------------------------- @@ -145,7 +145,7 @@ subroutine lilac_init(lsize) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "1st Coupler Component (atmosphere to land ) Created!" + print *, trim(subname) // " coupler component (atmosphere to land) created" end if !------------------------------------------------------------------------- @@ -156,17 +156,17 @@ subroutine lilac_init(lsize) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "2nd Coupler Component (land to atmosphere) Created!" + print *, trim(subname) // " coupler component (land to atmosphere) created" end if !------------------------------------------------------------------------- ! Register section -- set services -- atmos_cap !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(atm_gcomp, userRoutine=atmos_register, rc=rc) + call ESMF_GridCompSetServices(atm_gcomp, userRoutine=lilac_atmos_register, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//" atmos SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, " Atmosphere Gridded Component SetServices finished!" + print *, trim(subname) // " lilac atm cap setservices finished" end if !------------------------------------------------------------------------- @@ -176,7 +176,7 @@ subroutine lilac_init(lsize) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "Land Gridded Component SetServices finished!" + print *, trim(subname) // " CTSM setservices finished" end if !------------------------------------------------------------------------- @@ -186,7 +186,7 @@ subroutine lilac_init(lsize) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "Coupler from atmosphere to land SetServices finished!" + print *, trim(subname) // " coupler from atmosphere to land setservices finished" end if !------------------------------------------------------------------------- @@ -196,40 +196,43 @@ subroutine lilac_init(lsize) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "Coupler from land to atmosphere SetServices finished!" + print *, trim(subname) // " coupler from land to atmosphere setservices finished" end if + + !------------------------------------------------------------------------- + ! Create and initialize the lilac_clock and calendar !------------------------------------------------------------------------- - ! Create and initialize a clock! - ! Clock is initialized here from namelist.input from WRF..... still we - ! are looping over time from host atmosphere - !------------------------------------------------------------------------- - calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeIntervalSet(TimeStep, s=2, rc=rc) ! time step every 2second - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - !call ESMF_TimeSet(startTime, yy=2003, mm=s_month, dd=s_day, h=s_hour, m=s_min, s=0, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - !call ESMF_TimeSet(stopTime, yy=2003, mm=e_month, dd=e_day, h=e_hour, m=e_min, s=0, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1 , s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=03, dd=01, s=0, calendar=Calendar, rc=rc) - !call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=1800, rc=rc) - clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, & - RefTime=StartTime, stopTime=stopTime, rc=rc) - if (mytask == 0) then - print *, "---------------------------------------" - end if - !call ESMF_ClockPrint (clock, rc=rc) - if (mytask == 0) then - print *, "=======================================" + if (trim(atm_calendar) == 'NOLEAP') then + lilac_calendar = ESMF_CalendarCreate(name='NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + else if (trim(atm_calendar) == 'GREGORIAN') then + lilac_calendar = ESMF_CalendarCreate(name='NOLEAP', calkindflag=ESMF_CALKIND_GREGORIAN, rc=rc ) + else + ! TODO: add supported calendars here end if - !call ESMF_CalendarPrint ( calendar , rc=rc) + + call ESMF_TimeIntervalSet(TimeStep, s=atm_timestep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_TimeSet(StartTime, yy=atm_start_year, mm=atm_start_mon, dd=atm_start_day , s=atm_start_secs, & + calendar=lilac_calendar, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_TimeSet(StopTime , yy=atm_stop_year , mm=atm_stop_mon , dd=atm_stop_day , s=atm_stop_secs , & + calendar=lilac_calendar, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + lilac_clock = ESMF_ClockCreate(name='lilac_clock', TimeStep=TimeStep, startTime=StartTime, & + RefTime=StartTime, stopTime=stopTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (mytask == 0) then - print *, "---------------------------------------" + print *, trim(subname) // "---------------------------------------" + call ESMF_ClockPrint (lilac_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_CalendarPrint (lilac_calendar , rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + print *, trim(subname) // "---------------------------------------" end if ! ------------------------------------------------------------------------- @@ -243,7 +246,7 @@ subroutine lilac_init(lsize) lnd2atm_a_state = ESMF_StateCreate(name='lnd_state_on_lnd_mesh', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridCompInitialize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + call ESMF_GridCompInitialize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=lilac_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp initialized", ESMF_LOGMSG_INFO) @@ -260,7 +263,7 @@ subroutine lilac_init(lsize) lnd2atm_l_state = ESMF_StateCreate(name='lnd_state_on_atm_mesh', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridCompInitialize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + call ESMF_GridCompInitialize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=lilac_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp initialized", ESMF_LOGMSG_INFO) @@ -270,18 +273,18 @@ subroutine lilac_init(lsize) ! Initialze LILAC coupler components ! ------------------------------------------------------------------------- - call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=lilac_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "coupler :: cpl_atm2lnd_comp initialize finished" !, rc =", rc + print *, trim(subname) // "coupler :: cpl_atm2lnd_comp initialize finished" !, rc =", rc end if - call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=lilac_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "coupler :: cpl_lnd2atm_comp initialize finished" !, rc =", rc + print *, trim(subname) // "coupler :: cpl_lnd2atm_comp initialize finished" !, rc =", rc end if end subroutine lilac_init @@ -310,22 +313,18 @@ subroutine lilac_run( ) ! Create a local clock from the general clock! !------------------------------------------------------------------------- - local_clock = ESMF_ClockCreate(clock, rc=rc) + local_clock = ESMF_ClockCreate(lilac_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (mytask == 0) then print *, "Run Loop Start time" end if - !call ESMF_ClockPrint(local_clock, options="currtime string", rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return !------------------------------------------------------------------------- ! We are running components in this order: ! 1- atmos_cap 2- cpl_atm2lnd! 3- lnd_cap 4- cpl_lnd2atm !------------------------------------------------------------------------- - ! if we want to loop through clock in atmos cap. - !do while (.NOT. ESMF_ClockIsStopTime(local_clock, rc=rc)) call ESMF_GridCompRun(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, & clock=local_clock, rc=rc, userRC=userRC) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -395,7 +394,7 @@ subroutine lilac_final( ) !------------------------------------------------------------------------- ! Gridded Component Finalizing! --- atmosphere !------------------------------------------------------------------------- - call ESMF_GridCompFinalize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + call ESMF_GridCompFinalize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=lilac_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp is running", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -405,7 +404,7 @@ subroutine lilac_final( ) !------------------------------------------------------------------------- ! Coupler component Finalizing --- coupler atmos to land !------------------------------------------------------------------------- - call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=lilac_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -415,7 +414,7 @@ subroutine lilac_final( ) !------------------------------------------------------------------------- ! Gridded Component Finalizing! --- land !------------------------------------------------------------------------- - call ESMF_GridCompFinalize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + call ESMF_GridCompFinalize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=lilac_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp is running", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -425,7 +424,7 @@ subroutine lilac_final( ) !------------------------------------------------------------------------- ! Coupler component Finalizing --- coupler land to atmos !------------------------------------------------------------------------- - call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=lilac_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 index 7bce4b8f99..1012654080 100644 --- a/lilac/lilac/lilac_utils.F90 +++ b/lilac/lilac/lilac_utils.F90 @@ -9,11 +9,14 @@ module lilac_utils public :: lilac_atm2lnd public :: lilac_lnd2atm + ! the HOST ATMOSPHERE atm sends gindex_atm and atm_mesh_filename via the inputs to lilac_init + ! Global index space info for atm data - ! the HOST ATMOSPHERE is also responsible for filling in the gindex information - ! this is used to create the distgrid for the mesh in lilac *** integer, public, allocatable :: gindex_atm (:) + ! Mesh file to be read in by lilac_atm + character(len=256), public :: atm_mesh_filename + type :: atm2lnd_type character(len=128) :: fldname real*8, pointer :: dataptr(:) From a136950318dbb51ceac2942a5d049c8430067c0c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 27 Nov 2019 10:54:56 -0700 Subject: [PATCH 167/556] updates to caps including removal of commented code that will not be used --- src/cpl/lilac/for_negin | 19 - src/cpl/lilac/lnd_comp_esmf.F90 | 1934 +++++++++++++-------------- src/cpl/lilac/lnd_import_export.F90 | 787 ++--------- src/cpl/lilac/lnd_shr_methods.F90 | 581 +------- src/cpl/lilac/shr_utils_mod.F90 | 47 - 5 files changed, 1036 insertions(+), 2332 deletions(-) delete mode 100644 src/cpl/lilac/for_negin delete mode 100644 src/cpl/lilac/shr_utils_mod.F90 diff --git a/src/cpl/lilac/for_negin b/src/cpl/lilac/for_negin deleted file mode 100644 index c5986a0408..0000000000 --- a/src/cpl/lilac/for_negin +++ /dev/null @@ -1,19 +0,0 @@ - ! Initialize PIO - - integer, pointer :: comms(:), comps(:) - character(len=32), allocatable :: compLabels(:) - logical, allocatable :: comp_iamin(:) - integer, allocatable :: comp_comm_iam(:) - - allocate(comms(1), comps(1), compLabels(1), comp_iamin(1), comp_comm_iam(1)) - - comms(1) = Global_Comm - comps(1) = 1 - compLabels(1) = 'lnd' - comp_iamin(1) = .true. - - call ESMF_VMGet(vm, mpiCommunicator=comms(1), localPet=comp_comm_iam(1), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call shr_pio_init2(comps, compLabel, comp_iamin, comms, comp_comm_iam) - diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index ddf03eb6a8..87db539ad6 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -1,1102 +1,1030 @@ module lnd_comp_esmf - !---------------------------------------------------------------------------- - ! This is the ESMF cap for CTSM - !---------------------------------------------------------------------------- - use ESMF - use shr_kind_mod , only : shr_kind_r8, SHR_KIND_CL - use shr_string_mod , only : shr_string_listGetNum - use abortutils , only : endrun - use domainMod , only : ldomain - use decompMod , only : ldecomp, bounds_type, get_proc_bounds - use clm_varctl , only : iulog - !use clm_initializeMod , only : lnd2atm_inst, atm2lnd_inst - !use clm_cpl_indices - use lnd_import_export - - use ESMF - use mct_mod , only : mct_world_init, mct_world_clean, mct_die - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl - use shr_sys_mod , only : shr_sys_abort - use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit - use shr_orb_mod , only : shr_orb_decl - use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date - use spmdMod , only : masterproc, mpicom, spmd_init - use decompMod , only : bounds_type, ldecomp, get_proc_bounds - use domainMod , only : ldomain - use controlMod , only : control_setNL - use clm_varorb , only : eccen, obliqr, lambm0, mvelpp - use clm_varctl , only : single_column, clm_varctl_set, iulog - use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch - use clm_time_manager , only : set_timemgr_init, advance_timestep - use clm_time_manager , only : set_nextsw_cday, update_rad_dtime - use clm_time_manager , only : get_nstep, get_step_size - use clm_time_manager , only : get_curr_date, get_curr_calday - use clm_initializeMod , only : initialize1, initialize2 - use clm_driver , only : clm_drv - use perf_mod , only : t_startf, t_stopf, t_barrierf - use lnd_import_export , only : import_fields, export_fields - use lnd_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit - use lnd_shr_methods , only : log_clock_advance - !use lnd_import_export , only : realize_fields - ! !PUBLIC MEMBER FUNCTIONS: - implicit none - private ! By default make data private except - ! - public :: lnd_register ! register clm initial, run, final methods - public :: lnd_init ! clm initialization - public :: lnd_run ! clm run phase - public :: lnd_final ! clm finalization/cleanup - - !NS: from https://github.com/amangupta2/CAM_Trunk/blob/33b0fd4bc2c3b945b93655ee8b5e20f1acf5625b/components/cam/src/cpl/nuopc/atm_comp_nuopc.F90 - !-------------------------------------------------------------------------- - ! Private module data - !-------------------------------------------------------------------------- - - !type fld_list_type - ! character(len=128) :: stdname - !end type fld_list_type - - integer , parameter :: dbug_flag = 6 - type(ESMF_Field), public, save :: field - !type(cam_in_t) , pointer :: cam_in(:) - !type(cam_out_t) , pointer :: cam_out(:) - !integer , pointer :: dof(:) ! global index space decomposition - !integer :: shrlogunit ! original log unit - !integer :: shrloglev ! original log level - !character(len=256) :: rsfilename_spec_cam ! Filename specifier for restart surface file - !character(*) ,parameter :: modName = "ctsm_lilac" - !character(*) ,parameter :: u_FILE_u = & - ! __FILE__ - - - - character(len=CL) :: flds_scalar_name = '' - integer :: flds_scalar_num = 0 - integer :: flds_scalar_index_nx = 0 - integer :: flds_scalar_index_ny = 0 - integer :: flds_scalar_index_nextsw_cday = 0 - logical :: glc_present = .false. ! .true. => running with a non-stubGLC model - logical :: rof_prognostic = .false. ! .true. => running with a prognostic ROF model - integer, parameter :: dbug = 1 - !character(*),parameter :: modName = "(lnd_comp_nuopc)" - character(*) ,parameter :: modName = "ctsm_lilac" - character(*),parameter :: u_FILE_u = & + !---------------------------------------------------------------------------- + ! This is the ESMF cap for CTSM + !---------------------------------------------------------------------------- + + use ESMF + use mct_mod , only : mct_world_init, mct_world_clean, mct_die + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use shr_orb_mod , only : shr_orb_decl + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use spmdMod , only : masterproc, mpicom, spmd_init + use decompMod , only : bounds_type, ldecomp, get_proc_bounds + use domainMod , only : ldomain + use controlMod , only : control_setNL + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use clm_varctl , only : single_column, clm_varctl_set, iulog + use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch + use clm_time_manager , only : set_timemgr_init, advance_timestep + use clm_time_manager , only : set_nextsw_cday, update_rad_dtime + use clm_time_manager , only : get_nstep, get_step_size + use clm_time_manager , only : get_curr_date, get_curr_calday + use clm_initializeMod , only : initialize1, initialize2 + use clm_driver , only : clm_drv + use perf_mod , only : t_startf, t_stopf, t_barrierf + use lnd_import_export , only : import_fields, export_fields + use lnd_shr_methods , only : chkerr, state_diagnose + + implicit none + private ! By default make data private except + + public :: lnd_register ! register clm initial, run, final methods + public :: lnd_init ! clm initialization + public :: lnd_run ! clm run phase + public :: lnd_final ! clm finalization/cleanup + + !-------------------------------------------------------------------------- + ! Private module data + !-------------------------------------------------------------------------- + + integer , parameter :: dbug_flag = 6 + type(ESMF_Field), public, save :: field + + logical :: glc_present = .false. ! .true. => running with a non-stubGLC model + logical :: rof_prognostic = .false. ! .true. => running with a prognostic ROF model + integer, parameter :: memdebug_level=1 + integer, parameter :: dbug = 1 + character(*) ,parameter :: modName = "lnd_comp_esmf" + character(*),parameter :: u_FILE_u = & __FILE__! - type(ESMF_Mesh) :: Emesh, EMeshTemp, lnd_mesh ! esmf meshes + type(ESMF_Mesh) :: Emesh, EMeshTemp, lnd_mesh ! esmf meshes + !=============================================================================== contains !=============================================================================== - subroutine lnd_register(comp, rc) - - ! Register the clm initial, run, and final phase methods with ESMF. - - ! input/output argumenents - type(ESMF_GridComp) :: comp ! CLM grid component - integer, intent(out) :: rc ! return status - - ! local variables - character(len=*), parameter :: subname=trim(modname)//': [lnd_register] ' - !----------------------------------------------------------------------- - - print *, "in lnd register routine" - rc = ESMF_SUCCESS - call ESMF_LogSet ( flush =.true.) - call ESMF_LogWrite(subname//"lnd gridcompset entry points setting ....!", ESMF_LOGMSG_INFO) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, lnd_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, lnd_run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, lnd_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_LogWrite(subname//"lnd gridcompset entry points finished!", ESMF_LOGMSG_INFO) - end subroutine lnd_register - - !=============================================================================== - - subroutine lnd_init(comp, import_state, export_state, clock, rc) - - ! Initialize land surface model and obtain relevant atmospheric model arrays - ! back from (i.e. albedos, surface temperature and snow cover over land). - - use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel - use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel - use shr_file_mod , only : shr_file_getUnit, shr_file_setIO - use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, set_nextsw_cday - !use clm_initializeMod, only : initialize1, initialize2, lnd2atm_inst, lnd2glc_inst - use clm_initializeMod, only : initialize1, initialize2 - use clm_varctl , only : finidat,single_column, clm_varctl_set, noland - - use clm_varctl , only : inst_index, inst_suffix, inst_name - use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch - use clm_varorb , only : eccen, obliqr, lambm0, mvelpp - use controlMod , only : control_setNL - use spmdMod , only : masterproc, spmd_init - !NS - use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst - use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE - use shr_pio_mod, only : shr_pio_init1, shr_pio_init2 - use glc_elevclass_mod , only : glc_elevclass_init - use shr_orb_mod , only : shr_orb_params - ! input/output variables - type(ESMF_GridComp) :: comp ! CLM gridded component - type(ESMF_State) :: import_state ! CLM import state - type(ESMF_State) :: export_state ! CLM export state - type(ESMF_Clock) :: clock ! ESMF synchronization clock - integer, intent(out) :: rc ! Return code - - ! local variable - integer :: mpicom_lnd, mpicom_vm, gsize - type(ESMF_ArraySpec) :: arrayspec - type(ESMF_DistGrid) :: distgrid - type(ESMF_Array) :: dom, l2x, x2l - type(ESMF_VM) :: vm - integer :: lsize ! size of attribute vector - integer :: g,i,j ! indices - integer :: dtime_sync ! coupling time-step from the input synchronization clock - integer :: dtime_clm ! clm time-step - logical :: exists ! true if file exists - real(r8) :: nextsw_cday ! calday from clock of next radiation computation - character(len=SHR_KIND_CL) :: caseid ! case identifier name - character(len=SHR_KIND_CL) :: ctitle ! case description title - character(len=SHR_KIND_CL) :: starttype ! start-type (startup, continue, branch, hybrid) - character(len=SHR_KIND_CL) :: calendar ! calendar type name - character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on - character(len=SHR_KIND_CL) :: version ! Model version - character(len=SHR_KIND_CL) :: username ! user running the model - integer :: nsrest ! clm restart type - integer :: ref_ymd ! reference date (YYYYMMDD) - integer :: ref_tod ! reference time of day (sec) - integer :: start_ymd ! start date (YYYYMMDD) - integer :: start_tod ! start time of day (sec) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) - logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type - logical :: atm_aero ! Flag if aerosol data sent from atm model - integer :: lbnum ! input to memory diagnostic - integer :: shrlogunit,shrloglev ! old values for log unit and log level - integer :: logunit ! original log unit - - type(bounds_type) :: bounds ! bounds - integer :: nfields - real(R8), pointer :: fptr(:, :) - character(ESMF_MAXSTR) :: convCIM, purpComp - integer :: ierr - - ! MCT - integer :: ncomps = 1 - integer, pointer :: comps(:) ! array with component ids - integer, pointer :: comms(:) ! array with mpicoms - character(len=32), allocatable :: compLabels(:) - integer,allocatable :: comp_id(:) ! for pio init2 - character(len=64),allocatable :: comp_name(:) ! for pio init2 - integer,allocatable :: comp_comm(:) ! for pio_init2 - logical,allocatable :: comp_iamin(:) ! for pio init2 - integer,allocatable :: comp_comm_iam(:) ! for pio_init2 - - ! - character(len=32), parameter :: sub = 'lnd_init' - character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" - - - integer :: ymd ! CTSM current date (YYYYMMDD) - integer :: orb_iyear_align ! associated with model year - integer :: orb_cyear ! orbital year for current orbital computation - integer :: orb_iyear ! orbital year for current orbital computation - integer :: orb_eccen ! orbital year for current orbital computation - integer :: yy, mm ,dd , curr_tod, curr_ymd ! orbital year for current orbital computation - - !----------------------------------------------------------------------- - ! NS : from - ! https://github.com/amangupta2/CAM_Trunk/blob/33b0fd4bc2c3b945b93655ee8b5e20f1acf5625b/components/cam/src/cpl/nuopc/atm_comp_nuopc.F90 - - !local variables - type(ESMF_Time) :: currTime ! Current time - type(ESMF_Time) :: startTime ! Start time - type(ESMF_Time) :: stopTime ! Stop time - type(ESMF_Time) :: refTime ! Ref time - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Calendar) :: esmf_calendar ! esmf calendar - type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type - !type(ESMF_DistGrid) :: distGrid - !type(ESMF_Field) :: field - - - character(len=*), parameter :: subname=trim(modName)//': [lnd_init_lilac_cap] ' - - ! NS: From : - integer, pointer :: gindex(:) ! global index space for land and ocean points - integer, pointer :: gindex_lnd(:) ! global index space for just land points - integer, pointer :: gindex_ocn(:) ! global index space for just ocean points - character(ESMF_MAXSTR) :: cvalue ! config data - integer :: nlnd, nocn ! local size ofarrays - !integer :: g,n ! indices - integer :: n ! indices - integer :: year, month, day - - - integer :: dtime ! time step increment (sec) - - type(ESMF_FieldBundle) :: c2l_fb - type(ESMF_FieldBundle) :: l2c_fb - - - type(ESMF_State) :: importState, exportState - - - integer :: glc_nec = 10 ! number of glc elevation classes - !! FIXME(ns, 2019-07-29) - !! glc_nec should be set from driver or higher level lilac? - integer :: compid ! component id - !------------------------------------------------------------------------ - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' is called!', ESMF_LOGMSG_INFO) - - !------------------------------------------------------------------------ - ! Initialize clm MPI communicator - !------------------------------------------------------------------------ - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call ESMF_LogWrite(subname//"ESMF_VMGetCurrent", ESMF_LOGMSG_INFO) - call ESMF_VMPrint (vm, rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - call ESMF_LogWrite(subname//"ESMF_VMGet", ESMF_LOGMSG_INFO) - - ! duplicate the mpi communicator from the current VM - call MPI_Comm_dup(mpicom_vm, mpicom_lnd, rc) - call ESMF_LogWrite(subname//"MPI_Comm_dup...", ESMF_LOGMSG_INFO) - - !!!! NS : BOTH MPI_INIT and PIO_INIT1 are in lilac_mod.F90 - - - !------------------------------------------------------------------------ - ! Initialize mct - ! (needed for data models and cice prescribed capability) - ! (needed for data model share code - e.g. nitrogen deposition) - !------------------------------------------------------------------------ - ! TODO: FIX THIS PLEASE!!!! - - allocate(comms(1), comps(1), compLabels(1), comp_iamin(1), comp_comm_iam(1), comp_name(1),stat=ierr) - - comms(1) = mpicom_lnd !or call MPI_Comm_dup(mpicom_vm, comms(1), ierr) - comps(1) = 1 - compLabels(1) = 'LND' - comp_iamin(1) = .true. - comp_name(1) = 'LND' - - call ESMF_VMGet(vm, mpiCommunicator=comms(1), localPet=comp_comm_iam(1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call shr_pio_init2(comps, compLabels, comp_iamin, comms, comp_comm_iam) + subroutine lnd_register(comp, rc) - call ESMF_LogWrite(subname//"after shr_pio_init2", ESMF_LOGMSG_INFO) + ! Register the clm initial, run, and final phase methods with ESMF. - call ESMF_LogWrite(subname//"Now calling mct_world_init", ESMF_LOGMSG_INFO) - call mct_world_init(ncomps, mpicom_lnd, comms, comps) - call ESMF_LogWrite(subname//"mct world initialized! ", ESMF_LOGMSG_INFO) - - !deallocate(comms, comps, compLabels, comp_iamin, comp_comm_iam, comp_name) ??? - - ! Initialize model mpi info - compid = 1 - call spmd_init( mpicom_lnd, compid) - call ESMF_LogWrite(subname//"initialized model mpi info using spmd_init", ESMF_LOGMSG_INFO) - - !------------------------------------------------------------------------ - !--- Log File --- - !------------------------------------------------------------------------ - - inst_name = 'LND' - inst_index = 1 - inst_suffix = "" - - ! Initialize io log unit - !! TODO: Put this in a subroutine..... - call shr_file_getLogUnit (shrlogunit) - if (masterproc) then - inquire(file='lnd_modelio.nml'//trim(inst_suffix),exist=exists) - if (exists) then - iulog = shr_file_getUnit() - call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),iulog) - end if - write(iulog,format) "CLM land model initialization" - else - iulog = shrlogunit - end if - - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (iulog) + ! input/output argumenents + type(ESMF_GridComp) :: comp ! CLM grid component + integer, intent(out) :: rc ! return status - !------------------------------------------------------------------------ - !--- Orbital Values --- - !------------------------------------------------------------------------ + ! local variables + character(len=*), parameter :: subname=trim(modname)//': [lnd_register] ' + !----------------------------------------------------------------------- + print *, "in lnd register routine" + rc = ESMF_SUCCESS + call ESMF_LogSet ( flush =.true.) + call ESMF_LogWrite(subname//"lnd gridcompset entry points setting ....!", ESMF_LOGMSG_INFO) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, lnd_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - ! TODO: orbital values should be provided by lilac - but for now lets use defaults - !! hard wire these these in and we can decide on maybe having a - !namelist/ + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, lnd_run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !call shr_cal_date2ymd(ymd,year,month,day) - !orb_cyear = orb_iyear + (year - orb_iyear_align) - - orb_cyear = 2000 - call shr_orb_params(orb_cyear, eccen, obliqr, mvelpp, & - obliqr, lambm0, mvelpp, masterproc) - - ! for now hard-coding: - !nextsw_cday = 1.02083333333333 - !eccen = 1.670366039276560E-002 - !mvelpp = 4.93745779048816 - !lambm0 = -3.247249566152933E-0020 - !obliqr = 0.409101122579779 - - !if ((debug >1) .and. (masterproc)) then - if (masterproc) then - write(iulog,*) 'shr_obs_params is setting these:', eccen - write(iulog,*) 'eccen is : ', eccen - write(iulog,*) 'mvelpp is : ', mvelpp - - write(iulog,*) 'lambm0 is : ', lambm0 - write(iulog,*) 'obliqr is : ', obliqr - end if - - !---------------------- - ! Consistency check on namelist filename - !---------------------- - call control_setNL("lnd_in") - - !---------------------- - ! Get properties from clock - !---------------------- - - - call ESMF_ClockGet( clock, & - currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, & - timeStep=timeStep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,curr_ymd) - - call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,start_ymd) - - call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,stop_ymd) - - call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,ref_ymd) - - call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (esmf_caltype == ESMF_CALKIND_NOLEAP) then - calendar = shr_cal_noleap - else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then - calendar = shr_cal_gregorian - else - call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) - end if - - ! TODO: how do we set case_name and nsrest - should we hardwire for now? - caseid = 'test_lilac' - nsrest = nsrStartup - call ESMF_LogWrite(subname//"time manager Initialized....", ESMF_LOGMSG_INFO) - - !---------------------- - ! Initialize CTSM time manager - !---------------------- - - call set_timemgr_init( & - calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & - ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, stop_ymd_in=stop_ymd, & - stop_tod_in=stop_tod) - call ESMF_LogWrite(subname//"time manager is set now!", ESMF_LOGMSG_INFO) - - !---------------------- - ! Read namelist, grid and surface data - !---------------------- - - ! set default values for run control variables - call clm_varctl_set(caseid_in=caseid, nsrest_in=nsrest) - call ESMF_LogWrite(subname//"default values for run control variables are set...", ESMF_LOGMSG_INFO) - - - - !---------------------- - ! Initialize glc_elevclass module - !---------------------- - call glc_elevclass_init(glc_nec) - - !---------------------- - ! Initialize1 - !---------------------- - - ! note that the memory for gindex_ocn will be allocated in the following call - call initialize1(gindex_ocn) - ! call initialize1() - - call ESMF_LogWrite(subname//"initialize1 done...", ESMF_LOGMSG_INFO) - - ! obtain global index array for just land points which includes mask=0 or ocean points - call get_proc_bounds( bounds ) - - !print ,* "bound is :", bounds - !print ,* "bounds%begg :", bounds%begg - !print ,* "bounds%endg : ", bounds%endg - nlnd = bounds%endg - bounds%begg + 1 - allocate(gindex_lnd(nlnd)) - !print ,* "nlnd is :", nlnd - do g = bounds%begg,bounds%endg - n = 1 + (g - bounds%begg) - gindex_lnd(n) = ldecomp%gdc2glo(g) - end do - - call ESMF_LogWrite(subname//"obtained global index", ESMF_LOGMSG_INFO) - - ! create a global index that includes both land and ocean points - nocn = size(gindex_ocn) - allocate(gindex(nlnd + nocn)) - do n = 1,nlnd+nocn - if (n <= nlnd) then - gindex(n) = gindex_lnd(n) - else - gindex(n) = gindex_ocn(n-nlnd) - end if - end do - - ! create distGrid from global index array - DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - deallocate(gindex) - call ESMF_LogWrite(subname//"DistGrid created......", ESMF_LOGMSG_INFO) - - !-------------------------------- - ! generate the mesh on ctsm distribution - !-------------------------------- - - ! TODO: mesh file should come into clm as a namelist for lilac only - ! for now need to hardwire this in cvalue here - cvalue = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' ! this will need to be filled in to run - - EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if (masterproc) then - write(iulog,*)'mesh file for domain is ',trim(cvalue) - end if - - ! recreate the mesh using the above distGrid - EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_LogWrite(subname//" Create Mesh using distgrid ....", ESMF_LOGMSG_INFO) - lnd_mesh = EMesh - !-------------------------------- - ! Finish initializing ctsm - !-------------------------------- - call ESMF_LogWrite(subname//"before initialize2", ESMF_LOGMSG_INFO) - - call initialize2() - - call ESMF_LogWrite(subname//"initialize2 done...", ESMF_LOGMSG_INFO) - - !-------------------------------- - ! Check that ctsm internal dtime aligns with ctsm coupling interval - !-------------------------------- - call ESMF_LogWrite(subname//"cheking CTSM dtime and coupling intervals....", ESMF_LOGMSG_INFO) - - call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeIntervalGet( timeStep, s=dtime_sync, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - dtime_clm = get_step_size() + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, lnd_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if (masterproc) then - write(iulog,*)'dtime_sync= ',dtime_sync,' dtime_ctsm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) - end if - if (mod(dtime_sync,dtime_clm) /= 0) then - write(iulog,*)'ctsm dtime ',dtime_clm,' and clock dtime ',dtime_sync,' never align' - rc = ESMF_FAILURE - return - end if + call ESMF_LogWrite(subname//"lnd gridcompset entry points finished!", ESMF_LOGMSG_INFO) + end subroutine lnd_register - !-------------------------------- - ! Create import state (only assume input from atm - not rof and glc) - !-------------------------------- - - c2l_fb = ESMF_FieldBundleCreate ( name='c2l_fb', rc=rc) - - - call fldbundle_add( 'Sa_z' , c2l_fb,rc) !1 - call fldbundle_add( 'Sa_topo' , c2l_fb,rc) !2 - call fldbundle_add( 'Sa_u' , c2l_fb,rc) !3 - call fldbundle_add( 'Sa_v' , c2l_fb,rc) !4 - call fldbundle_add( 'Sa_ptem' , c2l_fb,rc) !5 - call fldbundle_add( 'Sa_pbot' , c2l_fb,rc) !6 - call fldbundle_add( 'Sa_tbot' , c2l_fb,rc) !7 - call fldbundle_add( 'Sa_shum' , c2l_fb,rc) !8 - - call fldbundle_add( 'Faxa_lwdn' , c2l_fb,rc) !9 - call fldbundle_add( 'Faxa_rainc' , c2l_fb,rc) !10 - call fldbundle_add( 'Faxa_rainl' , c2l_fb,rc) !11 - call fldbundle_add( 'Faxa_snowc' , c2l_fb,rc) !12 - call fldbundle_add( 'Faxa_snowl' , c2l_fb,rc) !13 - call fldbundle_add( 'Faxa_swndr' , c2l_fb,rc) !14 - call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) !15 - call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) !16 - call fldbundle_add( 'Faxa_swvdf' , c2l_fb,rc) !17 - call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb/), rc=rc) - - ! Create export state + !=============================================================================== - l2c_fb = ESMF_FieldBundleCreate(name='l2c_fb', rc=rc) - !call fldbundle_add( 'Sl_lfrint' , l2c_fb,rc) !1 - call fldbundle_add( 'Sl_lfrin' , l2c_fb,rc) !1 - call fldbundle_add( 'Sl_t' , l2c_fb,rc) !2 - call fldbundle_add( 'Sl_tref' , l2c_fb,rc) !3 - call fldbundle_add( 'Sl_qref' , l2c_fb,rc) !4 - call fldbundle_add( 'Sl_avsdr' , l2c_fb,rc) !5 - call fldbundle_add( 'Sl_anidr' , l2c_fb,rc) !6 - call fldbundle_add( 'Sl_avsdf' , l2c_fb,rc) !7 - call fldbundle_add( 'Sl_anidf' , l2c_fb,rc) !8 - call fldbundle_add( 'Sl_snowh' , l2c_fb,rc) !9 - call fldbundle_add( 'Fall_u10' , l2c_fb,rc) !10 - call fldbundle_add( 'Fall_fv' , l2c_fb,rc) !11 - call fldbundle_add( 'Fall_ram1' , l2c_fb,rc) !12 - !call fldbundle_add( 'Fall_taux' , l2c_fb,rc) !10 - !call fldbundle_add( 'Fall_lwup' , l2c_fb,rc) !14 - !call fldbundle_add( 'Fall_evap' , l2c_fb,rc) !15 - !call fldbundle_add( 'Fall_swniet' , l2c_fb,rc) !16 - call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb/), rc=rc) - !call ESMF_StateAdd(exportState, fieldbundleList = (/l2c_fb/), rc=rc) + subroutine lnd_init(comp, import_state, export_state, clock, rc) + ! Initialize land surface model and obtain relevant atmospheric model arrays + ! back from (i.e. albedos, surface temperature and snow cover over land). + use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel + use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel + use shr_file_mod , only : shr_file_getUnit, shr_file_setIO + use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, set_nextsw_cday + use clm_initializeMod , only : initialize1, initialize2 + use clm_varctl , only : finidat,single_column, clm_varctl_set, noland + use clm_varctl , only : inst_index, inst_suffix, inst_name + use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use controlMod , only : control_setNL + use spmdMod , only : masterproc, spmd_init + use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE + use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 + use glc_elevclass_mod , only : glc_elevclass_init + use shr_orb_mod , only : shr_orb_params + + ! input/output variables + type(ESMF_GridComp) :: comp ! CLM gridded component + type(ESMF_State) :: import_state ! CLM import state + type(ESMF_State) :: export_state ! CLM export state + type(ESMF_Clock) :: clock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + + ! local variable + integer :: mpicom_lnd, mpicom_vm, gsize + type(ESMF_ArraySpec) :: arrayspec + type(ESMF_DistGrid) :: distgrid + type(ESMF_Array) :: dom, l2x, x2l + type(ESMF_VM) :: vm + integer :: lsize ! size of attribute vector + integer :: g,i,j ! indices + integer :: dtime_sync ! coupling time-step from the input synchronization clock + integer :: dtime_clm ! clm time-step + logical :: exists ! true if file exists + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + character(len=CL) :: caseid ! case identifier name + character(len=CL) :: ctitle ! case description title + character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) + character(len=CL) :: calendar ! calendar type name + character(len=CL) :: hostname ! hostname of machine running on + character(len=CL) :: version ! Model version + character(len=CL) :: username ! user running the model + integer :: nsrest ! clm restart type + integer :: ref_ymd ! reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (sec) + integer :: start_ymd ! start date (YYYYMMDD) + integer :: start_tod ! start time of day (sec) + integer :: stop_ymd ! stop date (YYYYMMDD) + integer :: stop_tod ! stop time of day (sec) + logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type + logical :: atm_aero ! Flag if aerosol data sent from atm model + integer :: lbnum ! input to memory diagnostic + integer :: shrlogunit,shrloglev ! old values for log unit and log level + integer :: logunit ! original log unit + type(bounds_type) :: bounds ! bounds + integer :: nfields + real(R8), pointer :: fptr(:, :) + integer :: ierr + integer :: ncomps = 1 + integer, pointer :: comps(:) ! array with component ids + integer, pointer :: comms(:) ! array with mpicoms + character(len=32), allocatable :: compLabels(:) + integer,allocatable :: comp_id(:) ! for pio init2 + character(len=64),allocatable :: comp_name(:) ! for pio init2 + integer,allocatable :: comp_comm(:) ! for pio_init2 + logical,allocatable :: comp_iamin(:) ! for pio init2 + integer,allocatable :: comp_comm_iam(:) ! for pio_init2 + integer :: ymd ! CTSM current date (YYYYMMDD) + integer :: orb_iyear_align ! associated with model year + integer :: orb_cyear ! orbital year for current orbital computation + integer :: orb_iyear ! orbital year for current orbital computation + integer :: orb_eccen ! orbital year for current orbital computation + integer :: yy, mm ,dd , curr_tod, curr_ymd ! orbital year for current orbital computation + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: startTime ! Start time + type(ESMF_Time) :: stopTime ! Stop time + type(ESMF_Time) :: refTime ! Ref time + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Calendar) :: esmf_calendar ! esmf calendar + type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type + integer, pointer :: gindex(:) ! global index space for land and ocean points + integer, pointer :: gindex_lnd(:) ! global index space for just land points + integer, pointer :: gindex_ocn(:) ! global index space for just ocean points + character(ESMF_MAXSTR) :: cvalue ! config data + integer :: nlnd, nocn ! local size ofarrays + integer :: n ! indices + integer :: year, month, day + integer :: dtime ! time step increment (sec) + type(ESMF_FieldBundle) :: c2l_fb + type(ESMF_FieldBundle) :: l2c_fb + type(ESMF_State) :: importState, exportState + integer :: glc_nec = 10 ! number of glc elevation classes + integer :: compid ! component id + character(len=32), parameter :: sub = 'lnd_init' + character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" + character(len=*), parameter :: subname=trim(modName)//': [lnd_init_lilac_cap] ' + !------------------------------------------------------------------------ + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' is called!', ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------ + ! Initialize clm MPI communicator + !------------------------------------------------------------------------ + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call ESMF_LogWrite(subname//"ESMF_VMGetCurrent", ESMF_LOGMSG_INFO) + call ESMF_VMPrint (vm, rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_LogWrite(subname//"ESMF_VMGet", ESMF_LOGMSG_INFO) + + ! duplicate the mpi communicator from the current VM + call MPI_Comm_dup(mpicom_vm, mpicom_lnd, rc) + call ESMF_LogWrite(subname//"MPI_Comm_dup...", ESMF_LOGMSG_INFO) + +!!!! NS : BOTH MPI_INIT and PIO_INIT1 are in lilac_mod.F90 + + + !------------------------------------------------------------------------ + ! Initialize mct + ! (needed for data models and cice prescribed capability) + ! (needed for data model share code - e.g. nitrogen deposition) + !------------------------------------------------------------------------ + ! TODO: FIX THIS PLEASE!!!! + + allocate(comms(1), comps(1), compLabels(1), comp_iamin(1), comp_comm_iam(1), comp_name(1),stat=ierr) + + comms(1) = mpicom_lnd !or call MPI_Comm_dup(mpicom_vm, comms(1), ierr) + comps(1) = 1 + compLabels(1) = 'LND' + comp_iamin(1) = .true. + comp_name(1) = 'LND' + + call ESMF_VMGet(vm, mpiCommunicator=comms(1), localPet=comp_comm_iam(1), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_pio_init2(comps, compLabels, comp_iamin, comms, comp_comm_iam) + + call ESMF_LogWrite(subname//"after shr_pio_init2", ESMF_LOGMSG_INFO) + + call ESMF_LogWrite(subname//"Now calling mct_world_init", ESMF_LOGMSG_INFO) + call mct_world_init(ncomps, mpicom_lnd, comms, comps) + call ESMF_LogWrite(subname//"mct world initialized! ", ESMF_LOGMSG_INFO) + + !deallocate(comms, comps, compLabels, comp_iamin, comp_comm_iam, comp_name) ??? + + ! Initialize model mpi info + compid = 1 + call spmd_init( mpicom_lnd, compid) + call ESMF_LogWrite(subname//"initialized model mpi info using spmd_init", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------ + !--- Log File --- + !------------------------------------------------------------------------ + + inst_name = 'LND' + inst_index = 1 + inst_suffix = "" + + ! Initialize io log unit + !! TODO: Put this in a subroutine..... + call shr_file_getLogUnit (shrlogunit) + if (masterproc) then + inquire(file='lnd_modelio.nml'//trim(inst_suffix),exist=exists) + if (exists) then + iulog = shr_file_getUnit() + call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),iulog) + end if + write(iulog,format) "CLM land model initialization" + else + iulog = shrlogunit + end if + + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + !------------------------------------------------------------------------ + !--- Orbital Values --- + !------------------------------------------------------------------------ + + + ! TODO: orbital values should be provided by lilac - but for now lets use defaults + !! hard wire these these in and we can decide on maybe having a + !namelist/ + + !call shr_cal_date2ymd(ymd,year,month,day) + !orb_cyear = orb_iyear + (year - orb_iyear_align) + + orb_cyear = 2000 + call shr_orb_params(orb_cyear, eccen, obliqr, mvelpp, & + obliqr, lambm0, mvelpp, masterproc) + ! for now hard-coding: + !nextsw_cday = 1.02083333333333 + !eccen = 1.670366039276560E-002 + !mvelpp = 4.93745779048816 + !lambm0 = -3.247249566152933E-0020 + !obliqr = 0.409101122579779 + + !if ((debug >1) .and. (masterproc)) then + if (masterproc) then + write(iulog,*) 'shr_obs_params is setting these:', eccen + write(iulog,*) 'eccen is : ', eccen + write(iulog,*) 'mvelpp is : ', mvelpp + + write(iulog,*) 'lambm0 is : ', lambm0 + write(iulog,*) 'obliqr is : ', obliqr + end if + + !---------------------- + ! Consistency check on namelist filename + !---------------------- + call control_setNL("lnd_in") + + !---------------------- + ! Get properties from clock + !---------------------- + + + call ESMF_ClockGet( clock, & + currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, & + timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + + call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,start_ymd) + + call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,stop_ymd) + + call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,ref_ymd) + + call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (esmf_caltype == ESMF_CALKIND_NOLEAP) then + calendar = shr_cal_noleap + else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then + calendar = shr_cal_gregorian + else + call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) + end if + + ! TODO: how do we set case_name and nsrest - should we hardwire for now? + caseid = 'test_lilac' + nsrest = nsrStartup + call ESMF_LogWrite(subname//"time manager Initialized....", ESMF_LOGMSG_INFO) + + !---------------------- + ! Initialize CTSM time manager + !---------------------- + + call set_timemgr_init( & + calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & + ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, stop_ymd_in=stop_ymd, & + stop_tod_in=stop_tod) + call ESMF_LogWrite(subname//"time manager is set now!", ESMF_LOGMSG_INFO) + + !---------------------- + ! Read namelist, grid and surface data + !---------------------- + + ! set default values for run control variables + call clm_varctl_set(caseid_in=caseid, nsrest_in=nsrest) + call ESMF_LogWrite(subname//"default values for run control variables are set...", ESMF_LOGMSG_INFO) + + + + !---------------------- + ! Initialize glc_elevclass module + !---------------------- + call glc_elevclass_init(glc_nec) + + !---------------------- + ! Initialize1 + !---------------------- + + ! note that the memory for gindex_ocn will be allocated in the following call + call initialize1(gindex_ocn) + ! call initialize1() + + call ESMF_LogWrite(subname//"initialize1 done...", ESMF_LOGMSG_INFO) + + ! obtain global index array for just land points which includes mask=0 or ocean points + call get_proc_bounds( bounds ) + + !print ,* "bound is :", bounds + !print ,* "bounds%begg :", bounds%begg + !print ,* "bounds%endg : ", bounds%endg + nlnd = bounds%endg - bounds%begg + 1 + allocate(gindex_lnd(nlnd)) + !print ,* "nlnd is :", nlnd + do g = bounds%begg,bounds%endg + n = 1 + (g - bounds%begg) + gindex_lnd(n) = ldecomp%gdc2glo(g) + end do + + call ESMF_LogWrite(subname//"obtained global index", ESMF_LOGMSG_INFO) + + ! create a global index that includes both land and ocean points + nocn = size(gindex_ocn) + allocate(gindex(nlnd + nocn)) + do n = 1,nlnd+nocn + if (n <= nlnd) then + gindex(n) = gindex_lnd(n) + else + gindex(n) = gindex_ocn(n-nlnd) + end if + end do + + ! create distGrid from global index array + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + deallocate(gindex) + call ESMF_LogWrite(subname//"DistGrid created......", ESMF_LOGMSG_INFO) + + !-------------------------------- + ! generate the mesh on ctsm distribution + !-------------------------------- + + ! TODO: mesh file should come into clm as a namelist for lilac only + ! for now need to hardwire this in cvalue here + cvalue = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' ! this will need to be filled in to run + + EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (masterproc) then + write(iulog,*)'mesh file for domain is ',trim(cvalue) + end if + + ! recreate the mesh using the above distGrid + EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_LogWrite(subname//" Create Mesh using distgrid ....", ESMF_LOGMSG_INFO) + lnd_mesh = EMesh + !-------------------------------- + ! Finish initializing ctsm + !-------------------------------- + call ESMF_LogWrite(subname//"before initialize2", ESMF_LOGMSG_INFO) + + call initialize2() + + call ESMF_LogWrite(subname//"initialize2 done...", ESMF_LOGMSG_INFO) + + !-------------------------------- + ! Check that ctsm internal dtime aligns with ctsm coupling interval + !-------------------------------- + call ESMF_LogWrite(subname//"cheking CTSM dtime and coupling intervals....", ESMF_LOGMSG_INFO) + + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_TimeIntervalGet( timeStep, s=dtime_sync, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + dtime_clm = get_step_size() + if (masterproc) then + write(iulog,*)'dtime_sync= ',dtime_sync,' dtime_ctsm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) + end if + if (mod(dtime_sync,dtime_clm) /= 0) then + write(iulog,*)'ctsm dtime ',dtime_clm,' and clock dtime ',dtime_sync,' never align' + rc = ESMF_FAILURE + return + end if + !-------------------------------- + ! Create import state (only assume input from atm - not rof and glc) + !-------------------------------- + + c2l_fb = ESMF_FieldBundleCreate ( name='c2l_fb', rc=rc) + + + call fldbundle_add( 'Sa_z' , c2l_fb,rc) !1 + call fldbundle_add( 'Sa_topo' , c2l_fb,rc) !2 + call fldbundle_add( 'Sa_u' , c2l_fb,rc) !3 + call fldbundle_add( 'Sa_v' , c2l_fb,rc) !4 + call fldbundle_add( 'Sa_ptem' , c2l_fb,rc) !5 + call fldbundle_add( 'Sa_pbot' , c2l_fb,rc) !6 + call fldbundle_add( 'Sa_tbot' , c2l_fb,rc) !7 + call fldbundle_add( 'Sa_shum' , c2l_fb,rc) !8 + + call fldbundle_add( 'Faxa_lwdn' , c2l_fb,rc) !9 + call fldbundle_add( 'Faxa_rainc' , c2l_fb,rc) !10 + call fldbundle_add( 'Faxa_rainl' , c2l_fb,rc) !11 + call fldbundle_add( 'Faxa_snowc' , c2l_fb,rc) !12 + call fldbundle_add( 'Faxa_snowl' , c2l_fb,rc) !13 + call fldbundle_add( 'Faxa_swndr' , c2l_fb,rc) !14 + call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) !15 + call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) !16 + call fldbundle_add( 'Faxa_swvdf' , c2l_fb,rc) !17 + call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb/), rc=rc) + ! Create export state + l2c_fb = ESMF_FieldBundleCreate(name='l2c_fb', rc=rc) + !call fldbundle_add( 'Sl_lfrint' , l2c_fb,rc) !1 + call fldbundle_add( 'Sl_lfrin' , l2c_fb,rc) !1 + call fldbundle_add( 'Sl_t' , l2c_fb,rc) !2 + call fldbundle_add( 'Sl_tref' , l2c_fb,rc) !3 + call fldbundle_add( 'Sl_qref' , l2c_fb,rc) !4 + call fldbundle_add( 'Sl_avsdr' , l2c_fb,rc) !5 + call fldbundle_add( 'Sl_anidr' , l2c_fb,rc) !6 + call fldbundle_add( 'Sl_avsdf' , l2c_fb,rc) !7 + call fldbundle_add( 'Sl_anidf' , l2c_fb,rc) !8 + call fldbundle_add( 'Sl_snowh' , l2c_fb,rc) !9 + call fldbundle_add( 'Fall_u10' , l2c_fb,rc) !10 + call fldbundle_add( 'Fall_fv' , l2c_fb,rc) !11 + call fldbundle_add( 'Fall_ram1' , l2c_fb,rc) !12 + !call fldbundle_add( 'Fall_taux' , l2c_fb,rc) !10 + !call fldbundle_add( 'Fall_lwup' , l2c_fb,rc) !14 + !call fldbundle_add( 'Fall_evap' , l2c_fb,rc) !15 + !call fldbundle_add( 'Fall_swniet' , l2c_fb,rc) !16 + call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb/), rc=rc) + !call ESMF_StateAdd(exportState, fieldbundleList = (/l2c_fb/), rc=rc) - !-------------------------------- - ! Create land export state - !-------------------------------- - call ESMF_LogWrite(subname//"Creating land export state", ESMF_LOGMSG_INFO) - ! FIXME (NS, 2019-07-30) - ! FIX THIS EXPORT STATES!!!!!! MAYBE REWRITE WITH THE ORIGINAL STRUCTURE - ! IN MIND - ! Fill in export state at end of initialization - call export_fields(comp, bounds, glc_present, rof_prognostic, & - water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//"Getting Calendar Day of nextsw calculation...", ESMF_LOGMSG_INFO) - ! Get calendar day of next sw (shortwave) calculation (nextsw_cday) - if (nsrest == nsrStartup) then - call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end if - ! Set nextsw_cday - call set_nextsw_cday( nextsw_cday ) + !-------------------------------- + ! Create land export state + !-------------------------------- + call ESMF_LogWrite(subname//"Creating land export state", ESMF_LOGMSG_INFO) - if (masterproc) then - write(iulog,*) 'TimeGet ... nextsw_cday is : ', nextsw_cday - end if + ! FIXME (NS, 2019-07-30) + ! FIX THIS EXPORT STATES!!!!!! MAYBE REWRITE WITH THE ORIGINAL STRUCTURE + ! IN MIND - ! Set Attributes - call ESMF_LogWrite(subname//"setting attribute!", ESMF_LOGMSG_INFO) + ! Fill in export state at end of initialization + call export_fields(comp, bounds, glc_present, rof_prognostic, & + water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeSet(export_state, name="lnd_nx", value=ldomain%ni, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_LogWrite(subname//"setting attribute! lnd_nx", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Getting Calendar Day of nextsw calculation...", ESMF_LOGMSG_INFO) - call ESMF_AttributeSet(export_state, name="lnd_ny", value=ldomain%nj, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_LogWrite(subname//"setting attribute-lnd_ny!", ESMF_LOGMSG_INFO) + ! Get calendar day of next sw (shortwave) calculation (nextsw_cday) + if (nsrest == nsrStartup) then + call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"State_SetScalar....!", ESMF_LOGMSG_INFO) - !Set scalars in export state - !call State_SetScalar(dble(ldomain%ni), flds_scalar_index_nx, export_state, & - ! flds_scalar_name, flds_scalar_num, rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if - !call State_SetScalar(dble(ldomain%nj), flds_scalar_index_ny, exportState, & - ! flds_scalar_name, flds_scalar_num, rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set nextsw_cday + call set_nextsw_cday( nextsw_cday ) - !-------------------------------- - ! diagnostics - !-------------------------------- + if (masterproc) then + write(iulog,*) 'TimeGet ... nextsw_cday is : ', nextsw_cday + end if - if (dbug > 1) then - call State_diagnose(export_state, subname//':ExportState',rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + ! Set Attributes + call ESMF_LogWrite(subname//"setting attribute!", ESMF_LOGMSG_INFO) + call ESMF_AttributeSet(export_state, name="lnd_nx", value=ldomain%ni, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"setting attribute! lnd_nx", ESMF_LOGMSG_INFO) + call ESMF_AttributeSet(export_state, name="lnd_ny", value=ldomain%nj, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"setting attribute-lnd_ny!", ESMF_LOGMSG_INFO) - ! Reset shr logging to original values + !-------------------------------- + ! diagnostics + !-------------------------------- - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) + if (dbug > 1) then + call State_diagnose(export_state, subname//':ExportState',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - call ESMF_AttributeAdd(comp, convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ShortName", "CTSM", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", "Community Land Model", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "Description", "Community Land Model", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2017", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Terrestrial", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "Name", "TBD", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "EmailAddress", TBD, convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", convention=convCIM, purpose=purpComp, rc=rc) - ! adding this nextsw_cday - call ESMF_AttributeSet(comp, "nextsw_cday", nextsw_cday, convention=convCIM, purpose=purpComp, rc=rc) -#endif + ! Reset shr logging to original values + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) #if (defined _MEMTRACE) - if(masterproc) then - write(iulog,*) TRIM(Sub) // ':end::' - lbnum=1 - call memmon_dump_fort('memmon.out','lnd_int:end::',lbnum) - call memmon_reset_addr() - endif + if(masterproc) then + write(iulog,*) TRIM(Sub) // ':end::' + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_int:end::',lbnum) + call memmon_reset_addr() + endif #endif call ESMF_LogWrite(subname//' CTSM INITIALIZATION DONE SUCCESSFULLY!!!! ', ESMF_LOGMSG_INFO) end subroutine lnd_init - !--------------------------------------------------------------------------- - - !subroutine fldbundle_add(stdname, fldptr, fieldbundle,rc) - subroutine fldbundle_add(stdname, fieldbundle,rc) - type(ESMF_Field) :: field - !type(ESMF_Mesh) :: lnd_mesh - character(len=*), intent(in) :: stdname - type (ESMF_FieldBundle) :: fieldbundle - integer, intent(out) :: rc - - print *, "in lnd register routine" - - rc = ESMF_SUCCESS - - !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(stdname), rc=rc) - field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldBundleAdd(fieldbundle, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end subroutine fldbundle_add - - !--------------------------------------------------------------------------- - subroutine lnd_run(gcomp, import_state, export_state, clock, rc) - - !------------------------ - ! Run CTSM - !------------------------ - - use clm_instMod , only : water_inst, atm2lnd_inst, glc2lnd_inst, lnd2atm_inst, lnd2glc_inst - use lnd_import_export , only : import_fields, export_fields - use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst - - ! input/output variables - type(ESMF_GridComp) :: gcomp ! CLM gridded component - type(ESMF_State) :: import_state ! CLM import state - type(ESMF_State) :: export_state ! CLM export state - type(ESMF_Clock) :: clock ! ESMF synchronization clock - integer, intent(out) :: rc ! Return code - - ! local variables: - type(ESMF_Alarm) :: alarm - type(ESMF_Time) :: currTime - type(ESMF_Time) :: nextTime - type(ESMF_State) :: importState, exportState - character(ESMF_MAXSTR) :: cvalue - character(ESMF_MAXSTR) :: case_name ! case name - integer :: ymd ! CTSM current date (YYYYMMDD) - integer :: yr ! CTSM current year - integer :: mon ! CTSM current month - integer :: day ! CTSM current day - integer :: tod ! CTSM current time of day (sec) - integer :: ymd_sync ! Sync date (YYYYMMDD) - integer :: yr_sync ! Sync current year - integer :: mon_sync ! Sync current month - integer :: day_sync ! Sync current day - integer :: tod_sync ! Sync current time of day (sec) - integer :: dtime ! time step increment (sec) - integer :: nstep ! time step index - logical :: rstwr ! .true. ==> write restart file before returning - logical :: nlend ! .true. ==> last time-step - logical :: dosend ! true => send data back to driver - logical :: doalb ! .true. ==> do albedo calculation on this time step - real(r8) :: nextsw_cday ! calday from clock of next radiation computation - real(r8) :: caldayp1 ! ctsm calday plus dtime offset - integer :: lbnum ! input to memory diagnostic - integer :: g,i ! counters - real(r8) :: calday ! calendar day for nstep - real(r8) :: declin ! solar declination angle in radians for nstep - real(r8) :: declinp1 ! solar declination angle in radians for nstep+1 - real(r8) :: eccf ! earth orbit eccentricity factor - type(bounds_type) :: bounds ! bounds - character(len=32) :: rdate ! date char string for restart file names - integer :: shrlogunit ! original log unit - character(len=*),parameter :: subname=trim(modName)//':[lnd_run] ' - - character(*),parameter :: F02 = "('[lnd_comp_esmf] ',a, d26.19)" - !------------------------------------------------------------------------------- - - - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - - call shr_file_getLogUnit (shrlogunit) - call shr_file_setLogUnit (iulog) - call ESMF_LogWrite(subname//' shr_file_getLogunits....', ESMF_LOGMSG_INFO) - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','lnd_comp_nuopc_ModelAdvance:start::',lbnum) - endif -#endif - - !-------------------------------- - ! Determine time of next atmospheric shortwave calculation - !-------------------------------- - - - !call ESMF_AttributeGet(export_state, name="nextsw_cday", value=nextsw_cday, rc=rc) - !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !call set_nextsw_cday( nextsw_cday ) - - call State_GetScalar(import_state, & - flds_scalar_index_nextsw_cday, nextsw_cday, & - flds_scalar_name, flds_scalar_num, rc) - call set_nextsw_cday( nextsw_cday ) - - - if (masterproc) then - write(iulog,*) 'State_GetScalar ... nextsw_cday is : ', nextsw_cday - end if - - ! in nuopc it is like this...... - !call State_GetScalar(import_state, & - ! flds_scalar_index_nextsw_cday, nextsw_cday, & - ! flds_scalar_name, flds_scalar_num, rc) - !call ESMF_LogWrite(subname//'after state_getscalar for determining nextsw_cday', ESMF_LOGMSG_INFO) - !call set_nextsw_cday( nextsw_cday ) - !call ESMF_LogWrite(subname//'settitng nextsw_cday', ESMF_LOGMSG_INFO) - + !--------------------------------------------------------------------------- - !---------------------- - ! Obtain orbital values - !---------------------- + !subroutine fldbundle_add(stdname, fldptr, fieldbundle,rc) + subroutine fldbundle_add(stdname, fieldbundle,rc) + type(ESMF_Field) :: field + !type(ESMF_Mesh) :: lnd_mesh + character(len=*), intent(in) :: stdname + type (ESMF_FieldBundle) :: fieldbundle + integer, intent(out) :: rc - !call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !read(cvalue,*) eccen + print *, "in lnd register routine" - !call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !read(cvalue,*) obliqr + rc = ESMF_SUCCESS - !call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !read(cvalue,*) lambm0 + !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(stdname), rc=rc) + field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(stdname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - !call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !read(cvalue,*) mvelpp + call ESMF_FieldBundleAdd(fieldbundle, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end subroutine fldbundle_add + !--------------------------------------------------------------------------- + subroutine lnd_run(gcomp, import_state, export_state, clock, rc) + !------------------------ + ! Run CTSM + !------------------------ + use clm_instMod , only : water_inst, atm2lnd_inst, glc2lnd_inst, lnd2atm_inst, lnd2glc_inst + use lnd_import_export , only : import_fields, export_fields + use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst + + ! input/output variables + type(ESMF_GridComp) :: gcomp ! CLM gridded component + type(ESMF_State) :: import_state ! CLM import state + type(ESMF_State) :: export_state ! CLM export state + type(ESMF_Clock) :: clock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + + ! local variables: + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: currTime + type(ESMF_Time) :: nextTime + type(ESMF_State) :: importState, exportState + character(ESMF_MAXSTR) :: cvalue + character(ESMF_MAXSTR) :: case_name ! case name + integer :: ymd ! CTSM current date (YYYYMMDD) + integer :: yr ! CTSM current year + integer :: mon ! CTSM current month + integer :: day ! CTSM current day + integer :: tod ! CTSM current time of day (sec) + integer :: ymd_sync ! Sync date (YYYYMMDD) + integer :: yr_sync ! Sync current year + integer :: mon_sync ! Sync current month + integer :: day_sync ! Sync current day + integer :: tod_sync ! Sync current time of day (sec) + integer :: dtime ! time step increment (sec) + integer :: nstep ! time step index + logical :: rstwr ! .true. ==> write restart file before returning + logical :: nlend ! .true. ==> last time-step + logical :: dosend ! true => send data back to driver + logical :: doalb ! .true. ==> do albedo calculation on this time step + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + real(r8) :: caldayp1 ! ctsm calday plus dtime offset + integer :: lbnum ! input to memory diagnostic + integer :: g,i ! counters + real(r8) :: calday ! calendar day for nstep + real(r8) :: declin ! solar declination angle in radians for nstep + real(r8) :: declinp1 ! solar declination angle in radians for nstep+1 + real(r8) :: eccf ! earth orbit eccentricity factor + type(bounds_type) :: bounds ! bounds + character(len=32) :: rdate ! date char string for restart file names + integer :: shrlogunit ! original log unit + character(len=*),parameter :: subname=trim(modName)//':[lnd_run] ' + + character(*),parameter :: F02 = "('[lnd_comp_esmf] ',a, d26.19)" + !------------------------------------------------------------------------------- + + + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + call shr_file_getLogUnit (shrlogunit) + call shr_file_setLogUnit (iulog) + call ESMF_LogWrite(subname//' shr_file_getLogunits....', ESMF_LOGMSG_INFO) - !-------------------------------- - ! Unpack import state - !-------------------------------- - - call t_startf ('lc_lnd_import') - - call get_proc_bounds(bounds) - call ESMF_LogWrite(subname//'after get_proc_bounds', ESMF_LOGMSG_INFO) - !call import_fields( import_state, bounds, glc_present, rof_prognostic, atm2lnd_inst, glc2lnd_inst, water_inst%wateratm2lndbulk_inst, rc ) - call import_fields( gcomp , bounds, glc_present, rof_prognostic, atm2lnd_inst, glc2lnd_inst, water_inst%wateratm2lndbulk_inst, rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call t_stopf ('lc_lnd_import') - - !-------------------------------- - ! Run model - !-------------------------------- - - dtime = get_step_size() - dosend = .false. - do while(.not. dosend) - - ! TODO: This is currently hard-wired - is there a better way for nuopc? - ! Note that the model clock is updated at the end of the time step not at the beginning - nstep = get_nstep() - if (nstep > 0) then - dosend = .true. - end if - - !-------------------------------- - ! Determine doalb based on nextsw_cday sent from atm model - !-------------------------------- - - calday = get_curr_calday() - caldayp1 = get_curr_calday(offset=dtime) - - !TODO(NS): nextsw_cday should come directly from atmosphere! What - !should we do - ! For now I am setting nextsw_cday to be the same caldayp1 - - - nextsw_cday = calday - if (nstep == 0) then - doalb = .false. - nextsw_cday = caldayp1 - else if (nstep == 1) then - !doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) - doalb = .false. - else - doalb = (nextsw_cday >= -0.5_r8) - end if - - - if (masterproc) then - write(iulog,*) '------------ LILAC ----------------' - write(iulog,*) 'nstep : ', nstep - write(iulog,*) 'dtime : ', dtime - write(iulog,F02) 'calday : ', calday - write(iulog,F02) 'caldayp1 : ', caldayp1 - write(iulog,F02) 'nextsw_cday : ', nextsw_cday - write(iulog,*) '-------------------------------------' - end if - - call update_rad_dtime(doalb) +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_comp_nuopc_ModelAdvance:start::',lbnum) + endif +#endif - if (masterproc) then - write(iulog,*) 'doalb is: ', doalb - end if + !---------------------- + ! Obtain orbital values + !---------------------- + + !call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) eccen + + !call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) obliqr + + !call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) lambm0 + + !call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) mvelpp + + !-------------------------------- + ! Unpack import state + !-------------------------------- + + call t_startf ('lc_lnd_import') + + call get_proc_bounds(bounds) + call ESMF_LogWrite(subname//'after get_proc_bounds', ESMF_LOGMSG_INFO) + call import_fields( gcomp , bounds, glc_present, rof_prognostic, atm2lnd_inst, glc2lnd_inst, water_inst%wateratm2lndbulk_inst, rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call t_stopf ('lc_lnd_import') + + !-------------------------------- + ! Run model + !-------------------------------- + + dtime = get_step_size() + dosend = .false. + do while(.not. dosend) + + ! TODO: This is currently hard-wired - is there a better way for nuopc? + ! Note that the model clock is updated at the end of the time step not at the beginning + nstep = get_nstep() + if (nstep > 0) then + dosend = .true. + end if + + !-------------------------------- + ! Determine calendar day info + !-------------------------------- + + calday = get_curr_calday() + caldayp1 = get_curr_calday(offset=dtime) + + !-------------------------------- + ! Get time of next atmospheric shortwave calculation + !-------------------------------- + + ! TODO(NS): nextsw_cday should come directly from atmosphere! + ! For now I am setting nextsw_cday to be the same caldayp1 + + nextsw_cday = calday + if (masterproc) then + write(iulog,*) 'State_GetScalar ... nextsw_cday is : ', nextsw_cday + end if + + !-------------------------------- + ! Determine doalb based on nextsw_cday sent from atm model + !-------------------------------- + + if (nstep == 0) then + doalb = .false. + nextsw_cday = caldayp1 + else if (nstep == 1) then + !doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) + doalb = .false. + else + doalb = (nextsw_cday >= -0.5_r8) + end if + + if (masterproc) then + write(iulog,*) '------------ LILAC ----------------' + write(iulog,*) 'nstep : ', nstep + write(iulog,*) 'dtime : ', dtime + write(iulog,F02) 'calday : ', calday + write(iulog,F02) 'caldayp1 : ', caldayp1 + write(iulog,F02) 'nextsw_cday : ', nextsw_cday + write(iulog,*) '-------------------------------------' + end if + + call update_rad_dtime(doalb) + + if (masterproc) then + write(iulog,*) 'doalb is: ', doalb + end if + + !-------------------------------- + ! Determine if time to write restart + !-------------------------------- + + !call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !rstwr = .true. + !call ESMF_AlarmRingerOff( alarm, rc=rc ) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !else + !rstwr = .false. + !endif + + ! TODO: for now hardwire rstwr to .false. + rstwr = .false. + + !-------------------------------- + ! Determine if time to stop + !-------------------------------- + + !call ESMF_ClockGetAlarm(clock, alarmname='alarm_stop', alarm=alarm, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !nlend = .true. + !call ESMF_AlarmRingerOff( alarm, rc=rc ) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !else + ! nlend = .false. + !endif + + !-------------------------------- + ! Run CTSM + !-------------------------------- + + call t_barrierf('sync_ctsm_run1', mpicom) + + call t_startf ('shr_orb_decl') + calday = get_curr_calday() + + call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) + call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) + + if (masterproc) then + write(iulog,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' + write(iulog,* ) 'doalb : ', doalb + write(iulog,*) 'call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, decl' + write(iulog,*) 'call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, decl' + write(iulog,F02) 'calday is : ', calday + write(iulog,F02) 'eccen is : ', eccen + write(iulog,F02) 'mvelpp is : ', mvelpp + write(iulog,F02) 'lambm0 is : ', lambm0 + write(iulog,F02) 'obliqr is : ', obliqr + write(iulog,F02) 'clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic)' + write(iulog,F02) 'declin is : ', declin + write(iulog,F02) 'declinp1 is : ', declinp1 + write(iulog,F02) 'rof_prognostic : ', rof_prognostic + write(iulog,* ) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' + end if + + call t_stopf ('shr_orb_decl') + + call t_startf ('ctsm_run') + + ! Restart File - use nexttimestr rather than currtimestr here since that is the time at the end of + ! the timestep and is preferred for restart file names + + call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync, mon_sync, day_sync, tod_sync + + call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic) + + call t_stopf ('ctsm_run') + + !-------------------------------- + ! Pack export state + !-------------------------------- + + call t_startf ('lc_lnd_export') + + call export_fields(gcomp, bounds, glc_present, rof_prognostic, & + water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) + !call export_fields(exportState, bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call t_stopf ('lc_lnd_export') - !-------------------------------- - ! Determine if time to write restart - !-------------------------------- + !-------------------------------- + ! Advance ctsm time step + !-------------------------------- + + call t_startf ('lc_ctsm2_adv_timestep') + call advance_timestep() + call t_stopf ('lc_ctsm2_adv_timestep') + + end do + + ! Check that internal clock is in sync with master clock + ! Note that the driver clock has not been updated yet - so at this point + ! CTSM is actually 1 coupling intervals ahead of the driver clock + + call get_curr_date( yr, mon, day, tod, offset=-2*dtime ) + ymd = yr*10000 + mon*100 + day + tod = tod + + call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet( currTime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) - !if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !rstwr = .true. - !call ESMF_AlarmRingerOff( alarm, rc=rc ) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !else - !rstwr = .false. - !endif + if ( (ymd /= ymd_sync) .and. (tod /= tod_sync) ) then + write(iulog,*)'ctsm ymd=',ymd ,' ctsm tod= ',tod + write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync + rc = ESMF_FAILURE + call ESMF_LogWrite(subname//" CTSM clock not in sync with Master Sync clock",ESMF_LOGMSG_ERROR) + end if - !-------------------------------- - ! Determine if time to stop - !-------------------------------- + !-------------------------------- + ! diagnostics + !-------------------------------- - !call ESMF_ClockGetAlarm(clock, alarmname='alarm_stop', alarm=alarm, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (dbug > 1) then + ! call State_diagnose(exportState,subname//':ES',rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (masterproc) then + ! call log_clock_advance(clock, 'CTSM', iulog, rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! end if + !end if - !if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !nlend = .true. - !call ESMF_AlarmRingerOff( alarm, rc=rc ) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !else - ! nlend = .false. - !endif - - !-------------------------------- - ! Run CTSM - !-------------------------------- - - call t_barrierf('sync_ctsm_run1', mpicom) - - call t_startf ('shr_orb_decl') - calday = get_curr_calday() - - - call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) - call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) - - - if (masterproc) then - write(iulog,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' - write(iulog,* ) 'doalb : ', doalb - write(iulog,*) 'call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, decl' - write(iulog,*) 'call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, decl' - write(iulog,F02) 'calday is : ', calday - write(iulog,F02) 'eccen is : ', eccen - write(iulog,F02) 'mvelpp is : ', mvelpp - write(iulog,F02) 'lambm0 is : ', lambm0 - write(iulog,F02) 'obliqr is : ', obliqr - write(iulog,F02) 'clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic)' - write(iulog,F02) 'declin is : ', declin - write(iulog,F02) 'declinp1 is : ', declinp1 - write(iulog,F02) 'rof_prognostic : ', rof_prognostic - write(iulog,* ) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' - end if - - call t_stopf ('shr_orb_decl') - - call t_startf ('ctsm_run') - - ! Restart File - use nexttimestr rather than currtimestr here since that is the time at the end of - ! the timestep and is preferred for restart file names - - call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync, mon_sync, day_sync, tod_sync - - call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic) - - call t_stopf ('ctsm_run') + !-------------------------------- + ! Reset shr logging to my original values + !-------------------------------- - !-------------------------------- - ! Pack export state - !-------------------------------- + call shr_file_setLogUnit (shrlogunit) - call t_startf ('lc_lnd_export') - - call export_fields(gcomp, bounds, glc_present, rof_prognostic, & - water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) - !call export_fields(exportState, bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - call t_stopf ('lc_lnd_export') +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_comp_nuopc_ModelAdvance:end::',lbnum) + call memmon_reset_addr() + endif +#endif - !-------------------------------- - ! Advance ctsm time step - !-------------------------------- + end subroutine lnd_run - call t_startf ('lc_ctsm2_adv_timestep') - call advance_timestep() - call t_stopf ('lc_ctsm2_adv_timestep') + !--------------------------------------------------------------------------- - end do + subroutine lnd_final(comp, import_state, export_state, clock, rc) + ! + ! !DESCRIPTION: + ! Finalize land surface model + ! + ! !ARGUMENTS: + type(ESMF_GridComp) :: comp ! CLM gridded component + type(ESMF_State) :: import_state ! CLM import state + type(ESMF_State) :: export_state ! CLM export state + type(ESMF_Clock) :: clock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + !--------------------------------------------------------------------------- - ! Check that internal clock is in sync with master clock - ! Note that the driver clock has not been updated yet - so at this point - ! CTSM is actually 1 coupling intervals ahead of the driver clock + rc = ESMF_SUCCESS - call get_curr_date( yr, mon, day, tod, offset=-2*dtime ) - ymd = yr*10000 + mon*100 + day - tod = tod + ! Destroy ESMF objects + !call esmfshr_util_StateArrayDestroy(export_state,'domain',rc) + !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ClockGet( clock, currTime=currTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call esmfshr_util_StateArrayDestroy(export_state,'d2x',rc) + !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_TimeGet( currTime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) + !call esmfshr_util_StateArrayDestroy(import_state,'x2d',rc) + !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - if ( (ymd /= ymd_sync) .and. (tod /= tod_sync) ) then - write(iulog,*)'ctsm ymd=',ymd ,' ctsm tod= ',tod - write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync - rc = ESMF_FAILURE - call ESMF_LogWrite(subname//" CTSM clock not in sync with Master Sync clock",ESMF_LOGMSG_ERROR) - end if + end subroutine lnd_final - !-------------------------------- - ! diagnostics - !-------------------------------- + !=============================================================================== - !if (dbug > 1) then - ! call State_diagnose(exportState,subname//':ES',rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! if (masterproc) then - ! call log_clock_advance(clock, 'CTSM', iulog, rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! end if - !end if + subroutine log_clock_advance(clock, logunit, rc) - !-------------------------------- - ! Reset shr logging to my original values - !-------------------------------- + ! input/output variables + type(ESMF_Clock) :: clock + integer , intent(in) :: logunit + integer , intent(out) :: rc - call shr_file_setLogUnit (shrlogunit) + ! local variables + character(len=CL) :: cvalue, prestring + !----------------------------------------------------------------------- - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','lnd_comp_nuopc_ModelAdvance:end::',lbnum) - call memmon_reset_addr() - endif -#endif + write(prestring, *) "------>Advancing CTSM from: " + call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, preString=trim(prestring), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) - end subroutine lnd_run + call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & + preString="--------------------------------> to: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) - !--------------------------------------------------------------------------- + end subroutine log_clock_advance - subroutine lnd_final(comp, import_state, export_state, clock, rc) - ! - ! !DESCRIPTION: - ! Finalize land surface model - ! - ! !ARGUMENTS: - type(ESMF_GridComp) :: comp ! CLM gridded component - type(ESMF_State) :: import_state ! CLM import state - type(ESMF_State) :: export_state ! CLM export state - type(ESMF_Clock) :: clock ! ESMF synchronization clock - integer, intent(out) :: rc ! Return code - !--------------------------------------------------------------------------- +!=============================================================================== - rc = ESMF_SUCCESS + subroutine memcheck(string, level, mastertask) - ! Destroy ESMF objects - !call esmfshr_util_StateArrayDestroy(export_state,'domain',rc) - !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + ! input/output variables + character(len=*) , intent(in) :: string + integer , intent(in) :: level + logical , intent(in) :: mastertask - !call esmfshr_util_StateArrayDestroy(export_state,'d2x',rc) - !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + ! local variables + integer :: ierr + integer, external :: GPTLprint_memusage + !----------------------------------------------------------------------- - !call esmfshr_util_StateArrayDestroy(import_state,'x2d',rc) - !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + ierr = GPTLprint_memusage(string) + endif - end subroutine lnd_final + end subroutine memcheck - end module lnd_comp_esmf +end module lnd_comp_esmf diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index e1b9435b23..9f8c7c0d5c 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -1,13 +1,6 @@ module lnd_import_export - use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet - use ESMF , only : ESMF_StatePrint - use ESMF , only : ESMF_GridCompGet - use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError - use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag - use ESMF , only : operator(/=), operator(==) - !use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected - !use NUOPC_Model , only : NUOPC_ModelGet + + use ESMF use shr_kind_mod , only : r8 => shr_kind_r8, cx=>shr_kind_cx, cxx=>shr_kind_cxx, cs=>shr_kind_cs use shr_infnan_mod , only : isnan => shr_infnan_isnan use shr_string_mod , only : shr_string_listGetName, shr_string_listGetNum @@ -32,13 +25,10 @@ module lnd_import_export implicit none private ! except -! public :: advertise_fields -! public :: realize_fields public :: import_fields public :: export_fields private :: fldlist_add - private :: fldlist_realize private :: state_getimport private :: state_setexport private :: state_getfldptr @@ -58,18 +48,14 @@ module lnd_import_export integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost ! from atm->lnd - integer :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn + integer :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn ! from lnd->atm - character(len=cx) :: carma_fields ! List of CARMA fields from lnd->atm integer :: drydep_nflds ! number of dry deposition velocity fields lnd-> atm integer :: megan_nflds ! number of MEGAN voc fields from lnd-> atm integer :: emis_nflds ! number of fire emission fields from lnd-> atm - logical :: flds_co2a ! use case - logical :: flds_co2b ! use case - logical :: flds_co2c ! use case - integer :: glc_nec ! number of glc elevation classes + integer :: glc_nec = 10 ! number of glc elevation classes integer, parameter :: debug = 1 ! internal debug level character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" @@ -78,291 +64,8 @@ module lnd_import_export __FILE__ character(*),parameter :: modname = "[lnd_import_export]: " -!=============================================================================== + !=============================================================================== contains -!=============================================================================== - -! subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, rof_prognostic, rc) -! -! use clm_varctl, only : ndep_from_cpl -! -! ! input/output variables -! type(ESMF_GridComp) :: gcomp -! character(len=*) , intent(in) :: flds_scalar_name -! logical , intent(in) :: glc_present -! logical , intent(in) :: rof_prognostic -! integer , intent(out) :: rc -! -! ! local variables -! type(ESMF_State) :: importState -! type(ESMF_State) :: exportState -! character(ESMF_MAXSTR) :: stdname -! character(ESMF_MAXSTR) :: cvalue -! character(len=2) :: nec_str -! integer :: n, num -! character(len=128) :: fldname -! character(len=*), parameter :: subname='(lnd_import_export:advertise_fields)' -! !------------------------------------------------------------------------------- -! -! rc = ESMF_SUCCESS -! -! call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! !-------------------------------- -! ! determine necessary toggles for below -! !-------------------------------- -! -! 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) -! -! 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) -! -! 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) -! -! ! Determine number of elevation classes -! call NUOPC_CompAttributeGet(gcomp, name='glc_nec', value=cvalue, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! read(cvalue,*) glc_nec -! call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO) -! if (glc_nec < 1) then -! call shr_sys_abort('ERROR: In CLM4.5 and later, glc_nec must be at least 1.') -! end if -! -! ! Initialize glc_elevclass module -! call glc_elevclass_init(glc_nec) -! -! !-------------------------------- -! ! Advertise export fields -! !-------------------------------- -! -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, trim(flds_scalar_name)) -! -! ! export land states -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_t' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_tref' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_qref' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdr' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidr' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdf' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidf' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_snowh' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_u10' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_fv' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_ram1' ) -! -! ! export fluxes to river -! if (rof_prognostic) then -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsur' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofgwl' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsub' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofi' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_irrig' ) -! end if -! -! ! export fluxes to atm -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_taux' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_tauy' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lat' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_sen' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lwup' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap' ) -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_swnet' ) -! -! ! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_methane' ) -! -! ! dust fluxes from land (4 sizes) -! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_flxdst', ungridded_lbound=1, ungridded_ubound=4) -! -! ! co2 fields from land -! if (flds_co2b .or. flds_co2c) then -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_fco2_lnd' ) -! end if -! -! ! Dry Deposition velocities from land - ALSO initialize drydep here -! call seq_drydep_readnl("drv_flds_in", drydep_nflds) -! if (n_drydep .ne. drydep_nflds) call shr_sys_abort('ERROR: drydep field count mismatch') -! if (n_drydep > 0) then -! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_ddvel', ungridded_lbound=1, ungridded_ubound=drydep_nflds) -! end if -! call seq_drydep_init( ) -! -! ! MEGAN VOC emissions fluxes from land -! megan_nflds=0 -! call shr_megan_readnl('drv_flds_in', megan_nflds) -! if (shr_megan_mechcomps_n .ne. megan_nflds) call shr_sys_abort('ERROR: megan field count mismatch') -! if (shr_megan_mechcomps_n > 0) then -! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_voc', ungridded_lbound=1, ungridded_ubound=megan_nflds) -! end if -! -! ! Fire emissions fluxes from land -! call shr_fire_emis_readnl('drv_flds_in', emis_nflds) -! if (shr_fire_emis_mechcomps_n .ne. emis_nflds) call shr_sys_abort('ERROR: fire_emis field count mismatch') -! if (shr_fire_emis_mechcomps_n > 0) then -! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_fire', ungridded_lbound=1, ungridded_ubound=emis_nflds) -! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_fztop') -! end if -! ! CARMA volumetric soil water from land -! ! TODO: is the following correct - the CARMA field exchange is very confusing in mct -! call shr_carma_readnl('drv_flds_in', carma_fields) -! if (carma_fields /= ' ') then -! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_soilw') ! optional for carma -! end if -! -! if (glc_present) then -! ! lnd->glc states from land all lnd->glc elevation classes (1:glc_nec) plus bare land (index 0). -! ! The following puts all of the elevation class fields as an -! ! undidstributed dimension in the export state field -! -! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_tsrf_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) -! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_topo_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) -! call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Flgl_qice_elev', ungridded_lbound=1, ungridded_ubound=glc_nec+1) -! end if -! -! ! Now advertise above export fields -! do n = 1,fldsFrLnd_num -! call NUOPC_Advertise(exportState, standardName=fldsFrLnd(n)%stdname, & -! TransferOfferGeomObject='will provide', rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! enddo -! -! !-------------------------------- -! ! Advertise import fields -! !-------------------------------- -! -! call fldlist_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) -! -! ! from atm - states -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_z' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_topo' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_u' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_v' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_ptem' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_pbot' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_tbot' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_shum' ) -! !call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_methane' ) -! -! ! from atm - fluxes -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_lwdn' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainc' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainl' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowc' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowl' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndr' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdr' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndf' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdf' ) -! -! ! from atm - black carbon deposition fluxes (3) -! ! (1) => bcphidry, (2) => bcphodry, (3) => bcphiwet -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_bcph', ungridded_lbound=1, ungridded_ubound=3) -! -! ! from atm - organic carbon deposition fluxes (3) -! ! (1) => ocphidry, (2) => ocphodry, (3) => ocphiwet -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_ocph', ungridded_lbound=1, ungridded_ubound=3) -! -! ! from atm - wet dust deposition frluxes (4 sizes) -! ! (1) => dstwet1, (2) => dstwet2, (3) => dstwet3, (4) => dstwet4 -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) -! -! ! from - atm dry dust deposition frluxes (4 sizes) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) -! -! ! from atm - nitrogen deposition -! call shr_ndep_readnl("drv_flds_in", ndep_nflds) -! if (ndep_nflds > 0) then -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=ndep_nflds) -! ! This sets a variable in clm_varctl -! ndep_from_cpl = .true. -! end if -! -! ! from atm - co2 exchange scenarios -! if (flds_co2a .or. flds_co2b .or. flds_co2c) then -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_co2prog') -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_co2diag') -! end if -! -! if (rof_prognostic) then -! ! from river -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_flood' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_volr' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_volrmch' ) -! end if -! -! if (glc_present) then -! ! from land-ice (glc) - no elevation classes -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_icemask' ) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_icemask_coupled_fluxes') -! -! ! from land-ice (glc) - fields for all glc->lnd elevation classes (1:glc_nec) plus bare land (index 0) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_ice_covered_elev', ungridded_lbound=1, ungridded_ubound=glc_nec+1) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_topo_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) -! call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flgg_hflx_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) -! end if -! -! ! Now advertise import fields -! do n = 1,fldsToLnd_num -! call NUOPC_Advertise(importState, standardName=fldsToLnd(n)%stdname, & -! TransferOfferGeomObject='will provide', rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! enddo -! -! end subroutine advertise_fields -! -! !=============================================================================== -! -! subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) -! -! ! input/output variables -! type(ESMF_GridComp) , intent(inout) :: gcomp -! type(ESMF_Mesh) , intent(in) :: Emesh -! character(len=*) , intent(in) :: flds_scalar_name -! integer , intent(in) :: flds_scalar_num -! integer , intent(out) :: rc -! -! ! local variables -! type(ESMF_State) :: importState -! type(ESMF_State) :: exportState -! character(len=*), parameter :: subname='(lnd_import_export:realize_fields)' -! !--------------------------------------------------------------------------- -! -! rc = ESMF_SUCCESS -! -! call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! call fldlist_realize( & -! state=ExportState, & -! fldList=fldsFrLnd, & -! numflds=fldsFrLnd_num, & -! flds_scalar_name=flds_scalar_name, & -! flds_scalar_num=flds_scalar_num, & -! tag=subname//':clmExport',& -! mesh=Emesh, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! call fldlist_realize( & -! state=importState, & -! fldList=fldsToLnd, & -! numflds=fldsToLnd_num, & -! flds_scalar_name=flds_scalar_name, & -! flds_scalar_num=flds_scalar_num, & -! tag=subname//':clmImport',& -! mesh=Emesh, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! end subroutine realize_fields - !=============================================================================== subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & @@ -443,12 +146,9 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! Get import state - !call NUOPC_ModelGet(gcomp, importState=importState, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Get import state call ESMF_GridCompGet(gcomp, importState=importState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set bounds begg = bounds%begg; endg=bounds%endg @@ -513,192 +213,81 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & call state_getimport(importState, 'Faxa_swndf', bounds, output=atm2lnd_inst%forc_solai_grc(:,2), rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - -!!!# ! Atmosphere prognostic/prescribed aerosol fields -!!!# -!!!# ! bcphidry -!!!# call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,1), & -!!!# ungridded_index=1, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# ! bcphodry -!!!# call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,2), & -!!!# ungridded_index=2, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# ! bcphiwet -!!!# call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,3), & -!!!# ungridded_index=3, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# -!!!# ! ocphidry -!!!# call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,4), & -!!!# ungridded_index=1, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# ! bcphodry -!!!# call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,5), & -!!!# ungridded_index=2, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# ! bcphiwet -!!!# call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,6), & -!!!# ungridded_index=3, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# -!!!# call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,7), & -!!!# ungridded_index=1, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,8), & -!!!# ungridded_index=1, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# -!!!# call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,9), & -!!!# ungridded_index=2, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,10), & -!!!# ungridded_index=2, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# -!!!# call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,11), & -!!!# ungridded_index=3, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,12), & -!!!# ungridded_index=3, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# -!!!# call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,13), & -!!!# ungridded_index=4, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,14), & -!!!# ungridded_index=4, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# -!!!# call state_getimport(importState, 'Sa_methane', bounds, output=atm2lnd_inst%forc_pch4_grc, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# -!!!# ! The mediator is sending ndep in units if kgN/m2/s - and ctsm uses units of gN/m2/sec -!!!# ! so the following conversion needs to happen -!!!# -!!!# call state_getimport(importState, 'Faxa_nhx', bounds, output=forc_nhx, ungridded_index=1, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# call state_getimport(importState, 'Faxa_noy', bounds, output=forc_noy, ungridded_index=2, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# do g = begg,endg -!!!# atm2lnd_inst%forc_ndep_grc(g) = (forc_nhx(g) + forc_noy(g))*1000._r8 -!!!# end do -!!!# -!!!# !-------------------------- -!!!# ! Atmosphere co2 -!!!# !-------------------------- -!!!# -!!!# fldName = 'Sa_co2prog' -!!!# call ESMF_StateGet(importState, trim(fldname), itemFlag, rc=rc) -!!!# if ( ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# if (itemflag == ESMF_STATEITEM_NOTFOUND .and. co2_type == 'prognostic') then -!!!# call shr_sys_abort( subname//' ERROR: must have nonzero Sa_co2prog for co2_type equal to prognostic' ) -!!!# end if -!!!# if (itemflag /= ESMF_STATEITEM_NOTFOUND) then -!!!# call state_getfldptr(importState, trim(fldname), dataPtr, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# do g = begg,endg -!!!# co2_ppmv_prog(g) = dataPtr(g-begg+1) ! co2 atm prognostic -!!!# end do -!!!# else -!!!# do g = begg,endg -!!!# co2_ppmv_prog(g) = co2_ppmv -!!!# end do -!!!# end if -!!!# -!!!# fldName = 'Sa_co2diag' -!!!# call ESMF_StateGet(importState, trim(fldname), itemFlag, rc=rc) -!!!# if ( ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# if (itemflag == ESMF_STATEITEM_NOTFOUND .and. co2_type == 'diagnostic') then -!!!# call shr_sys_abort( subname//' ERROR: must have nonzero Sa_co2prog for co2_type equal to prognostic' ) -!!!# end if -!!!# if (itemflag /= ESMF_STATEITEM_NOTFOUND) then -!!!# call state_getfldptr(importState, trim(fldname), dataPtr, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# do g = begg,endg -!!!# co2_ppmv_diag(g) = dataPtr(g-begg+1) ! co2 atm diagnostic -!!!# end do -!!!# else -!!!# do g = begg,endg -!!!# co2_ppmv_diag(g) = co2_ppmv -!!!# end do -!!!# end if -!!!# -!!!# ! Note that the following does unit conversions from ppmv to partial pressures (Pa) -!!!# ! Note that forc_pbot is in Pa -!!!# do g = begg,endg -!!!# if (co2_type == 'prognostic') then -!!!# co2_ppmv_val = co2_ppmv_prog(g) -!!!# else if (co2_type == 'diagnostic') then -!!!# co2_ppmv_val = co2_ppmv_diag(g) -!!!# else -!!!# co2_ppmv_val = co2_ppmv -!!!# end if -!!!# forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) -!!!# atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot -!!!# if (use_c13) then -!!!# atm2lnd_inst%forc_pc13o2_grc(g) = co2_ppmv_val * c13ratio * 1.e-6_r8 * forc_pbot -!!!# end if -!!!# end do -!!!# -!!!# !-------------------------- -!!!# ! Flooding back from river -!!!# !-------------------------- -!!!# -!!!# ! sign convention is positive downward and hierarchy is atm/glc/lnd/rof/ice/ocn. -!!!# ! so water sent from rof to land is negative, -!!!# ! change the sign to indicate addition of water to system. -!!!# -!!!# if (rof_prognostic) then -!!!# call state_getimport(importState, 'Flrr_flood', bounds, output=wateratm2lndbulk_inst%forc_flood_grc, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# wateratm2lndbulk_inst%forc_flood_grc(:) = -wateratm2lndbulk_inst%forc_flood_grc(:) -!!!# else - wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 -!!!# end if -!!!# -!!!# if (rof_prognostic) then -!!!# call state_getimport(importState, 'Flrr_volr', bounds, output=wateratm2lndbulk_inst%volr_grc, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# wateratm2lndbulk_inst%volr_grc(:) = wateratm2lndbulk_inst%volr_grc(:) * (ldomain%area(:) * 1.e6_r8) -!!!# else -!!!# wateratm2lndbulk_inst%volr_grc(:) = 0._r8 -!!!# end if -!!!# -!!!# if (rof_prognostic) then -!!!# call state_getimport(importState, 'Flrr_volrmch', bounds, output=wateratm2lndbulk_inst%volrmch_grc, rc=rc ) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# wateratm2lndbulk_inst%volrmch_grc(:) = wateratm2lndbulk_inst%volrmch_grc(:) * (ldomain%area(:) * 1.e6_r8) -!!!# else -!!!# wateratm2lndbulk_inst%volrmch_grc(:) = 0._r8 -!!!# end if -!!!# -!!!# !-------------------------- -!!!# ! Land-ice (glc) fields -!!!# !-------------------------- -!!!# -!!!# if (glc_present) then -!!!# ! We could avoid setting these fields if glc_present is .false., if that would -!!!# ! help with performance. (The downside would be that we wouldn't have these fields -!!!# ! available for diagnostic purposes or to force a later T compset with dlnd.) -!!!# -!!!# do num = 0,glc_nec -!!!# call state_getimport(importState, 'Sg_ice_covered_elev', bounds, frac_grc(:,num), ungridded_index=num+1, rc=rc) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# call state_getimport(importState, 'Sg_topo_elev' , bounds, topo_grc(:,num), ungridded_index=num+1, rc=rc) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# call state_getimport(importState, 'Flgg_hflx_elev' , bounds, hflx_grc(:,num), ungridded_index=num+1, rc=rc) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# end do -!!!# call state_getimport(importState, 'Sg_icemask' , bounds, icemask_grc, rc=rc) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# call state_getimport(importState, 'Sg_icemask_coupled_fluxes', bounds, icemask_grc, rc=rc) -!!!# if (ChkErr(rc,__LINE__,u_FILE_u)) return -!!!# -!!!# call glc2lnd_inst%set_glc2lnd_fields_nuopc( bounds, glc_present, & -!!!# frac_grc, topo_grc, hflx_grc, icemask_grc, icemask_coupled_fluxes_grc) -!!!# end if + ! ! Atmosphere prognostic/prescribed aerosol fields + + ! ! bcphidry + ! call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,1), & + ! ungridded_index=1, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! ! bcphodry + ! call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,2), & + ! ungridded_index=2, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! ! bcphiwet + ! call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,3), & + ! ungridded_index=3, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ! ocphidry + ! call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,4), & + ! ungridded_index=1, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! ! bcphodry + ! call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,5), & + ! ungridded_index=2, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! ! bcphiwet + ! call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,6), & + ! ungridded_index=3, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,7), & + ! ungridded_index=1, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,8), & + ! ungridded_index=1, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,9), & + ! ungridded_index=2, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,10), & + ! ungridded_index=2, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,11), & + ! ungridded_index=3, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,12), & + ! ungridded_index=3, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,13), & + ! ungridded_index=4, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,14), & + ! ungridded_index=4, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! call state_getimport(importState, 'Sa_methane', bounds, output=atm2lnd_inst%forc_pch4_grc, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ! The mediator is sending ndep in units if kgN/m2/s - and ctsm uses units of gN/m2/sec + ! ! so the following conversion needs to happen + + ! call state_getimport(importState, 'Faxa_nhx', bounds, output=forc_nhx, ungridded_index=1, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_getimport(importState, 'Faxa_noy', bounds, output=forc_noy, ungridded_index=2, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! do g = begg,endg + ! atm2lnd_inst%forc_ndep_grc(g) = (forc_nhx(g) + forc_noy(g))*1000._r8 + ! end do + + !-------------------------- + ! Set force flood back from river to 0 + !-------------------------- + + wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 !-------------------------- ! Derived quantities @@ -725,7 +314,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & atm2lnd_inst%forc_wind_grc(g) = sqrt(atm2lnd_inst%forc_u_grc(g)**2 + atm2lnd_inst%forc_v_grc(g)**2) atm2lnd_inst%forc_solar_grc(g) = atm2lnd_inst%forc_solad_grc(g,1) + atm2lnd_inst%forc_solai_grc(g,1) + & - atm2lnd_inst%forc_solad_grc(g,2) + atm2lnd_inst%forc_solai_grc(g,2) + atm2lnd_inst%forc_solad_grc(g,2) + atm2lnd_inst%forc_solai_grc(g,2) wateratm2lndbulk_inst%forc_rain_not_downscaled_grc(g) = forc_rainc(g) + forc_rainl(g) wateratm2lndbulk_inst%forc_snow_not_downscaled_grc(g) = forc_snowc(g) + forc_snowl(g) @@ -742,7 +331,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & if (1==2) then if ((forc_rainc(g)+forc_rainl(g)) > 0._r8) then forc_q = 0.95_r8*qsat - !forc_q = qsat + !forc_q = qsat wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = forc_q endif endif @@ -782,7 +371,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & end subroutine import_fields -!============================================================================== + !============================================================================== subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) @@ -908,12 +497,6 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & input=waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! co2 from land - if (flds_co2b .or. flds_co2c) then - call state_setexport(exportState, 'Fall_fco2_lnd', bounds, lnd2atm_inst%net_carbon_exchange_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! dry dep velocities do num = 1, drydep_nflds call state_setexport(exportState, 'Sl_ddvel', bounds, input=lnd2atm_inst%ddvel_grc(:,num), & @@ -1028,166 +611,8 @@ end subroutine fldlist_add !=============================================================================== - subroutine fldlist_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, ESMF_FieldBundle - use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleAdd, ESMF_StateAdd - use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU - - ! input/output variables - type(ESMF_State) , intent(inout) :: state - type(fld_list_type) , intent(in) :: fldList(:) - integer , intent(in) :: numflds - character(len=*) , intent(in) :: flds_scalar_name - integer , intent(in) :: flds_scalar_num - character(len=*) , intent(in) :: tag - type(ESMF_Mesh) , intent(in) :: mesh - integer , intent(inout) :: rc - - ! local variables - integer :: n - type(ESMF_Field) :: field - character(len=80) :: stdname - character(len=*),parameter :: subname='(lnd_import_export:fldlist_realize)' - type (ESMF_FieldBundle) :: l2c_fb , c2l_fb - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - -!! do n = 1, numflds -!! stdname = fldList(n)%stdname -!! 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) -!! ! 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 -!! ! Create the field -!! 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 -!! call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & -!! ESMF_LOGMSG_INFO) -!! endif -!! -!! ! NOW call NUOPC_Realize -!! call NUOPC_Realize(state, field=field, rc=rc) -!! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return -!! else -!! if (stdname /= trim(flds_scalar_name)) then -!! call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(stdname) // " is not connected.", & -!! 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 -!! end if -!! end do - - - - - - - l2c_fb = ESMF_FieldBundleCreate (name="l2c_fb", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - do n = 1, numflds - stdname = fldList(n)%stdname - 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) - ! 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 - ! Create the field - 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 - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & - ESMF_LOGMSG_INFO) - endif - call ESMF_FieldBundleAdd(l2c_fb, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - call ESMF_StateAdd(state, (/l2c_fb/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - if (masterproc .and. debug > 0) then - write(iulog,F01)' lnd2atm_l_state is filld with l2c_fb field bundle!' - end if - end do - - - - - - - - - - - contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 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 - integer , intent(in) :: flds_scalar_num - integer , intent(inout) :: rc - - ! local variables - type(ESMF_Distgrid) :: distgrid - type(ESMF_Grid) :: grid - character(len=*), parameter :: subname='(lnd_import_export:SetScalarField)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - ! create a DistGrid with a single index space element, which gets mapped onto DE 0. - distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - grid = ESMF_GridCreate(distgrid, rc=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/), gridToFieldMap=(/2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - end subroutine SetScalarField - - end subroutine fldlist_realize - - !=============================================================================== - subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) - use ESMF , only : ESMF_Field, ESMF_FieldBundle - use ESMF , only : ESMF_FieldBundleGet ! ---------------------------------------------- ! Map import state field to output array ! ---------------------------------------------- @@ -1228,10 +653,10 @@ subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) ! print out what is in our state??? if (masterproc .and. debug > 0) then - write(iulog,F01)' Show me what is in the state? for '//trim(fldname) - call ESMF_StatePrint(state, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + write(iulog,F01)' Show me what is in the state? for '//trim(fldname) + call ESMF_StatePrint(state, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if ! Determine if fieldbundle exists in state call ESMF_StateGet(state, "c2l_fb", itemFlag, rc=rc) @@ -1240,19 +665,19 @@ subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) ! if fieldbundle exists then create output array - else do nothing if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - ! Get the field bundle??? - call ESMF_StateGet(state, "c2l_fb", fieldBundle, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Get the field bundle??? + call ESMF_StateGet(state, "c2l_fb", fieldBundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//'c2l_fb found and now ... getting '//trim(fldname), ESMF_LOGMSG_INFO) - call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=field, isPresent=isPresent, rc=rc) - !call ESMF_FieldBundleGet(fieldBundle,field=field, rc=rc) - !call ESMF_FieldBundleGet(fieldBundle, fieldCount=fieldCount, rc=rc) + call ESMF_LogWrite(subname//'c2l_fb found and now ... getting '//trim(fldname), ESMF_LOGMSG_INFO) + call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=field, isPresent=isPresent, rc=rc) + !call ESMF_FieldBundleGet(fieldBundle,field=field, rc=rc) + !call ESMF_FieldBundleGet(fieldBundle, fieldCount=fieldCount, rc=rc) - ! Now for error checking we can put ... if (isPresent...) + ! Now for error checking we can put ... if (isPresent...) ! get field pointer if (present(ungridded_index)) then write(cvalue,*) ungridded_index @@ -1284,8 +709,8 @@ subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) n = g - bounds%begg + 1 output(g) = fldptr1d(n) if (masterproc .and. debug > 0 .and. get_nstep() < 5) then - write(iulog,F02)' n, g , fldptr1d(n) '//trim(fldname)//' = ',n, g, fldptr1d(n) - end if + write(iulog,F02)' n, g , fldptr1d(n) '//trim(fldname)//' = ',n, g, fldptr1d(n) + end if end do end if @@ -1410,12 +835,6 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) ! Get pointer to a state field ! ---------------------------------------------- - use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_FieldBundle - use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet - use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE - use ESMF , only : ESMF_FieldBundleGet - ! input/output variables type(ESMF_State), intent(in) :: State character(len=*), intent(in) :: fldname @@ -1443,7 +862,7 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) call ESMF_StateGet(state, "c2l_fb", itemFlag, rc=rc) !call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + ! Get the fieldbundle from state... call ESMF_StateGet(state, "c2l_fb", fieldBundle, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1478,7 +897,7 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (masterproc .and. debug > 0) then write(iulog,F01)' in '//trim(subname)//'fldptr1d for '//trim(fldname)//' is ' - end if + end if !print *, "FLDPTR1D is" !print *, FLDPTR1d else if (present(fldptr2d)) then @@ -1499,7 +918,7 @@ subroutine check_for_nans(array, fname, begg) real(r8) , intent(in) :: array(:) character(len=*) , intent(in) :: fname integer , intent(in) :: begg -! + ! ! local variables integer :: i !------------------------------------------------------------------------------- diff --git a/src/cpl/lilac/lnd_shr_methods.F90 b/src/cpl/lilac/lnd_shr_methods.F90 index d0fda756fa..c20a3e4360 100644 --- a/src/cpl/lilac/lnd_shr_methods.F90 +++ b/src/cpl/lilac/lnd_shr_methods.F90 @@ -1,243 +1,24 @@ module lnd_shr_methods - use ESMF , only : operator(<), operator(/=), operator(+) - use ESMF , only : operator(-), operator(*) , operator(>=) - use ESMF , only : operator(<=), operator(>), operator(==) - use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR, ESMF_MAXSTR - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE - use ESMF , only : ESMF_State, ESMF_StateGet - use ESMF , only : ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet - use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_Mesh, ESMF_MeshGet - use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE - use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet - use ESMF , only : ESMF_ClockPrint, ESMF_ClockAdvance - use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet - use ESMF , only : ESMF_Calendar, ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN - use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMGetCurrent + use ESMF use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort - use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit implicit none private - public :: memcheck - public :: log_clock_advance - public :: state_getscalar - public :: state_setscalar public :: state_diagnose - public :: alarmInit public :: chkerr - private :: timeInit private :: field_getfldptr - ! Clock and alarm options - character(len=*), private, parameter :: & - optNONE = "none" , & - optNever = "never" , & - optNSteps = "nsteps" , & - optNStep = "nstep" , & - optNSeconds = "nseconds" , & - optNSecond = "nsecond" , & - optNMinutes = "nminutes" , & - optNMinute = "nminute" , & - optNHours = "nhours" , & - optNHour = "nhour" , & - optNDays = "ndays" , & - optNDay = "nday" , & - optNMonths = "nmonths" , & - optNMonth = "nmonth" , & - optNYears = "nyears" , & - optNYear = "nyear" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optDate = "date" , & - optIfdays0 = "ifdays0" - ! Module data - integer, parameter :: SecPerDay = 86400 ! Seconds per day - integer, parameter :: memdebug_level=1 - character(len=1024) :: msgString + character(len=1024) :: msgString character(len=*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== contains -!=============================================================================== - - subroutine memcheck(string, level, mastertask) - - ! input/output variables - character(len=*) , intent(in) :: string - integer , intent(in) :: level - logical , intent(in) :: mastertask - - ! local variables - integer :: ierr - integer, external :: GPTLprint_memusage - !----------------------------------------------------------------------- - - if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then - ierr = GPTLprint_memusage(string) - endif - - end subroutine memcheck - -!=============================================================================== - - subroutine log_clock_advance(clock, component, logunit, rc) - - ! input/output variables - type(ESMF_Clock) :: clock - character(len=*) , intent(in) :: component - integer , intent(in) :: logunit - integer , intent(out) :: rc - - ! local variables - character(len=CL) :: cvalue, prestring - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - write(prestring, *) "------>Advancing ",trim(component)," from: " - call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, preString=trim(prestring), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(logunit, *) trim(cvalue) - - call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & - preString="--------------------------------> to: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(logunit, *) trim(cvalue) - - end subroutine log_clock_advance - -!=============================================================================== - - subroutine 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 - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State), intent(in) :: state - integer, intent(in) :: scalar_id - real(r8), intent(out) :: scalar_value - character(len=*), intent(in) :: flds_scalar_name - integer, intent(in) :: flds_scalar_num - integer, intent(inout) :: rc - - ! local variables - integer :: mytask, ierr, len - type(ESMF_VM) :: vm - type(ESMF_Field) :: field - real(r8), pointer :: farrayptr(:,:) - real(r8) :: tmp(1) - character(len=*), parameter :: subname='(state_getscalar)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call ESMF_VMGetCurrent(vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(subname//'after VMGetCurrent', ESMF_LOGMSG_INFO) - call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//'after VMGet', ESMF_LOGMSG_INFO) - - call ESMF_LogWrite(subname//'before ESMF_StateGet', ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//'or field is '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//'after ESMF_StateGet', ESMF_LOGMSG_INFO) - - if (mytask == 0) then - call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) - if (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 = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - endif - tmp(:) = farrayptr(scalar_id,:) - endif - call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - scalar_value = tmp(1) - - end subroutine state_getscalar - -!================================================================================ - - subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) - - ! ---------------------------------------------- - ! Set scalar data from State for a particular name - ! ---------------------------------------------- - - ! 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 - integer, intent(in) :: flds_scalar_num - integer, intent(inout) :: rc - - ! local variables - integer :: mytask - type(ESMF_Field) :: lfield - type(ESMF_VM) :: vm - real(r8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(state_setscalar)' - ! ---------------------------------------------- - - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - - - rc = ESMF_SUCCESS - - call ESMF_VMGetCurrent(vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//'after VMGetCurrent', ESMF_LOGMSG_INFO) - - call ESMF_VMGet(vm, localPet=mytask, rc=rc) - call ESMF_LogWrite(subname//'after VMGet', ESMF_LOGMSG_INFO) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - print *, trim(flds_scalar_name) - - call ESMF_LogWrite(subname//'before ESMF_StateSet', ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//'itemName:'//trim(flds_scalar_name), ESMF_LOGMSG_INFO) - !call ESMF_LogWrite(subname//'State: '//State, ESMF_LOGMSG_INFO) - !print *, 'itemName:', trim(flds_scalar_name) - !print *, 'lfield:', lfield - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - call ESMF_LogWrite(subname//'before FieldGet', ESMF_LOGMSG_INFO) - !print *, 'lfield:', lfield - !print *, 'this farrayptr is ', farrayptr - call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) - if (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) - rc = ESMF_FAILURE - return - endif - farrayptr(scalar_id,1) = scalar_value - endif - - end subroutine state_setscalar - !=============================================================================== subroutine state_diagnose(State, string, rc) @@ -416,359 +197,6 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) end subroutine field_getfldptr -!=============================================================================== - - subroutine alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code - - ! local variables - type(ESMF_Calendar) :: cal ! calendar - integer :: lymd ! local ymd - integer :: ltod ! local tod - integer :: cyy,cmm,cdd,csec ! time info - character(len=64) :: lalarmname ! local alarm name - logical :: update_nextalarm ! update next alarm - type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next restart alarm time - type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - integer :: sec - character(len=*), parameter :: subname = '(set_alarmInit): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - lalarmname = 'alarm_unknown' - if (present(alarmname)) lalarmname = trim(alarmname) - ltod = 0 - if (present(opt_tod)) ltod = opt_tod - lymd = -1 - if (present(opt_ymd)) lymd = opt_ymd - - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - ! Determine calendar - call ESMF_ClockGet(clock, calendar=cal) - - ! Determine inputs for call to create alarm - selectcase (trim(option)) - - case (optNONE) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optDate) - if (.not. present(opt_ymd)) then - call shr_sys_abort(subname//trim(option)//' requires opt_ymd') - end if - if (lymd < 0 .or. ltod < 0) then - call shr_sys_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call timeInit(NextAlarm, lymd, cal, ltod, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optIfdays0) - if (.not. present(opt_ymd)) then - call shr_sys_abort(subname//trim(option)//' requires opt_ymd') - end if - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNSteps) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNStep) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSecond) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinutes) - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinute) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHour) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDay) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonth) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNYears) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNYear) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case default - call shr_sys_abort(subname//'unknown option '//trim(option)) - - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & - ringInterval=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine alarmInit - -!=============================================================================== - - subroutine timeInit( Time, ymd, cal, tod, rc) - - ! Create the ESMF_Time object corresponding to the given input time, - ! given in YMD (Year Month Day) and TOD (Time-of-day) format. - ! Set the time by an integer as YYYYMMDD and integer seconds in the day - - ! input/output parameters: - type(ESMF_Time) , intent(inout) :: Time ! ESMF time - integer , intent(in) :: ymd ! year, month, day YYYYMMDD - type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar - integer , intent(in) :: tod ! time of day in seconds - integer , intent(out) :: rc - - ! local variables - integer :: year, mon, day ! year, month, day as integers - integer :: tdate ! temporary date - integer :: date ! coded-date (yyyymmdd) - character(len=*), parameter :: subname='(timeInit)' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if ( (ymd < 0) .or. (tod < 0) .or. (tod > SecPerDay) )then - call shr_sys_abort( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) - end if - - tdate = abs(date) - year = int(tdate/10000) - if (date < 0) year = -year - mon = int( mod(tdate,10000)/ 100) - day = mod(tdate, 100) - - call ESMF_TimeSet( Time, yy=year, mm=mon, dd=day, s=tod, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine timeInit - !=============================================================================== logical function chkerr(rc, line, file) @@ -786,9 +214,4 @@ logical function chkerr(rc, line, file) endif end function chkerr - - - - ! FROM - end module lnd_shr_methods diff --git a/src/cpl/lilac/shr_utils_mod.F90 b/src/cpl/lilac/shr_utils_mod.F90 deleted file mode 100644 index 90aba85801..0000000000 --- a/src/cpl/lilac/shr_utils_mod.F90 +++ /dev/null @@ -1,47 +0,0 @@ -module shr_utils_mod - - use shr_sys_mod, only : shr_sys_abort - implicit none - private - - public :: shr_utils_ChkErr - - character(*), parameter :: u_FILE_u = __FILE__ - -!========================================================= -contains -!========================================================= - - logical function shr_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 - - ! input/output arguments - integer , intent(in) :: rc - integer , intent(in) :: line - character(len=*) , intent(in) :: file - logical, optional , intent(in) :: mpierr - - ! local variables - character(MPI_MAX_ERROR_STRING) :: lstring - integer :: dbrc, lrc, len, ierr - !------------------------------------------ - - shr_utils_ChkErr = .false. - lrc = rc - if (present(mpierr) .and. mpierr) then - if (rc == MPI_SUCCESS) return - call MPI_ERROR_STRING(rc, lstring, len, ierr) - call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file, rc=dbrc) - lrc = ESMF_FAILURE - endif - - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then - shr_utils_ChkErr = .true. - endif - - end function shr_utils_ChkErr - -end module shr_utils_mod From 0011114aff6dc50d85c19effe13aec47cd7604f2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 27 Nov 2019 19:09:07 -0700 Subject: [PATCH 168/556] incremental changes to expose what still needs to be done for the lilac cap --- src/cpl/lilac/lnd_comp_esmf.F90 | 161 ++++++++------------------- src/cpl/lilac/lnd_import_export.F90 | 164 +++++++++------------------- 2 files changed, 99 insertions(+), 226 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 87db539ad6..a1317fb467 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -4,29 +4,37 @@ module lnd_comp_esmf ! This is the ESMF cap for CTSM !---------------------------------------------------------------------------- + ! External libraries use ESMF + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE use mct_mod , only : mct_world_init, mct_world_clean, mct_die + use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 + use perf_mod , only : t_startf, t_stopf, t_barrierf + + ! ctsm and share code use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl use shr_sys_mod , only : shr_sys_abort - use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit - use shr_orb_mod , only : shr_orb_decl + use shr_file_mod , only : shr_file_setLogUnit, shr_file_getLogUnit + use shr_orb_mod , only : shr_orb_decl, shr_orb_params use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date use spmdMod , only : masterproc, mpicom, spmd_init use decompMod , only : bounds_type, ldecomp, get_proc_bounds use domainMod , only : ldomain use controlMod , only : control_setNL use clm_varorb , only : eccen, obliqr, lambm0, mvelpp - use clm_varctl , only : single_column, clm_varctl_set, iulog + use clm_varctl , only : clm_varctl_set, iulog, finidat use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch + use clm_varctl , only : inst_index, inst_suffix, inst_name use clm_time_manager , only : set_timemgr_init, advance_timestep use clm_time_manager , only : set_nextsw_cday, update_rad_dtime use clm_time_manager , only : get_nstep, get_step_size - use clm_time_manager , only : get_curr_date, get_curr_calday + use clm_time_manager , only : get_curr_date, get_curr_calday, set_nextsw_cday use clm_initializeMod , only : initialize1, initialize2 use clm_driver , only : clm_drv - use perf_mod , only : t_startf, t_stopf, t_barrierf use lnd_import_export , only : import_fields, export_fields use lnd_shr_methods , only : chkerr, state_diagnose + use spmdMod , only : masterproc, spmd_init + use glc_elevclass_mod , only : glc_elevclass_init implicit none private ! By default make data private except @@ -40,15 +48,14 @@ module lnd_comp_esmf ! Private module data !-------------------------------------------------------------------------- - integer , parameter :: dbug_flag = 6 - type(ESMF_Field), public, save :: field + integer , parameter :: dbug_flag = 6 + type(ESMF_Field), public, save :: field - logical :: glc_present = .false. ! .true. => running with a non-stubGLC model - logical :: rof_prognostic = .false. ! .true. => running with a prognostic ROF model - integer, parameter :: memdebug_level=1 - integer, parameter :: dbug = 1 - character(*) ,parameter :: modName = "lnd_comp_esmf" - character(*),parameter :: u_FILE_u = & + integer :: glc_nec = 10 ! number of glc elevation classes + integer, parameter :: memdebug_level=1 + integer, parameter :: dbug = 1 + character(*) , parameter :: modName = "lnd_comp_esmf" + character(*), parameter :: u_FILE_u = & __FILE__! type(ESMF_Mesh) :: Emesh, EMeshTemp, lnd_mesh ! esmf meshes @@ -91,23 +98,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Initialize land surface model and obtain relevant atmospheric model arrays ! back from (i.e. albedos, surface temperature and snow cover over land). - use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel - use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel - use shr_file_mod , only : shr_file_getUnit, shr_file_setIO - use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, set_nextsw_cday - use clm_initializeMod , only : initialize1, initialize2 - use clm_varctl , only : finidat,single_column, clm_varctl_set, noland - use clm_varctl , only : inst_index, inst_suffix, inst_name - use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch - use clm_varorb , only : eccen, obliqr, lambm0, mvelpp - use controlMod , only : control_setNL - use spmdMod , only : masterproc, spmd_init - use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst - use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE - use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 - use glc_elevclass_mod , only : glc_elevclass_init - use shr_orb_mod , only : shr_orb_params - ! input/output variables type(ESMF_GridComp) :: comp ! CLM gridded component type(ESMF_State) :: import_state ! CLM import state @@ -144,7 +134,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type logical :: atm_aero ! Flag if aerosol data sent from atm model integer :: lbnum ! input to memory diagnostic - integer :: shrlogunit,shrloglev ! old values for log unit and log level + integer :: shrlogunit ! old values for log unit and log level integer :: logunit ! original log unit type(bounds_type) :: bounds ! bounds integer :: nfields @@ -183,7 +173,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) type(ESMF_FieldBundle) :: c2l_fb type(ESMF_FieldBundle) :: l2c_fb type(ESMF_State) :: importState, exportState - integer :: glc_nec = 10 ! number of glc elevation classes integer :: compid ! component id character(len=32), parameter :: sub = 'lnd_init' character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" @@ -251,35 +240,23 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !--- Log File --- !------------------------------------------------------------------------ - inst_name = 'LND' - inst_index = 1 - inst_suffix = "" + inst_name = 'LND'; inst_index = 1; inst_suffix = "" ! Initialize io log unit - !! TODO: Put this in a subroutine..... call shr_file_getLogUnit (shrlogunit) if (masterproc) then - inquire(file='lnd_modelio.nml'//trim(inst_suffix),exist=exists) - if (exists) then - iulog = shr_file_getUnit() - call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),iulog) - end if write(iulog,format) "CLM land model initialization" else iulog = shrlogunit end if - - call shr_file_getLogLevel(shrloglev) call shr_file_setLogUnit (iulog) !------------------------------------------------------------------------ !--- Orbital Values --- !------------------------------------------------------------------------ - ! TODO: orbital values should be provided by lilac - but for now lets use defaults - !! hard wire these these in and we can decide on maybe having a - !namelist/ + !! hard wire these these in and we can decide on maybe having a namelist/ !call shr_cal_date2ymd(ymd,year,month,day) !orb_cyear = orb_iyear + (year - orb_iyear_align) @@ -370,8 +347,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call clm_varctl_set(caseid_in=caseid, nsrest_in=nsrest) call ESMF_LogWrite(subname//"default values for run control variables are set...", ESMF_LOGMSG_INFO) - - !---------------------- ! Initialize glc_elevclass module !---------------------- @@ -390,9 +365,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! obtain global index array for just land points which includes mask=0 or ocean points call get_proc_bounds( bounds ) - !print ,* "bound is :", bounds - !print ,* "bounds%begg :", bounds%begg - !print ,* "bounds%endg : ", bounds%endg nlnd = bounds%endg - bounds%begg + 1 allocate(gindex_lnd(nlnd)) !print ,* "nlnd is :", nlnd @@ -520,28 +492,15 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb/), rc=rc) !call ESMF_StateAdd(exportState, fieldbundleList = (/l2c_fb/), rc=rc) - - - - - - - - - - !-------------------------------- ! Create land export state !-------------------------------- call ESMF_LogWrite(subname//"Creating land export state", ESMF_LOGMSG_INFO) - ! FIXME (NS, 2019-07-30) - ! FIX THIS EXPORT STATES!!!!!! MAYBE REWRITE WITH THE ORIGINAL STRUCTURE - ! IN MIND - ! Fill in export state at end of initialization - call export_fields(comp, bounds, glc_present, rof_prognostic, & - water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) + call export_fields(comp, bounds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -556,7 +515,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out end if - ! Set nextsw_cday call set_nextsw_cday( nextsw_cday ) @@ -584,11 +542,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - ! Reset shr logging to original values - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - #if (defined _MEMTRACE) if(masterproc) then write(iulog,*) TRIM(Sub) // ':end::' @@ -631,10 +584,6 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) ! Run CTSM !------------------------ - use clm_instMod , only : water_inst, atm2lnd_inst, glc2lnd_inst, lnd2atm_inst, lnd2glc_inst - use lnd_import_export , only : import_fields, export_fields - use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst - ! input/output variables type(ESMF_GridComp) :: gcomp ! CLM gridded component type(ESMF_State) :: import_state ! CLM import state @@ -675,21 +624,13 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) real(r8) :: eccf ! earth orbit eccentricity factor type(bounds_type) :: bounds ! bounds character(len=32) :: rdate ! date char string for restart file names - integer :: shrlogunit ! original log unit character(len=*),parameter :: subname=trim(modName)//':[lnd_run] ' - character(*),parameter :: F02 = "('[lnd_comp_esmf] ',a, d26.19)" !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call shr_file_getLogUnit (shrlogunit) - call shr_file_setLogUnit (iulog) - call ESMF_LogWrite(subname//' shr_file_getLogunits....', ESMF_LOGMSG_INFO) - #if (defined _MEMTRACE) if(masterproc) then lbnum=1 @@ -717,17 +658,19 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) !if (ChkErr(rc,__LINE__,u_FILE_u)) return !read(cvalue,*) mvelpp + !-------------------------------- + ! Get processor bounds + !-------------------------------- + + call get_proc_bounds(bounds) + !-------------------------------- ! Unpack import state !-------------------------------- call t_startf ('lc_lnd_import') - - call get_proc_bounds(bounds) - call ESMF_LogWrite(subname//'after get_proc_bounds', ESMF_LOGMSG_INFO) - call import_fields( gcomp , bounds, glc_present, rof_prognostic, atm2lnd_inst, glc2lnd_inst, water_inst%wateratm2lndbulk_inst, rc ) + call import_fields( gcomp, bounds, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf ('lc_lnd_import') !-------------------------------- @@ -843,27 +786,25 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) if (masterproc) then write(iulog,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' - write(iulog,* ) 'doalb : ', doalb + write(iulog,*) 'doalb : ', doalb write(iulog,*) 'call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, decl' write(iulog,*) 'call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, decl' - write(iulog,F02) 'calday is : ', calday - write(iulog,F02) 'eccen is : ', eccen - write(iulog,F02) 'mvelpp is : ', mvelpp - write(iulog,F02) 'lambm0 is : ', lambm0 - write(iulog,F02) 'obliqr is : ', obliqr + write(iulog,F02) 'calday is : ', calday + write(iulog,F02) 'eccen is : ', eccen + write(iulog,F02) 'mvelpp is : ', mvelpp + write(iulog,F02) 'lambm0 is : ', lambm0 + write(iulog,F02) 'obliqr is : ', obliqr write(iulog,F02) 'clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic)' - write(iulog,F02) 'declin is : ', declin - write(iulog,F02) 'declinp1 is : ', declinp1 - write(iulog,F02) 'rof_prognostic : ', rof_prognostic + write(iulog,F02) 'declin is : ', declin + write(iulog,F02) 'declinp1 is : ', declinp1 write(iulog,* ) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' end if call t_stopf ('shr_orb_decl') - call t_startf ('ctsm_run') - ! Restart File - use nexttimestr rather than currtimestr here since that is the time at the end of ! the timestep and is preferred for restart file names + ! TODO: is this correct for lilac? call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -871,8 +812,8 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync, mon_sync, day_sync, tod_sync - call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic) - + call t_startf ('ctsm_run') + call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic=.false.) call t_stopf ('ctsm_run') !-------------------------------- @@ -880,12 +821,8 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) !-------------------------------- call t_startf ('lc_lnd_export') - - call export_fields(gcomp, bounds, glc_present, rof_prognostic, & - water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) - !call export_fields(exportState, bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - + call export_fields(gcomp, bounds, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf ('lc_lnd_export') !-------------------------------- @@ -933,12 +870,6 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) ! end if !end if - !-------------------------------- - ! Reset shr logging to my original values - !-------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) #if (defined _MEMTRACE) diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 9f8c7c0d5c..3dc2dd66f4 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -5,22 +5,19 @@ module lnd_import_export use shr_infnan_mod , only : isnan => shr_infnan_isnan use shr_string_mod , only : shr_string_listGetName, shr_string_listGetNum use shr_sys_mod , only : shr_sys_abort - use clm_varctl , only : iulog + use shr_const_mod , only : SHR_CONST_TKFRZ, fillvalue=>SHR_CONST_SPVAL + use clm_varctl , only : iulog, co2_ppmv, ndep_from_cpl + use clm_varcon , only : rair, o2_molar_const use clm_time_manager , only : get_nstep + use spmdMod , only : masterproc use decompmod , only : bounds_type use lnd2atmType , only : lnd2atm_type use lnd2glcMod , only : lnd2glc_type use atm2lndType , only : atm2lnd_type - use glc2lndMod , only : glc2lnd_type use domainMod , only : ldomain - use spmdMod , only : masterproc - use seq_drydep_mod , only : seq_drydep_readnl, n_drydep, seq_drydep_init - use shr_megan_mod , only : shr_megan_readnl, shr_megan_mechcomps_n - use shr_fire_emis_mod , only : shr_fire_emis_readnl, shr_fire_emis_mechcomps_n - use shr_carma_mod , only : shr_carma_readnl - use shr_ndep_mod , only : shr_ndep_readnl - use glc_elevclass_mod , only : glc_elevclass_init + use shr_megan_mod , only : shr_megan_mechcomps_n ! TODO: need to add a namelist read nere use lnd_shr_methods , only : chkerr + use clm_instMod , only : atm2lnd_inst, lnd2atm_inst, water_inst implicit none private ! except @@ -45,18 +42,20 @@ module lnd_import_export integer :: fldsFrLnd_num = 0 type (fld_list_type) :: fldsToLnd(fldsMax) type (fld_list_type) :: fldsFrLnd(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + + logical :: glc_present = .false. ! .true. => running with a non-stubGLC model + logical :: rof_prognostic = .false. ! .true. => running with a prognostic ROF model ! from atm->lnd - integer :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn + integer :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn ! from lnd->atm - integer :: drydep_nflds ! number of dry deposition velocity fields lnd-> atm - integer :: megan_nflds ! number of MEGAN voc fields from lnd-> atm - integer :: emis_nflds ! number of fire emission fields from lnd-> atm + integer :: drydep_nflds ! number of dry deposition velocity fields lnd-> atm + integer :: emis_nflds ! number of fire emission fields from lnd-> atm - integer :: glc_nec = 10 ! number of glc elevation classes - integer, parameter :: debug = 1 ! internal debug level + integer :: glc_nec = 10 ! number of glc elevation classes + integer, parameter :: debug = 1 ! internal debug level character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" character(*),parameter :: F02 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d26.19)" @@ -64,44 +63,28 @@ module lnd_import_export __FILE__ character(*),parameter :: modname = "[lnd_import_export]: " - !=============================================================================== +!=============================================================================== contains - !=============================================================================== +!=============================================================================== - subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & - atm2lnd_inst, glc2lnd_inst, wateratm2lndbulk_inst, rc) + subroutine import_fields( gcomp, bounds, rc) !--------------------------------------------------------------------------- ! Convert the input data from the mediator to the land model !--------------------------------------------------------------------------- - use clm_varctl , only: co2_type, co2_ppmv, use_c13, ndep_from_cpl - use clm_varcon , only: rair, o2_molar_const, c13ratio - use shr_const_mod , only: SHR_CONST_TKFRZ - use Wateratm2lndBulkType , only: wateratm2lndbulk_type - ! input/output variabes - type(ESMF_GridComp) :: gcomp - type(bounds_type) , intent(in) :: bounds ! bounds - logical , intent(in) :: glc_present ! .true. => running with a non-stub GLC model - logical , intent(in) :: rof_prognostic ! .true. => running with a prognostic ROF model - type(atm2lnd_type) , intent(inout) :: atm2lnd_inst ! clm internal input data type - type(glc2lnd_type) , intent(inout) :: glc2lnd_inst ! clm internal input data type - type(Wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst - integer , intent(out) :: rc + type(ESMF_GridComp) :: gcomp + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(out) :: rc ! local variables type(ESMF_State) :: importState - type(ESMF_StateItem_Flag) :: itemFlag - real(r8), pointer :: dataPtr(:) - character(len=128) :: fldname integer :: num integer :: begg, endg ! bounds integer :: g,i,k ! indices real(r8) :: e ! vapor pressure (Pa) real(r8) :: qsat ! saturation specific humidity (kg/kg) - real(r8) :: co2_ppmv_diag(bounds%begg:bounds%endg) ! temporary - real(r8) :: co2_ppmv_prog(bounds%begg:bounds%endg) ! temporary real(r8) :: co2_ppmv_val ! temporary real(r8) :: esatw ! saturation vapor pressure over water (Pa) real(r8) :: esati ! saturation vapor pressure over ice (Pa) @@ -117,13 +100,8 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & real(r8) :: forc_snowl(bounds%begg:bounds%endg) ! snowfxl Atm flux mm/s real(r8) :: forc_noy(bounds%begg:bounds%endg) real(r8) :: forc_nhx(bounds%begg:bounds%endg) - real(r8) :: frac_grc(bounds%begg:bounds%endg, 0:glc_nec) real(r8) :: topo_grc(bounds%begg:bounds%endg, 0:glc_nec) - real(r8) :: hflx_grc(bounds%begg:bounds%endg, 0:glc_nec) - real(r8) :: icemask_grc(bounds%begg:bounds%endg) - real(r8) :: icemask_coupled_fluxes_grc(bounds%begg:bounds%endg) character(len=*), parameter :: subname='(lnd_import_export:import_fields)' - !character(len=* ) , parameter :: subname=trim(modname ) //' : (import_fields) ' ! Constants to compute vapor pressure parameter (a0=6.107799961_r8 , a1=4.436518521e-01_r8, & @@ -177,7 +155,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & call state_getimport(importState, 'Sa_ptem', bounds, output=atm2lnd_inst%forc_th_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sa_shum', bounds, output=wateratm2lndbulk_inst%forc_q_not_downscaled_grc, rc=rc) + call state_getimport(importState, 'Sa_shum', bounds, output=water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport(importState, 'Sa_pbot', bounds, output=atm2lnd_inst%forc_pbot_not_downscaled_grc, rc=rc) @@ -287,7 +265,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! Set force flood back from river to 0 !-------------------------- - wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 + water_inst%wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 !-------------------------- ! Derived quantities @@ -295,7 +273,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & do g = begg, endg forc_t = atm2lnd_inst%forc_t_not_downscaled_grc(g) - forc_q = wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) + forc_q = water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) atm2lnd_inst%forc_hgt_u_grc(g) = atm2lnd_inst%forc_hgt_grc(g) !observational height of wind [m] @@ -316,8 +294,8 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & atm2lnd_inst%forc_solar_grc(g) = atm2lnd_inst%forc_solad_grc(g,1) + atm2lnd_inst%forc_solai_grc(g,1) + & atm2lnd_inst%forc_solad_grc(g,2) + atm2lnd_inst%forc_solai_grc(g,2) - wateratm2lndbulk_inst%forc_rain_not_downscaled_grc(g) = forc_rainc(g) + forc_rainl(g) - wateratm2lndbulk_inst%forc_snow_not_downscaled_grc(g) = forc_snowc(g) + forc_snowl(g) + water_inst%wateratm2lndbulk_inst%forc_rain_not_downscaled_grc(g) = forc_rainc(g) + forc_rainl(g) + water_inst%wateratm2lndbulk_inst%forc_snow_not_downscaled_grc(g) = forc_snowc(g) + forc_snowl(g) if (forc_t > SHR_CONST_TKFRZ) then @@ -332,13 +310,13 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & if ((forc_rainc(g)+forc_rainl(g)) > 0._r8) then forc_q = 0.95_r8*qsat !forc_q = qsat - wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = forc_q + water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = forc_q endif endif - wateratm2lndbulk_inst%forc_rh_grc(g) = 100.0_r8*(forc_q / qsat) - wateratm2lndbulk_inst%volr_grc(g) = 0._r8 - wateratm2lndbulk_inst%volrmch_grc(g) = 0._r8 + water_inst%wateratm2lndbulk_inst%forc_rh_grc(g) = 100.0_r8*(forc_q / qsat) + water_inst%wateratm2lndbulk_inst%volr_grc(g) = 0._r8 + water_inst%wateratm2lndbulk_inst%volrmch_grc(g) = 0._r8 end do !-------------------------- @@ -359,7 +337,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ' ERROR: One of the solar fields (indirect/diffuse, vis or near-IR)'// & ' from the atmosphere model is negative or zero' ) end if - if ( wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) < 0.0_r8 )then + if ( water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) < 0.0_r8 )then call shr_sys_abort( subname//& ' ERROR: Bottom layer specific humidty sent from the atmosphere model is less than zero' ) end if @@ -373,42 +351,28 @@ end subroutine import_fields !============================================================================== - subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & - waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) + subroutine export_fields(gcomp, bounds, rc) !------------------------------- ! Pack the export state !------------------------------- - use Waterlnd2atmBulkType , only: waterlnd2atmbulk_type - ! input/output variables - type(ESMF_GridComp) :: gcomp - type(bounds_type) , intent(in) :: bounds ! bounds - logical , intent(in) :: glc_present - logical , intent(in) :: rof_prognostic - type(waterlnd2atmbulk_type) , intent(inout) :: waterlnd2atmbulk_inst - type(lnd2atm_type) , intent(inout) :: lnd2atm_inst ! land to atmosphere exchange data type - type(lnd2glc_type) , intent(inout) :: lnd2glc_inst ! land to atmosphere exchange data type - integer , intent(out) :: rc - - !type(datawrapper) :: wrap2 + type(ESMF_GridComp) :: gcomp + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(out) :: rc + ! local variables - type(ESMF_State) :: exportState - integer :: i, g, num - real(r8) :: array(bounds%begg:bounds%endg) + type(ESMF_State) :: exportState + integer :: i, g, num + real(r8) :: array(bounds%begg:bounds%endg) character(len=*), parameter :: subname='(lnd_import_export:export_fields)' !--------------------------------------------------------------------------- rc = ESMF_SUCCESS - ! Get export state - !call NUOPC_ModelGet(gcomp, exportState=exportState, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Get export state (ESMF) call ESMF_GridCompGet(gcomp, exportState=exportState, rc=rc) ! do we need the clock now? - !call ESMF_GridCompGet(gcomp, exportState, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ----------------------- @@ -425,8 +389,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & call state_setexport(exportState, 'Sl_t', bounds, input=lnd2atm_inst%t_rad_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_snowh', bounds, & - input=waterlnd2atmbulk_inst%h2osno_grc, rc=rc) + call state_setexport(exportState, 'Sl_snowh', bounds, input=water_inst%waterlnd2atmbulk_inst%h2osno_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_setexport(exportState, 'Sl_avsdr', bounds, input=lnd2atm_inst%albd_grc(bounds%begg:,1), rc=rc) @@ -444,7 +407,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & call state_setexport(exportState, 'Sl_tref', bounds, input=lnd2atm_inst%t_ref2m_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_qref', bounds, input=waterlnd2atmbulk_inst%q_ref2m_grc, rc=rc) + call state_setexport(exportState, 'Sl_qref', bounds, input=water_inst%waterlnd2atmbulk_inst%q_ref2m_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_setexport(exportState, 'Sl_u10', bounds, input=lnd2atm_inst%u_ref10m_grc, rc=rc) @@ -465,7 +428,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & call state_setexport(exportState, 'Fall_lwup', bounds, input=lnd2atm_inst%eflx_lwrad_out_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_evap', bounds, input=waterlnd2atmbulk_inst%qflx_evap_tot_grc, minus=.true., rc=rc) + call state_setexport(exportState, 'Fall_evap', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_evap_tot_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_setexport(exportState, 'Fall_swnet', bounds, input=lnd2atm_inst%fsa_grc, rc=rc) @@ -493,8 +456,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & call state_setexport(exportState, 'Sl_fv', bounds, input=lnd2atm_inst%fv_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_soilw', bounds, & - input=waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) + call state_setexport(exportState, 'Sl_soilw', bounds, input=water_inst%waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! dry dep velocities @@ -529,51 +491,33 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! ----------------------- ! surface runoff is the sum of qflx_over, qflx_h2osfc_surf - ! do g = bounds%begg,bounds%endg - ! array(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) - ! end do - call state_setexport(exportState, 'Flrl_rofsur', bounds, input=waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) + ! do g = bounds%begg,bounds%endg + ! array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) + ! end do + + call state_setexport(exportState, 'Flrl_rofsur', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain do g = bounds%begg,bounds%endg - array(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) + array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) end do call state_setexport(exportState, 'Flrl_rofsub', bounds, input=array, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! qgwl sent individually to coupler - call state_setexport(exportState, 'Flrl_rofgwl', bounds, input=waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) + call state_setexport(exportState, 'Flrl_rofgwl', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ice sent individually to coupler - call state_setexport(exportState, 'Flrl_rofi', bounds, input=waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) + call state_setexport(exportState, 'Flrl_rofi', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! irrigation flux to be removed from main channel storage (negative) - call state_setexport(exportState, 'Flrl_irrig', bounds, input=waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) + call state_setexport(exportState, 'Flrl_irrig', bounds, input=water_inst%waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ----------------------- - ! output to glc - ! ----------------------- - - ! We could avoid setting these fields if glc_present is .false., if that would - ! help with performance. (The downside would be that we wouldn't have these fields - ! available for diagnostic purposes or to force a later T compset with dlnd.) - - do num = 0,glc_nec - call state_setexport(exportState, 'Sl_tsrf_elev', bounds, input=lnd2glc_inst%tsrf_grc(:,num), & - ungridded_index=num+1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_topo_elev', bounds, input=lnd2glc_inst%topo_grc(:,num), & - ungridded_index=num+1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Flgl_qice_elev', bounds, input=lnd2glc_inst%qice_grc(:,num), & - ungridded_index=num+1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - end subroutine export_fields !=============================================================================== @@ -736,8 +680,6 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index ! Map input array to export state field ! ---------------------------------------------- - use shr_const_mod, only : fillvalue=>SHR_CONST_SPVAL - ! input/output variables type(ESMF_State) , intent(inout) :: state type(bounds_type) , intent(in) :: bounds From 94dda7797c271fa023712845a274e4c4e477579d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 28 Nov 2019 10:17:05 -0700 Subject: [PATCH 169/556] more changes to clarify time manager input from lilac driver --- src/cpl/lilac/lnd_comp_esmf.F90 | 436 ++++++++++++++++---------------- src/main/clm_initializeMod.F90 | 5 +- src/main/controlMod.F90 | 25 +- 3 files changed, 245 insertions(+), 221 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index a1317fb467..98535e47f4 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -14,7 +14,7 @@ module lnd_comp_esmf ! ctsm and share code use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl use shr_sys_mod , only : shr_sys_abort - use shr_file_mod , only : shr_file_setLogUnit, shr_file_getLogUnit + use shr_file_mod , only : shr_file_setLogUnit, shr_file_getLogUnit use shr_orb_mod , only : shr_orb_decl, shr_orb_params use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date use spmdMod , only : masterproc, mpicom, spmd_init @@ -22,7 +22,7 @@ module lnd_comp_esmf use domainMod , only : ldomain use controlMod , only : control_setNL use clm_varorb , only : eccen, obliqr, lambm0, mvelpp - use clm_varctl , only : clm_varctl_set, iulog, finidat + use clm_varctl , only : clm_varctl_set, iulog, finidat use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch use clm_varctl , only : inst_index, inst_suffix, inst_name use clm_time_manager , only : set_timemgr_init, advance_timestep @@ -34,7 +34,7 @@ module lnd_comp_esmf use lnd_import_export , only : import_fields, export_fields use lnd_shr_methods , only : chkerr, state_diagnose use spmdMod , only : masterproc, spmd_init - use glc_elevclass_mod , only : glc_elevclass_init + use glc_elevclass_mod , only : glc_elevclass_init ! TODO: is this needed? implicit none private ! By default make data private except @@ -48,16 +48,12 @@ module lnd_comp_esmf ! Private module data !-------------------------------------------------------------------------- - integer , parameter :: dbug_flag = 6 - type(ESMF_Field), public, save :: field - - integer :: glc_nec = 10 ! number of glc elevation classes - integer, parameter :: memdebug_level=1 - integer, parameter :: dbug = 1 - character(*) , parameter :: modName = "lnd_comp_esmf" - character(*), parameter :: u_FILE_u = & - __FILE__! - type(ESMF_Mesh) :: Emesh, EMeshTemp, lnd_mesh ! esmf meshes + integer :: glc_nec = 10 ! fixed # of glc elevation classes + integer, parameter :: memdebug_level=1 + integer, parameter :: dbug = 1 + character(*), parameter :: modName = "lnd_comp_esmf" + character(*), parameter :: u_FILE_u = & + __FILE__ !=============================================================================== contains @@ -77,16 +73,18 @@ subroutine lnd_register(comp, rc) print *, "in lnd register routine" rc = ESMF_SUCCESS + call ESMF_LogSet ( flush =.true.) call ESMF_LogWrite(subname//"lnd gridcompset entry points setting ....!", ESMF_LOGMSG_INFO) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, lnd_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, lnd_run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, lnd_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//"lnd gridcompset entry points finished!", ESMF_LOGMSG_INFO) end subroutine lnd_register @@ -106,77 +104,72 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) integer, intent(out) :: rc ! Return code ! local variable + type(ESMF_Mesh) :: lnd_mesh + character(ESMF_MAXSTR) :: lnd_mesh_filename ! full filepath of land mesh file + integer :: ierr integer :: mpicom_lnd, mpicom_vm, gsize - type(ESMF_ArraySpec) :: arrayspec type(ESMF_DistGrid) :: distgrid - type(ESMF_Array) :: dom, l2x, x2l type(ESMF_VM) :: vm - integer :: lsize ! size of attribute vector - integer :: g,i,j ! indices - integer :: dtime_sync ! coupling time-step from the input synchronization clock - integer :: dtime_clm ! clm time-step - logical :: exists ! true if file exists - real(r8) :: nextsw_cday ! calday from clock of next radiation computation - character(len=CL) :: caseid ! case identifier name - character(len=CL) :: ctitle ! case description title - character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) - character(len=CL) :: calendar ! calendar type name - character(len=CL) :: hostname ! hostname of machine running on - character(len=CL) :: version ! Model version - character(len=CL) :: username ! user running the model - integer :: nsrest ! clm restart type - integer :: ref_ymd ! reference date (YYYYMMDD) - integer :: ref_tod ! reference time of day (sec) - integer :: start_ymd ! start date (YYYYMMDD) - integer :: start_tod ! start time of day (sec) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) - logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type - logical :: atm_aero ! Flag if aerosol data sent from atm model - integer :: lbnum ! input to memory diagnostic - integer :: shrlogunit ! old values for log unit and log level - integer :: logunit ! original log unit - type(bounds_type) :: bounds ! bounds + integer :: lsize ! size of attribute vector + integer :: g,i,j ! indices + logical :: exists ! true if file exists + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + character(len=CL) :: caseid ! case identifier name + character(len=CL) :: ctitle ! case description title + character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) + character(len=CL) :: calendar ! calendar type name + character(len=CL) :: hostname ! hostname of machine running on + character(len=CL) :: version ! Model version + character(len=CL) :: username ! user running the model + integer :: nsrest ! clm restart type + integer :: ref_ymd ! reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (sec) + integer :: start_ymd ! start date (YYYYMMDD) + integer :: start_tod ! start time of day (sec) + integer :: stop_ymd ! stop date (YYYYMMDD) + integer :: stop_tod ! stop time of day (sec) + logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type + logical :: atm_aero ! Flag if aerosol data sent from atm model + integer :: lbnum ! input to memory diagnostic + integer :: shrlogunit ! old values for log unit and log level + integer :: logunit ! original log unit + type(bounds_type) :: bounds ! bounds integer :: nfields - real(R8), pointer :: fptr(:, :) - integer :: ierr integer :: ncomps = 1 - integer, pointer :: comps(:) ! array with component ids - integer, pointer :: comms(:) ! array with mpicoms + integer, pointer :: comps(:) ! array with component ids + integer, pointer :: comms(:) ! array with mpicoms character(len=32), allocatable :: compLabels(:) - integer,allocatable :: comp_id(:) ! for pio init2 - character(len=64),allocatable :: comp_name(:) ! for pio init2 - integer,allocatable :: comp_comm(:) ! for pio_init2 - logical,allocatable :: comp_iamin(:) ! for pio init2 - integer,allocatable :: comp_comm_iam(:) ! for pio_init2 - integer :: ymd ! CTSM current date (YYYYMMDD) - integer :: orb_iyear_align ! associated with model year - integer :: orb_cyear ! orbital year for current orbital computation - integer :: orb_iyear ! orbital year for current orbital computation - integer :: orb_eccen ! orbital year for current orbital computation - integer :: yy, mm ,dd , curr_tod, curr_ymd ! orbital year for current orbital computation - type(ESMF_Time) :: currTime ! Current time - type(ESMF_Time) :: startTime ! Start time - type(ESMF_Time) :: stopTime ! Stop time - type(ESMF_Time) :: refTime ! Ref time + integer,allocatable :: comp_id(:) ! for pio init2 + character(len=64),allocatable :: comp_name(:) ! for pio init2 + integer,allocatable :: comp_comm(:) ! for pio_init2 + logical,allocatable :: comp_iamin(:) ! for pio init2 + integer,allocatable :: comp_comm_iam(:) ! for pio_init2 + integer :: ymd ! CTSM current date (YYYYMMDD) + integer :: orb_iyear_align ! associated with model year + integer :: orb_cyear ! orbital year for current orbital computation + integer :: orb_iyear ! orbital year for current orbital computation + integer :: orb_eccen ! orbital year for current orbital computation + integer :: dtime_lilac ! coupling time-step from the input lilac clock + integer :: curr_tod, curr_ymd + integer :: yy, mm, dd + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: startTime ! Start time + type(ESMF_Time) :: stopTime ! Stop time + type(ESMF_Time) :: refTime ! Ref time type(ESMF_TimeInterval) :: timeStep - type(ESMF_Calendar) :: esmf_calendar ! esmf calendar - type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type - integer, pointer :: gindex(:) ! global index space for land and ocean points - integer, pointer :: gindex_lnd(:) ! global index space for just land points - integer, pointer :: gindex_ocn(:) ! global index space for just ocean points - character(ESMF_MAXSTR) :: cvalue ! config data - integer :: nlnd, nocn ! local size ofarrays - integer :: n ! indices - integer :: year, month, day - integer :: dtime ! time step increment (sec) + type(ESMF_Calendar) :: esmf_calendar ! esmf calendar + type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type + integer, pointer :: gindex(:) ! global index space for land and ocean points + integer, pointer :: gindex_lnd(:) ! global index space for just land points + integer, pointer :: gindex_ocn(:) ! global index space for just ocean points + integer :: nlnd, nocn ! local size ofarrays + integer :: n ! indices + integer :: dtime ! time step increment (sec) type(ESMF_FieldBundle) :: c2l_fb type(ESMF_FieldBundle) :: l2c_fb type(ESMF_State) :: importState, exportState - integer :: compid ! component id - character(len=32), parameter :: sub = 'lnd_init' - character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" - character(len=*), parameter :: subname=trim(modName)//': [lnd_init_lilac_cap] ' + integer :: compid ! component id + character(len=*), parameter :: subname=trim(modName)//': [lnd_init] ' !------------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -245,7 +238,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Initialize io log unit call shr_file_getLogUnit (shrlogunit) if (masterproc) then - write(iulog,format) "CLM land model initialization" + write(iulog,*) trim(subname) // "CLM land model initialization" else iulog = shrlogunit end if @@ -274,12 +267,12 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !if ((debug >1) .and. (masterproc)) then if (masterproc) then - write(iulog,*) 'shr_obs_params is setting these:', eccen - write(iulog,*) 'eccen is : ', eccen - write(iulog,*) 'mvelpp is : ', mvelpp + write(iulog,*) trim(subname) // 'shr_obs_params is setting these:', eccen + write(iulog,*) trim(subname) // 'eccen is : ', eccen + write(iulog,*) trim(subname) // 'mvelpp is : ', mvelpp - write(iulog,*) 'lambm0 is : ', lambm0 - write(iulog,*) 'obliqr is : ', obliqr + write(iulog,*) trim(subname) // 'lambm0 is : ', lambm0 + write(iulog,*) trim(subname) // 'obliqr is : ', obliqr end if !---------------------- @@ -287,14 +280,16 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !---------------------- call control_setNL("lnd_in") + ! TODO: how do we set case_name and nsrest - should we hardwire for now? + caseid = 'test_lilac' + nsrest = nsrStartup + !---------------------- - ! Get properties from clock + ! Initialize module variables in clm_time_manger.F90 !---------------------- - call ESMF_ClockGet( clock, & - currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, & - timeStep=timeStep, rc=rc) + currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, timeStep=timeStep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) @@ -324,20 +319,13 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) end if - ! TODO: how do we set case_name and nsrest - should we hardwire for now? - caseid = 'test_lilac' - nsrest = nsrStartup - call ESMF_LogWrite(subname//"time manager Initialized....", ESMF_LOGMSG_INFO) - - !---------------------- - ! Initialize CTSM time manager - !---------------------- + ! The following sets the module variables in clm_time_mamanger.F90 - BUT DOES NOT intialize the + ! clock. Routine timemgr_init (called by initialize1) initializes the clock using the module variables + ! that have been set via calls to set_timemgr_init. call set_timemgr_init( & calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & - ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, stop_ymd_in=stop_ymd, & - stop_tod_in=stop_tod) - call ESMF_LogWrite(subname//"time manager is set now!", ESMF_LOGMSG_INFO) + ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, stop_ymd_in=stop_ymd, stop_tod_in=stop_tod) !---------------------- ! Read namelist, grid and surface data @@ -350,17 +338,38 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !---------------------- ! Initialize glc_elevclass module !---------------------- - call glc_elevclass_init(glc_nec) + + call glc_elevclass_init(glc_nec) ! TODO: is this needed still? !---------------------- - ! Initialize1 + ! Call initialize1 !---------------------- - ! note that the memory for gindex_ocn will be allocated in the following call - call initialize1(gindex_ocn) - ! call initialize1() + call ESMF_TimeIntervalGet(timeStep, s=dtime_lilac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (masterproc) then + write(iulog,*)'dtime_lilac= ',dtime_lilac + end if + + ! Note that routine controlMod.F90 will initialze the dtime module + ! variable in clm_time_manager to the dtime_lilac AND NOT the + ! dtime read in from the clm_inparm namelist in this case. Note + ! that the memory for gindex_ocn will be allocated in the following call + + call initialize1(gindex_ocn=gindex_ocn, dtime_driver=dtime_lilac) + + call ESMF_LogWrite(subname//"ctsm time manager initialized....", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"ctsm initialize1 done...", ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//"initialize1 done...", ESMF_LOGMSG_INFO) + !-------------------------------- + ! generate the land mesh on ctsm distribution + !-------------------------------- + + ! TODO: mesh file should come into clm as a namelist for lilac only + ! for now need to hardwire this in lnd_mesh_filename here + + lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' ! obtain global index array for just land points which includes mask=0 or ocean points call get_proc_bounds( bounds ) @@ -388,120 +397,123 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! create distGrid from global index array DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return deallocate(gindex) call ESMF_LogWrite(subname//"DistGrid created......", ESMF_LOGMSG_INFO) - !-------------------------------- - ! generate the mesh on ctsm distribution - !-------------------------------- - - ! TODO: mesh file should come into clm as a namelist for lilac only - ! for now need to hardwire this in cvalue here - cvalue = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' ! this will need to be filled in to run - - EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, elementDistgrid=Distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (masterproc) then - write(iulog,*)'mesh file for domain is ',trim(cvalue) + write(iulog,*)'mesh file for domain is ',trim(lnd_mesh_filename) end if + call ESMF_LogWrite(subname//" Create Mesh using file ...."//trim(lnd_mesh_filename), ESMF_LOGMSG_INFO) - ! recreate the mesh using the above distGrid - EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_LogWrite(subname//" Create Mesh using distgrid ....", ESMF_LOGMSG_INFO) - lnd_mesh = EMesh !-------------------------------- ! Finish initializing ctsm !-------------------------------- - call ESMF_LogWrite(subname//"before initialize2", ESMF_LOGMSG_INFO) call initialize2() - - call ESMF_LogWrite(subname//"initialize2 done...", ESMF_LOGMSG_INFO) - - !-------------------------------- - ! Check that ctsm internal dtime aligns with ctsm coupling interval - !-------------------------------- - call ESMF_LogWrite(subname//"cheking CTSM dtime and coupling intervals....", ESMF_LOGMSG_INFO) - - call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_TimeIntervalGet( timeStep, s=dtime_sync, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - dtime_clm = get_step_size() - - if (masterproc) then - write(iulog,*)'dtime_sync= ',dtime_sync,' dtime_ctsm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) - end if - if (mod(dtime_sync,dtime_clm) /= 0) then - write(iulog,*)'ctsm dtime ',dtime_clm,' and clock dtime ',dtime_sync,' never align' - rc = ESMF_FAILURE - return - end if + call ESMF_LogWrite(subname//"ctsm initialize2 done...", ESMF_LOGMSG_INFO) !-------------------------------- ! Create import state (only assume input from atm - not rof and glc) !-------------------------------- + ! First create an empty field bundle c2l_fb = ESMF_FieldBundleCreate ( name='c2l_fb', rc=rc) + ! Now add fields on lnd_mesh to this field bundle + call fldbundle_add( 'Sa_z' , c2l_fb,rc) !1 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_topo' , c2l_fb,rc) !2 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_u' , c2l_fb,rc) !3 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_v' , c2l_fb,rc) !4 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_ptem' , c2l_fb,rc) !5 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_pbot' , c2l_fb,rc) !6 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_tbot' , c2l_fb,rc) !7 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_shum' , c2l_fb,rc) !8 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_lwdn' , c2l_fb,rc) !9 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_rainc' , c2l_fb,rc) !10 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_rainl' , c2l_fb,rc) !11 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_snowc' , c2l_fb,rc) !12 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_snowl' , c2l_fb,rc) !13 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swndr' , c2l_fb,rc) !14 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) !15 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) !16 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swvdf' , c2l_fb,rc) !17 + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_z' , c2l_fb,rc) !1 - call fldbundle_add( 'Sa_topo' , c2l_fb,rc) !2 - call fldbundle_add( 'Sa_u' , c2l_fb,rc) !3 - call fldbundle_add( 'Sa_v' , c2l_fb,rc) !4 - call fldbundle_add( 'Sa_ptem' , c2l_fb,rc) !5 - call fldbundle_add( 'Sa_pbot' , c2l_fb,rc) !6 - call fldbundle_add( 'Sa_tbot' , c2l_fb,rc) !7 - call fldbundle_add( 'Sa_shum' , c2l_fb,rc) !8 - - call fldbundle_add( 'Faxa_lwdn' , c2l_fb,rc) !9 - call fldbundle_add( 'Faxa_rainc' , c2l_fb,rc) !10 - call fldbundle_add( 'Faxa_rainl' , c2l_fb,rc) !11 - call fldbundle_add( 'Faxa_snowc' , c2l_fb,rc) !12 - call fldbundle_add( 'Faxa_snowl' , c2l_fb,rc) !13 - call fldbundle_add( 'Faxa_swndr' , c2l_fb,rc) !14 - call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) !15 - call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) !16 - call fldbundle_add( 'Faxa_swvdf' , c2l_fb,rc) !17 call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb/), rc=rc) + !-------------------------------- ! Create export state + !-------------------------------- + ! First create an empty field bundle l2c_fb = ESMF_FieldBundleCreate(name='l2c_fb', rc=rc) - !call fldbundle_add( 'Sl_lfrint' , l2c_fb,rc) !1 - call fldbundle_add( 'Sl_lfrin' , l2c_fb,rc) !1 + + ! Now add fields on lnd_mesh to this field bundle + call fldbundle_add( 'Sl_lfrin' , l2c_fb,rc) !1 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbundle_add( 'Sl_t' , l2c_fb,rc) !2 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbundle_add( 'Sl_tref' , l2c_fb,rc) !3 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbundle_add( 'Sl_qref' , l2c_fb,rc) !4 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbundle_add( 'Sl_avsdr' , l2c_fb,rc) !5 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbundle_add( 'Sl_anidr' , l2c_fb,rc) !6 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbundle_add( 'Sl_avsdf' , l2c_fb,rc) !7 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbundle_add( 'Sl_anidf' , l2c_fb,rc) !8 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbundle_add( 'Sl_snowh' , l2c_fb,rc) !9 - call fldbundle_add( 'Fall_u10' , l2c_fb,rc) !10 - call fldbundle_add( 'Fall_fv' , l2c_fb,rc) !11 - call fldbundle_add( 'Fall_ram1' , l2c_fb,rc) !12 - !call fldbundle_add( 'Fall_taux' , l2c_fb,rc) !10 - !call fldbundle_add( 'Fall_lwup' , l2c_fb,rc) !14 - !call fldbundle_add( 'Fall_evap' , l2c_fb,rc) !15 - !call fldbundle_add( 'Fall_swniet' , l2c_fb,rc) !16 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Fall_u10' , l2c_fb,rc) !10 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Fall_fv' , l2c_fb,rc) !11 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Fall_ram1' , l2c_fb,rc) !12 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call fldbundle_add( 'Fall_taux' , l2c_fb,rc) !10 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call fldbundle_add( 'Fall_lwup' , l2c_fb,rc) !14 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call fldbundle_add( 'Fall_evap' , l2c_fb,rc) !15 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call fldbundle_add( 'Fall_swnet' , l2c_fb,rc) !16 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb/), rc=rc) - !call ESMF_StateAdd(exportState, fieldbundleList = (/l2c_fb/), rc=rc) !-------------------------------- ! Create land export state !-------------------------------- + call ESMF_LogWrite(subname//"Creating land export state", ESMF_LOGMSG_INFO) ! Fill in export state at end of initialization call export_fields(comp, bounds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"Getting Calendar Day of nextsw calculation...", ESMF_LOGMSG_INFO) @@ -509,10 +521,10 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Get calendar day of next sw (shortwave) calculation (nextsw_cday) if (nsrest == nsrStartup) then call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return end if ! Set nextsw_cday @@ -553,31 +565,33 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call ESMF_LogWrite(subname//' CTSM INITIALIZATION DONE SUCCESSFULLY!!!! ', ESMF_LOGMSG_INFO) + !--------------------------- + contains + !--------------------------- + + subroutine fldbundle_add(stdname, fieldbundle,rc) + !--------------------------- + ! Create an empty input field with name 'stdname' to add to fieldbundle + !--------------------------- + + ! input/output variables + character(len=*) , intent(in) :: stdname + type (ESMF_FieldBundle) , intent(inout) :: fieldbundle + integer , intent(out) :: rc + ! local variables + type(ESMF_Field) :: field + !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(stdname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(fieldbundle, (/field/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine fldbundle_add + end subroutine lnd_init !--------------------------------------------------------------------------- - !subroutine fldbundle_add(stdname, fldptr, fieldbundle,rc) - subroutine fldbundle_add(stdname, fieldbundle,rc) - type(ESMF_Field) :: field - !type(ESMF_Mesh) :: lnd_mesh - character(len=*), intent(in) :: stdname - type (ESMF_FieldBundle) :: fieldbundle - integer, intent(out) :: rc - - print *, "in lnd register routine" - - rc = ESMF_SUCCESS - - !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(stdname), rc=rc) - field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(stdname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_FieldBundleAdd(fieldbundle, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - end subroutine fldbundle_add - - !--------------------------------------------------------------------------- subroutine lnd_run(gcomp, import_state, export_state, clock, rc) !------------------------ @@ -597,7 +611,6 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) type(ESMF_Time) :: nextTime type(ESMF_State) :: importState, exportState character(ESMF_MAXSTR) :: cvalue - character(ESMF_MAXSTR) :: case_name ! case name integer :: ymd ! CTSM current date (YYYYMMDD) integer :: yr ! CTSM current year integer :: mon ! CTSM current month @@ -624,8 +637,8 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) real(r8) :: eccf ! earth orbit eccentricity factor type(bounds_type) :: bounds ! bounds character(len=32) :: rdate ! date char string for restart file names - character(len=*),parameter :: subname=trim(modName)//':[lnd_run] ' - character(*),parameter :: F02 = "('[lnd_comp_esmf] ',a, d26.19)" + character(*) , parameter :: F02 = "('[lnd_comp_esmf] ',a, d26.19)" + character(len=*), parameter :: subname=trim(modName)//':[lnd_run] ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -704,7 +717,7 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) nextsw_cday = calday if (masterproc) then - write(iulog,*) 'State_GetScalar ... nextsw_cday is : ', nextsw_cday + write(iulog,*) trim(subname) // '... nextsw_cday is : ', nextsw_cday end if !-------------------------------- @@ -723,11 +736,11 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) if (masterproc) then write(iulog,*) '------------ LILAC ----------------' - write(iulog,*) 'nstep : ', nstep - write(iulog,*) 'dtime : ', dtime - write(iulog,F02) 'calday : ', calday - write(iulog,F02) 'caldayp1 : ', caldayp1 - write(iulog,F02) 'nextsw_cday : ', nextsw_cday + write(iulog,*) trim(subname) // 'nstep : ', nstep + write(iulog,*) trim(subname) // 'dtime : ', dtime + write(iulog,*) trim(subname) // 'calday : ', calday + write(iulog,*) trim(subname) // 'caldayp1 : ', caldayp1 + write(iulog,*) trim(subname) // 'nextsw_cday : ', nextsw_cday write(iulog,*) '-------------------------------------' end if @@ -786,15 +799,12 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) if (masterproc) then write(iulog,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' - write(iulog,*) 'doalb : ', doalb - write(iulog,*) 'call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, decl' - write(iulog,*) 'call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, decl' + write(iulog,*) 'doalb : ', doalb write(iulog,F02) 'calday is : ', calday write(iulog,F02) 'eccen is : ', eccen write(iulog,F02) 'mvelpp is : ', mvelpp write(iulog,F02) 'lambm0 is : ', lambm0 write(iulog,F02) 'obliqr is : ', obliqr - write(iulog,F02) 'clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic)' write(iulog,F02) 'declin is : ', declin write(iulog,F02) 'declinp1 is : ', declinp1 write(iulog,* ) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' @@ -829,9 +839,7 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) ! Advance ctsm time step !-------------------------------- - call t_startf ('lc_ctsm2_adv_timestep') call advance_timestep() - call t_stopf ('lc_ctsm2_adv_timestep') end do @@ -911,6 +919,8 @@ subroutine lnd_final(comp, import_state, export_state, clock, rc) end subroutine lnd_final + !--------------------------------------------------------------------------- + !=============================================================================== subroutine log_clock_advance(clock, logunit, rc) diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 4cd1073488..c6dfb7593b 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -39,7 +39,7 @@ module clm_initializeMod contains !----------------------------------------------------------------------- - subroutine initialize1(gindex_ocn) + subroutine initialize1(gindex_ocn, dtime_driver) ! ! !DESCRIPTION: ! CLM initialization first phase @@ -63,6 +63,7 @@ subroutine initialize1(gindex_ocn) ! ! !ARGUMENTS integer, pointer, optional :: gindex_ocn(:) + integer, intent(in), optional :: dtime_driver ! ! !LOCAL VARIABLES: integer :: ier ! error status @@ -94,7 +95,7 @@ subroutine initialize1(gindex_ocn) call shr_sys_flush(iulog) endif - call control_init() + call control_init(dtime_driver) call ncd_pio_init() call surfrd_get_num_patches(fsurdat, actual_maxsoil_patches, actual_numcft) call clm_varpar_init(actual_maxsoil_patches, actual_numcft) diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 097b138209..122b7af309 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -109,7 +109,8 @@ subroutine control_setNL( NLfile ) end subroutine control_setNL !------------------------------------------------------------------------ - subroutine control_init( ) + + subroutine control_init(dtime_driver) ! ! !DESCRIPTION: ! Initialize CLM run control information @@ -124,6 +125,9 @@ subroutine control_init( ) use CNPhenologyMod , only : CNPhenologyReadNML use landunit_varcon , only : max_lunit ! + ! ARGUMENTS + integer, intent(in), optional :: dtime_driver + ! !LOCAL VARIABLES: integer :: i ! loop indices integer :: ierr ! error code @@ -339,20 +343,29 @@ subroutine control_init( ) ! Process some namelist variables, and perform consistency checks ! ---------------------------------------------------------------------- - call set_timemgr_init( dtime_in=dtime ) - - if (use_init_interp) then - call apply_use_init_interp(finidat_interp_dest, finidat, finidat_interp_source) + if (present(dtime_driver)) then + ! overwrite dtime with dtime_in - instead of what is being used in the namelist + if (masterproc) then + write(iulog,*) 'WARNING: using dtime from cap rather than what is being read in from namelist' + end if + dtime = dtime_driver end if - ! History and restart files + ! Now initialize the module variable dtime in clm_time_manger - this will be utilized to create the + ! internal clm clock + call set_timemgr_init( dtime_in=dtime ) + ! History and restart files (dependent on settings of dtime) do i = 1, max_tapes if (hist_nhtfrq(i) < 0) then hist_nhtfrq(i) = nint(-hist_nhtfrq(i)*SHR_CONST_CDAY/(24._r8*dtime)) endif end do + if (use_init_interp) then + call apply_use_init_interp(finidat_interp_dest, finidat, finidat_interp_source) + end if + if (maxpatch_glcmec <= 0) then call endrun(msg=' ERROR: maxpatch_glcmec must be at least 1 ' // & errMsg(sourcefile, __LINE__)) From 80f0c5ce123239e003bcc6fde575a4bc5426a395 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 28 Nov 2019 11:19:19 -0700 Subject: [PATCH 170/556] cleaned up initialization of mct and shr_pio_init2 --- src/cpl/lilac/lnd_comp_esmf.F90 | 230 +++++++++++++++----------------- 1 file changed, 105 insertions(+), 125 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 98535e47f4..4e1a3e7688 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -17,7 +17,7 @@ module lnd_comp_esmf use shr_file_mod , only : shr_file_setLogUnit, shr_file_getLogUnit use shr_orb_mod , only : shr_orb_decl, shr_orb_params use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date - use spmdMod , only : masterproc, mpicom, spmd_init + use spmdMod , only : masterproc, spmd_init, mpicom use decompMod , only : bounds_type, ldecomp, get_proc_bounds use domainMod , only : ldomain use controlMod , only : control_setNL @@ -66,16 +66,11 @@ subroutine lnd_register(comp, rc) ! input/output argumenents type(ESMF_GridComp) :: comp ! CLM grid component integer, intent(out) :: rc ! return status - - ! local variables - character(len=*), parameter :: subname=trim(modname)//': [lnd_register] ' !----------------------------------------------------------------------- - print *, "in lnd register routine" rc = ESMF_SUCCESS call ESMF_LogSet ( flush =.true.) - call ESMF_LogWrite(subname//"lnd gridcompset entry points setting ....!", ESMF_LOGMSG_INFO) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, lnd_init, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -86,7 +81,8 @@ subroutine lnd_register(comp, rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, lnd_final, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite(subname//"lnd gridcompset entry points finished!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite("lnd gridcompset entry points finished!", ESMF_LOGMSG_INFO) + end subroutine lnd_register !=============================================================================== @@ -104,146 +100,140 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) integer, intent(out) :: rc ! Return code ! local variable - type(ESMF_Mesh) :: lnd_mesh - character(ESMF_MAXSTR) :: lnd_mesh_filename ! full filepath of land mesh file - integer :: ierr - integer :: mpicom_lnd, mpicom_vm, gsize - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - integer :: lsize ! size of attribute vector - integer :: g,i,j ! indices + integer :: ierr ! error code + integer :: n,g,i,j ! indices logical :: exists ! true if file exists real(r8) :: nextsw_cday ! calday from clock of next radiation computation character(len=CL) :: caseid ! case identifier name character(len=CL) :: ctitle ! case description title character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) - character(len=CL) :: calendar ! calendar type name - character(len=CL) :: hostname ! hostname of machine running on - character(len=CL) :: version ! Model version - character(len=CL) :: username ! user running the model integer :: nsrest ! clm restart type - integer :: ref_ymd ! reference date (YYYYMMDD) - integer :: ref_tod ! reference time of day (sec) - integer :: start_ymd ! start date (YYYYMMDD) - integer :: start_tod ! start time of day (sec) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type logical :: atm_aero ! Flag if aerosol data sent from atm model integer :: lbnum ! input to memory diagnostic integer :: shrlogunit ! old values for log unit and log level - integer :: logunit ! original log unit type(bounds_type) :: bounds ! bounds - integer :: nfields - integer :: ncomps = 1 - integer, pointer :: comps(:) ! array with component ids - integer, pointer :: comms(:) ! array with mpicoms - character(len=32), allocatable :: compLabels(:) - integer,allocatable :: comp_id(:) ! for pio init2 - character(len=64),allocatable :: comp_name(:) ! for pio init2 - integer,allocatable :: comp_comm(:) ! for pio_init2 - logical,allocatable :: comp_iamin(:) ! for pio init2 - integer,allocatable :: comp_comm_iam(:) ! for pio_init2 - integer :: ymd ! CTSM current date (YYYYMMDD) - integer :: orb_iyear_align ! associated with model year - integer :: orb_cyear ! orbital year for current orbital computation - integer :: orb_iyear ! orbital year for current orbital computation - integer :: orb_eccen ! orbital year for current orbital computation + + ! generation of field bundles + type(ESMF_State) :: importState, exportState + type(ESMF_FieldBundle) :: c2l_fb + type(ESMF_FieldBundle) :: l2c_fb + + ! mesh generation + type(ESMF_Mesh) :: lnd_mesh + character(ESMF_MAXSTR) :: lnd_mesh_filename ! full filepath of land mesh file + integer :: nlnd, nocn ! local size ofarrays + integer, pointer :: gindex(:) ! global index space for land and ocean points + integer, pointer :: gindex_lnd(:) ! global index space for just land points + integer, pointer :: gindex_ocn(:) ! global index space for just ocean points + type(ESMF_DistGrid) :: distgrid + + ! clock info + character(len=CL) :: calendar ! calendar type name + type(ESMF_CalKind_Flag) :: caltype ! calendar type from lilac clock + integer :: curr_tod, curr_ymd ! current time info + integer :: yy, mm, dd ! query output from lilac clock integer :: dtime_lilac ! coupling time-step from the input lilac clock - integer :: curr_tod, curr_ymd - integer :: yy, mm, dd + integer :: ref_ymd ! reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (sec) + integer :: start_ymd ! start date (YYYYMMDD) + integer :: start_tod ! start time of day (sec) + integer :: stop_ymd ! stop date (YYYYMMDD) + integer :: stop_tod ! stop time of day (sec) type(ESMF_Time) :: currTime ! Current time type(ESMF_Time) :: startTime ! Start time type(ESMF_Time) :: stopTime ! Stop time type(ESMF_Time) :: refTime ! Ref time - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Calendar) :: esmf_calendar ! esmf calendar - type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type - integer, pointer :: gindex(:) ! global index space for land and ocean points - integer, pointer :: gindex_lnd(:) ! global index space for just land points - integer, pointer :: gindex_ocn(:) ! global index space for just ocean points - integer :: nlnd, nocn ! local size ofarrays - integer :: n ! indices - integer :: dtime ! time step increment (sec) - type(ESMF_FieldBundle) :: c2l_fb - type(ESMF_FieldBundle) :: l2c_fb - type(ESMF_State) :: importState, exportState - integer :: compid ! component id - character(len=*), parameter :: subname=trim(modName)//': [lnd_init] ' + type(ESMF_TimeInterval) :: timeStep ! time step from lilac clock + + ! orbital info + integer :: orb_iyear_align ! associated with model year + integer :: orb_cyear ! orbital year for current orbital computation + integer :: orb_iyear ! orbital year for current orbital computation + integer :: orb_eccen ! orbital year for current orbital computation + + ! for pio_init2 and mct + type(ESMF_VM) :: vm + integer :: mpicom_vm + integer :: ncomps = 1 + integer, pointer :: mycomms(:) ! for mct + integer, pointer :: myids(:) ! for mct + integer :: compids(1) = (/1/) ! for both mct and pio_init2 - array with component ids + integer :: comms(1) ! for both mct and pio_init2 - array with mpicoms + character(len=32) :: compLabels(1) = (/'LND'/) ! for pio_init2 + character(len=64) :: comp_name(1) = (/'LND'/) ! for pio_init2 + logical :: comp_iamin(1) = (/.true./) ! for pio init2 + integer :: iam(1) ! for pio_init2 + character(len=*), parameter :: subname=trim(modName)//': (lnd_init) ' !------------------------------------------------------------------------ rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' is called!', ESMF_LOGMSG_INFO) !------------------------------------------------------------------------ - ! Initialize clm MPI communicator + ! Query VM for local PET and mpi communicator !------------------------------------------------------------------------ - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - call ESMF_LogWrite(subname//"ESMF_VMGetCurrent", ESMF_LOGMSG_INFO) - call ESMF_VMPrint (vm, rc = rc) + ! NOTE : both MPI_INIT and PIO_INIT1 are initialized in lilac_mod.F90 + + call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) + call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, localPet=iam(1), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return call ESMF_LogWrite(subname//"ESMF_VMGet", ESMF_LOGMSG_INFO) - ! duplicate the mpi communicator from the current VM - call MPI_Comm_dup(mpicom_vm, mpicom_lnd, rc) - call ESMF_LogWrite(subname//"MPI_Comm_dup...", ESMF_LOGMSG_INFO) - -!!!! NS : BOTH MPI_INIT and PIO_INIT1 are in lilac_mod.F90 + !call ESMF_VMPrint (vm, rc = rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + comms(1) = mpicom_vm !------------------------------------------------------------------------ - ! Initialize mct - ! (needed for data models and cice prescribed capability) - ! (needed for data model share code - e.g. nitrogen deposition) + ! Initialize pio_init2 TODO: is this needed here? !------------------------------------------------------------------------ - ! TODO: FIX THIS PLEASE!!!! - - allocate(comms(1), comps(1), compLabels(1), comp_iamin(1), comp_comm_iam(1), comp_name(1),stat=ierr) - - comms(1) = mpicom_lnd !or call MPI_Comm_dup(mpicom_vm, comms(1), ierr) - comps(1) = 1 - compLabels(1) = 'LND' - comp_iamin(1) = .true. - comp_name(1) = 'LND' - call ESMF_VMGet(vm, mpiCommunicator=comms(1), localPet=comp_comm_iam(1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_pio_init2(compids, compLabels, comp_iamin, comms, iam) + call ESMF_LogWrite(subname//"initialized shr_pio_init2 ...", ESMF_LOGMSG_INFO) - call shr_pio_init2(comps, compLabels, comp_iamin, comms, comp_comm_iam) + !------------------------------------------------------------------------ + ! Initialize mct - needed for data model share code - e.g. nitrogen deposition + !------------------------------------------------------------------------ - call ESMF_LogWrite(subname//"after shr_pio_init2", ESMF_LOGMSG_INFO) + allocate(mycomms(1), myids(1)) + mycomms = (/mpicom_vm/) ; myids = (/1/) - call ESMF_LogWrite(subname//"Now calling mct_world_init", ESMF_LOGMSG_INFO) - call mct_world_init(ncomps, mpicom_lnd, comms, comps) - call ESMF_LogWrite(subname//"mct world initialized! ", ESMF_LOGMSG_INFO) + call mct_world_init(ncomps, mpicom_vm, mycomms, myids) + call ESMF_LogWrite(subname//"initialized mct ... ", ESMF_LOGMSG_INFO) - !deallocate(comms, comps, compLabels, comp_iamin, comp_comm_iam, comp_name) ??? + !------------------------------------------------------------------------ + ! Initialize internal ctsm MPI info + !------------------------------------------------------------------------ - ! Initialize model mpi info - compid = 1 - call spmd_init( mpicom_lnd, compid) + call spmd_init( clm_mpicom=mpicom_vm, lndid=1) call ESMF_LogWrite(subname//"initialized model mpi info using spmd_init", ESMF_LOGMSG_INFO) !------------------------------------------------------------------------ !--- Log File --- !------------------------------------------------------------------------ + ! TODO: by default iulog = 6 in clm_varctl - this should be generalized so that we + ! can control the output log file for ctsm running with a lilac driver + inst_name = 'LND'; inst_index = 1; inst_suffix = "" ! Initialize io log unit call shr_file_getLogUnit (shrlogunit) - if (masterproc) then - write(iulog,*) trim(subname) // "CLM land model initialization" - else - iulog = shrlogunit + if (.not. masterproc) then + iulog = shrlogunit ! All shr code output will go to iulog for masterproc end if call shr_file_setLogUnit (iulog) + if (masterproc) then + write(iulog,*) "=========================================" + write(iulog,*) " starting (lnd_comp_esmf): lnd_comp_init " + write(iulog,*) " CLM land model initialization" + end if + !------------------------------------------------------------------------ !--- Orbital Values --- !------------------------------------------------------------------------ @@ -265,14 +255,12 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !lambm0 = -3.247249566152933E-0020 !obliqr = 0.409101122579779 - !if ((debug >1) .and. (masterproc)) then if (masterproc) then - write(iulog,*) trim(subname) // 'shr_obs_params is setting these:', eccen - write(iulog,*) trim(subname) // 'eccen is : ', eccen - write(iulog,*) trim(subname) // 'mvelpp is : ', mvelpp - - write(iulog,*) trim(subname) // 'lambm0 is : ', lambm0 - write(iulog,*) trim(subname) // 'obliqr is : ', obliqr + write(iulog,*) 'shr_obs_params is setting the following:' + write(iulog,*) 'eccen is : ', eccen + write(iulog,*) 'mvelpp is : ', mvelpp + write(iulog,*) 'lambm0 is : ', lambm0 + write(iulog,*) 'obliqr is : ', obliqr end if !---------------------- @@ -308,20 +296,20 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,ref_ymd) - call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) + call ESMF_TimeGet( currTime, calkindflag=caltype, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (esmf_caltype == ESMF_CALKIND_NOLEAP) then + if (caltype == ESMF_CALKIND_NOLEAP) then calendar = shr_cal_noleap - else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then + else if (caltype == ESMF_CALKIND_GREGORIAN) then calendar = shr_cal_gregorian else call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) end if - ! The following sets the module variables in clm_time_mamanger.F90 - BUT DOES NOT intialize the + ! The following sets the module variables in clm_time_mamanger.F90 - BUT DOES NOT intialize the ! clock. Routine timemgr_init (called by initialize1) initializes the clock using the module variables - ! that have been set via calls to set_timemgr_init. + ! that have been set via calls to set_timemgr_init. call set_timemgr_init( & calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & @@ -339,7 +327,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Initialize glc_elevclass module !---------------------- - call glc_elevclass_init(glc_nec) ! TODO: is this needed still? + call glc_elevclass_init(glc_nec) ! TODO: is this needed still? !---------------------- ! Call initialize1 @@ -369,14 +357,13 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! TODO: mesh file should come into clm as a namelist for lilac only ! for now need to hardwire this in lnd_mesh_filename here - lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' ! obtain global index array for just land points which includes mask=0 or ocean points call get_proc_bounds( bounds ) nlnd = bounds%endg - bounds%begg + 1 allocate(gindex_lnd(nlnd)) - !print ,* "nlnd is :", nlnd do g = bounds%begg,bounds%endg n = 1 + (g - bounds%begg) gindex_lnd(n) = ldecomp%gdc2glo(g) @@ -565,6 +552,9 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call ESMF_LogWrite(subname//' CTSM INITIALIZATION DONE SUCCESSFULLY!!!! ', ESMF_LOGMSG_INFO) + write(iulog,*) " finished (lnd_comp_esmf): lnd_comp_init " + write(iulog,*) "=========================================" + !--------------------------- contains !--------------------------- @@ -893,11 +883,11 @@ end subroutine lnd_run !--------------------------------------------------------------------------- subroutine lnd_final(comp, import_state, export_state, clock, rc) - ! - ! !DESCRIPTION: + !--------------------------------- ! Finalize land surface model - ! - ! !ARGUMENTS: + !--------------------------------- + + ! input/output variables type(ESMF_GridComp) :: comp ! CLM gridded component type(ESMF_State) :: import_state ! CLM import state type(ESMF_State) :: export_state ! CLM export state @@ -907,20 +897,10 @@ subroutine lnd_final(comp, import_state, export_state, clock, rc) rc = ESMF_SUCCESS - ! Destroy ESMF objects - !call esmfshr_util_StateArrayDestroy(export_state,'domain',rc) - !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !call esmfshr_util_StateArrayDestroy(export_state,'d2x',rc) - !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !call esmfshr_util_StateArrayDestroy(import_state,'x2d',rc) - !if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + ! TODO: Destroy ESMF objects end subroutine lnd_final - !--------------------------------------------------------------------------- - !=============================================================================== subroutine log_clock_advance(clock, logunit, rc) From e962ff9162ed3111055dbe045ee38272c48de7b8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 28 Nov 2019 12:17:06 -0700 Subject: [PATCH 171/556] updates to clean up error handling and clock advance --- lilac/atm_driver/atm_driver.F90 | 4 +- lilac/lilac/lilac_mod.F90 | 100 ++++++++++++++------------------ 2 files changed, 47 insertions(+), 57 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 32d42f18f9..f6e61f35ff 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -174,9 +174,9 @@ program atm_driver print *, "=======================================" end if - !===================== +!======================================================= contains - !===================== +!======================================================= subroutine read_netcdf_mesh(filename, nglobal) diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 84dbda6ef5..8e9badc0dd 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -14,13 +14,16 @@ module lilac_mod type(ESMF_Clock) :: lilac_clock type(ESMF_Calendar),target :: lilac_calendar - ! Gridded Components and Coupling Components + ! Gridded components and states in gridded components type(ESMF_GridComp) :: atm_gcomp type(ESMF_GridComp) :: lnd_gcomp - type(ESMF_CplComp) :: cpl_atm2lnd_comp - type(ESMF_CplComp) :: cpl_lnd2atm_comp type(ESMF_State) :: atm2lnd_l_state, atm2lnd_a_state type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state + + ! Coupler components + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp + character(*) , parameter :: modname = "lilac_mod" integer :: mytask @@ -37,13 +40,13 @@ subroutine lilac_init(atm_global_index, atm_mesh_filepath, atm_calendar, atm_tim ! This is called by the host atmosphere ! -------------------------------------------------------------------------------- - use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd, gindex_atm, atm_mesh_filename + use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd + use lilac_utils , only : gindex_atm, atm_mesh_filename use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register use lilac_atmcap , only : lilac_atmos_register use lnd_comp_esmf , only : lnd_register !ctsm routine use shr_pio_mod , only : shr_pio_init1 - ! input/output variables ! input/output variables integer , intent(in) :: atm_global_index(:) character(len=*) , intent(in) :: atm_mesh_filepath @@ -59,11 +62,11 @@ subroutine lilac_init(atm_global_index, atm_mesh_filepath, atm_calendar, atm_tim integer , intent(in) :: atm_stop_secs ! local variables - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime - type(ESMF_Time) :: stopTime - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - integer :: yy,mm,dd,sec + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_Time) :: stopTime + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + integer :: yy,mm,dd,sec integer :: lsize type(ESMF_State) :: importState, exportState type(ESMF_VM) :: vm @@ -293,14 +296,14 @@ end subroutine lilac_init subroutine lilac_run( ) + use shr_sys_mod, only : shr_sys_abort + ! local variables type(ESMF_State) :: importState, exportState - integer :: rc, userRC - type (ESMF_Clock) :: local_clock + integer :: rc character(len=*), parameter :: subname=trim(modname)//': [lilac_run] ' !------------------------------------------------------------------------ - ! Initialize return code rc = ESMF_SUCCESS if (mytask == 0) then @@ -309,62 +312,49 @@ subroutine lilac_run( ) print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" end if - !------------------------------------------------------------------------- - ! Create a local clock from the general clock! - !------------------------------------------------------------------------- - - local_clock = ESMF_ClockCreate(lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - if (mytask == 0) then - print *, "Run Loop Start time" - end if - - !------------------------------------------------------------------------- - ! We are running components in this order: - ! 1- atmos_cap 2- cpl_atm2lnd! 3- lnd_cap 4- cpl_lnd2atm - !------------------------------------------------------------------------- - + ! Run lilac atmcap + call ESMF_LogWrite(subname//"running lilac atmos_cap", ESMF_LOGMSG_INFO) + if (mytask == 0) print *, "Running atmos_cap gridded component , rc =", rc call ESMF_GridCompRun(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, & - clock=local_clock, rc=rc, userRC=userRC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp is running", ESMF_LOGMSG_INFO) - if (mytask == 0) then - print *, "Running atmos_cap gridded component , rc =", rc + clock=lilac_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in running lilac atm_cap") end if - call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, & - clock=local_clock, rc=rc , userRC=userRC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! Run cpl_atm2lnd call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) - if (mytask == 0) then - print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc + if (mytask == 0) print *, "Running coupler component..... cpl_atm2lnd_comp" + call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, & + clock=lilac_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in running cpl_atm2lnd") end if + ! Run ctsm + call ESMF_LogWrite(subname//"running ctsm", ESMF_LOGMSG_INFO) + if (mytask == 0) print *, "Running ctsm" call ESMF_GridCompRun(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, & - clock=local_clock, rc=rc, userRC=userRC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp is running", ESMF_LOGMSG_INFO) - if (mytask == 0) then - print *, "Running lnd_cap gridded component , rc =", rc + clock=lilac_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in running ctsm") end if - call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, & - clock=local_clock, rc=rc, userRC=userRC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! Run cpl_lnd2atm call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc end if + call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, & + clock=lilac_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in cpl_lnd2atm") + end if - ! Advance the time - call ESMF_ClockAdvance(local_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! Advance the time at the end of the time step + call ESMF_ClockAdvance(lilac_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in advancing time step") + end if call ESMF_LogWrite(subname//"time is icremented now... (ClockAdvance)", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, "time is icremented now... (ClockAdvance) , rc =", rc From 66b6335eb7b6ece9e65b46a82e62f83462d63280 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 28 Nov 2019 12:18:40 -0700 Subject: [PATCH 172/556] rename of sync clock to lilac_clock and turn off debug mode --- src/cpl/lilac/lnd_comp_esmf.F90 | 47 ++++++++++++++++++----------- src/cpl/lilac/lnd_import_export.F90 | 2 +- 2 files changed, 30 insertions(+), 19 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 4e1a3e7688..e3d3d58820 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -552,8 +552,10 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call ESMF_LogWrite(subname//' CTSM INITIALIZATION DONE SUCCESSFULLY!!!! ', ESMF_LOGMSG_INFO) - write(iulog,*) " finished (lnd_comp_esmf): lnd_comp_init " - write(iulog,*) "=========================================" + if (masterproc) then + write(iulog,*) " finished (lnd_comp_esmf): lnd_comp_init " + write(iulog,*) "=========================================" + end if !--------------------------- contains @@ -606,11 +608,11 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) integer :: mon ! CTSM current month integer :: day ! CTSM current day integer :: tod ! CTSM current time of day (sec) - integer :: ymd_sync ! Sync date (YYYYMMDD) - integer :: yr_sync ! Sync current year - integer :: mon_sync ! Sync current month - integer :: day_sync ! Sync current day - integer :: tod_sync ! Sync current time of day (sec) + integer :: ymd_lilac ! Sync date (YYYYMMDD) + integer :: yr_lilac ! Sync current year + integer :: mon_lilac ! Sync current month + integer :: day_lilac ! Sync current day + integer :: tod_lilac ! Sync current time of day (sec) integer :: dtime ! time step increment (sec) integer :: nstep ! time step index logical :: rstwr ! .true. ==> write restart file before returning @@ -808,9 +810,9 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc) + call ESMF_TimeGet(nexttime, yy=yr_lilac, mm=mon_lilac, dd=day_lilac, s=tod_lilac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync, mon_sync, day_sync, tod_sync + write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_lilac, mon_lilac, day_lilac, tod_lilac call t_startf ('ctsm_run') call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic=.false.) @@ -833,26 +835,35 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) end do - ! Check that internal clock is in sync with master clock - ! Note that the driver clock has not been updated yet - so at this point - ! CTSM is actually 1 coupling intervals ahead of the driver clock + !-------------------------------- + ! Check that internal clock is in sync with lilac driver clock + !-------------------------------- + ! Get ctsm current time info call get_curr_date( yr, mon, day, tod, offset=-2*dtime ) ymd = yr*10000 + mon*100 + day tod = tod + ! Get lilac clock info call ESMF_ClockGet( clock, currTime=currTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet( currTime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc ) + call ESMF_TimeGet( currTime, yy=yr_lilac, mm=mon_lilac, dd=day_lilac, s=tod_lilac, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) + call shr_cal_ymd2date(yr_lilac, mon_lilac, day_lilac, ymd_lilac) + + if (masterproc) then + write(iulog,*)'lilac ymd=',ymd ,' lilac tod= ',tod + end if + + ! Note that the driver clock has not been updated yet - so at this point + ! CTSM is actually 1 coupling intervals ahead of the driver clock - if ( (ymd /= ymd_sync) .and. (tod /= tod_sync) ) then - write(iulog,*)'ctsm ymd=',ymd ,' ctsm tod= ',tod - write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync + if ( (ymd /= ymd_lilac) .and. (tod /= tod_lilac) ) then + write(iulog,*)'ctsm ymd=',ymd ,' ctsm tod= ',tod + write(iulog,*)'lilac ymd=',ymd_lilac,' lilac tod= ',tod_lilac rc = ESMF_FAILURE - call ESMF_LogWrite(subname//" CTSM clock not in sync with Master Sync clock",ESMF_LOGMSG_ERROR) + call ESMF_LogWrite(subname//" CTSM clock not in sync with lilac clock",ESMF_LOGMSG_ERROR) end if !-------------------------------- diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 3dc2dd66f4..35f6308ff3 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -55,7 +55,7 @@ module lnd_import_export integer :: emis_nflds ! number of fire emission fields from lnd-> atm integer :: glc_nec = 10 ! number of glc elevation classes - integer, parameter :: debug = 1 ! internal debug level + integer, parameter :: debug = 0 ! internal debug level character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" character(*),parameter :: F02 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d26.19)" From 2eb502475b271d4080242246f5daa1c166585780 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 28 Nov 2019 13:40:45 -0700 Subject: [PATCH 173/556] added start and stop alarm functionality --- lilac/atm_driver/atm_driver.F90 | 6 +++- lilac/lilac/lilac_mod.F90 | 49 ++++++++++++++++++++++++++++----- 2 files changed, 47 insertions(+), 8 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index f6e61f35ff..56a6759a8a 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -159,7 +159,11 @@ program atm_driver !------------------------------------------------------------------------ do nstep = atm_timestep_start, atm_timestep_stop - call lilac_run( ) + if (nstep == atm_timestep_stop) then + call lilac_run(restart_alarm_is_ringing=.true., stop_alarm_is_ringing=.true.) + else + call lilac_run(restart_alarm_is_ringing=.false., stop_alarm_is_ringing=.false.) + end if end do !------------------------------------------------------------------------ diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 8e9badc0dd..56250e0399 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -13,6 +13,8 @@ module lilac_mod ! Clock, TimeInterval, and Times type(ESMF_Clock) :: lilac_clock type(ESMF_Calendar),target :: lilac_calendar + type(ESMF_Alarm) :: lilac_restart_alarm + type(ESMF_Alarm) :: lilac_stop_alarm ! Gridded components and states in gridded components type(ESMF_GridComp) :: atm_gcomp @@ -40,12 +42,13 @@ subroutine lilac_init(atm_global_index, atm_mesh_filepath, atm_calendar, atm_tim ! This is called by the host atmosphere ! -------------------------------------------------------------------------------- - use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd - use lilac_utils , only : gindex_atm, atm_mesh_filename - use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register - use lilac_atmcap , only : lilac_atmos_register - use lnd_comp_esmf , only : lnd_register !ctsm routine - use shr_pio_mod , only : shr_pio_init1 + use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd + use lilac_utils , only : gindex_atm, atm_mesh_filename + use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register + use lilac_atmcap , only : lilac_atmos_register + use lnd_comp_esmf , only : lnd_register !ctsm routine + use shr_pio_mod , only : shr_pio_init1 + use shr_sys_mod , only : shr_sys_abort ! input/output variables integer , intent(in) :: atm_global_index(:) @@ -238,6 +241,18 @@ subroutine lilac_init(atm_global_index, atm_mesh_filepath, atm_calendar, atm_tim print *, trim(subname) // "---------------------------------------" end if + ! Add a restart alarm to the clock + lilac_restart_alarm = ESMF_AlarmCreate(lilac_clock, ringTime=StopTime, name='lilac_restart_alarm', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort('error in initializing restart alarm') + end if + + ! Add a stop alarm to the clock + lilac_stop_alarm = ESMF_AlarmCreate(lilac_clock, ringTime=StopTime, name='lilac_stop_alarm', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort('error in initializing stop alarm') + end if + ! ------------------------------------------------------------------------- ! Initialze lilac_atm gridded component ! First Create the empty import and export states used to pass data @@ -294,10 +309,14 @@ end subroutine lilac_init !======================================================================== - subroutine lilac_run( ) + subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) use shr_sys_mod, only : shr_sys_abort + ! input/output variables + logical, intent(in) :: restart_alarm_is_ringing + logical, intent(in) :: stop_alarm_is_ringing + ! local variables type(ESMF_State) :: importState, exportState integer :: rc @@ -312,6 +331,22 @@ subroutine lilac_run( ) print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" end if + ! Set the clock restart alarm if restart_alarm_ringing is true + if (restart_alarm_is_ringing) then + call ESMF_AlarmRingerOn(lilac_restart_alarm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in running lilac atm_cap") + end if + end if + + ! Set the clock stop alarm if stop_alarm_ringing is true + if (stop_alarm_is_ringing) then + call ESMF_AlarmRingerOn(lilac_stop_alarm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in running lilac atm_cap") + end if + end if + ! Run lilac atmcap call ESMF_LogWrite(subname//"running lilac atmos_cap", ESMF_LOGMSG_INFO) if (mytask == 0) print *, "Running atmos_cap gridded component , rc =", rc From 2b464b445ad3020111f0f9a14e1c36a2f62c26d8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 29 Nov 2019 09:27:40 -0700 Subject: [PATCH 174/556] new buildnml functionality for lilac cap --- lilac_config/buildnml | 207 ++++++++++++++++++++++++++++++++ lilac_config/lnd_input.py | 23 ++++ src/cpl/lilac/lnd_comp_esmf.F90 | 107 ++++++++--------- 3 files changed, 282 insertions(+), 55 deletions(-) create mode 100755 lilac_config/buildnml create mode 100644 lilac_config/lnd_input.py diff --git a/lilac_config/buildnml b/lilac_config/buildnml new file mode 100755 index 0000000000..b4a4ab198e --- /dev/null +++ b/lilac_config/buildnml @@ -0,0 +1,207 @@ +#!/usr/bin/env python + +""" +CLM namelist creator +""" +import sys, os, shutil, subprocess, logging +import six +from lnd_input import * + +logger = logging.getLogger(__name__) + +# Find python version +PY3 = sys.version_info[0] > 2 +PYSUBVER = sys.version_info[1] + +_config_cache_template = """ + + + +Specifies clm physics + +""" + +# Note the following is needed in env_lilac.xml otherwise the following error appers in the call to build_namelist +#err=ERROR : CLM build-namelist::CLMBuildNamelist::logical_to_fortran() : Unexpected value in logical_to_fortran: + +_env_lilac_template = """ + + + + + logical + TRUE,FALSE + + + +""" + +_hack=object() + +############################################################################### +def run_cmd(cmd, input_str=None, from_dir=None, verbose=None, + arg_stdout=_hack, arg_stderr=_hack, env=None, combine_output=False): +############################################################################### + + """ + Wrapper around subprocess to make it much more convenient to run shell commands + + >>> run_cmd('ls file_i_hope_doesnt_exist')[0] != 0 + True + """ + import subprocess # Not safe to do globally, module not available in older pythons + + # Real defaults for these value should be subprocess.PIPE + if arg_stdout is _hack: + arg_stdout = subprocess.PIPE + elif isinstance(arg_stdout, six.string_types): + arg_stdout = _convert_to_fd(arg_stdout, from_dir) + + if arg_stderr is _hack: + arg_stderr = subprocess.STDOUT if combine_output else subprocess.PIPE + elif isinstance(arg_stderr, six.string_types): + arg_stderr = _convert_to_fd(arg_stdout, from_dir) + + if (verbose != False and (verbose or logger.isEnabledFor(logging.DEBUG))): + logger.info("RUN: {}\nFROM: {}".format(cmd, os.getcwd() if from_dir is None else from_dir)) + + if (input_str is not None): + stdin = subprocess.PIPE + else: + stdin = None + + proc = subprocess.Popen(cmd, + shell=True, + stdout=arg_stdout, + stderr=arg_stderr, + stdin=stdin, + cwd=from_dir, + env=env) + + output, errput = proc.communicate(input_str) + if output is not None: + try: + output = output.decode('utf-8', errors='ignore').strip() + except AttributeError: + pass + if errput is not None: + try: + errput = errput.decode('utf-8', errors='ignore').strip() + except AttributeError: + pass + + stat = proc.wait() + if six.PY2: + if isinstance(arg_stdout, file): # pylint: disable=undefined-variable + arg_stdout.close() # pylint: disable=no-member + if isinstance(arg_stderr, file) and arg_stderr is not arg_stdout: # pylint: disable=undefined-variable + arg_stderr.close() # pylint: disable=no-member + else: + if isinstance(arg_stdout, io.IOBase): + arg_stdout.close() # pylint: disable=no-member + if isinstance(arg_stderr, io.IOBase) and arg_stderr is not arg_stdout: + arg_stderr.close() # pylint: disable=no-member + + + if (verbose != False and (verbose or logger.isEnabledFor(logging.DEBUG))): + if stat != 0: + logger.info(" stat: {:d}\n".format(stat)) + if output: + logger.info(" output: {}\n".format(output)) + if errput: + logger.info(" errput: {}\n".format(errput)) + + return stat, output, errput + +############################################################################### +def buildnml(): +############################################################################### + + """Build the clm namelist """ + + # A few notes: + # - tuning parameters and initial conditions should be optimized for what CLM model version and + # what meteorlogical forcing combination? valid values are: + # clm5_0_cam6.0, clm5_0_GSWP3v1, clm5_0_CRUv7, clm4_5_CRUv7, clm4_5_GSWP3v1, clm4_5_cam6.0 + # - only support startup or continue runs for now + + glc_nec = str(10) # + lnd_ncpl = str(1) # this will not be used - but is only here as a place holder to satisfy build_namelist + nomeg = "" + caseroot = "." + + # set path for the namelist assume that build namelist in lilac_conf/namelist + clmconf = os.path.join(os.getcwd(),"namelist") + infile = os.path.join(clmconf, "namelist") + inputdata_file = os.path.join(clmconf, "clm.input_data_list") + config_cache = os.path.join(clmconf, "config_cache.xml") + env_lilac = os.path.join(clmconf, "env_lilac.xml") + lndfrac_file = os.path.join(lnd_domain_path,lnd_domain_file) + + # create clmconf if it does not exist + if not os.path.isdir(clmconf): + os.makedirs(clmconf) + + # clean inputdata_file if it does exist + if os.path.exists(inputdata_file): + os.remove(inputdata_file) + + # Create config_cache.xml file + # Note that build-namelist utilizes the contents of the config_cache.xml file in + # the namelist_defaults.xml file to obtain namelist variables + config_cache_text = _config_cache_template.format(clm_phys=clm_phys) + with open(config_cache, 'w') as tempfile: + tempfile.write(config_cache_text) + + # Create env_lilac text + env_lilac_text = _env_lilac_template.format() + with open(env_lilac, 'w') as tempfile: + tempfile.write(env_lilac_text) + + # ----------------------------------------------------- + # call build-namelist + # ----------------------------------------------------- + + cmd = os.path.join(os.pardir, "bld","build-namelist") + command = [cmd, + '-csmdata', din_loc_root, + '-inputdata', inputdata_file, ignore, + '-namelist', '\'&clm_inparm start_ymd={} {}/\''.format(start_ymd, clm_namelist_opts), + '-use_case',use_case, + '-res', lnd_grid, + '-mask',gridmask, + '-clm_start_type', start_type, + '-l_ncpl', lnd_ncpl, + '-configuration', configuration, + '-structure', structure, + '-lnd_frac', lndfrac_file, + '-glc_nec', glc_nec, + '-co2_ppmv', ccsm_co2_ppmv, + '-co2_type', clm_co2_type, + '-clm_accelerated_spinup', spinup, + '-lnd_tuning_mode',lnd_tuning_mode, + '-config',os.path.join(clmconf, "config_cache.xml"), + '-envxml_dir', os.path.join(os.getcwd(), "namelist"), + nomeg, clm_bldnml_opts] + + cmd = ' '.join(command) + rc, out, err = run_cmd(cmd, from_dir=os.getcwd()) + + #TODO: need to put in error handling + #raise Exception("Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) + + # ----------------------------------------------------- + # copy resolved namelist to rundir + # ----------------------------------------------------- + + if os.path.isdir(rundir): + file1 = os.path.join(clmconf, "lnd_in") + file2 = os.path.join(rundir , "lnd_in") + logger.debug("CLM namelist copy: file1 %s file2 %s " %(file1, file2)) + shutil.copy(file1,file2) + +############################################################################### +if __name__ == "__main__": + buildnml() + + diff --git a/lilac_config/lnd_input.py b/lilac_config/lnd_input.py new file mode 100644 index 0000000000..c6cfe23caa --- /dev/null +++ b/lilac_config/lnd_input.py @@ -0,0 +1,23 @@ +# set the run directory +rundir = "/glade/u/home/mvertens/src/LILAC/lilac_atm_driver" + +# set the input namelist options for clm's build-namelist +clm_phys = "clm5_0" +start_type = "default" +start_ymd = "20000101" +startfile_type = "finidat" +ignore = "-ignore_ic_year" +configuration = "clm" +structure = "standard" +ccsm_co2_ppmv = str(367.0) +clm_co2_type = "constant" +clm_bldnml_opts = "-bgc sp" +use_case = "2000_control" +lnd_tuning_mode = "clm5_0_GSWP3v1" +spinup = "off" +gridmask = "gx3v7" +lnd_grid = "4x5" +lnd_domain_file = "domain.lnd.fv4x5_gx3v7.091218.nc" +lnd_domain_path = "/glade/p/cesmdata/cseg/inputdata/share/domains" +din_loc_root = "/glade/p/cesmdata/cseg/inputdata" +clm_namelist_opts = "" diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index e3d3d58820..1b88a27204 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -674,7 +674,7 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) !-------------------------------- call t_startf ('lc_lnd_import') - call import_fields( gcomp, bounds, rc) + call import_fields(gcomp, bounds, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf ('lc_lnd_import') @@ -701,7 +701,7 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) caldayp1 = get_curr_calday(offset=dtime) !-------------------------------- - ! Get time of next atmospheric shortwave calculation + ! Get time of next atmospheric shortwave calculation !-------------------------------- ! TODO(NS): nextsw_cday should come directly from atmosphere! @@ -712,6 +712,25 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) write(iulog,*) trim(subname) // '... nextsw_cday is : ', nextsw_cday end if + !-------------------------------- + ! Obtain orbital values + !-------------------------------- + + call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) + call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) + + if (masterproc) then + write(iulog,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' + write(iulog,F02) 'calday is : ', calday + write(iulog,F02) 'eccen is : ', eccen + write(iulog,F02) 'mvelpp is : ', mvelpp + write(iulog,F02) 'lambm0 is : ', lambm0 + write(iulog,F02) 'obliqr is : ', obliqr + write(iulog,F02) 'declin is : ', declin + write(iulog,F02) 'declinp1 is : ', declinp1 + write(iulog,* ) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' + end if + !-------------------------------- ! Determine doalb based on nextsw_cday sent from atm model !-------------------------------- @@ -728,54 +747,53 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) if (masterproc) then write(iulog,*) '------------ LILAC ----------------' - write(iulog,*) trim(subname) // 'nstep : ', nstep - write(iulog,*) trim(subname) // 'dtime : ', dtime - write(iulog,*) trim(subname) // 'calday : ', calday - write(iulog,*) trim(subname) // 'caldayp1 : ', caldayp1 - write(iulog,*) trim(subname) // 'nextsw_cday : ', nextsw_cday + write(iulog,*) 'nstep : ', nstep + write(iulog,*) 'calday : ', calday + write(iulog,*) 'caldayp1 : ', caldayp1 + write(iulog,*) 'nextsw_cday : ', nextsw_cday + write(iulog,*) 'doalb : ', doalb write(iulog,*) '-------------------------------------' end if call update_rad_dtime(doalb) - if (masterproc) then - write(iulog,*) 'doalb is: ', doalb - end if - !-------------------------------- ! Determine if time to write restart !-------------------------------- - !call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !rstwr = .true. - !call ESMF_AlarmRingerOff( alarm, rc=rc ) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !else - !rstwr = .false. - !endif + call ESMF_ClockGetAlarm(clock, alarmname='lilac_restart_alarm', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! TODO: for now hardwire rstwr to .false. - rstwr = .false. + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + rstwr = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + rstwr = .false. + endif + if (masterproc) then + write(iulog,*)' restart alarm is ',rstwr + end if !-------------------------------- ! Determine if time to stop !-------------------------------- - !call ESMF_ClockGetAlarm(clock, alarmname='alarm_stop', alarm=alarm, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetAlarm(clock, alarmname='lilac_stop_alarm', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !nlend = .true. - !call ESMF_AlarmRingerOff( alarm, rc=rc ) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !else - ! nlend = .false. - !endif + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + nlend = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + nlend = .false. + endif + if (masterproc) then + write(iulog,*)' stop alarm is ',nlend + end if !-------------------------------- ! Run CTSM @@ -783,27 +801,6 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) call t_barrierf('sync_ctsm_run1', mpicom) - call t_startf ('shr_orb_decl') - calday = get_curr_calday() - - call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) - call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) - - if (masterproc) then - write(iulog,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' - write(iulog,*) 'doalb : ', doalb - write(iulog,F02) 'calday is : ', calday - write(iulog,F02) 'eccen is : ', eccen - write(iulog,F02) 'mvelpp is : ', mvelpp - write(iulog,F02) 'lambm0 is : ', lambm0 - write(iulog,F02) 'obliqr is : ', obliqr - write(iulog,F02) 'declin is : ', declin - write(iulog,F02) 'declinp1 is : ', declinp1 - write(iulog,* ) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' - end if - - call t_stopf ('shr_orb_decl') - ! Restart File - use nexttimestr rather than currtimestr here since that is the time at the end of ! the timestep and is preferred for restart file names ! TODO: is this correct for lilac? From 34b001a94d51e6b3b5e5c4ec5d7b96795a40fdfd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 29 Nov 2019 09:55:13 -0700 Subject: [PATCH 175/556] updated buildnml --- lilac_config/buildnml | 37 +++++++++++++------------------------ lilac_config/lnd_input.py | 2 +- 2 files changed, 14 insertions(+), 25 deletions(-) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index b4a4ab198e..5d65dcfce5 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -125,19 +125,11 @@ def buildnml(): # clm5_0_cam6.0, clm5_0_GSWP3v1, clm5_0_CRUv7, clm4_5_CRUv7, clm4_5_GSWP3v1, clm4_5_cam6.0 # - only support startup or continue runs for now - glc_nec = str(10) # - lnd_ncpl = str(1) # this will not be used - but is only here as a place holder to satisfy build_namelist - nomeg = "" - caseroot = "." - # set path for the namelist assume that build namelist in lilac_conf/namelist - clmconf = os.path.join(os.getcwd(),"namelist") - infile = os.path.join(clmconf, "namelist") + clmconf = rundir inputdata_file = os.path.join(clmconf, "clm.input_data_list") config_cache = os.path.join(clmconf, "config_cache.xml") - env_lilac = os.path.join(clmconf, "env_lilac.xml") - lndfrac_file = os.path.join(lnd_domain_path,lnd_domain_file) - + # create clmconf if it does not exist if not os.path.isdir(clmconf): os.makedirs(clmconf) @@ -153,7 +145,8 @@ def buildnml(): with open(config_cache, 'w') as tempfile: tempfile.write(config_cache_text) - # Create env_lilac text + # Create temporary env_lilac.xml + env_lilac = os.path.join(clmconf, "env_lilac.xml") env_lilac_text = _env_lilac_template.format() with open(env_lilac, 'w') as tempfile: tempfile.write(env_lilac_text) @@ -171,34 +164,30 @@ def buildnml(): '-res', lnd_grid, '-mask',gridmask, '-clm_start_type', start_type, - '-l_ncpl', lnd_ncpl, + '-l_ncpl', str(1), # this will not be used in lilac - but is needed as input '-configuration', configuration, '-structure', structure, - '-lnd_frac', lndfrac_file, - '-glc_nec', glc_nec, + '-lnd_frac', os.path.join(lnd_domain_path,lnd_domain_file), + '-glc_nec', str(10), '-co2_ppmv', ccsm_co2_ppmv, '-co2_type', clm_co2_type, '-clm_accelerated_spinup', spinup, '-lnd_tuning_mode',lnd_tuning_mode, '-config',os.path.join(clmconf, "config_cache.xml"), '-envxml_dir', os.path.join(os.getcwd(), "namelist"), - nomeg, clm_bldnml_opts] + clm_bldnml_opts] cmd = ' '.join(command) rc, out, err = run_cmd(cmd, from_dir=os.getcwd()) - - #TODO: need to put in error handling - #raise Exception("Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) + if rc > 0: + raise Exception("Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) # ----------------------------------------------------- - # copy resolved namelist to rundir + # remove temporary files from rundir # ----------------------------------------------------- - if os.path.isdir(rundir): - file1 = os.path.join(clmconf, "lnd_in") - file2 = os.path.join(rundir , "lnd_in") - logger.debug("CLM namelist copy: file1 %s file2 %s " %(file1, file2)) - shutil.copy(file1,file2) + os.remove(os.path.join(rundir, "config_cache.xml")) + os.remove(os.path.join(rundir, "env_lilac.xml")) ############################################################################### if __name__ == "__main__": diff --git a/lilac_config/lnd_input.py b/lilac_config/lnd_input.py index c6cfe23caa..afee3840ac 100644 --- a/lilac_config/lnd_input.py +++ b/lilac_config/lnd_input.py @@ -1,5 +1,5 @@ # set the run directory -rundir = "/glade/u/home/mvertens/src/LILAC/lilac_atm_driver" +rundir = "/glade/u/home/mvertens/src/LILAC/lilac/atm_driver" # set the input namelist options for clm's build-namelist clm_phys = "clm5_0" From e294a021509ae057e150b40fadd4c97f8bc1076a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 29 Nov 2019 10:06:28 -0700 Subject: [PATCH 176/556] cleaner version of buildnml --- lilac_config/buildnml | 49 +++++++++++---------------------------- lilac_config/lnd_input.py | 5 ++++ 2 files changed, 18 insertions(+), 36 deletions(-) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 5d65dcfce5..73d6b3036c 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -1,18 +1,15 @@ #!/usr/bin/env python """ -CLM namelist creator +CTSM namelist creator """ + import sys, os, shutil, subprocess, logging import six from lnd_input import * logger = logging.getLogger(__name__) -# Find python version -PY3 = sys.version_info[0] > 2 -PYSUBVER = sys.version_info[1] - _config_cache_template = """ @@ -117,48 +114,31 @@ def run_cmd(cmd, input_str=None, from_dir=None, verbose=None, def buildnml(): ############################################################################### - """Build the clm namelist """ - - # A few notes: - # - tuning parameters and initial conditions should be optimized for what CLM model version and - # what meteorlogical forcing combination? valid values are: - # clm5_0_cam6.0, clm5_0_GSWP3v1, clm5_0_CRUv7, clm4_5_CRUv7, clm4_5_GSWP3v1, clm4_5_cam6.0 - # - only support startup or continue runs for now + """Build the ctsm namelist """ - # set path for the namelist assume that build namelist in lilac_conf/namelist - clmconf = rundir - inputdata_file = os.path.join(clmconf, "clm.input_data_list") - config_cache = os.path.join(clmconf, "config_cache.xml") - - # create clmconf if it does not exist - if not os.path.isdir(clmconf): - os.makedirs(clmconf) + # check if rundir exists + if not os.path.isdir(rundir): + raise Exception("rundir %s does not exist".format(rundir)) - # clean inputdata_file if it does exist - if os.path.exists(inputdata_file): - os.remove(inputdata_file) - - # Create config_cache.xml file + # create config_cache.xml file # Note that build-namelist utilizes the contents of the config_cache.xml file in # the namelist_defaults.xml file to obtain namelist variables + config_cache = os.path.join(rundir, "config_cache.xml") config_cache_text = _config_cache_template.format(clm_phys=clm_phys) with open(config_cache, 'w') as tempfile: tempfile.write(config_cache_text) - # Create temporary env_lilac.xml - env_lilac = os.path.join(clmconf, "env_lilac.xml") + # create temporary env_lilac.xml + env_lilac = os.path.join(rundir, "env_lilac.xml") env_lilac_text = _env_lilac_template.format() with open(env_lilac, 'w') as tempfile: tempfile.write(env_lilac_text) - # ----------------------------------------------------- # call build-namelist - # ----------------------------------------------------- - cmd = os.path.join(os.pardir, "bld","build-namelist") command = [cmd, '-csmdata', din_loc_root, - '-inputdata', inputdata_file, ignore, + '-inputdata', os.path.join(rundir, "clm.input_data_list"), '-namelist', '\'&clm_inparm start_ymd={} {}/\''.format(start_ymd, clm_namelist_opts), '-use_case',use_case, '-res', lnd_grid, @@ -173,8 +153,8 @@ def buildnml(): '-co2_type', clm_co2_type, '-clm_accelerated_spinup', spinup, '-lnd_tuning_mode',lnd_tuning_mode, - '-config',os.path.join(clmconf, "config_cache.xml"), - '-envxml_dir', os.path.join(os.getcwd(), "namelist"), + '-config',os.path.join(rundir, "config_cache.xml"), + '-envxml_dir', rundir, clm_bldnml_opts] cmd = ' '.join(command) @@ -182,10 +162,7 @@ def buildnml(): if rc > 0: raise Exception("Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) - # ----------------------------------------------------- # remove temporary files from rundir - # ----------------------------------------------------- - os.remove(os.path.join(rundir, "config_cache.xml")) os.remove(os.path.join(rundir, "env_lilac.xml")) diff --git a/lilac_config/lnd_input.py b/lilac_config/lnd_input.py index afee3840ac..a613ea6a80 100644 --- a/lilac_config/lnd_input.py +++ b/lilac_config/lnd_input.py @@ -1,3 +1,8 @@ +# - tuning parameters and initial conditions should be optimized for what CLM model version and +# what meteorlogical forcing combination? valid values are: +# clm5_0_cam6.0, clm5_0_GSWP3v1, clm5_0_CRUv7, clm4_5_CRUv7, clm4_5_GSWP3v1, clm4_5_cam6.0 +# - only support startup or continue runs for now + # set the run directory rundir = "/glade/u/home/mvertens/src/LILAC/lilac/atm_driver" From 638acf0182ed8c59a604209ebfa342382687302b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 29 Nov 2019 10:39:28 -0700 Subject: [PATCH 177/556] added new parsing for buildnml --- lilac_config/buildnml | 33 +++++++++++++++++++++++++-------- lilac_config/lnd_input.py | 7 +++---- 2 files changed, 28 insertions(+), 12 deletions(-) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 73d6b3036c..31a368acb8 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -4,9 +4,10 @@ CTSM namelist creator """ -import sys, os, shutil, subprocess, logging +import sys, os, shutil, subprocess, logging, argparse import six from lnd_input import * +from argparse import RawTextHelpFormatter logger = logging.getLogger(__name__) @@ -35,6 +36,23 @@ _env_lilac_template = """ _hack=object() +############################################################################### +def parse_command_line(args, description): +############################################################################### + + parser = argparse.ArgumentParser(formatter_class=RawTextHelpFormatter, description=description) + + parser.add_argument("--rundir", type=str, default=os.getcwd(), + help="(required) specify the full path of the run directory)") + + arguments = parser.parse_args(args) + + # check if rundir exists + if not os.path.isdir(arguments.rundir): + raise Exception("rundir %s does not exist".format(arguments.rundir)) + + return arguments.rundir + ############################################################################### def run_cmd(cmd, input_str=None, from_dir=None, verbose=None, arg_stdout=_hack, arg_stderr=_hack, env=None, combine_output=False): @@ -111,15 +129,11 @@ def run_cmd(cmd, input_str=None, from_dir=None, verbose=None, return stat, output, errput ############################################################################### -def buildnml(): +def buildnml(rundir, bldnmldir): ############################################################################### """Build the ctsm namelist """ - # check if rundir exists - if not os.path.isdir(rundir): - raise Exception("rundir %s does not exist".format(rundir)) - # create config_cache.xml file # Note that build-namelist utilizes the contents of the config_cache.xml file in # the namelist_defaults.xml file to obtain namelist variables @@ -135,7 +149,7 @@ def buildnml(): tempfile.write(env_lilac_text) # call build-namelist - cmd = os.path.join(os.pardir, "bld","build-namelist") + cmd = os.path.abspath(os.path.join(bldnmldir, os.pardir, "bld","build-namelist")) command = [cmd, '-csmdata', din_loc_root, '-inputdata', os.path.join(rundir, "clm.input_data_list"), @@ -167,7 +181,10 @@ def buildnml(): os.remove(os.path.join(rundir, "env_lilac.xml")) ############################################################################### + if __name__ == "__main__": - buildnml() + rundir = parse_command_line(sys.argv[1:], __doc__) + bldnmldir = os.path.dirname(os.path.abspath(__file__)) + buildnml(rundir, bldnmldir) diff --git a/lilac_config/lnd_input.py b/lilac_config/lnd_input.py index a613ea6a80..d2b202dcae 100644 --- a/lilac_config/lnd_input.py +++ b/lilac_config/lnd_input.py @@ -1,12 +1,11 @@ +# ------------------------------------------------------------------------- +# set the input namelist options for clm's build-namelist +# ------------------------------------------------------------------------- # - tuning parameters and initial conditions should be optimized for what CLM model version and # what meteorlogical forcing combination? valid values are: # clm5_0_cam6.0, clm5_0_GSWP3v1, clm5_0_CRUv7, clm4_5_CRUv7, clm4_5_GSWP3v1, clm4_5_cam6.0 # - only support startup or continue runs for now -# set the run directory -rundir = "/glade/u/home/mvertens/src/LILAC/lilac/atm_driver" - -# set the input namelist options for clm's build-namelist clm_phys = "clm5_0" start_type = "default" start_ymd = "20000101" From 18aa660ba0b0cd1b10684c311ed5a124c20c0b37 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 29 Nov 2019 10:53:14 -0700 Subject: [PATCH 178/556] removed hard-wired lnd_in and drv_flds_in - now generated via calls to lilac_config/buildnml in ctsm --- lilac/atm_driver/README | 14 +++ lilac/atm_driver/drv_flds_in | 7 -- lilac/atm_driver/lnd_in | 238 ----------------------------------- 3 files changed, 14 insertions(+), 245 deletions(-) create mode 100644 lilac/atm_driver/README delete mode 100644 lilac/atm_driver/drv_flds_in delete mode 100644 lilac/atm_driver/lnd_in diff --git a/lilac/atm_driver/README b/lilac/atm_driver/README new file mode 100644 index 0000000000..09b9e0d255 --- /dev/null +++ b/lilac/atm_driver/README @@ -0,0 +1,14 @@ +assume the ctsm code base is checked out in $CTSM_ROOTDIR + +- to customize the generated namelist - edit the file + > $CTSM_ROOTDIR/lilac_config/lnd_input.py + +- to create the ctsm namelist FROM THIS DIRECTORY: + > $CTSM_ROOTDIR/lilac_config/buildnml + +- this will now create the files lnd_in, drv_flds_in, and clm.input_data_list in this directory + THIS ONLY NEEDS TO BE DONE ONCE + to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory + + + diff --git a/lilac/atm_driver/drv_flds_in b/lilac/atm_driver/drv_flds_in deleted file mode 100644 index bca8f84a0b..0000000000 --- a/lilac/atm_driver/drv_flds_in +++ /dev/null @@ -1,7 +0,0 @@ -&megan_emis_nl - megan_factors_file = '/glade/p/cesmdata/cseg/inputdata/atm/cam/chem/trop_mozart/emis/megan21_emis_factors_78pft_c20161108.nc' - megan_specifier = 'ISOP = isoprene', - 'C10H16 = pinene_a + carene_3 + thujene_a', 'CH3OH = methanol', - 'C2H5OH = ethanol', 'CH2O = formaldehyde', 'CH3CHO = acetaldehyde', - 'CH3COOH = acetic_acid', 'CH3COCH3 = acetone' -/ diff --git a/lilac/atm_driver/lnd_in b/lilac/atm_driver/lnd_in deleted file mode 100644 index 2a0b650433..0000000000 --- a/lilac/atm_driver/lnd_in +++ /dev/null @@ -1,238 +0,0 @@ -&clm_inparm - albice = 0.50,0.30 - co2_ppmv = 367.0 - co2_type = 'constant' - collapse_urban = .false. - create_crop_landunit = .true. - crop_fsat_equals_zero = .false. - dtime = 1800 - fatmlndfrc = '/glade/p/cesmdata/cseg/inputdata/share/domains/domain.lnd.fv4x5_gx3v7.091218.nc' - finidat = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/initdata_map/clmi.I2000Clm50BgcCrop.2011-01-01.1.9x2.5_gx1v7_gl4_simyr2000_c180715.nc' - fsnowaging = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc' - fsnowoptics = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/snicardata/snicar_optics_5bnd_c090915.nc' - fsurdat = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/surfdata_map/surfdata_4x5_16pfts_Irrig_CMIP6_simyr2000_c170824.nc' - glc_do_dynglacier = .false. - glc_snow_persistence_max_days = 0 - h2osno_max = 10000.0 - hist_mfilt = 1 - hist_ndens = 1 - hist_nhtfrq = 1 - irrigate = .true. - maxpatch_glcmec = 10 - maxpatch_pft = 17 - n_dom_landunits = 0 - n_dom_pfts = 0 - nlevsno = 12 - nsegspc = 35 - paramfile = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/paramdata/clm5_params.c190829.nc' - run_zero_weight_urban = .false. - snow_cover_fraction_method = 'SwensonLawrence2012' - soil_layerstruct_predefined = '20SL_8.5m' - spinup_state = 0 - toosmall_crop = 0.d00 - toosmall_glacier = 0.d00 - toosmall_lake = 0.d00 - toosmall_soil = 0.d00 - toosmall_urban = 0.d00 - toosmall_wetland = 0.d00 - use_bedrock = .true. - use_century_decomp = .false. - use_cn = .false. - use_crop = .false. - use_dynroot = .false. - use_fates = .false. - use_fertilizer = .false. - use_fun = .false. - use_grainproduct = .false. - use_hydrstress = .true. - use_init_interp = .true. - use_lai_streams = .false. - use_lch4 = .false. - use_luna = .true. - use_nitrif_denitrif = .false. - use_subgrid_fluxes = .true. - use_vertsoilc = .false. -/ -&ndepdyn_nml -/ -&popd_streams -/ -&urbantv_streams - stream_fldfilename_urbantv = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/urbandata/CLM50_tbuildmax_Oleson_2016_0.9x1.25_simyr1849-2106_c160923.nc' - stream_year_first_urbantv = 2000 - stream_year_last_urbantv = 2000 - urbantvmapalgo = 'nn' -/ -&light_streams -/ -&lai_streams - lai_mapalgo = 'bilinear' - model_year_align_lai = 2001 - stream_fldfilename_lai = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/lai_streams/MODISPFTLAI_0.5x0.5_c140711.nc' - stream_year_first_lai = 2001 - stream_year_last_lai = 2013 -/ -&atm2lnd_inparm - glcmec_downscale_longwave = .true. - lapse_rate = 0.006 - lapse_rate_longwave = 0.032 - longwave_downscaling_limit = 0.5 - precip_repartition_glc_all_rain_t = 0. - precip_repartition_glc_all_snow_t = -2. - precip_repartition_nonglc_all_rain_t = 2. - precip_repartition_nonglc_all_snow_t = 0. - repartition_rain_snow = .true. -/ -&lnd2atm_inparm - melt_non_icesheet_ice_runoff = .true. -/ -&clm_canopyhydrology_inparm - interception_fraction = 1.0 - maximum_leaf_wetted_fraction = 0.05 - use_clm5_fpi = .true. -/ -&cnphenology -/ -&clm_soilhydrology_inparm -/ -&dynamic_subgrid - reset_dynbal_baselines = .false. -/ -&cnvegcarbonstate -/ -&finidat_consistency_checks -/ -&dynpft_consistency_checks -/ -&clm_initinterp_inparm - init_interp_method = 'general' -/ -¢ury_soilbgcdecompcascade -/ -&soilhydrology_inparm - baseflow_scalar = 0.001d00 -/ -&luna - jmaxb1 = 0.093563 -/ -&friction_velocity - zetamaxstable = 0.5d00 -/ -&mineral_nitrogen_dynamics -/ -&soilwater_movement_inparm - dtmin = 60. - expensive = 42 - flux_calculation = 1 - inexpensive = 1 - lower_boundary_condition = 2 - soilwater_movement_method = 1 - upper_boundary_condition = 1 - verysmall = 1.e-8 - xtolerlower = 1.e-2 - xtolerupper = 1.e-1 -/ -&rooting_profile_inparm - rooting_profile_method_carbon = 1 - rooting_profile_method_water = 1 -/ -&soil_resis_inparm - soil_resis_method = 1 -/ -&bgc_shared -/ -&canopyfluxes_inparm - itmax_canopy_fluxes = 40 - use_undercanopy_stability = .false. -/ -&aerosol - fresh_snw_rds_max = 204.526d00 -/ -&clmu_inparm - building_temp_method = 1 - urban_hac = 'ON_WASTEHEAT' - urban_traffic = .false. -/ -&clm_soilstate_inparm - organic_frac_squared = .false. -/ -&clm_nitrogen - lnc_opt = .false. -/ -&clm_snowhydrology_inparm - lotmp_snowdensity_method = 'Slater2017' - reset_snow = .false. - reset_snow_glc = .false. - reset_snow_glc_ela = 1.e9 - snow_dzmax_l_1 = 0.03d00 - snow_dzmax_l_2 = 0.07d00 - snow_dzmax_u_1 = 0.02d00 - snow_dzmax_u_2 = 0.05d00 - snow_dzmin_1 = 0.010d00 - snow_dzmin_2 = 0.015d00 - snow_overburden_compaction_method = 'Vionnet2012' - upplim_destruct_metamorph = 175.d00 - wind_dependent_snow_density = .true. -/ -&cnprecision_inparm -/ -&clm_glacier_behavior - glacier_region_behavior = 'single_at_atm_topo','virtual','virtual','multiple' - glacier_region_ice_runoff_behavior = 'melted','melted','remains_ice','remains_ice' - glacier_region_melt_behavior = 'remains_in_place','replaced_by_ice','replaced_by_ice','replaced_by_ice' -/ -&crop -/ -&irrigation_inparm - irrig_depth = 0.6 - irrig_length = 14400 - irrig_method_default = 'drip' - irrig_min_lai = 0.0 - irrig_start_time = 21600 - irrig_target_smp = -3400. - irrig_threshold_fraction = 1.0 - limit_irrigation_if_rof_enabled = .false. - use_groundwater_irrigation = .false. -/ -&surfacealbedo_inparm - snowveg_affects_radiation = .true. -/ -&water_tracers_inparm - enable_water_isotopes = .false. - enable_water_tracer_consistency_checks = .false. -/ -&clm_humanindex_inparm - calc_human_stress_indices = 'FAST' -/ -&cnmresp_inparm -/ -&photosyns_inparm - leafresp_method = 0 - light_inhibit = .true. - modifyphoto_and_lmr_forcrop = .true. - rootstem_acc = .false. - stomatalcond_method = 'Medlyn2011' -/ -&cnfire_inparm -/ -&cn_general -/ -&nitrif_inparm -/ -&lifire_inparm -/ -&ch4finundated -/ -&clm_canopy_inparm - leaf_mr_vcm = 0.015d00 -/ -&scf_swenson_lawrence_2012_inparm - int_snow_max = 2000. - n_melt_glcmec = 10.0d00 -/ -!#-------------------------------------------------------------------------------------------------------------------------- -!# lnd_in:: Comment: -!# This namelist was created using the following command-line: -!# /glade/work/negins/ctsm_negin/bld/CLM build-namelist -cimeroot /glade/work/negins/ctsm_negin/cime/scripts/Tools/../.. -infile /glade/scratch/negins/ctsm1.0.dev066_MCT_I2000Clm50SpRsGs_lilac_2/Buildconf/clmconf/namelist -csmdata /glade/p/cesmdata/cseg/inputdata -inputdata /glade/scratch/negins/ctsm1.0.dev066_MCT_I2000Clm50SpRsGs_lilac_2/Buildconf/clm.input_data_list -ignore_ic_year -namelist &clm_inparm start_ymd=20000101 / -use_case 2000_control -res 4x5 -clm_start_type default -envxml_dir /glade/scratch/negins/ctsm1.0.dev066_MCT_I2000Clm50SpRsGs_lilac_2 -l_ncpl 48 -configuration clm -structure standard -lnd_frac /glade/p/cesmdata/cseg/inputdata/share/domains/domain.lnd.fv4x5_gx3v7.091218.nc -glc_nec 10 -co2_ppmv 367.0 -co2_type constant -config /glade/scratch/negins/ctsm1.0.dev066_MCT_I2000Clm50SpRsGs_lilac_2/Buildconf/clmconf/config_cache.xml -bgc sp -clm_accelerated_spinup off -lnd_tuning_mode clm5_0_GSWP3v1 -mask gx3v7 -!# For help on options use: /glade/work/negins/ctsm_negin/bld/CLM build-namelist -help -!#-------------------------------------------------------------------------------------------------------------------------- From 8625a0d4783908d3890b9b8119d65d6e44b572f3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 29 Nov 2019 12:47:00 -0700 Subject: [PATCH 179/556] more updates to clean up atm driver --- lilac/atm_driver/Makefile | 2 - lilac/atm_driver/atm_driver.F90 | 48 +++---- lilac/atm_driver/atm_driver_in | 4 +- lilac/atm_driver/drv_in | 234 -------------------------------- lilac/lilac/lilac_mod.F90 | 22 ++- lilac/lilac/lilac_utils.F90 | 15 +- 6 files changed, 46 insertions(+), 279 deletions(-) diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index 860c6743d7..a2521fca0a 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -14,8 +14,6 @@ include $(ESMFMKFILE) #================================================================================ ### Define directory paths #================================================================================ -# Temporarily hard-coded -# TODO: Please fix this part. CASE_NAME = why01-g CTSM_BLD_DIR = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf CTSM_INC = -I$(CTSM_BLD_DIR)/include diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 56a6759a8a..146ba9b9c2 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -26,7 +26,7 @@ program atm_driver integer :: comp_comm integer :: ierr real , allocatable :: centerCoords(:,:) - real , allocatable :: lon(:), lat(:) + real , allocatable :: atm_lons(:), atm_lats(:) integer , allocatable :: atm_global_index(:) integer :: mytask, ntasks integer :: my_start, my_end @@ -37,7 +37,7 @@ program atm_driver integer :: fileunit ! for namelist input ! Namelist and related variables - character(len=512) :: atm_mesh_filename + character(len=512) :: atm_mesh_file character(len=128) :: atm_calendar integer :: atm_timestep integer :: atm_start_year ! (yyyy) @@ -51,7 +51,7 @@ program atm_driver integer :: atm_timestep_start ! for internal time loop only integer :: atm_timestep_stop ! for internal time loop only - namelist /lilac_input/ atm_mesh_filename, atm_calendar, atm_timestep, & + namelist /atm_driver_input/ atm_mesh_file, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, & atm_timestep_start, atm_timestep_stop @@ -88,7 +88,7 @@ program atm_driver ! master processor and broadcast in the future open(newunit=fileunit, status="old", file="atm_driver_in") - read(fileunit, lilac_input, iostat=ierr) + read(fileunit, atm_driver_input, iostat=ierr) if (ierr > 0) then call shr_sys_abort( 'problem on read of atm_driver_in') end if @@ -98,9 +98,10 @@ program atm_driver ! Read mesh file to get number of points (n_points) !----------------------------------------------------------------------------- - call read_netcdf_mesh(atm_mesh_filename, nglobal) + print *, "DEBUG: atm_mesh_file = ",trim(atm_mesh_file) + call read_netcdf_mesh(atm_mesh_file, nglobal) if (mytask == 0 ) then - print *, " atm_driver mesh file ",trim(atm_mesh_filename) + print *, " atm_driver mesh file ",trim(atm_mesh_file) print *, "number of global points in mesh is:", nglobal end if @@ -125,6 +126,17 @@ program atm_driver i_global = i_global + 1 end do + ! first determine lats and lons + allocate(atm_lons(nlocal)) + allocate(atm_lats(nlocal)) + do i = 1,nlocal + i_global = atm_global_index(i) + atm_lons(i) = centerCoords(1,i_global) + atm_lons(i) = real(nint(atm_lons(i))) ! rounding to nearest int + atm_lats(i) = centerCoords(2,i_global) + atm_lats(i) = real(nint(atm_lats(i))) ! rounding to nearest int + end do + !------------------------------------------------------------------------ ! Initialize lilac !------------------------------------------------------------------------ @@ -132,7 +144,8 @@ program atm_driver if (mytask == 0 ) then print *, " initializing lilac " end if - call lilac_init(atm_global_index, atm_mesh_filename, atm_calendar, atm_timestep, & + call lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & + atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs) @@ -140,19 +153,8 @@ program atm_driver ! Fill in atm2lnd type pointer data !------------------------------------------------------------------------ - ! first determine lats and lons - allocate(lon(nlocal)) - allocate(lat(nlocal)) - do i = 1,nlocal - i_global = atm_global_index(i) - lon(i) = centerCoords(1,i_global) - lon(i) = real(nint(lon(i))) ! rounding to nearest int - lat(i) = centerCoords(2,i_global) - lat(i) = real(nint(lat(i))) ! rounding to nearest int - end do - ! now fill in the dataptr values - call atm_to_lilac (lon, lat) + call atm_driver_to_lilac (atm_lons, atm_lats) !------------------------------------------------------------------------ ! Run lilac @@ -253,7 +255,7 @@ subroutine nc_check_err(ierror, description, filename) end subroutine nc_check_err !======================================================================== - subroutine atm_to_lilac (lon, lat) + subroutine atm_driver_to_lilac (lon, lat) ! input/output variables real, intent(in) :: lon(:) @@ -320,10 +322,10 @@ subroutine atm_to_lilac (lon, lat) data(:) = 40.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 call lilac_atm2lnd('Faxa_swvdf', data) - end subroutine atm_to_lilac + end subroutine atm_driver_to_lilac !======================================================================== - subroutine lilac_to_atm () + subroutine lilac_to_atm_driver () ! local variables integer :: lsize @@ -346,6 +348,6 @@ subroutine lilac_to_atm () call lilac_lnd2atm('Sl_fv' , data) call lilac_lnd2atm('Sl_ram1' , data) - end subroutine lilac_to_atm + end subroutine lilac_to_atm_driver end program diff --git a/lilac/atm_driver/atm_driver_in b/lilac/atm_driver/atm_driver_in index ba32e9e528..b4becacda4 100644 --- a/lilac/atm_driver/atm_driver_in +++ b/lilac/atm_driver/atm_driver_in @@ -1,4 +1,5 @@ -&lilac_input +&atm_driver_input + atm_mesh_file = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' atm_start_year = 2000 atm_start_mon = 1 atm_start_day = 1 @@ -9,7 +10,6 @@ atm_stop_secs = 0 atm_timestep = 1800 atm_calendar = 'NOLEAP' - atm_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' atm_timestep_start = 1 atm_timestep_stop = 48 diff --git a/lilac/atm_driver/drv_in b/lilac/atm_driver/drv_in index 76d084e624..0282ee8721 100644 --- a/lilac/atm_driver/drv_in +++ b/lilac/atm_driver/drv_in @@ -1,62 +1,3 @@ -&cime_driver_inst - ninst_driver = 1 -/ -&cime_pes - atm_layout = "concurrent" - atm_ntasks = 36 - atm_nthreads = 1 - atm_pestride = 1 - atm_rootpe = 0 - cpl_ntasks = 36 - cpl_nthreads = 1 - cpl_pestride = 1 - cpl_rootpe = 36 - esp_layout = "concurrent" - esp_ntasks = 1 - esp_nthreads = 1 - esp_pestride = 1 - esp_rootpe = 0 - glc_layout = "concurrent" - glc_ntasks = 36 - glc_nthreads = 1 - glc_pestride = 1 - glc_rootpe = 36 - iac_layout = "concurrent" - iac_ntasks = 1 - iac_nthreads = 1 - iac_pestride = 1 - iac_rootpe = 0 - ice_layout = "concurrent" - ice_ntasks = 36 - ice_nthreads = 1 - ice_pestride = 1 - ice_rootpe = 36 - info_taskmap_comp = 0 - info_taskmap_model = 0 - lnd_layout = "concurrent" - lnd_ntasks = 36 - lnd_nthreads = 1 - lnd_pestride = 1 - lnd_rootpe = 36 - ocn_layout = "concurrent" - ocn_ntasks = 36 - ocn_nthreads = 1 - ocn_pestride = 1 - ocn_rootpe = 36 - rof_layout = "concurrent" - rof_ntasks = 36 - rof_nthreads = 1 - rof_pestride = 1 - rof_rootpe = 36 - wav_layout = "concurrent" - wav_ntasks = 36 - wav_nthreads = 1 - wav_pestride = 1 - wav_rootpe = 36 -/ -&esmf_inparm - esmf_logfile_kind = "ESMF_LOGKIND_NONE" -/ &papi_inparm papi_ctr1_str = "PAPI_FP_OPS" papi_ctr2_str = "PAPI_NO_CTR" @@ -91,178 +32,3 @@ profile_single_file = .false. profile_timer = 4 / -&seq_cplflds_inparm - flds_bgc_oi = .false. - flds_co2_dmsa = .false. - flds_co2a = .false. - flds_co2b = .false. - flds_co2c = .false. - flds_wiso = .false. - glc_nec = 10 - ice_ncat = 1 - nan_check_component_fields = .true. - seq_flds_i2o_per_cat = .false. -/ -&seq_cplflds_userspec - cplflds_custom = "" -/ -&seq_infodata_inparm - aoflux_grid = "ocn" - aqua_planet = .false. - aqua_planet_sst = 1 - atm_gnam = "4x5" - bfbflag = .false. - brnch_retain_casename = .false. - budget_ann = 1 - budget_daily = 0 - budget_inst = 0 - budget_ltann = 1 - budget_ltend = 0 - budget_month = 1 - case_desc = "UNSET" - case_name = "datm_test_mct01" - cime_model = "cesm" - coldair_outbreak_mod = .true. - cpl_decomp = 0 - cpl_seq_option = "CESM1_MOD" - do_budgets = .false. - do_histinit = .false. - drv_threading = .false. - eps_aarea = 9e-07 - eps_agrid = 1e-12 - eps_amask = 1e-13 - eps_frac = 1.0e-02 - eps_oarea = 0.1 - eps_ogrid = 0.01 - eps_omask = 1e-06 - flux_albav = .false. - flux_convergence = 0.01 - flux_diurnal = .false. - flux_epbal = "off" - flux_max_iteration = 5 - force_stop_at = "month" - glc_gnam = "null" - glc_renormalize_smb = "on_if_glc_coupled_fluxes" - histaux_a2x = .false. - histaux_a2x1hr = .false. - histaux_a2x1hri = .false. - histaux_a2x24hr = .false. - histaux_a2x3hr = .false. - histaux_a2x3hrp = .false. - histaux_double_precision = .false. - histaux_l2x = .false. - histaux_l2x1yrg = .false. - histaux_r2x = .false. - histavg_atm = .true. - histavg_glc = .true. - histavg_iac = .true. - histavg_ice = .true. - histavg_lnd = .true. - histavg_ocn = .true. - histavg_rof = .true. - histavg_wav = .true. - histavg_xao = .true. - hostname = "cheyenne" - iac_gnam = "null" - ice_gnam = "null" - info_debug = 1 - lnd_gnam = "4x5" - logfilepostfix = ".log" - max_cplstep_time = 0.0 - mct_usealltoall = .false. - mct_usevector = .false. - model_doi_url = "https://doi.org/10.5065/D67H1H0V" - model_version = "cesm-cmeps-v0.8-19-gae1c5be" - ocn_gnam = "null" - orb_eccen = 1.e36 - orb_iyear = 2000 - orb_iyear_align = 2000 - orb_mode = "fixed_year" - orb_mvelp = 1.e36 - orb_obliq = 1.e36 - outpathroot = "./" - reprosum_allow_infnan = .false. - reprosum_diffmax = -1.0e-8 - reprosum_recompute = .false. - reprosum_use_ddpdd = .false. - restart_file = "str_undefined" - rof_gnam = "null" - run_barriers = .false. - scmlat = -999. - scmlon = -999. - shr_map_dopole = .true. - single_column = .false. - start_type = "startup" - tchkpt_dir = "./timing/checkpoints" - tfreeze_option = "mushy" - timing_dir = "./timing" - username = "negins" - vect_map = "cart3d" - wall_time_limit = -1.0 - wav_gnam = "null" - wv_sat_scheme = "GoffGratch" - wv_sat_table_spacing = 1.0D0 - wv_sat_transition_start = 20.0D0 - wv_sat_use_tables = .false. -/ -&seq_timemgr_inparm - atm_cpl_dt = 1800 - atm_cpl_offset = 0 - barrier_n = 1 - barrier_option = "ndays" - barrier_ymd = -999 - calendar = "NO_LEAP" - data_assimilation_atm = .false. - data_assimilation_cpl = .false. - data_assimilation_glc = .false. - data_assimilation_iac = .false. - data_assimilation_ice = .false. - data_assimilation_lnd = .false. - data_assimilation_ocn = .false. - data_assimilation_rof = .false. - data_assimilation_wav = .false. - end_restart = .false. - esp_cpl_offset = 0 - esp_run_on_pause = .true. - glc_avg_period = "yearly" - glc_cpl_dt = 1800 - glc_cpl_offset = 0 - histavg_n = -999 - histavg_option = "never" - histavg_ymd = -999 - history_n = -999 - history_option = "never" - history_ymd = -999 - iac_cpl_offset = 0 - ice_cpl_dt = 1800 - ice_cpl_offset = 0 - lnd_cpl_dt = 1800 - lnd_cpl_offset = 0 - ocn_cpl_dt = 1800 - ocn_cpl_offset = 0 - pause_active_atm = .false. - pause_active_cpl = .false. - pause_active_glc = .false. - pause_active_iac = .false. - pause_active_ice = .false. - pause_active_lnd = .false. - pause_active_ocn = .false. - pause_active_rof = .false. - pause_active_wav = .false. - pause_n = 0 - pause_option = "never" - restart_n = 5 - restart_option = "ndays" - restart_ymd = -999 - rof_cpl_dt = 1800 - start_tod = 0 - start_ymd = 00010101 - stop_n = 5 - stop_option = "ndays" - stop_ymd = -999 - tprof_n = -999 - tprof_option = "never" - tprof_ymd = -999 - wav_cpl_dt = 1800 - wav_cpl_offset = 0 -/ diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 56250e0399..dfd74754c1 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -2,6 +2,9 @@ module lilac_mod !----------------------------------------------------------------------- ! !DESCRIPTION: + ! This is the driver for running CTSM and the ESMF lilac atm cap that + ! is put in place to ensure that the host atmosphere does not need to + ! know about ESMF !----------------------------------------------------------------------- use ESMF @@ -34,7 +37,8 @@ module lilac_mod contains !======================================================================== - subroutine lilac_init(atm_global_index, atm_mesh_filepath, atm_calendar, atm_timestep, & + subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & + atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs) @@ -51,8 +55,10 @@ subroutine lilac_init(atm_global_index, atm_mesh_filepath, atm_calendar, atm_tim use shr_sys_mod , only : shr_sys_abort ! input/output variables + character(len=*) , intent(in) :: atm_mesh_file integer , intent(in) :: atm_global_index(:) - character(len=*) , intent(in) :: atm_mesh_filepath + real , intent(in) :: atm_lons(:) + real , intent(in) :: atm_lats(:) character(len=*) , intent(in) :: atm_calendar integer , intent(in) :: atm_timestep integer , intent(in) :: atm_start_year !(yyyy) @@ -109,15 +115,19 @@ subroutine lilac_init(atm_global_index, atm_mesh_filepath, atm_calendar, atm_tim call shr_pio_init1(ncomps=1, nlfilename="drv_in", Global_Comm=mpic) ! TODO: make the filename lilac_in - ! Initialize lilac_util module variable gindex_atm + !------------------------------------------------------------------------- + ! Initial lilac_utils module variables + !------------------------------------------------------------------------- + + ! Initialize gindex_atm lsize = size(atm_global_index) allocate(gindex_atm(lsize)) gindex_atm(:) = atm_global_index(:) - ! Initialize lilac_util module variable for atm mesh file - atm_mesh_filename = atm_mesh_filepath + ! Initialize atm_mesh_filename + atm_mesh_filename = atm_mesh_file - ! Initialize lilac_util module data atm2lnd and lnd2atm + ! Initialize datatypes atm2lnd and lnd2atm call lilac_init_atm2lnd(lsize) call lilac_init_lnd2atm(lsize) diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 index 1012654080..25a05cf73b 100644 --- a/lilac/lilac/lilac_utils.F90 +++ b/lilac/lilac/lilac_utils.F90 @@ -3,20 +3,20 @@ module lilac_utils implicit none private - public :: this_clock public :: lilac_init_atm2lnd public :: lilac_init_lnd2atm public :: lilac_atm2lnd public :: lilac_lnd2atm - ! the HOST ATMOSPHERE atm sends gindex_atm and atm_mesh_filename via the inputs to lilac_init - ! Global index space info for atm data integer, public, allocatable :: gindex_atm (:) ! Mesh file to be read in by lilac_atm character(len=256), public :: atm_mesh_filename + ! Mesh file to be read in by ctsm + character(len=256), public :: lnd_mesh_filename + type :: atm2lnd_type character(len=128) :: fldname real*8, pointer :: dataptr(:) @@ -33,15 +33,6 @@ module lilac_utils end type lnd2atm_type type(atm2lnd_type), pointer, public :: lnd2atm(:) - type :: this_clock - integer, pointer :: yy - integer, pointer :: mm - integer, pointer :: dd - integer, pointer :: hh - integer, pointer :: mn - integer, pointer :: ss - end type this_clock - !======================================================================== contains !======================================================================== From b876970a5a8920359349580647194612ea6e46cd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 29 Nov 2019 13:00:09 -0700 Subject: [PATCH 180/556] moved drv_in to lilac_in and moved it to the ctsm directory --- lilac/atm_driver/drv_in | 34 ---------------------------------- lilac/lilac/lilac_mod.F90 | 2 +- 2 files changed, 1 insertion(+), 35 deletions(-) delete mode 100644 lilac/atm_driver/drv_in diff --git a/lilac/atm_driver/drv_in b/lilac/atm_driver/drv_in deleted file mode 100644 index 0282ee8721..0000000000 --- a/lilac/atm_driver/drv_in +++ /dev/null @@ -1,34 +0,0 @@ -&papi_inparm - papi_ctr1_str = "PAPI_FP_OPS" - papi_ctr2_str = "PAPI_NO_CTR" - papi_ctr3_str = "PAPI_NO_CTR" - papi_ctr4_str = "PAPI_NO_CTR" -/ -&pio_default_inparm - pio_async_interface = .false. - pio_blocksize = -1 - pio_buffer_size_limit = -1 - pio_debug_level = 0 - pio_rearr_comm_enable_hs_comp2io = .true. - pio_rearr_comm_enable_hs_io2comp = .false. - pio_rearr_comm_enable_isend_comp2io = .false. - pio_rearr_comm_enable_isend_io2comp = .true. - pio_rearr_comm_fcd = "2denable" - pio_rearr_comm_max_pend_req_comp2io = 0 - pio_rearr_comm_max_pend_req_io2comp = 64 - pio_rearr_comm_type = "p2p" -/ -&prof_inparm - profile_add_detail = .false. - profile_barrier = .false. - profile_depth_limit = 4 - profile_detail_limit = 2 - profile_disable = .false. - profile_global_stats = .true. - profile_outpe_num = 1 - profile_outpe_stride = 0 - profile_ovhd_measurement = .false. - profile_papi_enable = .false. - profile_single_file = .false. - profile_timer = 4 -/ diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index dfd74754c1..aa129b145a 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -113,7 +113,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & call ESMF_VMGet(vm, localPet=mytask, mpiCommunicator=mpic, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call shr_pio_init1(ncomps=1, nlfilename="drv_in", Global_Comm=mpic) ! TODO: make the filename lilac_in + call shr_pio_init1(ncomps=1, nlfilename="lilac_in", Global_Comm=mpic) !------------------------------------------------------------------------- ! Initial lilac_utils module variables From 9ae025a66d2e12670e47494f4fe696765a5bef7e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 29 Nov 2019 15:36:01 -0700 Subject: [PATCH 181/556] updated error code handling for initialization --- lilac/lilac/lilac_mod.F90 | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index aa129b145a..d8725a8dbe 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -275,9 +275,9 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_GridCompInitialize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp initialized", ESMF_LOGMSG_INFO) - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in initializing atmcap") + end if call ESMF_LogWrite(subname//"lilac_atm gridded component initialized", ESMF_LOGMSG_INFO) ! ------------------------------------------------------------------------- @@ -292,9 +292,9 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_GridCompInitialize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp initialized", ESMF_LOGMSG_INFO) - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in initializing ctsm") + end if call ESMF_LogWrite(subname//"CTSM gridded component initialized", ESMF_LOGMSG_INFO) ! ------------------------------------------------------------------------- @@ -302,17 +302,19 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! ------------------------------------------------------------------------- call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) - if (mytask == 0) then - print *, trim(subname) // "coupler :: cpl_atm2lnd_comp initialize finished" !, rc =", rc + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in initializing cpl_lnd2atm coupler component") end if + call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in initializing cpl_atm2lnd coupler component") + end if call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) + if (mytask == 0) then - print *, trim(subname) // "coupler :: cpl_lnd2atm_comp initialize finished" !, rc =", rc + print *, trim(subname) // "finished lilac initialization" end if end subroutine lilac_init From db7c754415f791138cd581af6099275f8f0ffff2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 29 Nov 2019 15:38:08 -0700 Subject: [PATCH 182/556] added land mesh info to lilac_in filename --- lilac_config/buildnml | 5 ++ src/cpl/lilac/lnd_comp_esmf.F90 | 140 ++++++++++++++++++-------------- 2 files changed, 82 insertions(+), 63 deletions(-) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 31a368acb8..d88ad29199 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -179,6 +179,11 @@ def buildnml(rundir, bldnmldir): # remove temporary files from rundir os.remove(os.path.join(rundir, "config_cache.xml")) os.remove(os.path.join(rundir, "env_lilac.xml")) + os.remove(os.path.join(rundir, "drv_flds_in")) + + # copy lilac_in to rundir - mesh file is defined in lilac_in + shutil.copy(os.path.join(bldnmldir,"lilac_in"), + os.path.join(rundir, "lilac_in")) ############################################################################### diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 1b88a27204..9ac64ab13e 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -4,19 +4,23 @@ module lnd_comp_esmf ! This is the ESMF cap for CTSM !---------------------------------------------------------------------------- - ! External libraries + ! external libraries use ESMF use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE + use mpi , only : MPI_BCAST, MPI_CHARACTER use mct_mod , only : mct_world_init, mct_world_clean, mct_die use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 use perf_mod , only : t_startf, t_stopf, t_barrierf - ! ctsm and share code + ! cime share code use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl use shr_sys_mod , only : shr_sys_abort use shr_file_mod , only : shr_file_setLogUnit, shr_file_getLogUnit use shr_orb_mod , only : shr_orb_decl, shr_orb_params use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use glc_elevclass_mod , only : glc_elevclass_init ! TODO: is this needed? + + ! ctsm code use spmdMod , only : masterproc, spmd_init, mpicom use decompMod , only : bounds_type, ldecomp, get_proc_bounds use domainMod , only : ldomain @@ -33,8 +37,6 @@ module lnd_comp_esmf use clm_driver , only : clm_drv use lnd_import_export , only : import_fields, export_fields use lnd_shr_methods , only : chkerr, state_diagnose - use spmdMod , only : masterproc, spmd_init - use glc_elevclass_mod , only : glc_elevclass_init ! TODO: is this needed? implicit none private ! By default make data private except @@ -100,70 +102,75 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) integer, intent(out) :: rc ! Return code ! local variable - integer :: ierr ! error code - integer :: n,g,i,j ! indices - logical :: exists ! true if file exists - real(r8) :: nextsw_cday ! calday from clock of next radiation computation - character(len=CL) :: caseid ! case identifier name - character(len=CL) :: ctitle ! case description title - character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) - integer :: nsrest ! clm restart type - logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type - logical :: atm_aero ! Flag if aerosol data sent from atm model - integer :: lbnum ! input to memory diagnostic - integer :: shrlogunit ! old values for log unit and log level - type(bounds_type) :: bounds ! bounds + integer :: ierr ! error code + integer :: n,g,i,j ! indices + logical :: exists ! true if file exists + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + character(len=CL) :: caseid ! case identifier name + character(len=CL) :: ctitle ! case description title + character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) + integer :: nsrest ! clm restart type + logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type + logical :: atm_aero ! Flag if aerosol data sent from atm model + integer :: lbnum ! input to memory diagnostic + integer :: shrlogunit ! old values for log unit and log level + type(bounds_type) :: bounds ! bounds ! generation of field bundles - type(ESMF_State) :: importState, exportState - type(ESMF_FieldBundle) :: c2l_fb - type(ESMF_FieldBundle) :: l2c_fb + type(ESMF_State) :: importState, exportState + type(ESMF_FieldBundle) :: c2l_fb + type(ESMF_FieldBundle) :: l2c_fb ! mesh generation - type(ESMF_Mesh) :: lnd_mesh - character(ESMF_MAXSTR) :: lnd_mesh_filename ! full filepath of land mesh file - integer :: nlnd, nocn ! local size ofarrays - integer, pointer :: gindex(:) ! global index space for land and ocean points - integer, pointer :: gindex_lnd(:) ! global index space for just land points - integer, pointer :: gindex_ocn(:) ! global index space for just ocean points - type(ESMF_DistGrid) :: distgrid + type(ESMF_Mesh) :: lnd_mesh + character(ESMF_MAXSTR) :: lnd_mesh_filename ! full filepath of land mesh file + integer :: nlnd, nocn ! local size ofarrays + integer, pointer :: gindex(:) ! global index space for land and ocean points + integer, pointer :: gindex_lnd(:) ! global index space for just land points + integer, pointer :: gindex_ocn(:) ! global index space for just ocean points + type(ESMF_DistGrid) :: distgrid + integer :: fileunit ! clock info - character(len=CL) :: calendar ! calendar type name - type(ESMF_CalKind_Flag) :: caltype ! calendar type from lilac clock - integer :: curr_tod, curr_ymd ! current time info - integer :: yy, mm, dd ! query output from lilac clock - integer :: dtime_lilac ! coupling time-step from the input lilac clock - integer :: ref_ymd ! reference date (YYYYMMDD) - integer :: ref_tod ! reference time of day (sec) - integer :: start_ymd ! start date (YYYYMMDD) - integer :: start_tod ! start time of day (sec) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) - type(ESMF_Time) :: currTime ! Current time - type(ESMF_Time) :: startTime ! Start time - type(ESMF_Time) :: stopTime ! Stop time - type(ESMF_Time) :: refTime ! Ref time - type(ESMF_TimeInterval) :: timeStep ! time step from lilac clock + character(len=CL) :: calendar ! calendar type name + type(ESMF_CalKind_Flag) :: caltype ! calendar type from lilac clock + integer :: curr_tod, curr_ymd ! current time info + integer :: yy, mm, dd ! query output from lilac clock + integer :: dtime_lilac ! coupling time-step from the input lilac clock + integer :: ref_ymd ! reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (sec) + integer :: start_ymd ! start date (YYYYMMDD) + integer :: start_tod ! start time of day (sec) + integer :: stop_ymd ! stop date (YYYYMMDD) + integer :: stop_tod ! stop time of day (sec) + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: startTime ! Start time + type(ESMF_Time) :: stopTime ! Stop time + type(ESMF_Time) :: refTime ! Ref time + type(ESMF_TimeInterval) :: timeStep ! time step from lilac clock ! orbital info - integer :: orb_iyear_align ! associated with model year - integer :: orb_cyear ! orbital year for current orbital computation - integer :: orb_iyear ! orbital year for current orbital computation - integer :: orb_eccen ! orbital year for current orbital computation + integer :: orb_iyear_align ! associated with model year + integer :: orb_cyear ! orbital year for current orbital computation + integer :: orb_iyear ! orbital year for current orbital computation + integer :: orb_eccen ! orbital year for current orbital computation ! for pio_init2 and mct - type(ESMF_VM) :: vm - integer :: mpicom_vm - integer :: ncomps = 1 - integer, pointer :: mycomms(:) ! for mct - integer, pointer :: myids(:) ! for mct - integer :: compids(1) = (/1/) ! for both mct and pio_init2 - array with component ids - integer :: comms(1) ! for both mct and pio_init2 - array with mpicoms - character(len=32) :: compLabels(1) = (/'LND'/) ! for pio_init2 - character(len=64) :: comp_name(1) = (/'LND'/) ! for pio_init2 - logical :: comp_iamin(1) = (/.true./) ! for pio init2 - integer :: iam(1) ! for pio_init2 + type(ESMF_VM) :: vm + integer :: mpicom_vm + integer :: ncomps = 1 + integer, pointer :: mycomms(:) ! for mct + integer, pointer :: myids(:) ! for mct + integer :: compids(1) = (/1/) ! for both mct and pio_init2 - array with component ids + integer :: comms(1) ! for both mct and pio_init2 - array with mpicoms + character(len=32) :: compLabels(1) = (/'LND'/) ! for pio_init2 + character(len=64) :: comp_name(1) = (/'LND'/) ! for pio_init2 + logical :: comp_iamin(1) = (/.true./) ! for pio init2 + integer :: iam(1) ! for pio_init2 + + ! input namelist read for ctsm mesh + namelist /lnd_mesh_inparm/ lnd_mesh_filename + character(len=*), parameter :: subname=trim(modName)//': (lnd_init) ' !------------------------------------------------------------------------ @@ -354,11 +361,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! generate the land mesh on ctsm distribution !-------------------------------- - ! TODO: mesh file should come into clm as a namelist for lilac only - ! for now need to hardwire this in lnd_mesh_filename here - - lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - ! obtain global index array for just land points which includes mask=0 or ocean points call get_proc_bounds( bounds ) @@ -388,6 +390,18 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) deallocate(gindex) call ESMF_LogWrite(subname//"DistGrid created......", ESMF_LOGMSG_INFO) + ! obtain the mesh filename from the namelist + if (masterproc) then + open(newunit=fileunit, status="old", file="lilac_in") + read(fileunit, lnd_mesh_inparm, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of lilac_in') + end if + close(fileunit) + end if + call MPI_BCAST(lnd_mesh_filename, len(lnd_mesh_filename), MPI_CHARACTER, 0, mpicom, ierr) + + ! create esmf mesh using distgrid and lnd_mesh_filename lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, elementDistgrid=Distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (masterproc) then From 8189b9bead630a8f6858822288835f594652d67a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 29 Nov 2019 15:52:49 -0700 Subject: [PATCH 183/556] added hard-wired lilac_in namelist for now --- lilac_config/lilac_in | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 lilac_config/lilac_in diff --git a/lilac_config/lilac_in b/lilac_config/lilac_in new file mode 100644 index 0000000000..6b217cc324 --- /dev/null +++ b/lilac_config/lilac_in @@ -0,0 +1,37 @@ +&lnd_mesh_inparm + lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' +/ +&papi_inparm + papi_ctr1_str = "PAPI_FP_OPS" + papi_ctr2_str = "PAPI_NO_CTR" + papi_ctr3_str = "PAPI_NO_CTR" + papi_ctr4_str = "PAPI_NO_CTR" +/ +&pio_default_inparm + pio_async_interface = .false. + pio_blocksize = -1 + pio_buffer_size_limit = -1 + pio_debug_level = 0 + pio_rearr_comm_enable_hs_comp2io = .true. + pio_rearr_comm_enable_hs_io2comp = .false. + pio_rearr_comm_enable_isend_comp2io = .false. + pio_rearr_comm_enable_isend_io2comp = .true. + pio_rearr_comm_fcd = "2denable" + pio_rearr_comm_max_pend_req_comp2io = 0 + pio_rearr_comm_max_pend_req_io2comp = 64 + pio_rearr_comm_type = "p2p" +/ +&prof_inparm + profile_add_detail = .false. + profile_barrier = .false. + profile_depth_limit = 4 + profile_detail_limit = 2 + profile_disable = .false. + profile_global_stats = .true. + profile_outpe_num = 1 + profile_outpe_stride = 0 + profile_ovhd_measurement = .false. + profile_papi_enable = .false. + profile_single_file = .false. + profile_timer = 4 +/ From d3837caa08ff58be7e7cd130748c50ed40152adf Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 29 Nov 2019 22:34:54 -0700 Subject: [PATCH 184/556] added files for lilac history output - but have not turned on implementation --- lilac/atm_driver/Makefile | 44 +- lilac/lilac/lilac_constants.F90 | 16 + lilac/lilac/lilac_history.F90 | 284 +++++ lilac/lilac/lilac_io.F90 | 1832 +++++++++++++++++++++++++++++++ lilac/lilac/lilac_methods.F90 | 1709 ++++++++++++++++++++++++++++ lilac/lilac/lilac_mod.F90 | 23 +- lilac/lilac/lilac_time.F90 | 541 +++++++++ lilac/lilac/lilac_utils.F90 | 2 + 8 files changed, 4437 insertions(+), 14 deletions(-) create mode 100644 lilac/lilac/lilac_constants.F90 create mode 100644 lilac/lilac/lilac_history.F90 create mode 100644 lilac/lilac/lilac_io.F90 create mode 100644 lilac/lilac/lilac_methods.F90 create mode 100644 lilac/lilac/lilac_time.F90 diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index a2521fca0a..96846db837 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -15,12 +15,15 @@ include $(ESMFMKFILE) ### Define directory paths #================================================================================ CASE_NAME = why01-g -CTSM_BLD_DIR = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf +PIO_INC = -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/include +CTSM_BLD_DIR = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf CTSM_INC = -I$(CTSM_BLD_DIR)/include CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm + #TRACEBACK_FLAGS = -g -traceback -debug all -check all -O2 -r8 TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free + # ----------------------------------------------------------------------------- EXTRA_LIBS = -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -lcsm_share -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib MORE_LIBS = -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/clm/obj/ -I//glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ @@ -69,6 +72,36 @@ lilac_mod.o : $(LILAC_DIR)/lilac_mod.F90 $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ $(EXTRA_LIBS) $(MORE_LIBS) $< +lilac_constants.o : $(LILAC_DIR)/lilac_constants.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< + +lilac_methods.o : $(LILAC_DIR)/lilac_methods.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< + +lilac_time.o : $(LILAC_DIR)/lilac_time.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< + +lilac_io.o : $(LILAC_DIR)/lilac_io.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) $(PIO_INC) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< + +lilac_history.o : $(LILAC_DIR)/lilac_history.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< + atm_driver.o : $(DRIVER_DIR)/atm_driver.F90 $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ @@ -81,11 +114,14 @@ atm_driver: atm_driver.o lilac_atmcap.o lilac_mod.o lilac_utils.o lilac_cpl.o rm *.o *.mod # module dependencies: -#atm_driver.o: lilac_mod.o lilac_atmcap.o lilac_utils.o lilac_cpl.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o atm_driver.o: lilac_mod.o lilac_atmcap.o lilac_utils.o lilac_cpl.o -lilac_mod.o: lilac_atmcap.o lilac_utils.o lilac_cpl.o #shr_pio_mod.o +lilac_mod.o: lilac_atmcap.o lilac_utils.o lilac_cpl.o lilac_history.o lilac_atmcap.o: lilac_utils.o - +lilac_constants.o : +lilac_methods.o: lilac_constants.o +lilac_time.o: lilac_constants.o lilac_methods.o +lilac_io.o: lilac_constants.o lilac_methods.o +lilac_history.o: lilac_constants.o lilac_methods.o lilac_io.o lilac_time.o # ----------------------------------------------------------------------------- .PHONY: clean berzerk remake diff --git a/lilac/lilac/lilac_constants.F90 b/lilac/lilac/lilac_constants.F90 new file mode 100644 index 0000000000..d564e14420 --- /dev/null +++ b/lilac/lilac/lilac_constants.F90 @@ -0,0 +1,16 @@ +module lilac_constants + + use shr_kind_mod, only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + + implicit none + public + + logical, parameter :: lilac_constants_statewrite_flag = .false. + real(R8), parameter :: lilac_constants_spval_init = 0.0_R8 ! spval for initialization + real(R8), parameter :: lilac_constants_spval = 0.0_R8 ! spval + real(R8), parameter :: lilac_constants_czero = 0.0_R8 ! spval + integer, parameter :: lilac_constants_ispval_mask = -987987 ! spval for RH mask values + integer, parameter :: lilac_constants_SecPerDay = 86400 ! Seconds per day + integer :: lilac_constants_dbug_flag = 0 + +end module lilac_constants diff --git a/lilac/lilac/lilac_history.F90 b/lilac/lilac/lilac_history.F90 new file mode 100644 index 0000000000..e72099985a --- /dev/null +++ b/lilac/lilac/lilac_history.F90 @@ -0,0 +1,284 @@ +module lilac_history + + !----------------------------------------------------------------------------- + ! Mediator Phases + !----------------------------------------------------------------------------- + + use ESMF + use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl, r8=>shr_kind_r8 + use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag + use lilac_constants , only : SecPerDay => lilac_constants_SecPerDay + use lilac_methods , only : FB_reset => lilac_methods_FB_reset + use lilac_methods , only : FB_diagnose => lilac_methods_FB_diagnose + use lilac_methods , only : FB_GetFldPtr => lilac_methods_FB_GetFldPtr + use lilac_methods , only : FB_accum => lilac_methods_FB_accum + use lilac_methods , only : chkerr + use lilac_time , only : alarmInit => lilac_time_alarmInit + use lilac_io , only : lilac_io_write, lilac_io_wopen, lilac_io_enddef + use lilac_io , only : lilac_io_close, lilac_io_date2yyyymmdd, lilac_io_sec2hms + use lilac_io , only : lilac_io_ymd2date + + implicit none + private + + public :: lilac_history_alarm_init + public :: lilac_history_write + + type(ESMF_Alarm) :: AlarmHist + type(ESMF_Alarm) :: AlarmHistAvg + character(*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine lilac_history_alarm_init(clock, hist_freq_n, hist_freq_option, rc) + + ! Initialize lilac history file alarm + + ! input/output variables + type(ESMF_Clock) :: clock ! lilac clock + integer , intent(in) :: hist_freq_n + character(len=*) , intent(in) :: hist_freq_option + integer , intent(out) :: rc + + ! local variables + type(ESMF_Time) :: currtime + type(ESMF_Time) :: reftime + type(ESMF_Time) :: starttime + type(ESMF_Time) :: nexttime + type(ESMF_Calendar) :: calendar ! calendar type + character(len=64) :: currtimestr + character(CS) :: histavg_option ! Histavg option units + integer :: yr,mon,day,sec ! time units + character(CL) :: freq_option ! freq_option setting (ndays, nsteps, etc) + integer :: freq_n ! freq_n setting relative to freq_option + integer :: iam + character(len=*), parameter :: subname='(lilac_history_alarm_init)' + !--------------------------------------- + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + endif + rc = ESMF_SUCCESS + + !--------------------------------------- + ! Get the clock info + !--------------------------------------- + + call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=rc) + endif + + !--------------------------------------- + ! Initialize thie history alarm + !--------------------------------------- + + call alarmInit(clock, AlarmHist, option=freq_option, opt_n=freq_n, RefTime=RefTime, alarmname='history', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine lilac_history_alarm_init + + !=============================================================================== + + subroutine lilac_history_write(atm2lnd_a_state, atm2lnd_l_state, lnd2atm_l_state, lnd2atm_a_state, clock, rc) + + ! Write lilac history file + + ! input/output variables + type(ESMF_State) :: atm2lnd_a_state + type(ESMF_State) :: atm2lnd_l_state + type(ESMF_State) :: lnd2atm_l_state + type(ESMF_State) :: lnd2atm_a_state + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(ESMF_FieldBundle) :: c2a_fb , a2c_fb, c2l_fb, l2c_fb + type(ESMF_VM) :: vm + type(ESMF_Time) :: currtime + type(ESMF_Time) :: reftime + type(ESMF_Time) :: starttime + type(ESMF_Time) :: nexttime + type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time + type(ESMF_Calendar) :: calendar ! calendar type + character(len=64) :: currtimestr + character(len=64) :: nexttimestr + character(CS) :: histavg_option ! Histavg option units + integer :: i,j,m,n,n1,ncnt + integer :: start_ymd ! Starting date YYYYMMDD + integer :: start_tod ! Starting time-of-day (s) + integer :: nx,ny ! global grid size + integer :: yr,mon,day,sec ! time units + real(r8) :: rval ! real tmp value + real(r8) :: dayssince ! Time interval since reference time + integer :: fk ! index + character(CL) :: time_units ! units of time variable + character(CL) :: case_name ! case name + character(CL) :: hist_file ! Local path to history filename + character(CS) :: cpl_inst_tag ! instance tag + character(CL) :: freq_option ! freq_option setting (ndays, nsteps, etc) + integer :: freq_n ! freq_n setting relative to freq_option + logical :: alarmIsOn ! generic alarm flag + real(r8) :: tbnds(2) ! CF1.0 time bounds + logical :: whead,wdata ! for writing restart/history cdf files + integer :: dbrc + integer :: iam + logical,save :: first_call = .true. + character(len=*), parameter :: subname='(lilac_history_write)' + !--------------------------------------- + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + endif + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the communicator and localpet + !--------------------------------------- + + call ESMF_VMGetGlobal(vm=vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! --- Get the clock info + !--------------------------------------- + + call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=rc) + endif + + call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=rc) + endif + timediff = nexttime - reftime + call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) + dayssince = day + sec/real(SecPerDay,R8) + + call ESMF_TimeGet(reftime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call lilac_io_ymd2date(yr,mon,day,start_ymd) + start_tod = sec + time_units = 'days since ' // trim(lilac_io_date2yyyymmdd(start_ymd)) // ' ' // lilac_io_sec2hms(start_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! --- History Alarms + !--------------------------------------- + + if (ESMF_AlarmIsRinging(AlarmHist, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + alarmIsOn = .true. + call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + alarmisOn = .false. + endif + + !--------------------------------------- + ! --- History File + ! Use nexttimestr rather than currtimestr here since that is the time at the end of + ! the timestep and is preferred for history file names + !--------------------------------------- + + if (alarmIsOn) then + write(hist_file,"(6a)") & + trim(case_name), '.cpl',trim(cpl_inst_tag),'.hi.', trim(nexttimestr),'.nc' + call ESMF_LogWrite(trim(subname)//": write "//trim(hist_file), ESMF_LOGMSG_INFO, rc=rc) + call lilac_io_wopen(hist_file, vm, iam, clobber=.true.) + + do m = 1,2 + whead=.false. + wdata=.false. + if (m == 1) then + whead=.true. + elseif (m == 2) then + wdata=.true. + call lilac_io_enddef(hist_file) + endif + + tbnds = dayssince + + call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO, rc=rc) + if (tbnds(1) >= tbnds(2)) then + call lilac_io_write(hist_file, iam, & + time_units=time_units, calendar=calendar, time_val=dayssince, & + whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call lilac_io_write(hist_file, iam, & + time_units=time_units, calendar=calendar, time_val=dayssince, & + whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + nx = 72 ! hard-wire for now + ny = 46 ! hard-wire for now + + call ESMF_StateGet(atm2lnd_a_state, 'a2c_fb', a2c_fb) ! from atm + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, a2c_fb, & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='a2c_from_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(atm2lnd_l_state, 'c2l_fb', c2l_fb) ! to land + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, c2l_fb, & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='c2l_to_land', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(lnd2atm_l_state, 'l2c_fb', l2c_fb) ! from land + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, c2l_fb, & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='l2c_from_land', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(lnd2atm_a_state, 'c2a_fb', c2a_fb) ! to atm + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, c2l_fb, & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='c2a_to_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + enddo + + call lilac_io_close(hist_file, iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + endif + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + first_call = .false. + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + endif + + end subroutine lilac_history_write + + !=============================================================================== + +end module lilac_history diff --git a/lilac/lilac/lilac_io.F90 b/lilac/lilac/lilac_io.F90 new file mode 100644 index 0000000000..d5aeabf48f --- /dev/null +++ b/lilac/lilac/lilac_io.F90 @@ -0,0 +1,1832 @@ +module lilac_io + + !------------------------------------------ + ! Create mediator history files + !------------------------------------------ + + use ESMF + use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl + use shr_kind_mod , only : r4=>shr_kind_r4, i8=>shr_kind_i8, r8=>shr_kind_r8 + use shr_const_mod , only : fillvalue => SHR_CONST_SPVAL + use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat + use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag + use lilac_methods , only : FB_getFieldN => lilac_methods_FB_getFieldN + use lilac_methods , only : FB_getFldPtr => lilac_methods_FB_getFldPtr + use lilac_methods , only : FB_getNameN => lilac_methods_FB_getNameN + use lilac_methods , only : chkerr + use pio , only : file_desc_t, iosystem_desc_t + use pio , only : var_desc_t, io_desc_t, PIO_UNLIMITED + use pio , only : pio_def_dim, pio_inq_dimid, pio_real, 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, pio_offset_kind, pio_int + use pio , only : pio_double, pio_def_dim, pio_def_var, pio_put_att, pio_put_var + use pio , only : PIO_IOTYPE_PNETCDF, PIO_IOTYPE_NETCDF, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_openfile, pio_createfile, PIO_GLOBAL, pio_enddef + use pio , only : pio_put_att, pio_redef, pio_get_att + use pio , only : pio_seterrorhandling, pio_file_is_open, pio_clobber, pio_write, pio_noclobber + use pio , only : pio_file_is_open, pio_closefile + use pio , only : pio_redef, pio_enddef + use pio , only : var_desc_t, pio_def_dim + use pio , only : pio_put_att, pio_put_var + use pio , only : pio_int, pio_char + use pio , only : var_desc_t, pio_def_var, pio_put_att + use pio , only : pio_double, pio_noerr, pio_put_var + use pio , only : file_desc_T, var_desc_t, io_desc_t, pio_nowrite, pio_openfile + use pio , only : pio_noerr, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_double, pio_get_att, pio_seterrorhandling, pio_freedecomp, pio_closefile + use pio , only : pio_read_darray, pio_offset_kind, pio_setframe + 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_vardimid + use pio , only : pio_double, pio_seterrorhandling, pio_initdecomp + use pio , only : var_desc_t, file_desc_t, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_seterrorhandling + use pio , only : pio_get_var, pio_get_att, pio_openfile + use pio , only : pio_nowrite, pio_openfile, pio_global + use pio , only : pio_closefile + 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_get_var + use pio , only : pio_nowrite, pio_openfile, pio_global, pio_get_att + use pio , only : file_desc_t, var_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_closefile, pio_get_var + use pio , only : pio_openfile, pio_global, pio_get_att, pio_nowrite + use pio , only : var_desc_t, pio_def_dim, pio_put_att + use pio , only : pio_put_var + use pio , only : var_desc_t, pio_def_dim + use pio , only : pio_put_var, pio_double, pio_put_att + + implicit none + private + + integer :: logunit = 6 ! TODO: fix this + integer :: lilac_id + + ! public member functions: + public :: lilac_io_wopen + public :: lilac_io_close + public :: lilac_io_redef + public :: lilac_io_enddef + public :: lilac_io_sec2hms + public :: lilac_io_read + public :: lilac_io_write + public :: lilac_io_init + public :: lilac_io_date2yyyymmdd + public :: lilac_io_datetod2string + public :: lilac_io_ymd2date + + ! private member functions + private :: lilac_io_file_exists + + ! public data members: + interface lilac_io_read + module procedure lilac_io_read_FB + module procedure lilac_io_read_int + module procedure lilac_io_read_int1d + module procedure lilac_io_read_r8 + module procedure lilac_io_read_r81d + module procedure lilac_io_read_char + end interface lilac_io_read + interface lilac_io_write + module procedure lilac_io_write_FB + module procedure lilac_io_write_int + module procedure lilac_io_write_int1d + module procedure lilac_io_write_r8 + module procedure lilac_io_write_r81d + module procedure lilac_io_write_char + module procedure lilac_io_write_time + end interface lilac_io_write + interface lilac_io_date2ymd + module procedure lilac_io_date2ymd_int + module procedure lilac_io_date2ymd_long + end interface lilac_io_date2ymd + interface lilac_io_datetod2string + module procedure lilac_io_datetod2string_int + module procedure lilac_io_datetod2string_long + end interface lilac_io_datetod2string + interface lilac_io_ymd2date + module procedure lilac_io_ymd2date_int + module procedure lilac_io_ymd2date_long + end interface lilac_io_ymd2date + + !------------------------------------------------------------------------------- + ! module data + !------------------------------------------------------------------------------- + + character(*),parameter :: prefix = "lilac_io_" + character(*),parameter :: modName = "(lilac_io_mod) " + character(*),parameter :: version = "lilac0" + 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 +!================================================================================= + + logical function lilac_io_file_exists(vm, iam, filename) + + !--------------- + ! inquire if i/o file exists + !--------------- + + ! input/output variables + type(ESMF_VM) :: vm + integer, intent(in) :: iam + character(len=*), intent(in) :: filename + + ! local variables + integer :: tmp(1) + integer :: rc + !------------------------------------------------------------------------------- + + lilac_io_file_exists = .false. + if (iam==0) inquire(file=trim(filename),exist=lilac_io_file_exists) + if (lilac_io_file_exists) tmp(1) = 1 + + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(tmp(1) == 1) lilac_io_file_exists = .true. + + end function lilac_io_file_exists + + !=============================================================================== + subroutine lilac_io_init() + + !--------------- + ! initialize pio + !--------------- + +#ifdef INTERNAL_PIO_INIT + ! if CMEPS is the only component using PIO, then it needs to initialize PIO + use shr_pio_mod , only : shr_pio_init2 + + type(ESMF_VM) :: vm + integer :: comms(1), comps(1) + logical :: comp_iamin(1) + integer :: comp_comm_iam(1) + character(len=32) :: compLabels(1) + integer :: rc + + call ESMF_VMGetCurrent(vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, mpiCommunicator=comms(1), localPet=comp_comm_iam(1), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + comps(1) = lilac_id + compLabels(1) = "MED" + comp_iamin(1) = .true. + + call shr_pio_init2(comps, compLabels, comp_iamin, comms, comp_comm_iam) +#endif + + io_subsystem => shr_pio_getiosys(lilac_id) + pio_iotype = shr_pio_getiotype(lilac_id) + pio_ioformat = shr_pio_getioformat(lilac_id) + + end subroutine lilac_io_init + + !=============================================================================== + subroutine lilac_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) + + !--------------- + ! open netcdf file + !--------------- + + ! input/output arguments + character(*), intent(in) :: filename + type(ESMF_VM) :: vm + integer, intent(in) :: iam + logical, optional, intent(in) :: clobber + integer, optional, intent(in) :: file_ind + character(CL), optional, intent(in) :: model_doi_url + + ! local variables + logical :: lclobber + integer :: rcode + integer :: nmode + integer :: lfile_ind + integer :: rc + character(CL) :: lversion + character(CL) :: lmodel_doi_url + character(*),parameter :: subName = '(lilac_io_wopen) ' + !------------------------------------------------------------------------------- + + lversion=trim(version) + + lclobber = .false. + if (present(clobber)) lclobber=clobber + + lmodel_doi_url = 'unset' + if (present(model_doi_url)) lmodel_doi_url = model_doi_url + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not. pio_file_is_open(io_file(lfile_ind))) then + + ! filename not open + wfilename = filename + + if (lilac_io_file_exists(vm, iam, filename)) then + if (lclobber) then + nmode = pio_clobber + ! only applies to classic NETCDF files. + if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then + nmode = ior(nmode,pio_ioformat) + endif + rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + if(iam==0) write(logunit,*) subname,' create file ',trim(filename) + else + rcode = pio_openfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), pio_write) + if (iam==0) then + write(logunit,*) subname,' open file ',trim(filename) + end if + call pio_seterrorhandling(io_file(lfile_ind),PIO_BCAST_ERROR) + rcode = pio_get_att(io_file(lfile_ind),pio_global,"file_version",lversion) + call pio_seterrorhandling(io_file(lfile_ind),PIO_INTERNAL_ERROR) + if (trim(lversion) /= trim(version)) then + rcode = pio_redef(io_file(lfile_ind)) + rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) + rcode = pio_enddef(io_file(lfile_ind)) + endif + endif + else + nmode = pio_noclobber + ! only applies to classic NETCDF files. + if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then + nmode = ior(nmode,pio_ioformat) + endif + rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + if (iam==0) then + write(logunit,*) subname,' create file ',trim(filename) + end if + rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) + rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + endif + elseif (trim(wfilename) /= trim(filename)) then + ! filename is open, better match open filename + if(iam==0) write(logunit,*) subname,' different filename currently open ',trim(filename) + if(iam==0) write(logunit,*) subname,' different wfilename currently open ',trim(wfilename) + call ESMF_LogWrite(subname//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + else + ! filename is already open, just return + endif + + end subroutine lilac_io_wopen + + !=============================================================================== + subroutine lilac_io_close(filename, iam, file_ind, rc) + + !--------------- + ! close netcdf file + !--------------- + + ! input/output variables + character(*), intent(in) :: filename + integer, intent(in) :: iam + integer,optional, intent(in) :: file_ind + integer , intent(out) :: rc + + ! local variables + integer :: lfile_ind + character(*),parameter :: subName = '(lilac_io_close) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not. pio_file_is_open(io_file(lfile_ind))) then + ! filename not open, just return + elseif (trim(wfilename) == trim(filename)) then + ! filename matches, close it + call pio_closefile(io_file(lfile_ind)) + else + ! different filename is open, abort + if (iam==0) write(logunit,*) subname,' different filename currently open, aborting ',trim(filename) + if (iam==0) write(logunit,*) subname,' different wfilename currently open, aborting ',trim(wfilename) + call ESMF_LogWrite(subname//'different file currently open, aborting '//trim(filename), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + wfilename = '' + end subroutine lilac_io_close + + !=============================================================================== + subroutine lilac_io_redef(filename,file_ind) + + ! 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 lilac_io_redef + + !=============================================================================== + subroutine lilac_io_enddef(filename,file_ind) + + ! 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_enddef(io_file(lfile_ind)) + end subroutine lilac_io_enddef + + !=============================================================================== + character(len=24) function lilac_io_date2yyyymmdd (date) + + integer, intent(in) :: date ! date expressed as an integer: yyyymmdd + + call lilac_io_datetod2string(date_str = lilac_io_date2yyyymmdd, ymd = date) + + end function lilac_io_date2yyyymmdd + + !=============================================================================== + character(len=8) function lilac_io_sec2hms (seconds, rc) + + ! input arguments + integer, intent(in) :: seconds + integer, intent(out) :: rc + + ! local variables + integer :: hours ! hours of hh:mm:ss + integer :: minutes ! minutes of hh:mm:ss + integer :: secs ! seconds of hh:mm:ss + !---------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if (seconds < 0 .or. seconds > 86400) then + write(logunit,*)'lilac_io_sec2hms: bad input seconds:', seconds + call ESMF_LogWrite('lilac_io_sec2hms: bad input seconds', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + hours = seconds / 3600 + minutes = (seconds - hours*3600) / 60 + secs = (seconds - hours*3600 - minutes*60) + + if (minutes < 0 .or. minutes > 60) then + write(logunit,*)'lilac_io_sec2hms: bad minutes = ',minutes + call ESMF_LogWrite('lilac_io_sec2hms: bad minutes', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + if (secs < 0 .or. secs > 60) then + write(logunit,*)'lilac_io_sec2hms: bad secs = ',secs + call ESMF_LogWrite('lilac_io_sec2hms: bad secs', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + write(lilac_io_sec2hms,80) hours, minutes, secs +80 format(i2.2,':',i2.2,':',i2.2) + + end function lilac_io_sec2hms + + !=============================================================================== + subroutine lilac_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & + fillval, pre, tavg, use_float, file_ind, rc) + + !--------------- + ! Write FB to netcdf file + !--------------- + + ! input/output variables + character(len=*), intent(in) :: filename ! file + integer, intent(in) :: iam ! local pet + type(ESMF_FieldBundle), intent(in) :: FB ! data to be written + logical, optional, intent(in) :: whead ! write header + logical, optional, intent(in) :: wdata ! write data + integer , optional, intent(in) :: nx ! 2d grid size if available + integer , optional, intent(in) :: ny ! 2d grid size if available + integer , optional, intent(in) :: nt ! time sample + real(r8), optional, intent(in) :: fillval ! fill value + character(len=*), optional, intent(in) :: pre ! prefix to variable name + logical, optional, intent(in) :: tavg ! is this a tavg + logical, optional, intent(in) :: use_float ! write output as float rather than double + integer, optional, intent(in) :: file_ind + integer, intent(out):: rc + + ! local variables + type(ESMF_Field) :: field + type(ESMF_Mesh) :: mesh + type(ESMF_Distgrid) :: distgrid + type(ESMF_VM) :: VM + integer :: mpicom + integer :: rcode + integer :: nf,ns,ng + integer :: k,n + integer :: ndims, nelements + integer ,target :: dimid2(2) + integer ,target :: dimid3(3) + integer ,pointer :: dimid(:) + type(var_desc_t) :: varid + type(io_desc_t) :: iodesc + integer(kind=Pio_Offset_Kind) :: frame + character(CL) :: itemc ! string converted to char + character(CL) :: name1 ! var name + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + character(CL) :: lpre ! local prefix + logical :: lwhead, lwdata + logical :: luse_float + integer :: lnx,lny + real(r8) :: lfillvalue + integer, pointer :: minIndexPTile(:,:) + integer, pointer :: maxIndexPTile(:,:) + integer :: dimCount, tileCount + integer, pointer :: Dof(:) + integer :: lfile_ind + real(r8), pointer :: fldptr1(:) + real(r8), pointer :: fldptr2(:,:) + real(r8), allocatable :: ownedElemCoords(:), ownedElemCoords_x(:), ownedElemCoords_y(:) + character(len=number_strlen) :: cnumber + character(CL) :: tmpstr + 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 = '(lilac_io_write_FB) ' + !------------------------------------------------------------------------------- + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_Success + + lfillvalue = fillvalue + if (present(fillval)) then + lfillvalue = fillval + endif + + lpre = ' ' + if (present(pre)) then + 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) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + rc = ESMF_Success + return + endif + + lwhead = .true. + lwdata = .true. + if (present(whead)) lwhead = whead + if (present(wdata)) lwdata = wdata + + 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) + endif + return + endif + + luse_float = .false. + if (present(use_float)) luse_float = use_float + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) + write(tmpstr,*) subname//' field count = '//trim(lpre),nf + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (nf < 1) then + 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) + endif + rc = ESMF_Success + return + endif + + call FB_getFieldN(FB, 1, field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field, mesh=mesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, spatialDim=ndims, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write(tmpstr,*) subname, 'ndims, nelements = ', ndims, nelements + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + if (.not. allocated(ownedElemCoords) .and. ndims > 0 .and. nelements > 0) then + allocate(ownedElemCoords(ndims*nelements)) + allocate(ownedElemCoords_x(ndims*nelements/2)) + allocate(ownedElemCoords_y(ndims*nelements/2)) + + call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ownedElemCoords_x = ownedElemCoords(1::2) + ownedElemCoords_y = ownedElemCoords(2::2) + end if + + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) + if (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 (chkerr(rc,__LINE__,u_FILE_u)) return + + ! 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 + + ng = maxval(maxIndexPTile) + lnx = ng + lny = 1 + deallocate(minIndexPTile, maxIndexPTile) + + frame = -1 + if (present(nt)) then + frame = nt + endif + if (present(nx)) then + if (nx > 0) lnx = nx + endif + if (present(ny)) then + if (ny > 0) lny = ny + 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) + + !TODO: this should not be an error for say CTSM which does not send a global grid + !rc = ESMF_FAILURE + !return + endif + + if (lwhead) then + rcode = pio_def_dim(io_file(lfile_ind),trim(lpre)//'_nx',lnx,dimid2(1)) + rcode = pio_def_dim(io_file(lfile_ind),trim(lpre)//'_ny',lny,dimid2(2)) + + if (present(nt)) then + dimid3(1:2) = dimid2 + rcode = pio_inq_dimid(io_file(lfile_ind),'time',dimid3(3)) + dimid => dimid3 + else + dimid => dimid2 + endif + + write(tmpstr,*) subname,' dimid = ',dimid + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + do k = 1,nf + call FB_getNameN(FB, k, itemc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Determine rank of field with name itemc + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (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 + if (rank == 2) then + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + if (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 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return + rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + 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 + name1 = trim(lpre)//'_'//trim(itemc) + 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return + rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + 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 + end if + end do + + ! Add coordinate information to file + name1 = trim(lpre)//'_lon' + if (luse_float) then + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) + else + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) + end if + rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "longitude") + rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_east") + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "longitude") + + name1 = trim(lpre)//'_lat' + if (luse_float) then + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) + else + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) + end if + rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "latitude") + rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_north") + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "latitude") + + ! Finish define mode + if (lwdata) call lilac_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 (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) + + ! call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) + + deallocate(dof) + + do k = 1,nf + call FB_getNameN(FB, k, itemc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call FB_getFldPtr(FB, itemc, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) + if (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 + 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 (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (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 + + ! Fill coordinate variables + name1 = trim(lpre)//'_lon' + 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, ownedElemCoords_x, rcode, fillval=lfillvalue) + + name1 = trim(lpre)//'_lat' + 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, ownedElemCoords_y, rcode, fillval=lfillvalue) + + 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) + endif + + end subroutine lilac_io_write_FB + + !=============================================================================== + subroutine lilac_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, rc) + + !--------------- + ! Write scalar integer to netcdf file + !--------------- + + ! intput/output variables + character(len=*) ,intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + integer ,intent(in) :: idata ! data to be written + character(len=*) ,intent(in) :: dname ! name of data + logical,optional ,intent(in) :: whead ! write header + logical,optional ,intent(in) :: wdata ! write data + integer,optional ,intent(in) :: file_ind + integer ,intent(out):: rc + + ! local variables + integer :: rcode + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(lilac_io_write_int) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + lwdata = .true. + if (present(whead)) lwhead = whead + if (present(wdata)) lwdata = wdata + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (lwhead) then + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,idata) + ! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata + endif + + end subroutine lilac_io_write_int + + !=============================================================================== + subroutine lilac_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_ind, rc) + + !--------------- + ! Write 1d integer array to netcdf file + !--------------- + + ! input/output arguments + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + integer ,intent(in) :: idata(:) ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + integer , intent(out) :: rc + + ! local variables + integer :: rcode + integer :: dimid(1) + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + integer :: lnx + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(lilac_io_write_int1d) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + lwdata = .true. + if (present(whead)) lwhead = whead + if (present(wdata)) lwdata = wdata + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (lwhead) then + !rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + lnx = size(idata) + rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,dimid,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,idata) + endif + + ! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata + + end subroutine lilac_io_write_int1d + + !=============================================================================== + subroutine lilac_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + + !--------------- + ! Write scalar double to netcdf file + !--------------- + + ! input/output arguments + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + real(r8) ,intent(in) :: rdata ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + integer ,intent(out):: rc + + ! local variables + integer :: rcode + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(lilac_io_write_r8) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + if (lwhead) then + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) + if (rcode==PIO_NOERR) then + !rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + end if + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + endif + + end subroutine lilac_io_write_r8 + + !=============================================================================== + subroutine lilac_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + + !--------------- + ! Write 1d double array to netcdf file + !--------------- + + ! !INPUT/OUTPUT PARAMETERS: + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam + real(r8) ,intent(in) :: rdata(:) ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + integer ,intent(out):: rc + + ! local variables + integer :: rcode + integer :: dimid(1) + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + integer :: lnx + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(lilac_io_write_r81d) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + if (lwhead) then + lnx = size(rdata) + rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,dimid,varid) + !rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + endif + + end subroutine lilac_io_write_r81d + + !=============================================================================== + subroutine lilac_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind, rc) + + !--------------- + ! Write char string to netcdf file + !--------------- + + ! input/output arguments + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + character(len=*),intent(in) :: rdata ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + integer ,intent(out):: rc + + ! local variables + integer :: rcode + integer :: dimid(1) + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + integer :: lnx + logical :: lwhead, lwdata + integer :: lfile_ind + character(CL) :: charvar ! buffer for string read/write + character(*),parameter :: subName = '(lilac_io_write_char) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + if (lwhead) then + lnx = len(charvar) + rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_CHAR,dimid,varid) + !rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + endif + if (lwdata) then + charvar = '' + charvar = trim(rdata) + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,charvar) + endif + + end subroutine lilac_io_write_char + + !=============================================================================== + subroutine lilac_io_write_time(filename, iam, time_units, calendar, time_val, nt,& + whead, wdata, tbnds, file_ind, rc) + + !--------------- + ! Write time variable to netcdf file + !--------------- + + ! input/output variables + character(len=*) , intent(in) :: filename ! file + integer , intent(in) :: iam ! local pet + character(len=*) , intent(in) :: time_units ! units of time + type(ESMF_Calendar) , intent(in) :: calendar ! calendar + real(r8) , intent(in) :: time_val ! data to be written + integer , optional, intent(in) :: nt + logical , optional, intent(in) :: whead ! write header + logical , optional, intent(in) :: wdata ! write data + real(r8) , optional, intent(in) :: tbnds(2) ! time bounds + integer , optional, intent(in) :: file_ind + integer , intent(out):: rc + + ! local variables + integer :: rcode + integer :: dimid(1) + integer :: dimid2(2) + type(var_desc_t) :: varid + logical :: lwhead, lwdata + integer :: start(4),count(4) + real(r8) :: time_val_1d(1) + integer :: lfile_ind + character(CL) :: calname ! calendar name + character(*),parameter :: subName = '(lilac_io_write_time) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + ! Write out header + if (lwhead) then + rcode = pio_def_dim(io_file(lfile_ind),'time',PIO_UNLIMITED,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),'time',PIO_DOUBLE,dimid,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,'units',trim(time_units)) + + if (calendar == ESMF_CALKIND_360DAY) then + calname = '360_day' + else if (calendar == ESMF_CALKIND_GREGORIAN) then + calname = 'gregorian' + else if (calendar == ESMF_CALKIND_JULIAN) then + calname = 'julian' + else if (calendar == ESMF_CALKIND_JULIANDAY) then + calname = 'ESMF_CALKIND_JULIANDAY' + else if (calendar == ESMF_CALKIND_MODJULIANDAY) then + calname = 'ESMF_CALKIND_MODJULIANDAY' + else if (calendar == ESMF_CALKIND_NOCALENDAR) then + calname = 'none' + else if (calendar == ESMF_CALKIND_NOLEAP) then + calname = 'noleap' + end if + rcode = pio_put_att(io_file(lfile_ind),varid,'calendar',trim(calname)) + + if (present(tbnds)) then + dimid2(2) = dimid(1) + rcode = pio_put_att(io_file(lfile_ind),varid,'bounds','time_bnds') + rcode = pio_def_dim(io_file(lfile_ind),'ntb',2,dimid2(1)) + rcode = pio_def_var(io_file(lfile_ind),'time_bnds',PIO_DOUBLE,dimid2,varid) + endif + if (lwdata) call lilac_io_enddef(filename, file_ind=lfile_ind) + endif + + ! Write out data + if (lwdata) then + start = 1 + count = 1 + if (present(nt)) then + start(1) = nt + endif + time_val_1d(1) = time_val + rcode = pio_inq_varid(io_file(lfile_ind),'time',varid) + rcode = pio_put_var(io_file(lfile_ind),varid,start,count,time_val_1d) + if (present(tbnds)) then + rcode = pio_inq_varid(io_file(lfile_ind),'time_bnds',varid) + start = 1 + count = 1 + if (present(nt)) then + start(2) = nt + endif + count(1) = 2 + rcode = pio_put_var(io_file(lfile_ind),varid,start,count,tbnds) + endif + endif + + end subroutine lilac_io_write_time + + !=============================================================================== + subroutine lilac_io_read_FB(filename, vm, iam, FB, pre, frame, rc) + + !--------------- + ! Read FB from netcdf file + !--------------- + + + ! 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) :: 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 = '(lilac_io_read_FB) ' + !------------------------------------------------------------------------------- + rc = ESMF_Success + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + lpre = ' ' + if (present(pre)) then + lpre = trim(pre) + endif + if (present(frame)) then + lframe = frame + else + lframe = 1 + endif + if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + return + endif + + call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(tmpstr,*) subname//' field count = '//trim(lpre),nf + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nf < 1) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + return + endif + + if (lilac_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) + if (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 = ESMF_FAILURE + return + endif + + call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) + + do k = 1,nf + ! Get name of field + call FB_getNameN(FB, k, itemc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! 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 (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (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 lilac_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + call ESMF_LogWrite(trim(subname)//' reading field '//trim(itemc), ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! 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 FB_getFldPtr(FB, itemc, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) + if (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 (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (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 (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 + 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 + 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 (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 + do n = 1,size(fldptr1) + if (fldptr1(n) == lfillvalue) fldptr1(n) = 0.0_r8 + enddo + else + fldptr1 = 0.0_r8 + endif + end if + + enddo ! end of loop over fields + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + + call pio_freedecomp(pioid, iodesc) + call pio_closefile(pioid) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_io_read_FB + + !=============================================================================== + subroutine lilac_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) + + + ! 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 = '(lilac_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 FB_getFieldN(FB, 1, field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field, mesh=mesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) + if (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 (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 (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 lilac_io_read_init_iodesc + + !=============================================================================== + subroutine lilac_io_read_int(filename, vm, iam, idata, dname, rc) + + !--------------- + ! Read scalar integer from netcdf file + !--------------- + + ! input/output arguments + character(len=*) , intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam + integer , intent(inout) :: idata ! integer data + character(len=*) , intent(in) :: dname ! name of data + integer , intent(out) :: rc + + ! local variables + integer :: i1d(1) + character(*),parameter :: subName = '(lilac_io_read_int) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call lilac_io_read_int1d(filename, vm, iam, i1d, dname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + idata = i1d(1) + + end subroutine lilac_io_read_int + + !=============================================================================== + subroutine lilac_io_read_int1d(filename, vm, iam, idata, dname, rc) + + !--------------- + ! Read 1d integer array from netcdf file + !--------------- + + ! input/output arguments + character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer, intent(in) :: iam + integer , intent(inout) :: idata(:) ! integer data + character(len=*), intent(in) :: dname ! name of data + integer , intent(out) :: rc + + ! local variables + integer :: rcode + type(file_desc_t) :: pioid + type(var_desc_t) :: varid + character(CL) :: lversion + character(CL) :: name1 + character(*),parameter :: subName = '(lilac_io_read_int1d) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lversion=trim(version) + + if (lilac_io_file_exists(vm, iam, filename)) then + rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) + call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) + rcode = pio_get_att(pioid,pio_global,"file_version",lversion) + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + else + if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) + call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + + if (trim(lversion) == trim(version)) then + name1 = trim(dname) + else + name1 = trim(prefix)//trim(dname) + endif + rcode = pio_inq_varid(pioid,trim(name1),varid) + rcode = pio_get_var(pioid,varid,idata) + + call pio_closefile(pioid) + end subroutine lilac_io_read_int1d + + !=============================================================================== + subroutine lilac_io_read_r8(filename, vm, iam, rdata, dname, rc) + + !--------------- + ! Read scalar double from netcdf file + !--------------- + + ! input/output arguments + character(len=*) , intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam + real(r8) , intent(inout) :: rdata ! real data + character(len=*) , intent(in) :: dname ! name of data + integer , intent(out) :: rc + + ! local variables + real(r8) :: r1d(1) + character(*),parameter :: subName = '(lilac_io_read_r8) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call lilac_io_read_r81d(filename, vm, iam, r1d,dname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + rdata = r1d(1) + + end subroutine lilac_io_read_r8 + + !=============================================================================== + subroutine lilac_io_read_r81d(filename, vm, iam, rdata, dname, rc) + + !--------------- + ! Read 1d double array from netcdf file + !--------------- + + + ! input/output arguments + character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam + real(r8) , intent(inout) :: rdata(:) ! real data + character(len=*), intent(in) :: dname ! name of data + integer , intent(out) :: rc + + ! local variables + integer :: rcode + type(file_desc_T) :: pioid + type(var_desc_t) :: varid + character(CL) :: lversion + character(CL) :: name1 + character(*),parameter :: subName = '(lilac_io_read_r81d) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lversion=trim(version) + + if (lilac_io_file_exists(vm, iam, filename)) then + rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) + call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) + rcode = pio_get_att(pioid,pio_global,"file_version",lversion) + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + else + if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) + call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + + if (trim(lversion) == trim(version)) then + name1 = trim(dname) + else + name1 = trim(prefix)//trim(dname) + endif + rcode = pio_inq_varid(pioid,trim(name1),varid) + rcode = pio_get_var(pioid,varid,rdata) + + call pio_closefile(pioid) + end subroutine lilac_io_read_r81d + + !=============================================================================== + subroutine lilac_io_read_char(filename, vm, iam, rdata, dname, rc) + + !--------------- + ! Read char string from netcdf file + !--------------- + + ! input/output arguments + character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer, intent(in) :: iam + character(len=*), intent(inout) :: rdata ! character data + character(len=*), intent(in) :: dname ! name of data + integer , intent(out) :: rc + + ! local variables + integer :: rcode + type(file_desc_T) :: pioid + type(var_desc_t) :: varid + character(CL) :: lversion + character(CL) :: name1 + character(CL) :: charvar ! buffer for string read/write + character(*),parameter :: subName = '(lilac_io_read_char) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lversion=trim(version) + + if (lilac_io_file_exists(vm, iam, filename)) then + rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) + ! write(logunit,*) subname,' open file ',trim(filename) + call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) + rcode = pio_get_att(pioid,pio_global,"file_version",lversion) + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + else + if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) + call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + + if (trim(lversion) == trim(version)) then + name1 = trim(dname) + else + name1 = trim(prefix)//trim(dname) + endif + rcode = pio_inq_varid(pioid,trim(name1),varid) + rcode = pio_get_var(pioid,varid,charvar) + rdata = trim(charvar) + + call pio_closefile(pioid) + end subroutine lilac_io_read_char + + !=============================================================================== + subroutine lilac_io_date2ymd_int (date,year,month,day) + ! Converts coded-date (yyyymmdd) to year/month/day. + ! input/output variables + integer,intent(in) :: date ! coded-date (yyyymmdd) + integer,intent(out) :: year,month,day ! calendar year,month,day + ! local variables + integer :: tdate ! temporary date + !------------------------------------------------------------------------------- + + tdate = abs(date) + year =int(tdate/10000) + if (date < 0) year = -year + month = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + end subroutine lilac_io_date2ymd_int + + subroutine lilac_io_date2ymd_long (date,year,month,day) + ! Converts coded-date (yyyymmdd) to year/month/day. + ! input/output variables + integer(I8),intent(in) :: date ! coded-date ([yy]yyyymmdd) + integer ,intent(out) :: year,month,day ! calendar year,month,day + ! local variables + integer(I8) :: tdate ! temporary date + character(*),parameter :: subName = "(lilac_io_date2ymd_long)" + !------------------------------------------------------------------------------- + + tdate = abs(date) + year =int(tdate/10000) + if (date < 0) year = -year + month = int( mod(tdate,10000_I8)/ 100) + day = mod(tdate, 100_I8) + end subroutine lilac_io_date2ymd_long + + !=============================================================================== + subroutine lilac_io_datetod2string_int(date_str, ymd, tod) + ! Converts coded date (yyyymmdd) and optional time of day to a string like + ! 'yyyy-mm-dd-ttttt' (if tod is present) or 'yyyy-mm-dd' (if tod is absent). + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + + ! input/output variables + character(len=*) , intent(out) :: date_str + integer , intent(in) :: ymd + integer, optional, intent(in) :: tod + + ! local variables + integer :: yy, mm, dd + character(len=6) :: year_str + character(len=3) :: month_str + character(len=3) :: day_str + character(len=6) :: time_str + !--------------------------------------- + + call lilac_io_date2ymd(ymd, yy, mm, dd) + + ! Convert year, month, day and time of day to a string like 'yyyy-mm-dd-ttttt'. + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + write(year_str,'(i6.4)') yy + year_str = adjustl(year_str) + write(month_str,'(a,i2.2)') '-',mm + write(day_str ,'(a,i2.2)') '-',dd + if (present(tod)) then + write(time_str,'(a,i5.5)') '-',tod + else + time_str = ' ' + end if + date_str = trim(year_str) // trim(month_str) // trim(day_str) // trim(time_str) + + end subroutine lilac_io_datetod2string_int + + subroutine lilac_io_datetod2string_long(date_str, ymd, tod) + ! Converts coded date (yyyymmdd) and optional time of day to a string like + ! 'yyyy-mm-dd-ttttt' (if tod is present) or 'yyyy-mm-dd' (if tod is absent). + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + + ! input/output variables + character(len=*) , intent(out) :: date_str + integer(i8) , intent(in) :: ymd + integer, optional, intent(in) :: tod + + ! local variables + integer :: yy, mm, dd + character(len=6) :: year_str + character(len=3) :: month_str + character(len=3) :: day_str + character(len=6) :: time_str + !--------------------------------------- + + call lilac_io_date2ymd(ymd, yy, mm, dd) + + ! Convert year, month, day and time of day to a string like 'yyyy-mm-dd-ttttt'. + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + write(year_str,'(i6.4)') yy + year_str = adjustl(year_str) + write(month_str,'(a,i2.2)') '-',mm + write(day_str ,'(a,i2.2)') '-',dd + if (present(tod)) then + write(time_str,'(a,i5.5)') '-',tod + else + time_str = ' ' + end if + date_str = trim(year_str) // trim(month_str) // trim(day_str) // trim(time_str) + + end subroutine lilac_io_datetod2string_long + + !=============================================================================== + subroutine lilac_io_ymd2date_int(year,month,day,date) + ! Converts year, month, day to coded-date + + ! input/output variables + integer,intent(in ) :: year,month,day ! calendar year,month,day + integer,intent(out) :: date ! coded (yyyymmdd) calendar date + !--------------------------------------- + + ! NOTE: this calendar has a year zero (but no day or month zero) + date = abs(year)*10000 + month*100 + day ! coded calendar date + if (year < 0) date = -date + end subroutine lilac_io_ymd2date_int + + subroutine lilac_io_ymd2date_long(year,month,day,date) + ! Converts year, month, day to coded-date + + ! input/output variables + integer ,intent(in ) :: year,month,day ! calendar year,month,day + integer(I8),intent(out) :: date ! coded ([yy]yyyymmdd) calendar date + !--------------------------------------- + + ! NOTE: this calendar has a year zero (but no day or month zero) + date = abs(year)*10000_I8 + month*100 + day ! coded calendar date + if (year < 0) date = -date + end subroutine lilac_io_ymd2date_long + +end module lilac_io diff --git a/lilac/lilac/lilac_methods.F90 b/lilac/lilac/lilac_methods.F90 new file mode 100644 index 0000000000..7052a6a355 --- /dev/null +++ b/lilac/lilac/lilac_methods.F90 @@ -0,0 +1,1709 @@ +module lilac_methods + + !----------------------------------------------------------------------------- + ! Generic operation methods used by the Mediator Component. + !----------------------------------------------------------------------------- + + use ESMF + use mpi , only : MPI_ERROR_STRING, MPI_MAX_ERROR_STRING, MPI_SUCCESS + use shr_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag + use lilac_constants , only : czero => lilac_constants_czero + use lilac_constants , only : spval_init => lilac_constants_spval_init + + implicit none + private + + interface lilac_methods_FB_accum ; module procedure & + lilac_methods_FB_accumFB2FB + end interface + + interface lilac_methods_FB_copy ; module procedure & + lilac_methods_FB_copyFB2FB + end interface + + interface lilac_methods_FieldPtr_compare ; module procedure & + lilac_methods_FieldPtr_compare1, & + lilac_methods_FieldPtr_compare2 + end interface + + ! used/reused in module + + logical :: isPresent + character(len=1024) :: msgString + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_FieldStatus_Flag) :: status + character(*) , parameter :: u_FILE_u = & + __FILE__ + + public lilac_methods_FB_copy + public lilac_methods_FB_accum + public lilac_methods_FB_average + public lilac_methods_FB_reset + public lilac_methods_FB_clean + public lilac_methods_FB_diagnose + public lilac_methods_FB_FldChk + public lilac_methods_FB_GetFldPtr + public lilac_methods_FB_getNameN + public lilac_methods_FB_getFieldN + public lilac_methods_FB_getFieldByName + public lilac_methods_FB_getNumflds + public lilac_methods_FB_Field_diagnose + public lilac_methods_State_diagnose + public lilac_methods_State_GetFldPtr + public lilac_methods_State_SetScalar + public lilac_methods_State_GetScalar + public lilac_methods_Clock_TimePrint + public lilac_methods_FieldPtr_compare + public chkerr + + private lilac_methods_Mesh_Print + private lilac_methods_Mesh_Write + private lilac_methods_Field_GetFldPtr + private lilac_methods_FB_SetFldPtr + private lilac_methods_FB_copyFB2FB + private lilac_methods_FB_accumFB2FB + private lilac_methods_State_getNameN + private lilac_methods_State_SetFldPtr + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_getNameN(FB, fieldnum, fieldname, rc) + + ! ---------------------------------------------- + ! Get name of field number fieldnum in input field bundle FB + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(in) :: FB + integer , intent(in) :: fieldnum + character(len=*) , intent(out) :: fieldname + integer , intent(out) :: rc + + ! local variables + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + character(len=*),parameter :: subname='(lilac_methods_FB_getNameN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + fieldname = ' ' + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldnum > fieldCount) then + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + fieldname = lfieldnamelist(fieldnum) + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_getNameN + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_getFieldN(FB, fieldnum, field, rc) + + ! ---------------------------------------------- + ! Get field with number fieldnum in input field bundle FB + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(in) :: FB + integer , intent(in) :: fieldnum + type(ESMF_Field) , intent(inout) :: field + integer , intent(out) :: rc + + ! local variables + character(len=ESMF_MAXSTR) :: name + character(len=*),parameter :: subname='(lilac_methods_FB_getFieldN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call lilac_methods_FB_getNameN(FB, fieldnum, name, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(FB, fieldName=name, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_getFieldN + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_getFieldByName(FB, fieldname, field, rc) + + ! ---------------------------------------------- + ! Get field associated with fieldname out of FB + ! ---------------------------------------------- + + ! 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 + character(len=*),parameter :: subname='(lilac_methods_FB_getFieldByName)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_getFieldByName + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_State_getNameN(State, fieldnum, fieldname, rc) + + ! ---------------------------------------------- + ! Get field number fieldnum name out of State + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: State + integer , intent(in) :: fieldnum + character(len=*), intent(out) :: fieldname + integer , intent(out) :: rc + + ! local variables + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + character(len=*),parameter :: subname='(lilac_methods_State_getNameN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + fieldname = ' ' + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldnum > fieldCount) then + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + allocate(lfieldnamelist(fieldCount)) + call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + fieldname = lfieldnamelist(fieldnum) + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_State_getNameN + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_clean(FB, rc) + + ! ---------------------------------------------- + ! Destroy fields in FB and FB + ! ---------------------------------------------- + + type(ESMF_FieldBundle), intent(inout) :: FB + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + type(ESMF_Field) :: field + character(len=*),parameter :: subname='(lilac_methods_FB_clean)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call ESMF_FieldBundleGet(FB, fieldName=lfieldnamelist(n), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(field, rc=rc, noGarbage=.true.) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + + call ESMF_FieldBundleDestroy(FB, rc=rc, noGarbage=.true.) + if (chkerr(rc,__LINE__,u_FILE_u)) return + deallocate(lfieldnamelist) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine lilac_methods_FB_clean + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_reset(FB, value, rc) + ! ---------------------------------------------- + ! Set all fields to value in FB + ! If value is not provided, reset to 0.0 + ! ---------------------------------------------- + + ! intput/output variables + type(ESMF_FieldBundle), intent(inout) :: FB + real(R8) , intent(in), optional :: value + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(R8) :: lvalue + character(len=*),parameter :: subname='(lilac_methods_FB_reset)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lvalue = czero + if (present(value)) then + lvalue = value + endif + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call lilac_methods_FB_SetFldPtr(FB, lfieldnamelist(n), lvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_reset + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_average(FB, count, rc) + + ! ---------------------------------------------- + ! Set all fields to zero in FB + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(inout) :: FB + integer , intent(in) :: count + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(R8), pointer :: dataPtr1(:) + real(R8), pointer :: dataPtr2(:,:) + character(len=*),parameter :: subname='(lilac_methods_FB_average)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + 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) + end if + !call ESMF_LogWrite(trim(subname)//": WARNING count is 0 set avg to spval", ESMF_LOGMSG_INFO) + !call lilac_methods_FB_reset(FB, value=spval, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + + else + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1, fieldCount + call lilac_methods_FB_GetFldPtr(FB, lfieldnamelist(n), dataPtr1, dataPtr2, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + do i=lbound(dataptr1,1),ubound(dataptr1,1) + dataptr1(i) = dataptr1(i) / real(count, R8) + enddo + elseif (lrank == 2) then + do j=lbound(dataptr2,2),ubound(dataptr2,2) + do i=lbound(dataptr2,1),ubound(dataptr2,1) + dataptr2(i,j) = dataptr2(i,j) / real(count, R8) + enddo + enddo + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + enddo + deallocate(lfieldnamelist) + + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_average + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_diagnose(FB, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of FB + ! ---------------------------------------------- + + type(ESMF_FieldBundle) , intent(inout) :: FB + character(len=*) , intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) + character(len=CL) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + character(len=*), parameter :: subname='(lilac_methods_FB_diagnose)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string) // ' ' + endif + + ! Determine number of fields in field bundle and allocate memory for lfieldnamelist + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + ! Get the fields in the field bundle + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! For each field in the bundle, get its memory location and print out the field + do n = 1, fieldCount + call lilac_methods_FB_GetFldPtr(FB, lfieldnamelist(n), & + fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), " no data" + endif + + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " 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) + enddo + + ! Deallocate memory + deallocate(lfieldnamelist) + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine lilac_methods_FB_diagnose + + !----------------------------------------------------------------------------- + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_State_diagnose(State, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: State + character(len=*), intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + character(len=CS) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(lilac_methods_State_diagnose)' + ! ---------------------------------------------- + + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + endif + + lstring = '' + if (present(string)) then + lstring = trim(string) + endif + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + + call lilac_methods_State_GetFldPtr(State, lfieldnamelist(n), & + fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " no data" + endif + + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " 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) + + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_State_diagnose + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_Field_diagnose(FB, fieldname, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(inout) :: FB + 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='(lilac_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 lilac_methods_FB_GetFldPtr(FB, fieldname, dataPtr1d, dataPtr2d, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + 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 + 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 lilac_methods_FB_Field_diagnose + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_copyFB2FB(FBout, FBin, rc) + + ! ---------------------------------------------- + ! Copy common field names from FBin to FBout + ! ---------------------------------------------- + + type(ESMF_FieldBundle), intent(inout) :: FBout + type(ESMF_FieldBundle), intent(in) :: FBin + integer , intent(out) :: rc + character(len=*), parameter :: subname='(lilac_methods_FB_copyFB2FB)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + call lilac_methods_FB_accum(FBout, FBin, copy=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_copyFB2FB + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_accumFB2FB(FBout, FBin, copy, rc) + + ! ---------------------------------------------- + ! Accumulate common field names from FBin to FBout + ! If copy is passed in and true, the this is a copy + ! ---------------------------------------------- + + type(ESMF_FieldBundle), intent(inout) :: FBout + type(ESMF_FieldBundle), intent(in) :: FBin + logical, optional , intent(in) :: copy + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lranki, lranko + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + logical :: exists + logical :: lcopy + real(R8), pointer :: dataPtri1(:) , dataPtro1(:) + real(R8), pointer :: dataPtri2(:,:), dataPtro2(:,:) + character(len=*), parameter :: subname='(lilac_methods_FB_accumFB2FB)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lcopy = .false. ! accumulate by default + if (present(copy)) then + lcopy = copy + endif + + call ESMF_FieldBundleGet(FBout, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FBout, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call ESMF_FieldBundleGet(FBin, fieldName=lfieldnamelist(n), isPresent=exists, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (exists) then + call lilac_methods_FB_GetFldPtr(FBin, lfieldnamelist(n), dataPtri1, dataPtri2, lranki, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call lilac_methods_FB_GetFldPtr(FBout, lfieldnamelist(n), dataPtro1, dataPtro2, lranko, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lranki == 1 .and. lranko == 1) then + + if (.not.lilac_methods_FieldPtr_Compare(dataPtro1, dataPtri1, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do i=lbound(dataPtri1,1),ubound(dataPtri1,1) + dataPtro1(i) = dataPtri1(i) + enddo + else + do i=lbound(dataPtri1,1),ubound(dataPtri1,1) + dataPtro1(i) = dataPtro1(i) + dataPtri1(i) + enddo + endif + + elseif (lranki == 2 .and. lranko == 2) then + + if (.not.lilac_methods_FieldPtr_Compare(dataPtro2, dataPtri2, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do j=lbound(dataPtri2,2),ubound(dataPtri2,2) + do i=lbound(dataPtri2,1),ubound(dataPtri2,1) + dataPtro2(i,j) = dataPtri2(i,j) + enddo + enddo + else + do j=lbound(dataPtri2,2),ubound(dataPtri2,2) + do i=lbound(dataPtri2,1),ubound(dataPtri2,1) + dataPtro2(i,j) = dataPtro2(i,j) + dataPtri2(i,j) + enddo + enddo + endif + + else + + write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & + ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + + endif + + endif + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_accumFB2FB + + !----------------------------------------------------------------------------- + + logical function lilac_methods_FB_FldChk(FB, fldname, rc) + + ! ---------------------------------------------- + ! Determine if field with fldname is in input field bundle + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(lilac_methods_FB_FldChk)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + ! If field bundle is not created then set return to .false. + if (.not. ESMF_FieldBundleIsCreated(FB)) then + lilac_methods_FB_FldChk = .false. + return + end if + + ! If field bundle is created determine if fldname is present in field bundle + lilac_methods_FB_FldChk = .false. + + call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) then + call ESMF_LogWrite(trim(subname)//" Error checking field: "//trim(fldname), & + ESMF_LOGMSG_ERROR) + return + endif + if (isPresent) then + lilac_methods_FB_FldChk = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end function lilac_methods_FB_FldChk + + !----------------------------------------------------------------------------- + + subroutine lilac_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 + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_Field) , intent(in) :: field + real(R8), pointer , intent(inout), optional :: fldptr1(:) + real(R8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out) , optional :: rank + logical , intent(in) , optional :: abort + integer , intent(out) , optional :: rc + + ! local variables + type(ESMF_Mesh) :: lmesh + integer :: lrank, nnodes, nelements + logical :: labort + character(len=*), parameter :: subname='(lilac_methods_Field_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + 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 = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + labort = .true. + if (present(abort)) then + labort = abort + endif + lrank = -99 + + call ESMF_FieldGet(field, status=status, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + lrank = 0 + if (labort) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + endif + else + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nnodes == 0 .and. nelements == 0) lrank = 0 + + else + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif ! geomtype + + if (lrank == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & + 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 = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) + if (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 = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) + if (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 = ESMF_FAILURE + return + endif + + endif ! status + + if (present(rank)) then + rank = lrank + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_Field_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, rc) + + ! ---------------------------------------------- + ! 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(:) + real(R8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out), optional :: rank + integer , intent(out), optional :: rc + type(ESMF_Field) , intent(out), optional :: field + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + character(len=*), parameter :: subname='(lilac_methods_FB_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + 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 = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + if (.not. lilac_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 = ESMF_FAILURE + return + endif + + call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call lilac_methods_Field_GetFldPtr(lfield, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (present(rank)) then + rank = lrank + endif + if (present(field)) then + field = lfield + endif + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_FB_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_SetFldPtr(FB, fldname, val, rc) + + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*) , intent(in) :: fldname + real(R8) , intent(in) :: val + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) + character(len=*), parameter :: subname='(lilac_methods_FB_SetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call lilac_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + fldptr1 = val + elseif (lrank == 2) then + fldptr2 = val + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & + 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) + endif + + end subroutine lilac_methods_FB_SetFldPtr + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, rank, rc) + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(R8), pointer, intent(inout), optional :: fldptr1(:) + real(R8), pointer, intent(inout), optional :: fldptr2(:,:) + integer , intent(out), optional :: rank + integer , intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + character(len=*), parameter :: subname='(lilac_methods_State_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + 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 = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call lilac_methods_Field_GetFldPtr(lfield, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (present(rank)) then + rank = lrank + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_State_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_State_SetFldPtr(ST, fldname, val, rc) + + type(ESMF_State) , intent(in) :: ST + character(len=*) , intent(in) :: fldname + real(R8), intent(in) :: val + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) + character(len=*), parameter :: subname='(lilac_methods_State_SetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call lilac_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + fldptr1 = val + elseif (lrank == 2) then + fldptr2 = val + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & + 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) + endif + + end subroutine lilac_methods_State_SetFldPtr + + !----------------------------------------------------------------------------- + + logical function lilac_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, rc) + + real(R8), pointer, intent(in) :: fldptr1(:) + real(R8), pointer, intent(in) :: fldptr2(:) + character(len=*) , intent(in) :: cstring + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(lilac_methods_FieldPtr_Compare1)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lilac_methods_FieldPtr_Compare1 = .false. + if (lbound(fldptr2,1) /= lbound(fldptr1,1) .or. & + ubound(fldptr2,1) /= ubound(fldptr1,1)) then + call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) + 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) + else + lilac_methods_FieldPtr_Compare1 = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end function lilac_methods_FieldPtr_Compare1 + + !----------------------------------------------------------------------------- + + logical function lilac_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, rc) + + real(R8), pointer, intent(in) :: fldptr1(:,:) + real(R8), pointer, intent(in) :: fldptr2(:,:) + character(len=*) , intent(in) :: cstring + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(lilac_methods_FieldPtr_Compare2)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lilac_methods_FieldPtr_Compare2 = .false. + if (lbound(fldptr2,2) /= lbound(fldptr1,2) .or. & + lbound(fldptr2,1) /= lbound(fldptr1,1) .or. & + ubound(fldptr2,2) /= ubound(fldptr1,2) .or. & + ubound(fldptr2,1) /= ubound(fldptr1,1)) then + call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) + 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) + else + lilac_methods_FieldPtr_Compare2 = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end function lilac_methods_FieldPtr_Compare2 + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_Mesh_Print(mesh, string, rc) + + type(ESMF_Mesh) , intent(in) :: mesh + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Distgrid) :: distgrid + type(ESMF_DELayout) :: delayout + integer :: pdim, sdim, nnodes, nelements + integer :: localDeCount + integer :: DeCount + integer :: dimCount, tileCount + integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) + type(ESMF_MeshStatus_Flag) :: meshStatus + logical :: elemDGPresent, nodeDGPresent + character(len=*),parameter :: subname='(lilac_methods_Mesh_Print)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_MeshGet(mesh, elementDistGridIsPresent=elemDGPresent, & + nodalDistgridIsPresent=nodeDGPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, status=meshStatus, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! first get the distgrid, which should be available + if (elemDGPresent) then + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": distGrid=element" + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, deLayout=deLayout, dimCount=dimCount, & + tileCount=tileCount, deCount=deCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DELayoutGet(deLayout, localDeCount=localDeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount + allocate(minIndexPTile(dimCount, tileCount), & + maxIndexPTile(dimCount, tileCount)) + + ! get minIndex and maxIndex arrays + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) + + endif + + if (nodeDGPresent) then + call ESMF_MeshGet(mesh, nodalDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": distGrid=nodal" + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, deLayout=deLayout, dimCount=dimCount, & + tileCount=tileCount, deCount=deCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DELayoutGet(deLayout, localDeCount=localDeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount + allocate(minIndexPTile(dimCount, tileCount), & + maxIndexPTile(dimCount, tileCount)) + + ! get minIndex and maxIndex arrays + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) + + endif + + if (.not. elemDGPresent .and. .not. nodeDGPresent) then + call ESMF_LogWrite(trim(subname)//": cannot print distgrid from mesh", & + ESMF_LOGMSG_WARNING, rc=rc) + return + endif + + ! if mesh is complete, also get additional parameters + if (meshStatus==ESMF_MESHSTATUS_COMPLETE) then + ! access localDeCount to show this is a real Grid + call ESMF_MeshGet(mesh, parametricDim=pdim, spatialDim=sdim, & + numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": parametricDim=", pdim + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": spatialDim=", sdim + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": numOwnedNodes=", nnodes + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": numOwnedElements=", nelements + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine lilac_methods_Mesh_Print + + +!----------------------------------------------------------------------------- + subroutine lilac_methods_Clock_TimePrint(clock,string,rc) + + ! input/output variables + type(ESMF_Clock) , intent(in) :: clock + character(len=*) , intent(in),optional :: string + integer , intent(out) :: rc + + ! local variables + type(ESMF_Time) :: time + type(ESMF_TimeInterval) :: timeStep + character(len=CS) :: timestr + character(len=CL) :: lstring + character(len=*), parameter :: subname='(lilac_methods_Clock_TimePrint)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + + if (present(string)) then + lstring = trim(subname)//":"//trim(string) + else + lstring = trim(subname) + endif + + call ESMF_ClockGet(clock,currtime=time,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": currtime = "//trim(timestr), ESMF_LOGMSG_INFO) + + call ESMF_ClockGet(clock,starttime=time,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": startime = "//trim(timestr), ESMF_LOGMSG_INFO) + + call ESMF_ClockGet(clock,stoptime=time,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": stoptime = "//trim(timestr), ESMF_LOGMSG_INFO) + + call ESMF_ClockGet(clock,timestep=timestep,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(timestep,timestring=timestr,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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) + endif + + end subroutine lilac_methods_Clock_TimePrint + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_Mesh_Write(mesh, string, rc) + + type(ESMF_Mesh) ,intent(in) :: mesh + character(len=*),intent(in) :: string + integer ,intent(out) :: rc + + ! local + integer :: n,l,i,lsize,ndims + character(len=CS) :: name + type(ESMF_DISTGRID) :: distgrid + type(ESMF_Array) :: array + real(R8), pointer :: rawdata(:) + real(R8), pointer :: coord(:) + character(len=*),parameter :: subname='(lilac_methods_Mesh_Write)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + +#if (1 == 0) + !--- elements --- + + call ESMF_MeshGet(mesh, spatialDim=ndims, numownedElements=lsize, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(rawdata(ndims*lsize)) + allocate(coord(lsize)) + + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, ownedElemCoords=rawdata, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1,ndims + name = "unknown" + if (n == 1) name = "lon_element" + if (n == 2) name = "lat_element" + do l = 1,lsize + i = 2*(l-1) + n + coord(l) = rawdata(i) + array = ESMF_ArrayCreate(distgrid, farrayPtr=coord, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call lilac_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + enddo + + deallocate(rawdata,coord) + + !--- nodes --- + + call ESMF_MeshGet(mesh, spatialDim=ndims, numownedNodes=lsize, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(rawdata(ndims*lsize)) + allocate(coord(lsize)) + + call ESMF_MeshGet(mesh, nodalDistgrid=distgrid, ownedNodeCoords=rawdata, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1,ndims + name = "unknown" + if (n == 1) name = "lon_nodes" + if (n == 2) name = "lat_nodes" + do l = 1,lsize + i = 2*(l-1) + n + coord(l) = rawdata(i) + array = ESMF_ArrayCreate(distgrid, farrayPtr=coord, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call lilac_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + enddo + + deallocate(rawdata,coord) +#else + 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) + endif + + end subroutine lilac_methods_Mesh_Write + + !----------------------------------------------------------------------------- + +!================================================================================ + + subroutine lilac_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 + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State), intent(in) :: state + integer, intent(in) :: scalar_id + real(R8), intent(out) :: scalar_value + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask, ierr, len, icount + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + real(R8), pointer :: farrayptr(:,:) + real(r8) :: tmp(1) + character(len=*), parameter :: subname='(lilac_methods_State_GetScalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! check item exist or not? + call ESMF_StateGet(State, itemSearch=trim(flds_scalar_name), itemCount=icount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (icount > 0) then + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (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 = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + tmp(:) = farrayptr(scalar_id,:) + endif + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + scalar_value = tmp(1) + else + call ESMF_LogWrite(trim(subname)//": no ESMF_Field found named: "//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + end if + + end subroutine lilac_methods_State_GetScalar + +!================================================================================ + + subroutine lilac_methods_State_SetScalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + + ! ---------------------------------------------- + ! Set scalar data from State for a particular name + ! ---------------------------------------------- + + ! 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 + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask + type(ESMF_Field) :: field + type(ESMF_VM) :: vm + real(R8), pointer :: farrayptr(:,:) + character(len=*), parameter :: subname='(lilac_methods_State_SetScalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (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) + rc = ESMF_FAILURE + return + endif + farrayptr(scalar_id,1) = scalar_value + endif + + end subroutine lilac_methods_State_SetScalar + + !----------------------------------------------------------------------------- + + subroutine lilac_methods_FB_getNumFlds(FB, string, nflds, rc) + + ! ---------------------------------------------- + ! Determine if fieldbundle is created and if so, the number of non-scalar + ! fields in the field bundle + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: string + integer , intent(out) :: nflds + integer , intent(inout) :: rc + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (.not. ESMF_FieldBundleIsCreated(FB)) then + 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 + ! field bundles - so this is why we check if the fieldCount is 0 and not 1 here + + call ESMF_FieldBundleGet(FB, fieldCount=nflds, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nflds == 0) then + call ESMF_LogWrite(trim(string)//": only has scalar data, returning", ESMF_LOGMSG_INFO) + end if + end if + + end subroutine lilac_methods_FB_getNumFlds + +!=============================================================================== + + logical function ChkErr(rc, line, file, mpierr) + + integer, intent(in) :: rc + integer, intent(in) :: line + + character(len=*), intent(in) :: file + logical, optional, intent(in) :: mpierr + + character(MPI_MAX_ERROR_STRING) :: lstring + integer :: dbrc, lrc, len, ierr + + ChkErr = .false. + lrc = rc + if (present(mpierr) .and. mpierr) then + if (rc == MPI_SUCCESS) return + call MPI_ERROR_STRING(rc, lstring, len, ierr) + call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file, rc=dbrc) + lrc = ESMF_FAILURE + endif + + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + ChkErr = .true. + endif + + end function ChkErr + +end module lilac_methods + diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index d8725a8dbe..19ee588c75 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -13,22 +13,24 @@ module lilac_mod public :: lilac_init public :: lilac_run + ! Gridded components and states in gridded components + type(ESMF_GridComp) :: atm_gcomp + type(ESMF_GridComp) :: lnd_gcomp + + ! Coupler components + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp + + ! States + type(ESMF_State) :: atm2lnd_l_state, atm2lnd_a_state + type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state + ! Clock, TimeInterval, and Times type(ESMF_Clock) :: lilac_clock type(ESMF_Calendar),target :: lilac_calendar type(ESMF_Alarm) :: lilac_restart_alarm type(ESMF_Alarm) :: lilac_stop_alarm - ! Gridded components and states in gridded components - type(ESMF_GridComp) :: atm_gcomp - type(ESMF_GridComp) :: lnd_gcomp - type(ESMF_State) :: atm2lnd_l_state, atm2lnd_a_state - type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state - - ! Coupler components - type(ESMF_CplComp) :: cpl_atm2lnd_comp - type(ESMF_CplComp) :: cpl_lnd2atm_comp - character(*) , parameter :: modname = "lilac_mod" integer :: mytask @@ -324,6 +326,7 @@ end subroutine lilac_init subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) use shr_sys_mod, only : shr_sys_abort + use lilac_history ! input/output variables logical, intent(in) :: restart_alarm_is_ringing diff --git a/lilac/lilac/lilac_time.F90 b/lilac/lilac/lilac_time.F90 new file mode 100644 index 0000000000..724925565b --- /dev/null +++ b/lilac/lilac/lilac_time.F90 @@ -0,0 +1,541 @@ +module lilac_time + + use ESMF + use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl, r8=>shr_kind_r8 + use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag + use lilac_methods , only : chkerr + + implicit none + private ! default private + + public :: lilac_time_alarmInit ! initialize an alarm + + ! Clock and alarm options + character(len=*), private, parameter :: & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNStep = "nstep" , & + optNSeconds = "nseconds" , & + optNSecond = "nsecond" , & + optNMinutes = "nminutes" , & + optNMinute = "nminute" , & + optNHours = "nhours" , & + optNHour = "nhour" , & + optNDays = "ndays" , & + optNDay = "nday" , & + optNMonths = "nmonths" , & + optNMonth = "nmonth" , & + optNYears = "nyears" , & + optNYear = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optIfdays0 = "ifdays0" , & + optGLCCouplingPeriod = "glc_coupling_period" + + ! Module data + integer, parameter :: SecPerDay = 86400 ! Seconds per day + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine lilac_time_alarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! !DESCRIPTION: Setup an alarm in a clock + ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm + ! time. If you send an arbitrary but proper ringtime from the + ! past and the ring interval, the alarm will always go off on the + ! next clock advance and this will cause serious problems. Even + ! if it makes sense to initialize an alarm with some reference + ! time and the alarm interval, that reference time has to be + ! advance forward to be >= the current time. In the logic below + ! we set an appropriate "NextAlarm" and then we make sure to + ! advance it properly based on the ring interval. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , optional , intent(in) :: opt_tod ! alarm tod (sec) + type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time + character(len=*) , optional , intent(in) :: alarmname ! alarm name + integer , intent(inout) :: rc ! Return code + + ! local variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! time info + character(len=64) :: lalarmname ! local alarm name + logical :: update_nextalarm ! update next alarm + type(ESMF_Time) :: CurrTime ! Current Time + type(ESMF_Time) :: NextAlarm ! Next restart alarm time + type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval + integer :: sec + character(len=*), parameter :: subname = '(lilac_time_alarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lalarmname = 'alarm_unknown' + if (present(alarmname)) lalarmname = trim(alarmname) + ltod = 0 + if (present(opt_tod)) ltod = opt_tod + lymd = -1 + if (present(opt_ymd)) lymd = opt_ymd + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initial guess of next alarm, this will be updated below + if (present(RefTime)) then + NextAlarm = RefTime + else + NextAlarm = CurrTime + endif + + ! Get calendar from clock + call ESMF_ClockGet(clock, calendar=cal) + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNSteps) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNStep) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSecond) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinute) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHour) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDay) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonth) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNYears) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNYear) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case default + call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + + end select + + ! -------------------------------------------------------------------------------- + ! --- AlarmInterval and NextAlarm should be set --- + ! -------------------------------------------------------------------------------- + + ! --- advance Next Alarm so it won't ring on first timestep for + ! --- most options above. go back one alarminterval just to be careful + + if (update_nextalarm) then + NextAlarm = NextAlarm - AlarmInterval + do while (NextAlarm <= CurrTime) + NextAlarm = NextAlarm + AlarmInterval + enddo + endif + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & + ringInterval=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine lilac_time_alarmInit + + !=============================================================================== + + subroutine lilac_time_read_restart(restart_file, & + start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod, rc) + + use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr + use netcdf , only : nf90_inq_varid, nf90_get_var, nf90_close + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO + + ! input/output variables + character(len=*), intent(in) :: restart_file + integer, intent(out) :: ref_ymd ! Reference date (YYYYMMDD) + integer, intent(out) :: ref_tod ! Reference time of day (seconds) + integer, intent(out) :: start_ymd ! Start date (YYYYMMDD) + integer, intent(out) :: start_tod ! Start time of day (seconds) + integer, intent(out) :: curr_ymd ! Current ymd (YYYYMMDD) + integer, intent(out) :: curr_tod ! Current tod (seconds) + integer, intent(out) :: rc + + ! local variables + integer :: status, ncid, varid ! netcdf stuff + character(CL) :: tmpstr ! temporary + character(len=*), parameter :: subname = "(lilac_time_read_restart)" + !---------------------------------------------------------------- + + ! use netcdf here since it's serial + status = nf90_open(restart_file, NF90_NOWRITE, ncid) + if (status /= nf90_NoErr) then + print *,__FILE__,__LINE__,trim(restart_file) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_open', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + status = nf90_inq_varid(ncid, 'start_ymd', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, start_ymd) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_inq_varid(ncid, 'start_tod', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, start_tod) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_inq_varid(ncid, 'ref_ymd', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid ref_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, ref_ymd) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var ref_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_inq_varid(ncid, 'ref_tod', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid ref_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, ref_tod) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var ref_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_inq_varid(ncid, 'curr_ymd', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, curr_ymd) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_inq_varid(ncid, 'curr_tod', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, curr_tod) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_close(ncid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_close', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + write(tmpstr,*) trim(subname)//" read start_ymd = ",start_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read start_tod = ",start_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read ref_ymd = ",ref_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read ref_tod = ",ref_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read curr_ymd = ",curr_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read curr_tod = ",curr_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + end subroutine lilac_time_read_restart + +end module lilac_time + + diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 index 25a05cf73b..d35066ef17 100644 --- a/lilac/lilac/lilac_utils.F90 +++ b/lilac/lilac/lilac_utils.F90 @@ -1,5 +1,7 @@ module lilac_utils + ! NOTE: the following cannot depend on any esmf objects - since it will be used by the host atmosphere + implicit none private From 30638dbf917a3459cb3d3302073282055d046ae3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 30 Nov 2019 11:11:25 -0700 Subject: [PATCH 185/556] changes to get lilac coupler history files working --- lilac/atm_driver/Makefile | 28 ++++---- lilac/lilac/lilac_history.F90 | 23 +++--- lilac/lilac/lilac_io.F90 | 129 +++++++++++----------------------- lilac/lilac/lilac_mod.F90 | 23 +++++- 4 files changed, 87 insertions(+), 116 deletions(-) diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index 96846db837..01486380a1 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -20,14 +20,12 @@ CTSM_BLD_DIR = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/no CTSM_INC = -I$(CTSM_BLD_DIR)/include CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm -#TRACEBACK_FLAGS = -g -traceback -debug all -check all -O2 -r8 TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free - -# ----------------------------------------------------------------------------- EXTRA_LIBS = -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -lcsm_share -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib + MORE_LIBS = -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/clm/obj/ -I//glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -# ----------------------------------------------------------------------------- + DRIVER_DIR = $(CURDIR) LILAC_DIR = $(DRIVER_DIR)/../lilac @@ -54,46 +52,46 @@ lilac_atmcap.o : $(LILAC_DIR)/lilac_atmcap.F90 $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ $(EXTRA_LIBS) $(MORE_LIBS) $< -lilac_cpl.o : $(LILAC_DIR)/lilac_cpl.F90 +lilac_mod.o : $(LILAC_DIR)/lilac_mod.F90 $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) $(PIO_INC) \ $(EXTRA_LIBS) $(MORE_LIBS) $< -lilac_utils.o : $(LILAC_DIR)/lilac_utils.F90 +lilac_io.o : $(LILAC_DIR)/lilac_io.F90 $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) $(PIO_INC) \ $(EXTRA_LIBS) $(MORE_LIBS) $< -lilac_mod.o : $(LILAC_DIR)/lilac_mod.F90 +lilac_cpl.o : $(LILAC_DIR)/lilac_cpl.F90 $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ $(EXTRA_LIBS) $(MORE_LIBS) $< -lilac_constants.o : $(LILAC_DIR)/lilac_constants.F90 +lilac_utils.o : $(LILAC_DIR)/lilac_utils.F90 $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ $(EXTRA_LIBS) $(MORE_LIBS) $< -lilac_methods.o : $(LILAC_DIR)/lilac_methods.F90 +lilac_constants.o : $(LILAC_DIR)/lilac_constants.F90 $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ $(EXTRA_LIBS) $(MORE_LIBS) $< -lilac_time.o : $(LILAC_DIR)/lilac_time.F90 +lilac_methods.o : $(LILAC_DIR)/lilac_methods.F90 $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ $(EXTRA_LIBS) $(MORE_LIBS) $< -lilac_io.o : $(LILAC_DIR)/lilac_io.F90 +lilac_time.o : $(LILAC_DIR)/lilac_time.F90 $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) $(PIO_INC) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ $(EXTRA_LIBS) $(MORE_LIBS) $< lilac_history.o : $(LILAC_DIR)/lilac_history.F90 @@ -108,7 +106,7 @@ atm_driver.o : $(DRIVER_DIR)/atm_driver.F90 $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ $(EXTRA_LIBS) $(MORE_LIBS) $< -atm_driver: atm_driver.o lilac_atmcap.o lilac_mod.o lilac_utils.o lilac_cpl.o +atm_driver: atm_driver.o lilac_atmcap.o lilac_mod.o lilac_utils.o lilac_cpl.o lilac_history.o lilac_methods.o lilac_time.o lilac_io.o lilac_constants.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(CTSM_INC) $(CTSM_LIB) $(EXTRA_LIBS) $(TRACEBACK_FLAGS) $(MORE_LIBS) mv atm_driver atm_driver.exe rm *.o *.mod diff --git a/lilac/lilac/lilac_history.F90 b/lilac/lilac/lilac_history.F90 index e72099985a..69ce98ae00 100644 --- a/lilac/lilac/lilac_history.F90 +++ b/lilac/lilac/lilac_history.F90 @@ -187,14 +187,17 @@ subroutine lilac_history_write(atm2lnd_a_state, atm2lnd_l_state, lnd2atm_l_state ! --- History Alarms !--------------------------------------- - if (ESMF_AlarmIsRinging(AlarmHist, rc=rc)) then - if (ChkErr(rc,__LINE__,u_FILE_u)) return - alarmIsOn = .true. - call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - alarmisOn = .false. - endif + ! if (ESMF_AlarmIsRinging(AlarmHist, rc=rc)) then + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! alarmIsOn = .true. + ! call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! else + ! alarmisOn = .false. + ! endif + ! hard-wire for now + alarmisOn = .true. + case_name = 'test_lilac' !--------------------------------------- ! --- History File @@ -203,9 +206,9 @@ subroutine lilac_history_write(atm2lnd_a_state, atm2lnd_l_state, lnd2atm_l_state !--------------------------------------- if (alarmIsOn) then - write(hist_file,"(6a)") & - trim(case_name), '.cpl',trim(cpl_inst_tag),'.hi.', trim(nexttimestr),'.nc' + write(hist_file,"(6a)") trim(case_name), '.cpl.hi.',trim(nexttimestr),'.nc' call ESMF_LogWrite(trim(subname)//": write "//trim(hist_file), ESMF_LOGMSG_INFO, rc=rc) + call lilac_io_wopen(hist_file, vm, iam, clobber=.true.) do m = 1,2 diff --git a/lilac/lilac/lilac_io.F90 b/lilac/lilac/lilac_io.F90 index d5aeabf48f..c118d881ca 100644 --- a/lilac/lilac/lilac_io.F90 +++ b/lilac/lilac/lilac_io.F90 @@ -14,51 +14,24 @@ module lilac_io use lilac_methods , only : FB_getFldPtr => lilac_methods_FB_getFldPtr use lilac_methods , only : FB_getNameN => lilac_methods_FB_getNameN use lilac_methods , only : chkerr - use pio , only : file_desc_t, iosystem_desc_t - use pio , only : var_desc_t, io_desc_t, PIO_UNLIMITED - use pio , only : pio_def_dim, pio_inq_dimid, pio_real, 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, pio_offset_kind, pio_int - use pio , only : pio_double, pio_def_dim, pio_def_var, pio_put_att, pio_put_var - use pio , only : PIO_IOTYPE_PNETCDF, PIO_IOTYPE_NETCDF, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR - use pio , only : pio_openfile, pio_createfile, PIO_GLOBAL, pio_enddef - use pio , only : pio_put_att, pio_redef, pio_get_att - use pio , only : pio_seterrorhandling, pio_file_is_open, pio_clobber, pio_write, pio_noclobber - use pio , only : pio_file_is_open, pio_closefile - use pio , only : pio_redef, pio_enddef - use pio , only : var_desc_t, pio_def_dim - use pio , only : pio_put_att, pio_put_var - use pio , only : pio_int, pio_char - use pio , only : var_desc_t, pio_def_var, pio_put_att - use pio , only : pio_double, pio_noerr, pio_put_var - use pio , only : file_desc_T, var_desc_t, io_desc_t, pio_nowrite, pio_openfile - use pio , only : pio_noerr, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR - use pio , only : pio_double, pio_get_att, pio_seterrorhandling, pio_freedecomp, pio_closefile - use pio , only : pio_read_darray, pio_offset_kind, pio_setframe - 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_vardimid - use pio , only : pio_double, pio_seterrorhandling, pio_initdecomp - use pio , only : var_desc_t, file_desc_t, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_seterrorhandling - use pio , only : pio_get_var, pio_get_att, pio_openfile - use pio , only : pio_nowrite, pio_openfile, pio_global - use pio , only : pio_closefile - 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_get_var - use pio , only : pio_nowrite, pio_openfile, pio_global, pio_get_att - use pio , only : file_desc_t, var_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR - use pio , only : pio_closefile, pio_get_var - use pio , only : pio_openfile, pio_global, pio_get_att, pio_nowrite - use pio , only : var_desc_t, pio_def_dim, pio_put_att - use pio , only : pio_put_var - use pio , only : var_desc_t, pio_def_dim - use pio , only : pio_put_var, pio_double, pio_put_att + use pio , only : file_desc_t, iosystem_desc_t, var_desc_t, io_desc_t, file_desc_t + use pio , only : PIO_DOUBLE, PIO_REAL, PIO_INT, PIO_CHAR,PIO_UNLIMITED, PIO_GLOBAL + use pio , only : PIO_IOTYPE_PNETCDF, PIO_IOTYPE_NETCDF, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, PIO_NOERR + use pio , only : pio_openfile, pio_createfile, pio_nowrite, pio_redef, pio_enddef, pio_closefile + use pio , only : pio_syncfile, pio_offset_kind + use pio , only : pio_initdecomp, pio_freedecomp + use pio , only : pio_seterrorhandling, pio_file_is_open, pio_clobber, pio_noclobber, pio_setframe + use pio , only : pio_inq_dimid, pio_inq_dimlen, pio_inq_vardimid, pio_inq_varid, pio_inq_varndims + use pio , only : pio_def_dim, pio_def_var + use pio , only : pio_get_var, pio_get_att + use pio , only : pio_put_var, pio_put_att + use pio , only : pio_write, pio_write_darray + use pio , only : pio_read_darray implicit none private integer :: logunit = 6 ! TODO: fix this - integer :: lilac_id ! public member functions: public :: lilac_io_wopen @@ -111,16 +84,18 @@ module lilac_io ! module data !------------------------------------------------------------------------------- + type(iosystem_desc_t), pointer :: io_subsystem + integer :: pio_iotype + integer :: pio_ioformat + + integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now + type(file_desc_t) :: io_file(0:file_desc_t_cnt) + character(*),parameter :: prefix = "lilac_io_" character(*),parameter :: modName = "(lilac_io_mod) " character(*),parameter :: version = "lilac0" - 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__ @@ -128,6 +103,19 @@ module lilac_io contains !================================================================================= + subroutine lilac_io_init() + + !--------------- + ! initialize module variables + !--------------- + + io_subsystem => shr_pio_getiosys(compid=1) + pio_iotype = shr_pio_getiotype(compid=1) + pio_ioformat = shr_pio_getioformat(compid=1) + + end subroutine lilac_io_init + + !=============================================================================== logical function lilac_io_file_exists(vm, iam, filename) !--------------- @@ -155,43 +143,6 @@ logical function lilac_io_file_exists(vm, iam, filename) end function lilac_io_file_exists - !=============================================================================== - subroutine lilac_io_init() - - !--------------- - ! initialize pio - !--------------- - -#ifdef INTERNAL_PIO_INIT - ! if CMEPS is the only component using PIO, then it needs to initialize PIO - use shr_pio_mod , only : shr_pio_init2 - - type(ESMF_VM) :: vm - integer :: comms(1), comps(1) - logical :: comp_iamin(1) - integer :: comp_comm_iam(1) - character(len=32) :: compLabels(1) - integer :: rc - - call ESMF_VMGetCurrent(vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, mpiCommunicator=comms(1), localPet=comp_comm_iam(1), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - comps(1) = lilac_id - compLabels(1) = "MED" - comp_iamin(1) = .true. - - call shr_pio_init2(comps, compLabels, comp_iamin, comms, comp_comm_iam) -#endif - - io_subsystem => shr_pio_getiosys(lilac_id) - pio_iotype = shr_pio_getiotype(lilac_id) - pio_ioformat = shr_pio_getioformat(lilac_id) - - end subroutine lilac_io_init - !=============================================================================== subroutine lilac_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) @@ -249,11 +200,11 @@ subroutine lilac_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) write(logunit,*) subname,' open file ',trim(filename) end if call pio_seterrorhandling(io_file(lfile_ind),PIO_BCAST_ERROR) - rcode = pio_get_att(io_file(lfile_ind),pio_global,"file_version",lversion) + rcode = pio_get_att(io_file(lfile_ind),PIO_GLOBAL,"file_version",lversion) call pio_seterrorhandling(io_file(lfile_ind),PIO_INTERNAL_ERROR) if (trim(lversion) /= trim(version)) then rcode = pio_redef(io_file(lfile_ind)) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) + rcode = pio_put_att(io_file(lfile_ind),PIO_GLOBAL,"file_version",version) rcode = pio_enddef(io_file(lfile_ind)) endif endif @@ -267,8 +218,8 @@ subroutine lilac_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) if (iam==0) then write(logunit,*) subname,' create file ',trim(filename) end if - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(io_file(lfile_ind),PIO_GLOBAL,"file_version",version) + rcode = pio_put_att(io_file(lfile_ind),PIO_GLOBAL,"model_doi_url",lmodel_doi_url) endif elseif (trim(wfilename) /= trim(filename)) then ! filename is open, better match open filename @@ -1539,7 +1490,7 @@ subroutine lilac_io_read_int1d(filename, vm, iam, idata, dname, rc) if (lilac_io_file_exists(vm, iam, filename)) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) - rcode = pio_get_att(pioid,pio_global,"file_version",lversion) + rcode = pio_get_att(pioid,PIO_GLOBAL,"file_version",lversion) call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) else if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) @@ -1619,7 +1570,7 @@ subroutine lilac_io_read_r81d(filename, vm, iam, rdata, dname, rc) if (lilac_io_file_exists(vm, iam, filename)) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) - rcode = pio_get_att(pioid,pio_global,"file_version",lversion) + rcode = pio_get_att(pioid,PIO_GLOBAL,"file_version",lversion) call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) else if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) @@ -1672,7 +1623,7 @@ subroutine lilac_io_read_char(filename, vm, iam, rdata, dname, rc) rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) ! write(logunit,*) subname,' open file ',trim(filename) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) - rcode = pio_get_att(pioid,pio_global,"file_version",lversion) + rcode = pio_get_att(pioid,PIO_GLOBAL,"file_version",lversion) call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) else if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 19ee588c75..1ff52d6a19 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -48,6 +48,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! This is called by the host atmosphere ! -------------------------------------------------------------------------------- + use lilac_io , only : lilac_io_init use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd use lilac_utils , only : gindex_atm, atm_mesh_filename use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register @@ -108,6 +109,10 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) call ESMF_LogWrite(subname//"Initializing ESMF ", ESMF_LOGMSG_INFO) + !------------------------------------------------------------------------- + ! Initialize pio with first initialization + !------------------------------------------------------------------------- + ! Initialize pio (needed by CTSM) - TODO: this should be done within CTSM not here call ESMF_VMGetGlobal(vm=vm, rc=rc) @@ -319,14 +324,21 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & print *, trim(subname) // "finished lilac initialization" end if + !------------------------------------------------------------------------- + ! Initialize lilac_io_mod module data + !------------------------------------------------------------------------- + + call lilac_io_init() + call ESMF_LogWrite(subname//"initialized lilac_io ...", ESMF_LOGMSG_INFO) + end subroutine lilac_init !======================================================================== subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) - use shr_sys_mod, only : shr_sys_abort - use lilac_history + use shr_sys_mod , only : shr_sys_abort + use lilac_history, only : lilac_history_write ! input/output variables logical, intent(in) :: restart_alarm_is_ringing @@ -400,6 +412,13 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) call shr_sys_abort("lilac error in cpl_lnd2atm") end if + ! Write out history output + call lilac_history_write(atm2lnd_a_state, atm2lnd_l_state, lnd2atm_l_state, lnd2atm_a_state, & + lilac_clock, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort("lilac error in history write") + end if + ! Advance the time at the end of the time step call ESMF_ClockAdvance(lilac_clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then From ead027e82a4079ebb93149ed3986f41dfc0379c4 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 30 Nov 2019 11:13:08 -0700 Subject: [PATCH 186/556] updates necessary to get lilac history output working --- src/cpl/lilac/lnd_comp_esmf.F90 | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 9ac64ab13e..96846d3d1f 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -2,17 +2,17 @@ module lnd_comp_esmf !---------------------------------------------------------------------------- ! This is the ESMF cap for CTSM + ! NOTE : both mpi_init and pio_init1 are initialized in lilac_mod.F90 !---------------------------------------------------------------------------- ! external libraries use ESMF - use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE use mpi , only : MPI_BCAST, MPI_CHARACTER - use mct_mod , only : mct_world_init, mct_world_clean, mct_die - use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 + use mct_mod , only : mct_world_init use perf_mod , only : t_startf, t_stopf, t_barrierf ! cime share code + use shr_pio_mod , only : shr_pio_init2 use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl use shr_sys_mod , only : shr_sys_abort use shr_file_mod , only : shr_file_setLogUnit, shr_file_getLogUnit @@ -157,8 +157,8 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! for pio_init2 and mct type(ESMF_VM) :: vm - integer :: mpicom_vm - integer :: ncomps = 1 + integer :: mpicom_vm + integer :: ncomps = 1 ! for mct integer, pointer :: mycomms(:) ! for mct integer, pointer :: myids(:) ! for mct integer :: compids(1) = (/1/) ! for both mct and pio_init2 - array with component ids @@ -181,8 +181,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Query VM for local PET and mpi communicator !------------------------------------------------------------------------ - ! NOTE : both MPI_INIT and PIO_INIT1 are initialized in lilac_mod.F90 - call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return @@ -190,15 +188,11 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return call ESMF_LogWrite(subname//"ESMF_VMGet", ESMF_LOGMSG_INFO) - !call ESMF_VMPrint (vm, rc = rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - comms(1) = mpicom_vm - !------------------------------------------------------------------------ ! Initialize pio_init2 TODO: is this needed here? !------------------------------------------------------------------------ + comms(1) = mpicom_vm call shr_pio_init2(compids, compLabels, comp_iamin, comms, iam) call ESMF_LogWrite(subname//"initialized shr_pio_init2 ...", ESMF_LOGMSG_INFO) From 9afc8be37c1667b195543b62b5d878fc5b50947e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 30 Nov 2019 13:06:46 -0700 Subject: [PATCH 187/556] now building lilac as part of CTSM - and not as part of the host atm --- lilac/atm_driver/Makefile | 79 ++++---------------------------- lilac/lilac/lilac_fields.F90 | 87 ++++++++++++++++++++++++++++++++++++ lilac/lilac/lilac_mod.F90 | 1 + lilac/lilac/lilac_utils.F90 | 12 +++-- 4 files changed, 101 insertions(+), 78 deletions(-) create mode 100644 lilac/lilac/lilac_fields.F90 diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index 01486380a1..b1e137c957 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -14,17 +14,16 @@ include $(ESMFMKFILE) #================================================================================ ### Define directory paths #================================================================================ -CASE_NAME = why01-g -PIO_INC = -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/include -CTSM_BLD_DIR = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf -CTSM_INC = -I$(CTSM_BLD_DIR)/include -CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm +CASE_NAME = why01-g +CTSM_BLD_DIR = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf +CTSM_INC = -I$(CTSM_BLD_DIR)/include +CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free -EXTRA_LIBS = -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -lcsm_share -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib +EXTRA_LIBS = -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -lcsm_share -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib -MORE_LIBS = -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/clm/obj/ -I//glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ +MORE_LIBS = -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/clm/obj/ -I//glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ DRIVER_DIR = $(CURDIR) @@ -46,80 +45,18 @@ LILAC_DIR = $(DRIVER_DIR)/../lilac $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ $(EXTRA_LIBS) $(MORE_LIBS) $< -lilac_atmcap.o : $(LILAC_DIR)/lilac_atmcap.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ - $(EXTRA_LIBS) $(MORE_LIBS) $< - -lilac_mod.o : $(LILAC_DIR)/lilac_mod.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) $(PIO_INC) \ - $(EXTRA_LIBS) $(MORE_LIBS) $< - -lilac_io.o : $(LILAC_DIR)/lilac_io.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) $(PIO_INC) \ - $(EXTRA_LIBS) $(MORE_LIBS) $< - -lilac_cpl.o : $(LILAC_DIR)/lilac_cpl.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ - $(EXTRA_LIBS) $(MORE_LIBS) $< - -lilac_utils.o : $(LILAC_DIR)/lilac_utils.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ - $(EXTRA_LIBS) $(MORE_LIBS) $< - -lilac_constants.o : $(LILAC_DIR)/lilac_constants.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ - $(EXTRA_LIBS) $(MORE_LIBS) $< - -lilac_methods.o : $(LILAC_DIR)/lilac_methods.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ - $(EXTRA_LIBS) $(MORE_LIBS) $< - -lilac_time.o : $(LILAC_DIR)/lilac_time.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ - $(EXTRA_LIBS) $(MORE_LIBS) $< - -lilac_history.o : $(LILAC_DIR)/lilac_history.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ - $(EXTRA_LIBS) $(MORE_LIBS) $< - atm_driver.o : $(DRIVER_DIR)/atm_driver.F90 $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ $(EXTRA_LIBS) $(MORE_LIBS) $< -atm_driver: atm_driver.o lilac_atmcap.o lilac_mod.o lilac_utils.o lilac_cpl.o lilac_history.o lilac_methods.o lilac_time.o lilac_io.o lilac_constants.o +atm_driver: atm_driver.o $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(CTSM_INC) $(CTSM_LIB) $(EXTRA_LIBS) $(TRACEBACK_FLAGS) $(MORE_LIBS) mv atm_driver atm_driver.exe - rm *.o *.mod # module dependencies: -atm_driver.o: lilac_mod.o lilac_atmcap.o lilac_utils.o lilac_cpl.o -lilac_mod.o: lilac_atmcap.o lilac_utils.o lilac_cpl.o lilac_history.o -lilac_atmcap.o: lilac_utils.o -lilac_constants.o : -lilac_methods.o: lilac_constants.o -lilac_time.o: lilac_constants.o lilac_methods.o -lilac_io.o: lilac_constants.o lilac_methods.o -lilac_history.o: lilac_constants.o lilac_methods.o lilac_io.o lilac_time.o +atm_driver.o: # ----------------------------------------------------------------------------- .PHONY: clean berzerk remake diff --git a/lilac/lilac/lilac_fields.F90 b/lilac/lilac/lilac_fields.F90 new file mode 100644 index 0000000000..c31f41a120 --- /dev/null +++ b/lilac/lilac/lilac_fields.F90 @@ -0,0 +1,87 @@ +module lilac_fields + + ! This module is used by both CTSM and the lilac atmcap to ensure that the field bundles + ! exchanged between components are identical + + use ESMF + use lilac_methods, only : chkerr + use lilac_utils , only : atm2lnd, lnd2atm + + implicit none + public + + character(*),parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine lilac_field_bundle_to_land(mesh, fieldbundle, rc) + + type(ESMF_Mesh) :: mesh + type(ESMF_FieldBundle) :: fieldbundle + integer, intent(out) :: rc + + integer :: n + + rc = ESMF_SUCCESS + + ! Add empty fields to field bundle + do n = 1, size(atm2lnd) + call fldbundle_add(trim(atm2lnd(n)%fldname), mesh, fieldbundle, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + end subroutine lilac_field_bundle_to_land + + !=============================================================================== + + subroutine lilac_field_bundle_from_land(mesh, fieldbundle, rc) + + type(ESMF_Mesh) :: mesh + type(ESMF_FieldBundle) :: fieldbundle + integer, intent(out) :: rc + + integer :: n + + rc = ESMF_SUCCESS + + ! Add empty fields to field bundle + do n = 1, size(atm2lnd) + call fldbundle_add( trim(lnd2atm(n)%fldname), mesh, fieldbundle, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + end subroutine lilac_field_bundle_from_land + + !=============================================================================== + + subroutine fldbundle_add(fldname, mesh, fieldbundle, rc) + + !--------------------------- + ! Create an empty input field with name 'stdname' to add to fieldbundle + !--------------------------- + + ! input/output variables + character(len=*) , intent(in) :: fldname + type(ESMF_Mesh) , intent(in) :: mesh + type(ESMF_FieldBundle) , intent(inout) :: fieldbundle + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: field + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleAdd(fieldbundle, (/field/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine fldbundle_add + + +end module lilac_fields diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 index 1ff52d6a19..b3febbfae7 100644 --- a/lilac/lilac/lilac_mod.F90 +++ b/lilac/lilac/lilac_mod.F90 @@ -135,6 +135,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & atm_mesh_filename = atm_mesh_file ! Initialize datatypes atm2lnd and lnd2atm + ! This must be done BEFORE the component initialization call lilac_init_atm2lnd(lsize) call lilac_init_lnd2atm(lsize) diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 index d35066ef17..08877ffb51 100644 --- a/lilac/lilac/lilac_utils.F90 +++ b/lilac/lilac/lilac_utils.F90 @@ -106,13 +106,11 @@ subroutine lilac_init_lnd2atm(lsize) call lnd2atm_add_fld (lnd2atm, fldname='Sl_u10' , units='unknown', lsize=lsize) call lnd2atm_add_fld (lnd2atm, fldname='Sl_fv' , units='unknown', lsize=lsize) call lnd2atm_add_fld (lnd2atm, fldname='Sl_ram1' , units='unknown', lsize=lsize) - - ! TODO: for now are commenting these since they are in the lnd send - however this - ! is not correct and the lnd send should reintroduce these as soon as possible and - ! the following should be uncommented - !call lnd2atm_add_fld (lnd2atm, fldname='Fall_lwup' , units='unknown', lsize=lsize) - !call lnd2atm_add_fld (lnd2atm, fldname='Fall_taux' , units='unknown', lsize=lsize) - !call lnd2atm_add_fld (lnd2atm, fldname='Fall_tauy' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Fall_lwup' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Fall_taux' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Fall_tauy' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Fall_evap' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Fall_swnet', units='unknown', lsize=lsize) ! now add dataptr memory for all of the fields do n = 1,size(lnd2atm) From 518aa63f2432c29dc1a9feb0f0cce21d2fe13487 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 30 Nov 2019 13:35:48 -0700 Subject: [PATCH 188/556] cleanup of Makefile to have minimal information for driver --- lilac/atm_driver/Makefile | 49 +++++++++++---------------------- lilac/atm_driver/atm_driver.F90 | 6 ++-- 2 files changed, 19 insertions(+), 36 deletions(-) diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index b1e137c957..58e9ea1fd0 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -1,63 +1,46 @@ #================================================================================ -# Makefile to compile the lilac program +# Makefile to compile atm_driver on cheyenne #================================================================================ -## This is temporary Makefile for building lilac against CTSM pre-compiled library #================================================================================ -### Finding and including esmf.mk +# Define directory paths #================================================================================ ESMFMKFILE = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default/esmf.mk ESMF_LIB_DIR = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default include $(ESMFMKFILE) -#================================================================================ -### Define directory paths -#================================================================================ CASE_NAME = why01-g CTSM_BLD_DIR = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf -CTSM_INC = -I$(CTSM_BLD_DIR)/include -CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm - -TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free +MCT_LIB = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib +SHR_LIB = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib +SHR_INC = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ +CTSM_INC = $(CTSM_BLD_DIR)/clm/obj -EXTRA_LIBS = -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -lcsm_share -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib +FFLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free -MORE_LIBS = -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -L/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -I/glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/clm/obj/ -I//glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ +LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(MCT_LIB) -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib - -DRIVER_DIR = $(CURDIR) -LILAC_DIR = $(DRIVER_DIR)/../lilac +INCLUDES = -I$(CTSM_BLD_DIR)/include -I$(SHR_INC) -I$(CTSM_INC) #================================================================================ -### Compiler and linker rules using ESMF_ variables supplied by esmf.mk +# Compiler and linker rules using ESMF_ variables supplied by esmf.mk #================================================================================ -.SUFFIXES: .f90 .F90 .c .C - -%.o : %.f90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREENOCPP) $< +.SUFFIXES: .F90 %.o : %.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ - $(EXTRA_LIBS) $(MORE_LIBS) $< + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(INCLUDES) $(FFLAGS) $< -atm_driver.o : $(DRIVER_DIR)/atm_driver.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $(ESMF_F90COMPILEFREENOCPP) \ - $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ - $(EXTRA_LIBS) $(MORE_LIBS) $< +atm_driver.o : $(CURDIR)/atm_driver.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(INCLUDES) $(FFLAGS) $< atm_driver: atm_driver.o - $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(CTSM_INC) $(CTSM_LIB) $(EXTRA_LIBS) $(TRACEBACK_FLAGS) $(MORE_LIBS) + $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(LIBS) mv atm_driver atm_driver.exe # module dependencies: atm_driver.o: -# ----------------------------------------------------------------------------- .PHONY: clean berzerk remake clean: @@ -66,4 +49,4 @@ berzerk: rm -f PET*.ESMF_LogFile job_name* *.o *.mod *.exe remake: rm lilac_mod.o atm_driver.o atm_driver.exe & make -# ----------------------------------------------------------------------------- + diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 146ba9b9c2..f13069396d 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -16,10 +16,9 @@ program atm_driver ! ESMF lilac_atmcap ESMF CTSM cap ESMF river cap (Mizzouroute, Mosart) !---------------------------------------------------------------------------- + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS use lilac_mod , only : lilac_init, lilac_run, lilac_final use lilac_utils , only : lilac_atm2lnd, lilac_lnd2atm - use shr_sys_mod , only : shr_sys_abort - use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS implicit none @@ -90,7 +89,8 @@ program atm_driver open(newunit=fileunit, status="old", file="atm_driver_in") read(fileunit, atm_driver_input, iostat=ierr) if (ierr > 0) then - call shr_sys_abort( 'problem on read of atm_driver_in') + print *, 'Error on reading atm_driver_in' + call MPI_ABORT(MPI_COMM_WORLD, ierr) end if close(fileunit) From 3bf9bee9bc40e26b95c664041bca4f3f589392c7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 30 Nov 2019 14:36:02 -0700 Subject: [PATCH 189/556] made lilac a part of the ctsm build and created new config file that is input into lilac buildnml - and that is located in the host atm driver --- cime_config/buildlib | 28 ++++++- lilac_config/buildnml | 58 ++++++++++++- lilac_config/lnd_input.py | 27 ------ src/cpl/lilac/lnd_import_export.F90 | 124 ++++++---------------------- 4 files changed, 103 insertions(+), 134 deletions(-) delete mode 100644 lilac_config/lnd_input.py diff --git a/cime_config/buildlib b/cime_config/buildlib index f4cd613a6c..9493767c0c 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -20,6 +20,15 @@ from CIME.utils import run_cmd, expect logger = logging.getLogger(__name__) +############################################################################### +def _get_osvar(key, default): +############################################################################### + if key in os.environ: + value = os.environ[key] + else: + value = default + return value + ############################################################################### def _main_func(): ############################################################################### @@ -33,12 +42,19 @@ def _main_func(): gmake_j = case.get_value("GMAKE_J") gmake = case.get_value("GMAKE") + lilac_mode = _get_osvar('LILAC_MODE', 'off') + print "DEBUG: lilac_mode is ",lilac_mode + if lilac_mode == 'on': + lilac_src = _get_osvar('LILAC_SRC', None) + expect(lilac_src, "environment variable LILAC_SRC must be set") + #------------------------------------------------------- # create Filepath file #------------------------------------------------------- filepath_file = os.path.join(bldroot,"Filepath") if not os.path.isfile(filepath_file): caseroot = case.get_value("CASEROOT") + paths = [os.path.join(caseroot,"SourceMods","src.clm"), os.path.join(lnd_root,"src","main"), os.path.join(lnd_root,"src","biogeophys"), @@ -51,10 +67,14 @@ def _main_func(): os.path.join(lnd_root,"src","fates","biogeophys"), os.path.join(lnd_root,"src","fates","biogeochem"), os.path.join(lnd_root,"src","fates","fire"), - os.path.join(lnd_root,"src","utils"), - os.path.join(lnd_root,"src","cpl"), - #os.path.join(lnd_root,"src","cpl","mct"), - os.path.join(lnd_root,"src","cpl","lilac")] + os.path.join(lnd_root,"src","utils")] + + if lilac_mode == 'off': + paths.append(os.path.join(lnd_root,"src","cpl","mct")) + else: + paths.append(os.path.join(lnd_root,"src","cpl","lilac")) + paths.append(lilac_src) + with open(filepath_file, "w") as filepath: filepath.write("\n".join(paths)) filepath.write("\n") diff --git a/lilac_config/buildnml b/lilac_config/buildnml index d88ad29199..9f0e0e82b0 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -6,8 +6,30 @@ CTSM namelist creator import sys, os, shutil, subprocess, logging, argparse import six -from lnd_input import * -from argparse import RawTextHelpFormatter +from argparse import RawTextHelpFormatter + +try: + # python2 + from ConfigParser import SafeConfigParser as config_parser + from ConfigParser import MissingSectionHeaderError + from ConfigParser import NoSectionError, NoOptionError + + def config_string_cleaner(text): + """convert strings into unicode + """ + return text.decode('utf-8') +except ImportError: + # python3 + from configparser import ConfigParser as config_parser + from configparser import MissingSectionHeaderError + from configparser import NoSectionError, NoOptionError + + def config_string_cleaner(text): + """Python3 already uses unicode strings, so just return the string + without modification. + + """ + return text logger = logging.getLogger(__name__) @@ -134,6 +156,32 @@ def buildnml(rundir, bldnmldir): """Build the ctsm namelist """ + file_path = os.path.join(rundir,'ctsm.cfg') + + # read the config file + config = config_parser() + config.read(file_path) # TODO: add the code in externals_description.py to get the error checks + + clm_phys = config.get('buildnml_input', 'clm_phys') + start_type = config.get('buildnml_input', 'start_type') + start_ymd = config.get('buildnml_input', 'start_ymd') + startfile_type = config.get('buildnml_input', 'startfile_type') + ignore = config.get('buildnml_input', 'ignore') + configuration = config.get('buildnml_input', 'configuration') + structure = config.get('buildnml_input', 'structure') + ccsm_co2_ppmv = config.get('buildnml_input', 'ccsm_co2_ppmv') + clm_co2_type = config.get('buildnml_input', 'clm_co2_type') + clm_bldnml_opts = config.get('buildnml_input', 'clm_bldnml_opts') + use_case = config.get('buildnml_input', 'use_case') + lnd_tuning_mode = config.get('buildnml_input', 'lnd_tuning_mode') + spinup = config.get('buildnml_input', 'spinup') + gridmask = config.get('buildnml_input', 'gridmask') + lnd_grid = config.get('buildnml_input', 'lnd_grid') + lnd_domain_file = config.get('buildnml_input', 'lnd_domain_file') + lnd_domain_path = config.get('buildnml_input', 'lnd_domain_path') + din_loc_root = config.get('buildnml_input', 'din_loc_root') + clm_namelist_opts = config.get('buildnml_input', 'clm_namelist_opts') + # create config_cache.xml file # Note that build-namelist utilizes the contents of the config_cache.xml file in # the namelist_defaults.xml file to obtain namelist variables @@ -176,7 +224,11 @@ def buildnml(rundir, bldnmldir): if rc > 0: raise Exception("Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) - # remove temporary files from rundir + # remove temporary files in bldnmldir + os.remove(os.path.join(bldnmldir, "lnd_in")) + os.remove(os.path.join(bldnmldir, "clm.input_data_list")) + + # remove temporary files in rundir os.remove(os.path.join(rundir, "config_cache.xml")) os.remove(os.path.join(rundir, "env_lilac.xml")) os.remove(os.path.join(rundir, "drv_flds_in")) diff --git a/lilac_config/lnd_input.py b/lilac_config/lnd_input.py deleted file mode 100644 index d2b202dcae..0000000000 --- a/lilac_config/lnd_input.py +++ /dev/null @@ -1,27 +0,0 @@ -# ------------------------------------------------------------------------- -# set the input namelist options for clm's build-namelist -# ------------------------------------------------------------------------- -# - tuning parameters and initial conditions should be optimized for what CLM model version and -# what meteorlogical forcing combination? valid values are: -# clm5_0_cam6.0, clm5_0_GSWP3v1, clm5_0_CRUv7, clm4_5_CRUv7, clm4_5_GSWP3v1, clm4_5_cam6.0 -# - only support startup or continue runs for now - -clm_phys = "clm5_0" -start_type = "default" -start_ymd = "20000101" -startfile_type = "finidat" -ignore = "-ignore_ic_year" -configuration = "clm" -structure = "standard" -ccsm_co2_ppmv = str(367.0) -clm_co2_type = "constant" -clm_bldnml_opts = "-bgc sp" -use_case = "2000_control" -lnd_tuning_mode = "clm5_0_GSWP3v1" -spinup = "off" -gridmask = "gx3v7" -lnd_grid = "4x5" -lnd_domain_file = "domain.lnd.fv4x5_gx3v7.091218.nc" -lnd_domain_path = "/glade/p/cesmdata/cseg/inputdata/share/domains" -din_loc_root = "/glade/p/cesmdata/cseg/inputdata" -clm_namelist_opts = "" diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 35f6308ff3..e310dbd4c8 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -9,15 +9,15 @@ module lnd_import_export use clm_varctl , only : iulog, co2_ppmv, ndep_from_cpl use clm_varcon , only : rair, o2_molar_const use clm_time_manager , only : get_nstep + use clm_instMod , only : atm2lnd_inst, lnd2atm_inst, water_inst + use domainMod , only : ldomain use spmdMod , only : masterproc use decompmod , only : bounds_type use lnd2atmType , only : lnd2atm_type use lnd2glcMod , only : lnd2glc_type use atm2lndType , only : atm2lnd_type - use domainMod , only : ldomain - use shr_megan_mod , only : shr_megan_mechcomps_n ! TODO: need to add a namelist read nere use lnd_shr_methods , only : chkerr - use clm_instMod , only : atm2lnd_inst, lnd2atm_inst, water_inst + use shr_megan_mod , only : shr_megan_mechcomps_n ! TODO: need to add a namelist read nere implicit none private ! except @@ -25,28 +25,11 @@ module lnd_import_export public :: import_fields public :: export_fields - private :: fldlist_add private :: state_getimport private :: state_setexport private :: state_getfldptr private :: check_for_nans - type fld_list_type - character(len=128) :: stdname - integer :: ungridded_lbound = 0 - integer :: ungridded_ubound = 0 - end type fld_list_type - - integer, parameter :: fldsMax = 100 - integer :: fldsToLnd_num = 0 - integer :: fldsFrLnd_num = 0 - type (fld_list_type) :: fldsToLnd(fldsMax) - type (fld_list_type) :: fldsFrLnd(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost - - logical :: glc_present = .false. ! .true. => running with a non-stubGLC model - logical :: rof_prognostic = .false. ! .true. => running with a prognostic ROF model - ! from atm->lnd integer :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn @@ -522,39 +505,6 @@ end subroutine export_fields !=============================================================================== - subroutine fldlist_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 - integer, optional, intent(in) :: ungridded_lbound - integer, optional, intent(in) :: ungridded_ubound - - ! local variables - integer :: rc - character(len=*), parameter :: subname='(lnd_import_export:fldlist_add)' - !------------------------------------------------------------------------------- - - ! Set up a list of field information - - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - 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 fldlist_add - - !=============================================================================== - subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) ! ---------------------------------------------- @@ -570,20 +520,17 @@ subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) integer , intent(out) :: rc ! local variables - integer :: g, i,n - - integer :: fieldcount - - real(R8), pointer :: fldptr1d(:) - real(R8), pointer :: fldptr2d(:,:) - type(ESMF_StateItem_Flag) :: itemFlag - character(len=cs) :: cvalue + integer :: g, i,n + integer :: fieldcount + real(R8), pointer :: fldptr1d(:) + real(R8), pointer :: fldptr2d(:,:) + type(ESMF_StateItem_Flag) :: itemFlag + character(len=cs) :: cvalue + type (ESMF_FieldBundle) :: field + type(ESMF_Field) :: lfield + type (ESMF_FieldBundle) :: fieldBundle + logical :: isPresent character(len=*), parameter :: subname='(lnd_import_export:state_getimport)' - - type (ESMF_FieldBundle):: field - type(ESMF_Field) :: lfield - type (ESMF_FieldBundle):: fieldBundle - logical :: isPresent ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -605,7 +552,6 @@ subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) ! Determine if fieldbundle exists in state call ESMF_StateGet(state, "c2l_fb", itemFlag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) ! if fieldbundle exists then create output array - else do nothing if (itemflag /= ESMF_STATEITEM_NOTFOUND) then @@ -616,10 +562,6 @@ subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) call ESMF_LogWrite(subname//'c2l_fb found and now ... getting '//trim(fldname), ESMF_LOGMSG_INFO) call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=field, isPresent=isPresent, rc=rc) - !call ESMF_FieldBundleGet(fieldBundle,field=field, rc=rc) - !call ESMF_FieldBundleGet(fieldBundle, fieldCount=fieldCount, rc=rc) - ! Now for error checking we can put ... if (isPresent...) ! get field pointer @@ -637,17 +579,10 @@ subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) ! determine output array if (present(ungridded_index)) then - if (gridToFieldMap == 1) then - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr2d(n,ungridded_index) - end do - else if (gridToFieldMap == 2) then - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr2d(ungridded_index,n) - end do - end if + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + output(g) = fldptr2d(ungridded_index,n) + end do else do g = bounds%begg, bounds%endg n = g - bounds%begg + 1 @@ -725,24 +660,13 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index ! determine output array if (present(ungridded_index)) then - if (gridToFieldMap == 1) then - fldptr2d(:,ungridded_index) = 0._r8 - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - fldptr2d(n,ungridded_index) = input(g) - end do - if (present(minus)) then - fldptr2d(:,ungridded_index) = -fldptr2d(:,ungridded_index) - end if - else if (gridToFieldMap == 2) then - fldptr2d(ungridded_index,:) = 0._r8 - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - fldptr2d(ungridded_index,n) = input(g) - end do - if (present(minus)) then - fldptr2d(ungridded_index,:) = -fldptr2d(ungridded_index,:) - end if + fldptr2d(ungridded_index,:) = 0._r8 + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + fldptr2d(ungridded_index,n) = input(g) + end do + if (present(minus)) then + fldptr2d(ungridded_index,:) = -fldptr2d(ungridded_index,:) end if else fldptr1d(:) = 0._r8 From be7f7313b0e721a43e2e460abe4b79e77b377019 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 30 Nov 2019 18:35:47 -0700 Subject: [PATCH 190/556] new ctsm.config file to call ctsm's buildnml and updated README as well as Makefile --- lilac/atm_driver/Makefile | 13 +++---- lilac/atm_driver/README | 75 ++++++++++++++++++++++++++++++++++----- lilac/atm_driver/ctsm.cfg | 20 +++++++++++ 3 files changed, 94 insertions(+), 14 deletions(-) create mode 100644 lilac/atm_driver/ctsm.cfg diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index 58e9ea1fd0..220741e3a3 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -10,12 +10,13 @@ ESMFMKFILE = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.def ESMF_LIB_DIR = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default include $(ESMFMKFILE) -CASE_NAME = why01-g -CTSM_BLD_DIR = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf -MCT_LIB = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -SHR_LIB = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -SHR_INC = /glade/scratch/mvertens/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -CTSM_INC = $(CTSM_BLD_DIR)/clm/obj +BLD_DIR = /glade/scratch/mvertens/test_lilac/bld + +CTSM_BLD_DIR = $(BLD_DIR)/intel/mpt/debug/nothreads/mct/mct/esmf +MCT_LIB = $(BLD_DIR)/intel/mpt/debug/nothreads/mct/lib +SHR_LIB = $(BLD_DIR)/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib +SHR_INC = $(BLD_DIR)/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ +CTSM_INC = $(CTSM_BLD_DIR)/clm/obj FFLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free diff --git a/lilac/atm_driver/README b/lilac/atm_driver/README index 09b9e0d255..25b7bc0a54 100644 --- a/lilac/atm_driver/README +++ b/lilac/atm_driver/README @@ -1,14 +1,73 @@ -assume the ctsm code base is checked out in $CTSM_ROOTDIR +1) to build ctsm and lilac (these are now built together in a single +library and linked as part of generating the executable) -- to customize the generated namelist - edit the file - > $CTSM_ROOTDIR/lilac_config/lnd_input.py + > cd ../../ + > git clone https://github.com/mvertens/ctsm.git + > cd ctsm + > git checkout mvertens/lilac_cap + > ./manage_externals/checkout_externals -v + > cd cime/scripts + > ./create_newcase --case /glade/scratch/mvertens/test_lilac --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver mct + > cd /glade/scratch/mvertens/test_lilac -- to create the ctsm namelist FROM THIS DIRECTORY: - > $CTSM_ROOTDIR/lilac_config/buildnml + > ./xmlchange USE_ESMF_LIB=TRUE + > ./xmlchange DEBUG=TRUE -- this will now create the files lnd_in, drv_flds_in, and clm.input_data_list in this directory - THIS ONLY NEEDS TO BE DONE ONCE - to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory + > remove the following lines from env_mach_specific: + esmf_libs + + esmf-7.1.0r-defio-mpi-g + + + esmf-7.1.0r-defio-mpi-O + + + esmf-7.1.0r-ncdfio-uni-g + + + esmf-7.1.0r-ncdfio-uni-O + + + > remove the string comp_interface="nuopc" from the following lines + + + + + > make the following changes + + /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libO/Linux.intel.64.mpt.default/esmf.mk to + /glade/work/turuncu/ESMF/8.0.0b50/lib/libO/Linux.intel.64.mpt.default/esmf.mk + /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libg/Linux.intel.64.mpt.default/esmf.mk to + /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default/esmf.mk + + > set the following environment variables (***THIS IS CRITICAL to have the lilac code built as part of ctsm) + + export LILAC_MODE='on' + eport LILAC_SRC = (in this case ../lilac/lilac) + + > ./case.setup + > ./case.build + +2) To build the atm_driver executable on cheyenne - edit the Makefile to change BLD_DIR + + > make clean + > make atm_driver + +3) to generate the input namelists + + - to customize the generated namelist - edit the file ctsm.cfg (in this directory) + + - to create the ctsm namelist FROM THIS DIRECTORY: + assume the ctsm code base is checked out in $CTSM_ROOTDIR + > $CTSM_ROOTDIR/lilac_config/buildnml + + - this will now create the files lnd_in, drv_flds_in, and clm.input_data_list in this directory + THIS ONLY NEEDS TO BE DONE ONCE + to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory + +4) run the atm_driver on cheyenne + + > qsub cheyenne.sub diff --git a/lilac/atm_driver/ctsm.cfg b/lilac/atm_driver/ctsm.cfg new file mode 100644 index 0000000000..95764fb0bd --- /dev/null +++ b/lilac/atm_driver/ctsm.cfg @@ -0,0 +1,20 @@ +[buildnml_input] +clm_phys = clm5_0 +start_type = default +start_ymd = 20000101 +startfile_type = finidat +ignore = -ignore_ic_year +configuration = clm +structure = standard +ccsm_co2_ppmv = 367.0 +clm_co2_type = constant +clm_bldnml_opts = -bgc sp +use_case = 2000_control +lnd_tuning_mode = clm5_0_GSWP3v1 +spinup = off +gridmask = gx3v7 +lnd_grid = 4x5 +lnd_domain_file = domain.lnd.fv4x5_gx3v7.091218.nc +lnd_domain_path = /glade/p/cesmdata/cseg/inputdata/share/domains +din_loc_root = /glade/p/cesmdata/cseg/inputdata +clm_namelist_opts = "" From 9483cccda0220d0bdf97bf458dbe1c60d8263dcf Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 1 Dec 2019 09:29:03 -0700 Subject: [PATCH 191/556] bringing in lilac as an external to be easily built as part of the ctsm library --- Externals.cfg | 7 +++++ README.lilac | 75 ++++++++++++++++++++++++++++++++++++++++++++ cime_config/buildlib | 7 ++--- 3 files changed, 85 insertions(+), 4 deletions(-) create mode 100644 README.lilac diff --git a/Externals.cfg b/Externals.cfg index 36775f16fe..41e2deb264 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -4,6 +4,13 @@ protocol = externals_only externals = Externals_CLM.cfg required = True +[lilac] +local_path = . +protocol = git +repo_url = https://github.com/NCAR/lilac.git +branch = master +required = True + [cism] local_path = components/cism protocol = git diff --git a/README.lilac b/README.lilac new file mode 100644 index 0000000000..6473f603e6 --- /dev/null +++ b/README.lilac @@ -0,0 +1,75 @@ +1) set the following environment variables (***THIS IS CRITICAL to have the lilac code built as part of ctsm) + > export LILAC_MODE='on' + + +2) check out the code (ctsm and lilac are now bundled together) and built as one library + + SRC_ROOT is where tsm is checked out + + > git clone https://github.com/mvertens/ctsm.git + > cd ctsm (this is $SRCROOT) + > git checkout mvertens/lilac_cap + > ./manage_externals/checkout_externals -v + +3) build the ctsm/lilac library using a CIME case + + > cd $SRCROOT/cime/scripts + > ./create_newcase --case /glade/scratch/mvertens/test_lilac --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver mct + + > cd /glade/scratch/mvertens/test_lilac + > ./xmlchange USE_ESMF_LIB=TRUE + > ./xmlchange DEBUG=TRUE + + > remove the following lines from env_mach_specific: + + esmf_libs + + esmf-7.1.0r-defio-mpi-g + + + esmf-7.1.0r-defio-mpi-O + + + esmf-7.1.0r-ncdfio-uni-g + + + esmf-7.1.0r-ncdfio-uni-O + + + > remove the string comp_interface="nuopc" from the following lines + + + + + > make the following changes + + /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libO/Linux.intel.64.mpt.default/esmf.mk to + /glade/work/turuncu/ESMF/8.0.0b50/lib/libO/Linux.intel.64.mpt.default/esmf.mk + /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libg/Linux.intel.64.mpt.default/esmf.mk to + /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default/esmf.mk + + > ./case.setup + > ./case.build + +4) To build the atm_driver executable on cheyenne - edit the Makefile to change BLD_DIR + + > cd $SRCROOT/lilac/atm_driver + > make clean + > make atm_driver + +4) to generate the input namelists + + - to customize the generated namelist - edit the file ctsm.cfg (in this directory) + - to create the ctsm namelist FROM THIS DIRECTORY: + + > $SRC_ROOT/lilac_config/buildnml + + - this will now create the files lnd_in, drv_flds_in, and clm.input_data_list in this directory + THIS ONLY NEEDS TO BE DONE ONCE + to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory + +5) run the atm_driver on cheyenne + + > qsub cheyenne.sub + + diff --git a/cime_config/buildlib b/cime_config/buildlib index 9493767c0c..6b23d23b11 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -43,10 +43,9 @@ def _main_func(): gmake = case.get_value("GMAKE") lilac_mode = _get_osvar('LILAC_MODE', 'off') - print "DEBUG: lilac_mode is ",lilac_mode if lilac_mode == 'on': - lilac_src = _get_osvar('LILAC_SRC', None) - expect(lilac_src, "environment variable LILAC_SRC must be set") + ctsm_root = case.get_value("SRCROOT") + lilac_src = os.path.join(ctsm_root,"lilac","lilac") #------------------------------------------------------- # create Filepath file @@ -72,8 +71,8 @@ def _main_func(): if lilac_mode == 'off': paths.append(os.path.join(lnd_root,"src","cpl","mct")) else: - paths.append(os.path.join(lnd_root,"src","cpl","lilac")) paths.append(lilac_src) + paths.append(os.path.join(lnd_root,"src","cpl","lilac")) with open(filepath_file, "w") as filepath: filepath.write("\n".join(paths)) From 43a7b78946126326c1becbec8214944cf553b301 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 1 Dec 2019 10:23:52 -0700 Subject: [PATCH 192/556] moved lilac/ directory to src/ --- lilac/atm_driver/README | 38 +++++++++++++----------- lilac/{lilac => src}/.gitignore | 0 lilac/{lilac => src}/lilac_atmcap.F90 | 0 lilac/{lilac => src}/lilac_constants.F90 | 0 lilac/{lilac => src}/lilac_cpl.F90 | 10 +++++-- lilac/{lilac => src}/lilac_fields.F90 | 1 + lilac/{lilac => src}/lilac_history.F90 | 0 lilac/{lilac => src}/lilac_io.F90 | 0 lilac/{lilac => src}/lilac_methods.F90 | 0 lilac/{lilac => src}/lilac_mod.F90 | 0 lilac/{lilac => src}/lilac_time.F90 | 0 lilac/{lilac => src}/lilac_utils.F90 | 0 12 files changed, 29 insertions(+), 20 deletions(-) rename lilac/{lilac => src}/.gitignore (100%) rename lilac/{lilac => src}/lilac_atmcap.F90 (100%) rename lilac/{lilac => src}/lilac_constants.F90 (100%) rename lilac/{lilac => src}/lilac_cpl.F90 (98%) rename lilac/{lilac => src}/lilac_fields.F90 (97%) rename lilac/{lilac => src}/lilac_history.F90 (100%) rename lilac/{lilac => src}/lilac_io.F90 (100%) rename lilac/{lilac => src}/lilac_methods.F90 (100%) rename lilac/{lilac => src}/lilac_mod.F90 (100%) rename lilac/{lilac => src}/lilac_time.F90 (100%) rename lilac/{lilac => src}/lilac_utils.F90 (100%) diff --git a/lilac/atm_driver/README b/lilac/atm_driver/README index 25b7bc0a54..6473f603e6 100644 --- a/lilac/atm_driver/README +++ b/lilac/atm_driver/README @@ -1,15 +1,22 @@ -1) to build ctsm and lilac (these are now built together in a single -library and linked as part of generating the executable) +1) set the following environment variables (***THIS IS CRITICAL to have the lilac code built as part of ctsm) + > export LILAC_MODE='on' + + +2) check out the code (ctsm and lilac are now bundled together) and built as one library + + SRC_ROOT is where tsm is checked out - > cd ../../ > git clone https://github.com/mvertens/ctsm.git - > cd ctsm + > cd ctsm (this is $SRCROOT) > git checkout mvertens/lilac_cap > ./manage_externals/checkout_externals -v - > cd cime/scripts + +3) build the ctsm/lilac library using a CIME case + + > cd $SRCROOT/cime/scripts > ./create_newcase --case /glade/scratch/mvertens/test_lilac --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver mct - > cd /glade/scratch/mvertens/test_lilac + > cd /glade/scratch/mvertens/test_lilac > ./xmlchange USE_ESMF_LIB=TRUE > ./xmlchange DEBUG=TRUE @@ -34,39 +41,34 @@ library and linked as part of generating the executable) - > make the following changes + > make the following changes /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libO/Linux.intel.64.mpt.default/esmf.mk to /glade/work/turuncu/ESMF/8.0.0b50/lib/libO/Linux.intel.64.mpt.default/esmf.mk /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libg/Linux.intel.64.mpt.default/esmf.mk to /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default/esmf.mk - > set the following environment variables (***THIS IS CRITICAL to have the lilac code built as part of ctsm) - - export LILAC_MODE='on' - eport LILAC_SRC = (in this case ../lilac/lilac) - > ./case.setup > ./case.build -2) To build the atm_driver executable on cheyenne - edit the Makefile to change BLD_DIR +4) To build the atm_driver executable on cheyenne - edit the Makefile to change BLD_DIR + > cd $SRCROOT/lilac/atm_driver > make clean > make atm_driver -3) to generate the input namelists +4) to generate the input namelists - to customize the generated namelist - edit the file ctsm.cfg (in this directory) - - to create the ctsm namelist FROM THIS DIRECTORY: - assume the ctsm code base is checked out in $CTSM_ROOTDIR - > $CTSM_ROOTDIR/lilac_config/buildnml + + > $SRC_ROOT/lilac_config/buildnml - this will now create the files lnd_in, drv_flds_in, and clm.input_data_list in this directory THIS ONLY NEEDS TO BE DONE ONCE to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory -4) run the atm_driver on cheyenne +5) run the atm_driver on cheyenne > qsub cheyenne.sub diff --git a/lilac/lilac/.gitignore b/lilac/src/.gitignore similarity index 100% rename from lilac/lilac/.gitignore rename to lilac/src/.gitignore diff --git a/lilac/lilac/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 similarity index 100% rename from lilac/lilac/lilac_atmcap.F90 rename to lilac/src/lilac_atmcap.F90 diff --git a/lilac/lilac/lilac_constants.F90 b/lilac/src/lilac_constants.F90 similarity index 100% rename from lilac/lilac/lilac_constants.F90 rename to lilac/src/lilac_constants.F90 diff --git a/lilac/lilac/lilac_cpl.F90 b/lilac/src/lilac_cpl.F90 similarity index 98% rename from lilac/lilac/lilac_cpl.F90 rename to lilac/src/lilac_cpl.F90 index c28de3c7e3..1414c86528 100644 --- a/lilac/lilac/lilac_cpl.F90 +++ b/lilac/src/lilac_cpl.F90 @@ -7,6 +7,8 @@ module lilac_cpl !----------------------------------------------------------------------- use ESMF + use shr_sys_mod, only : shr_sys_abort + implicit none private @@ -157,7 +159,9 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) end if call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort('error in initializing cpl_atm2lnd') + end if call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) @@ -227,7 +231,9 @@ subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) end if call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call shr_sys_abort('error in initializing cpl_lnd2atm') + end if call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) diff --git a/lilac/lilac/lilac_fields.F90 b/lilac/src/lilac_fields.F90 similarity index 97% rename from lilac/lilac/lilac_fields.F90 rename to lilac/src/lilac_fields.F90 index c31f41a120..355e6f9a88 100644 --- a/lilac/lilac/lilac_fields.F90 +++ b/lilac/src/lilac_fields.F90 @@ -29,6 +29,7 @@ subroutine lilac_field_bundle_to_land(mesh, fieldbundle, rc) ! Add empty fields to field bundle do n = 1, size(atm2lnd) + write(6,*)'DEBUG: ',n, trim(atm2lnd(n)%fldname) call fldbundle_add(trim(atm2lnd(n)%fldname), mesh, fieldbundle, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/lilac/lilac/lilac_history.F90 b/lilac/src/lilac_history.F90 similarity index 100% rename from lilac/lilac/lilac_history.F90 rename to lilac/src/lilac_history.F90 diff --git a/lilac/lilac/lilac_io.F90 b/lilac/src/lilac_io.F90 similarity index 100% rename from lilac/lilac/lilac_io.F90 rename to lilac/src/lilac_io.F90 diff --git a/lilac/lilac/lilac_methods.F90 b/lilac/src/lilac_methods.F90 similarity index 100% rename from lilac/lilac/lilac_methods.F90 rename to lilac/src/lilac_methods.F90 diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/src/lilac_mod.F90 similarity index 100% rename from lilac/lilac/lilac_mod.F90 rename to lilac/src/lilac_mod.F90 diff --git a/lilac/lilac/lilac_time.F90 b/lilac/src/lilac_time.F90 similarity index 100% rename from lilac/lilac/lilac_time.F90 rename to lilac/src/lilac_time.F90 diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/src/lilac_utils.F90 similarity index 100% rename from lilac/lilac/lilac_utils.F90 rename to lilac/src/lilac_utils.F90 From c0c0e80d9aa5662762996d9a7dcb48ce1eceb440 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 1 Dec 2019 10:34:10 -0700 Subject: [PATCH 193/556] cleanup of minor problems --- README.lilac | 57 +++++++-------- cime_config/buildlib | 2 +- src/cpl/lilac/lnd_comp_esmf.F90 | 123 ++++++++++++++------------------ 3 files changed, 77 insertions(+), 105 deletions(-) diff --git a/README.lilac b/README.lilac index 6473f603e6..615ca71149 100644 --- a/README.lilac +++ b/README.lilac @@ -1,10 +1,9 @@ 1) set the following environment variables (***THIS IS CRITICAL to have the lilac code built as part of ctsm) > export LILAC_MODE='on' - 2) check out the code (ctsm and lilac are now bundled together) and built as one library - SRC_ROOT is where tsm is checked out + SRC_ROOT is where ctsm is checked out > git clone https://github.com/mvertens/ctsm.git > cd ctsm (this is $SRCROOT) @@ -15,41 +14,33 @@ > cd $SRCROOT/cime/scripts > ./create_newcase --case /glade/scratch/mvertens/test_lilac --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver mct - > cd /glade/scratch/mvertens/test_lilac > ./xmlchange USE_ESMF_LIB=TRUE > ./xmlchange DEBUG=TRUE - > remove the following lines from env_mach_specific: - - esmf_libs - - esmf-7.1.0r-defio-mpi-g - - - esmf-7.1.0r-defio-mpi-O - - - esmf-7.1.0r-ncdfio-uni-g - - - esmf-7.1.0r-ncdfio-uni-O - - - > remove the string comp_interface="nuopc" from the following lines - - - - - > make the following changes - - /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libO/Linux.intel.64.mpt.default/esmf.mk to - /glade/work/turuncu/ESMF/8.0.0b50/lib/libO/Linux.intel.64.mpt.default/esmf.mk - /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libg/Linux.intel.64.mpt.default/esmf.mk to - /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default/esmf.mk - - > ./case.setup - > ./case.build + esmf_libs + + esmf-7.1.0r-defio-mpi-g + + + esmf-7.1.0r-defio-mpi-O + + + esmf-7.1.0r-ncdfio-uni-g + + + esmf-7.1.0r-ncdfio-uni-O + + > remove the string comp_interface="nuopc" from the following lines + + + > make the following changes + /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libO/Linux.intel.64.mpt.default/esmf.mk to + /glade/work/turuncu/ESMF/8.0.0b50/lib/libO/Linux.intel.64.mpt.default/esmf.mk + /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libg/Linux.intel.64.mpt.default/esmf.mk to + /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default/esmf.mk + > ./case.setup + > ./case.build 4) To build the atm_driver executable on cheyenne - edit the Makefile to change BLD_DIR diff --git a/cime_config/buildlib b/cime_config/buildlib index 6b23d23b11..55c5254c8d 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -45,7 +45,7 @@ def _main_func(): lilac_mode = _get_osvar('LILAC_MODE', 'off') if lilac_mode == 'on': ctsm_root = case.get_value("SRCROOT") - lilac_src = os.path.join(ctsm_root,"lilac","lilac") + lilac_src = os.path.join(ctsm_root,"lilac","src") #------------------------------------------------------- # create Filepath file diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 96846d3d1f..c66e02d4f8 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -10,6 +10,7 @@ module lnd_comp_esmf use mpi , only : MPI_BCAST, MPI_CHARACTER use mct_mod , only : mct_world_init use perf_mod , only : t_startf, t_stopf, t_barrierf + use lilac_fields , only : lilac_field_bundle_to_land, lilac_field_bundle_from_land ! cime share code use shr_pio_mod , only : shr_pio_init2 @@ -414,88 +415,68 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Create import state (only assume input from atm - not rof and glc) !-------------------------------- - ! First create an empty field bundle + ! NOTE: currently this must be the same list as in lilac_init_atm2lnd + + ! create an empty field bundle c2l_fb = ESMF_FieldBundleCreate ( name='c2l_fb', rc=rc) - ! Now add fields on lnd_mesh to this field bundle - call fldbundle_add( 'Sa_z' , c2l_fb,rc) !1 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_topo' , c2l_fb,rc) !2 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_u' , c2l_fb,rc) !3 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_v' , c2l_fb,rc) !4 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_ptem' , c2l_fb,rc) !5 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_pbot' , c2l_fb,rc) !6 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_tbot' , c2l_fb,rc) !7 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_shum' , c2l_fb,rc) !8 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_lwdn' , c2l_fb,rc) !9 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_rainc' , c2l_fb,rc) !10 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_rainl' , c2l_fb,rc) !11 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_snowc' , c2l_fb,rc) !12 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_snowl' , c2l_fb,rc) !13 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swndr' , c2l_fb,rc) !14 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) !15 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) !16 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swvdf' , c2l_fb,rc) !17 - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call lilac_field_bundle_to_land(lnd_mesh, c2l_fb, rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb/), rc=rc) + ! Now add fields on lnd_mesh to this field bundle + call fldbundle_add( 'Sa_z' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_topo' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_u' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_v' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_ptem' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_pbot' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_tbot' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_shum' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_lwdn' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_rainc' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_rainl' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_snowc' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_snowl' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swndr' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swvdf' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add the field bundle to the export state + call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb/)) !-------------------------------- ! Create export state !-------------------------------- - ! First create an empty field bundle + ! NOTE: currently this must be the same list as in lilac_init_lnd2atm + + ! Create an empty field bundle l2c_fb = ESMF_FieldBundleCreate(name='l2c_fb', rc=rc) - ! Now add fields on lnd_mesh to this field bundle - call fldbundle_add( 'Sl_lfrin' , l2c_fb,rc) !1 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_t' , l2c_fb,rc) !2 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_tref' , l2c_fb,rc) !3 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_qref' , l2c_fb,rc) !4 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_avsdr' , l2c_fb,rc) !5 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_anidr' , l2c_fb,rc) !6 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_avsdf' , l2c_fb,rc) !7 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_anidf' , l2c_fb,rc) !8 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_snowh' , l2c_fb,rc) !9 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Fall_u10' , l2c_fb,rc) !10 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Fall_fv' , l2c_fb,rc) !11 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Fall_ram1' , l2c_fb,rc) !12 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call fldbundle_add( 'Fall_taux' , l2c_fb,rc) !10 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call fldbundle_add( 'Fall_lwup' , l2c_fb,rc) !14 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call fldbundle_add( 'Fall_evap' , l2c_fb,rc) !15 - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call fldbundle_add( 'Fall_swnet' , l2c_fb,rc) !16 - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call lilac_field_bundle_from_land(lnd_mesh, l2c_fb, rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Now add fields on lnd_mesh to this field bundle + call fldbundle_add( 'Sl_lfrin' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sl_t' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sl_tref' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sl_qref' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sl_avsdr' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sl_anidr' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sl_avsdf' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sl_anidf' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sl_snowh' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Fall_u10' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Fall_fv' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Fall_ram1' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Fall_lwup' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Fall_taux' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Fall_tauy' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Fall_evap' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Fall_swnet' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Add the field bundle to the state call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb/), rc=rc) !-------------------------------- From ab9f287d4e7f6fac5b2dcbdf7fe3329041ed8067 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 1 Dec 2019 11:23:33 -0700 Subject: [PATCH 194/556] fixed buildlib problems and added nuopc driver for future capability --- .gitignore | 1 + Externals.cfg | 3 ++- Externals_cime.cfg | 9 +++++++++ 3 files changed, 12 insertions(+), 1 deletion(-) create mode 100644 Externals_cime.cfg diff --git a/.gitignore b/.gitignore index 4a5672d970..9a16cf5eb1 100644 --- a/.gitignore +++ b/.gitignore @@ -5,6 +5,7 @@ manage_externals.log /tools/PTCLM/ /cime/ /components/ +/lilac # ignore svn directories **/.svn/** diff --git a/Externals.cfg b/Externals.cfg index 41e2deb264..72d1e54b5c 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -5,7 +5,7 @@ externals = Externals_CLM.cfg required = True [lilac] -local_path = . +local_path = lilac protocol = git repo_url = https://github.com/NCAR/lilac.git branch = master @@ -38,6 +38,7 @@ local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime tag = branch_tags/cime5.8.3_chint17-05 +externals = ../Externals_cime.cfg required = True [externals_description] diff --git a/Externals_cime.cfg b/Externals_cime.cfg new file mode 100644 index 0000000000..d4e79f0364 --- /dev/null +++ b/Externals_cime.cfg @@ -0,0 +1,9 @@ +[cmeps] +tag = 181ff1e +protocol = git +repo_url = https://github.com/ESCOMP/CMEPS.git +local_path = src/drivers/nuopc/ +required = True + +[externals_description] +schema_version = 1.0.0 From 21984974ee94f1df14b8f1da957e5feb2ae9c4e6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 1 Dec 2019 11:30:11 -0700 Subject: [PATCH 195/556] bug fix --- lilac_config/buildnml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 9f0e0e82b0..6cbaa419c1 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -224,10 +224,6 @@ def buildnml(rundir, bldnmldir): if rc > 0: raise Exception("Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) - # remove temporary files in bldnmldir - os.remove(os.path.join(bldnmldir, "lnd_in")) - os.remove(os.path.join(bldnmldir, "clm.input_data_list")) - # remove temporary files in rundir os.remove(os.path.join(rundir, "config_cache.xml")) os.remove(os.path.join(rundir, "env_lilac.xml")) From 7757b05499f74d5944e726d0028d41cbbf622143 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 1 Dec 2019 14:32:34 -0700 Subject: [PATCH 196/556] updates for new stream capability --- lilac/src/lilac_atmaero.F90 | 237 ++++++++++++++++++++++++++++++++++++ lilac/src/lilac_mod.F90 | 7 ++ 2 files changed, 244 insertions(+) create mode 100644 lilac/src/lilac_atmaero.F90 diff --git a/lilac/src/lilac_atmaero.F90 b/lilac/src/lilac_atmaero.F90 new file mode 100644 index 0000000000..df5741a8a2 --- /dev/null +++ b/lilac/src/lilac_atmaero.F90 @@ -0,0 +1,237 @@ +module lilac_atmaero + + !----------------------------------------------------------------------- + ! Contains methods for reading in atmosphere aerosal data + ! This will be done on the CTSM grid with the CTSM decomposition + ! (after the redistribution from atm-> lnd) + !----------------------------------------------------------------------- + + use ESMF + + ! share code uses + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl, CS => shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : shr_log_errMsg + use shr_mpi_mod , only : shr_mpi_bcast + use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create + use shr_strdata_mod , only : shr_strdata_print, shr_strdata_advance + use shr_cal_mod , only : shr_cal_ymd2date + use shr_pio_mod , only : shr_pio_getiotype + use mct_mod , only : mct_avect_indexra, mct_ggrid + + ! ctsm uses + use ncdio_pio , only : pio_subsystem + use decompMod , only : bounds_type, get_proc_bounds, gsmap_lnd_gdc2glo + use domainMod , only : ldomain + use spmdMod , only : mpicom, masterproc, comp_id + use ndepStreamMod , only : clm_domain_mct + use clm_time_manager , only : get_calendar + + ! lilac share + use lilac_methods , only : chkerr + + implicit none + private + + public :: lilac_atmaero_init ! initialize stream data type sdat + public :: lilac_atmaero_interp ! interpolates between two years of ndep file data + + ! module data + type(shr_strdata_type) :: sdat ! input data stream + + character(*),parameter :: u_file_u = & + __FILE__ + +!============================================================================== +contains +!============================================================================== + + subroutine lilac_atmaero_init() + + ! ---------------------------------------- + ! Initialize data stream information. + ! ---------------------------------------- + + ! local variables + integer :: nunit + integer :: ierr ! namelist i/o error flag + type(mct_ggrid) :: domain_mct ! domain information + character(len=cl) :: stream_fldfilename_atmaero ! name of input stream file + character(len=CL) :: mapalgo = 'bilinear' ! type of 2d mapping + character(len=CS) :: taxmode = 'extend' ! time extrapolation + character(len=CL) :: fldlistFile ! name of fields in input stream file + character(len=CL) :: fldlistModel ! name of fields in data stream code + integer :: stream_year_first_atmaero ! first year in stream to use + integer :: stream_year_last_atmaero ! last year in stream to use + integer :: model_year_align_atmaero ! align stream_year_first with model year + type(bounds_type) :: bounds + !----------------------------------------------------------------------- + + namelist /atmaero_stream/ & + stream_year_first_atmaero, & + stream_year_last_atmaero, & + model_year_align_atmaero, & + stream_fldfilename_atmaero + + ! default values for namelist + stream_year_first_atmaero = 1 ! first year in stream to use + stream_year_last_atmaero = 1 ! last year in stream to use + model_year_align_atmaero = 1 ! align stream_year_first_atmaero with this model year + stream_fldFileName_atmaero = ' ' + + ! Read namelist + if (masterproc) then + open(newunit=nunit, file='lilac_in', status='old', iostat=ierr ) + call shr_nl_find_group_name(nunit, 'atmaero_stream', status=ierr) + if (ierr == 0) then + read(nunit, atmaero_stream, iostat=ierr) + if (ierr /= 0) then + call shr_sys_abort(' ERROR reading namelist '//shr_log_errMsg(u_file_u, __LINE__)) + end if + else + call shr_sys_abort(' ERROR finding namelist '//shr_log_errMsg(u_file_u, __LINE__)) + end if + close(nunit) + endif + + call shr_mpi_bcast(stream_year_first_atmaero , mpicom) + call shr_mpi_bcast(stream_year_last_atmaero , mpicom) + call shr_mpi_bcast(model_year_align_atmaero , mpicom) + call shr_mpi_bcast(stream_fldfilename_atmaero, mpicom) + + if (masterproc) then + print *, ' ' + print *, 'atmaero stream settings:' + print *, ' stream_year_first_atmaero = ',stream_year_first_atmaero + print *, ' stream_year_last_atmaero = ',stream_year_last_atmaero + print *, ' model_year_align_atmaero = ',model_year_align_atmaero + print *, ' stream_fldFileName_atmaero = ',stream_fldFileName_atmaero + print *, ' ' + endif + + ! Create the mct domain + call get_proc_bounds(bounds) + call clm_domain_mct (bounds, domain_mct) + + ! Create the field list for these urbantv fields...use in shr_strdata_create + fldlistFile = 'BCDEPWET:BCPHODRY:BCPHIDRY:' + fldlistFile = trim(fldlistFile) // 'OCDEPWET:OCPHIDRY:OCPHODRY:DSTX01WD:' + fldlistFile = trim(fldlistFile) // 'DSTX01DD:DSTX02WD:DSTX02DD:DSTX03WD:' + fldlistFile = trim(fldlistFile) // 'DSTX03DD:DSTX04WD:DSTX04DD' + + fldlistModel = 'bcphiwet:bcphodry:bcphidry:' + fldlistModel = trim(fldlistModel) // 'ocphiwet:ocphidry:ocphodry:' + fldlistModel = trim(fldlistModel) // 'dstwet1:dstdry1:dstwet2:dstdry2' + fldlistModel = trim(fldlistModel) // 'dstwet3:dstdry3:dstwet4:dstdry4' + + call shr_strdata_create(sdat,& + name = "atmaero", & + pio_subsystem = pio_subsystem, & + pio_iotype = shr_pio_getiotype(compid= 1), & + mpicom = mpicom, & + compid = comp_id, & + gsmap = gsmap_lnd_gdc2glo, & + ggrid = domain_mct, & + nxg = ldomain%ni, & + nyg = ldomain%nj, & + yearFirst = stream_year_first_atmaero, & + yearLast = stream_year_last_atmaero, & + yearAlign = model_year_align_atmaero, & + offset = 0, & + domFilePath = '', & + domfilename = trim(stream_fldfilename_atmaero), & + domTvarName = 'time', & + domXvarName = 'lon' , & + domYvarName = 'lat' , & + domAreaName = 'area', & + domMaskName = 'mask', & + filePath = '', & + filename = (/trim(stream_fldfilename_atmaero)/), & + fldListFile = trim(fldlistFile), & + fldListModel = trim(fldlistModel), & + fillalgo = 'none', & + mapalgo = mapalgo, & + calendar = get_calendar(), & + taxmode = taxmode ) + + if (masterproc) then + call shr_strdata_print(sdat,'ATMAERO data') + endif + + end subroutine lilac_atmaero_init + + !================================================================ + + subroutine lilac_atmaero_interp(c2l_fb, clock, rc) + + ! input/output variables + type(ESMF_FieldBundle) :: c2l_fb + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(ESMF_Time) :: currTime + integer :: yy, mm, dd, sec, curr_ymd + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + + call shr_strdata_advance(sdat, curr_ymd, sec, mpicom, 'atmaero') + + ! Set field bundle data + call set_fieldbundle_data('Faxa_bcphidry' , c2l_fb, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_bcphodry' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_bcphiwet' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_ocphidry' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_ocphodry' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_ocphiwet' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstwet1' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstdry1' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstwet2' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstdry2' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstwet3' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstdry3' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstwet4' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstdry4' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine lilac_atmaero_interp + + !============================================================================== + + subroutine set_fieldbundle_data(fldname, fieldbundle, rc) + + ! input/output data + character(len=*) , intent(in) :: fldname + type(ESMF_FieldBundle) , intent(inout) :: fieldbundle + integer , intent(out) :: rc + + ! local data + type(ESMF_field) :: lfield + integer :: n, nfld, indx + real(r8), pointer :: fldptr1d(:) + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(fieldBundle, fieldName=trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + nfld = mct_avect_indexra(sdat%avs(1),trim(fldname)) + do indx = 1, size(fldptr1d) + fldptr1d(n)= sdat%avs(1)%rAttr(nfld,indx) + end do + + end subroutine set_fieldbundle_data + +end module lilac_atmaero diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index b3febbfae7..ec3f43c320 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -54,6 +54,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register use lilac_atmcap , only : lilac_atmos_register use lnd_comp_esmf , only : lnd_register !ctsm routine + use lilac_atmaero , only : lilac_atmaero_init use shr_pio_mod , only : shr_pio_init1 use shr_sys_mod , only : shr_sys_abort @@ -332,6 +333,12 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & call lilac_io_init() call ESMF_LogWrite(subname//"initialized lilac_io ...", ESMF_LOGMSG_INFO) + !------------------------------------------------------------------------- + ! Initialize atmaero stream data (using share strearm capability from CIME) + !------------------------------------------------------------------------- + + call lilac_atmaero_init() + end subroutine lilac_init !======================================================================== From aa296fc3b00fd39b5586d2cf48aad7cd2a600717 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 1 Dec 2019 14:33:14 -0700 Subject: [PATCH 197/556] new stream capability in lilac_in --- lilac_config/lilac_in | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lilac_config/lilac_in b/lilac_config/lilac_in index 6b217cc324..198c8aea6e 100644 --- a/lilac_config/lilac_in +++ b/lilac_config/lilac_in @@ -1,6 +1,11 @@ &lnd_mesh_inparm lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' / +&atmaero_stream + stream_fldfilename_atmaero='/glade/p/cesmdata/cseg/inputdata/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_WACCM.ensmean_monthly_hist_1849-2015_0.9x1.25_CMIP6_c180926.nc' + stream_year_first_atmaero = 2000 + stream_year_last_atmaero = 2000 +/ &papi_inparm papi_ctr1_str = "PAPI_FP_OPS" papi_ctr2_str = "PAPI_NO_CTR" From 64a5ac9abfb6efed3b7a67fd313b950ec1629d75 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 2 Dec 2019 16:24:46 -0700 Subject: [PATCH 198/556] receiving prescribed aerosols from lilac --- src/cpl/lilac/lnd_comp_esmf.F90 | 55 +++++--- src/cpl/lilac/lnd_import_export.F90 | 193 ++++++++++++---------------- 2 files changed, 115 insertions(+), 133 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index c66e02d4f8..6e4628a82e 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -10,7 +10,7 @@ module lnd_comp_esmf use mpi , only : MPI_BCAST, MPI_CHARACTER use mct_mod , only : mct_world_init use perf_mod , only : t_startf, t_stopf, t_barrierf - use lilac_fields , only : lilac_field_bundle_to_land, lilac_field_bundle_from_land + use lilac_fields , only : lilac_field_bundle_to_land, lilac_field_bundle_from_land ! cime share code use shr_pio_mod , only : shr_pio_init2 @@ -158,8 +158,8 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! for pio_init2 and mct type(ESMF_VM) :: vm - integer :: mpicom_vm - integer :: ncomps = 1 ! for mct + integer :: mpicom_vm + integer :: ncomps = 1 ! for mct integer, pointer :: mycomms(:) ! for mct integer, pointer :: myids(:) ! for mct integer :: compids(1) = (/1/) ! for both mct and pio_init2 - array with component ids @@ -424,23 +424,38 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Now add fields on lnd_mesh to this field bundle - call fldbundle_add( 'Sa_z' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_topo' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_u' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_v' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_ptem' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_pbot' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_tbot' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_shum' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_lwdn' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_rainc' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_rainl' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_snowc' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_snowl' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swndr' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swvdf' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_z' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_topo' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_u' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_v' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_ptem' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_pbot' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_tbot' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Sa_shum' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_lwdn' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_rainc' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_rainl' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_snowc' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_snowl' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swndr' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_swvdf' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fldbundle_add( 'Faxa_bcphidry' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_bcphodry' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_bcphiwet' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_ocphidry' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_ocphodry' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_ocphiwet' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_dstwet1' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_dstdry1' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_dstwet2' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_dstdry2' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_dstwet3' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_dstdry3' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_dstwet4' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add( 'Faxa_dstdry4' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return ! add the field bundle to the export state call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb/)) diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index e310dbd4c8..0510eeff56 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -53,7 +53,7 @@ module lnd_import_export subroutine import_fields( gcomp, bounds, rc) !--------------------------------------------------------------------------- - ! Convert the input data from the mediator to the land model + ! Convert the input data from the lilac to the land model !--------------------------------------------------------------------------- ! input/output variabes @@ -176,69 +176,45 @@ subroutine import_fields( gcomp, bounds, rc) ! ! Atmosphere prognostic/prescribed aerosol fields - ! ! bcphidry - ! call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,1), & - ! ungridded_index=1, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ! bcphodry - ! call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,2), & - ! ungridded_index=2, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ! bcphiwet - ! call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,3), & - ! ungridded_index=3, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! ! ocphidry - ! call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,4), & - ! ungridded_index=1, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ! bcphodry - ! call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,5), & - ! ungridded_index=2, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ! bcphiwet - ! call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,6), & - ! ungridded_index=3, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,7), & - ! ungridded_index=1, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,8), & - ! ungridded_index=1, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,9), & - ! ungridded_index=2, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,10), & - ! ungridded_index=2, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_bcphidry', bounds, output=atm2lnd_inst%forc_aer_grc(:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_bcphodry', bounds, output=atm2lnd_inst%forc_aer_grc(:,2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_bcphiwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,3), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,11), & - ! ungridded_index=3, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,12), & - ! ungridded_index=3, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_ocphidry', bounds, output=atm2lnd_inst%forc_aer_grc(:,4), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_ocphodry', bounds, output=atm2lnd_inst%forc_aer_grc(:,5), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_ocphiwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,6), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,13), & - ! ungridded_index=4, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,14), & - ! ungridded_index=4, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_dstwet1', bounds, output=atm2lnd_inst%forc_aer_grc(:,7), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_dstdry1', bounds, output=atm2lnd_inst%forc_aer_grc(:,8), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_dstwet2', bounds, output=atm2lnd_inst%forc_aer_grc(:,9), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_dstdry2', bounds, output=atm2lnd_inst%forc_aer_grc(:,10), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_dstwet3', bounds, output=atm2lnd_inst%forc_aer_grc(:,11), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_dstdry3', bounds, output=atm2lnd_inst%forc_aer_grc(:,12), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_dstwet4', bounds, output=atm2lnd_inst%forc_aer_grc(:,13), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Faxa_dstdry4', bounds, output=atm2lnd_inst%forc_aer_grc(:,14), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! call state_getimport(importState, 'Sa_methane', bounds, output=atm2lnd_inst%forc_pch4_grc, rc=rc ) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ! The mediator is sending ndep in units if kgN/m2/s - and ctsm uses units of gN/m2/sec - ! ! so the following conversion needs to happen - - ! call state_getimport(importState, 'Faxa_nhx', bounds, output=forc_nhx, ungridded_index=1, rc=rc ) + ! The lilac is sending ndep in units if kgN/m2/s - and ctsm uses units of gN/m2/sec + ! so the following conversion needs to happen + ! call state_getimport(importState, 'Faxa_nhx', bounds, output=forc_nhx, rc=rc ) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport(importState, 'Faxa_noy', bounds, output=forc_noy, ungridded_index=2, rc=rc ) + ! call state_getimport(importState, 'Faxa_noy', bounds, output=forc_noy, rc=rc ) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! do g = begg,endg ! atm2lnd_inst%forc_ndep_grc(g) = (forc_nhx(g) + forc_noy(g))*1000._r8 @@ -359,16 +335,12 @@ subroutine export_fields(gcomp, bounds, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ----------------------- - ! output to mediator + ! output to atm ! ----------------------- call state_setexport(exportState, 'Sl_lfrin', bounds, input=ldomain%frac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ----------------------- - ! output to atm - ! ----------------------- - call state_setexport(exportState, 'Sl_t', bounds, input=lnd2atm_inst%t_rad_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -417,20 +389,13 @@ subroutine export_fields(gcomp, bounds, rc) call state_setexport(exportState, 'Fall_swnet', bounds, input=lnd2atm_inst%fsa_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,1), & - minus=.true., ungridded_index=1, rc=rc) + call state_setexport(exportState, 'Fall_flxdst1', bounds, input=lnd2atm_inst%flxdst_grc(:,1), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,2), & - minus=.true., ungridded_index=2, rc=rc) + call state_setexport(exportState, 'Fall_flxdst2', bounds, input=lnd2atm_inst%flxdst_grc(:,2), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,3), & - minus=.true., ungridded_index=3, rc=rc) + call state_setexport(exportState, 'Fall_flxdst3', bounds, input=lnd2atm_inst%flxdst_grc(:,3), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,4), & - minus=.true., ungridded_index=4, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_methane', bounds, input=lnd2atm_inst%flux_ch4_grc, minus=.true., rc=rc) + call state_setexport(exportState, 'Fall_flxdst4', bounds, input=lnd2atm_inst%flxdst_grc(:,4), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_setexport(exportState, 'Sl_ram1', bounds, input=lnd2atm_inst%ram1_grc, rc=rc) @@ -439,33 +404,35 @@ subroutine export_fields(gcomp, bounds, rc) call state_setexport(exportState, 'Sl_fv', bounds, input=lnd2atm_inst%fv_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_soilw', bounds, input=water_inst%waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! methanem + ! call state_setexport(exportState, 'Fall_methane', bounds, input=lnd2atm_inst%flux_ch4_grc, minus=.true., rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! soil water + ! call state_setexport(exportState, 'Sl_soilw', bounds, input=water_inst%waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! dry dep velocities - do num = 1, drydep_nflds - call state_setexport(exportState, 'Sl_ddvel', bounds, input=lnd2atm_inst%ddvel_grc(:,num), & - ungridded_index=num, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do + ! do num = 1, drydep_nflds + ! call state_setexport(exportState, 'Sl_ddvel', bounds, input=lnd2atm_inst%ddvel_grc(:,num), ungridded_index=num, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! end do ! MEGAN VOC emis fluxes - do num = 1, shr_megan_mechcomps_n - call state_setexport(exportState, 'Fall_voc', bounds, input=lnd2atm_inst%flxvoc_grc(:,num), minus=.true., & - ungridded_index=num, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do + ! do num = 1, shr_megan_mechcomps_n + ! call state_setexport(exportState, 'Fall_voc', bounds, input=lnd2atm_inst%flxvoc_grc(:,num), minus=.true., ungridded_index=num, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! end do ! fire emis fluxes - do num = 1, emis_nflds - call state_setexport(exportState, 'Fall_fire', bounds, input=lnd2atm_inst%fireflx_grc(:,num), minus=.true., & - ungridded_index=num, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - if (emis_nflds > 0) then - call state_setexport(exportState, 'Sl_fztopo', bounds, input=lnd2atm_inst%fireztop_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + ! do num = 1, emis_nflds + ! call state_setexport(exportState, 'Fall_fire', bounds, input=lnd2atm_inst%fireflx_grc(:,num), minus=.true., ungridded_index=num, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! end do + ! if (emis_nflds > 0) then + ! call state_setexport(exportState, 'Sl_fztopo', bounds, input=lnd2atm_inst%fireztop_grc, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! endif ! sign convention is positive downward with hierarchy of atm/glc/lnd/rof/ice/ocn. ! i.e. water sent from land to rof is positive @@ -478,28 +445,28 @@ subroutine export_fields(gcomp, bounds, rc) ! array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) ! end do - call state_setexport(exportState, 'Flrl_rofsur', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_setexport(exportState, 'Flrl_rofsur', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain - do g = bounds%begg,bounds%endg - array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & - water_inst%waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) - end do - call state_setexport(exportState, 'Flrl_rofsub', bounds, input=array, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain + ! do g = bounds%begg,bounds%endg + ! array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & + ! water_inst%waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) + ! end do + ! call state_setexport(exportState, 'Flrl_rofsub', bounds, input=array, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! qgwl sent individually to coupler - call state_setexport(exportState, 'Flrl_rofgwl', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! ! qgwl sent individually to coupler + ! call state_setexport(exportState, 'Flrl_rofgwl', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ice sent individually to coupler - call state_setexport(exportState, 'Flrl_rofi', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! ! ice sent individually to coupler + ! call state_setexport(exportState, 'Flrl_rofi', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! irrigation flux to be removed from main channel storage (negative) - call state_setexport(exportState, 'Flrl_irrig', bounds, input=water_inst%waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! ! irrigation flux to be removed from main channel storage (negative) + ! call state_setexport(exportState, 'Flrl_irrig', bounds, input=water_inst%waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine export_fields @@ -789,7 +756,7 @@ subroutine check_for_nans(array, fname, begg) integer :: i !------------------------------------------------------------------------------- - ! Check if any input from mediator or output to mediator is NaN + ! Check if any input from lilac or output to lilac is NaN if (any(isnan(array))) then write(iulog,*) '# of NaNs = ', count(isnan(array)) From 16134a7c5b3413547c13f872d901f805ba576751 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 2 Dec 2019 16:26:53 -0700 Subject: [PATCH 199/556] added new prescribed aerosol functionality --- lilac/src/lilac_atmaero.F90 | 226 ++++++++++++++++++++++++++---------- lilac/src/lilac_atmcap.F90 | 84 +++++++------- lilac/src/lilac_cpl.F90 | 4 +- lilac/src/lilac_fields.F90 | 1 - lilac/src/lilac_mod.F90 | 184 ++++++++++++++--------------- lilac/src/lilac_utils.F90 | 119 +++++++++++-------- 6 files changed, 368 insertions(+), 250 deletions(-) diff --git a/lilac/src/lilac_atmaero.F90 b/lilac/src/lilac_atmaero.F90 index df5741a8a2..be31be5105 100644 --- a/lilac/src/lilac_atmaero.F90 +++ b/lilac/src/lilac_atmaero.F90 @@ -1,8 +1,8 @@ module lilac_atmaero !----------------------------------------------------------------------- - ! Contains methods for reading in atmosphere aerosal data - ! This will be done on the CTSM grid with the CTSM decomposition + ! Contains methods for reading in atmosphere aerosal data + ! This will be done on the CTSM grid with the CTSM decomposition ! (after the redistribution from atm-> lnd) !----------------------------------------------------------------------- @@ -18,24 +18,25 @@ module lilac_atmaero use shr_strdata_mod , only : shr_strdata_print, shr_strdata_advance use shr_cal_mod , only : shr_cal_ymd2date use shr_pio_mod , only : shr_pio_getiotype - use mct_mod , only : mct_avect_indexra, mct_ggrid + use mct_mod , only : mct_avect_indexra, mct_gsmap, mct_ggrid + use mct_mod , only : mct_gsmap_init, mct_gsmap_orderedpoints + use mct_mod , only : mct_ggrid_init, mct_ggrid_importIAttr, mct_ggrid_importRattr ! ctsm uses use ncdio_pio , only : pio_subsystem - use decompMod , only : bounds_type, get_proc_bounds, gsmap_lnd_gdc2glo use domainMod , only : ldomain - use spmdMod , only : mpicom, masterproc, comp_id - use ndepStreamMod , only : clm_domain_mct use clm_time_manager , only : get_calendar - ! lilac share + ! lilac uses + use lilac_utils , only : gindex_atm use lilac_methods , only : chkerr + use lilac_methods , only : lilac_methods_FB_getFieldN implicit none private - public :: lilac_atmaero_init ! initialize stream data type sdat - public :: lilac_atmaero_interp ! interpolates between two years of ndep file data + public :: lilac_atmaero_init ! initialize stream data type sdat + public :: lilac_atmaero_interp ! interpolates between two years of ndep file data ! module data type(shr_strdata_type) :: sdat ! input data stream @@ -47,25 +48,46 @@ module lilac_atmaero contains !============================================================================== - subroutine lilac_atmaero_init() + subroutine lilac_atmaero_init(atm2lnd_a_state, rc) ! ---------------------------------------- ! Initialize data stream information. ! ---------------------------------------- + ! input/output variables + type(ESMF_State) , intent(inout) :: atm2lnd_a_state + integer , intent(out) :: rc + ! local variables - integer :: nunit - integer :: ierr ! namelist i/o error flag - type(mct_ggrid) :: domain_mct ! domain information - character(len=cl) :: stream_fldfilename_atmaero ! name of input stream file - character(len=CL) :: mapalgo = 'bilinear' ! type of 2d mapping - character(len=CS) :: taxmode = 'extend' ! time extrapolation - character(len=CL) :: fldlistFile ! name of fields in input stream file - character(len=CL) :: fldlistModel ! name of fields in data stream code - integer :: stream_year_first_atmaero ! first year in stream to use - integer :: stream_year_last_atmaero ! last year in stream to use - integer :: model_year_align_atmaero ! align stream_year_first with model year - type(bounds_type) :: bounds + type(ESMF_VM) :: vm + type(ESMF_Mesh) :: lmesh + type(ESMF_FieldBundle) :: lfieldbundle + type(ESMF_Field) :: lfield + type(mct_ggrid) :: ggrid_atm ! domain information + type(mct_gsmap) :: gsmap_atm ! decompositoin info + integer :: mytask ! mpi task number + integer :: mpicom ! mpi communicator + integer :: n,i,j ! index + integer :: lsize ! local size + integer :: gsize ! global size + integer :: nunit ! namelist input unit + integer :: ierr ! namelist i/o error flag + character(len=cl) :: stream_fldfilename_atmaero ! name of input stream file + character(len=CL) :: mapalgo = 'bilinear' ! type of 2d mapping + character(len=CS) :: taxmode = 'extend' ! time extrapolation + character(len=CL) :: fldlistFile ! name of fields in input stream file + character(len=CL) :: fldlistModel ! name of fields in data stream code + integer :: stream_year_first_atmaero ! first year in stream to use + integer :: stream_year_last_atmaero ! last year in stream to use + integer :: model_year_align_atmaero ! align stream_year_first with model year + integer :: spatialDim + integer :: numOwnedElements + real(r8), pointer :: ownedElemCoords(:) + real(r8), pointer :: mesh_lons(:) + real(r8), pointer :: mesh_lats(:) + real(r8), pointer :: mesh_areas(:) + real(r8), pointer :: rdata(:) + integer , pointer :: idata(:) !----------------------------------------------------------------------- namelist /atmaero_stream/ & @@ -80,8 +102,14 @@ subroutine lilac_atmaero_init() model_year_align_atmaero = 1 ! align stream_year_first_atmaero with this model year stream_fldFileName_atmaero = ' ' + ! get mytask and mpicom + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_VMGet(vm, localPet=mytask, mpiCommunicator=mpicom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! Read namelist - if (masterproc) then + if (mytask == 0) then open(newunit=nunit, file='lilac_in', status='old', iostat=ierr ) call shr_nl_find_group_name(nunit, 'atmaero_stream', status=ierr) if (ierr == 0) then @@ -100,7 +128,7 @@ subroutine lilac_atmaero_init() call shr_mpi_bcast(model_year_align_atmaero , mpicom) call shr_mpi_bcast(stream_fldfilename_atmaero, mpicom) - if (masterproc) then + if (mytask == 0) then print *, ' ' print *, 'atmaero stream settings:' print *, ' stream_year_first_atmaero = ',stream_year_first_atmaero @@ -110,30 +138,85 @@ subroutine lilac_atmaero_init() print *, ' ' endif - ! Create the mct domain - call get_proc_bounds(bounds) - call clm_domain_mct (bounds, domain_mct) - - ! Create the field list for these urbantv fields...use in shr_strdata_create + ! ------------------------------ + ! create the field list for these urbantv fields...use in shr_strdata_create + ! ------------------------------ fldlistFile = 'BCDEPWET:BCPHODRY:BCPHIDRY:' fldlistFile = trim(fldlistFile) // 'OCDEPWET:OCPHIDRY:OCPHODRY:DSTX01WD:' fldlistFile = trim(fldlistFile) // 'DSTX01DD:DSTX02WD:DSTX02DD:DSTX03WD:' fldlistFile = trim(fldlistFile) // 'DSTX03DD:DSTX04WD:DSTX04DD' - fldlistModel = 'bcphiwet:bcphodry:bcphidry:' - fldlistModel = trim(fldlistModel) // 'ocphiwet:ocphidry:ocphodry:' - fldlistModel = trim(fldlistModel) // 'dstwet1:dstdry1:dstwet2:dstdry2' - fldlistModel = trim(fldlistModel) // 'dstwet3:dstdry3:dstwet4:dstdry4' + fldlistModel = 'Faxa_bcphiwet:Faxa_bcphodry:Faxa_bcphidry:' + fldlistModel = trim(fldlistModel) // 'Faxa_ocphiwet:Faxa_ocphidry:Faxa_ocphodry:' + fldlistModel = trim(fldlistModel) // 'Faxa_dstwet1:Faxa_dstdry1:Faxa_dstwet2:Faxa_dstdry2:' + fldlistModel = trim(fldlistModel) // 'Faxa_dstwet3:Faxa_dstdry3:Faxa_dstwet4:Faxa_dstdry4' + + ! ------------------------------ + ! create the mct gsmap + ! ------------------------------ + lsize = size(gindex_atm) + gsize = ldomain%ni * ldomain%nj + call mct_gsmap_init( gsmap_atm, gindex_atm, mpicom, 1, lsize, gsize ) + + ! ------------------------------ + ! obtain mesh lats, lons and areas + ! ------------------------------ + call ESMF_StateGet(atm2lnd_a_state, 'a2c_fb', lfieldbundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call lilac_methods_FB_getFieldN(lfieldbundle, fieldnum=1, field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(lmesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (numOwnedElements /= lsize) then + call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') + end if + allocate(ownedElemCoords(spatialDim*numOwnedElements)) + + call ESMF_MeshGet(lmesh, ownedElemCoords=ownedElemCoords, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(mesh_lons(numOwnedElements)) + allocate(mesh_lats(numOwnedElements)) + allocate(mesh_areas(numOwnedElements)) + do n = 1,numOwnedElements + mesh_lons(n) = ownedElemCoords(2*n-1) + mesh_lats(n) = ownedElemCoords(2*n) + mesh_areas(n) = 1.e36 ! hard-wire for now for testing + end do + + ! ------------------------------ + ! create the mct ggrid + ! ------------------------------ + call mct_ggrid_init( ggrid=ggrid_atm, CoordChars='lat:lon:hgt', OtherChars='area:aream:mask:frac', lsize=lsize) + call mct_gsmap_orderedpoints(gsmap_atm, mytask, idata) + call mct_gGrid_importIAttr(ggrid_atm,'GlobGridNum', idata, lsize) + call mct_gGrid_importRattr(ggrid_atm,"lon" , mesh_lons , lsize) + call mct_gGrid_importRattr(ggrid_atm,"lat" , mesh_lats , lsize) + call mct_gGrid_importRattr(ggrid_atm,"area", mesh_areas, lsize) + allocate(rdata(lsize)) + rdata(:) = 1._R8 + call mct_gGrid_importRattr(ggrid_atm,"mask", rdata, lsize) + deallocate(mesh_lons, mesh_lats, mesh_areas, rdata) + + ! ------------------------------ + ! create the stream data sdat + ! ------------------------------ call shr_strdata_create(sdat,& name = "atmaero", & pio_subsystem = pio_subsystem, & pio_iotype = shr_pio_getiotype(compid= 1), & mpicom = mpicom, & - compid = comp_id, & - gsmap = gsmap_lnd_gdc2glo, & - ggrid = domain_mct, & - nxg = ldomain%ni, & + compid = 1, & + gsmap = gsmap_atm, & + ggrid = ggrid_atm, & + nxg = ldomain%ni, & nyg = ldomain%nj, & yearFirst = stream_year_first_atmaero, & yearLast = stream_year_last_atmaero, & @@ -155,7 +238,7 @@ subroutine lilac_atmaero_init() calendar = get_calendar(), & taxmode = taxmode ) - if (masterproc) then + if (mytask == 0) then call shr_strdata_print(sdat,'ATMAERO data') endif @@ -163,20 +246,32 @@ end subroutine lilac_atmaero_init !================================================================ - subroutine lilac_atmaero_interp(c2l_fb, clock, rc) + subroutine lilac_atmaero_interp(atm2lnd_a_state, clock, rc) ! input/output variables - type(ESMF_FieldBundle) :: c2l_fb + type(ESMF_State) :: atm2lnd_a_state type(ESMF_Clock) :: clock - integer, intent(out) :: rc + integer, intent(out) :: rc ! local variables - type(ESMF_Time) :: currTime - integer :: yy, mm, dd, sec, curr_ymd + type(ESMF_VM) :: vm + integer :: mpicom ! mpi communicator + integer :: mytask ! mpi task number + type(ESMF_FieldBundle) :: lfieldbundle + type(ESMF_Time) :: currTime + integer :: yy, mm, dd, sec, curr_ymd + character(len=*), parameter :: subname='lilac_atmaero: [lilac_atmaero_interp]' !----------------------------------------------------------------------- rc = ESMF_SUCCESS + ! get mytask and mpicom + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_VMGet(vm, localPet=mytask, mpiCommunicator=mpicom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! get current time info call ESMF_ClockGet( clock, currTime=currTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -184,23 +279,27 @@ subroutine lilac_atmaero_interp(c2l_fb, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + ! advance the streams call shr_strdata_advance(sdat, curr_ymd, sec, mpicom, 'atmaero') - ! Set field bundle data - call set_fieldbundle_data('Faxa_bcphidry' , c2l_fb, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_bcphodry' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_bcphiwet' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_ocphidry' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_ocphodry' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_ocphiwet' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstwet1' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstdry1' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstwet2' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstdry2' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstwet3' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstdry3' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstwet4' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstdry4' , c2l_fb, rc=rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! set field bundle data + call ESMF_StateGet(atm2lnd_a_state, "a2c_fb", lfieldbundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call set_fieldbundle_data('Faxa_bcphidry' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_bcphodry' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_bcphiwet' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_ocphidry' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_ocphodry' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_ocphiwet' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstwet1' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstdry1' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstwet2' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstdry2' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstwet3' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstdry3' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstwet4' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + call set_fieldbundle_data('Faxa_dstdry4' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine lilac_atmaero_interp @@ -215,7 +314,7 @@ subroutine set_fieldbundle_data(fldname, fieldbundle, rc) ! local data type(ESMF_field) :: lfield - integer :: n, nfld, indx + integer :: nfld, i real(r8), pointer :: fldptr1d(:) !----------------------------------------------------------------------- @@ -227,9 +326,14 @@ subroutine set_fieldbundle_data(fldname, fieldbundle, rc) call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! error check + if (size(fldptr1d) /= size(sdat%avs(1)%rAttr, dim=2)) then + call shr_sys_abort("ERROR: size of fldptr1d and sdat%avs(1)%rattr dim2 are not equal") + end if + nfld = mct_avect_indexra(sdat%avs(1),trim(fldname)) - do indx = 1, size(fldptr1d) - fldptr1d(n)= sdat%avs(1)%rAttr(nfld,indx) + do i = 1, size(fldptr1d) + fldptr1d(i)= sdat%avs(1)%rAttr(nfld,i) end do end subroutine set_fieldbundle_data diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index 2909dfdbab..d03db5a0b2 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -5,9 +5,10 @@ module lilac_atmcap ! This is a dummy atmosphere cap for setting up lilac structure. !----------------------------------------------------------------------- - ! !USES use ESMF - use lilac_utils , only : atm2lnd, lnd2atm, gindex_atm, atm_mesh_filename + use lilac_utils , only : atm2lnd, lnd2atm, gindex_atm, atm_mesh_filename + use lilac_methods, only : chkerr + implicit none public :: lilac_atmos_register @@ -15,6 +16,9 @@ module lilac_atmcap integer :: mytask integer, parameter :: debug = 0 ! internal debug level + character(*),parameter :: u_FILE_u = & + __FILE__ + !======================================================================== contains !======================================================================== @@ -30,9 +34,9 @@ subroutine lilac_atmos_register (comp, rc) !------------------------------------------------------------------------- call ESMF_VMGetGlobal(vm=vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mytask == 0) then print *, "in user register routine" @@ -43,13 +47,13 @@ subroutine lilac_atmos_register (comp, rc) ! Set the entry points for standard ESMF Component methods call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=lilac_atmos_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=lilac_atmos_run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=lilac_atmos_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine lilac_atmos_register @@ -85,11 +89,14 @@ subroutine lilac_atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! the atm_mesh_filename that were then set as module variables in lilac_utils atm_distgrid = ESMF_DistGridCreate (arbSeqIndexList=gindex_atm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! TODO: the addUserArea failed for the 4x5 grid - need to have a more robust approach - unless the area will simply be ignored for now? + ! atm_mesh = ESMF_MeshCreate(filename=trim(atm_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + ! elementDistGrid=atm_distgrid, addUserArea=.true., rc=rc) atm_mesh = ESMF_MeshCreate(filename=trim(atm_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & elementDistGrid=atm_distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//"Mesh for atmosphere is created for "//trim(atm_mesh_filename), ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -97,67 +104,64 @@ subroutine lilac_atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) end if !------------------------------------------------------------------------- - ! Atmosphere to Coupler (land) Fields -- atmos --> land - ! - Create empty field bundle -- a2c_fb - ! - Create Fields and add them to field bundle - ! - Add a2c_fb to state (atm2lnd_a_state) + ! Create a2c_fb field bundle and add to atm2lnd_a_state !------------------------------------------------------------------------- - ! Create individual fields and add to field bundle -- a2c + ! create empty field bundle "a2c_fb" a2c_fb = ESMF_FieldBundleCreate(name="a2c_fb", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create fields and add to field bundle do n = 1, size(atm2lnd) field = ESMF_FieldCreate(atm_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & name=trim(atm2lnd(n)%fldname), farrayPtr=atm2lnd(n)%dataptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end do + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//"fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) - if (mytask == 0) then - print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" - end if + if (debug > 0) then + call ESMF_FieldPrint(field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do - ! Add field bundle to state + ! add field bundle to atm2lnd_a_state call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_LogWrite(subname//"atm2lnd_a_state is filled with dummy_var field bundle!", ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//"lilac a2c_fb fieldbundle created and added to atm2lnd_a_state", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "!atm2lnd_a_state is filld with dummy_var field bundle!" + print *, "lilac a2c_fb fieldbundle created and added to atm2lnd_a_state" end if !------------------------------------------------------------------------- - ! Coupler (land) to Atmosphere Fields -- c2a - ! - Create Field Bundle -- c2a_fb for because we are in atmos - ! - Create Fields and add them to field bundle - ! - Add c2a_fb to state (lnd2atm_a_state) + ! Create c2a_fb field bundle and add to lnd2atm_a_state + ! Also add nextsw_cday attributes !------------------------------------------------------------------------- + ! create empty field bundle "c2a_fb" c2a_fb = ESMF_FieldBundleCreate (name="c2a_fb", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create fields and add to field bundle do n = 1, size(lnd2atm) field = ESMF_FieldCreate(atm_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & name=trim(lnd2atm(n)%fldname), farrayPtr=lnd2atm(n)%dataptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (debug > 0) then call ESMF_FieldPrint(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end do - call ESMF_LogWrite(subname//"c2a fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) - ! Add field bundle to state + ! add field bundle to lnd2atm_a_state call ESMF_StateAdd(lnd2atm_a_state, (/c2a_fb/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//"lilac c2a_fb fieldbundle is done and added to lnd2atm_a_state", ESMF_LOGMSG_INFO) ! Set Attributes needed by land call ESMF_AttributeSet(lnd2atm_a_state, name="nextsw_cday", value=11, rc=rc) ! TODO: mv what in the world is this??? @@ -203,10 +207,10 @@ subroutine lilac_atmos_final(comp, importState, exportState, clock, rc) rc = ESMF_SUCCESS call ESMF_StateGet(importState, "c2a_fb", import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_StateGet(exportState, "a2c_fb", export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleDestroy(import_fieldbundle, rc=rc) call ESMF_FieldBundleDestroy(export_fieldbundle, rc=rc) diff --git a/lilac/src/lilac_cpl.F90 b/lilac/src/lilac_cpl.F90 index 1414c86528..db15c4d60d 100644 --- a/lilac/src/lilac_cpl.F90 +++ b/lilac/src/lilac_cpl.F90 @@ -260,11 +260,11 @@ subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) end if call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - call ESMF_StateGet(importState, trim("a2c_fb"), import_fieldbundle, rc=rc) + call ESMF_StateGet(importState, "a2c_fb", import_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//" got a2c fieldbundle!", ESMF_LOGMSG_INFO) - call ESMF_StateGet(exportState, trim("c2l_fb"), export_fieldbundle, rc=rc) + call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(subname//" got c2l fieldbundle!", ESMF_LOGMSG_INFO) diff --git a/lilac/src/lilac_fields.F90 b/lilac/src/lilac_fields.F90 index 355e6f9a88..c31f41a120 100644 --- a/lilac/src/lilac_fields.F90 +++ b/lilac/src/lilac_fields.F90 @@ -29,7 +29,6 @@ subroutine lilac_field_bundle_to_land(mesh, fieldbundle, rc) ! Add empty fields to field bundle do n = 1, size(atm2lnd) - write(6,*)'DEBUG: ',n, trim(atm2lnd(n)%fldname) call fldbundle_add(trim(atm2lnd(n)%fldname), mesh, fieldbundle, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index ec3f43c320..3da662f34f 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -8,6 +8,25 @@ module lilac_mod !----------------------------------------------------------------------- use ESMF + + ! lilac routines + use lilac_io , only : lilac_io_init + use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd + use lilac_utils , only : gindex_atm, atm_mesh_filename + use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register + use lilac_atmcap , only : lilac_atmos_register + use lilac_atmaero , only : lilac_atmaero_init + use lilac_atmaero , only : lilac_atmaero_interp + use lilac_history , only : lilac_history_write + use lilac_methods , only : chkerr + + ! shr code routines + use shr_pio_mod , only : shr_pio_init1 + use shr_sys_mod , only : shr_sys_abort + + ! ctsm routines + use lnd_comp_esmf , only : lnd_register ! ctsm routine + implicit none public :: lilac_init @@ -22,8 +41,8 @@ module lilac_mod type(ESMF_CplComp) :: cpl_lnd2atm_comp ! States - type(ESMF_State) :: atm2lnd_l_state, atm2lnd_a_state - type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state + type(ESMF_State) :: atm2lnd_a_state, atm2lnd_l_state + type(ESMF_State) :: lnd2atm_l_state, lnd2atm_a_state ! Clock, TimeInterval, and Times type(ESMF_Clock) :: lilac_clock @@ -35,6 +54,9 @@ module lilac_mod integer :: mytask + character(*), parameter :: u_FILE_u = & + __FILE__ + !======================================================================== contains !======================================================================== @@ -48,23 +70,13 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! This is called by the host atmosphere ! -------------------------------------------------------------------------------- - use lilac_io , only : lilac_io_init - use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd - use lilac_utils , only : gindex_atm, atm_mesh_filename - use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register - use lilac_atmcap , only : lilac_atmos_register - use lnd_comp_esmf , only : lnd_register !ctsm routine - use lilac_atmaero , only : lilac_atmaero_init - use shr_pio_mod , only : shr_pio_init1 - use shr_sys_mod , only : shr_sys_abort - ! input/output variables character(len=*) , intent(in) :: atm_mesh_file integer , intent(in) :: atm_global_index(:) real , intent(in) :: atm_lons(:) real , intent(in) :: atm_lats(:) character(len=*) , intent(in) :: atm_calendar - integer , intent(in) :: atm_timestep + integer , intent(in) :: atm_timestep integer , intent(in) :: atm_start_year !(yyyy) integer , intent(in) :: atm_start_mon !(mm) integer , intent(in) :: atm_start_day @@ -86,7 +98,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & integer :: rc character(len=ESMF_MAXSTR) :: cname !components or cpl names integer :: ierr - integer :: mpic ! mpi communicator + integer :: mpic ! mpi communicator integer :: n, i integer :: fileunit integer, parameter :: debug = 1 !-- internal debug level @@ -102,8 +114,8 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! TODO: cannot assume that the calendar is always gregorian unless CTSM assumes this as well ! Need to coordinate the calendar info between lilac and the host component - call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, logappendflag=.false., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, logappendflag=.false., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogSet(flush=.true.) @@ -117,9 +129,9 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! Initialize pio (needed by CTSM) - TODO: this should be done within CTSM not here call ESMF_VMGetGlobal(vm=vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=mytask, mpiCommunicator=mpic, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_pio_init1(ncomps=1, nlfilename="lilac_in", Global_Comm=mpic) @@ -135,7 +147,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! Initialize atm_mesh_filename atm_mesh_filename = atm_mesh_file - ! Initialize datatypes atm2lnd and lnd2atm + ! Initialize datatypes atm2lnd and lnd2atm ! This must be done BEFORE the component initialization call lilac_init_atm2lnd(lsize) call lilac_init_lnd2atm(lsize) @@ -145,7 +157,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & !------------------------------------------------------------------------- cname = " LILAC atm cap " atm_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac atmcap initialization') call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, trim(subname) // "lilac atm cap gridded component created" @@ -156,7 +168,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & !------------------------------------------------------------------------- cname = " CTSM " lnd_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac ctsm initialization') call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, trim(subname) // " ctsm gridded component created" @@ -167,7 +179,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & !------------------------------------------------------------------------- cname = "Coupler from atmosphere to land" cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_a2l initialization') call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, trim(subname) // " coupler component (atmosphere to land) created" @@ -178,7 +190,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & !------------------------------------------------------------------------- cname = "Coupler from land to atmosphere" cpl_lnd2atm_comp = ESMF_CplCompCreate(name=cname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_l2a initialization') call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, trim(subname) // " coupler component (land to atmosphere) created" @@ -188,7 +200,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! Register section -- set services -- atmos_cap !------------------------------------------------------------------------- call ESMF_GridCompSetServices(atm_gcomp, userRoutine=lilac_atmos_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('atm_gcomp register failure') call ESMF_LogWrite(subname//" atmos SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, trim(subname) // " lilac atm cap setservices finished" @@ -198,7 +210,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! Register section -- set services -- land cap !------------------------------------------------------------------------- call ESMF_GridCompSetServices(lnd_gcomp, userRoutine=lnd_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('lnd_gcomp register failure') call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, trim(subname) // " CTSM setservices finished" @@ -208,7 +220,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! Register section -- set services -- coupler atmosphere to land !------------------------------------------------------------------------- call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_atm2lnd_comp register failure') call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, trim(subname) // " coupler from atmosphere to land setservices finished" @@ -218,7 +230,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! Register section -- set services -- coupler land to atmosphere !------------------------------------------------------------------------- call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_lnd2atm_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2atm_comp register failure') call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, trim(subname) // " coupler from land to atmosphere setservices finished" @@ -236,41 +248,37 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! TODO: add supported calendars here end if - call ESMF_TimeIntervalSet(TimeStep, s=atm_timestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TimeIntervalSet(TimeStep, s=atm_timestep, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeSet(StartTime, yy=atm_start_year, mm=atm_start_mon, dd=atm_start_day , s=atm_start_secs, & calendar=lilac_calendar, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeSet(StopTime , yy=atm_stop_year , mm=atm_stop_mon , dd=atm_stop_day , s=atm_stop_secs , & calendar=lilac_calendar, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return lilac_clock = ESMF_ClockCreate(name='lilac_clock', TimeStep=TimeStep, startTime=StartTime, & RefTime=StartTime, stopTime=stopTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (mytask == 0) then print *, trim(subname) // "---------------------------------------" call ESMF_ClockPrint (lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_CalendarPrint (lilac_calendar , rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return print *, trim(subname) // "---------------------------------------" end if ! Add a restart alarm to the clock lilac_restart_alarm = ESMF_AlarmCreate(lilac_clock, ringTime=StopTime, name='lilac_restart_alarm', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort('error in initializing restart alarm') - end if + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing restart alarm') ! Add a stop alarm to the clock lilac_stop_alarm = ESMF_AlarmCreate(lilac_clock, ringTime=StopTime, name='lilac_stop_alarm', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort('error in initializing stop alarm') - end if + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing stop alarm') ! ------------------------------------------------------------------------- ! Initialze lilac_atm gridded component @@ -278,15 +286,14 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! between components. (these are module variables) ! ------------------------------------------------------------------------- - atm2lnd_a_state = ESMF_StateCreate(name='atm_state_on_atm_mesh', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - lnd2atm_a_state = ESMF_StateCreate(name='lnd_state_on_lnd_mesh', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + atm2lnd_a_state = ESMF_StateCreate(name='state_from_atm_on_atm_mesh', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + lnd2atm_a_state = ESMF_StateCreate(name='state_from_land_on_atm_mesh', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompInitialize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in initializing atmcap") - end if + call ESMF_GridCompInitialize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing atmcap") call ESMF_LogWrite(subname//"lilac_atm gridded component initialized", ESMF_LOGMSG_INFO) ! ------------------------------------------------------------------------- @@ -295,31 +302,28 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! between components. (these are module variables) ! ------------------------------------------------------------------------- - atm2lnd_l_state = ESMF_StateCreate(name='atm_state_on_lnd_mesh', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - lnd2atm_l_state = ESMF_StateCreate(name='lnd_state_on_atm_mesh', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + atm2lnd_l_state = ESMF_StateCreate(name='state_from_atm_on_land_mesh', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + lnd2atm_l_state = ESMF_StateCreate(name='state_from_land_on_land_mesh', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompInitialize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in initializing ctsm") - end if + call ESMF_GridCompInitialize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing ctsm") call ESMF_LogWrite(subname//"CTSM gridded component initialized", ESMF_LOGMSG_INFO) ! ------------------------------------------------------------------------- ! Initialze LILAC coupler components ! ------------------------------------------------------------------------- - call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in initializing cpl_lnd2atm coupler component") - end if + call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_atm2lnd component") call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) - call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in initializing cpl_atm2lnd coupler component") - end if + call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -337,7 +341,8 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! Initialize atmaero stream data (using share strearm capability from CIME) !------------------------------------------------------------------------- - call lilac_atmaero_init() + call lilac_atmaero_init(atm2lnd_a_state, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing lilac_atmaero_init") end subroutine lilac_init @@ -345,9 +350,6 @@ end subroutine lilac_init subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) - use shr_sys_mod , only : shr_sys_abort - use lilac_history, only : lilac_history_write - ! input/output variables logical, intent(in) :: restart_alarm_is_ringing logical, intent(in) :: stop_alarm_is_ringing @@ -369,45 +371,39 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) ! Set the clock restart alarm if restart_alarm_ringing is true if (restart_alarm_is_ringing) then call ESMF_AlarmRingerOn(lilac_restart_alarm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in running lilac atm_cap") - end if + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") end if ! Set the clock stop alarm if stop_alarm_ringing is true if (stop_alarm_is_ringing) then call ESMF_AlarmRingerOn(lilac_stop_alarm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in running lilac atm_cap") - end if + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") end if - ! Run lilac atmcap + ! Run lilac atmcap - update the atm2lnd_a_state call ESMF_LogWrite(subname//"running lilac atmos_cap", ESMF_LOGMSG_INFO) if (mytask == 0) print *, "Running atmos_cap gridded component , rc =", rc call ESMF_GridCompRun(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, & clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in running lilac atm_cap") - end if + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") + + ! Update prescribed aerosols atm2lnd_a_state + call lilac_atmaero_interp(atm2lnd_a_state, lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac_atmaero_interp") ! Run cpl_atm2lnd call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) print *, "Running coupler component..... cpl_atm2lnd_comp" call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, & clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in running cpl_atm2lnd") - end if + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_atm2lnd") ! Run ctsm call ESMF_LogWrite(subname//"running ctsm", ESMF_LOGMSG_INFO) if (mytask == 0) print *, "Running ctsm" call ESMF_GridCompRun(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, & clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in running ctsm") - end if + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") ! Run cpl_lnd2atm call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) @@ -416,22 +412,16 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) end if call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, & clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in cpl_lnd2atm") - end if + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in cpl_lnd2atm") ! Write out history output call lilac_history_write(atm2lnd_a_state, atm2lnd_l_state, lnd2atm_l_state, lnd2atm_a_state, & lilac_clock, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in history write") - end if + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in history write") ! Advance the time at the end of the time step call ESMF_ClockAdvance(lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort("lilac error in advancing time step") - end if + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in advancing time step") call ESMF_LogWrite(subname//"time is icremented now... (ClockAdvance)", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, "time is icremented now... (ClockAdvance) , rc =", rc @@ -462,7 +452,7 @@ subroutine lilac_final( ) ! Gridded Component Finalizing! --- atmosphere !------------------------------------------------------------------------- call ESMF_GridCompFinalize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp is running", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, "Finalizing atmos_cap gridded component , rc =", rc @@ -472,7 +462,7 @@ subroutine lilac_final( ) ! Coupler component Finalizing --- coupler atmos to land !------------------------------------------------------------------------- call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc @@ -482,7 +472,7 @@ subroutine lilac_final( ) ! Gridded Component Finalizing! --- land !------------------------------------------------------------------------- call ESMF_GridCompFinalize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp is running", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, "Finalizing lnd_cap gridded component , rc =", rc @@ -492,7 +482,7 @@ subroutine lilac_final( ) ! Coupler component Finalizing --- coupler land to atmos !------------------------------------------------------------------------- call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=lilac_clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, "Finalizing coupler component..... cpl_lnd2atm_comp , rc =", rc diff --git a/lilac/src/lilac_utils.F90 b/lilac/src/lilac_utils.F90 index 08877ffb51..f83245d6f9 100644 --- a/lilac/src/lilac_utils.F90 +++ b/lilac/src/lilac_utils.F90 @@ -1,6 +1,21 @@ module lilac_utils - ! NOTE: the following cannot depend on any esmf objects - since it will be used by the host atmosphere + ! *********************************************************************** + ! NOTE: THE FOLLOWING CANNOT DEPEND ON ANY ESMF OBJECTS + ! since it will be used by the host atmosphere + ! This is the ONLY lilac routine that is required to be ESMF independent + ! + ! THE HOST ATMOSPHERE IS RESPONSIBLE for calling lilac_init() and in turn + ! lilac_init() calls the initialization routines for atm2lnd and lnd2atm + ! + ! the host atm init call will be + ! call lilac_init() + ! the host atm run phase will be + ! call lilac_atm2lnd(fldname, data1d) + ! call lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) + ! call lilac_lnd2atm(fldname, data1d) + ! + ! *********************************************************************** implicit none private @@ -13,7 +28,7 @@ module lilac_utils ! Global index space info for atm data integer, public, allocatable :: gindex_atm (:) - ! Mesh file to be read in by lilac_atm + ! Mesh file to be read in by lilac_atm character(len=256), public :: atm_mesh_filename ! Mesh file to be read in by ctsm @@ -24,7 +39,7 @@ module lilac_utils real*8, pointer :: dataptr(:) character(len=64) :: units logical :: provided_by_atm - logical :: required_fr_atm + logical :: required_fr_atm end type atm2lnd_type type(atm2lnd_type), pointer, public :: atm2lnd(:) @@ -39,44 +54,50 @@ module lilac_utils contains !======================================================================== - ! *** NOTE - THE HOST ATMOSPHERE IS RESPONSIBLE for calling - ! lilac_init that then calls the initialization routines for atm2lnd and lnd2atm - - ! host atm init call will simply be - ! call lilac_init() - - ! host atm run phase will be - ! call lilac_atm2lnd(fldname, data1d) - subroutine lilac_init_atm2lnd(lsize) integer, intent(in) :: lsize integer :: n - ! TODO: how is the atm going to specify which fields are not provided = + ! TODO: how is the atm going to specify which fields are not provided = ! should it pass an array of character strings or a colon deliminited set of fields ! to specify the fields it will not provide - and then these are checked against those fields - call atm2lnd_add_fld (atm2lnd, fldname='Sa_z' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_topo' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_u' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_v' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_ptem' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_pbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_tbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_shum' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_lwdn' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainc' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainl' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowc' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowl' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndr' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdr' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndf' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdf' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_z' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_topo' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_u' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_v' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_ptem' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_pbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_tbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Sa_shum' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_lwdn' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainc' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainl' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowc' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowl' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndr' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdr' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndf' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdf' , units='unknown', required_fr_atm=.true. , lsize=lsize) + + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet1' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry1' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet2' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry2' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet3' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry3' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet4' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry4' , units='unknown', required_fr_atm=.true. , lsize=lsize) ! TODO: optional fields - if these are uncommented then need to make sure that they are also appear in the lnd ! import state - ! CRITICAL the fields in the export state from lilac_atmcap MUST match the fields in the import state to the land + ! CRITICAL the fields in the export state from lilac_atmcap MUST match the fields in the import state to the land ! this is not being checked currently and msut be !call atm2lnd_add_fld (atm2lnd, fldname='Sa_methane' , units='unknown', required_fr_atm=.false. , lsize=lsize) !call atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcph' , units='unknown', required_fr_atm=.false. , lsize=lsize) @@ -88,29 +109,29 @@ subroutine lilac_init_atm2lnd(lsize) end do end subroutine lilac_init_atm2lnd -!======================================================================== + !======================================================================== subroutine lilac_init_lnd2atm(lsize) integer, intent(in) :: lsize integer :: n call lnd2atm_add_fld (lnd2atm, fldname='Sl_lfrin' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_t' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_tref' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_qref' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdr' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_anidr' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdf' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_anidf' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_snowh' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_u10' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_fv' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_ram1' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Fall_lwup' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Fall_taux' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Fall_tauy' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Fall_evap' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Fall_swnet', units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_t' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_tref' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_qref' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdr' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_anidr' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdf' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_anidf' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_snowh' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_u10' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_fv' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Sl_ram1' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Fall_lwup' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Fall_taux' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Fall_tauy' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Fall_evap' , units='unknown', lsize=lsize) + call lnd2atm_add_fld (lnd2atm, fldname='Fall_swnet', units='unknown', lsize=lsize) ! now add dataptr memory for all of the fields do n = 1,size(lnd2atm) @@ -159,7 +180,7 @@ subroutine lilac_atm2lnd_check() ! if there are fields that the atmosphere does not provide but that are required - then abort do n = 1,size(atm2lnd) if (atm2lnd(n)%required_fr_atm .and. (.not. atm2lnd(n)%provided_by_atm)) then - ! call abort or provide default values? + ! call abort or provide default values? else if (.not. atm2lnd(n)%provided_by_atm) then ! create default values end if From 35971908b5f99d49a5665659396e8955525829f6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 2 Dec 2019 17:30:27 -0700 Subject: [PATCH 200/556] new approach to consistency in lilac/clm fields --- lilac/src/lilac_fields.F90 | 87 --------------- lilac/src/lilac_utils.F90 | 216 +++++++++++++++++++++++++------------ 2 files changed, 147 insertions(+), 156 deletions(-) delete mode 100644 lilac/src/lilac_fields.F90 diff --git a/lilac/src/lilac_fields.F90 b/lilac/src/lilac_fields.F90 deleted file mode 100644 index c31f41a120..0000000000 --- a/lilac/src/lilac_fields.F90 +++ /dev/null @@ -1,87 +0,0 @@ -module lilac_fields - - ! This module is used by both CTSM and the lilac atmcap to ensure that the field bundles - ! exchanged between components are identical - - use ESMF - use lilac_methods, only : chkerr - use lilac_utils , only : atm2lnd, lnd2atm - - implicit none - public - - character(*),parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine lilac_field_bundle_to_land(mesh, fieldbundle, rc) - - type(ESMF_Mesh) :: mesh - type(ESMF_FieldBundle) :: fieldbundle - integer, intent(out) :: rc - - integer :: n - - rc = ESMF_SUCCESS - - ! Add empty fields to field bundle - do n = 1, size(atm2lnd) - call fldbundle_add(trim(atm2lnd(n)%fldname), mesh, fieldbundle, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - - end subroutine lilac_field_bundle_to_land - - !=============================================================================== - - subroutine lilac_field_bundle_from_land(mesh, fieldbundle, rc) - - type(ESMF_Mesh) :: mesh - type(ESMF_FieldBundle) :: fieldbundle - integer, intent(out) :: rc - - integer :: n - - rc = ESMF_SUCCESS - - ! Add empty fields to field bundle - do n = 1, size(atm2lnd) - call fldbundle_add( trim(lnd2atm(n)%fldname), mesh, fieldbundle, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - - end subroutine lilac_field_bundle_from_land - - !=============================================================================== - - subroutine fldbundle_add(fldname, mesh, fieldbundle, rc) - - !--------------------------- - ! Create an empty input field with name 'stdname' to add to fieldbundle - !--------------------------- - - ! input/output variables - character(len=*) , intent(in) :: fldname - type(ESMF_Mesh) , intent(in) :: mesh - type(ESMF_FieldBundle) , intent(inout) :: fieldbundle - integer , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: field - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldname), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldBundleAdd(fieldbundle, (/field/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine fldbundle_add - - -end module lilac_fields diff --git a/lilac/src/lilac_utils.F90 b/lilac/src/lilac_utils.F90 index f83245d6f9..3a765e0f8d 100644 --- a/lilac/src/lilac_utils.F90 +++ b/lilac/src/lilac_utils.F90 @@ -1,10 +1,6 @@ module lilac_utils ! *********************************************************************** - ! NOTE: THE FOLLOWING CANNOT DEPEND ON ANY ESMF OBJECTS - ! since it will be used by the host atmosphere - ! This is the ONLY lilac routine that is required to be ESMF independent - ! ! THE HOST ATMOSPHERE IS RESPONSIBLE for calling lilac_init() and in turn ! lilac_init() calls the initialization routines for atm2lnd and lnd2atm ! @@ -14,9 +10,13 @@ module lilac_utils ! call lilac_atm2lnd(fldname, data1d) ! call lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) ! call lilac_lnd2atm(fldname, data1d) - ! ! *********************************************************************** + use ESMF + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl, CS => shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use lilac_methods , only : chkerr + implicit none private @@ -24,20 +24,25 @@ module lilac_utils public :: lilac_init_lnd2atm public :: lilac_atm2lnd public :: lilac_lnd2atm + public :: lilac_field_bundle_to_land + public :: lilac_field_bundle_fr_land + + private :: lilac_atm2lnd_add_fld + private :: lilac_lnd2atm_add_fld ! Global index space info for atm data integer, public, allocatable :: gindex_atm (:) ! Mesh file to be read in by lilac_atm - character(len=256), public :: atm_mesh_filename + character(len=CL), public :: atm_mesh_filename ! Mesh file to be read in by ctsm - character(len=256), public :: lnd_mesh_filename + character(len=CL), public :: lnd_mesh_filename type :: atm2lnd_type - character(len=128) :: fldname - real*8, pointer :: dataptr(:) - character(len=64) :: units + character(len=CL) :: fldname + real(r8), pointer :: dataptr(:) + character(len=CS) :: units logical :: provided_by_atm logical :: required_fr_atm end type atm2lnd_type @@ -45,11 +50,14 @@ module lilac_utils type :: lnd2atm_type character(len=128) :: fldname - real*8, pointer :: dataptr(:) + real(r8), pointer :: dataptr(:) character(len=64) :: units end type lnd2atm_type type(atm2lnd_type), pointer, public :: lnd2atm(:) + character(*), parameter :: u_FILE_u = & + __FILE__ + !======================================================================== contains !======================================================================== @@ -62,45 +70,45 @@ subroutine lilac_init_atm2lnd(lsize) ! should it pass an array of character strings or a colon deliminited set of fields ! to specify the fields it will not provide - and then these are checked against those fields - call atm2lnd_add_fld (atm2lnd, fldname='Sa_z' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_topo' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_u' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_v' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_ptem' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_pbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_tbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Sa_shum' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_lwdn' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainc' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainl' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowc' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowl' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndr' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdr' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndf' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdf' , units='unknown', required_fr_atm=.true. , lsize=lsize) - - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet1' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry1' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet2' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry2' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet3' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry3' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet4' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry4' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_z' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_topo' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_u' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_v' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_ptem' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_pbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_tbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_shum' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_lwdn' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainc' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainl' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowc' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowl' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndr' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdr' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndf' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdf' , units='unknown', required_fr_atm=.true. , lsize=lsize) + + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet1' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry1' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet2' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry2' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet3' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry3' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet4' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry4' , units='unknown', required_fr_atm=.true. , lsize=lsize) ! TODO: optional fields - if these are uncommented then need to make sure that they are also appear in the lnd ! import state ! CRITICAL the fields in the export state from lilac_atmcap MUST match the fields in the import state to the land ! this is not being checked currently and msut be - !call atm2lnd_add_fld (atm2lnd, fldname='Sa_methane' , units='unknown', required_fr_atm=.false. , lsize=lsize) - !call atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcph' , units='unknown', required_fr_atm=.false. , lsize=lsize) + !call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_methane' , units='unknown', required_fr_atm=.false. , lsize=lsize) + !call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcph' , units='unknown', required_fr_atm=.false. , lsize=lsize) ! now add dataptr memory for all of the fields and set default values of provided_by_atm to false do n = 1,size(atm2lnd) @@ -115,23 +123,23 @@ subroutine lilac_init_lnd2atm(lsize) integer, intent(in) :: lsize integer :: n - call lnd2atm_add_fld (lnd2atm, fldname='Sl_lfrin' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_t' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_tref' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_qref' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdr' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_anidr' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdf' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_anidf' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_snowh' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_u10' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_fv' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Sl_ram1' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Fall_lwup' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Fall_taux' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Fall_tauy' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Fall_evap' , units='unknown', lsize=lsize) - call lnd2atm_add_fld (lnd2atm, fldname='Fall_swnet', units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_lfrin' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_t' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_tref' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_qref' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdr' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_anidr' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdf' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_anidf' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_snowh' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_u10' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_fv' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_ram1' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Fall_lwup' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Fall_taux' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Fall_tauy' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Fall_evap' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm, fldname='Fall_swnet', units='unknown', lsize=lsize) ! now add dataptr memory for all of the fields do n = 1,size(lnd2atm) @@ -145,7 +153,7 @@ subroutine lilac_atm2lnd(fldname, data) ! input/output variables character(len=*), intent(in) :: fldname - real*8, intent(in) :: data(:) + real(r8), intent(in) :: data(:) ! local variables integer :: n @@ -171,6 +179,8 @@ subroutine lilac_atm2lnd(fldname, data) end subroutine lilac_atm2lnd +!======================================================================== + subroutine lilac_atm2lnd_check() ! local variables @@ -191,8 +201,8 @@ end subroutine lilac_atm2lnd_check subroutine lilac_lnd2atm(fldname, data) ! input/output variables - character(len=*), intent(in) :: fldname - real*8, intent(out) :: data(:) + character(len=*) , intent(in) :: fldname + real(r8) , intent(out) :: data(:) ! local variables integer :: n @@ -211,7 +221,7 @@ end subroutine lilac_lnd2atm !======================================================================== - subroutine atm2lnd_add_fld(flds, fldname, units, required_fr_atm, lsize) + subroutine lilac_atm2lnd_add_fld(flds, fldname, units, required_fr_atm, lsize) ! ---------------------------------------------- ! Add an entry to to the flds array @@ -276,11 +286,11 @@ subroutine atm2lnd_add_fld(flds, fldname, units, required_fr_atm, lsize) flds(newsize)%required_fr_atm = required_fr_atm end if - end subroutine atm2lnd_add_fld + end subroutine lilac_atm2lnd_add_fld !======================================================================== - subroutine lnd2atm_add_fld(flds, fldname, units, lsize) + subroutine lilac_lnd2atm_add_fld(flds, fldname, units, lsize) ! ---------------------------------------------- ! Add an entry to to the flds array @@ -334,6 +344,74 @@ subroutine lnd2atm_add_fld(flds, fldname, units, lsize) flds(newsize)%fldname = trim(fldname) flds(newsize)%units = trim(units) - end subroutine lnd2atm_add_fld + end subroutine lilac_lnd2atm_add_fld + +!======================================================================== + + subroutine lilac_field_bundle_to_land(mesh, fieldbundle, rc) + + type(ESMF_Mesh) :: mesh + type(ESMF_FieldBundle) :: fieldbundle + integer, intent(out) :: rc + + integer :: n + + rc = ESMF_SUCCESS + + ! Add empty fields to field bundle + do n = 1, size(atm2lnd) + call fldbundle_add(trim(atm2lnd(n)%fldname), mesh, fieldbundle, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + end subroutine lilac_field_bundle_to_land + +!=============================================================================== + + subroutine lilac_field_bundle_fr_land(mesh, fieldbundle, rc) + + type(ESMF_Mesh) :: mesh + type(ESMF_FieldBundle) :: fieldbundle + integer, intent(out) :: rc + + integer :: n + + rc = ESMF_SUCCESS + + ! Add empty fields to field bundle + do n = 1, size(atm2lnd) + call fldbundle_add( trim(lnd2atm(n)%fldname), mesh, fieldbundle, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + end subroutine lilac_field_bundle_fr_land + +!=============================================================================== + + subroutine fldbundle_add(fldname, mesh, fieldbundle, rc) + + !--------------------------- + ! Create an empty input field with name 'stdname' to add to fieldbundle + !--------------------------- + + ! input/output variables + character(len=*) , intent(in) :: fldname + type(ESMF_Mesh) , intent(in) :: mesh + type(ESMF_FieldBundle) , intent(inout) :: fieldbundle + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: field + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleAdd(fieldbundle, (/field/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine fldbundle_add end module lilac_utils From a2f3610174c5300f9ec271e36a1787ad3f674478 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 2 Dec 2019 17:31:00 -0700 Subject: [PATCH 201/556] new approach in consistency of lilac/clm fields --- src/cpl/lilac/lnd_comp_esmf.F90 | 73 ++++++--------------------------- 1 file changed, 12 insertions(+), 61 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 6e4628a82e..f27ac92767 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -10,7 +10,7 @@ module lnd_comp_esmf use mpi , only : MPI_BCAST, MPI_CHARACTER use mct_mod , only : mct_world_init use perf_mod , only : t_startf, t_stopf, t_barrierf - use lilac_fields , only : lilac_field_bundle_to_land, lilac_field_bundle_from_land + use lilac_utils , only : lilac_field_bundle_to_land, lilac_field_bundle_fr_land ! cime share code use shr_pio_mod , only : shr_pio_init2 @@ -418,44 +418,12 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! NOTE: currently this must be the same list as in lilac_init_atm2lnd ! create an empty field bundle - c2l_fb = ESMF_FieldBundleCreate ( name='c2l_fb', rc=rc) - - !call lilac_field_bundle_to_land(lnd_mesh, c2l_fb, rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + c2l_fb = ESMF_FieldBundleCreate (name='c2l_fb', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Now add fields on lnd_mesh to this field bundle - call fldbundle_add( 'Sa_z' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_topo' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_u' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_v' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_ptem' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_pbot' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_tbot' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sa_shum' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_lwdn' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_rainc' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_rainl' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_snowc' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_snowl' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swndr' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swvdr' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swndf' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_swvdf' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call fldbundle_add( 'Faxa_bcphidry' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_bcphodry' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_bcphiwet' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_ocphidry' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_ocphodry' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_ocphiwet' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_dstwet1' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_dstdry1' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_dstwet2' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_dstdry2' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_dstwet3' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_dstdry3' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_dstwet4' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Faxa_dstdry4' , c2l_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! now add fields on lnd_mesh to this field bundle + call lilac_field_bundle_to_land(lnd_mesh, c2l_fb, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! add the field bundle to the export state call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb/)) @@ -466,32 +434,15 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! NOTE: currently this must be the same list as in lilac_init_lnd2atm - ! Create an empty field bundle + ! create an empty field bundle l2c_fb = ESMF_FieldBundleCreate(name='l2c_fb', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call lilac_field_bundle_from_land(lnd_mesh, l2c_fb, rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! now add fields on lnd_mesh to this field bundle + call lilac_field_bundle_fr_land(lnd_mesh, l2c_fb, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Now add fields on lnd_mesh to this field bundle - call fldbundle_add( 'Sl_lfrin' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_t' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_tref' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_qref' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_avsdr' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_anidr' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_avsdf' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_anidf' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Sl_snowh' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Fall_u10' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Fall_fv' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Fall_ram1' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Fall_lwup' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Fall_taux' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Fall_tauy' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Fall_evap' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbundle_add( 'Fall_swnet' , l2c_fb,rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Add the field bundle to the state + ! add the field bundle to the state call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb/), rc=rc) !-------------------------------- From 219856a9df3e60840fdba029fce321159f91cfb3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 2 Dec 2019 19:46:56 -0700 Subject: [PATCH 202/556] fixed bug --- lilac/src/lilac_utils.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/src/lilac_utils.F90 b/lilac/src/lilac_utils.F90 index 3a765e0f8d..2c6b6d343e 100644 --- a/lilac/src/lilac_utils.F90 +++ b/lilac/src/lilac_utils.F90 @@ -379,7 +379,7 @@ subroutine lilac_field_bundle_fr_land(mesh, fieldbundle, rc) rc = ESMF_SUCCESS ! Add empty fields to field bundle - do n = 1, size(atm2lnd) + do n = 1, size(lnd2atm) call fldbundle_add( trim(lnd2atm(n)%fldname), mesh, fieldbundle, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do From 58f96b3ad6cd239b62dbcb503ba401532fe11475 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 2 Dec 2019 20:13:07 -0700 Subject: [PATCH 203/556] made lilac_atmaero more generic --- lilac/src/lilac_atmaero.F90 | 50 ++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/lilac/src/lilac_atmaero.F90 b/lilac/src/lilac_atmaero.F90 index be31be5105..f54481ae62 100644 --- a/lilac/src/lilac_atmaero.F90 +++ b/lilac/src/lilac_atmaero.F90 @@ -72,14 +72,14 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) integer :: gsize ! global size integer :: nunit ! namelist input unit integer :: ierr ! namelist i/o error flag - character(len=cl) :: stream_fldfilename_atmaero ! name of input stream file + character(len=cl) :: stream_fldfilename ! name of input stream file character(len=CL) :: mapalgo = 'bilinear' ! type of 2d mapping character(len=CS) :: taxmode = 'extend' ! time extrapolation character(len=CL) :: fldlistFile ! name of fields in input stream file character(len=CL) :: fldlistModel ! name of fields in data stream code - integer :: stream_year_first_atmaero ! first year in stream to use - integer :: stream_year_last_atmaero ! last year in stream to use - integer :: model_year_align_atmaero ! align stream_year_first with model year + integer :: stream_year_first ! first year in stream to use + integer :: stream_year_last ! last year in stream to use + integer :: model_year_align ! align stream_year_first with model year integer :: spatialDim integer :: numOwnedElements real(r8), pointer :: ownedElemCoords(:) @@ -91,16 +91,16 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) !----------------------------------------------------------------------- namelist /atmaero_stream/ & - stream_year_first_atmaero, & - stream_year_last_atmaero, & - model_year_align_atmaero, & - stream_fldfilename_atmaero + stream_year_first, & + stream_year_last, & + model_year_align, & + stream_fldfilename ! default values for namelist - stream_year_first_atmaero = 1 ! first year in stream to use - stream_year_last_atmaero = 1 ! last year in stream to use - model_year_align_atmaero = 1 ! align stream_year_first_atmaero with this model year - stream_fldFileName_atmaero = ' ' + stream_year_first = 1 ! first year in stream to use + stream_year_last = 1 ! last year in stream to use + model_year_align = 1 ! align stream_year_first with this model year + stream_fldFileName = ' ' ! get mytask and mpicom call ESMF_VMGetCurrent(vm, rc=rc) @@ -123,18 +123,18 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) close(nunit) endif - call shr_mpi_bcast(stream_year_first_atmaero , mpicom) - call shr_mpi_bcast(stream_year_last_atmaero , mpicom) - call shr_mpi_bcast(model_year_align_atmaero , mpicom) - call shr_mpi_bcast(stream_fldfilename_atmaero, mpicom) + call shr_mpi_bcast(stream_year_first , mpicom) + call shr_mpi_bcast(stream_year_last , mpicom) + call shr_mpi_bcast(model_year_align , mpicom) + call shr_mpi_bcast(stream_fldfilename, mpicom) if (mytask == 0) then print *, ' ' print *, 'atmaero stream settings:' - print *, ' stream_year_first_atmaero = ',stream_year_first_atmaero - print *, ' stream_year_last_atmaero = ',stream_year_last_atmaero - print *, ' model_year_align_atmaero = ',model_year_align_atmaero - print *, ' stream_fldFileName_atmaero = ',stream_fldFileName_atmaero + print *, ' stream_year_first = ',stream_year_first + print *, ' stream_year_last = ',stream_year_last + print *, ' model_year_align = ',model_year_align + print *, ' stream_fldFileName = ',stream_fldFileName print *, ' ' endif @@ -218,19 +218,19 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) ggrid = ggrid_atm, & nxg = ldomain%ni, & nyg = ldomain%nj, & - yearFirst = stream_year_first_atmaero, & - yearLast = stream_year_last_atmaero, & - yearAlign = model_year_align_atmaero, & + yearFirst = stream_year_first, & + yearLast = stream_year_last, & + yearAlign = model_year_align, & offset = 0, & domFilePath = '', & - domfilename = trim(stream_fldfilename_atmaero), & + domfilename = trim(stream_fldfilename), & domTvarName = 'time', & domXvarName = 'lon' , & domYvarName = 'lat' , & domAreaName = 'area', & domMaskName = 'mask', & filePath = '', & - filename = (/trim(stream_fldfilename_atmaero)/), & + filename = (/trim(stream_fldfilename)/), & fldListFile = trim(fldlistFile), & fldListModel = trim(fldlistModel), & fillalgo = 'none', & From 0e1d8d705d6370febf3bcaa872a4026cc5067312 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 2 Dec 2019 20:13:42 -0700 Subject: [PATCH 204/556] made stream input more generic --- lilac_config/lilac_in | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lilac_config/lilac_in b/lilac_config/lilac_in index 198c8aea6e..7e738d65d6 100644 --- a/lilac_config/lilac_in +++ b/lilac_config/lilac_in @@ -2,9 +2,9 @@ lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' / &atmaero_stream - stream_fldfilename_atmaero='/glade/p/cesmdata/cseg/inputdata/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_WACCM.ensmean_monthly_hist_1849-2015_0.9x1.25_CMIP6_c180926.nc' - stream_year_first_atmaero = 2000 - stream_year_last_atmaero = 2000 + stream_fldfilename='/glade/p/cesmdata/cseg/inputdata/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_WACCM.ensmean_monthly_hist_1849-2015_0.9x1.25_CMIP6_c180926.nc' + stream_year_first = 2000 + stream_year_last = 2000 / &papi_inparm papi_ctr1_str = "PAPI_FP_OPS" From adbc3af36f79a210d7f544978c40fb5df55d1a2f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 3 Dec 2019 13:22:49 -0700 Subject: [PATCH 205/556] Remove submodules (esmf, pfunit) --- external/esmf | 1 - external/pfunit | 1 - lilac/.gitmodules | 8 -------- 3 files changed, 10 deletions(-) delete mode 160000 external/esmf delete mode 160000 external/pfunit diff --git a/external/esmf b/external/esmf deleted file mode 160000 index 3a9c142262..0000000000 --- a/external/esmf +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 3a9c142262b247189abd8dbca0d63e6dbb3a8207 diff --git a/external/pfunit b/external/pfunit deleted file mode 160000 index 14339d668c..0000000000 --- a/external/pfunit +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 14339d668c3f7440c408422dea68d750ee59ad9d diff --git a/lilac/.gitmodules b/lilac/.gitmodules index 3836c21e6b..e69de29bb2 100644 --- a/lilac/.gitmodules +++ b/lilac/.gitmodules @@ -1,8 +0,0 @@ -[submodule "external/pfunit"] - path = external/pfunit - url = https://github.com/laristra/pfunit.git - shallow = true -[submodule "external/esmf"] - path = external/esmf - url = https://git.code.sf.net/p/esmf/esmf - shallow = true From 1344b414b1e49c5e4956efdc105c39708f664ff7 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 3 Dec 2019 13:23:10 -0700 Subject: [PATCH 206/556] Remove now-empty .gitmodules file --- lilac/.gitmodules | 0 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 lilac/.gitmodules diff --git a/lilac/.gitmodules b/lilac/.gitmodules deleted file mode 100644 index e69de29bb2..0000000000 From 8fae5d70047526682b769e4e4e0604121b9058f6 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 3 Dec 2019 13:48:15 -0700 Subject: [PATCH 207/556] Stop bringing in lilac as an external We're going to include lilac directly rather than as an external. --- .gitignore | 1 - Externals.cfg | 7 ------- 2 files changed, 8 deletions(-) diff --git a/.gitignore b/.gitignore index 9a16cf5eb1..4a5672d970 100644 --- a/.gitignore +++ b/.gitignore @@ -5,7 +5,6 @@ manage_externals.log /tools/PTCLM/ /cime/ /components/ -/lilac # ignore svn directories **/.svn/** diff --git a/Externals.cfg b/Externals.cfg index 72d1e54b5c..9f124b5043 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -4,13 +4,6 @@ protocol = externals_only externals = Externals_CLM.cfg required = True -[lilac] -local_path = lilac -protocol = git -repo_url = https://github.com/NCAR/lilac.git -branch = master -required = True - [cism] local_path = components/cism protocol = git From 7a61923b1bd2353c6bcfcea8b87d2767a39552c4 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 3 Dec 2019 20:03:49 -0700 Subject: [PATCH 208/556] added lilac as an external --- Externals.cfg | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Externals.cfg b/Externals.cfg index 9f124b5043..72d1e54b5c 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -4,6 +4,13 @@ protocol = externals_only externals = Externals_CLM.cfg required = True +[lilac] +local_path = lilac +protocol = git +repo_url = https://github.com/NCAR/lilac.git +branch = master +required = True + [cism] local_path = components/cism protocol = git From b91023e7ec6db94cef6ed911ef70ddc1bf7f5067 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 3 Dec 2019 20:40:18 -0700 Subject: [PATCH 209/556] Revert "added lilac as an external" This reverts commit 7a61923b1bd2353c6bcfcea8b87d2767a39552c4. --- Externals.cfg | 7 ------- 1 file changed, 7 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 72d1e54b5c..9f124b5043 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -4,13 +4,6 @@ protocol = externals_only externals = Externals_CLM.cfg required = True -[lilac] -local_path = lilac -protocol = git -repo_url = https://github.com/NCAR/lilac.git -branch = master -required = True - [cism] local_path = components/cism protocol = git From e1eeadff5f1dd10073b6fcc9153fec6272d0c07a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 3 Dec 2019 21:03:22 -0700 Subject: [PATCH 210/556] Remove top-level dot files in lilac These files (.gitignore, .dockerignore, .travis.yml) served a purpose when lilac was its own repository, but I think they no longer serve their intended purpose now that lilac is inlined into the ctsm repository. However, it's possible that we may want to bring back some of the contents of these at some point, e.g., bringing them to the top level of CTSM. --- lilac/.dockerignore | 329 -------------------------------------------- lilac/.gitignore | 17 --- lilac/.travis.yml | 21 --- 3 files changed, 367 deletions(-) delete mode 100644 lilac/.dockerignore delete mode 100644 lilac/.gitignore delete mode 100644 lilac/.travis.yml diff --git a/lilac/.dockerignore b/lilac/.dockerignore deleted file mode 100644 index 2fc5d54e03..0000000000 --- a/lilac/.dockerignore +++ /dev/null @@ -1,329 +0,0 @@ -# Created by .ignore support plugin (hsz.mobi) - -### Vim template -# swap -[._]*.s[a-w][a-z] -[._]s[a-w][a-z] -# session -Session.vim -# temporary -.netrwhist -*~ - -# auto-generated tag files -tags - -### Cpp template -# Compiled Object files -*.slo -*.lo -*.o -*.obj - -# Precompiled Headers -*.gch -*.pch - -# Compiled Dynamic libraries -*.so -*.dylib -*.dll - -# Fortran module files -*.mod -*.smod - -# Compiled Static libraries -*.lai -*.la -*.a -*.lib - -# Executables -*.exe -*.out -*.app - -### CMake template -CMakeCache.txt -CMakeFiles -CMakeScripts -Makefile -cmake_install.cmake -install_manifest.txt -CTestTestfile.cmake - -### Emacs template -# -*- mode: gitignore; -*- -*~ -\#*\# -/.emacs.desktop -/.emacs.desktop.lock -*.elc -auto-save-list -tramp -.\#* - -# Org-mode -.org-id-locations -*_archive - -# flymake-mode -*_flymake.* - -# eshell files -/eshell/history -/eshell/lastdir - -# elpa packages -/elpa/ - -# reftex files -*.rel - -# AUCTeX auto folder -/auto/ - -# cask packages -.cask/ -dist/ - -# Flycheck -flycheck_*.el - -# server auth directory -/server/ - -# projectiles files -.projectile### VirtualEnv template -# Virtualenv -# http://iamzed.com/2009/05/07/a-primer-on-virtualenv/ -.Python -[Bb]in -[Ii]nclude -[Ll]ib -[Ll]ib64 -[Ll]ocal -[Ss]cripts -pyvenv.cfg -.venv -pip-selfcheck.json - -### Linux template -*~ - -# temporary files which can be created if a process still has a handle open of a deleted file -.fuse_hidden* - -# KDE directory preferences -.directory - -# Linux trash folder which might appear on any partition or disk -.Trash-* - -### C template -# Object files -*.o -*.ko -*.obj -*.elf - -# Precompiled Headers -*.gch -*.pch - -# Libraries -*.lib -*.a -*.la -*.lo - -# Shared objects (inc. Windows DLLs) -*.dll -*.so -*.so.* -*.dylib - -# Executables -*.exe -*.out -*.app -*.i*86 -*.x86_64 -*.hex - -# Debug files -*.dSYM/ -*.su - -### Windows template -# Windows image file caches -Thumbs.db -ehthumbs.db - -# Folder config file -Desktop.ini - -# Recycle Bin used on file shares -$RECYCLE.BIN/ - -# Windows Installer files -*.cab -*.msi -*.msm -*.msp - -# Windows shortcuts -*.lnk - -### KDevelop4 template -*.kdev4 -.kdev4/ - -### Python template -# Byte-compiled / optimized / DLL files -__pycache__/ -*.py[cod] -*$py.class - -# C extensions -*.so - -# Distribution / packaging -.Python -env/ -build/ -develop-eggs/ -dist/ -downloads/ -eggs/ -.eggs/ -lib/ -lib64/ -parts/ -sdist/ -var/ -*.egg-info/ -.installed.cfg -*.egg - -# PyInstaller -# Usually these files are written by a python script from a template -# before PyInstaller builds the exe, so as to inject date/other infos into it. -*.manifest -*.spec - -# Installer logs -pip-log.txt -pip-delete-this-directory.txt - -# Unit test / coverage reports -htmlcov/ -.tox/ -.coverage -.coverage.* -.cache -nosetests.xml -coverage.xml -*,cover -.hypothesis/ - -# Translations -*.mo -*.pot - -# Django stuff: -*.log -local_settings.py - -# Flask stuff: -instance/ -.webassets-cache - -# Scrapy stuff: -.scrapy - -# Sphinx documentation -docs/_build/ - -# PyBuilder -target/ - -# IPython Notebook -.ipynb_checkpoints - -# pyenv -.python-version - -# celery beat schedule file -celerybeat-schedule - -# dotenv -.env - -# virtualenv -venv/ -ENV/ - -# Spyder project settings -.spyderproject - -# Rope project settings -.ropeproject - -### Xcode template -# Xcode -# -# gitignore contributors: remember to update Global/Xcode.gitignore, Objective-C.gitignore & Swift.gitignore - -## Build generated -build/ -DerivedData/ - -## Various settings -*.pbxuser -!default.pbxuser -*.mode1v3 -!default.mode1v3 -*.mode2v3 -!default.mode2v3 -*.perspectivev3 -!default.perspectivev3 -xcuserdata/ - -## Other -*.moved-aside -*.xccheckout -*.xcscmblueprint - -### NodeJS template -# Logs -logs -*.log -npm-debug.log* - -# Runtime data -pids -*.pid -*.seed - -# Directory for instrumented libs generated by jscoverage/JSCover -lib-cov - -# Coverage directory used by tools like istanbul -coverage - -# Grunt intermediate storage (http://gruntjs.com/creating-plugins#storing-task-files) -.grunt - -# node-waf configuration -.lock-wscript - -# Compiled binary addons (http://nodejs.org/api/addons.html) -build/Release - -# Dependency directory -# https://docs.npmjs.com/misc/faq#should-i-check-my-node-modules-folder-into-git -node_modules - -build/ \ No newline at end of file diff --git a/lilac/.gitignore b/lilac/.gitignore deleted file mode 100644 index 6e5803401e..0000000000 --- a/lilac/.gitignore +++ /dev/null @@ -1,17 +0,0 @@ -# directories that are checked out by the tool -cime/ -cime_config/ -components/ - -# generated local files -*.log - -# editor files -*~ -*.bak - -# generated python files -*.pyc - -build/ -_build/ diff --git a/lilac/.travis.yml b/lilac/.travis.yml deleted file mode 100644 index 40f2c1981a..0000000000 --- a/lilac/.travis.yml +++ /dev/null @@ -1,21 +0,0 @@ -language: cpp -sudo: required -dist: trusty -notifications: - email: false - -services: - - docker - -before_install: - - docker version - - docker-compose version - -install: - - docker-compose build lilac - -before_script: - - docker-compose images - -script: - - docker run -t lilac From bc7d02fb2c5caa22ba97017c94820b5c64c94fc7 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 4 Dec 2019 10:54:44 -0700 Subject: [PATCH 211/556] Remove lilac readme and license files These are no longer needed now that lilac has been folded in to ctsm. --- lilac/LICENSE | 34 ---------------------------------- lilac/README.md | 12 ------------ 2 files changed, 46 deletions(-) delete mode 100644 lilac/LICENSE delete mode 100644 lilac/README.md diff --git a/lilac/LICENSE b/lilac/LICENSE deleted file mode 100644 index 0ba25429ac..0000000000 --- a/lilac/LICENSE +++ /dev/null @@ -1,34 +0,0 @@ -Copyright (c) 2018, University Corporation for Atmospheric Research (UCAR) -All rights reserved. - -Developed by: - University Corporation for Atmospheric Research - National Center for Atmospheric Research - https://www2.cesm.ucar.edu/working-groups/sewg - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the "Software"), -to deal with the Software without restriction, including without limitation -the rights to use, copy, modify, merge, publish, distribute, sublicense, -and/or sell copies of the Software, and to permit persons to whom -the Software is furnished to do so, subject to the following conditions: - - - Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimers. - - Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimers in the documentation - and/or other materials provided with the distribution. - - Neither the names of [Name of Development Group, UCAR], - nor the names of its contributors may be used to endorse or promote - products derived from this Software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE -LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. diff --git a/lilac/README.md b/lilac/README.md deleted file mode 100644 index 4184eb80d3..0000000000 --- a/lilac/README.md +++ /dev/null @@ -1,12 +0,0 @@ -# LILAC - -LILAC, Lightweight Infrastructure for Land Atmosphere Coupling. - -[![Build Status](https://travis-ci.org/jhamman/lilac.svg?branch=master)](https://travis-ci.org/jhamman/lilac) -[![Documentation Status](https://readthedocs.org/projects/ctsm-lilac/badge/?version=latest)](https://ctsm-lilac.readthedocs.io/en/latest/?badge=latest) - -Currently working on: - - Setting up CI and CMake - - setup/test style (borrow from geostreams) - - setup unit tests with pfunit - From 2f434bdef15baf1daa19828e217af2062d943613 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 5 Dec 2019 05:20:44 -0700 Subject: [PATCH 212/556] Add some information to README.lilac --- README.lilac | 35 ++++++++++++++++++++++++++++++----- 1 file changed, 30 insertions(+), 5 deletions(-) diff --git a/README.lilac b/README.lilac index 615ca71149..daa7f01db4 100644 --- a/README.lilac +++ b/README.lilac @@ -5,16 +5,17 @@ SRC_ROOT is where ctsm is checked out - > git clone https://github.com/mvertens/ctsm.git + > git clone https://github.com/ESCOMP/ctsm.git > cd ctsm (this is $SRCROOT) - > git checkout mvertens/lilac_cap + > git checkout lilac_cap > ./manage_externals/checkout_externals -v 3) build the ctsm/lilac library using a CIME case > cd $SRCROOT/cime/scripts - > ./create_newcase --case /glade/scratch/mvertens/test_lilac --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver mct - > cd /glade/scratch/mvertens/test_lilac + > export CASEDIR=/glade/scratch/mvertens/test_lilac + > ./create_newcase --case $CASEDIR --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver mct + > cd $CASEDIR > ./xmlchange USE_ESMF_LIB=TRUE > ./xmlchange DEBUG=TRUE > remove the following lines from env_mach_specific: @@ -42,10 +43,14 @@ > ./case.setup > ./case.build + The last step will fail in building the executable; that's okay: all + we need from it is the component libraries. + 4) To build the atm_driver executable on cheyenne - edit the Makefile to change BLD_DIR > cd $SRCROOT/lilac/atm_driver > make clean + > source $CASEDIR/.env_mach_specific.sh > make atm_driver 4) to generate the input namelists @@ -59,8 +64,28 @@ THIS ONLY NEEDS TO BE DONE ONCE to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory -5) run the atm_driver on cheyenne +5) write CTSM history files every time step + + insert the following after the initial '&clm_inparm' in lnd_in: + + hist_nhtfrq = 1 + hist_mfilt = 1 + hist_ndens = 1 + +6) run the atm_driver on cheyenne > qsub cheyenne.sub +7) compare with latest baselines + + use something like this to compare the last clm and last cpl hist files: + + > basedir=/glade/p/cgd/tss/ctsm_baselines/lilac_20191202 + > cprnc test_lilac.clm2.h0.2000-01-02-00000.nc $basedir/test_lilac.clm2.h0.2000-01-02-00000.nc | tail -30 + > cprnc test_lilac.cpl.hi.2000-01-02-00000.nc $basedir/test_lilac.cpl.hi.2000-01-02-00000.nc | tail -30 + +8) if there are differences, and those are intentional, then create new + baselines + copy all *.nc files, plus ctsm.cfg, lilac_in and lnd_in to the + baseline directory From 36d46d11a7d9ccb8599d20a9de3b84e19b1cb7f0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 5 Dec 2019 07:03:42 -0700 Subject: [PATCH 213/556] Building lilac source: use lnd_root rather than SRCROOT --- cime_config/buildlib | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/cime_config/buildlib b/cime_config/buildlib index a7d8ac63d6..e382668c15 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -46,8 +46,6 @@ def _main_func(): lilac_mode = _get_osvar('LILAC_MODE', 'off') if lilac_mode == 'on': driver = "lilac" - ctsm_root = case.get_value("SRCROOT") - lilac_src = os.path.join(ctsm_root,"lilac","src") #------------------------------------------------------- # create Filepath file @@ -73,7 +71,7 @@ def _main_func(): os.path.join(lnd_root,"src","cpl",driver)] if lilac_mode == 'on': - paths.append(lilac_src) + paths.append(os.path.join(lnd_root,"lilac","src")) with open(filepath_file, "w") as filepath: filepath.write("\n".join(paths)) From 5f1683a694537b8e898a10fcfd5b60f459b08cbc Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 5 Dec 2019 12:07:18 -0700 Subject: [PATCH 214/556] Update build to use new nuopc driver capabilities --- README.lilac | 50 +++++++++++---------------------------- lilac/atm_driver/Makefile | 15 ++++++------ 2 files changed, 22 insertions(+), 43 deletions(-) diff --git a/README.lilac b/README.lilac index daa7f01db4..93d74413a3 100644 --- a/README.lilac +++ b/README.lilac @@ -14,46 +14,24 @@ > cd $SRCROOT/cime/scripts > export CASEDIR=/glade/scratch/mvertens/test_lilac - > ./create_newcase --case $CASEDIR --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver mct + > ./create_newcase --case $CASEDIR --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver nuopc > cd $CASEDIR - > ./xmlchange USE_ESMF_LIB=TRUE > ./xmlchange DEBUG=TRUE - > remove the following lines from env_mach_specific: - esmf_libs - - esmf-7.1.0r-defio-mpi-g - - - esmf-7.1.0r-defio-mpi-O - - - esmf-7.1.0r-ncdfio-uni-g - - - esmf-7.1.0r-ncdfio-uni-O - - > remove the string comp_interface="nuopc" from the following lines - - - > make the following changes - /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libO/Linux.intel.64.mpt.default/esmf.mk to - /glade/work/turuncu/ESMF/8.0.0b50/lib/libO/Linux.intel.64.mpt.default/esmf.mk - /glade/work/dunlap/ESMF-INSTALL/8.0.0bs38/lib/libg/Linux.intel.64.mpt.default/esmf.mk to - /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default/esmf.mk - > ./case.setup - > ./case.build - - The last step will fail in building the executable; that's okay: all - we need from it is the component libraries. - -4) To build the atm_driver executable on cheyenne - edit the Makefile to change BLD_DIR + > ./case.setup + > ./case.build --sharedlib-only + +4) To build the atm_driver executable on cheyenne + + - First, edit the Makefile to change BLD_DIR + + - Then, build with: > cd $SRCROOT/lilac/atm_driver > make clean > source $CASEDIR/.env_mach_specific.sh > make atm_driver -4) to generate the input namelists +5) to generate the input namelists - to customize the generated namelist - edit the file ctsm.cfg (in this directory) - to create the ctsm namelist FROM THIS DIRECTORY: @@ -64,7 +42,7 @@ THIS ONLY NEEDS TO BE DONE ONCE to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory -5) write CTSM history files every time step +6) write CTSM history files every time step insert the following after the initial '&clm_inparm' in lnd_in: @@ -72,11 +50,11 @@ hist_mfilt = 1 hist_ndens = 1 -6) run the atm_driver on cheyenne +7) run the atm_driver on cheyenne > qsub cheyenne.sub -7) compare with latest baselines +8) compare with latest baselines use something like this to compare the last clm and last cpl hist files: @@ -84,7 +62,7 @@ > cprnc test_lilac.clm2.h0.2000-01-02-00000.nc $basedir/test_lilac.clm2.h0.2000-01-02-00000.nc | tail -30 > cprnc test_lilac.cpl.hi.2000-01-02-00000.nc $basedir/test_lilac.cpl.hi.2000-01-02-00000.nc | tail -30 -8) if there are differences, and those are intentional, then create new +9) if there are differences, and those are intentional, then create new baselines copy all *.nc files, plus ctsm.cfg, lilac_in and lnd_in to the diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index 220741e3a3..9ae826927f 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -10,17 +10,18 @@ ESMFMKFILE = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.def ESMF_LIB_DIR = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default include $(ESMFMKFILE) -BLD_DIR = /glade/scratch/mvertens/test_lilac/bld +BLD_DIR = /glade/scratch/mvertens/test_lilac/bld -CTSM_BLD_DIR = $(BLD_DIR)/intel/mpt/debug/nothreads/mct/mct/esmf -MCT_LIB = $(BLD_DIR)/intel/mpt/debug/nothreads/mct/lib -SHR_LIB = $(BLD_DIR)/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -SHR_INC = $(BLD_DIR)/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -CTSM_INC = $(CTSM_BLD_DIR)/clm/obj +SHARED_BLD_DIR = $(BLD_DIR)/intel/mpt/debug/nothreads/nuopc +CTSM_BLD_DIR = $(SHARED_BLD_DIR)/nuopc/esmf +DEPENDS_LIB = $(SHARED_BLD_DIR)/lib +SHR_LIB = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/lib +SHR_INC = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/csm_share +CTSM_INC = $(CTSM_BLD_DIR)/clm/obj FFLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free -LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(MCT_LIB) -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib +LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib INCLUDES = -I$(CTSM_BLD_DIR)/include -I$(SHR_INC) -I$(CTSM_INC) From e98234b960b0fd46610040a602ffe2df6cd56e77 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 5 Dec 2019 12:20:01 -0700 Subject: [PATCH 215/556] Get BLDDIR from an environment variable It was getting to be a pain to have to keep changing the Makefile. --- README.lilac | 4 +++- lilac/atm_driver/Makefile | 7 ++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/README.lilac b/README.lilac index 93d74413a3..7cfe3b2429 100644 --- a/README.lilac +++ b/README.lilac @@ -22,7 +22,9 @@ 4) To build the atm_driver executable on cheyenne - - First, edit the Makefile to change BLD_DIR + - First, set BLDDIR - e.g.: + + > export BLDDIR=/glade/scratch/sacks/test_lilac_1205a/bld - Then, build with: diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index 9ae826927f..69de97f6fe 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -4,15 +4,16 @@ #================================================================================ # Define directory paths +# +# Note: You must set the environment BLDDIR before running this - e.g. +# export BLDDIR=/glade/scratch/sacks/test_lilac_1205a/bld #================================================================================ ESMFMKFILE = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default/esmf.mk ESMF_LIB_DIR = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default include $(ESMFMKFILE) -BLD_DIR = /glade/scratch/mvertens/test_lilac/bld - -SHARED_BLD_DIR = $(BLD_DIR)/intel/mpt/debug/nothreads/nuopc +SHARED_BLD_DIR = $(BLDDIR)/intel/mpt/debug/nothreads/nuopc CTSM_BLD_DIR = $(SHARED_BLD_DIR)/nuopc/esmf DEPENDS_LIB = $(SHARED_BLD_DIR)/lib SHR_LIB = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/lib From 63beebb3f37b6b01da070f2a310ba9586095dd6d Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 5 Dec 2019 12:20:36 -0700 Subject: [PATCH 216/556] pio is now split into piof and pioc --- lilac/atm_driver/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index 69de97f6fe..d17925627c 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -22,7 +22,7 @@ CTSM_INC = $(CTSM_BLD_DIR)/clm/obj FFLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free -LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib +LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib INCLUDES = -I$(CTSM_BLD_DIR)/include -I$(SHR_INC) -I$(CTSM_INC) From 507c7507ceb3a42fa774d1ca1e570fb6d6d8940d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 5 Dec 2019 12:52:17 -0700 Subject: [PATCH 217/556] updates to git mosart working in lilac --- cime_config/buildlib | 7 +- lilac/atm_driver/atm_driver.F90 | 2 +- {lilac_config => lilac/atm_driver}/lilac_in | 21 +- lilac/src/lilac_cpl.F90 | 469 +++++++++++++++----- lilac/src/lilac_history.F90 | 144 +++--- lilac/src/lilac_mod.F90 | 298 ++++++++++--- lilac/src/lilac_utils.F90 | 40 +- lilac_config/buildnml | 4 - src/cpl/lilac/lnd_comp_esmf.F90 | 271 ++++++----- src/cpl/lilac/lnd_import_export.F90 | 452 ++++++++++--------- 10 files changed, 1105 insertions(+), 603 deletions(-) rename {lilac_config => lilac/atm_driver}/lilac_in (86%) diff --git a/cime_config/buildlib b/cime_config/buildlib index 55c5254c8d..dee71eba92 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -45,7 +45,6 @@ def _main_func(): lilac_mode = _get_osvar('LILAC_MODE', 'off') if lilac_mode == 'on': ctsm_root = case.get_value("SRCROOT") - lilac_src = os.path.join(ctsm_root,"lilac","src") #------------------------------------------------------- # create Filepath file @@ -71,8 +70,12 @@ def _main_func(): if lilac_mode == 'off': paths.append(os.path.join(lnd_root,"src","cpl","mct")) else: - paths.append(lilac_src) paths.append(os.path.join(lnd_root,"src","cpl","lilac")) + lilac_src = os.path.join(ctsm_root,"lilac","src") + paths.append(lilac_src) + mosart_src = os.path.join(ctsm_root,"components","mosart","src") + paths.append(os.path.join(mosart_src,"riverroute")) + paths.append(os.path.join(mosart_src,"cpl","lilac")) with open(filepath_file, "w") as filepath: filepath.write("\n".join(paths)) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index f13069396d..a9622e00b0 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -144,7 +144,7 @@ program atm_driver if (mytask == 0 ) then print *, " initializing lilac " end if - call lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & + call lilac_init(comp_comm, atm_mesh_file, atm_global_index, atm_lons, atm_lats, & atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs) diff --git a/lilac_config/lilac_in b/lilac/atm_driver/lilac_in similarity index 86% rename from lilac_config/lilac_in rename to lilac/atm_driver/lilac_in index 7e738d65d6..b51fbe35fc 100644 --- a/lilac_config/lilac_in +++ b/lilac/atm_driver/lilac_in @@ -1,17 +1,18 @@ -&lnd_mesh_inparm +&lilac_run_input + starttype = 'startup' + caseid = 'test_lilac' +/ +&lilac_lnd_input lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' / +&lilac_rof_input + rof_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/r05_nomask_c110308_ESMFmesh.nc' +/ &atmaero_stream stream_fldfilename='/glade/p/cesmdata/cseg/inputdata/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_WACCM.ensmean_monthly_hist_1849-2015_0.9x1.25_CMIP6_c180926.nc' stream_year_first = 2000 stream_year_last = 2000 / -&papi_inparm - papi_ctr1_str = "PAPI_FP_OPS" - papi_ctr2_str = "PAPI_NO_CTR" - papi_ctr3_str = "PAPI_NO_CTR" - papi_ctr4_str = "PAPI_NO_CTR" -/ &pio_default_inparm pio_async_interface = .false. pio_blocksize = -1 @@ -26,6 +27,12 @@ pio_rearr_comm_max_pend_req_io2comp = 64 pio_rearr_comm_type = "p2p" / +&papi_inparm + papi_ctr1_str = "PAPI_FP_OPS" + papi_ctr2_str = "PAPI_NO_CTR" + papi_ctr3_str = "PAPI_NO_CTR" + papi_ctr4_str = "PAPI_NO_CTR" +/ &prof_inparm profile_add_detail = .false. profile_barrier = .false. diff --git a/lilac/src/lilac_cpl.F90 b/lilac/src/lilac_cpl.F90 index db15c4d60d..86167e927b 100644 --- a/lilac/src/lilac_cpl.F90 +++ b/lilac/src/lilac_cpl.F90 @@ -1,26 +1,34 @@ module lilac_cpl !----------------------------------------------------------------------- - ! Module containing all routines for both couplers - ! 1- coupler 1 : atm ---> lnd (cpl_atm2lnd) - ! 2- coupler 2 : lnd ---> atm (cpl_lnd2atm) + ! Module containing all routines for couplers !----------------------------------------------------------------------- use ESMF - use shr_sys_mod, only : shr_sys_abort + use shr_sys_mod , only : shr_sys_abort + use lilac_methods, only : chkerr implicit none private public :: cpl_atm2lnd_register public :: cpl_lnd2atm_register + public :: cpl_lnd2rof_register + public :: cpl_rof2lnd_register type(ESMF_RouteHandle) :: rh_atm2lnd type(ESMF_RouteHandle) :: rh_lnd2atm + type(ESMF_RouteHandle) :: rh_lnd2rof + type(ESMF_RouteHandle) :: rh_rof2lnd + integer :: mytask + integer, parameter :: ispval_mask = -987987 ! spval for RH mask values character(*), parameter :: modname = "lilac_cpl" + character(*), parameter :: u_FILE_u = & + __FILE__ + !====================================================================== contains !====================================================================== @@ -39,9 +47,9 @@ subroutine cpl_atm2lnd_register(cplcomp, rc) rc = ESMF_SUCCESS call ESMF_VMGetGlobal(vm=vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (mytask == 0) then print *, "in cpl_atm2lnd_register routine" @@ -49,7 +57,7 @@ subroutine cpl_atm2lnd_register(cplcomp, rc) ! Register the callback routines. ! Set the entry points for coupler ESMF Component methods - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine= cpl_atm2lnd_init, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_atm2lnd_init, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_atm2lnd_run , rc=rc) @@ -57,6 +65,7 @@ subroutine cpl_atm2lnd_register(cplcomp, rc) call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_atm2lnd_final, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end subroutine cpl_atm2lnd_register !====================================================================== @@ -77,16 +86,83 @@ subroutine cpl_lnd2atm_register(cplcomp, rc) ! Register the callback routines. ! Set the entry points for coupler ESMF Component methods - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_lnd2atm_init, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_lnd2atm_init, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_lnd2atm_run , rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN, userRoutine=cpl_lnd2atm_run , rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_lnd2atm_final, rc=rc) + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE, userRoutine=cpl_lnd2atm_final, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end subroutine cpl_lnd2atm_register +!====================================================================== + + subroutine cpl_lnd2rof_register(cplcomp, rc) + + ! input/output variables + type(ESMF_CplComp ) :: cplcomp + integer, intent(out ) :: rc + + ! local variables + type(ESMF_VM) :: vm + character(len=*) , parameter :: subname=trim(modname ) //' : [cpl_atm2lnd_register] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetGlobal(vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + print *, "in cpl_atm2lnd_register routine" + end if + + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_lnd2rof_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_lnd2rof_run , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_lnd2rof_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + end subroutine cpl_lnd2rof_register + +!====================================================================== + + subroutine cpl_rof2lnd_register(cplcomp, rc) + + type(ESMF_CplComp) :: cplcomp + integer, intent(out ) :: rc + + ! local variables + character(len=* ) , parameter :: subname=trim(modname ) //' : [cpl_rof2lnd_register] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "in cpl_rof2lnd_register routine" + end if + + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine=cpl_rof2lnd_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_rof2lnd_run , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_rof2lnd_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + end subroutine cpl_rof2lnd_register + !====================================================================== subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) @@ -101,10 +177,6 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) ! local variables type (ESMF_FieldBundle) :: import_fieldbundle type (ESMF_FieldBundle) :: export_fieldbundle - integer :: n - integer :: fieldcount - character(len=128), allocatable :: fieldlist(:) - character(len=128) :: cvalue character(len=*), parameter :: subname=trim(modname) //': [cpl_atm2lnd_init] ' !--------------------------------------------------- @@ -114,56 +186,15 @@ subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) end if call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - call ESMF_StateGet(importState, "a2c_fb", import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_FieldBundleGet(import_fieldbundle, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - write(cvalue,*) fieldcount - call ESMF_LogWrite(subname//" a2c_fb field count = "//trim(cvalue), ESMF_LOGMSG_INFO) - allocate(fieldlist(fieldcount)) - call ESMF_FieldBundleGet(import_fieldbundle, fieldNameList=fieldlist, rc=rc) - do n = 1,fieldCount - write(cvalue,*) n - call ESMF_LogWrite(subname//" a2c_fb field "//trim(cvalue)//' = '//trim(fieldlist(n)), ESMF_LOGMSG_INFO) - end do - deallocate(fieldlist) - if (mytask == 0) then - print *, ' a2c_fb field count = ',fieldcount - end if - - call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_FieldBundleGet(export_fieldbundle, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - write(cvalue,*) fieldcount - call ESMF_LogWrite(subname//" c2l_fb field count = "//trim(cvalue), ESMF_LOGMSG_INFO) - allocate(fieldlist(fieldcount)) - call ESMF_FieldBundleGet(export_fieldbundle, fieldNameList=fieldlist, rc=rc) - do n = 1,fieldCount - write(cvalue,*) n - call ESMF_LogWrite(subname//" c2l_fb field "//trim(cvalue)//' = '//trim(fieldlist(n)), ESMF_LOGMSG_INFO) - end do - deallocate(fieldlist) - if (mytask == 0) then - print *, ' c2l_fb field count = ',fieldcount - end if - - if (mytask == 0) then - print *, "PRINTING FIELDBUNDLES from atm->lnd" - call ESMF_FieldBundlePrint (import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldBundlePrint (export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if + call cpl_get_fieldbundle(importState, 'a2c_fb', import_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call cpl_get_fieldbundle(exportState, 'c2l_fb_atm', export_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort('error in initializing cpl_atm2lnd') - end if + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing cpl_atm2lnd') - call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"cpl_atm2lnd_init finished!", ESMF_LOGMSG_INFO) end subroutine cpl_atm2lnd_init @@ -180,69 +211,118 @@ subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) ! local variables type (ESMF_FieldBundle) :: import_fieldbundle type (ESMF_FieldBundle) :: export_fieldbundle - integer :: n - integer :: fieldcount - character(len=128), allocatable :: fieldlist(:) - character(len=128) :: cvalue character(len=*) , parameter :: subname=trim(modname ) //': [cpl_lnd2atm_init] ' !--------------------------------------------------- rc = ESMF_SUCCESS - if (mytask == 0) then print *, "Coupler for land to atmosphere initialize routine called" end if call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call cpl_get_fieldbundle(importState, 'l2c_fb_atm', import_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call cpl_get_fieldbundle(exportState, 'c2a_fb', export_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(import_fieldbundle, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - write(cvalue,*) fieldcount - call ESMF_LogWrite(subname//" l2c_fb field count = "//trim(cvalue), ESMF_LOGMSG_INFO) - allocate(fieldlist(fieldcount)) - call ESMF_FieldBundleGet(import_fieldbundle, fieldNameList=fieldlist, rc=rc) - do n = 1,fieldCount - write(cvalue,*) n - call ESMF_LogWrite(subname//" l2c_fb field "//trim(cvalue)//' = '//trim(fieldlist(n)), ESMF_LOGMSG_INFO) - end do - deallocate(fieldlist) + call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing cpl_lnd2atm') + + call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2atm_init + +!====================================================================== + + subroutine cpl_lnd2rof_init(cplcomp, importState, exportState, clock, rc) + + ! input/output variables + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + integer, intent(out ) :: rc + + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle + type (ESMF_FieldBundle) :: export_fieldbundle + integer :: srcTermProcessing_Value = 0 ! should this be a module variable? + character(len=*), parameter :: subname=trim(modname) //': [cpl_lnd2rof_init] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS if (mytask == 0) then - print *, ' l2c_fb field count = ',fieldcount + print *, "Coupler for atmosphere to land initialize routine called" end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call cpl_get_fieldbundle(importState, 'l2c_fb_rof', import_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call cpl_get_fieldbundle(exportState, 'c2r_fb', export_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2rof, & + srcMaskValues=(/ispval_mask/), dstMaskValues=(/ispval_mask/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing cpl_lnd2rof') + + call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2rof_init + +!====================================================================== + + subroutine cpl_rof2lnd_init(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + integer, intent(out ) :: rc + + ! local variables + type (ESMF_FieldBundle) :: import_fieldbundle + type (ESMF_FieldBundle) :: export_fieldbundle + integer :: srcTermProcessing_Value = 0 ! should this be a module variable? + character(len=*) , parameter :: subname=trim(modname ) //': [cpl_rof2lnd_init] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS - call ESMF_FieldBundleGet(export_fieldbundle, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - write(cvalue,*) fieldcount - call ESMF_LogWrite(subname//" c2a_fb field count = "//trim(cvalue), ESMF_LOGMSG_INFO) - allocate(fieldlist(fieldcount)) - call ESMF_FieldBundleGet(export_fieldbundle, fieldNameList=fieldlist, rc=rc) - do n = 1,fieldCount - write(cvalue,*) n - call ESMF_LogWrite(subname//" c2a_fb field "//trim(cvalue)//' = '//trim(fieldlist(n)), ESMF_LOGMSG_INFO) - end do - deallocate(fieldlist) if (mytask == 0) then - print *, ' c2a_fb field count = ',fieldcount + print *, "Coupler for land to atmosphere initialize routine called" end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then - call shr_sys_abort('error in initializing cpl_lnd2atm') - end if + call cpl_get_fieldbundle(importState, 'r2c_fb', import_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call cpl_get_fieldbundle(exportState, 'c2l_fb_rof', export_fieldbundle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_rof2lnd, & + srcMaskValues=(/ispval_mask/), dstMaskValues=(/ispval_mask/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing cpl_rof2lnd') call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) - end subroutine cpl_lnd2atm_init + end subroutine cpl_rof2lnd_init !====================================================================== subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) + ! input/output variables type(ESMF_CplComp) :: cplcomp type(ESMF_State) :: importState type(ESMF_State) :: exportState @@ -251,7 +331,7 @@ subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) ! local variables type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle - character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_run] ' + character(len=*) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_run] ' !--------------------------------------------------- rc = ESMF_SUCCESS @@ -261,15 +341,12 @@ subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) call ESMF_StateGet(importState, "a2c_fb", import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite(subname//" got a2c fieldbundle!", ESMF_LOGMSG_INFO) - - call ESMF_StateGet(exportState, "c2l_fb", export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite(subname//" got c2l fieldbundle!", ESMF_LOGMSG_INFO) - + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, "c2l_fb_atm", export_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//" regridding fieldbundles from atmos to land!", ESMF_LOGMSG_INFO) end subroutine cpl_atm2lnd_run @@ -295,19 +372,82 @@ subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) end if call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) - call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + call ESMF_StateGet(importState, "l2c_fb_atm", import_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//" regridding fieldbundles from land to atmos!", ESMF_LOGMSG_INFO) end subroutine cpl_lnd2atm_run +!====================================================================== + + subroutine cpl_lnd2rof_run(cplcomp, importState, exportState, clock, rc) + + ! input/output variables + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=* ) , parameter :: subname=trim(modname) //': [cpl_lnd2rof_run] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Running cpl_lnd2rof_run" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "l2c_fb_rof", import_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, "c2r_fb", export_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2rof, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" regridding fieldbundles from land to river!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2rof_run + +!====================================================================== + + subroutine cpl_rof2lnd_run(cplcomp, importState, exportState, clock, rc) + + type(ESMF_CplComp) :: cplcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=*) , parameter :: subname=trim(modname) //': [cpl_rof2lnd_run] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + if (mytask == 0) then + print *, "Running cpl_rof2lnd_run" + end if + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "r2c_fb", import_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, "c2l_fb_rof", export_fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_rof2lnd, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" regridding fieldbundles from river to land!", ESMF_LOGMSG_INFO) + + end subroutine cpl_rof2lnd_run + !====================================================================== subroutine cpl_atm2lnd_final(cplcomp, importState, exportState, clock, rc) @@ -330,7 +470,7 @@ subroutine cpl_atm2lnd_final(cplcomp, importState, exportState, clock, rc) ! Only thing to do here is release redist (or regrid) and route handles call ESMF_FieldBundleRegridRelease (routehandle=rh_atm2lnd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//" rh_atm2lnd route handle released!", ESMF_LOGMSG_INFO) @@ -356,10 +496,107 @@ subroutine cpl_lnd2atm_final(cplcomp, importState, exportState, clock, rc) ! Only thing to do here is release redist (or regrid) and route handles call ESMF_FieldBundleRegridRelease (routehandle=rh_lnd2atm , rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//" rh_lnd2atm route handle released!", ESMF_LOGMSG_INFO) end subroutine cpl_lnd2atm_final +!====================================================================== + + subroutine cpl_lnd2rof_final(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp) :: cplcomp + type (ESMF_State) :: importState + type (ESMF_State) :: exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + character(len=*) , parameter :: subname=trim(modname) //': [cpl_lnd2rof_final] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_lnd2rof , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" rh_lnd2rof route handle released!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2rof_final + +!====================================================================== + + subroutine cpl_rof2lnd_final(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp) :: cplcomp + type (ESMF_State) :: importState + type (ESMF_State) :: exportState + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + character(len=*) , parameter :: subname=trim(modname) //': [cpl_rof2lnd_final] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_rof2lnd , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//" rh_rof2lnd route handle released!", ESMF_LOGMSG_INFO) + + end subroutine cpl_rof2lnd_final + +!====================================================================== + + subroutine cpl_get_fieldbundle(state, fbname, fieldbundle, rc) + + ! input/output variables + type(ESMF_State) :: state + character(len=*) :: fbname + type(ESMF_FieldBundle) :: fieldbundle + integer, intent(out) :: rc + + ! local variables + integer :: n + integer :: fieldcount + character(len=128), allocatable :: fieldlist(:) + character(len=128) :: cvalue + character(len=*), parameter :: subname=trim(modname) //': [cpl_get_fieldbundle] ' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, trim(fbname), fieldbundle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(fieldbundle, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write(cvalue,*) fieldcount + call ESMF_LogWrite(subname//" trim(fbname)//' field count = "//trim(cvalue), ESMF_LOGMSG_INFO) + allocate(fieldlist(fieldcount)) + + call ESMF_FieldBundleGet(fieldbundle, fieldNameList=fieldlist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1,fieldCount + write(cvalue,*) n + call ESMF_LogWrite(subname//trim(fbname)//" field "//trim(cvalue)//' = '//trim(fieldlist(n)), & + ESMF_LOGMSG_INFO) + end do + deallocate(fieldlist) + if (mytask == 0) then + print *, trim(fbname)//' field count = ',fieldcount + end if + + end subroutine cpl_get_fieldbundle + end module lilac_cpl diff --git a/lilac/src/lilac_history.F90 b/lilac/src/lilac_history.F90 index 69ce98ae00..b8e50b892b 100644 --- a/lilac/src/lilac_history.F90 +++ b/lilac/src/lilac_history.F90 @@ -1,7 +1,7 @@ module lilac_history !----------------------------------------------------------------------------- - ! Mediator Phases + ! LILAC history output !----------------------------------------------------------------------------- use ESMF @@ -18,6 +18,10 @@ module lilac_history use lilac_io , only : lilac_io_close, lilac_io_date2yyyymmdd, lilac_io_sec2hms use lilac_io , only : lilac_io_ymd2date + ! For global domains + ! TODO: need to generalize obtaining global domains via state attributes + use domainMod , only : ldomain + implicit none private @@ -88,50 +92,58 @@ end subroutine lilac_history_alarm_init !=============================================================================== - subroutine lilac_history_write(atm2lnd_a_state, atm2lnd_l_state, lnd2atm_l_state, lnd2atm_a_state, clock, rc) + subroutine lilac_history_write(atm2cpl_state, lnd2cpl_state, rof2cpl_state, & + cpl2atm_state, cpl2lnd_state, cpl2rof_state, clock, rc) ! Write lilac history file ! input/output variables - type(ESMF_State) :: atm2lnd_a_state - type(ESMF_State) :: atm2lnd_l_state - type(ESMF_State) :: lnd2atm_l_state - type(ESMF_State) :: lnd2atm_a_state + type(ESMF_State) :: atm2cpl_state + type(ESMF_State) :: lnd2cpl_state + type(ESMF_State) :: rof2cpl_state + type(ESMF_State) :: cpl2atm_state + type(ESMF_State) :: cpl2lnd_state + type(ESMF_State) :: cpl2rof_state type(ESMF_Clock) :: clock integer, intent(out) :: rc ! local variables - type(ESMF_FieldBundle) :: c2a_fb , a2c_fb, c2l_fb, l2c_fb - type(ESMF_VM) :: vm - type(ESMF_Time) :: currtime - type(ESMF_Time) :: reftime - type(ESMF_Time) :: starttime - type(ESMF_Time) :: nexttime - type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time - type(ESMF_Calendar) :: calendar ! calendar type - character(len=64) :: currtimestr - character(len=64) :: nexttimestr - character(CS) :: histavg_option ! Histavg option units - integer :: i,j,m,n,n1,ncnt - integer :: start_ymd ! Starting date YYYYMMDD - integer :: start_tod ! Starting time-of-day (s) - integer :: nx,ny ! global grid size - integer :: yr,mon,day,sec ! time units - real(r8) :: rval ! real tmp value - real(r8) :: dayssince ! Time interval since reference time - integer :: fk ! index - character(CL) :: time_units ! units of time variable - character(CL) :: case_name ! case name - character(CL) :: hist_file ! Local path to history filename - character(CS) :: cpl_inst_tag ! instance tag - character(CL) :: freq_option ! freq_option setting (ndays, nsteps, etc) - integer :: freq_n ! freq_n setting relative to freq_option - logical :: alarmIsOn ! generic alarm flag - real(r8) :: tbnds(2) ! CF1.0 time bounds - logical :: whead,wdata ! for writing restart/history cdf files - integer :: dbrc - integer :: iam - logical,save :: first_call = .true. + type(ESMF_FieldBundle) :: c2a_fb, a2c_fb + type(ESMF_FieldBundle) :: c2l_fb_atm, c2l_fb_rof, l2c_fb_atm, l2c_fb_rof + type(ESMF_FieldBundle) :: c2r_fb, r2c_fb + type(ESMF_VM) :: vm + type(ESMF_Time) :: currtime + type(ESMF_Time) :: reftime + type(ESMF_Time) :: starttime + type(ESMF_Time) :: nexttime + type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time + type(ESMF_Calendar) :: calendar ! calendar type + character(len=CS) :: currtimestr + integer :: nx_atm, ny_atm + integer :: nx_lnd, ny_lnd + integer :: nx_rof, ny_rof + character(len=CS) :: nexttimestr + character(CS) :: histavg_option ! Histavg option units + integer :: i,j,m,n,n1,ncnt + integer :: start_ymd ! Starting date YYYYMMDD + integer :: start_tod ! Starting time-of-day (s) + integer :: nx,ny ! global grid size + integer :: yr,mon,day,sec ! time units + real(r8) :: rval ! real tmp value + real(r8) :: dayssince ! Time interval since reference time + integer :: fk ! index + character(CL) :: time_units ! units of time variable + character(CL) :: case_name ! case name + character(CL) :: hist_file ! Local path to history filename + character(CS) :: cpl_inst_tag ! instance tag + character(CL) :: freq_option ! freq_option setting (ndays, nsteps, etc) + integer :: freq_n ! freq_n setting relative to freq_option + logical :: alarmIsOn ! generic alarm flag + real(r8) :: tbnds(2) ! CF1.0 time bounds + logical :: whead,wdata ! for writing restart/history cdf files + integer :: dbrc + integer :: iam + logical,save :: first_call = .true. character(len=*), parameter :: subname='(lilac_history_write)' !--------------------------------------- @@ -236,33 +248,61 @@ subroutine lilac_history_write(atm2lnd_a_state, atm2lnd_l_state, lnd2atm_l_state if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - nx = 72 ! hard-wire for now - ny = 46 ! hard-wire for now + nx_atm = ldomain%ni + ny_atm = ldomain%nj + nx_lnd = ldomain%ni + ny_lnd = ldomain%nj + nx_rof = 720 !TODO: remove this hard-wiring + ny_rof = 360 !TODO: remove this hard-wiring - call ESMF_StateGet(atm2lnd_a_state, 'a2c_fb', a2c_fb) ! from atm + call ESMF_StateGet(cpl2atm_state, 'c2a_fb', c2a_fb) ! to atm if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, a2c_fb, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='a2c_from_atm', rc=rc) + call lilac_io_write(hist_file, iam, c2a_fb, & + nx=nx_atm, ny=ny_atm, nt=1, whead=whead, wdata=wdata, pre='cpl_to_atm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(atm2lnd_l_state, 'c2l_fb', c2l_fb) ! to land + call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_atm', c2l_fb_atm) ! to land if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, c2l_fb, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='c2l_to_land', rc=rc) + call lilac_io_write(hist_file, iam, c2l_fb_atm, & + nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='cpl_to_lnd_atm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(lnd2atm_l_state, 'l2c_fb', l2c_fb) ! from land + ! call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_rof', c2l_fb_rof) ! to land + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call lilac_io_write(hist_file, iam, c2l_fb_rof, & + ! nx=nx_lnd, ny=ny_lnd, nt=1, whead=.true., wdata=wdata, pre='cpl_to_lnd_rof', rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(cpl2rof_state, 'c2r_fb', c2r_fb) ! to rof if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, c2l_fb, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='l2c_from_land', rc=rc) + call lilac_io_write(hist_file, iam, c2r_fb, & + nx=nx_rof, ny=ny_rof, nt=1, whead=whead, wdata=wdata, pre='cpl_to_rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(lnd2atm_a_state, 'c2a_fb', c2a_fb) ! to atm + call ESMF_StateGet(atm2cpl_state, 'a2c_fb', a2c_fb) ! from atm if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, c2l_fb, & - nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='c2a_to_atm', rc=rc) + call lilac_io_write(hist_file, iam, a2c_fb, & + nx=nx_atm, ny=ny_atm, nt=1, whead=whead, wdata=wdata, pre='atm_to_cpl', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_atm', l2c_fb_atm) ! from land + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, l2c_fb_atm, & + nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_rof', l2c_fb_rof) ! from land + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call lilac_io_write(hist_file, iam, l2c_fb_rof, & + ! nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_rof', rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! call ESMF_StateGet(rof2cpl_state, 'r2c_fb', r2c_fb) ! from rof + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call lilac_io_write(hist_file, iam, r2c_fb, & + ! nx=nx_rof, ny=ny_rof, nt=1, whead=whead, wdata=wdata, pre='rof_to_cpl', rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + enddo call lilac_io_close(hist_file, iam, rc=rc) @@ -282,6 +322,4 @@ subroutine lilac_history_write(atm2lnd_a_state, atm2lnd_l_state, lnd2atm_l_state end subroutine lilac_history_write - !=============================================================================== - end module lilac_history diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 3da662f34f..da45c6219a 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -7,42 +7,52 @@ module lilac_mod ! know about ESMF !----------------------------------------------------------------------- + ! External libraries use ESMF + use mct_mod , only : mct_world_init + + ! shr code routines + use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 + use shr_sys_mod , only : shr_sys_abort ! lilac routines use lilac_io , only : lilac_io_init use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd use lilac_utils , only : gindex_atm, atm_mesh_filename use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register + use lilac_cpl , only : cpl_lnd2rof_register, cpl_rof2lnd_register use lilac_atmcap , only : lilac_atmos_register use lilac_atmaero , only : lilac_atmaero_init use lilac_atmaero , only : lilac_atmaero_interp use lilac_history , only : lilac_history_write use lilac_methods , only : chkerr - ! shr code routines - use shr_pio_mod , only : shr_pio_init1 - use shr_sys_mod , only : shr_sys_abort - ! ctsm routines use lnd_comp_esmf , only : lnd_register ! ctsm routine + ! mosart routines + use rof_comp_esmf , only : rof_register ! mosart routine + implicit none public :: lilac_init public :: lilac_run ! Gridded components and states in gridded components - type(ESMF_GridComp) :: atm_gcomp - type(ESMF_GridComp) :: lnd_gcomp + type(ESMF_GridComp) :: atm_gcomp + type(ESMF_GridComp) :: lnd_gcomp + type(ESMF_GridComp) :: rof_gcomp ! Coupler components - type(ESMF_CplComp) :: cpl_atm2lnd_comp - type(ESMF_CplComp) :: cpl_lnd2atm_comp + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp + type(ESMF_CplComp) :: cpl_lnd2rof_comp + type(ESMF_CplComp) :: cpl_rof2lnd_comp ! States - type(ESMF_State) :: atm2lnd_a_state, atm2lnd_l_state - type(ESMF_State) :: lnd2atm_l_state, lnd2atm_a_state + type(ESMF_State) :: atm2cpl_state, cpl2atm_state ! on atm mesh (1 field bundle) + type(ESMF_State) :: lnd2cpl_state, cpl2lnd_state ! on lnd mesh (2 field bundles) + type(ESMF_State) :: rof2cpl_state, cpl2rof_state ! on rof mesh (1 field bundle) ! Clock, TimeInterval, and Times type(ESMF_Clock) :: lilac_clock @@ -50,18 +60,17 @@ module lilac_mod type(ESMF_Alarm) :: lilac_restart_alarm type(ESMF_Alarm) :: lilac_stop_alarm - character(*) , parameter :: modname = "lilac_mod" - - integer :: mytask + integer :: mytask - character(*), parameter :: u_FILE_u = & + character(*) , parameter :: modname = "lilac_mod" + character(*), parameter :: u_FILE_u = & __FILE__ !======================================================================== contains !======================================================================== - subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & + subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lats, & atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs) @@ -71,20 +80,21 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! -------------------------------------------------------------------------------- ! input/output variables - character(len=*) , intent(in) :: atm_mesh_file - integer , intent(in) :: atm_global_index(:) - real , intent(in) :: atm_lons(:) - real , intent(in) :: atm_lats(:) - character(len=*) , intent(in) :: atm_calendar - integer , intent(in) :: atm_timestep - integer , intent(in) :: atm_start_year !(yyyy) - integer , intent(in) :: atm_start_mon !(mm) - integer , intent(in) :: atm_start_day - integer , intent(in) :: atm_start_secs - integer , intent(in) :: atm_stop_year !(yyyy) - integer , intent(in) :: atm_stop_mon !(mm) - integer , intent(in) :: atm_stop_day - integer , intent(in) :: atm_stop_secs + integer , intent(inout) :: mpicom ! input commiunicator from atm + character(len=*) , intent(in) :: atm_mesh_file + integer , intent(in) :: atm_global_index(:) + real , intent(in) :: atm_lons(:) + real , intent(in) :: atm_lats(:) + character(len=*) , intent(in) :: atm_calendar + integer , intent(in) :: atm_timestep + integer , intent(in) :: atm_start_year !(yyyy) + integer , intent(in) :: atm_start_mon !(mm) + integer , intent(in) :: atm_start_day + integer , intent(in) :: atm_start_secs + integer , intent(in) :: atm_stop_year !(yyyy) + integer , intent(in) :: atm_stop_mon !(mm) + integer , intent(in) :: atm_stop_day + integer , intent(in) :: atm_stop_secs ! local variables type(ESMF_TimeInterval) :: timeStep @@ -98,42 +108,64 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & integer :: rc character(len=ESMF_MAXSTR) :: cname !components or cpl names integer :: ierr - integer :: mpic ! mpi communicator integer :: n, i integer :: fileunit integer, parameter :: debug = 1 !-- internal debug level character(len=*), parameter :: subname=trim(modname)//': [lilac_init] ' + + ! initialization of mct and pio + integer :: ncomps = 1 ! for mct + integer, pointer :: mycomms(:) ! for mct + integer, pointer :: myids(:) ! for mct + integer :: compids(1) = (/1/) ! for pio_init2 - array with component ids + integer :: comms(1) ! for both mct and pio_init2 - array with mpicoms + character(len=32) :: compLabels(1) = (/'LND'/) ! for pio_init2 + character(len=64) :: comp_name(1) = (/'LND'/) ! for pio_init2 + logical :: comp_iamin(1) = (/.true./) ! for pio init2 !------------------------------------------------------------------------ ! Initialize return code rc = ESMF_SUCCESS + !------------------------------------------------------------------------- + ! Initialize pio with first initialization + ! AFTER call to MPI_init (which is in the host atm driver) and + ! BEFORE call to ESMF_Initialize + !------------------------------------------------------------------------- + call shr_pio_init1(ncomps=1, nlfilename="lilac_in", Global_Comm=mpicom) + !------------------------------------------------------------------------- ! Initialize ESMF, set the default calendar and log type. !------------------------------------------------------------------------- ! TODO: cannot assume that the calendar is always gregorian unless CTSM assumes this as well ! Need to coordinate the calendar info between lilac and the host component - call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN, logappendflag=.false., rc=rc) + call ESMF_Initialize(mpiCommunicator=mpicom, defaultCalKind=ESMF_CALKIND_GREGORIAN, & + logappendflag=.false., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogSet(flush=.true.) - call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) call ESMF_LogWrite(subname//"Initializing ESMF ", ESMF_LOGMSG_INFO) - !------------------------------------------------------------------------- - ! Initialize pio with first initialization - !------------------------------------------------------------------------- - - ! Initialize pio (needed by CTSM) - TODO: this should be done within CTSM not here - call ESMF_VMGetGlobal(vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=mytask, mpiCommunicator=mpic, rc=rc) + call ESMF_VMGet(vm, localPet=mytask, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_pio_init1(ncomps=1, nlfilename="lilac_in", Global_Comm=mpic) + !------------------------------------------------------------------------- + ! Initialize MCT (this is needed for data model functionality) + !------------------------------------------- + allocate(mycomms(1), myids(1)) + mycomms = (/mpicom/) ; myids = (/1/) + call mct_world_init(ncomps, mpicom, mycomms, myids) + call ESMF_LogWrite(subname//"initialized mct ... ", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------- + ! Initialize PIO with second initialization + !------------------------------------------------------------------------- + call shr_pio_init2(compids, compLabels, comp_iamin, (/mpicom/), (/mytask/)) + call ESMF_LogWrite(subname//"initialized shr_pio_init2 ...", ESMF_LOGMSG_INFO) !------------------------------------------------------------------------- ! Initial lilac_utils module variables @@ -148,7 +180,8 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & atm_mesh_filename = atm_mesh_file ! Initialize datatypes atm2lnd and lnd2atm - ! This must be done BEFORE the component initialization + ! This must be done BEFORE the atmcap initialization - since the dataptr attributes + ! are only needed to initialize the atmcap field bundles call lilac_init_atm2lnd(lsize) call lilac_init_lnd2atm(lsize) @@ -174,6 +207,17 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & print *, trim(subname) // " ctsm gridded component created" end if + !------------------------------------------------------------------------- + ! Create Gridded Component -- MOSART river + !------------------------------------------------------------------------- + cname = " MOSART " + rof_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac mosart initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, trim(subname) // " mosart gridded component created" + end if + !------------------------------------------------------------------------- ! Create Coupling Component! --- Coupler from atmos to land !------------------------------------------------------------------------- @@ -197,7 +241,29 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & end if !------------------------------------------------------------------------- - ! Register section -- set services -- atmos_cap + ! Create Coupling Component! --- Coupler from rof to land + !------------------------------------------------------------------------- + cname = "Coupler from river to land" + cpl_rof2lnd_comp = ESMF_CplCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_r2l initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, trim(subname) // " coupler component (atmosphere to land) created" + end if + + !------------------------------------------------------------------------- + ! Create Coupling Component! -- Coupler from land to atmos + !------------------------------------------------------------------------- + cname = "Coupler from land to river" + cpl_lnd2rof_comp = ESMF_CplCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_l2r initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, trim(subname) // " coupler component (land to atmosphere) created" + end if + + !------------------------------------------------------------------------- + ! Register section -- set services -- atmcap !------------------------------------------------------------------------- call ESMF_GridCompSetServices(atm_gcomp, userRoutine=lilac_atmos_register, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('atm_gcomp register failure') @@ -207,11 +273,21 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & end if !------------------------------------------------------------------------- - ! Register section -- set services -- land cap + ! Register section -- set services -- ctsm !------------------------------------------------------------------------- call ESMF_GridCompSetServices(lnd_gcomp, userRoutine=lnd_register, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('lnd_gcomp register failure') - call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"CSTM SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, trim(subname) // " CTSM setservices finished" + end if + + !------------------------------------------------------------------------- + ! Register section -- set services -- mosart + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(rof_gcomp, userRoutine=rof_register, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('rof_gcomp register failure') + call ESMF_LogWrite(subname//"MOSART SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, trim(subname) // " CTSM setservices finished" end if @@ -226,6 +302,16 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & print *, trim(subname) // " coupler from atmosphere to land setservices finished" end if + !------------------------------------------------------------------------- + ! Register section -- set services -- river to land + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_rof2lnd_comp, userRoutine=cpl_rof2lnd_register, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_rof2lnd_comp register failure') + call ESMF_LogWrite(subname//"Coupler from river to land SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, trim(subname) // " coupler from river to land setservices finished" + end if + !------------------------------------------------------------------------- ! Register section -- set services -- coupler land to atmosphere !------------------------------------------------------------------------- @@ -236,6 +322,16 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & print *, trim(subname) // " coupler from land to atmosphere setservices finished" end if + !------------------------------------------------------------------------- + ! Register section -- set services -- coupler land to river + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_lnd2rof_comp, userRoutine=cpl_lnd2rof_register, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2rof_comp register failure') + call ESMF_LogWrite(subname//"Coupler from land to river SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + print *, trim(subname) // " coupler from land to river setservices finished" + end if + !------------------------------------------------------------------------- ! Create and initialize the lilac_clock and calendar !------------------------------------------------------------------------- @@ -286,12 +382,12 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! between components. (these are module variables) ! ------------------------------------------------------------------------- - atm2lnd_a_state = ESMF_StateCreate(name='state_from_atm_on_atm_mesh', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + atm2cpl_state = ESMF_StateCreate(name='state_from_atm', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - lnd2atm_a_state = ESMF_StateCreate(name='state_from_land_on_atm_mesh', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + cpl2atm_state = ESMF_StateCreate(name='state_to_atm', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompInitialize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, & + call ESMF_GridCompInitialize(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing atmcap") call ESMF_LogWrite(subname//"lilac_atm gridded component initialized", ESMF_LOGMSG_INFO) @@ -302,30 +398,63 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! between components. (these are module variables) ! ------------------------------------------------------------------------- - atm2lnd_l_state = ESMF_StateCreate(name='state_from_atm_on_land_mesh', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + cpl2lnd_state = ESMF_StateCreate(name='state_to_land', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - lnd2atm_l_state = ESMF_StateCreate(name='state_from_land_on_land_mesh', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + lnd2cpl_state = ESMF_StateCreate(name='state_fr_land', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompInitialize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, & + call ESMF_GridCompInitialize(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing ctsm") call ESMF_LogWrite(subname//"CTSM gridded component initialized", ESMF_LOGMSG_INFO) + ! ------------------------------------------------------------------------- + ! Initialze MOSART Gridded Component + ! First Create the empty import and export states used to pass data + ! between components. (these are module variables) + ! ------------------------------------------------------------------------- + + cpl2rof_state = ESMF_StateCreate(name='state_to_river', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + rof2cpl_state = ESMF_StateCreate(name='state_fr_river', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompInitialize(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing mosart") + call ESMF_LogWrite(subname//"MOSART gridded component initialized", ESMF_LOGMSG_INFO) + ! ------------------------------------------------------------------------- ! Initialze LILAC coupler components ! ------------------------------------------------------------------------- - call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, & + ! Note that the lnd2cpl_state and cpl2lnd_state are each made up of 2 field bundles, + ! one for the river and one for the atm - + + ! The following fills in the atm field bundle in cpl2lnd_state + call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_atm2lnd component") call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) - call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, & + ! The following fills in the rof field bundle in cpl2lnd_state + call ESMF_CplCompInitialize(cpl_rof2lnd_comp, importState=rof2cpl_state, exportState=cpl2lnd_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) + ! The following maps the atm field bundle in lnd2cpl_state to the atm mesh + call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2cpl_state, exportState=cpl2atm_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") + call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) + + ! The following maps the rof field bundle in lnd2cpl_state to the rof mesh + call ESMF_CplCompInitialize(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2rof component") + call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) + if (mytask == 0) then print *, trim(subname) // "finished lilac initialization" end if @@ -341,7 +470,7 @@ subroutine lilac_init(atm_mesh_file, atm_global_index, atm_lons, atm_lats, & ! Initialize atmaero stream data (using share strearm capability from CIME) !------------------------------------------------------------------------- - call lilac_atmaero_init(atm2lnd_a_state, rc) + call lilac_atmaero_init(atm2cpl_state, rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing lilac_atmaero_init") end subroutine lilac_init @@ -380,28 +509,28 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") end if - ! Run lilac atmcap - update the atm2lnd_a_state + ! Run lilac atmcap - update the cpl2atm_state call ESMF_LogWrite(subname//"running lilac atmos_cap", ESMF_LOGMSG_INFO) if (mytask == 0) print *, "Running atmos_cap gridded component , rc =", rc - call ESMF_GridCompRun(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, & + call ESMF_GridCompRun(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") - ! Update prescribed aerosols atm2lnd_a_state - call lilac_atmaero_interp(atm2lnd_a_state, lilac_clock, rc=rc) + ! Update prescribed aerosols atm2cpl_a_state + call lilac_atmaero_interp(atm2cpl_state, lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac_atmaero_interp") ! Run cpl_atm2lnd call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) print *, "Running coupler component..... cpl_atm2lnd_comp" - call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, & + call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_atm2lnd") ! Run ctsm call ESMF_LogWrite(subname//"running ctsm", ESMF_LOGMSG_INFO) if (mytask == 0) print *, "Running ctsm" - call ESMF_GridCompRun(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, & + call ESMF_GridCompRun(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") @@ -410,13 +539,34 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) if (mytask == 0) then print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc end if - call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, & + call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2cpl_state, exportState=cpl2atm_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in cpl_lnd2atm") + ! Run cpl_lnd2rof + call ESMF_LogWrite(subname//"running cpl_lnd2rof_comp ", ESMF_LOGMSG_INFO) + if (mytask == 0) print *, "Running coupler component..... cpl_lnd2rof_comp" + call ESMF_CplCompRun(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_lnd2rof") + + ! Run mosart + call ESMF_LogWrite(subname//"running mosart", ESMF_LOGMSG_INFO) + if (mytask == 0) print *, "Running mosart" + call ESMF_GridCompRun(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") + + ! Run cpl_rof2lnd + ! call ESMF_LogWrite(subname//"running cpl_rof2lnd_comp ", ESMF_LOGMSG_INFO) + ! if (mytask == 0) print *, "Running coupler component..... cpl_rof2lnd_comp" + ! call ESMF_CplCompRun(cpl_rof2lnd_comp, importState=rof2cpl_state, exportState=cpl2lnd_state, & + ! clock=lilac_clock, rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_rof2lnd") + ! Write out history output - call lilac_history_write(atm2lnd_a_state, atm2lnd_l_state, lnd2atm_l_state, lnd2atm_a_state, & - lilac_clock, rc) + call lilac_history_write(atm2cpl_state, lnd2cpl_state, rof2cpl_state, & + cpl2atm_state, cpl2lnd_state, cpl2rof_state, lilac_clock, rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in history write") ! Advance the time at the end of the time step @@ -451,7 +601,7 @@ subroutine lilac_final( ) !------------------------------------------------------------------------- ! Gridded Component Finalizing! --- atmosphere !------------------------------------------------------------------------- - call ESMF_GridCompFinalize(atm_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=lilac_clock, rc=rc) + call ESMF_GridCompFinalize(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp is running", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -461,7 +611,7 @@ subroutine lilac_final( ) !------------------------------------------------------------------------- ! Coupler component Finalizing --- coupler atmos to land !------------------------------------------------------------------------- - call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=lilac_clock, rc=rc) + call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -471,7 +621,7 @@ subroutine lilac_final( ) !------------------------------------------------------------------------- ! Gridded Component Finalizing! --- land !------------------------------------------------------------------------- - call ESMF_GridCompFinalize(lnd_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=lilac_clock, rc=rc) + call ESMF_GridCompFinalize(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp is running", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -481,7 +631,7 @@ subroutine lilac_final( ) !------------------------------------------------------------------------- ! Coupler component Finalizing --- coupler land to atmos !------------------------------------------------------------------------- - call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=lilac_clock, rc=rc) + call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=cpl2lnd_state, exportState=cpl2atm_state, clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -495,13 +645,17 @@ subroutine lilac_final( ) if (mytask == 0) then print *, "ready to destroy all states" end if - call ESMF_StateDestroy(atm2lnd_a_state , rc=rc) + call ESMF_StateDestroy(atm2cpl_state , rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateDestroy(atm2lnd_l_state, rc=rc) + call ESMF_StateDestroy(cpl2atm_state, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateDestroy(lnd2atm_a_state, rc=rc) + call ESMF_StateDestroy(lnd2cpl_state, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateDestroy(lnd2atm_l_state, rc=rc) + call ESMF_StateDestroy(cpl2lnd_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(rof2cpl_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(cpl2rof_state, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_LogWrite(subname//"destroying all components ", ESMF_LOGMSG_INFO) @@ -513,8 +667,10 @@ subroutine lilac_final( ) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_GridCompDestroy(lnd_gcomp, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_CplCompDestroy(cpl_atm2lnd_comp, rc=rc) + call ESMF_GridCompDestroy(rof_gcomp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompDestroy(cpl_atm2lnd_comp, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_CplCompDestroy(cpl_lnd2atm_comp, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) diff --git a/lilac/src/lilac_utils.F90 b/lilac/src/lilac_utils.F90 index 2c6b6d343e..89e4fb3130 100644 --- a/lilac/src/lilac_utils.F90 +++ b/lilac/src/lilac_utils.F90 @@ -123,23 +123,29 @@ subroutine lilac_init_lnd2atm(lsize) integer, intent(in) :: lsize integer :: n - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_lfrin' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_t' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_tref' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_qref' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdr' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_anidr' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_avsdf' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_anidf' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_snowh' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_u10' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_fv' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Sl_ram1' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Fall_lwup' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Fall_taux' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Fall_tauy' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Fall_evap' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm, fldname='Fall_swnet', units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_lfrin' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_t' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_tref' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_qref' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_avsdr' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_anidr' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_avsdf' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_anidf' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_snowh' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_u10' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_fv' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_ram1' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_taux' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_tauy' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_lat' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_sen' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_lwup' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_evap' , units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_swnet', units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_flxdst1', units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_flxdst2', units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_flxdst3', units='unknown', lsize=lsize) + call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_flxdst4', units='unknown', lsize=lsize) ! now add dataptr memory for all of the fields do n = 1,size(lnd2atm) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 6cbaa419c1..d808edefa8 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -229,10 +229,6 @@ def buildnml(rundir, bldnmldir): os.remove(os.path.join(rundir, "env_lilac.xml")) os.remove(os.path.join(rundir, "drv_flds_in")) - # copy lilac_in to rundir - mesh file is defined in lilac_in - shutil.copy(os.path.join(bldnmldir,"lilac_in"), - os.path.join(rundir, "lilac_in")) - ############################################################################### if __name__ == "__main__": diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index f27ac92767..a0db265893 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -8,18 +8,17 @@ module lnd_comp_esmf ! external libraries use ESMF use mpi , only : MPI_BCAST, MPI_CHARACTER - use mct_mod , only : mct_world_init use perf_mod , only : t_startf, t_stopf, t_barrierf use lilac_utils , only : lilac_field_bundle_to_land, lilac_field_bundle_fr_land ! cime share code - use shr_pio_mod , only : shr_pio_init2 use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl use shr_sys_mod , only : shr_sys_abort use shr_file_mod , only : shr_file_setLogUnit, shr_file_getLogUnit use shr_orb_mod , only : shr_orb_decl, shr_orb_params use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date - use glc_elevclass_mod , only : glc_elevclass_init ! TODO: is this needed? + use shr_nl_mod , only : shr_nl_find_group_name + use glc_elevclass_mod , only : glc_elevclass_init ! ctsm code use spmdMod , only : masterproc, spmd_init, mpicom @@ -28,7 +27,7 @@ module lnd_comp_esmf use controlMod , only : control_setNL use clm_varorb , only : eccen, obliqr, lambm0, mvelpp use clm_varctl , only : clm_varctl_set, iulog, finidat - use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch + use clm_varctl , only : nsrStartup, nsrContinue use clm_varctl , only : inst_index, inst_suffix, inst_name use clm_time_manager , only : set_timemgr_init, advance_timestep use clm_time_manager , only : set_nextsw_cday, update_rad_dtime @@ -103,74 +102,65 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) integer, intent(out) :: rc ! Return code ! local variable - integer :: ierr ! error code - integer :: n,g,i,j ! indices - logical :: exists ! true if file exists - real(r8) :: nextsw_cday ! calday from clock of next radiation computation - character(len=CL) :: caseid ! case identifier name - character(len=CL) :: ctitle ! case description title - character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) - integer :: nsrest ! clm restart type - logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type - logical :: atm_aero ! Flag if aerosol data sent from atm model - integer :: lbnum ! input to memory diagnostic - integer :: shrlogunit ! old values for log unit and log level - type(bounds_type) :: bounds ! bounds - - ! generation of field bundles + integer :: ierr ! error code + integer :: n,g,i,j ! indices + logical :: exists ! true if file exists + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + character(len=CL) :: caseid ! case identifier name + character(len=CL) :: ctitle ! case description title + character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) + integer :: nsrest ! clm restart type + logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type + logical :: atm_aero ! Flag if aerosol data sent from atm model + integer :: lbnum ! input to memory diagnostic + integer :: shrlogunit ! old values for log unit and log level + type(bounds_type) :: bounds ! bounds + + ! generation of field bundles type(ESMF_State) :: importState, exportState - type(ESMF_FieldBundle) :: c2l_fb - type(ESMF_FieldBundle) :: l2c_fb + type(ESMF_FieldBundle) :: c2l_fb_atm, c2l_fb_rof ! field bundles in import state + type(ESMF_FieldBundle) :: l2c_fb_atm, l2c_fb_rof ! field bundles in export state - ! mesh generation + ! mesh generation type(ESMF_Mesh) :: lnd_mesh - character(ESMF_MAXSTR) :: lnd_mesh_filename ! full filepath of land mesh file - integer :: nlnd, nocn ! local size ofarrays - integer, pointer :: gindex(:) ! global index space for land and ocean points - integer, pointer :: gindex_lnd(:) ! global index space for just land points - integer, pointer :: gindex_ocn(:) ! global index space for just ocean points + character(ESMF_MAXSTR) :: lnd_mesh_filename ! full filepath of land mesh file + integer :: nlnd, nocn ! local size ofarrays + integer, pointer :: gindex(:) ! global index space for land and ocean points + integer, pointer :: gindex_lnd(:) ! global index space for just land points + integer, pointer :: gindex_ocn(:) ! global index space for just ocean points type(ESMF_DistGrid) :: distgrid integer :: fileunit - ! clock info - character(len=CL) :: calendar ! calendar type name - type(ESMF_CalKind_Flag) :: caltype ! calendar type from lilac clock - integer :: curr_tod, curr_ymd ! current time info - integer :: yy, mm, dd ! query output from lilac clock - integer :: dtime_lilac ! coupling time-step from the input lilac clock - integer :: ref_ymd ! reference date (YYYYMMDD) - integer :: ref_tod ! reference time of day (sec) - integer :: start_ymd ! start date (YYYYMMDD) - integer :: start_tod ! start time of day (sec) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) - type(ESMF_Time) :: currTime ! Current time - type(ESMF_Time) :: startTime ! Start time - type(ESMF_Time) :: stopTime ! Stop time - type(ESMF_Time) :: refTime ! Ref time - type(ESMF_TimeInterval) :: timeStep ! time step from lilac clock - - ! orbital info - integer :: orb_iyear_align ! associated with model year - integer :: orb_cyear ! orbital year for current orbital computation - integer :: orb_iyear ! orbital year for current orbital computation - integer :: orb_eccen ! orbital year for current orbital computation - - ! for pio_init2 and mct + ! clock info + character(len=CL) :: calendar ! calendar type name + type(ESMF_CalKind_Flag) :: caltype ! calendar type from lilac clock + integer :: curr_tod, curr_ymd ! current time info + integer :: yy, mm, dd ! query output from lilac clock + integer :: dtime_lilac ! coupling time-step from the input lilac clock + integer :: ref_ymd ! reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (sec) + integer :: start_ymd ! start date (YYYYMMDD) + integer :: start_tod ! start time of day (sec) + integer :: stop_ymd ! stop date (YYYYMMDD) + integer :: stop_tod ! stop time of day (sec) + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: startTime ! Start time + type(ESMF_Time) :: stopTime ! Stop time + type(ESMF_Time) :: refTime ! Ref time + type(ESMF_TimeInterval) :: timeStep ! time step from lilac clock + + ! orbital info + integer :: orb_iyear_align ! associated with model year + integer :: orb_cyear ! orbital year for current orbital computation + integer :: orb_iyear ! orbital year for current orbital computation + integer :: orb_eccen ! orbital year for current orbital computation + type(ESMF_VM) :: vm integer :: mpicom_vm - integer :: ncomps = 1 ! for mct - integer, pointer :: mycomms(:) ! for mct - integer, pointer :: myids(:) ! for mct - integer :: compids(1) = (/1/) ! for both mct and pio_init2 - array with component ids - integer :: comms(1) ! for both mct and pio_init2 - array with mpicoms - character(len=32) :: compLabels(1) = (/'LND'/) ! for pio_init2 - character(len=64) :: comp_name(1) = (/'LND'/) ! for pio_init2 - logical :: comp_iamin(1) = (/.true./) ! for pio init2 - integer :: iam(1) ! for pio_init2 - - ! input namelist read for ctsm mesh - namelist /lnd_mesh_inparm/ lnd_mesh_filename + + ! input namelist read for ctsm mesh and run info + namelist /lilac_lnd_input/ lnd_mesh_filename + namelist /lilac_run_input/ caseid, starttype character(len=*), parameter :: subname=trim(modName)//': (lnd_init) ' !------------------------------------------------------------------------ @@ -185,28 +175,10 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, localPet=iam(1), rc=rc) + call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return call ESMF_LogWrite(subname//"ESMF_VMGet", ESMF_LOGMSG_INFO) - !------------------------------------------------------------------------ - ! Initialize pio_init2 TODO: is this needed here? - !------------------------------------------------------------------------ - - comms(1) = mpicom_vm - call shr_pio_init2(compids, compLabels, comp_iamin, comms, iam) - call ESMF_LogWrite(subname//"initialized shr_pio_init2 ...", ESMF_LOGMSG_INFO) - - !------------------------------------------------------------------------ - ! Initialize mct - needed for data model share code - e.g. nitrogen deposition - !------------------------------------------------------------------------ - - allocate(mycomms(1), myids(1)) - mycomms = (/mpicom_vm/) ; myids = (/1/) - - call mct_world_init(ncomps, mpicom_vm, mycomms, myids) - call ESMF_LogWrite(subname//"initialized mct ... ", ESMF_LOGMSG_INFO) - !------------------------------------------------------------------------ ! Initialize internal ctsm MPI info !------------------------------------------------------------------------ @@ -270,9 +242,39 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !---------------------- call control_setNL("lnd_in") - ! TODO: how do we set case_name and nsrest - should we hardwire for now? - caseid = 'test_lilac' - nsrest = nsrStartup + !---------------------- + ! Read in lilac_in namelists + !---------------------- + + if (masterproc) then + open(newunit=fileunit, status="old", file="lilac_in") + call shr_nl_find_group_name(fileunit, 'lilac_run_input', ierr) + if (ierr == 0) then + read(fileunit, lilac_run_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of lilac_run_input') + end if + end if + call shr_nl_find_group_name(fileunit, 'lilac_lnd_input', ierr) + if (ierr == 0) then + read(fileunit, lilac_lnd_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of lilac_lnd_input') + end if + end if + close(fileunit) + end if + call mpi_bcast(lnd_mesh_filename, len(lnd_mesh_filename), MPI_CHARACTER, 0, mpicom, ierr) + call mpi_bcast(starttype, len(starttype), MPI_CHARACTER, 0, mpicom, ierr) + call mpi_bcast(caseid, len(caseid), MPI_CHARACTER, 0, mpicom, ierr) + + if (trim(starttype) == trim('startup')) then + nsrest = nsrStartup + else if (trim(starttype) == trim('continue') ) then + nsrest = nsrContinue + else + call shr_sys_abort( subname//' ERROR: unknown starttype'//trim(starttype) ) + end if !---------------------- ! Initialize module variables in clm_time_manger.F90 @@ -329,7 +331,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Initialize glc_elevclass module !---------------------- - call glc_elevclass_init(glc_nec) ! TODO: is this needed still? + call glc_elevclass_init(glc_nec) !---------------------- ! Call initialize1 @@ -385,20 +387,12 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) deallocate(gindex) call ESMF_LogWrite(subname//"DistGrid created......", ESMF_LOGMSG_INFO) - ! obtain the mesh filename from the namelist - if (masterproc) then - open(newunit=fileunit, status="old", file="lilac_in") - read(fileunit, lnd_mesh_inparm, iostat=ierr) - if (ierr > 0) then - call shr_sys_abort( 'problem on read of lilac_in') - end if - close(fileunit) - end if - call MPI_BCAST(lnd_mesh_filename, len(lnd_mesh_filename), MPI_CHARACTER, 0, mpicom, ierr) - ! create esmf mesh using distgrid and lnd_mesh_filename - lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, elementDistgrid=Distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + elementDistgrid=Distgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) then + call shr_sys_abort("Error in creating mesh "// trim(lnd_mesh_filename)) + end if if (masterproc) then write(iulog,*)'mesh file for domain is ',trim(lnd_mesh_filename) end if @@ -415,38 +409,70 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Create import state (only assume input from atm - not rof and glc) !-------------------------------- - ! NOTE: currently this must be the same list as in lilac_init_atm2lnd + ! create an empty field bundle for import of atm fields + c2l_fb_atm = ESMF_FieldBundleCreate (name='c2l_fb_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! create an empty field bundle - c2l_fb = ESMF_FieldBundleCreate (name='c2l_fb', rc=rc) + ! now add atm import fields on lnd_mesh to this field bundle + call lilac_field_bundle_to_land(lnd_mesh, c2l_fb_atm, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! now add fields on lnd_mesh to this field bundle - call lilac_field_bundle_to_land(lnd_mesh, c2l_fb, rc) + ! add the field bundle to the state + call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb_atm/)) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! add the field bundle to the export state - call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb/)) + ! create an empty field bundle for the import of rof fields + c2l_fb_rof = ESMF_FieldBundleCreate (name='c2l_fb_rof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fldbundle_add('Flrr_flood', c2l_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrr_volr', c2l_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrr_volrmch', c2l_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add the field bundle to the state + call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb_rof/)) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Create export state !-------------------------------- - ! NOTE: currently this must be the same list as in lilac_init_lnd2atm - - ! create an empty field bundle - l2c_fb = ESMF_FieldBundleCreate(name='l2c_fb', rc=rc) + ! create an empty field bundle for atm export fields + l2c_fb_atm = ESMF_FieldBundleCreate(name='l2c_fb_atm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! now add fields on lnd_mesh to this field bundle - call lilac_field_bundle_fr_land(lnd_mesh, l2c_fb, rc) + ! now add atm export fields on lnd_mesh to this field bundle + call lilac_field_bundle_fr_land(lnd_mesh, l2c_fb_atm, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! add the field bundle to the state - call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb/), rc=rc) + call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb_atm/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create an empty field bundle for rof export fields + l2c_fb_rof = ESMF_FieldBundleCreate(name='l2c_fb_rof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! now add rof export fields on lnd_mesh to this field bundle + call fldbundle_add('Flrl_rofsur', l2c_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_rofgwl', l2c_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_rofsub', l2c_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_rofi', l2c_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_irrig', l2c_fb_rof, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb_rof/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- - ! Create land export state + ! Fill in land export state !-------------------------------- call ESMF_LogWrite(subname//"Creating land export state", ESMF_LOGMSG_INFO) @@ -479,13 +505,13 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Set Attributes call ESMF_LogWrite(subname//"setting attribute!", ESMF_LOGMSG_INFO) - call ESMF_AttributeSet(export_state, name="lnd_nx", value=ldomain%ni, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_LogWrite(subname//"setting attribute! lnd_nx", ESMF_LOGMSG_INFO) + ! call ESMF_AttributeSet(export_state, name="lnd_nx", value=ldomain%ni, rc=rc) + ! if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + ! call ESMF_LogWrite(subname//"setting attribute lnd_nx", ESMF_LOGMSG_INFO) - call ESMF_AttributeSet(export_state, name="lnd_ny", value=ldomain%nj, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_LogWrite(subname//"setting attribute-lnd_ny!", ESMF_LOGMSG_INFO) + ! call ESMF_AttributeSet(export_state, name="lnd_ny", value=ldomain%nj, rc=rc) + ! if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + ! call ESMF_LogWrite(subname//"setting attribute lnd_ny!", ESMF_LOGMSG_INFO) !-------------------------------- ! diagnostics @@ -516,7 +542,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) contains !--------------------------- - subroutine fldbundle_add(stdname, fieldbundle,rc) + subroutine fldbundle_add(stdname, fieldbundle, rc) !--------------------------- ! Create an empty input field with name 'stdname' to add to fieldbundle !--------------------------- @@ -556,7 +582,6 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) type(ESMF_Alarm) :: alarm type(ESMF_Time) :: currTime type(ESMF_Time) :: nextTime - type(ESMF_State) :: importState, exportState character(ESMF_MAXSTR) :: cvalue integer :: ymd ! CTSM current date (YYYYMMDD) integer :: yr ! CTSM current year diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 0510eeff56..ac39ae1fc0 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -123,98 +123,129 @@ subroutine import_fields( gcomp, bounds, rc) ! Required atmosphere input fields !-------------------------- - call state_getimport(importState, 'Sa_z', bounds, output=atm2lnd_inst%forc_hgt_grc, rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Sa_z', bounds, & + output=atm2lnd_inst%forc_hgt_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sa_topo', bounds, output=atm2lnd_inst%forc_topo_grc, rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Sa_topo', bounds, & + output=atm2lnd_inst%forc_topo_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sa_u', bounds, output=atm2lnd_inst%forc_u_grc, rc=rc ) + call state_getimport(importState, 'c2l_fb_atm', 'Sa_u', bounds, & + output=atm2lnd_inst%forc_u_grc, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sa_v', bounds, output=atm2lnd_inst%forc_v_grc, rc=rc ) + call state_getimport(importState, 'c2l_fb_atm', 'Sa_v', bounds, & + output=atm2lnd_inst%forc_v_grc, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sa_ptem', bounds, output=atm2lnd_inst%forc_th_not_downscaled_grc, rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Sa_ptem', bounds, & + output=atm2lnd_inst%forc_th_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sa_shum', bounds, output=water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc, rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Sa_shum', bounds, & + output=water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sa_pbot', bounds, output=atm2lnd_inst%forc_pbot_not_downscaled_grc, rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Sa_pbot', bounds, & + output=atm2lnd_inst%forc_pbot_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sa_tbot', bounds, output=atm2lnd_inst%forc_t_not_downscaled_grc, rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Sa_tbot', bounds, & + output=atm2lnd_inst%forc_t_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_rainc', bounds, output=forc_rainc, rc=rc ) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_rainc', bounds, & + output=forc_rainc, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_rainl', bounds, output=forc_rainl, rc=rc ) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_rainl', bounds, & + output=forc_rainl, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_snowc', bounds, output=forc_snowc, rc=rc ) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_snowc', bounds, & + output=forc_snowc, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_snowl', bounds, output=forc_snowl, rc=rc ) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_snowl', bounds, & + output=forc_snowl, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_lwdn', bounds, output=atm2lnd_inst%forc_lwrad_not_downscaled_grc, rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_lwdn', bounds, & + output=atm2lnd_inst%forc_lwrad_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_swvdr', bounds, output=atm2lnd_inst%forc_solad_grc(:,1), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swvdr', bounds, & + output=atm2lnd_inst%forc_solad_grc(:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_swndr', bounds, output=atm2lnd_inst%forc_solad_grc(:,2), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swndr', bounds, & + output=atm2lnd_inst%forc_solad_grc(:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_swvdf', bounds, output=atm2lnd_inst%forc_solai_grc(:,1), rc=rc ) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swvdf', bounds, & + output=atm2lnd_inst%forc_solai_grc(:,1), rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_swndf', bounds, output=atm2lnd_inst%forc_solai_grc(:,2), rc=rc ) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swndf', bounds, & + output=atm2lnd_inst%forc_solai_grc(:,2), rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ! Atmosphere prognostic/prescribed aerosol fields - call state_getimport(importState, 'Faxa_bcphidry', bounds, output=atm2lnd_inst%forc_aer_grc(:,1), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphidry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_bcphodry', bounds, output=atm2lnd_inst%forc_aer_grc(:,2), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphodry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_bcphiwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,3), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphiwet', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,3), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_ocphidry', bounds, output=atm2lnd_inst%forc_aer_grc(:,4), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphidry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,4), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_ocphodry', bounds, output=atm2lnd_inst%forc_aer_grc(:,5), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphodry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,5), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_ocphiwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,6), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphiwet', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,6), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstwet1', bounds, output=atm2lnd_inst%forc_aer_grc(:,7), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet1', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,7), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry1', bounds, output=atm2lnd_inst%forc_aer_grc(:,8), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry1', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,8), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstwet2', bounds, output=atm2lnd_inst%forc_aer_grc(:,9), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet2', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,9), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry2', bounds, output=atm2lnd_inst%forc_aer_grc(:,10), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry2', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,10), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstwet3', bounds, output=atm2lnd_inst%forc_aer_grc(:,11), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet3', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,11), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry3', bounds, output=atm2lnd_inst%forc_aer_grc(:,12), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry3', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,12), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstwet4', bounds, output=atm2lnd_inst%forc_aer_grc(:,13), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet4', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,13), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry4', bounds, output=atm2lnd_inst%forc_aer_grc(:,14), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry4', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,14), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport(importState, 'Sa_methane', bounds, output=atm2lnd_inst%forc_pch4_grc, rc=rc ) + ! call state_getimport(importState, 'c2l_fb_atm', 'Sa_methane', bounds, output=atm2lnd_inst%forc_pch4_grc, rc=rc ) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! The lilac is sending ndep in units if kgN/m2/s - and ctsm uses units of gN/m2/sec ! so the following conversion needs to happen - ! call state_getimport(importState, 'Faxa_nhx', bounds, output=forc_nhx, rc=rc ) + ! call state_getimport(importState, 'c2l_fb_atm', 'Faxa_nhx', bounds, output=forc_nhx, rc=rc ) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport(importState, 'Faxa_noy', bounds, output=forc_noy, rc=rc ) + ! call state_getimport(importState, 'c2l_fb_atm', 'Faxa_noy', bounds, output=forc_noy, rc=rc ) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! do g = begg,endg ! atm2lnd_inst%forc_ndep_grc(g) = (forc_nhx(g) + forc_noy(g))*1000._r8 @@ -338,99 +369,127 @@ subroutine export_fields(gcomp, bounds, rc) ! output to atm ! ----------------------- - call state_setexport(exportState, 'Sl_lfrin', bounds, input=ldomain%frac, rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_lfrin', bounds, & + input=ldomain%frac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_t', bounds, input=lnd2atm_inst%t_rad_grc, rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_t', bounds, & + input=lnd2atm_inst%t_rad_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_snowh', bounds, input=water_inst%waterlnd2atmbulk_inst%h2osno_grc, rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_snowh', bounds, & + input=water_inst%waterlnd2atmbulk_inst%h2osno_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_avsdr', bounds, input=lnd2atm_inst%albd_grc(bounds%begg:,1), rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_avsdr', bounds, & + input=lnd2atm_inst%albd_grc(bounds%begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_anidr', bounds, input=lnd2atm_inst%albd_grc(bounds%begg:,2), rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_anidr', bounds, & + input=lnd2atm_inst%albd_grc(bounds%begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_avsdf', bounds, input=lnd2atm_inst%albi_grc(bounds%begg:,1), rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_avsdf', bounds, & + input=lnd2atm_inst%albi_grc(bounds%begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_anidf', bounds, input=lnd2atm_inst%albi_grc(bounds%begg:,2), rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_anidf', bounds, & + input=lnd2atm_inst%albi_grc(bounds%begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_tref', bounds, input=lnd2atm_inst%t_ref2m_grc, rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_tref', bounds, & + input=lnd2atm_inst%t_ref2m_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_qref', bounds, input=water_inst%waterlnd2atmbulk_inst%q_ref2m_grc, rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_qref', bounds, & + input=water_inst%waterlnd2atmbulk_inst%q_ref2m_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_u10', bounds, input=lnd2atm_inst%u_ref10m_grc, rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_u10', bounds, & + input=lnd2atm_inst%u_ref10m_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_taux', bounds, input=lnd2atm_inst%taux_grc, minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_taux', bounds, & + input=lnd2atm_inst%taux_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_tauy', bounds, input=lnd2atm_inst%tauy_grc, minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_tauy', bounds, & + input=lnd2atm_inst%tauy_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_lat', bounds, input=lnd2atm_inst%eflx_lh_tot_grc, minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_lat', bounds, & + input=lnd2atm_inst%eflx_lh_tot_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_sen', bounds, input=lnd2atm_inst%eflx_sh_tot_grc, minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_sen', bounds, & + input=lnd2atm_inst%eflx_sh_tot_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_lwup', bounds, input=lnd2atm_inst%eflx_lwrad_out_grc, minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_lwup', bounds, & + input=lnd2atm_inst%eflx_lwrad_out_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_evap', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_evap_tot_grc, minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_evap', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_evap_tot_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_swnet', bounds, input=lnd2atm_inst%fsa_grc, rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_swnet', bounds, & + input=lnd2atm_inst%fsa_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst1', bounds, input=lnd2atm_inst%flxdst_grc(:,1), minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst1', bounds, & + input=lnd2atm_inst%flxdst_grc(:,1), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst2', bounds, input=lnd2atm_inst%flxdst_grc(:,2), minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst2', bounds, & + input=lnd2atm_inst%flxdst_grc(:,2), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst3', bounds, input=lnd2atm_inst%flxdst_grc(:,3), minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst3', bounds, & + input=lnd2atm_inst%flxdst_grc(:,3), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst4', bounds, input=lnd2atm_inst%flxdst_grc(:,4), minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst4', bounds, & + input=lnd2atm_inst%flxdst_grc(:,4), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_ram1', bounds, input=lnd2atm_inst%ram1_grc, rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_ram1', bounds, & + input=lnd2atm_inst%ram1_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_fv', bounds, input=lnd2atm_inst%fv_grc, rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_fv', bounds, & + input=lnd2atm_inst%fv_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! methanem - ! call state_setexport(exportState, 'Fall_methane', bounds, input=lnd2atm_inst%flux_ch4_grc, minus=.true., rc=rc) + ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_methane', bounds, & + ! input=lnd2atm_inst%flux_ch4_grc, minus=.true., rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! soil water - ! call state_setexport(exportState, 'Sl_soilw', bounds, input=water_inst%waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) + ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_soilw', bounds, & + ! input=water_inst%waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! dry dep velocities ! do num = 1, drydep_nflds - ! call state_setexport(exportState, 'Sl_ddvel', bounds, input=lnd2atm_inst%ddvel_grc(:,num), ungridded_index=num, rc=rc) + ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_ddvel', bounds, & + ! input=lnd2atm_inst%ddvel_grc(:,num), ungridded_index=num, rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end do ! MEGAN VOC emis fluxes ! do num = 1, shr_megan_mechcomps_n - ! call state_setexport(exportState, 'Fall_voc', bounds, input=lnd2atm_inst%flxvoc_grc(:,num), minus=.true., ungridded_index=num, rc=rc) + ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_voc', bounds, & + ! input=lnd2atm_inst%flxvoc_grc(:,num), minus=.true., ungridded_index=num, rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end do ! fire emis fluxes ! do num = 1, emis_nflds - ! call state_setexport(exportState, 'Fall_fire', bounds, input=lnd2atm_inst%fireflx_grc(:,num), minus=.true., ungridded_index=num, rc=rc) + ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_fire', bounds, & + ! input=lnd2atm_inst%fireflx_grc(:,num), minus=.true., ungridded_index=num, rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end do ! if (emis_nflds > 0) then - ! call state_setexport(exportState, 'Sl_fztopo', bounds, input=lnd2atm_inst%fireztop_grc, rc=rc) + ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_fztopo', bounds, input=lnd2atm_inst%fireztop_grc, rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! endif ! sign convention is positive downward with hierarchy of atm/glc/lnd/rof/ice/ocn. @@ -442,37 +501,43 @@ subroutine export_fields(gcomp, bounds, rc) ! surface runoff is the sum of qflx_over, qflx_h2osfc_surf ! do g = bounds%begg,bounds%endg - ! array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) + ! array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + & + ! water_inst%waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) ! end do - ! call state_setexport(exportState, 'Flrl_rofsur', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofsur', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain - ! do g = bounds%begg,bounds%endg - ! array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & - ! water_inst%waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) - ! end do - ! call state_setexport(exportState, 'Flrl_rofsub', bounds, input=array, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain + do g = bounds%begg,bounds%endg + array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) + end do + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofsub', bounds, & + input=array, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ! qgwl sent individually to coupler - ! call state_setexport(exportState, 'Flrl_rofgwl', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! qgwl sent individually to coupler + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofgwl', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ! ice sent individually to coupler - ! call state_setexport(exportState, 'Flrl_rofi', bounds, input=water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! ice sent individually to coupler + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofi', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ! irrigation flux to be removed from main channel storage (negative) - ! call state_setexport(exportState, 'Flrl_irrig', bounds, input=water_inst%waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! irrigation flux to be removed from main channel storage (negative) + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_irrig', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine export_fields !=============================================================================== - subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) + subroutine state_getimport(state, fb, fldname, bounds, output, ungridded_index, rc) ! ---------------------------------------------- ! Map import state field to output array @@ -480,8 +545,9 @@ subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) ! input/output variables type(ESMF_State) , intent(in) :: state - type(bounds_type) , intent(in) :: bounds + character(len=*) , intent(in) :: fb character(len=*) , intent(in) :: fldname + type(bounds_type) , intent(in) :: bounds real(r8) , intent(out) :: output(bounds%begg:bounds%endg) integer, optional , intent(in) :: ungridded_index integer , intent(out) :: rc @@ -504,79 +570,65 @@ subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - ! Determine if field with name fldname exists in state - - !call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! print out what is in our state??? if (masterproc .and. debug > 0) then write(iulog,F01)' Show me what is in the state? for '//trim(fldname) call ESMF_StatePrint(state, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Determine if fieldbundle exists in state - call ESMF_StateGet(state, "c2l_fb", itemFlag, rc=rc) + ! Get the field bundle + call ESMF_StateGet(state, trim(fb), fieldBundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("ERROR: fb "//trim(fb)//" not found in import state") + + ! Get the field + call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! if fieldbundle exists then create output array - else do nothing - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - ! Get the field bundle??? - call ESMF_StateGet(state, "c2l_fb", fieldBundle, rc=rc) + ! Get the pointer to data in the field + if (present(ungridded_index)) then + write(cvalue,*) ungridded_index + call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname)//" index "//trim(cvalue), & + ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fb), trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(subname//'c2l_fb found and now ... getting '//trim(fldname), ESMF_LOGMSG_INFO) - call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, isPresent=isPresent, rc=rc) + else + call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname),ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fb), trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! Now for error checking we can put ... if (isPresent...) - ! get field pointer - if (present(ungridded_index)) then - write(cvalue,*) ungridded_index - call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname)//" index "//trim(cvalue), & - ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname),ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! determine output array - if (present(ungridded_index)) then - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr2d(ungridded_index,n) - end do - else - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr1d(n) - if (masterproc .and. debug > 0 .and. get_nstep() < 5) then - write(iulog,F02)' n, g , fldptr1d(n) '//trim(fldname)//' = ',n, g, fldptr1d(n) - end if - end do - end if - - ! write debug output if appropriate - if (masterproc .and. debug > 0 .and. get_nstep() < 5) then - do g = bounds%begg,bounds%endg - i = 1 + g - bounds%begg - write(iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,output(g) - end do - end if + ! Fill in output array + if (present(ungridded_index)) then + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + output(g) = fldptr2d(ungridded_index,n) + end do + else + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + output(g) = fldptr1d(n) + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + write(iulog,F02)' n, g , fldptr1d(n) '//trim(fldname)//' = ',n, g, fldptr1d(n) + end if + end do + end if - ! check for nans - call check_for_nans(output, trim(fldname), bounds%begg) + ! Write debug output if appropriate + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + do g = bounds%begg,bounds%endg + i = 1 + g - bounds%begg + write(iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,output(g) + end do end if + ! Check for nans + call check_for_nans(output, trim(fldname), bounds%begg) + end subroutine state_getimport !=============================================================================== - subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index, rc) + subroutine state_setexport(state, fb, fldname, bounds, input, minus, ungridded_index, rc) ! ---------------------------------------------- ! Map input array to export state field @@ -584,6 +636,7 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index ! input/output variables type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fb type(bounds_type) , intent(in) :: bounds character(len=*) , intent(in) :: fldname real(r8) , intent(in) :: input(bounds%begg:bounds%endg) @@ -596,73 +649,64 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index real(R8), pointer :: fldptr1d(:) real(R8), pointer :: fldptr2d(:,:) character(len=cs) :: cvalue - type(ESMF_StateItem_Flag) :: itemFlag character(len=*), parameter :: subname='(lnd_import_export:state_setexport)' ! ---------------------------------------------- rc = ESMF_SUCCESS - ! Determine if field with name fldname exists in state - call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) - if (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 + if (present(ungridded_index)) then + call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname)//" index "//trim(cvalue), & + ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fb), trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname), ESMF_LOGMSG_INFO) + call state_getfldptr(state, trim(fb), trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! get field pointer - if (present(ungridded_index)) then - call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname)//" index "//trim(cvalue), & - ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname), ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! TODO: if fillvalue = shr_const_spval the snowhl sent to the atm will have the spval over some points + ! rather than 0 - this is very odd and needs to be understood + ! fldptr(:) = fillvalue - ! TODO: if fillvalue = shr_const_spval the snowhl sent to the atm will have the spval over some points - ! rather than 0 - this is very odd and needs to be understood - ! fldptr(:) = fillvalue - - ! determine output array - if (present(ungridded_index)) then - fldptr2d(ungridded_index,:) = 0._r8 - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - fldptr2d(ungridded_index,n) = input(g) - end do - if (present(minus)) then - fldptr2d(ungridded_index,:) = -fldptr2d(ungridded_index,:) - end if - else - fldptr1d(:) = 0._r8 - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - fldptr1d(n) = input(g) - end do - if (present(minus)) then - fldptr1d(:) = -fldptr1d(:) - end if + ! determine output array + if (present(ungridded_index)) then + fldptr2d(ungridded_index,:) = 0._r8 + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + fldptr2d(ungridded_index,n) = input(g) + end do + if (present(minus)) then + fldptr2d(ungridded_index,:) = -fldptr2d(ungridded_index,:) end if - - ! write debug output if appropriate - if (masterproc .and. debug > 0 .and. get_nstep() < 5) then - do g = bounds%begg,bounds%endg - i = 1 + g - bounds%begg - write(iulog,F01)'export: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,input(g) - end do + else + fldptr1d(:) = 0._r8 + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + fldptr1d(n) = input(g) + end do + if (present(minus)) then + fldptr1d(:) = -fldptr1d(:) end if + end if - ! check for nans - call check_for_nans(input, trim(fldname), bounds%begg) + ! write debug output if appropriate + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + do g = bounds%begg,bounds%endg + i = 1 + g - bounds%begg + write(iulog,F01)'export: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,input(g) + end do end if + ! check for nans + call check_for_nans(input, trim(fldname), bounds%begg) + end subroutine state_setexport !=============================================================================== - subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) + subroutine state_getfldptr(State, fb, fldname, fldptr1d, fldptr2d, rc) ! ---------------------------------------------- ! Get pointer to a state field @@ -670,6 +714,7 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) ! input/output variables type(ESMF_State), intent(in) :: State + character(len=*), intent(in) :: fb character(len=*), intent(in) :: fldname real(R8), pointer, optional , intent(out) :: fldptr1d(:) real(R8), pointer, optional , intent(out) :: fldptr2d(:,:) @@ -680,31 +725,21 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh integer :: nnodes, nelements - character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' - - type(ESMF_StateItem_Flag) :: itemFlag type(ESMF_FieldBundle) :: fieldBundle - logical :: isPresent + character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' ! ---------------------------------------------- rc = ESMF_SUCCESS - ! Determine if this field bundle exist.... - ! TODO: combine the error checks.... - - call ESMF_StateGet(state, "c2l_fb", itemFlag, rc=rc) - !call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Get the fieldbundle from state... - call ESMF_StateGet(state, "c2l_fb", fieldBundle, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + ! Get the fieldbundle from the state... + call ESMF_StateGet(state, trim(fb), fieldBundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("ERROR: fb "//trim(fb)//" not found in state") - call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, isPresent=isPresent, rc=rc) - !call ESMF_FieldBundleGet(fieldBundle,trim(fldname), lfield, isPresent, rc) + ! Get the field from the field bundle + call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Get the status of the field call ESMF_FieldGet(lfield, status=status, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -725,14 +760,13 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) return end if + ! Get the data from the field if (present(fldptr1d)) then call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (masterproc .and. debug > 0) then write(iulog,F01)' in '//trim(subname)//'fldptr1d for '//trim(fldname)//' is ' end if - !print *, "FLDPTR1D is" - !print *, FLDPTR1d else if (present(fldptr2d)) then call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 72719b05b03853582e65ed5545d84a227f9ba2e4 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 5 Dec 2019 12:53:10 -0700 Subject: [PATCH 218/556] addition of mosart input file --- lilac/atm_driver/mosart_in | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 lilac/atm_driver/mosart_in diff --git a/lilac/atm_driver/mosart_in b/lilac/atm_driver/mosart_in new file mode 100644 index 0000000000..d7844885bb --- /dev/null +++ b/lilac/atm_driver/mosart_in @@ -0,0 +1,21 @@ +&mosart_inparm + bypass_routing_option = "direct_in_place" + decomp_option = "roundrobin" + delt_mosart = 1800 + do_rtm = .true. + do_rtmflood = .false. + finidat_rtm = " " + frivinp_rtm = "/glade/p/cesmdata/cseg/inputdata/rof/mosart/MOSART_routing_Global_0.5x0.5_c170601.nc" + ice_runoff = .true. + qgwl_runoff_option = "threshold" + rtmhist_fexcl1 = "" + rtmhist_fexcl2 = "" + rtmhist_fexcl3 = "" + rtmhist_fincl1 = "" + rtmhist_fincl2 = "" + rtmhist_fincl3 = "" + rtmhist_mfilt = 1 + rtmhist_ndens = 1 + rtmhist_nhtfrq = 1 + smat_option = "Xonly" +/ From c9ad20319ef463b916f146e7437e1af4878b5be8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 5 Dec 2019 19:05:36 -0700 Subject: [PATCH 219/556] updated mosart branch and README.lilac --- Externals.cfg | 2 +- README.lilac | 23 +++++++++-------------- 2 files changed, 10 insertions(+), 15 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index bec4d33548..e75d8469df 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -23,7 +23,7 @@ required = True local_path = components/mosart protocol = git repo_url = https://github.com/ESCOMP/mosart -tag = mosart1_0_35 +branch = lilac_cap required = True [cime] diff --git a/README.lilac b/README.lilac index 7cfe3b2429..8e38c7d7ab 100644 --- a/README.lilac +++ b/README.lilac @@ -1,19 +1,20 @@ -1) set the following environment variables (***THIS IS CRITICAL to have the lilac code built as part of ctsm) - > export LILAC_MODE='on' - -2) check out the code (ctsm and lilac are now bundled together) and built as one library - - SRC_ROOT is where ctsm is checked out +1) check out the code (ctsm and lilac are now bundled together) and built as one library > git clone https://github.com/ESCOMP/ctsm.git - > cd ctsm (this is $SRCROOT) > git checkout lilac_cap > ./manage_externals/checkout_externals -v +1) set the following environment variables (***THIS IS CRITICAL to have the lilac code built as part of ctsm) + SRC_ROOT is where ctsm is checked out + + > export LILAC_MODE='on' + > export SRCROOT=`pwd` + > export CASEDIR=/glade/scratch/mvertens/test_lilac + > export BLDDIR=$CASEDIR/bld + 3) build the ctsm/lilac library using a CIME case > cd $SRCROOT/cime/scripts - > export CASEDIR=/glade/scratch/mvertens/test_lilac > ./create_newcase --case $CASEDIR --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver nuopc > cd $CASEDIR > ./xmlchange DEBUG=TRUE @@ -22,12 +23,6 @@ 4) To build the atm_driver executable on cheyenne - - First, set BLDDIR - e.g.: - - > export BLDDIR=/glade/scratch/sacks/test_lilac_1205a/bld - - - Then, build with: - > cd $SRCROOT/lilac/atm_driver > make clean > source $CASEDIR/.env_mach_specific.sh From c2cc6c3f49b44c884665f1aed5446d507da974ab Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 5 Dec 2019 19:43:38 -0700 Subject: [PATCH 220/556] hard-wired coupled_to_river variable to .false. --- lilac/src/lilac_history.F90 | 94 ++++++++++++++++++--------------- lilac/src/lilac_mod.F90 | 102 +++++++++++++++++++++--------------- 2 files changed, 110 insertions(+), 86 deletions(-) diff --git a/lilac/src/lilac_history.F90 b/lilac/src/lilac_history.F90 index b8e50b892b..e754bc9151 100644 --- a/lilac/src/lilac_history.F90 +++ b/lilac/src/lilac_history.F90 @@ -92,20 +92,22 @@ end subroutine lilac_history_alarm_init !=============================================================================== - subroutine lilac_history_write(atm2cpl_state, lnd2cpl_state, rof2cpl_state, & - cpl2atm_state, cpl2lnd_state, cpl2rof_state, clock, rc) + subroutine lilac_history_write(atm2cpl_state, cpl2atm_state, & + lnd2cpl_state, cpl2lnd_state, rof2cpl_state, cpl2rof_state, clock, rc) + ! ------------------------------ ! Write lilac history file + ! ------------------------------ ! input/output variables - type(ESMF_State) :: atm2cpl_state - type(ESMF_State) :: lnd2cpl_state - type(ESMF_State) :: rof2cpl_state - type(ESMF_State) :: cpl2atm_state - type(ESMF_State) :: cpl2lnd_state - type(ESMF_State) :: cpl2rof_state - type(ESMF_Clock) :: clock - integer, intent(out) :: rc + type(ESMF_State) :: atm2cpl_state + type(ESMF_State) :: cpl2atm_state + type(ESMF_State) :: lnd2cpl_state + type(ESMF_State) :: cpl2lnd_state + type(ESMF_State), optional :: rof2cpl_state + type(ESMF_State), optional :: cpl2rof_state + type(ESMF_Clock) :: clock + integer, intent(out) :: rc ! local variables type(ESMF_FieldBundle) :: c2a_fb, a2c_fb @@ -218,7 +220,7 @@ subroutine lilac_history_write(atm2cpl_state, lnd2cpl_state, rof2cpl_state, & !--------------------------------------- if (alarmIsOn) then - write(hist_file,"(6a)") trim(case_name), '.cpl.hi.',trim(nexttimestr),'.nc' + write(hist_file,"(6a)") trim(case_name), '.lilac.hi.',trim(nexttimestr),'.nc' call ESMF_LogWrite(trim(subname)//": write "//trim(hist_file), ESMF_LOGMSG_INFO, rc=rc) call lilac_io_wopen(hist_file, vm, iam, clobber=.true.) @@ -255,53 +257,59 @@ subroutine lilac_history_write(atm2cpl_state, lnd2cpl_state, rof2cpl_state, & nx_rof = 720 !TODO: remove this hard-wiring ny_rof = 360 !TODO: remove this hard-wiring - call ESMF_StateGet(cpl2atm_state, 'c2a_fb', c2a_fb) ! to atm + call ESMF_StateGet(atm2cpl_state, 'a2c_fb', a2c_fb) ! from atm if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, c2a_fb, & - nx=nx_atm, ny=ny_atm, nt=1, whead=whead, wdata=wdata, pre='cpl_to_atm', rc=rc) + call lilac_io_write(hist_file, iam, a2c_fb, & + nx=nx_atm, ny=ny_atm, nt=1, whead=whead, wdata=wdata, pre='atm_to_cpl', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_atm', c2l_fb_atm) ! to land + call ESMF_StateGet(cpl2atm_state, 'c2a_fb', c2a_fb) ! to atm if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, c2l_fb_atm, & - nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='cpl_to_lnd_atm', rc=rc) + call lilac_io_write(hist_file, iam, c2a_fb, & + nx=nx_atm, ny=ny_atm, nt=1, whead=whead, wdata=wdata, pre='cpl_to_atm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_rof', c2l_fb_rof) ! to land - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call lilac_io_write(hist_file, iam, c2l_fb_rof, & - ! nx=nx_lnd, ny=ny_lnd, nt=1, whead=.true., wdata=wdata, pre='cpl_to_lnd_rof', rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(cpl2rof_state, 'c2r_fb', c2r_fb) ! to rof + call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_atm', l2c_fb_atm) ! from lnd if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, c2r_fb, & - nx=nx_rof, ny=ny_rof, nt=1, whead=whead, wdata=wdata, pre='cpl_to_rof', rc=rc) + call lilac_io_write(hist_file, iam, l2c_fb_atm, & + nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_atm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(atm2cpl_state, 'a2c_fb', a2c_fb) ! from atm + call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_rof', l2c_fb_rof) ! from lnd if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, a2c_fb, & - nx=nx_atm, ny=ny_atm, nt=1, whead=whead, wdata=wdata, pre='atm_to_cpl', rc=rc) + call lilac_io_write(hist_file, iam, l2c_fb_rof, & + nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_atm', l2c_fb_atm) ! from land + call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_atm', c2l_fb_atm) ! to lnd if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, l2c_fb_atm, & - nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_atm', rc=rc) + call lilac_io_write(hist_file, iam, c2l_fb_atm, & + nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='cpl_to_lnd_atm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_rof', l2c_fb_rof) ! from land - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call lilac_io_write(hist_file, iam, l2c_fb_rof, & - ! nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_rof', rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! call ESMF_StateGet(rof2cpl_state, 'r2c_fb', r2c_fb) ! from rof - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call lilac_io_write(hist_file, iam, r2c_fb, & - ! nx=nx_rof, ny=ny_rof, nt=1, whead=whead, wdata=wdata, pre='rof_to_cpl', rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (present(rof2cpl_state)) then + call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_rof', c2l_fb_rof) ! to lnd + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, c2l_fb_rof, & + nx=nx_lnd, ny=ny_lnd, nt=1, whead=.true., wdata=wdata, pre='cpl_to_lnd_rof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (present(cpl2rof_state)) then + call ESMF_StateGet(cpl2rof_state, 'c2r_fb', c2r_fb) ! to rof + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, c2r_fb, & + nx=nx_rof, ny=ny_rof, nt=1, whead=whead, wdata=wdata, pre='cpl_to_rof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (present(rof2cpl_state)) then + call ESMF_StateGet(rof2cpl_state, 'r2c_fb', r2c_fb) ! from rof + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, r2c_fb, & + nx=nx_rof, ny=ny_rof, nt=1, whead=whead, wdata=wdata, pre='rof_to_cpl', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if enddo diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index da45c6219a..aa155e3a93 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -60,6 +60,9 @@ module lilac_mod type(ESMF_Alarm) :: lilac_restart_alarm type(ESMF_Alarm) :: lilac_stop_alarm + ! Coupling to mosart is now set to .false. by default + logical :: couple_to_river = .false. + integer :: mytask character(*) , parameter :: modname = "lilac_mod" @@ -409,20 +412,22 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat call ESMF_LogWrite(subname//"CTSM gridded component initialized", ESMF_LOGMSG_INFO) ! ------------------------------------------------------------------------- - ! Initialze MOSART Gridded Component + ! Initialize MOSART Gridded Component ! First Create the empty import and export states used to pass data ! between components. (these are module variables) ! ------------------------------------------------------------------------- - cpl2rof_state = ESMF_StateCreate(name='state_to_river', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - rof2cpl_state = ESMF_StateCreate(name='state_fr_river', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (couple_to_river) then + cpl2rof_state = ESMF_StateCreate(name='state_to_river', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + rof2cpl_state = ESMF_StateCreate(name='state_fr_river', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompInitialize(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & - clock=lilac_clock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing mosart") - call ESMF_LogWrite(subname//"MOSART gridded component initialized", ESMF_LOGMSG_INFO) + call ESMF_GridCompInitialize(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing mosart") + call ESMF_LogWrite(subname//"MOSART gridded component initialized", ESMF_LOGMSG_INFO) + end if ! ------------------------------------------------------------------------- ! Initialze LILAC coupler components @@ -437,23 +442,25 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_atm2lnd component") call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) - ! The following fills in the rof field bundle in cpl2lnd_state - call ESMF_CplCompInitialize(cpl_rof2lnd_comp, importState=rof2cpl_state, exportState=cpl2lnd_state, & - clock=lilac_clock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") - call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) - ! The following maps the atm field bundle in lnd2cpl_state to the atm mesh call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2cpl_state, exportState=cpl2atm_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) - ! The following maps the rof field bundle in lnd2cpl_state to the rof mesh - call ESMF_CplCompInitialize(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & - clock=lilac_clock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2rof component") - call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) + if (couple_to_river) then + ! The following maps the rof field bundle in lnd2cpl_state to the rof mesh + call ESMF_CplCompInitialize(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2rof component") + call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) + + ! The following fills in the rof field bundle in cpl2lnd_state + call ESMF_CplCompInitialize(cpl_rof2lnd_comp, importState=rof2cpl_state, exportState=cpl2lnd_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") + call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) + end if if (mytask == 0) then print *, trim(subname) // "finished lilac initialization" @@ -543,31 +550,40 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in cpl_lnd2atm") - ! Run cpl_lnd2rof - call ESMF_LogWrite(subname//"running cpl_lnd2rof_comp ", ESMF_LOGMSG_INFO) - if (mytask == 0) print *, "Running coupler component..... cpl_lnd2rof_comp" - call ESMF_CplCompRun(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & - clock=lilac_clock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_lnd2rof") - - ! Run mosart - call ESMF_LogWrite(subname//"running mosart", ESMF_LOGMSG_INFO) - if (mytask == 0) print *, "Running mosart" - call ESMF_GridCompRun(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & - clock=lilac_clock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") - - ! Run cpl_rof2lnd - ! call ESMF_LogWrite(subname//"running cpl_rof2lnd_comp ", ESMF_LOGMSG_INFO) - ! if (mytask == 0) print *, "Running coupler component..... cpl_rof2lnd_comp" - ! call ESMF_CplCompRun(cpl_rof2lnd_comp, importState=rof2cpl_state, exportState=cpl2lnd_state, & - ! clock=lilac_clock, rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_rof2lnd") + if (couple_to_river) then + ! Run cpl_lnd2rof + call ESMF_LogWrite(subname//"running cpl_lnd2rof_comp ", ESMF_LOGMSG_INFO) + if (mytask == 0) print *, "Running coupler component..... cpl_lnd2rof_comp" + call ESMF_CplCompRun(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_lnd2rof") + + ! Run mosart + call ESMF_LogWrite(subname//"running mosart", ESMF_LOGMSG_INFO) + if (mytask == 0) print *, "Running mosart" + call ESMF_GridCompRun(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") + + ! Run cpl_rof2lnd + ! TODO: uncommenting this needs to be tested + ! call ESMF_LogWrite(subname//"running cpl_rof2lnd_comp ", ESMF_LOGMSG_INFO) + ! if (mytask == 0) print *, "Running coupler component..... cpl_rof2lnd_comp" + ! call ESMF_CplCompRun(cpl_rof2lnd_comp, importState=rof2cpl_state, exportState=cpl2lnd_state, & + ! clock=lilac_clock, rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_rof2lnd") + end if ! Write out history output - call lilac_history_write(atm2cpl_state, lnd2cpl_state, rof2cpl_state, & - cpl2atm_state, cpl2lnd_state, cpl2rof_state, lilac_clock, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in history write") + if (couple_to_river) then + call lilac_history_write(atm2cpl_state, cpl2atm_state, lnd2cpl_state, cpl2lnd_state, & + rof2cpl_state=rof2cpl_state, cpl2rof_state=cpl2rof_state, clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in history write") + else + call lilac_history_write(atm2cpl_state, cpl2atm_state, lnd2cpl_state, cpl2lnd_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in history write") + end if ! Advance the time at the end of the time step call ESMF_ClockAdvance(lilac_clock, rc=rc) From 2b40c6bd04df222fa5e79a63a1ae8c47d88fe444 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 5 Dec 2019 21:42:22 -0700 Subject: [PATCH 221/556] moved lilac_utils.F90 contents into lilac_atmcap.R90 and removed the file --- lilac/atm_driver/atm_driver.F90 | 62 ++--- lilac/src/lilac_atmaero.F90 | 2 +- lilac/src/lilac_atmcap.F90 | 267 +++++++++++++++++++- lilac/src/lilac_mod.F90 | 11 +- lilac/src/lilac_utils.F90 | 423 -------------------------------- src/cpl/lilac/lnd_comp_esmf.F90 | 23 +- 6 files changed, 314 insertions(+), 474 deletions(-) delete mode 100644 lilac/src/lilac_utils.F90 diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index a9622e00b0..8f826862ec 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -18,7 +18,7 @@ program atm_driver use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS use lilac_mod , only : lilac_init, lilac_run, lilac_final - use lilac_utils , only : lilac_atm2lnd, lilac_lnd2atm + use lilac_atmcap, only : lilac_atmcap_atm2lnd, lilac_atmcap_lnd2atm implicit none @@ -272,60 +272,60 @@ subroutine atm_driver_to_lilac (lon, lat) allocate(data(lsize)) data(:) = 30.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Sa_z', data) + call lilac_atmcap_atm2lnd('Sa_z', data) data(:) = 10.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Sa_topo', data) + call lilac_atmcap_atm2lnd('Sa_topo', data) data(:) = 20.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Sa_u', data) + call lilac_atmcap_atm2lnd('Sa_u', data) data(:) = 40.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Sa_v', data) + call lilac_atmcap_atm2lnd('Sa_v', data) data(:) = 280.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Sa_ptem', data) + call lilac_atmcap_atm2lnd('Sa_ptem', data) data(:) = 100100.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Sa_pbot', data) + call lilac_atmcap_atm2lnd('Sa_pbot', data) data(:) = 280.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Sa_tbot', data) + call lilac_atmcap_atm2lnd('Sa_tbot', data) data(:) = 0.0004d0 !+(lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 - call lilac_atm2lnd('Sa_shum', data) + call lilac_atmcap_atm2lnd('Sa_shum', data) data(:) = 200.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Faxa_lwdn', data) + call lilac_atmcap_atm2lnd('Faxa_lwdn', data) data(:) = 0.0d0 - call lilac_atm2lnd('Faxa_rainc', data) + call lilac_atmcap_atm2lnd('Faxa_rainc', data) data(:) = 3.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 - call lilac_atm2lnd('Faxa_rainl', data) + call lilac_atmcap_atm2lnd('Faxa_rainl', data) data(:) = 1.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 - call lilac_atm2lnd('Faxa_snowc', data) + call lilac_atmcap_atm2lnd('Faxa_snowc', data) data(:) = 2.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 - call lilac_atm2lnd('Faxa_snowl', data) + call lilac_atmcap_atm2lnd('Faxa_snowl', data) data(:) = 100.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Faxa_swndr', data) + call lilac_atmcap_atm2lnd('Faxa_swndr', data) data(:) = 50.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Faxa_swvdr', data) + call lilac_atmcap_atm2lnd('Faxa_swvdr', data) data(:) = 20.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Faxa_swndf', data) + call lilac_atmcap_atm2lnd('Faxa_swndf', data) data(:) = 40.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 - call lilac_atm2lnd('Faxa_swvdf', data) + call lilac_atmcap_atm2lnd('Faxa_swvdf', data) end subroutine atm_driver_to_lilac !======================================================================== - subroutine lilac_to_atm_driver () + subroutine lilac_to_atm_driver ! local variables integer :: lsize @@ -335,18 +335,18 @@ subroutine lilac_to_atm_driver () lsize = size(atm_global_index) allocate(data(lsize)) - call lilac_lnd2atm('Sl_lfrin' , data) - call lilac_lnd2atm('Sl_t' , data) - call lilac_lnd2atm('Sl_tref' , data) - call lilac_lnd2atm('Sl_qref' , data) - call lilac_lnd2atm('Sl_avsdr' , data) - call lilac_lnd2atm('Sl_anidr' , data) - call lilac_lnd2atm('Sl_avsdf' , data) - call lilac_lnd2atm('Sl_anidf' , data) - call lilac_lnd2atm('Sl_snowh' , data) - call lilac_lnd2atm('Sl_u10' , data) - call lilac_lnd2atm('Sl_fv' , data) - call lilac_lnd2atm('Sl_ram1' , data) + call lilac_atmcap_lnd2atm('Sl_lfrin' , data) + call lilac_atmcap_lnd2atm('Sl_t' , data) + call lilac_atmcap_lnd2atm('Sl_tref' , data) + call lilac_atmcap_lnd2atm('Sl_qref' , data) + call lilac_atmcap_lnd2atm('Sl_avsdr' , data) + call lilac_atmcap_lnd2atm('Sl_anidr' , data) + call lilac_atmcap_lnd2atm('Sl_avsdf' , data) + call lilac_atmcap_lnd2atm('Sl_anidf' , data) + call lilac_atmcap_lnd2atm('Sl_snowh' , data) + call lilac_atmcap_lnd2atm('Sl_u10' , data) + call lilac_atmcap_lnd2atm('Sl_fv' , data) + call lilac_atmcap_lnd2atm('Sl_ram1' , data) end subroutine lilac_to_atm_driver diff --git a/lilac/src/lilac_atmaero.F90 b/lilac/src/lilac_atmaero.F90 index f54481ae62..2ac17d8da7 100644 --- a/lilac/src/lilac_atmaero.F90 +++ b/lilac/src/lilac_atmaero.F90 @@ -28,7 +28,7 @@ module lilac_atmaero use clm_time_manager , only : get_calendar ! lilac uses - use lilac_utils , only : gindex_atm + use lilac_atmcap , only : gindex_atm use lilac_methods , only : chkerr use lilac_methods , only : lilac_methods_FB_getFieldN diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index d03db5a0b2..5ff1541a49 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -1,28 +1,281 @@ module lilac_atmcap !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! This is a dummy atmosphere cap for setting up lilac structure. + ! This is an ESMF lilac cap for the host atmosphere + ! + ! THE HOST ATMOSPHERE IS RESPONSIBLE for calling lilac_init() and in turn + ! lilac_init() calls the initialization routines for atm2lnd and lnd2atm + ! + ! the host atm init call will be + ! call lilac_init() + ! the host atm run phase will be + ! call lilac_atm2lnd(fldname, data1d) + ! call lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) + ! call lilac_lnd2atm(fldname, data1d) !----------------------------------------------------------------------- use ESMF - use lilac_utils , only : atm2lnd, lnd2atm, gindex_atm, atm_mesh_filename - use lilac_methods, only : chkerr + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl, CS => shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use lilac_methods , only : chkerr implicit none public :: lilac_atmos_register + public :: lilac_atmcap_init + public :: lilac_atmcap_atm2lnd + public :: lilac_atmcap_lnd2atm + + private :: lilac_atmcap_add_fld + + ! Global index space info for atm data + integer, public, allocatable :: gindex_atm (:) + + ! Mesh file to be read in by lilac_atm + character(len=CL), public :: atm_mesh_filename + + type :: atmcap_type + character(len=CL) :: fldname + real(r8), pointer :: dataptr(:) + character(len=CS) :: units + logical :: provided_by_atm + logical :: required_fr_atm + end type atmcap_type + type(atmcap_type), pointer, public :: atm2lnd(:) + type(atmcap_type), pointer, public :: lnd2atm(:) + integer :: mytask integer, parameter :: debug = 0 ! internal debug level - character(*),parameter :: u_FILE_u = & + character(*), parameter :: u_FILE_u = & __FILE__ !======================================================================== contains !======================================================================== + subroutine lilac_atmcap_init() + integer :: n, lsize + + lsize = size(gindex_atm) + + ! TODO: how is the atm going to specify which fields are not provided = + ! should it pass an array of character strings or a colon deliminited set of fields + ! to specify the fields it will not provide - and then these are checked against those fields + + call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_z' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_topo' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_u' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_v' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_ptem' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_pbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_tbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_shum' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_lwdn' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_rainc' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_rainl' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_snowc' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_snowl' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_swndr' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_swvdr' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_swndf' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_swvdf' , units='unknown', required_fr_atm=.true. , lsize=lsize) + + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_bcphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_bcphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_bcphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_ocphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_ocphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_ocphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstwet1' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstdry1' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstwet2' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstdry2' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstwet3' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstdry3' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstwet4' , units='unknown', required_fr_atm=.true. , lsize=lsize) + call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstdry4' , units='unknown', required_fr_atm=.true. , lsize=lsize) + + ! TODO: optional fields - if these are uncommented then need to make sure that they are also appear in the lnd + ! import state + ! CRITICAL the fields in the export state from lilac_atmcap MUST match the fields in the import state to the land + ! this is not being checked currently and msut be + !call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_methane' , units='unknown', required_fr_atm=.false. , lsize=lsize) + !call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_bcph' , units='unknown', required_fr_atm=.false. , lsize=lsize) + + ! now add dataptr memory for all of the fields and set default values of provided_by_atm to false + do n = 1,size(atm2lnd) + allocate(atm2lnd(n)%dataptr(lsize)) + atm2lnd(n)%provided_by_atm = .false. + end do + + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_lfrin' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_t' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_tref' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_qref' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_avsdr' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_anidr' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_avsdf' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_anidf' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_snowh' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_u10' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_fv' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_ram1' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_taux' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_tauy' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_lat' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_sen' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_lwup' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_evap' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_swnet' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_flxdst1' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_flxdst2' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_flxdst3' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_flxdst4' , units='unknown', lsize=lsize) + + ! now add dataptr memory for all of the fields + do n = 1,size(lnd2atm) + allocate(lnd2atm(n)%dataptr(lsize)) + end do + + end subroutine lilac_atmcap_init + +!======================================================================== + subroutine lilac_atmcap_atm2lnd(fldname, data) + + ! input/output variables + character(len=*), intent(in) :: fldname + real(r8), intent(in) :: data(:) + + ! local variables + integer :: n + logical :: found + ! -------------------------------------------- + + found = .false. + do n = 1,size(atm2lnd) + if (trim(fldname) == atm2lnd(n)%fldname) then + found = .true. + if (size(data) /= size(atm2lnd(n)%dataptr)) then + ! call abort - TODO: what is the abort call in lilac + else + atm2lnd(n)%dataptr(:) = data(:) + end if + atm2lnd(n)%provided_by_atm = .true. + exit + end if + end do + if (.not. found) then + ! abort + end if + + contains + + subroutine lilac_atm2lnd_check() + integer :: n ! if there are fields that the atmosphere does not provide but + ! that are required - then abort + do n = 1,size(atm2lnd) + if (atm2lnd(n)%required_fr_atm .and. (.not. atm2lnd(n)%provided_by_atm)) then + ! call abort or provide default values? + else if (.not. atm2lnd(n)%provided_by_atm) then + ! create default values + end if + end do + end subroutine lilac_atm2lnd_check + + end subroutine lilac_atmcap_atm2lnd + +!======================================================================== + subroutine lilac_atmcap_lnd2atm(fldname, data) + character(len=*) , intent(in) :: fldname + real(r8) , intent(out) :: data(:) + integer :: n + + do n = 1,size(lnd2atm) + if (trim(fldname) == lnd2atm(n)%fldname) then + if (size(data) /= size(lnd2atm(n)%dataptr)) then + ! call abort - TODO: what is the abort call in lilac + else + data(:) = lnd2atm(n)%dataptr(:) + end if + end if + end do + end subroutine lilac_atmcap_lnd2atm + +!======================================================================== + subroutine lilac_atmcap_add_fld(flds, fldname, units, lsize, required_fr_atm) + + ! ---------------------------------------------- + ! Add an entry to to the flds array + ! Use pointers to create an extensible allocatable array. + ! to allow the size of flds to grow, the process for + ! adding a new field is: + ! 1) allocate newflds to be N (one element larger than flds) + ! 2) copy flds into first N-1 elements of newflds + ! 3) newest flds entry is Nth element of newflds + ! 4) deallocate / nullify flds + ! 5) point flds => newflds + ! ---------------------------------------------- + + type(atmcap_type), pointer :: flds(:) + character(len=*) , intent(in) :: fldname + character(len=*) , intent(in) :: units + integer , intent(in) :: lsize + logical, optional, intent(in) :: required_fr_atm + + ! local variables + integer :: n,oldsize,newsize + type(atmcap_type), pointer :: newflds(:) + character(len=*), parameter :: subname='(lilac_atmcap_atm2lnd_fld)' + ! ---------------------------------------------- + + if (associated(flds)) then + oldsize = size(flds) + else + oldsize = 0 + end if + newsize = oldsize + 1 + + if (oldsize > 0) then + ! 1) allocate newfld to be size (one element larger than input flds) + allocate(newflds(newsize)) + + ! 2) copy flds into first N-1 elements of newflds + do n = 1,oldsize + newflds(n)%fldname = flds(n)%fldname + newflds(n)%units = flds(n)%units + newflds(n)%required_fr_atm = flds(n)%required_fr_atm + end do + + ! 3) deallocate / nullify flds + if (oldsize > 0) then + deallocate(flds) + nullify(flds) + end if + + ! 4) point flds => new_flds + flds => newflds + + ! 5) update flds information for new entry + flds(newsize)%fldname = trim(fldname) + flds(newsize)%units = trim(units) + if (present(required_fr_atm)) then + flds(newsize)%required_fr_atm = required_fr_atm + end if + + else + allocate(flds(newsize)) + flds(newsize)%fldname = trim(fldname) + flds(newsize)%units = trim(units) + if (present(required_fr_atm)) then + flds(newsize)%required_fr_atm = required_fr_atm + end if + end if + + end subroutine lilac_atmcap_add_fld + + !======================================================================== subroutine lilac_atmos_register (comp, rc) type(ESMF_GridComp) :: comp ! must not be optional @@ -86,7 +339,7 @@ subroutine lilac_atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) !------------------------------------------------------------------------- ! Note that in the call to lilac_atm the host atmospere sent both the gindex_atm and - ! the atm_mesh_filename that were then set as module variables in lilac_utils + ! the atm_mesh_filename that were then set as module variables here atm_distgrid = ESMF_DistGridCreate (arbSeqIndexList=gindex_atm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -169,7 +422,6 @@ subroutine lilac_atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) end subroutine lilac_atmos_init !======================================================================== - subroutine lilac_atmos_run(comp, importState, exportState, clock, rc) ! input/output variables @@ -189,7 +441,6 @@ subroutine lilac_atmos_run(comp, importState, exportState, clock, rc) end subroutine lilac_atmos_run !======================================================================== - subroutine lilac_atmos_final(comp, importState, exportState, clock, rc) ! input/output variables diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index aa155e3a93..52ddcd0a88 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -17,8 +17,8 @@ module lilac_mod ! lilac routines use lilac_io , only : lilac_io_init - use lilac_utils , only : lilac_init_lnd2atm, lilac_init_atm2lnd - use lilac_utils , only : gindex_atm, atm_mesh_filename + use lilac_atmcap , only : lilac_atmcap_init + use lilac_atmcap , only : gindex_atm, atm_mesh_filename use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register use lilac_cpl , only : cpl_lnd2rof_register, cpl_rof2lnd_register use lilac_atmcap , only : lilac_atmos_register @@ -171,7 +171,7 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat call ESMF_LogWrite(subname//"initialized shr_pio_init2 ...", ESMF_LOGMSG_INFO) !------------------------------------------------------------------------- - ! Initial lilac_utils module variables + ! Initial lilac_atmcap module variables !------------------------------------------------------------------------- ! Initialize gindex_atm @@ -184,9 +184,8 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat ! Initialize datatypes atm2lnd and lnd2atm ! This must be done BEFORE the atmcap initialization - since the dataptr attributes - ! are only needed to initialize the atmcap field bundles - call lilac_init_atm2lnd(lsize) - call lilac_init_lnd2atm(lsize) + ! are needed to initialize the atmcap field bundles + call lilac_atmcap_init() !------------------------------------------------------------------------- ! Create Gridded Component -- lilac atmos_cap diff --git a/lilac/src/lilac_utils.F90 b/lilac/src/lilac_utils.F90 deleted file mode 100644 index 89e4fb3130..0000000000 --- a/lilac/src/lilac_utils.F90 +++ /dev/null @@ -1,423 +0,0 @@ -module lilac_utils - - ! *********************************************************************** - ! THE HOST ATMOSPHERE IS RESPONSIBLE for calling lilac_init() and in turn - ! lilac_init() calls the initialization routines for atm2lnd and lnd2atm - ! - ! the host atm init call will be - ! call lilac_init() - ! the host atm run phase will be - ! call lilac_atm2lnd(fldname, data1d) - ! call lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) - ! call lilac_lnd2atm(fldname, data1d) - ! *********************************************************************** - - use ESMF - use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl, CS => shr_kind_cs - use shr_sys_mod , only : shr_sys_abort - use lilac_methods , only : chkerr - - implicit none - private - - public :: lilac_init_atm2lnd - public :: lilac_init_lnd2atm - public :: lilac_atm2lnd - public :: lilac_lnd2atm - public :: lilac_field_bundle_to_land - public :: lilac_field_bundle_fr_land - - private :: lilac_atm2lnd_add_fld - private :: lilac_lnd2atm_add_fld - - ! Global index space info for atm data - integer, public, allocatable :: gindex_atm (:) - - ! Mesh file to be read in by lilac_atm - character(len=CL), public :: atm_mesh_filename - - ! Mesh file to be read in by ctsm - character(len=CL), public :: lnd_mesh_filename - - type :: atm2lnd_type - character(len=CL) :: fldname - real(r8), pointer :: dataptr(:) - character(len=CS) :: units - logical :: provided_by_atm - logical :: required_fr_atm - end type atm2lnd_type - type(atm2lnd_type), pointer, public :: atm2lnd(:) - - type :: lnd2atm_type - character(len=128) :: fldname - real(r8), pointer :: dataptr(:) - character(len=64) :: units - end type lnd2atm_type - type(atm2lnd_type), pointer, public :: lnd2atm(:) - - character(*), parameter :: u_FILE_u = & - __FILE__ - -!======================================================================== -contains -!======================================================================== - - subroutine lilac_init_atm2lnd(lsize) - integer, intent(in) :: lsize - integer :: n - - ! TODO: how is the atm going to specify which fields are not provided = - ! should it pass an array of character strings or a colon deliminited set of fields - ! to specify the fields it will not provide - and then these are checked against those fields - - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_z' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_topo' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_u' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_v' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_ptem' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_pbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_tbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_shum' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_lwdn' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainc' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_rainl' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowc' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_snowl' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndr' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdr' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_swndf' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_swvdf' , units='unknown', required_fr_atm=.true. , lsize=lsize) - - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_ocphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet1' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry1' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet2' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry2' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet3' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry3' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstwet4' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_dstdry4' , units='unknown', required_fr_atm=.true. , lsize=lsize) - - ! TODO: optional fields - if these are uncommented then need to make sure that they are also appear in the lnd - ! import state - ! CRITICAL the fields in the export state from lilac_atmcap MUST match the fields in the import state to the land - ! this is not being checked currently and msut be - !call lilac_atm2lnd_add_fld (atm2lnd, fldname='Sa_methane' , units='unknown', required_fr_atm=.false. , lsize=lsize) - !call lilac_atm2lnd_add_fld (atm2lnd, fldname='Faxa_bcph' , units='unknown', required_fr_atm=.false. , lsize=lsize) - - ! now add dataptr memory for all of the fields and set default values of provided_by_atm to false - do n = 1,size(atm2lnd) - allocate(atm2lnd(n)%dataptr(lsize)) - atm2lnd(n)%provided_by_atm = .false. - end do - end subroutine lilac_init_atm2lnd - - !======================================================================== - - subroutine lilac_init_lnd2atm(lsize) - integer, intent(in) :: lsize - integer :: n - - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_lfrin' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_t' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_tref' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_qref' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_avsdr' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_anidr' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_avsdf' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_anidf' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_snowh' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_u10' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_fv' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Sl_ram1' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_taux' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_tauy' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_lat' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_sen' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_lwup' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_evap' , units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_swnet', units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_flxdst1', units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_flxdst2', units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_flxdst3', units='unknown', lsize=lsize) - call lilac_lnd2atm_add_fld (lnd2atm , fldname='Fall_flxdst4', units='unknown', lsize=lsize) - - ! now add dataptr memory for all of the fields - do n = 1,size(lnd2atm) - allocate(lnd2atm(n)%dataptr(lsize)) - end do - end subroutine lilac_init_lnd2atm - -!======================================================================== - - subroutine lilac_atm2lnd(fldname, data) - - ! input/output variables - character(len=*), intent(in) :: fldname - real(r8), intent(in) :: data(:) - - ! local variables - integer :: n - logical :: found - ! -------------------------------------------- - - found = .false. - do n = 1,size(atm2lnd) - if (trim(fldname) == atm2lnd(n)%fldname) then - found = .true. - if (size(data) /= size(atm2lnd(n)%dataptr)) then - ! call abort - TODO: what is the abort call in lilac - else - atm2lnd(n)%dataptr(:) = data(:) - end if - atm2lnd(n)%provided_by_atm = .true. - exit - end if - end do - if (.not. found) then - ! abort - end if - - end subroutine lilac_atm2lnd - -!======================================================================== - - subroutine lilac_atm2lnd_check() - - ! local variables - integer :: n - ! -------------------------------------------- - - ! if there are fields that the atmosphere does not provide but that are required - then abort - do n = 1,size(atm2lnd) - if (atm2lnd(n)%required_fr_atm .and. (.not. atm2lnd(n)%provided_by_atm)) then - ! call abort or provide default values? - else if (.not. atm2lnd(n)%provided_by_atm) then - ! create default values - end if - end do - end subroutine lilac_atm2lnd_check - -!======================================================================== - - subroutine lilac_lnd2atm(fldname, data) - ! input/output variables - character(len=*) , intent(in) :: fldname - real(r8) , intent(out) :: data(:) - - ! local variables - integer :: n - ! -------------------------------------------- - - do n = 1,size(lnd2atm) - if (trim(fldname) == lnd2atm(n)%fldname) then - if (size(data) /= size(lnd2atm(n)%dataptr)) then - ! call abort - TODO: what is the abort call in lilac - else - data(:) = lnd2atm(n)%dataptr(:) - end if - end if - end do - end subroutine lilac_lnd2atm - -!======================================================================== - - subroutine lilac_atm2lnd_add_fld(flds, fldname, units, required_fr_atm, lsize) - - ! ---------------------------------------------- - ! Add an entry to to the flds array - ! Use pointers to create an extensible allocatable array. - ! to allow the size of flds to grow, the process for - ! adding a new field is: - ! 1) allocate newflds to be N (one element larger than flds) - ! 2) copy flds into first N-1 elements of newflds - ! 3) newest flds entry is Nth element of newflds - ! 4) deallocate / nullify flds - ! 5) point flds => newflds - ! ---------------------------------------------- - - type(atm2lnd_type), pointer :: flds(:) - character(len=*) , intent(in) :: fldname - character(len=*) , intent(in) :: units - logical , intent(in) :: required_fr_atm - integer , intent(in) :: lsize - - ! local variables - integer :: n,oldsize,newsize - type(atm2lnd_type), pointer :: newflds(:) - character(len=*), parameter :: subname='(lilac_utils_add_atm2lnd_fld)' - ! ---------------------------------------------- - - if (associated(flds)) then - oldsize = size(flds) - else - oldsize = 0 - end if - newsize = oldsize + 1 - - if (oldsize > 0) then - ! 1) allocate newfld to be size (one element larger than input flds) - allocate(newflds(newsize)) - - ! 2) copy flds into first N-1 elements of newflds - do n = 1,oldsize - newflds(n)%fldname = flds(n)%fldname - newflds(n)%units = flds(n)%units - newflds(n)%required_fr_atm = flds(n)%required_fr_atm - end do - - ! 3) deallocate / nullify flds - if (oldsize > 0) then - deallocate(flds) - nullify(flds) - end if - - ! 4) point flds => new_flds - flds => newflds - - ! 5) update flds information for new entry - flds(newsize)%fldname = trim(fldname) - flds(newsize)%units = trim(units) - flds(newsize)%required_fr_atm = required_fr_atm - - else - allocate(flds(newsize)) - flds(newsize)%fldname = trim(fldname) - flds(newsize)%units = trim(units) - flds(newsize)%required_fr_atm = required_fr_atm - end if - - end subroutine lilac_atm2lnd_add_fld - -!======================================================================== - - subroutine lilac_lnd2atm_add_fld(flds, fldname, units, lsize) - - ! ---------------------------------------------- - ! Add an entry to to the flds array - ! Use pointers to create an extensible allocatable array. - ! to allow the size of flds to grow, the process for - ! adding a new field is: - ! 1) allocate newflds to be N (one element larger than flds) - ! 2) copy flds into first N-1 elements of newflds - ! 3) newest flds entry is Nth element of newflds - ! 4) deallocate / nullify flds - ! 5) point flds => newflds - ! ---------------------------------------------- - - type(atm2lnd_type), pointer :: flds(:) - character(len=*) , intent(in) :: fldname - character(len=*) , intent(in) :: units - integer , intent(in) :: lsize - - ! local variables - integer :: n,oldsize,newsize - type(atm2lnd_type), pointer :: newflds(:) - character(len=*), parameter :: subname='(lilac_init_lnd2atm)' - ! ---------------------------------------------- - - if (associated(flds)) then - oldsize = size(flds) - else - oldsize = 0 - end if - newsize = oldsize + 1 - - ! 1) allocate newfld to be size (one element larger than input flds) - allocate(newflds(newsize)) - - ! 2) copy flds into first N-1 elements of newflds - do n = 1,oldsize - newflds(n)%fldname = flds(n)%fldname - newflds(n)%units = flds(n)%units - end do - - ! 3) deallocate / nullify flds - if (oldsize > 0) then - deallocate(flds) - nullify(flds) - end if - - ! 4) point flds => new_flds - flds => newflds - - ! 5) now update flds information for new entry - flds(newsize)%fldname = trim(fldname) - flds(newsize)%units = trim(units) - - end subroutine lilac_lnd2atm_add_fld - -!======================================================================== - - subroutine lilac_field_bundle_to_land(mesh, fieldbundle, rc) - - type(ESMF_Mesh) :: mesh - type(ESMF_FieldBundle) :: fieldbundle - integer, intent(out) :: rc - - integer :: n - - rc = ESMF_SUCCESS - - ! Add empty fields to field bundle - do n = 1, size(atm2lnd) - call fldbundle_add(trim(atm2lnd(n)%fldname), mesh, fieldbundle, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - - end subroutine lilac_field_bundle_to_land - -!=============================================================================== - - subroutine lilac_field_bundle_fr_land(mesh, fieldbundle, rc) - - type(ESMF_Mesh) :: mesh - type(ESMF_FieldBundle) :: fieldbundle - integer, intent(out) :: rc - - integer :: n - - rc = ESMF_SUCCESS - - ! Add empty fields to field bundle - do n = 1, size(lnd2atm) - call fldbundle_add( trim(lnd2atm(n)%fldname), mesh, fieldbundle, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - - end subroutine lilac_field_bundle_fr_land - -!=============================================================================== - - subroutine fldbundle_add(fldname, mesh, fieldbundle, rc) - - !--------------------------- - ! Create an empty input field with name 'stdname' to add to fieldbundle - !--------------------------- - - ! input/output variables - character(len=*) , intent(in) :: fldname - type(ESMF_Mesh) , intent(in) :: mesh - type(ESMF_FieldBundle) , intent(inout) :: fieldbundle - integer , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: field - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(fldname), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldBundleAdd(fieldbundle, (/field/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine fldbundle_add - -end module lilac_utils diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index a0db265893..61fb8adc12 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -9,7 +9,9 @@ module lnd_comp_esmf use ESMF use mpi , only : MPI_BCAST, MPI_CHARACTER use perf_mod , only : t_startf, t_stopf, t_barrierf - use lilac_utils , only : lilac_field_bundle_to_land, lilac_field_bundle_fr_land + + ! lilac code + use lilac_atmcap , only : atm2lnd, lnd2atm ! cime share code use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl @@ -120,6 +122,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) type(ESMF_State) :: importState, exportState type(ESMF_FieldBundle) :: c2l_fb_atm, c2l_fb_rof ! field bundles in import state type(ESMF_FieldBundle) :: l2c_fb_atm, l2c_fb_rof ! field bundles in export state + type(ESMF_Field) :: lfield ! mesh generation type(ESMF_Mesh) :: lnd_mesh @@ -414,8 +417,13 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! now add atm import fields on lnd_mesh to this field bundle - call lilac_field_bundle_to_land(lnd_mesh, c2l_fb_atm, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1, size(atm2lnd) + lfield = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(atm2lnd(n)%fldname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(c2l_fb_atm, (/lfield/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do ! add the field bundle to the state call ESMF_StateAdd(import_state, fieldbundleList = (/c2l_fb_atm/)) @@ -445,8 +453,13 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! now add atm export fields on lnd_mesh to this field bundle - call lilac_field_bundle_fr_land(lnd_mesh, l2c_fb_atm, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1, size(lnd2atm) + lfield = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(lnd2atm(n)%fldname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(l2c_fb_atm, (/lfield/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do ! add the field bundle to the state call ESMF_StateAdd(export_state, fieldbundleList = (/l2c_fb_atm/), rc=rc) From 06f1a20d3c7234e752b3dff7d43b34bb50164537 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 5 Dec 2019 21:44:10 -0700 Subject: [PATCH 222/556] updated Externals.cfg to point to latest mosart lilac_cap hash --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index e75d8469df..d2c294c57f 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -23,7 +23,7 @@ required = True local_path = components/mosart protocol = git repo_url = https://github.com/ESCOMP/mosart -branch = lilac_cap +tag = 14d02bb required = True [cime] From 4a79f0f3f5bd45cf1e4b6cada2350de9e3d3345a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 6 Dec 2019 09:33:15 -0700 Subject: [PATCH 223/556] When running lilac, by default write CTSM history every day This is helpful for testing --- README.lilac | 16 ++++------------ lilac/atm_driver/ctsm.cfg | 6 +++++- 2 files changed, 9 insertions(+), 13 deletions(-) diff --git a/README.lilac b/README.lilac index ec3465d41b..59da475bc8 100644 --- a/README.lilac +++ b/README.lilac @@ -4,7 +4,7 @@ > git checkout lilac_cap > ./manage_externals/checkout_externals -v -1) set the following environment variables (***THIS IS CRITICAL to have the lilac code built as part of ctsm) +2) set the following environment variables (***LILAC_MODE IS CRITICAL to have the lilac code built as part of ctsm) SRCROOT is where ctsm is checked out > export LILAC_MODE='on' @@ -39,19 +39,11 @@ THIS ONLY NEEDS TO BE DONE ONCE to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory -6) write CTSM history files every time step - - insert the following after the initial '&clm_inparm' in lnd_in: - - hist_nhtfrq = 1 - hist_mfilt = 1 - hist_ndens = 1 - -7) run the atm_driver on cheyenne +6) run the atm_driver on cheyenne > qsub cheyenne.sub -8) compare with latest baselines +7) compare with latest baselines use something like this to compare the last clm and last cpl hist files: @@ -59,7 +51,7 @@ > cprnc test_lilac.clm2.h0.2000-01-02-00000.nc $basedir/test_lilac.clm2.h0.2000-01-02-00000.nc | tail -30 > cprnc test_lilac.cpl.hi.2000-01-02-00000.nc $basedir/test_lilac.cpl.hi.2000-01-02-00000.nc | tail -30 -9) if there are differences, and those are intentional, then create new +8) if there are differences, and those are intentional, then create new baselines copy all *.nc files, plus ctsm.cfg, lilac_in and lnd_in to the diff --git a/lilac/atm_driver/ctsm.cfg b/lilac/atm_driver/ctsm.cfg index 95764fb0bd..a2e46981e7 100644 --- a/lilac/atm_driver/ctsm.cfg +++ b/lilac/atm_driver/ctsm.cfg @@ -17,4 +17,8 @@ lnd_grid = 4x5 lnd_domain_file = domain.lnd.fv4x5_gx3v7.091218.nc lnd_domain_path = /glade/p/cesmdata/cseg/inputdata/share/domains din_loc_root = /glade/p/cesmdata/cseg/inputdata -clm_namelist_opts = "" +# clm_namelist_opts can contain space-separated settings of individual namelist variables; +# this should NOT be enclosed in quotes; example: +# clm_namelist_opts = foo=1 bar=2 +# The current setting is useful for testing (giving double-precision output every day) +clm_namelist_opts = hist_nhtfrq=-24 hist_mfilt=1 hist_ndens=1 From e5c384b5532975132d5ff5eb2cf48bcfd538c16e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 6 Dec 2019 16:51:03 -0700 Subject: [PATCH 224/556] cleaned up lilac_mod interface to atm_driver and lilac_atmcap module --- lilac/atm_driver/atm_driver.F90 | 30 ++- lilac/atm_driver/atm_driver_in | 2 + lilac/atm_driver/lilac_in | 3 + lilac/src/lilac_atmaero.F90 | 18 ++ lilac/src/lilac_atmcap.F90 | 390 +++++++++++++++++--------------- lilac/src/lilac_mod.F90 | 131 ++++------- 6 files changed, 290 insertions(+), 284 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 8f826862ec..1b5d82bd86 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -19,6 +19,7 @@ program atm_driver use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS use lilac_mod , only : lilac_init, lilac_run, lilac_final use lilac_atmcap, only : lilac_atmcap_atm2lnd, lilac_atmcap_lnd2atm + use shr_sys_mod , only : shr_sys_abort implicit none @@ -37,6 +38,8 @@ program atm_driver ! Namelist and related variables character(len=512) :: atm_mesh_file + integer :: atm_global_nx + integer :: atm_global_ny character(len=128) :: atm_calendar integer :: atm_timestep integer :: atm_start_year ! (yyyy) @@ -50,7 +53,8 @@ program atm_driver integer :: atm_timestep_start ! for internal time loop only integer :: atm_timestep_stop ! for internal time loop only - namelist /atm_driver_input/ atm_mesh_file, atm_calendar, atm_timestep, & + namelist /atm_driver_input/ atm_mesh_file, atm_global_nx, atm_global_ny, & + atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, & atm_timestep_start, atm_timestep_stop @@ -96,13 +100,19 @@ program atm_driver !----------------------------------------------------------------------------- ! Read mesh file to get number of points (n_points) + ! Also read in global number of lons and lats (needed for lilac history output) !----------------------------------------------------------------------------- - print *, "DEBUG: atm_mesh_file = ",trim(atm_mesh_file) call read_netcdf_mesh(atm_mesh_file, nglobal) + if (atm_global_nx * atm_global_ny /= nglobal) then + print *, " atm global nx, ny, nglobal = ",atm_global_nx, atm_global_ny, nglobal + call shr_sys_abort("Error atm_nx*atm_ny is not equal to nglobal") + end if if (mytask == 0 ) then print *, " atm_driver mesh file ",trim(atm_mesh_file) - print *, "number of global points in mesh is:", nglobal + print *, " atm global nx = ",atm_global_nx + print *, " atm global nx = ",atm_global_ny + print *, " atm number of global points in mesh is:", nglobal end if !----------------------------------------------------------------------------- @@ -144,23 +154,19 @@ program atm_driver if (mytask == 0 ) then print *, " initializing lilac " end if - call lilac_init(comp_comm, atm_mesh_file, atm_global_index, atm_lons, atm_lats, & - atm_calendar, atm_timestep, & + call lilac_init(comp_comm, atm_global_index, atm_lons, atm_lats, & + atm_global_nx, atm_global_ny, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs) - !------------------------------------------------------------------------ - ! Fill in atm2lnd type pointer data - !------------------------------------------------------------------------ - - ! now fill in the dataptr values - call atm_driver_to_lilac (atm_lons, atm_lats) - !------------------------------------------------------------------------ ! Run lilac !------------------------------------------------------------------------ do nstep = atm_timestep_start, atm_timestep_stop + ! fill in the dataptr values in atm2lnd type in lilac_atmcap + call atm_driver_to_lilac (atm_lons, atm_lats) + if (nstep == atm_timestep_stop) then call lilac_run(restart_alarm_is_ringing=.true., stop_alarm_is_ringing=.true.) else diff --git a/lilac/atm_driver/atm_driver_in b/lilac/atm_driver/atm_driver_in index b4becacda4..4d88e0b9b1 100644 --- a/lilac/atm_driver/atm_driver_in +++ b/lilac/atm_driver/atm_driver_in @@ -1,5 +1,7 @@ &atm_driver_input atm_mesh_file = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + atm_global_nx = 72 + atm_global_ny = 46 atm_start_year = 2000 atm_start_mon = 1 atm_start_day = 1 diff --git a/lilac/atm_driver/lilac_in b/lilac/atm_driver/lilac_in index b51fbe35fc..51b288ba84 100644 --- a/lilac/atm_driver/lilac_in +++ b/lilac/atm_driver/lilac_in @@ -2,6 +2,9 @@ starttype = 'startup' caseid = 'test_lilac' / +&lilac_atmcap_input + atm_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' +/ &lilac_lnd_input lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' / diff --git a/lilac/src/lilac_atmaero.F90 b/lilac/src/lilac_atmaero.F90 index 2ac17d8da7..cc9b6a175a 100644 --- a/lilac/src/lilac_atmaero.F90 +++ b/lilac/src/lilac_atmaero.F90 @@ -90,6 +90,8 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) integer , pointer :: idata(:) !----------------------------------------------------------------------- + rc = ESMF_SUCCESS + namelist /atmaero_stream/ & stream_year_first, & stream_year_last, & @@ -162,18 +164,28 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) ! obtain mesh lats, lons and areas ! ------------------------------ + write(6,*)'DEBUG: here1' + call ESMF_StateGet(atm2lnd_a_state, 'a2c_fb', lfieldbundle, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(6,*)'DEBUG: here1a' + call lilac_methods_FB_getFieldN(lfieldbundle, fieldnum=1, field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + write(6,*)'DEBUG: here1b' + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + write(6,*)'DEBUG: here1c' + call ESMF_MeshGet(lmesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(6,*)'DEBUG: here2' + if (numOwnedElements /= lsize) then call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') end if @@ -182,6 +194,8 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) call ESMF_MeshGet(lmesh, ownedElemCoords=ownedElemCoords, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(6,*)'DEBUG: here3' + allocate(mesh_lons(numOwnedElements)) allocate(mesh_lats(numOwnedElements)) allocate(mesh_areas(numOwnedElements)) @@ -205,6 +219,8 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) call mct_gGrid_importRattr(ggrid_atm,"mask", rdata, lsize) deallocate(mesh_lons, mesh_lats, mesh_areas, rdata) + write(6,*)'DEBUG: here4' + ! ------------------------------ ! create the stream data sdat ! ------------------------------ @@ -238,6 +254,8 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) calendar = get_calendar(), & taxmode = taxmode ) + write(6,*)'DEBUG: here5' + if (mytask == 0) then call shr_strdata_print(sdat,'ATMAERO data') endif diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index 5ff1541a49..9cc7eba862 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -6,9 +6,9 @@ module lilac_atmcap ! THE HOST ATMOSPHERE IS RESPONSIBLE for calling lilac_init() and in turn ! lilac_init() calls the initialization routines for atm2lnd and lnd2atm ! - ! the host atm init call will be + ! the host atm init call will be ! call lilac_init() - ! the host atm run phase will be + ! the host atm run phase will be ! call lilac_atm2lnd(fldname, data1d) ! call lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) ! call lilac_lnd2atm(fldname, data1d) @@ -21,19 +21,19 @@ module lilac_atmcap implicit none - public :: lilac_atmos_register - public :: lilac_atmcap_init public :: lilac_atmcap_atm2lnd public :: lilac_atmcap_lnd2atm + public :: lilac_atmcap_register private :: lilac_atmcap_add_fld - ! Global index space info for atm data - integer, public, allocatable :: gindex_atm (:) - - ! Mesh file to be read in by lilac_atm - character(len=CL), public :: atm_mesh_filename + ! Input from host atmosphere + integer, public, allocatable :: gindex_atm(:) ! global index space + integer, public, allocatable :: atm_lons(:) ! local longitudes + integer, public, allocatable :: atm_lats(:) ! local latitudes + integer, public :: atm_global_nx + integer, public :: atm_global_ny type :: atmcap_type character(len=CL) :: fldname @@ -45,9 +45,8 @@ module lilac_atmcap type(atmcap_type), pointer, public :: atm2lnd(:) type(atmcap_type), pointer, public :: lnd2atm(:) - integer :: mytask - integer, parameter :: debug = 0 ! internal debug level - + integer :: mytask + integer , parameter :: debug = 0 ! internal debug level character(*), parameter :: u_FILE_u = & __FILE__ @@ -55,10 +54,34 @@ module lilac_atmcap contains !======================================================================== - subroutine lilac_atmcap_init() - integer :: n, lsize + subroutine lilac_atmcap_init_vars(atm_gindex_in, atm_lons_in, atm_lats_in, atm_global_nx_in, atm_global_ny_in) + + ! input/output variables + integer , intent(in) :: atm_gindex_in(:) + real , intent(in) :: atm_lons_in(:) + real , intent(in) :: atm_lats_in(:) + integer , intent(in) :: atm_global_nx_in + integer , intent(in) :: atm_global_ny_in + + ! glocal variables + integer :: n, lsize, fileunit + ! -------------------------------------------- + + lsize = size(atm_gindex_in) + allocate(gindex_atm(lsize)) + allocate(atm_lons(lsize)) + allocate(atm_lats(lsize)) + + ! set module variables + gindex_atm(:) = atm_gindex_in(:) + atm_lons(:) = atm_lons_in(:) + atm_lats(:) = atm_lats_in(:) + atm_global_nx = atm_global_nx_in + atm_global_ny = atm_global_ny_in - lsize = size(gindex_atm) + !------------------------------------------------------------------------- + ! Set module arrays atm2lnd and lnd2atm + !------------------------------------------------------------------------- ! TODO: how is the atm going to specify which fields are not provided = ! should it pass an array of character strings or a colon deliminited set of fields @@ -96,13 +119,8 @@ subroutine lilac_atmcap_init() call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstdry3' , units='unknown', required_fr_atm=.true. , lsize=lsize) call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstwet4' , units='unknown', required_fr_atm=.true. , lsize=lsize) call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstdry4' , units='unknown', required_fr_atm=.true. , lsize=lsize) - - ! TODO: optional fields - if these are uncommented then need to make sure that they are also appear in the lnd - ! import state - ! CRITICAL the fields in the export state from lilac_atmcap MUST match the fields in the import state to the land - ! this is not being checked currently and msut be - !call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_methane' , units='unknown', required_fr_atm=.false. , lsize=lsize) - !call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_bcph' , units='unknown', required_fr_atm=.false. , lsize=lsize) + ! call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_methane' , units='unknown', required_fr_atm=.false. , lsize=lsize) + ! call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_bcph' , units='unknown', required_fr_atm=.false. , lsize=lsize) ! now add dataptr memory for all of the fields and set default values of provided_by_atm to false do n = 1,size(atm2lnd) @@ -139,145 +157,12 @@ subroutine lilac_atmcap_init() allocate(lnd2atm(n)%dataptr(lsize)) end do - end subroutine lilac_atmcap_init - -!======================================================================== - subroutine lilac_atmcap_atm2lnd(fldname, data) - - ! input/output variables - character(len=*), intent(in) :: fldname - real(r8), intent(in) :: data(:) - - ! local variables - integer :: n - logical :: found - ! -------------------------------------------- - - found = .false. - do n = 1,size(atm2lnd) - if (trim(fldname) == atm2lnd(n)%fldname) then - found = .true. - if (size(data) /= size(atm2lnd(n)%dataptr)) then - ! call abort - TODO: what is the abort call in lilac - else - atm2lnd(n)%dataptr(:) = data(:) - end if - atm2lnd(n)%provided_by_atm = .true. - exit - end if - end do - if (.not. found) then - ! abort - end if - - contains - - subroutine lilac_atm2lnd_check() - integer :: n ! if there are fields that the atmosphere does not provide but - ! that are required - then abort - do n = 1,size(atm2lnd) - if (atm2lnd(n)%required_fr_atm .and. (.not. atm2lnd(n)%provided_by_atm)) then - ! call abort or provide default values? - else if (.not. atm2lnd(n)%provided_by_atm) then - ! create default values - end if - end do - end subroutine lilac_atm2lnd_check - - end subroutine lilac_atmcap_atm2lnd - -!======================================================================== - subroutine lilac_atmcap_lnd2atm(fldname, data) - character(len=*) , intent(in) :: fldname - real(r8) , intent(out) :: data(:) - integer :: n - - do n = 1,size(lnd2atm) - if (trim(fldname) == lnd2atm(n)%fldname) then - if (size(data) /= size(lnd2atm(n)%dataptr)) then - ! call abort - TODO: what is the abort call in lilac - else - data(:) = lnd2atm(n)%dataptr(:) - end if - end if - end do - end subroutine lilac_atmcap_lnd2atm - -!======================================================================== - subroutine lilac_atmcap_add_fld(flds, fldname, units, lsize, required_fr_atm) - - ! ---------------------------------------------- - ! Add an entry to to the flds array - ! Use pointers to create an extensible allocatable array. - ! to allow the size of flds to grow, the process for - ! adding a new field is: - ! 1) allocate newflds to be N (one element larger than flds) - ! 2) copy flds into first N-1 elements of newflds - ! 3) newest flds entry is Nth element of newflds - ! 4) deallocate / nullify flds - ! 5) point flds => newflds - ! ---------------------------------------------- - - type(atmcap_type), pointer :: flds(:) - character(len=*) , intent(in) :: fldname - character(len=*) , intent(in) :: units - integer , intent(in) :: lsize - logical, optional, intent(in) :: required_fr_atm - - ! local variables - integer :: n,oldsize,newsize - type(atmcap_type), pointer :: newflds(:) - character(len=*), parameter :: subname='(lilac_atmcap_atm2lnd_fld)' - ! ---------------------------------------------- - - if (associated(flds)) then - oldsize = size(flds) - else - oldsize = 0 - end if - newsize = oldsize + 1 - - if (oldsize > 0) then - ! 1) allocate newfld to be size (one element larger than input flds) - allocate(newflds(newsize)) - - ! 2) copy flds into first N-1 elements of newflds - do n = 1,oldsize - newflds(n)%fldname = flds(n)%fldname - newflds(n)%units = flds(n)%units - newflds(n)%required_fr_atm = flds(n)%required_fr_atm - end do - - ! 3) deallocate / nullify flds - if (oldsize > 0) then - deallocate(flds) - nullify(flds) - end if - - ! 4) point flds => new_flds - flds => newflds - - ! 5) update flds information for new entry - flds(newsize)%fldname = trim(fldname) - flds(newsize)%units = trim(units) - if (present(required_fr_atm)) then - flds(newsize)%required_fr_atm = required_fr_atm - end if - - else - allocate(flds(newsize)) - flds(newsize)%fldname = trim(fldname) - flds(newsize)%units = trim(units) - if (present(required_fr_atm)) then - flds(newsize)%required_fr_atm = required_fr_atm - end if - end if - - end subroutine lilac_atmcap_add_fld + end subroutine lilac_atmcap_init_vars !======================================================================== - subroutine lilac_atmos_register (comp, rc) + subroutine lilac_atmcap_register (comp, rc) + ! input/output variables type(ESMF_GridComp) :: comp ! must not be optional integer, intent(out) :: rc @@ -299,20 +184,20 @@ subroutine lilac_atmos_register (comp, rc) rc = ESMF_SUCCESS ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=lilac_atmos_init, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=lilac_atmcap_init, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=lilac_atmos_run, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=lilac_atmcap_run, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=lilac_atmos_final, rc=rc) + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=lilac_atmcap_final, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine lilac_atmos_register + end subroutine lilac_atmcap_register !======================================================================== - subroutine lilac_atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) + subroutine lilac_atmcap_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! input/output variables type (ESMF_GridComp) :: comp @@ -321,12 +206,15 @@ subroutine lilac_atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) integer, intent(out) :: rc ! local variables + integer :: fileunit type(ESMF_Mesh) :: atm_mesh type(ESMF_DistGrid) :: atm_distgrid type(ESMF_Field) :: field type(ESMF_FieldBundle) :: c2a_fb , a2c_fb - integer :: n, i - character(len=*), parameter :: subname='(lilac_atmos_init): ' + integer :: n, i, ierr + character(len=cl) :: atm_mesh_filename + character(len=*), parameter :: subname='(lilac_atmcap_init): ' + namelist /lilac_atmcap_input/ atm_mesh_filename !------------------------------------------------------------------------- ! Initialize return code @@ -338,18 +226,30 @@ subroutine lilac_atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! Read in the atm mesh !------------------------------------------------------------------------- - ! Note that in the call to lilac_atm the host atmospere sent both the gindex_atm and + ! read in mesh file name from namelist + open(newunit=fileunit, status="old", file="lilac_in") + read(fileunit, lilac_atmcap_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(trim(subname) // 'error reading in lilac_atm_input') + end if + close(fileunit) + + ! Note that in the call to lilac_atm the host atmospere sent both the gindex_atm and ! the atm_mesh_filename that were then set as module variables here atm_distgrid = ESMF_DistGridCreate (arbSeqIndexList=gindex_atm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! TODO: the addUserArea failed for the 4x5 grid - need to have a more robust approach - unless the area will simply be ignored for now? - ! atm_mesh = ESMF_MeshCreate(filename=trim(atm_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + ! TODO: the addUserArea failed for the 4x5 grid - need to have a + ! more robust approach - unless the area will simply be ignored for now? + ! atm_mesh = ESMF_MeshCreate(filename=trim(atm_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & ! elementDistGrid=atm_distgrid, addUserArea=.true., rc=rc) atm_mesh = ESMF_MeshCreate(filename=trim(atm_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & elementDistGrid=atm_distgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) then + call shr_sys_abort(trim(subname) // 'Error: failure in creating lilac atmcap from meshfile '//& + trim(atm_mesh_filename)) + end if call ESMF_LogWrite(trim(subname)//"Mesh for atmosphere is created for "//trim(atm_mesh_filename), ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -419,10 +319,10 @@ subroutine lilac_atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) ! Set Attributes needed by land call ESMF_AttributeSet(lnd2atm_a_state, name="nextsw_cday", value=11, rc=rc) ! TODO: mv what in the world is this??? - end subroutine lilac_atmos_init + end subroutine lilac_atmcap_init !======================================================================== - subroutine lilac_atmos_run(comp, importState, exportState, clock, rc) + subroutine lilac_atmcap_run(comp, importState, exportState, clock, rc) ! input/output variables type(ESMF_GridComp) :: comp @@ -430,18 +330,14 @@ subroutine lilac_atmos_run(comp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc - ! local variables - character(len=*), parameter :: subname='(lilac_atmos_run):' - ! Initialize return code + ! This routine does nothing - its all in the atm->lnd coupler rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//"Should atmos_run ", ESMF_LOGMSG_INFO) - - end subroutine lilac_atmos_run + end subroutine lilac_atmcap_run !======================================================================== - subroutine lilac_atmos_final(comp, importState, exportState, clock, rc) + subroutine lilac_atmcap_final(comp, importState, exportState, clock, rc) ! input/output variables type(ESMF_GridComp) :: comp @@ -466,8 +362,142 @@ subroutine lilac_atmos_final(comp, importState, exportState, clock, rc) call ESMF_FieldBundleDestroy(import_fieldbundle, rc=rc) call ESMF_FieldBundleDestroy(export_fieldbundle, rc=rc) - call ESMF_LogWrite(subname//"?? Are there any other thing for destroying in atmos_final??", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Finished lilac_atmcap_final", ESMF_LOGMSG_INFO) + + end subroutine lilac_atmcap_final + +!======================================================================== + subroutine lilac_atmcap_atm2lnd(fldname, data) + + ! input/output variables + character(len=*), intent(in) :: fldname + real(r8), intent(in) :: data(:) + + ! local variables + integer :: n + logical :: found + ! -------------------------------------------- + + found = .false. + do n = 1,size(atm2lnd) + if (trim(fldname) == atm2lnd(n)%fldname) then + found = .true. + if (size(data) /= size(atm2lnd(n)%dataptr)) then + ! call abort - TODO: what is the abort call in lilac + else + atm2lnd(n)%dataptr(:) = data(:) + end if + atm2lnd(n)%provided_by_atm = .true. + exit + end if + end do + if (.not. found) then + ! abort + end if + + contains + + subroutine lilac_atm2lnd_check() + integer :: n ! if there are fields that the atmosphere does not provide but + ! that are required - then abort + do n = 1,size(atm2lnd) + if (atm2lnd(n)%required_fr_atm .and. (.not. atm2lnd(n)%provided_by_atm)) then + ! call abort or provide default values? + else if (.not. atm2lnd(n)%provided_by_atm) then + ! create default values + end if + end do + end subroutine lilac_atm2lnd_check + + end subroutine lilac_atmcap_atm2lnd + +!======================================================================== + subroutine lilac_atmcap_lnd2atm(fldname, data) + character(len=*) , intent(in) :: fldname + real(r8) , intent(out) :: data(:) + integer :: n + + do n = 1,size(lnd2atm) + if (trim(fldname) == lnd2atm(n)%fldname) then + if (size(data) /= size(lnd2atm(n)%dataptr)) then + ! call abort - TODO: what is the abort call in lilac + else + data(:) = lnd2atm(n)%dataptr(:) + end if + end if + end do + end subroutine lilac_atmcap_lnd2atm + +!======================================================================== + subroutine lilac_atmcap_add_fld(flds, fldname, units, lsize, required_fr_atm) + + ! ---------------------------------------------- + ! Add an entry to to the flds array + ! Use pointers to create an extensible allocatable array. + ! to allow the size of flds to grow, the process for + ! adding a new field is: + ! 1) allocate newflds to be N (one element larger than flds) + ! 2) copy flds into first N-1 elements of newflds + ! 3) newest flds entry is Nth element of newflds + ! 4) deallocate / nullify flds + ! 5) point flds => newflds + ! ---------------------------------------------- + + type(atmcap_type), pointer :: flds(:) + character(len=*) , intent(in) :: fldname + character(len=*) , intent(in) :: units + integer , intent(in) :: lsize + logical, optional, intent(in) :: required_fr_atm + + ! local variables + integer :: n,oldsize,newsize + type(atmcap_type), pointer :: newflds(:) + character(len=*), parameter :: subname='(lilac_atmcap_atm2lnd_fld)' + ! ---------------------------------------------- + + if (associated(flds)) then + oldsize = size(flds) + else + oldsize = 0 + end if + newsize = oldsize + 1 + + if (oldsize > 0) then + ! 1) allocate newfld to be size (one element larger than input flds) + allocate(newflds(newsize)) + + ! 2) copy flds into first N-1 elements of newflds + do n = 1,oldsize + newflds(n)%fldname = flds(n)%fldname + newflds(n)%units = flds(n)%units + newflds(n)%required_fr_atm = flds(n)%required_fr_atm + end do + + ! 3) deallocate / nullify flds + if (oldsize > 0) then + deallocate(flds) + nullify(flds) + end if + + ! 4) point flds => new_flds + flds => newflds + + ! 5) update flds information for new entry + flds(newsize)%fldname = trim(fldname) + flds(newsize)%units = trim(units) + if (present(required_fr_atm)) then + flds(newsize)%required_fr_atm = required_fr_atm + end if + + else + allocate(flds(newsize)) + flds(newsize)%fldname = trim(fldname) + flds(newsize)%units = trim(units) + if (present(required_fr_atm)) then + flds(newsize)%required_fr_atm = required_fr_atm + end if + end if - end subroutine lilac_atmos_final + end subroutine lilac_atmcap_add_fld end module lilac_atmcap diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 52ddcd0a88..0d0ce9cc21 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -1,10 +1,9 @@ module lilac_mod !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! This is the driver for running CTSM and the ESMF lilac atm cap that - ! is put in place to ensure that the host atmosphere does not need to - ! know about ESMF + ! This is the driver for running CTSM, the ESMF lilac atm cap, and + ! optionally the MOSART river model that is put in place to ensure + ! that the host atmosphere does not need to know about ESMF !----------------------------------------------------------------------- ! External libraries @@ -17,26 +16,27 @@ module lilac_mod ! lilac routines use lilac_io , only : lilac_io_init - use lilac_atmcap , only : lilac_atmcap_init - use lilac_atmcap , only : gindex_atm, atm_mesh_filename - use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register - use lilac_cpl , only : cpl_lnd2rof_register, cpl_rof2lnd_register - use lilac_atmcap , only : lilac_atmos_register - use lilac_atmaero , only : lilac_atmaero_init - use lilac_atmaero , only : lilac_atmaero_interp + use lilac_atmaero , only : lilac_atmaero_init, lilac_atmaero_interp + use lilac_atmcap , only : lilac_atmcap_init_vars use lilac_history , only : lilac_history_write use lilac_methods , only : chkerr - ! ctsm routines + ! lilac register phaes + use lilac_atmcap , only : lilac_atmcap_register + use lilac_cpl , only : cpl_atm2lnd_register, cpl_lnd2atm_register + use lilac_cpl , only : cpl_lnd2rof_register, cpl_rof2lnd_register + + ! ctsm register use lnd_comp_esmf , only : lnd_register ! ctsm routine - ! mosart routines + ! mosart register use rof_comp_esmf , only : rof_register ! mosart routine implicit none public :: lilac_init public :: lilac_run + public :: lilac_final ! Gridded components and states in gridded components type(ESMF_GridComp) :: atm_gcomp @@ -73,8 +73,8 @@ module lilac_mod contains !======================================================================== - subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lats, & - atm_calendar, atm_timestep, & + subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & + atm_global_nx, atm_global_ny, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs) @@ -84,10 +84,11 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat ! input/output variables integer , intent(inout) :: mpicom ! input commiunicator from atm - character(len=*) , intent(in) :: atm_mesh_file integer , intent(in) :: atm_global_index(:) real , intent(in) :: atm_lons(:) real , intent(in) :: atm_lats(:) + integer , intent(in) :: atm_global_nx + integer , intent(in) :: atm_global_ny character(len=*) , intent(in) :: atm_calendar integer , intent(in) :: atm_timestep integer , intent(in) :: atm_start_year !(yyyy) @@ -132,7 +133,7 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat !------------------------------------------------------------------------- ! Initialize pio with first initialization - ! AFTER call to MPI_init (which is in the host atm driver) and + ! AFTER call to MPI_init (which is in the host atm driver) and ! BEFORE call to ESMF_Initialize !------------------------------------------------------------------------- call shr_pio_init1(ncomps=1, nlfilename="lilac_in", Global_Comm=mpicom) @@ -141,8 +142,11 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat ! Initialize ESMF, set the default calendar and log type. !------------------------------------------------------------------------- - ! TODO: cannot assume that the calendar is always gregorian unless CTSM assumes this as well - ! Need to coordinate the calendar info between lilac and the host component + ! NOTE: the default calendar is set to GREGORIAN and is reset below in the initialization of + ! the lilac clock + ! TODO: ensure that CTSM queries the lilac_clock for the calendar and initializes its own + ! internal clock accordingly + ! TODO: the same is true for the datm time manager that reads in prescribed data call ESMF_Initialize(mpiCommunicator=mpicom, defaultCalKind=ESMF_CALKIND_GREGORIAN, & logappendflag=.false., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -171,24 +175,13 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat call ESMF_LogWrite(subname//"initialized shr_pio_init2 ...", ESMF_LOGMSG_INFO) !------------------------------------------------------------------------- - ! Initial lilac_atmcap module variables + ! Initial lilac atmosphere cap module variables !------------------------------------------------------------------------- - - ! Initialize gindex_atm - lsize = size(atm_global_index) - allocate(gindex_atm(lsize)) - gindex_atm(:) = atm_global_index(:) - - ! Initialize atm_mesh_filename - atm_mesh_filename = atm_mesh_file - - ! Initialize datatypes atm2lnd and lnd2atm - ! This must be done BEFORE the atmcap initialization - since the dataptr attributes - ! are needed to initialize the atmcap field bundles - call lilac_atmcap_init() + ! This must be done BEFORE the atmcap initialization + call lilac_atmcap_init_vars(atm_global_index, atm_lons, atm_lats, atm_global_nx, atm_global_ny) !------------------------------------------------------------------------- - ! Create Gridded Component -- lilac atmos_cap + ! Create Gridded and Coupler Components !------------------------------------------------------------------------- cname = " LILAC atm cap " atm_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) @@ -198,9 +191,6 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat print *, trim(subname) // "lilac atm cap gridded component created" end if - !------------------------------------------------------------------------- - ! Create Gridded Component -- CTSM land - !------------------------------------------------------------------------- cname = " CTSM " lnd_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac ctsm initialization') @@ -209,9 +199,6 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat print *, trim(subname) // " ctsm gridded component created" end if - !------------------------------------------------------------------------- - ! Create Gridded Component -- MOSART river - !------------------------------------------------------------------------- cname = " MOSART " rof_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac mosart initialization') @@ -220,9 +207,6 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat print *, trim(subname) // " mosart gridded component created" end if - !------------------------------------------------------------------------- - ! Create Coupling Component! --- Coupler from atmos to land - !------------------------------------------------------------------------- cname = "Coupler from atmosphere to land" cpl_atm2lnd_comp = ESMF_CplCompCreate(name=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_a2l initialization') @@ -231,9 +215,6 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat print *, trim(subname) // " coupler component (atmosphere to land) created" end if - !------------------------------------------------------------------------- - ! Create Coupling Component! -- Coupler from land to atmos - !------------------------------------------------------------------------- cname = "Coupler from land to atmosphere" cpl_lnd2atm_comp = ESMF_CplCompCreate(name=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_l2a initialization') @@ -242,9 +223,6 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat print *, trim(subname) // " coupler component (land to atmosphere) created" end if - !------------------------------------------------------------------------- - ! Create Coupling Component! --- Coupler from rof to land - !------------------------------------------------------------------------- cname = "Coupler from river to land" cpl_rof2lnd_comp = ESMF_CplCompCreate(name=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_r2l initialization') @@ -253,9 +231,6 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat print *, trim(subname) // " coupler component (atmosphere to land) created" end if - !------------------------------------------------------------------------- - ! Create Coupling Component! -- Coupler from land to atmos - !------------------------------------------------------------------------- cname = "Coupler from land to river" cpl_lnd2rof_comp = ESMF_CplCompCreate(name=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_l2r initialization') @@ -265,18 +240,18 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat end if !------------------------------------------------------------------------- - ! Register section -- set services -- atmcap + ! Register gridded and coupler components !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(atm_gcomp, userRoutine=lilac_atmos_register, rc=rc) + + ! Register section -- set services -- atmcap + call ESMF_GridCompSetServices(atm_gcomp, userRoutine=lilac_atmcap_register, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('atm_gcomp register failure') call ESMF_LogWrite(subname//" atmos SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then print *, trim(subname) // " lilac atm cap setservices finished" end if - !------------------------------------------------------------------------- ! Register section -- set services -- ctsm - !------------------------------------------------------------------------- call ESMF_GridCompSetServices(lnd_gcomp, userRoutine=lnd_register, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('lnd_gcomp register failure') call ESMF_LogWrite(subname//"CSTM SetServices finished!", ESMF_LOGMSG_INFO) @@ -284,9 +259,7 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat print *, trim(subname) // " CTSM setservices finished" end if - !------------------------------------------------------------------------- ! Register section -- set services -- mosart - !------------------------------------------------------------------------- call ESMF_GridCompSetServices(rof_gcomp, userRoutine=rof_register, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('rof_gcomp register failure') call ESMF_LogWrite(subname//"MOSART SetServices finished!", ESMF_LOGMSG_INFO) @@ -294,9 +267,7 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat print *, trim(subname) // " CTSM setservices finished" end if - !------------------------------------------------------------------------- ! Register section -- set services -- coupler atmosphere to land - !------------------------------------------------------------------------- call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_atm2lnd_comp register failure') call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) @@ -304,9 +275,7 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat print *, trim(subname) // " coupler from atmosphere to land setservices finished" end if - !------------------------------------------------------------------------- ! Register section -- set services -- river to land - !------------------------------------------------------------------------- call ESMF_CplCompSetServices(cpl_rof2lnd_comp, userRoutine=cpl_rof2lnd_register, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_rof2lnd_comp register failure') call ESMF_LogWrite(subname//"Coupler from river to land SetServices finished!", ESMF_LOGMSG_INFO) @@ -314,9 +283,7 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat print *, trim(subname) // " coupler from river to land setservices finished" end if - !------------------------------------------------------------------------- ! Register section -- set services -- coupler land to atmosphere - !------------------------------------------------------------------------- call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_lnd2atm_register, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2atm_comp register failure') call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) @@ -324,9 +291,7 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat print *, trim(subname) // " coupler from land to atmosphere setservices finished" end if - !------------------------------------------------------------------------- ! Register section -- set services -- coupler land to river - !------------------------------------------------------------------------- call ESMF_CplCompSetServices(cpl_lnd2rof_comp, userRoutine=cpl_lnd2rof_register, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2rof_comp register failure') call ESMF_LogWrite(subname//"Coupler from land to river SetServices finished!", ESMF_LOGMSG_INFO) @@ -341,7 +306,7 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat if (trim(atm_calendar) == 'NOLEAP') then lilac_calendar = ESMF_CalendarCreate(name='NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) else if (trim(atm_calendar) == 'GREGORIAN') then - lilac_calendar = ESMF_CalendarCreate(name='NOLEAP', calkindflag=ESMF_CALKIND_GREGORIAN, rc=rc ) + lilac_calendar = ESMF_CalendarCreate(name='GREGORIAN', calkindflag=ESMF_CALKIND_GREGORIAN, rc=rc ) else ! TODO: add supported calendars here end if @@ -379,11 +344,12 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing stop alarm') ! ------------------------------------------------------------------------- - ! Initialze lilac_atm gridded component + ! Initialize LILAC gridded components ! First Create the empty import and export states used to pass data ! between components. (these are module variables) ! ------------------------------------------------------------------------- + ! Initialze lilac_atm gridded component atm2cpl_state = ESMF_StateCreate(name='state_from_atm', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return cpl2atm_state = ESMF_StateCreate(name='state_to_atm', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) @@ -394,12 +360,7 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing atmcap") call ESMF_LogWrite(subname//"lilac_atm gridded component initialized", ESMF_LOGMSG_INFO) - ! ------------------------------------------------------------------------- ! Initialze CTSM Gridded Component - ! First Create the empty import and export states used to pass data - ! between components. (these are module variables) - ! ------------------------------------------------------------------------- - cpl2lnd_state = ESMF_StateCreate(name='state_to_land', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return lnd2cpl_state = ESMF_StateCreate(name='state_fr_land', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) @@ -410,13 +371,8 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing ctsm") call ESMF_LogWrite(subname//"CTSM gridded component initialized", ESMF_LOGMSG_INFO) - ! ------------------------------------------------------------------------- - ! Initialize MOSART Gridded Component - ! First Create the empty import and export states used to pass data - ! between components. (these are module variables) - ! ------------------------------------------------------------------------- - if (couple_to_river) then + ! Initialize MOSART Gridded Component cpl2rof_state = ESMF_StateCreate(name='state_to_river', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return rof2cpl_state = ESMF_StateCreate(name='state_fr_river', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) @@ -429,12 +385,11 @@ subroutine lilac_init(mpicom, atm_mesh_file, atm_global_index, atm_lons, atm_lat end if ! ------------------------------------------------------------------------- - ! Initialze LILAC coupler components + ! Initialize LILAC coupler components ! ------------------------------------------------------------------------- - ! Note that the lnd2cpl_state and cpl2lnd_state are each made up of 2 field bundles, - ! one for the river and one for the atm - - + ! Note that the lnd2cpl_state and cpl2lnd_state are each made up of 2 field bundles, + ! one for the river and one for the atm - ! The following fills in the atm field bundle in cpl2lnd_state call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, & clock=lilac_clock, rc=rc) @@ -550,7 +505,7 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in cpl_lnd2atm") if (couple_to_river) then - ! Run cpl_lnd2rof + ! Run cpl_lnd2rof call ESMF_LogWrite(subname//"running cpl_lnd2rof_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) print *, "Running coupler component..... cpl_lnd2rof_comp" call ESMF_CplCompRun(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & @@ -613,9 +568,7 @@ subroutine lilac_final( ) print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" end if - !------------------------------------------------------------------------- ! Gridded Component Finalizing! --- atmosphere - !------------------------------------------------------------------------- call ESMF_GridCompFinalize(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp is running", ESMF_LOGMSG_INFO) @@ -623,9 +576,7 @@ subroutine lilac_final( ) print *, "Finalizing atmos_cap gridded component , rc =", rc end if - !------------------------------------------------------------------------- ! Coupler component Finalizing --- coupler atmos to land - !------------------------------------------------------------------------- call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) @@ -633,9 +584,7 @@ subroutine lilac_final( ) print *, "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc end if - !------------------------------------------------------------------------- ! Gridded Component Finalizing! --- land - !------------------------------------------------------------------------- call ESMF_GridCompFinalize(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp is running", ESMF_LOGMSG_INFO) @@ -643,9 +592,7 @@ subroutine lilac_final( ) print *, "Finalizing lnd_cap gridded component , rc =", rc end if - !------------------------------------------------------------------------- ! Coupler component Finalizing --- coupler land to atmos - !------------------------------------------------------------------------- call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=cpl2lnd_state, exportState=cpl2atm_state, clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) From d3294b0884d580e9dac52b12360a7a729d2bfda0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 6 Dec 2019 19:43:11 -0700 Subject: [PATCH 225/556] cleanup of history alarms --- lilac/atm_driver/lilac_in | 4 + lilac/src/lilac_atmaero.F90 | 16 --- lilac/src/lilac_atmcap.F90 | 3 +- lilac/src/lilac_history.F90 | 154 +++++++++++++++++----------- lilac/src/lilac_mod.F90 | 17 ++- src/cpl/lilac/lnd_comp_esmf.F90 | 71 ++++++------- src/cpl/lilac/lnd_import_export.F90 | 18 +--- 7 files changed, 147 insertions(+), 136 deletions(-) diff --git a/lilac/atm_driver/lilac_in b/lilac/atm_driver/lilac_in index 51b288ba84..852cd48637 100644 --- a/lilac/atm_driver/lilac_in +++ b/lilac/atm_driver/lilac_in @@ -2,6 +2,10 @@ starttype = 'startup' caseid = 'test_lilac' / +&lilac_io_input + lilac_histfreq_n = 4 + lilac_histfreq_option = 'nsteps' +/ &lilac_atmcap_input atm_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' / diff --git a/lilac/src/lilac_atmaero.F90 b/lilac/src/lilac_atmaero.F90 index cc9b6a175a..a09d2955a0 100644 --- a/lilac/src/lilac_atmaero.F90 +++ b/lilac/src/lilac_atmaero.F90 @@ -164,28 +164,18 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) ! obtain mesh lats, lons and areas ! ------------------------------ - write(6,*)'DEBUG: here1' - call ESMF_StateGet(atm2lnd_a_state, 'a2c_fb', lfieldbundle, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(6,*)'DEBUG: here1a' - call lilac_methods_FB_getFieldN(lfieldbundle, fieldnum=1, field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(6,*)'DEBUG: here1b' - call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(6,*)'DEBUG: here1c' - call ESMF_MeshGet(lmesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(6,*)'DEBUG: here2' - if (numOwnedElements /= lsize) then call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') end if @@ -194,8 +184,6 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) call ESMF_MeshGet(lmesh, ownedElemCoords=ownedElemCoords, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(6,*)'DEBUG: here3' - allocate(mesh_lons(numOwnedElements)) allocate(mesh_lats(numOwnedElements)) allocate(mesh_areas(numOwnedElements)) @@ -219,8 +207,6 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) call mct_gGrid_importRattr(ggrid_atm,"mask", rdata, lsize) deallocate(mesh_lons, mesh_lats, mesh_areas, rdata) - write(6,*)'DEBUG: here4' - ! ------------------------------ ! create the stream data sdat ! ------------------------------ @@ -254,8 +240,6 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) calendar = get_calendar(), & taxmode = taxmode ) - write(6,*)'DEBUG: here5' - if (mytask == 0) then call shr_strdata_print(sdat,'ATMAERO data') endif diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index 9cc7eba862..635f3b29dd 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -214,6 +214,7 @@ subroutine lilac_atmcap_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) integer :: n, i, ierr character(len=cl) :: atm_mesh_filename character(len=*), parameter :: subname='(lilac_atmcap_init): ' + namelist /lilac_atmcap_input/ atm_mesh_filename !------------------------------------------------------------------------- @@ -230,7 +231,7 @@ subroutine lilac_atmcap_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) open(newunit=fileunit, status="old", file="lilac_in") read(fileunit, lilac_atmcap_input, iostat=ierr) if (ierr > 0) then - call shr_sys_abort(trim(subname) // 'error reading in lilac_atm_input') + call shr_sys_abort(trim(subname) // 'error reading in lilac_atmcap_input') end if close(fileunit) diff --git a/lilac/src/lilac_history.F90 b/lilac/src/lilac_history.F90 index e754bc9151..5643737a26 100644 --- a/lilac/src/lilac_history.F90 +++ b/lilac/src/lilac_history.F90 @@ -6,28 +6,28 @@ module lilac_history use ESMF use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl, r8=>shr_kind_r8 - use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag - use lilac_constants , only : SecPerDay => lilac_constants_SecPerDay - use lilac_methods , only : FB_reset => lilac_methods_FB_reset - use lilac_methods , only : FB_diagnose => lilac_methods_FB_diagnose - use lilac_methods , only : FB_GetFldPtr => lilac_methods_FB_GetFldPtr - use lilac_methods , only : FB_accum => lilac_methods_FB_accum + use shr_sys_mod , only : shr_sys_abort + use lilac_atmcap , only : atm_nx => atm_global_nx + use lilac_atmcap , only : atm_ny => atm_global_ny + use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag + use lilac_constants , only : SecPerDay => lilac_constants_SecPerDay + use lilac_time , only : alarmInit => lilac_time_alarmInit + use lilac_methods , only : FB_reset => lilac_methods_FB_reset + use lilac_methods , only : FB_diagnose => lilac_methods_FB_diagnose + use lilac_methods , only : FB_GetFldPtr => lilac_methods_FB_GetFldPtr + use lilac_methods , only : FB_accum => lilac_methods_FB_accum use lilac_methods , only : chkerr - use lilac_time , only : alarmInit => lilac_time_alarmInit use lilac_io , only : lilac_io_write, lilac_io_wopen, lilac_io_enddef use lilac_io , only : lilac_io_close, lilac_io_date2yyyymmdd, lilac_io_sec2hms use lilac_io , only : lilac_io_ymd2date - ! For global domains - ! TODO: need to generalize obtaining global domains via state attributes - use domainMod , only : ldomain - implicit none private - public :: lilac_history_alarm_init + public :: lilac_history_init public :: lilac_history_write + character(CL) :: histfile_prefix type(ESMF_Alarm) :: AlarmHist type(ESMF_Alarm) :: AlarmHistAvg character(*), parameter :: u_FILE_u = & @@ -37,14 +37,14 @@ module lilac_history contains !=============================================================================== - subroutine lilac_history_alarm_init(clock, hist_freq_n, hist_freq_option, rc) + subroutine lilac_history_init(clock, rc) + ! ------------------------------------------ ! Initialize lilac history file alarm + ! ------------------------------------------ ! input/output variables type(ESMF_Clock) :: clock ! lilac clock - integer , intent(in) :: hist_freq_n - character(len=*) , intent(in) :: hist_freq_option integer , intent(out) :: rc ! local variables @@ -54,12 +54,20 @@ subroutine lilac_history_alarm_init(clock, hist_freq_n, hist_freq_option, rc) type(ESMF_Time) :: nexttime type(ESMF_Calendar) :: calendar ! calendar type character(len=64) :: currtimestr - character(CS) :: histavg_option ! Histavg option units integer :: yr,mon,day,sec ! time units character(CL) :: freq_option ! freq_option setting (ndays, nsteps, etc) integer :: freq_n ! freq_n setting relative to freq_option integer :: iam - character(len=*), parameter :: subname='(lilac_history_alarm_init)' + integer :: fileunit + integer :: ierr + character(CL) :: caseid + character(CS) :: starttype + character(CS) :: lilac_histfreq_option + integer :: lilac_histfreq_n + character(len=*), parameter :: subname='(lilac_history_init)' + + namelist /lilac_run_input/ caseid, starttype + namelist /lilac_io_input/ lilac_histfreq_n, lilac_histfreq_option !--------------------------------------- if (dbug_flag > 5) then @@ -67,6 +75,23 @@ subroutine lilac_history_alarm_init(clock, hist_freq_n, hist_freq_option, rc) endif rc = ESMF_SUCCESS + ! read in caseid + open(newunit=fileunit, status="old", file="lilac_in") + read(fileunit, lilac_run_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(trim(subname) // 'error reading in lilac_run_input') + end if + close(fileunit) + write(histfile_prefix,"(2a)") trim(caseid),'.lilac.hi.' + + ! read in history file output frequencies + open(newunit=fileunit, status="old", file="lilac_in") + read(fileunit, lilac_io_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(trim(subname) // 'error reading in lilac_io_input') + end if + close(fileunit) + !--------------------------------------- ! Get the clock info !--------------------------------------- @@ -85,10 +110,11 @@ subroutine lilac_history_alarm_init(clock, hist_freq_n, hist_freq_option, rc) ! Initialize thie history alarm !--------------------------------------- - call alarmInit(clock, AlarmHist, option=freq_option, opt_n=freq_n, RefTime=RefTime, alarmname='history', rc=rc) + call alarmInit(clock, AlarmHist, option=lilac_histfreq_option, opt_n=lilac_histfreq_n, & + RefTime=RefTime, alarmname='lilac_history_alarm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine lilac_history_alarm_init + end subroutine lilac_history_init !=============================================================================== @@ -121,29 +147,24 @@ subroutine lilac_history_write(atm2cpl_state, cpl2atm_state, & type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time type(ESMF_Calendar) :: calendar ! calendar type character(len=CS) :: currtimestr - integer :: nx_atm, ny_atm - integer :: nx_lnd, ny_lnd - integer :: nx_rof, ny_rof character(len=CS) :: nexttimestr - character(CS) :: histavg_option ! Histavg option units - integer :: i,j,m,n,n1,ncnt + integer :: i,j,m,n integer :: start_ymd ! Starting date YYYYMMDD integer :: start_tod ! Starting time-of-day (s) integer :: nx,ny ! global grid size integer :: yr,mon,day,sec ! time units real(r8) :: rval ! real tmp value real(r8) :: dayssince ! Time interval since reference time - integer :: fk ! index character(CL) :: time_units ! units of time variable - character(CL) :: case_name ! case name character(CL) :: hist_file ! Local path to history filename - character(CS) :: cpl_inst_tag ! instance tag character(CL) :: freq_option ! freq_option setting (ndays, nsteps, etc) integer :: freq_n ! freq_n setting relative to freq_option logical :: alarmIsOn ! generic alarm flag real(r8) :: tbnds(2) ! CF1.0 time bounds logical :: whead,wdata ! for writing restart/history cdf files - integer :: dbrc + character(CL) :: cvalue + integer :: lnd_nx, lnd_ny + integer :: rof_nx, rof_ny integer :: iam logical,save :: first_call = .true. character(len=*), parameter :: subname='(lilac_history_write)' @@ -201,17 +222,17 @@ subroutine lilac_history_write(atm2cpl_state, cpl2atm_state, & ! --- History Alarms !--------------------------------------- - ! if (ESMF_AlarmIsRinging(AlarmHist, rc=rc)) then - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! alarmIsOn = .true. - ! call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! else - ! alarmisOn = .false. - ! endif - ! hard-wire for now + if (ESMF_AlarmIsRinging(AlarmHist, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + alarmIsOn = .true. + call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + alarmIsOn = .false. + endif + + ! TODO: remove this hard-wiring alarmisOn = .true. - case_name = 'test_lilac' !--------------------------------------- ! --- History File @@ -220,7 +241,7 @@ subroutine lilac_history_write(atm2cpl_state, cpl2atm_state, & !--------------------------------------- if (alarmIsOn) then - write(hist_file,"(6a)") trim(case_name), '.lilac.hi.',trim(nexttimestr),'.nc' + write(hist_file,"(3a)") trim(histfile_prefix),trim(nexttimestr),'.nc' call ESMF_LogWrite(trim(subname)//": write "//trim(hist_file), ESMF_LOGMSG_INFO, rc=rc) call lilac_io_wopen(hist_file, vm, iam, clobber=.true.) @@ -250,64 +271,73 @@ subroutine lilac_history_write(atm2cpl_state, cpl2atm_state, & if (ChkErr(rc,__LINE__,u_FILE_u)) return endif - nx_atm = ldomain%ni - ny_atm = ldomain%nj - nx_lnd = ldomain%ni - ny_lnd = ldomain%nj - nx_rof = 720 !TODO: remove this hard-wiring - ny_rof = 360 !TODO: remove this hard-wiring + ! obtain global sizes for lnd_nx and lnd_ny + call ESMF_AttributeGet(lnd2cpl_state, name="lnd_nx", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) lnd_nx + call ESMF_LogWrite(subname//"got attribute lnd_nx "//trim(cvalue), ESMF_LOGMSG_INFO) + call ESMF_AttributeGet(lnd2cpl_state, name="lnd_ny", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) lnd_ny + call ESMF_LogWrite(subname//"got attribute lnd_nx "//trim(cvalue), ESMF_LOGMSG_INFO) call ESMF_StateGet(atm2cpl_state, 'a2c_fb', a2c_fb) ! from atm if (ChkErr(rc,__LINE__,u_FILE_u)) return call lilac_io_write(hist_file, iam, a2c_fb, & - nx=nx_atm, ny=ny_atm, nt=1, whead=whead, wdata=wdata, pre='atm_to_cpl', rc=rc) + nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, pre='atm_to_cpl', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_StateGet(cpl2atm_state, 'c2a_fb', c2a_fb) ! to atm if (ChkErr(rc,__LINE__,u_FILE_u)) return call lilac_io_write(hist_file, iam, c2a_fb, & - nx=nx_atm, ny=ny_atm, nt=1, whead=whead, wdata=wdata, pre='cpl_to_atm', rc=rc) + nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_atm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_atm', l2c_fb_atm) ! from lnd if (ChkErr(rc,__LINE__,u_FILE_u)) return call lilac_io_write(hist_file, iam, l2c_fb_atm, & - nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_atm', rc=rc) + nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_atm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_rof', l2c_fb_rof) ! from lnd if (ChkErr(rc,__LINE__,u_FILE_u)) return call lilac_io_write(hist_file, iam, l2c_fb_rof, & - nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_rof', rc=rc) + nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_atm', c2l_fb_atm) ! to lnd if (ChkErr(rc,__LINE__,u_FILE_u)) return call lilac_io_write(hist_file, iam, c2l_fb_atm, & - nx=nx_lnd, ny=ny_lnd, nt=1, whead=whead, wdata=wdata, pre='cpl_to_lnd_atm', rc=rc) + nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_lnd_atm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (present(rof2cpl_state)) then - call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_rof', c2l_fb_rof) ! to lnd + if (present(rof2cpl_state) .and. present(cpl2rof_state)) then + ! obtain global sizes for rof_nx and rof_ny + call ESMF_AttributeGet(rof2cpl_state, name="rof_nx", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) rof_nx + call ESMF_LogWrite(subname//"got attribute rof_nx "//trim(cvalue), ESMF_LOGMSG_INFO) + call ESMF_AttributeGet(rof2cpl_state, name="rof_ny", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) rof_ny + call ESMF_LogWrite(subname//"got attribute rof_nx "//trim(cvalue), ESMF_LOGMSG_INFO) + + call ESMF_StateGet(rof2cpl_state, 'r2c_fb', r2c_fb) ! from rof if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, c2l_fb_rof, & - nx=nx_lnd, ny=ny_lnd, nt=1, whead=.true., wdata=wdata, pre='cpl_to_lnd_rof', rc=rc) + call lilac_io_write(hist_file, iam, r2c_fb, & + nx=rof_nx, ny=rof_ny, nt=1, whead=whead, wdata=wdata, pre='rof_to_cpl', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (present(cpl2rof_state)) then call ESMF_StateGet(cpl2rof_state, 'c2r_fb', c2r_fb) ! to rof if (ChkErr(rc,__LINE__,u_FILE_u)) return call lilac_io_write(hist_file, iam, c2r_fb, & - nx=nx_rof, ny=ny_rof, nt=1, whead=whead, wdata=wdata, pre='cpl_to_rof', rc=rc) + nx=rof_nx, ny=rof_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (present(rof2cpl_state)) then - call ESMF_StateGet(rof2cpl_state, 'r2c_fb', r2c_fb) ! from rof + call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_rof', c2l_fb_rof) ! to rof if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, r2c_fb, & - nx=nx_rof, ny=ny_rof, nt=1, whead=whead, wdata=wdata, pre='rof_to_cpl', rc=rc) + call lilac_io_write(hist_file, iam, c2l_fb_rof, & + nx=lnd_nx, ny=lnd_ny, nt=1, whead=.true., wdata=wdata, pre='cpl_to_lnd_rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 0d0ce9cc21..8fc5560904 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -18,6 +18,7 @@ module lilac_mod use lilac_io , only : lilac_io_init use lilac_atmaero , only : lilac_atmaero_init, lilac_atmaero_interp use lilac_atmcap , only : lilac_atmcap_init_vars + use lilac_history , only : lilac_history_init use lilac_history , only : lilac_history_write use lilac_methods , only : chkerr @@ -420,19 +421,27 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & print *, trim(subname) // "finished lilac initialization" end if + !------------------------------------------------------------------------- + ! Initialize atmaero stream data (using share strearm capability from CIME) + !------------------------------------------------------------------------- + + call lilac_atmaero_init(atm2cpl_state, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing lilac_atmaero_init") + !------------------------------------------------------------------------- ! Initialize lilac_io_mod module data !------------------------------------------------------------------------- call lilac_io_init() - call ESMF_LogWrite(subname//"initialized lilac_io ...", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"initialized lilac io ...", ESMF_LOGMSG_INFO) !------------------------------------------------------------------------- - ! Initialize atmaero stream data (using share strearm capability from CIME) + ! Initialize lilac history output !------------------------------------------------------------------------- - call lilac_atmaero_init(atm2cpl_state, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing lilac_atmaero_init") + call lilac_history_init(lilac_clock, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing lilac_history_init") + call ESMF_LogWrite(subname//"initialized lilac history output ...", ESMF_LOGMSG_INFO) end subroutine lilac_init diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 61fb8adc12..958b67d8d4 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -34,7 +34,7 @@ module lnd_comp_esmf use clm_time_manager , only : set_timemgr_init, advance_timestep use clm_time_manager , only : set_nextsw_cday, update_rad_dtime use clm_time_manager , only : get_nstep, get_step_size - use clm_time_manager , only : get_curr_date, get_curr_calday, set_nextsw_cday + use clm_time_manager , only : get_curr_date, get_curr_calday use clm_initializeMod , only : initialize1, initialize2 use clm_driver , only : clm_drv use lnd_import_export , only : import_fields, export_fields @@ -117,14 +117,15 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) integer :: lbnum ! input to memory diagnostic integer :: shrlogunit ! old values for log unit and log level type(bounds_type) :: bounds ! bounds + character(len=CL) :: cvalue - ! generation of field bundles + ! generation of field bundles type(ESMF_State) :: importState, exportState type(ESMF_FieldBundle) :: c2l_fb_atm, c2l_fb_rof ! field bundles in import state type(ESMF_FieldBundle) :: l2c_fb_atm, l2c_fb_rof ! field bundles in export state type(ESMF_Field) :: lfield - ! mesh generation + ! mesh generation type(ESMF_Mesh) :: lnd_mesh character(ESMF_MAXSTR) :: lnd_mesh_filename ! full filepath of land mesh file integer :: nlnd, nocn ! local size ofarrays @@ -134,7 +135,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) type(ESMF_DistGrid) :: distgrid integer :: fileunit - ! clock info + ! clock info character(len=CL) :: calendar ! calendar type name type(ESMF_CalKind_Flag) :: caltype ! calendar type from lilac clock integer :: curr_tod, curr_ymd ! current time info @@ -152,7 +153,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) type(ESMF_Time) :: refTime ! Ref time type(ESMF_TimeInterval) :: timeStep ! time step from lilac clock - ! orbital info + ! orbital info integer :: orb_iyear_align ! associated with model year integer :: orb_cyear ! orbital year for current orbital computation integer :: orb_iyear ! orbital year for current orbital computation @@ -222,15 +223,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !orb_cyear = orb_iyear + (year - orb_iyear_align) orb_cyear = 2000 - call shr_orb_params(orb_cyear, eccen, obliqr, mvelpp, & - obliqr, lambm0, mvelpp, masterproc) - - ! for now hard-coding: - !nextsw_cday = 1.02083333333333 - !eccen = 1.670366039276560E-002 - !mvelpp = 4.93745779048816 - !lambm0 = -3.247249566152933E-0020 - !obliqr = 0.409101122579779 + call shr_orb_params(orb_cyear, eccen, obliqr, mvelpp, obliqr, lambm0, mvelpp, masterproc) if (masterproc) then write(iulog,*) 'shr_obs_params is setting the following:' @@ -445,7 +438,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- - ! Create export state + ! Create ctsm export state !-------------------------------- ! create an empty field bundle for atm export fields @@ -485,47 +478,47 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- - ! Fill in land export state + ! Fill in ctsm export state !-------------------------------- - call ESMF_LogWrite(subname//"Creating land export state", ESMF_LOGMSG_INFO) + call export_fields(export_state, bounds, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - ! Fill in export state at end of initialization - call export_fields(comp, bounds, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(cvalue,*) ldomain%ni + call ESMF_AttributeSet(export_state, name="lnd_nx", value=trim(cvalue), rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"set attribute lnd_nx to "//trim(cvalue), ESMF_LOGMSG_INFO) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(cvalue,*) ldomain%nj + call ESMF_AttributeSet(export_state, name="lnd_ny", value=trim(cvalue), rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"set attribute lnd_ny to "//trim(cvalue), ESMF_LOGMSG_INFO) - call ESMF_LogWrite(subname//"Getting Calendar Day of nextsw calculation...", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Created land export state", ESMF_LOGMSG_INFO) + !-------------------------------- ! Get calendar day of next sw (shortwave) calculation (nextsw_cday) + !-------------------------------- + if (nsrest == nsrStartup) then call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + ! TODO: get this from the import state nextsw_cday attribute end if ! Set nextsw_cday - call set_nextsw_cday( nextsw_cday ) + call set_nextsw_cday(nextsw_cday_in=nextsw_cday) + write(cvalue,*) nextsw_cday + call ESMF_LogWrite(subname//"Calendar Day of nextsw calculation is "//trim(cvalue), ESMF_LOGMSG_INFO) if (masterproc) then write(iulog,*) 'TimeGet ... nextsw_cday is : ', nextsw_cday end if - ! Set Attributes - call ESMF_LogWrite(subname//"setting attribute!", ESMF_LOGMSG_INFO) - - ! call ESMF_AttributeSet(export_state, name="lnd_nx", value=ldomain%ni, rc=rc) - ! if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - ! call ESMF_LogWrite(subname//"setting attribute lnd_nx", ESMF_LOGMSG_INFO) - - ! call ESMF_AttributeSet(export_state, name="lnd_ny", value=ldomain%nj, rc=rc) - ! if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - ! call ESMF_LogWrite(subname//"setting attribute lnd_ny!", ESMF_LOGMSG_INFO) - !-------------------------------- ! diagnostics !-------------------------------- @@ -667,7 +660,7 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) !-------------------------------- call t_startf ('lc_lnd_import') - call import_fields(gcomp, bounds, rc) + call import_fields(import_state, bounds, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf ('lc_lnd_import') @@ -813,7 +806,7 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) !-------------------------------- call t_startf ('lc_lnd_export') - call export_fields(gcomp, bounds, rc) + call export_fields(export_state, bounds, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf ('lc_lnd_export') diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index ac39ae1fc0..9768b6dc25 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -50,19 +50,18 @@ module lnd_import_export contains !=============================================================================== - subroutine import_fields( gcomp, bounds, rc) + subroutine import_fields( importState, bounds, rc) !--------------------------------------------------------------------------- ! Convert the input data from the lilac to the land model !--------------------------------------------------------------------------- ! input/output variabes - type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState type(bounds_type) , intent(in) :: bounds ! bounds integer , intent(out) :: rc ! local variables - type(ESMF_State) :: importState integer :: num integer :: begg, endg ! bounds integer :: g,i,k ! indices @@ -106,10 +105,6 @@ subroutine import_fields( gcomp, bounds, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - ! Get import state - call ESMF_GridCompGet(gcomp, importState=importState, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Set bounds begg = bounds%begg; endg=bounds%endg @@ -341,19 +336,18 @@ end subroutine import_fields !============================================================================== - subroutine export_fields(gcomp, bounds, rc) + subroutine export_fields(exportState, bounds, rc) !------------------------------- ! Pack the export state !------------------------------- ! input/output variables - type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: exportState type(bounds_type) , intent(in) :: bounds ! bounds integer , intent(out) :: rc ! local variables - type(ESMF_State) :: exportState integer :: i, g, num real(r8) :: array(bounds%begg:bounds%endg) character(len=*), parameter :: subname='(lnd_import_export:export_fields)' @@ -361,10 +355,6 @@ subroutine export_fields(gcomp, bounds, rc) rc = ESMF_SUCCESS - ! Get export state (ESMF) - call ESMF_GridCompGet(gcomp, exportState=exportState, rc=rc) ! do we need the clock now? - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ----------------------- ! output to atm ! ----------------------- From a5f20ecdf6ed3a81fe5e8bfdb030960988b152ce Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 7 Dec 2019 15:52:08 -0700 Subject: [PATCH 226/556] put in consistency check to verify that lats/lons read in from mesh are same as lats/lons obtained from host atm --- lilac/src/lilac_atmaero.F90 | 11 +-- lilac/src/lilac_atmcap.F90 | 112 ++++++++++++++++------ lilac/src/lilac_history.F90 | 2 +- lilac/src/lilac_io.F90 | 158 +++++++++++++++----------------- src/cpl/lilac/lnd_comp_esmf.F90 | 15 +-- 5 files changed, 169 insertions(+), 129 deletions(-) diff --git a/lilac/src/lilac_atmaero.F90 b/lilac/src/lilac_atmaero.F90 index a09d2955a0..6472d0a01e 100644 --- a/lilac/src/lilac_atmaero.F90 +++ b/lilac/src/lilac_atmaero.F90 @@ -90,14 +90,12 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) integer , pointer :: idata(:) !----------------------------------------------------------------------- - rc = ESMF_SUCCESS - - namelist /atmaero_stream/ & - stream_year_first, & - stream_year_last, & - model_year_align, & + namelist /atmaero_stream/ & + stream_year_first, stream_year_last, model_year_align, & stream_fldfilename + rc = ESMF_SUCCESS + ! default values for namelist stream_year_first = 1 ! first year in stream to use stream_year_last = 1 ! last year in stream to use @@ -124,7 +122,6 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) end if close(nunit) endif - call shr_mpi_bcast(stream_year_first , mpicom) call shr_mpi_bcast(stream_year_last , mpicom) call shr_mpi_bcast(model_year_align , mpicom) diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index 635f3b29dd..1b915911aa 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -28,13 +28,16 @@ module lilac_atmcap private :: lilac_atmcap_add_fld - ! Input from host atmosphere + ! Time invariant input from host atmosphere integer, public, allocatable :: gindex_atm(:) ! global index space integer, public, allocatable :: atm_lons(:) ! local longitudes integer, public, allocatable :: atm_lats(:) ! local latitudes integer, public :: atm_global_nx integer, public :: atm_global_ny + ! Time variant input from host atmosphere + real(r8) :: nextsw_cday = 1.e36_r8 ! calendar day of the next sw calculation + type :: atmcap_type character(len=CL) :: fldname real(r8), pointer :: dataptr(:) @@ -168,7 +171,7 @@ subroutine lilac_atmcap_register (comp, rc) ! local variables type(ESMF_VM) :: vm - character(len=*), parameter :: subname='(lilac_atmos_register): ' + character(len=*), parameter :: subname='(lilac_atmcap_register): ' !------------------------------------------------------------------------- call ESMF_VMGetGlobal(vm=vm, rc=rc) @@ -197,26 +200,34 @@ end subroutine lilac_atmcap_register !======================================================================== - subroutine lilac_atmcap_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) + subroutine lilac_atmcap_init (comp, lnd2atm_state, atm2lnd_state, clock, rc) ! input/output variables type (ESMF_GridComp) :: comp - type (ESMF_State) :: lnd2atm_a_state, atm2lnd_a_state + type (ESMF_State) :: lnd2atm_state + type (ESMF_State) :: atm2lnd_state type (ESMF_Clock) :: clock integer, intent(out) :: rc ! local variables - integer :: fileunit - type(ESMF_Mesh) :: atm_mesh - type(ESMF_DistGrid) :: atm_distgrid - type(ESMF_Field) :: field - type(ESMF_FieldBundle) :: c2a_fb , a2c_fb - integer :: n, i, ierr - character(len=cl) :: atm_mesh_filename + integer :: fileunit + type(ESMF_Mesh) :: atm_mesh + type(ESMF_DistGrid) :: atm_distgrid + type(ESMF_Field) :: field + type(ESMF_FieldBundle) :: c2a_fb , a2c_fb + integer :: n, i, ierr + integer :: lsize + character(len=cl) :: atm_mesh_filename + character(len=cl) :: cvalue + integer :: spatialDim + integer :: numOwnedElements + real(r8), pointer :: ownedElemCoords(:) + real(r8) :: mesh_lon, mesh_lat + real(r8) :: tolerance = 1.e-5_r8 character(len=*), parameter :: subname='(lilac_atmcap_init): ' + !------------------------------------------------------------------------- namelist /lilac_atmcap_input/ atm_mesh_filename - !------------------------------------------------------------------------- ! Initialize return code rc = ESMF_SUCCESS @@ -258,7 +269,42 @@ subroutine lilac_atmcap_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) end if !------------------------------------------------------------------------- - ! Create a2c_fb field bundle and add to atm2lnd_a_state + ! Check that lons and lats from the host atmospere match those read + ! in from the atm mesh file + !------------------------------------------------------------------------- + + call ESMF_MeshGet(atm_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + lsize = size(gindex_atm) + if (numOwnedElements /= lsize) then + print *, 'numOwnedElements in atm_mesh = ',numOwnedElements + print *, 'local size from gindex_atm from host atm = ',lsize + call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') + end if + + allocate(ownedElemCoords(spatialDim*numOwnedElements)) + call ESMF_MeshGet(atm_mesh, ownedElemCoords=ownedElemCoords, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1, lsize + mesh_lon = ownedElemCoords(2*n-1) + mesh_lat = ownedElemCoords(2*n) + if ( abs(mesh_lon - atm_lons(n)) > tolerance) then + write(6,101),n, atm_lons(n), mesh_lon +101 format('ERROR: lilac_atmcap: n, lon, mesh_lon = ',i6,2(f20.10,2x)) + call shr_sys_abort() + end if + if ( abs(mesh_lat - atm_lats(n)) > tolerance) then + write(6,102),n, atm_lats(n), mesh_lat +102 format('ERROR: lilac_atmcap: n, lat, mesh_lat = ',i6,2(f20.10,2x)) + call shr_sys_abort() + end if + end do + deallocate(ownedElemCoords) + + !------------------------------------------------------------------------- + ! Create a2c_fb field bundle and add to atm2lnd_state !------------------------------------------------------------------------- ! create empty field bundle "a2c_fb" @@ -280,17 +326,21 @@ subroutine lilac_atmcap_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) end if end do - ! add field bundle to atm2lnd_a_state - call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) + ! add field bundle to atm2lnd_state + call ESMF_StateAdd(atm2lnd_state, (/a2c_fb/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//"lilac a2c_fb fieldbundle created and added to atm2lnd_a_state", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"lilac a2c_fb fieldbundle created and added to atm2lnd_state", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "lilac a2c_fb fieldbundle created and added to atm2lnd_a_state" + print *, "lilac a2c_fb fieldbundle created and added to atm2lnd_state" end if + ! add nextsw_cday attributes + write(cvalue,*) nextsw_cday + call ESMF_AttributeSet(atm2lnd_state, name="nextsw_cday", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------------------------------------------------------------- - ! Create c2a_fb field bundle and add to lnd2atm_a_state - ! Also add nextsw_cday attributes + ! Create c2a_fb field bundle and add to lnd2atm_state !------------------------------------------------------------------------- ! create empty field bundle "c2a_fb" @@ -312,13 +362,10 @@ subroutine lilac_atmcap_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) end if end do - ! add field bundle to lnd2atm_a_state - call ESMF_StateAdd(lnd2atm_a_state, (/c2a_fb/), rc=rc) + ! add field bundle to lnd2atm_state + call ESMF_StateAdd(lnd2atm_state, (/c2a_fb/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//"lilac c2a_fb fieldbundle is done and added to lnd2atm_a_state", ESMF_LOGMSG_INFO) - - ! Set Attributes needed by land - call ESMF_AttributeSet(lnd2atm_a_state, name="nextsw_cday", value=11, rc=rc) ! TODO: mv what in the world is this??? + call ESMF_LogWrite(subname//"lilac c2a_fb fieldbundle is done and added to lnd2atm_state", ESMF_LOGMSG_INFO) end subroutine lilac_atmcap_init @@ -348,7 +395,7 @@ subroutine lilac_atmcap_final(comp, importState, exportState, clock, rc) ! local variables type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle - character(len=*), parameter :: subname='( lilac_atmos_final): ' + character(len=*), parameter :: subname='( lilac_atmcap_final): ' !------------------------------------------------------------------------- ! Initialize return code @@ -377,6 +424,7 @@ subroutine lilac_atmcap_atm2lnd(fldname, data) ! local variables integer :: n logical :: found + character(len=*), parameter :: subname='(lilac_atmcap_atm2lnd)' ! -------------------------------------------- found = .false. @@ -384,7 +432,7 @@ subroutine lilac_atmcap_atm2lnd(fldname, data) if (trim(fldname) == atm2lnd(n)%fldname) then found = .true. if (size(data) /= size(atm2lnd(n)%dataptr)) then - ! call abort - TODO: what is the abort call in lilac + call shr_sys_abort(trim(subname) // 'size(data) not equal to size(atm2lnd(n)%dataptr') else atm2lnd(n)%dataptr(:) = data(:) end if @@ -393,7 +441,7 @@ subroutine lilac_atmcap_atm2lnd(fldname, data) end if end do if (.not. found) then - ! abort + call shr_sys_abort(trim(subname) // 'atm2lnd field name ' // trim(fldname) //' not found') end if contains @@ -414,14 +462,20 @@ end subroutine lilac_atmcap_atm2lnd !======================================================================== subroutine lilac_atmcap_lnd2atm(fldname, data) + + ! input/output variables character(len=*) , intent(in) :: fldname real(r8) , intent(out) :: data(:) + + ! local variables integer :: n + character(len=*), parameter :: subname='(lilac_atmcap_lnd2atm)' + ! -------------------------------------------- do n = 1,size(lnd2atm) if (trim(fldname) == lnd2atm(n)%fldname) then if (size(data) /= size(lnd2atm(n)%dataptr)) then - ! call abort - TODO: what is the abort call in lilac + call shr_sys_abort(trim(subname) // 'size(data) not equal to size(lnd2atm(n)%dataptr') else data(:) = lnd2atm(n)%dataptr(:) end if diff --git a/lilac/src/lilac_history.F90 b/lilac/src/lilac_history.F90 index 5643737a26..8bb0654707 100644 --- a/lilac/src/lilac_history.F90 +++ b/lilac/src/lilac_history.F90 @@ -65,10 +65,10 @@ subroutine lilac_history_init(clock, rc) character(CS) :: lilac_histfreq_option integer :: lilac_histfreq_n character(len=*), parameter :: subname='(lilac_history_init)' + !--------------------------------------- namelist /lilac_run_input/ caseid, starttype namelist /lilac_io_input/ lilac_histfreq_n, lilac_histfreq_option - !--------------------------------------- if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) diff --git a/lilac/src/lilac_io.F90 b/lilac/src/lilac_io.F90 index c118d881ca..431d785e06 100644 --- a/lilac/src/lilac_io.F90 +++ b/lilac/src/lilac_io.F90 @@ -9,6 +9,7 @@ module lilac_io use shr_kind_mod , only : r4=>shr_kind_r4, i8=>shr_kind_i8, r8=>shr_kind_r8 use shr_const_mod , only : fillvalue => SHR_CONST_SPVAL use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat + use shr_sys_mod , only : shr_sys_abort use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag use lilac_methods , only : FB_getFieldN => lilac_methods_FB_getFieldN use lilac_methods , only : FB_getFldPtr => lilac_methods_FB_getFldPtr @@ -523,9 +524,6 @@ subroutine lilac_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & ! 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 - ng = maxval(maxIndexPTile) lnx = ng lny = 1 @@ -544,10 +542,8 @@ subroutine lilac_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & if (lnx*lny /= ng) then write(tmpstr,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny 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 + call shr_sys_abort() + !This should not be an error for say CTSM which does not send a global grid endif if (lwhead) then @@ -575,56 +571,53 @@ subroutine lilac_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & call ESMF_FieldGet(lfield, rank=rank, rc=rc) if (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 - if (rank == 2) then - call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) - if (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 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 - if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) - if (present(tavg)) then - if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") - endif - endif + if (rank == 2) then + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + if (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 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 - end do - else - name1 = trim(lpre)//'_'//trim(itemc) - 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 - if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(cunit)) - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) - if (present(tavg)) then - if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + if (chkerr(rc,__LINE__,u_FILE_u)) return + rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + 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 + name1 = trim(lpre)//'_'//trim(itemc) + 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return + rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + 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 end do @@ -679,37 +672,34 @@ subroutine lilac_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) if (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 - 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 (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (rank == 2) then - ! 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) + ! 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 (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - 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) + ! 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) - 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" + 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 do ! end loop over fields in FB ! Fill coordinate variables @@ -1404,15 +1394,13 @@ subroutine lilac_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - !write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + ! 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 + !This should not be an error for CTSM which does not send a global grid endif call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 958b67d8d4..369c3c8260 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -707,13 +707,14 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) if (masterproc) then write(iulog,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' - write(iulog,F02) 'calday is : ', calday - write(iulog,F02) 'eccen is : ', eccen - write(iulog,F02) 'mvelpp is : ', mvelpp - write(iulog,F02) 'lambm0 is : ', lambm0 - write(iulog,F02) 'obliqr is : ', obliqr - write(iulog,F02) 'declin is : ', declin - write(iulog,F02) 'declinp1 is : ', declinp1 + write(iulog,F02) 'nextsw_cday is : ', nextsw_cday + write(iulog,F02) 'calday is : ', calday + write(iulog,F02) 'eccen is : ', eccen + write(iulog,F02) 'mvelpp is : ', mvelpp + write(iulog,F02) 'lambm0 is : ', lambm0 + write(iulog,F02) 'obliqr is : ', obliqr + write(iulog,F02) 'declin is : ', declin + write(iulog,F02) 'declinp1 is : ', declinp1 write(iulog,* ) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' end if From 900de73e80412262491214186b93bc34b67c409d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 8 Dec 2019 12:09:18 -0700 Subject: [PATCH 227/556] changes to clean up lilac alarms and start getting in lilac restart capability --- lilac/atm_driver/lilac_in | 2 +- lilac/src/lilac_history.F90 | 310 ++++++--------- lilac/src/lilac_mod.F90 | 189 +++++---- lilac/src/lilac_time.F90 | 775 +++++++++++++++++------------------- 4 files changed, 597 insertions(+), 679 deletions(-) diff --git a/lilac/atm_driver/lilac_in b/lilac/atm_driver/lilac_in index 852cd48637..25c69a8abd 100644 --- a/lilac/atm_driver/lilac_in +++ b/lilac/atm_driver/lilac_in @@ -3,8 +3,8 @@ caseid = 'test_lilac' / &lilac_io_input - lilac_histfreq_n = 4 lilac_histfreq_option = 'nsteps' + lilac_histfreq_n = 4 / &lilac_atmcap_input atm_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' diff --git a/lilac/src/lilac_history.F90 b/lilac/src/lilac_history.F90 index 8bb0654707..58da52d614 100644 --- a/lilac/src/lilac_history.F90 +++ b/lilac/src/lilac_history.F90 @@ -7,19 +7,14 @@ module lilac_history use ESMF use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl, r8=>shr_kind_r8 use shr_sys_mod , only : shr_sys_abort + use lilac_time , only : lilac_time_alarmInit use lilac_atmcap , only : atm_nx => atm_global_nx use lilac_atmcap , only : atm_ny => atm_global_ny - use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag use lilac_constants , only : SecPerDay => lilac_constants_SecPerDay - use lilac_time , only : alarmInit => lilac_time_alarmInit - use lilac_methods , only : FB_reset => lilac_methods_FB_reset - use lilac_methods , only : FB_diagnose => lilac_methods_FB_diagnose - use lilac_methods , only : FB_GetFldPtr => lilac_methods_FB_GetFldPtr - use lilac_methods , only : FB_accum => lilac_methods_FB_accum - use lilac_methods , only : chkerr use lilac_io , only : lilac_io_write, lilac_io_wopen, lilac_io_enddef use lilac_io , only : lilac_io_close, lilac_io_date2yyyymmdd, lilac_io_sec2hms use lilac_io , only : lilac_io_ymd2date + use lilac_methods , only : chkerr implicit none private @@ -28,8 +23,6 @@ module lilac_history public :: lilac_history_write character(CL) :: histfile_prefix - type(ESMF_Alarm) :: AlarmHist - type(ESMF_Alarm) :: AlarmHistAvg character(*), parameter :: u_FILE_u = & __FILE__ @@ -37,53 +30,36 @@ module lilac_history contains !=============================================================================== - subroutine lilac_history_init(clock, rc) + subroutine lilac_history_init(clock, caseid, rc) ! ------------------------------------------ ! Initialize lilac history file alarm ! ------------------------------------------ ! input/output variables - type(ESMF_Clock) :: clock ! lilac clock - integer , intent(out) :: rc + type(ESMF_Clock) :: clock ! lilac clock + character(CL), intent(in) :: caseid + integer , intent(out) :: rc ! local variables + type(ESMF_Alarm) :: alarmhist type(ESMF_Time) :: currtime - type(ESMF_Time) :: reftime - type(ESMF_Time) :: starttime - type(ESMF_Time) :: nexttime - type(ESMF_Calendar) :: calendar ! calendar type character(len=64) :: currtimestr integer :: yr,mon,day,sec ! time units character(CL) :: freq_option ! freq_option setting (ndays, nsteps, etc) integer :: freq_n ! freq_n setting relative to freq_option - integer :: iam integer :: fileunit integer :: ierr - character(CL) :: caseid - character(CS) :: starttype + character(CS) :: cvalue character(CS) :: lilac_histfreq_option integer :: lilac_histfreq_n character(len=*), parameter :: subname='(lilac_history_init)' !--------------------------------------- - namelist /lilac_run_input/ caseid, starttype namelist /lilac_io_input/ lilac_histfreq_n, lilac_histfreq_option - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - endif rc = ESMF_SUCCESS - ! read in caseid - open(newunit=fileunit, status="old", file="lilac_in") - read(fileunit, lilac_run_input, iostat=ierr) - if (ierr > 0) then - call shr_sys_abort(trim(subname) // 'error reading in lilac_run_input') - end if - close(fileunit) - write(histfile_prefix,"(2a)") trim(caseid),'.lilac.hi.' - ! read in history file output frequencies open(newunit=fileunit, status="old", file="lilac_in") read(fileunit, lilac_io_input, iostat=ierr) @@ -92,26 +68,33 @@ subroutine lilac_history_init(clock, rc) end if close(fileunit) + write(histfile_prefix,"(2a)") trim(caseid),'.lilac.hi.' + write(6,*)'DEBUG: histfile_prefix = ',histfile_prefix + !--------------------------------------- ! Get the clock info !--------------------------------------- - call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, calendar=calendar, rc=rc) + call ESMF_ClockGet(clock, currtime=currtime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=rc) - endif + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=rc) !--------------------------------------- - ! Initialize thie history alarm + ! Initialize the history alarm !--------------------------------------- - call alarmInit(clock, AlarmHist, option=lilac_histfreq_option, opt_n=lilac_histfreq_n, & - RefTime=RefTime, alarmname='lilac_history_alarm', rc=rc) + call ESMF_LogWrite(trim(subname)//"Initializing lilac history alarm ", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//"Initializing lilac history frequency option "//trim(lilac_histfreq_option), & + ESMF_LOGMSG_INFO, rc=rc) + write(cvalue,*)lilac_histfreq_n + call ESMF_LogWrite(trim(subname)//"Initializing lilac history frequency "//trim(cvalue), & + ESMF_LOGMSG_INFO, rc=rc) + + call lilac_time_alarminit(clock, alarmhist, 'lilac_history_alarm', lilac_histfreq_option, lilac_histfreq_n, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine lilac_history_init @@ -141,13 +124,12 @@ subroutine lilac_history_write(atm2cpl_state, cpl2atm_state, & type(ESMF_FieldBundle) :: c2r_fb, r2c_fb type(ESMF_VM) :: vm type(ESMF_Time) :: currtime - type(ESMF_Time) :: reftime + character(len=CS) :: currtimestr type(ESMF_Time) :: starttime type(ESMF_Time) :: nexttime + character(len=CS) :: nexttimestr type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time type(ESMF_Calendar) :: calendar ! calendar type - character(len=CS) :: currtimestr - character(len=CS) :: nexttimestr integer :: i,j,m,n integer :: start_ymd ! Starting date YYYYMMDD integer :: start_tod ! Starting time-of-day (s) @@ -159,20 +141,15 @@ subroutine lilac_history_write(atm2cpl_state, cpl2atm_state, & character(CL) :: hist_file ! Local path to history filename character(CL) :: freq_option ! freq_option setting (ndays, nsteps, etc) integer :: freq_n ! freq_n setting relative to freq_option - logical :: alarmIsOn ! generic alarm flag real(r8) :: tbnds(2) ! CF1.0 time bounds logical :: whead,wdata ! for writing restart/history cdf files character(CL) :: cvalue integer :: lnd_nx, lnd_ny integer :: rof_nx, rof_ny integer :: iam - logical,save :: first_call = .true. character(len=*), parameter :: subname='(lilac_history_write)' !--------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - endif rc = ESMF_SUCCESS !--------------------------------------- @@ -189,7 +166,7 @@ subroutine lilac_history_write(atm2cpl_state, cpl2atm_state, & ! --- Get the clock info !--------------------------------------- - call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, calendar=calendar, rc=rc) + call ESMF_ClockGet(clock, currtime=currtime, starttime=starttime, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) @@ -198,166 +175,133 @@ subroutine lilac_history_write(atm2cpl_state, cpl2atm_state, & call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=rc) - endif + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=rc) call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=rc) - endif - timediff = nexttime - reftime + call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=rc) + timediff = nexttime - starttime call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) dayssince = day + sec/real(SecPerDay,R8) - call ESMF_TimeGet(reftime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) call lilac_io_ymd2date(yr,mon,day,start_ymd) start_tod = sec time_units = 'days since ' // trim(lilac_io_date2yyyymmdd(start_ymd)) // ' ' // lilac_io_sec2hms(start_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- - ! --- History Alarms - !--------------------------------------- - - if (ESMF_AlarmIsRinging(AlarmHist, rc=rc)) then - if (ChkErr(rc,__LINE__,u_FILE_u)) return - alarmIsOn = .true. - call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - alarmIsOn = .false. - endif - - ! TODO: remove this hard-wiring - alarmisOn = .true. - - !--------------------------------------- - ! --- History File + ! Write lilac history file ! Use nexttimestr rather than currtimestr here since that is the time at the end of ! the timestep and is preferred for history file names !--------------------------------------- - if (alarmIsOn) then - write(hist_file,"(3a)") trim(histfile_prefix),trim(nexttimestr),'.nc' - call ESMF_LogWrite(trim(subname)//": write "//trim(hist_file), ESMF_LOGMSG_INFO, rc=rc) - - call lilac_io_wopen(hist_file, vm, iam, clobber=.true.) - - do m = 1,2 - whead=.false. - wdata=.false. - if (m == 1) then - whead=.true. - elseif (m == 2) then - wdata=.true. - call lilac_io_enddef(hist_file) - endif - - tbnds = dayssince - - call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO, rc=rc) - if (tbnds(1) >= tbnds(2)) then - call lilac_io_write(hist_file, iam, & - time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call lilac_io_write(hist_file, iam, & - time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - - ! obtain global sizes for lnd_nx and lnd_ny - call ESMF_AttributeGet(lnd2cpl_state, name="lnd_nx", value=cvalue, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - read(cvalue,*) lnd_nx - call ESMF_LogWrite(subname//"got attribute lnd_nx "//trim(cvalue), ESMF_LOGMSG_INFO) - call ESMF_AttributeGet(lnd2cpl_state, name="lnd_ny", value=cvalue, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - read(cvalue,*) lnd_ny - call ESMF_LogWrite(subname//"got attribute lnd_nx "//trim(cvalue), ESMF_LOGMSG_INFO) - - call ESMF_StateGet(atm2cpl_state, 'a2c_fb', a2c_fb) ! from atm - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, a2c_fb, & - nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, pre='atm_to_cpl', rc=rc) + write(hist_file,"(3a)") trim(histfile_prefix),trim(nexttimestr),'.nc' + call ESMF_LogWrite(trim(subname)//": write "//trim(hist_file), ESMF_LOGMSG_INFO, rc=rc) + + call lilac_io_wopen(hist_file, vm, iam, clobber=.true.) + + do m = 1,2 + whead=.false. + wdata=.false. + if (m == 1) then + whead=.true. + elseif (m == 2) then + wdata=.true. + call lilac_io_enddef(hist_file) + endif + + tbnds = dayssince + + call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO, rc=rc) + if (tbnds(1) >= tbnds(2)) then + call lilac_io_write(hist_file, iam, & + time_units=time_units, calendar=calendar, time_val=dayssince, & + whead=whead, wdata=wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(cpl2atm_state, 'c2a_fb', c2a_fb) ! to atm + else + call lilac_io_write(hist_file, iam, & + time_units=time_units, calendar=calendar, time_val=dayssince, & + whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, c2a_fb, & - nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_atm', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_atm', l2c_fb_atm) ! from lnd + endif + + ! obtain global sizes for lnd_nx and lnd_ny + call ESMF_AttributeGet(lnd2cpl_state, name="lnd_nx", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) lnd_nx + call ESMF_LogWrite(subname//"got attribute lnd_nx "//trim(cvalue), ESMF_LOGMSG_INFO) + call ESMF_AttributeGet(lnd2cpl_state, name="lnd_ny", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) lnd_ny + call ESMF_LogWrite(subname//"got attribute lnd_nx "//trim(cvalue), ESMF_LOGMSG_INFO) + + call ESMF_StateGet(atm2cpl_state, 'a2c_fb', a2c_fb) ! from atm + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, a2c_fb, & + nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, pre='atm_to_cpl', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(cpl2atm_state, 'c2a_fb', c2a_fb) ! to atm + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, c2a_fb, & + nx=atm_nx, ny=atm_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_atm', l2c_fb_atm) ! from lnd + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, l2c_fb_atm, & + nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_rof', l2c_fb_rof) ! from lnd + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, l2c_fb_rof, & + nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_rof', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_atm', c2l_fb_atm) ! to lnd + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_io_write(hist_file, iam, c2l_fb_atm, & + nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_lnd_atm', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present(rof2cpl_state) .and. present(cpl2rof_state)) then + ! obtain global sizes for rof_nx and rof_ny + call ESMF_AttributeGet(rof2cpl_state, name="rof_nx", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) rof_nx + call ESMF_LogWrite(subname//"got attribute rof_nx "//trim(cvalue), ESMF_LOGMSG_INFO) + call ESMF_AttributeGet(rof2cpl_state, name="rof_ny", value=cvalue, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + read(cvalue,*) rof_ny + call ESMF_LogWrite(subname//"got attribute rof_nx "//trim(cvalue), ESMF_LOGMSG_INFO) + + call ESMF_StateGet(rof2cpl_state, 'r2c_fb', r2c_fb) ! from rof if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, l2c_fb_atm, & - nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_atm', rc=rc) + call lilac_io_write(hist_file, iam, r2c_fb, & + nx=rof_nx, ny=rof_ny, nt=1, whead=whead, wdata=wdata, pre='rof_to_cpl', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(lnd2cpl_state, 'l2c_fb_rof', l2c_fb_rof) ! from lnd + + call ESMF_StateGet(cpl2rof_state, 'c2r_fb', c2r_fb) ! to rof if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, l2c_fb_rof, & - nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='lnd_to_cpl_rof', rc=rc) + call lilac_io_write(hist_file, iam, c2r_fb, & + nx=rof_nx, ny=rof_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_atm', c2l_fb_atm) ! to lnd + + call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_rof', c2l_fb_rof) ! to rof if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, c2l_fb_atm, & - nx=lnd_nx, ny=lnd_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_lnd_atm', rc=rc) + call lilac_io_write(hist_file, iam, c2l_fb_rof, & + nx=lnd_nx, ny=lnd_ny, nt=1, whead=.true., wdata=wdata, pre='cpl_to_lnd_rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (present(rof2cpl_state) .and. present(cpl2rof_state)) then - ! obtain global sizes for rof_nx and rof_ny - call ESMF_AttributeGet(rof2cpl_state, name="rof_nx", value=cvalue, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - read(cvalue,*) rof_nx - call ESMF_LogWrite(subname//"got attribute rof_nx "//trim(cvalue), ESMF_LOGMSG_INFO) - call ESMF_AttributeGet(rof2cpl_state, name="rof_ny", value=cvalue, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - read(cvalue,*) rof_ny - call ESMF_LogWrite(subname//"got attribute rof_nx "//trim(cvalue), ESMF_LOGMSG_INFO) - - call ESMF_StateGet(rof2cpl_state, 'r2c_fb', r2c_fb) ! from rof - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, r2c_fb, & - nx=rof_nx, ny=rof_ny, nt=1, whead=whead, wdata=wdata, pre='rof_to_cpl', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(cpl2rof_state, 'c2r_fb', c2r_fb) ! to rof - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, c2r_fb, & - nx=rof_nx, ny=rof_ny, nt=1, whead=whead, wdata=wdata, pre='cpl_to_rof', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(cpl2lnd_state, 'c2l_fb_rof', c2l_fb_rof) ! to rof - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(hist_file, iam, c2l_fb_rof, & - nx=lnd_nx, ny=lnd_ny, nt=1, whead=.true., wdata=wdata, pre='cpl_to_lnd_rof', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - enddo - - call lilac_io_close(hist_file, iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - endif - - !--------------------------------------- - !--- clean up - !--------------------------------------- - - first_call = .false. - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - endif - + end if + + enddo + + call lilac_io_close(hist_file, iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine lilac_history_write end module lilac_history diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 8fc5560904..9e56c25dc8 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -16,6 +16,8 @@ module lilac_mod ! lilac routines use lilac_io , only : lilac_io_init + use lilac_time , only : lilac_time_clockinit, lilac_time_alarminit + use lilac_time , only : lilac_time_restart_write, lilac_time_restart_read use lilac_atmaero , only : lilac_atmaero_init, lilac_atmaero_interp use lilac_atmcap , only : lilac_atmcap_init_vars use lilac_history , only : lilac_history_init @@ -65,11 +67,14 @@ module lilac_mod logical :: couple_to_river = .false. integer :: mytask + character(ESMF_MAXSTR) :: starttype character(*) , parameter :: modname = "lilac_mod" character(*), parameter :: u_FILE_u = & __FILE__ + integer :: logunit = 6 ! TODO: generalize this + !======================================================================== contains !======================================================================== @@ -102,6 +107,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & integer , intent(in) :: atm_stop_secs ! local variables + character(ESMF_MAXSTR) :: caseid type(ESMF_TimeInterval) :: timeStep type(ESMF_Time) :: startTime type(ESMF_Time) :: stopTime @@ -129,6 +135,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & logical :: comp_iamin(1) = (/.true./) ! for pio init2 !------------------------------------------------------------------------ + namelist /lilac_run_input/ caseid, starttype + ! Initialize return code rc = ESMF_SUCCESS @@ -175,6 +183,14 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & call shr_pio_init2(compids, compLabels, comp_iamin, (/mpicom/), (/mytask/)) call ESMF_LogWrite(subname//"initialized shr_pio_init2 ...", ESMF_LOGMSG_INFO) + ! read in caseid + open(newunit=fileunit, status="old", file="lilac_in") + read(fileunit, lilac_run_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(trim(subname) // 'error reading in lilac_run_input') + end if + close(fileunit) + !------------------------------------------------------------------------- ! Initial lilac atmosphere cap module variables !------------------------------------------------------------------------- @@ -189,7 +205,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac atmcap initialization') call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // "lilac atm cap gridded component created" + write(logunit,*) trim(subname) // "lilac atm cap gridded component created" end if cname = " CTSM " @@ -197,7 +213,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac ctsm initialization') call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " ctsm gridded component created" + write(logunit,*) trim(subname) // " ctsm gridded component created" end if cname = " MOSART " @@ -205,7 +221,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac mosart initialization') call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " mosart gridded component created" + write(logunit,*) trim(subname) // " mosart gridded component created" end if cname = "Coupler from atmosphere to land" @@ -213,7 +229,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_a2l initialization') call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " coupler component (atmosphere to land) created" + write(logunit,*) trim(subname) // " coupler component (atmosphere to land) created" end if cname = "Coupler from land to atmosphere" @@ -221,7 +237,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_l2a initialization') call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " coupler component (land to atmosphere) created" + write(logunit,*) trim(subname) // " coupler component (land to atmosphere) created" end if cname = "Coupler from river to land" @@ -229,7 +245,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_r2l initialization') call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " coupler component (atmosphere to land) created" + write(logunit,*) trim(subname) // " coupler component (atmosphere to land) created" end if cname = "Coupler from land to river" @@ -237,7 +253,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_l2r initialization') call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " coupler component (land to atmosphere) created" + write(logunit,*) trim(subname) // " coupler component (land to atmosphere) created" end if !------------------------------------------------------------------------- @@ -249,7 +265,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('atm_gcomp register failure') call ESMF_LogWrite(subname//" atmos SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " lilac atm cap setservices finished" + write(logunit,*) trim(subname) // " lilac atm cap setservices finished" end if ! Register section -- set services -- ctsm @@ -257,7 +273,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('lnd_gcomp register failure') call ESMF_LogWrite(subname//"CSTM SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " CTSM setservices finished" + write(logunit,*) trim(subname) // " CTSM setservices finished" end if ! Register section -- set services -- mosart @@ -265,7 +281,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('rof_gcomp register failure') call ESMF_LogWrite(subname//"MOSART SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " CTSM setservices finished" + write(logunit,*) trim(subname) // " CTSM setservices finished" end if ! Register section -- set services -- coupler atmosphere to land @@ -273,7 +289,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_atm2lnd_comp register failure') call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " coupler from atmosphere to land setservices finished" + write(logunit,*) trim(subname) // " coupler from atmosphere to land setservices finished" end if ! Register section -- set services -- river to land @@ -281,7 +297,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_rof2lnd_comp register failure') call ESMF_LogWrite(subname//"Coupler from river to land SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " coupler from river to land setservices finished" + write(logunit,*) trim(subname) // " coupler from river to land setservices finished" end if ! Register section -- set services -- coupler land to atmosphere @@ -289,7 +305,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2atm_comp register failure') call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " coupler from land to atmosphere setservices finished" + write(logunit,*) trim(subname) // " coupler from land to atmosphere setservices finished" end if ! Register section -- set services -- coupler land to river @@ -297,52 +313,20 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2rof_comp register failure') call ESMF_LogWrite(subname//"Coupler from land to river SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, trim(subname) // " coupler from land to river setservices finished" + write(logunit,*) trim(subname) // " coupler from land to river setservices finished" end if !------------------------------------------------------------------------- - ! Create and initialize the lilac_clock and calendar + ! Create and initialize the lilac_clock, alarms and calendar !------------------------------------------------------------------------- - if (trim(atm_calendar) == 'NOLEAP') then - lilac_calendar = ESMF_CalendarCreate(name='NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - else if (trim(atm_calendar) == 'GREGORIAN') then - lilac_calendar = ESMF_CalendarCreate(name='GREGORIAN', calkindflag=ESMF_CALKIND_GREGORIAN, rc=rc ) - else - ! TODO: add supported calendars here - end if - - call ESMF_TimeIntervalSet(TimeStep, s=atm_timestep, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeSet(StartTime, yy=atm_start_year, mm=atm_start_mon, dd=atm_start_day , s=atm_start_secs, & - calendar=lilac_calendar, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeSet(StopTime , yy=atm_stop_year , mm=atm_stop_mon , dd=atm_stop_day , s=atm_stop_secs , & - calendar=lilac_calendar, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - lilac_clock = ESMF_ClockCreate(name='lilac_clock', TimeStep=TimeStep, startTime=StartTime, & - RefTime=StartTime, stopTime=stopTime, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - print *, trim(subname) // "---------------------------------------" - call ESMF_ClockPrint (lilac_clock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_CalendarPrint (lilac_calendar , rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - print *, trim(subname) // "---------------------------------------" - end if - - ! Add a restart alarm to the clock - lilac_restart_alarm = ESMF_AlarmCreate(lilac_clock, ringTime=StopTime, name='lilac_restart_alarm', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing restart alarm') + call lilac_time_clockInit(caseid, starttype, atm_calendar, atm_timestep, & + atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & + atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, logunit, & + lilac_clock, rc) - ! Add a stop alarm to the clock - lilac_stop_alarm = ESMF_AlarmCreate(lilac_clock, ringTime=StopTime, name='lilac_stop_alarm', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing stop alarm') + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing clock") + call ESMF_LogWrite(subname//"lilac_clock initialized", ESMF_LOGMSG_INFO) ! ------------------------------------------------------------------------- ! Initialize LILAC gridded components @@ -418,7 +402,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & end if if (mytask == 0) then - print *, trim(subname) // "finished lilac initialization" + write(logunit,*) trim(subname) // "finished lilac initialization" end if !------------------------------------------------------------------------- @@ -439,7 +423,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & ! Initialize lilac history output !------------------------------------------------------------------------- - call lilac_history_init(lilac_clock, rc) + call lilac_history_init(lilac_clock, caseid, rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing lilac_history_init") call ESMF_LogWrite(subname//"initialized lilac history output ...", ESMF_LOGMSG_INFO) @@ -454,6 +438,8 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) logical, intent(in) :: stop_alarm_is_ringing ! local variables + type(ESMF_Alarm) :: lilac_history_alarm + type(ESMF_Alarm) :: lilac_restart_alarm type(ESMF_State) :: importState, exportState integer :: rc character(len=*), parameter :: subname=trim(modname)//': [lilac_run] ' @@ -462,26 +448,33 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) rc = ESMF_SUCCESS if (mytask == 0) then - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" - print *, " Lilac Run " - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + write(logunit,*) "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + write(logunit,*) " Lilac Run " + write(logunit,*) "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" end if + ! Note that the lilac caps for ctsm and possible mosart will + ! listen to the restart and stop alarms on the lilac clock + ! Set the clock restart alarm if restart_alarm_ringing is true if (restart_alarm_is_ringing) then + call ESMF_ClockGetAlarm(lilac_clock, 'lilac_restart_alarm', lilac_restart_alarm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_restart_alarm") call ESMF_AlarmRingerOn(lilac_restart_alarm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") end if ! Set the clock stop alarm if stop_alarm_ringing is true if (stop_alarm_is_ringing) then + call ESMF_ClockGetAlarm(lilac_clock, 'lilac_restart_alarm', lilac_stop_alarm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_restart_alarm") call ESMF_AlarmRingerOn(lilac_stop_alarm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") end if ! Run lilac atmcap - update the cpl2atm_state call ESMF_LogWrite(subname//"running lilac atmos_cap", ESMF_LOGMSG_INFO) - if (mytask == 0) print *, "Running atmos_cap gridded component , rc =", rc + if (mytask == 0) write(logunit,*) "Running atmos_cap gridded component , rc =", rc call ESMF_GridCompRun(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") @@ -492,14 +485,16 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) ! Run cpl_atm2lnd call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) - if (mytask == 0) print *, "Running coupler component..... cpl_atm2lnd_comp" + if (mytask == 0) write(logunit,*) "Running coupler component..... cpl_atm2lnd_comp" call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_atm2lnd") ! Run ctsm + ! Write ctsm restart file if lilac_restart_alarm is ringing + ! Finalize ctsm if lilac_stop_alarm is ringing call ESMF_LogWrite(subname//"running ctsm", ESMF_LOGMSG_INFO) - if (mytask == 0) print *, "Running ctsm" + if (mytask == 0) write(logunit,*) "Running ctsm" call ESMF_GridCompRun(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") @@ -507,7 +502,7 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) ! Run cpl_lnd2atm call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc + write(logunit,*) "Running coupler component..... cpl_lnd2atm_comp , rc =", rc end if call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2cpl_state, exportState=cpl2atm_state, & clock=lilac_clock, rc=rc) @@ -516,14 +511,16 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) if (couple_to_river) then ! Run cpl_lnd2rof call ESMF_LogWrite(subname//"running cpl_lnd2rof_comp ", ESMF_LOGMSG_INFO) - if (mytask == 0) print *, "Running coupler component..... cpl_lnd2rof_comp" + if (mytask == 0) write(logunit,*) "Running coupler component..... cpl_lnd2rof_comp" call ESMF_CplCompRun(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_lnd2rof") ! Run mosart + ! Write mosart restart file if lilac_restart_alarm is ringing + ! Finalize mosart if lilac_stop_alarm is ringing call ESMF_LogWrite(subname//"running mosart", ESMF_LOGMSG_INFO) - if (mytask == 0) print *, "Running mosart" + if (mytask == 0) write(logunit,*) "Running mosart" call ESMF_GridCompRun(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") @@ -531,29 +528,45 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) ! Run cpl_rof2lnd ! TODO: uncommenting this needs to be tested ! call ESMF_LogWrite(subname//"running cpl_rof2lnd_comp ", ESMF_LOGMSG_INFO) - ! if (mytask == 0) print *, "Running coupler component..... cpl_rof2lnd_comp" + ! if (mytask == 0) write(logunit,*) "Running coupler component..... cpl_rof2lnd_comp" ! call ESMF_CplCompRun(cpl_rof2lnd_comp, importState=rof2cpl_state, exportState=cpl2lnd_state, & ! clock=lilac_clock, rc=rc) ! if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_rof2lnd") end if - ! Write out history output - if (couple_to_river) then - call lilac_history_write(atm2cpl_state, cpl2atm_state, lnd2cpl_state, cpl2lnd_state, & - rof2cpl_state=rof2cpl_state, cpl2rof_state=cpl2rof_state, clock=lilac_clock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in history write") - else - call lilac_history_write(atm2cpl_state, cpl2atm_state, lnd2cpl_state, cpl2lnd_state, & - clock=lilac_clock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in history write") - end if - - ! Advance the time at the end of the time step + ! Write out lilac history output if lilac_history_alarm is ringing + call ESMF_ClockGetAlarm(lilac_clock, 'lilac_history_alarm', lilac_history_alarm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_history_alarm") + if (ESMF_AlarmIsRinging(lilac_history_alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AlarmRingerOff( lilac_history_alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (couple_to_river) then + call lilac_history_write(atm2cpl_state, cpl2atm_state, lnd2cpl_state, cpl2lnd_state, & + rof2cpl_state=rof2cpl_state, cpl2rof_state=cpl2rof_state, clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in history write") + else + call lilac_history_write(atm2cpl_state, cpl2atm_state, lnd2cpl_state, cpl2lnd_state, & + clock=lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in history write") + end if + end if + + ! Write out lilac restart output if lilac_restart_alarm is ringing + if (ESMF_AlarmIsRinging(lilac_restart_alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AlarmRingerOff( lilac_restart_alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lilac_time_restart_write(lilac_clock, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in restart write") + end if + + ! Advance the lilac clock at the end of the time step call ESMF_ClockAdvance(lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in advancing time step") call ESMF_LogWrite(subname//"time is icremented now... (ClockAdvance)", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "time is icremented now... (ClockAdvance) , rc =", rc + write(logunit,*) "time is icremented now... (ClockAdvance) , rc =", rc end if end subroutine lilac_run @@ -572,9 +585,9 @@ subroutine lilac_final( ) rc = ESMF_SUCCESS if (mytask == 0) then - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" - print *, " Lilac Finalizing " - print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + write(logunit,*) "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + write(logunit,*) " Lilac Finalizing " + write(logunit,*) "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" end if ! Gridded Component Finalizing! --- atmosphere @@ -582,7 +595,7 @@ subroutine lilac_final( ) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp is running", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "Finalizing atmos_cap gridded component , rc =", rc + write(logunit,*) "Finalizing atmos_cap gridded component , rc =", rc end if ! Coupler component Finalizing --- coupler atmos to land @@ -590,7 +603,7 @@ subroutine lilac_final( ) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc + write(logunit,*) "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc end if ! Gridded Component Finalizing! --- land @@ -598,7 +611,7 @@ subroutine lilac_final( ) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp is running", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "Finalizing lnd_cap gridded component , rc =", rc + write(logunit,*) "Finalizing lnd_cap gridded component , rc =", rc end if ! Coupler component Finalizing --- coupler land to atmos @@ -606,7 +619,7 @@ subroutine lilac_final( ) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "Finalizing coupler component..... cpl_lnd2atm_comp , rc =", rc + write(logunit,*) "Finalizing coupler component..... cpl_lnd2atm_comp , rc =", rc end if ! Then clean them up @@ -614,7 +627,7 @@ subroutine lilac_final( ) call ESMF_LogWrite(subname//"destroying all states ", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "ready to destroy all states" + write(logunit,*) "ready to destroy all states" end if call ESMF_StateDestroy(atm2cpl_state , rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) @@ -631,7 +644,7 @@ subroutine lilac_final( ) call ESMF_LogWrite(subname//"destroying all components ", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "ready to destroy all components" + write(logunit,*) "ready to destroy all components" end if call ESMF_GridCompDestroy(atm_gcomp, rc=rc) @@ -648,7 +661,7 @@ subroutine lilac_final( ) call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) if (mytask == 0) then - print *, "end of Lilac Finalization routine" + write(logunit,*) "end of Lilac Finalization routine" end if ! Finalize ESMF diff --git a/lilac/src/lilac_time.F90 b/lilac/src/lilac_time.F90 index 724925565b..7a38bd57ec 100644 --- a/lilac/src/lilac_time.F90 +++ b/lilac/src/lilac_time.F90 @@ -1,39 +1,39 @@ module lilac_time use ESMF - use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl, r8=>shr_kind_r8 - use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag - use lilac_methods , only : chkerr + use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl, r8=>shr_kind_r8 + use shr_sys_mod , only : shr_sys_abort + use shr_cal_mod , only : shr_cal_ymd2date + use lilac_io , only : lilac_io_write, lilac_io_wopen, lilac_io_enddef + use lilac_io , only : lilac_io_close, lilac_io_date2yyyymmdd, lilac_io_sec2hms + use lilac_methods , only : chkerr + use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr + use netcdf , only : nf90_inq_varid, nf90_get_var, nf90_close implicit none private ! default private - public :: lilac_time_alarmInit ! initialize an alarm + public :: lilac_time_clockinit ! initialize the lilac clock + public :: lilac_time_alarminit ! initialize an alarm + public :: lilac_time_restart_write ! only writes the time info + public :: lilac_time_restart_read ! only reads the time info ! Clock and alarm options character(len=*), private, parameter :: & optNONE = "none" , & optNever = "never" , & optNSteps = "nsteps" , & - optNStep = "nstep" , & optNSeconds = "nseconds" , & - optNSecond = "nsecond" , & optNMinutes = "nminutes" , & - optNMinute = "nminute" , & optNHours = "nhours" , & - optNHour = "nhour" , & optNDays = "ndays" , & - optNDay = "nday" , & optNMonths = "nmonths" , & - optNMonth = "nmonth" , & - optNYears = "nyears" , & - optNYear = "nyear" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optIfdays0 = "ifdays0" , & - optGLCCouplingPeriod = "glc_coupling_period" + optNYears = "nyears" ! Module data + character(len=ESMF_MAXSTR) :: caseid + type(ESMF_Calendar) :: lilac_calendar + integer :: mytask integer, parameter :: SecPerDay = 86400 ! Seconds per day character(len=*), parameter :: u_FILE_u = & __FILE__ @@ -42,11 +42,185 @@ module lilac_time contains !=============================================================================== - subroutine lilac_time_alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep, & + atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & + atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, logunit, & + lilac_clock, rc) - ! !DESCRIPTION: Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm + ! ------------------------------------------------- + ! Initialize the lilac clock + ! ------------------------------------------------- + + ! input/output variables + character(len=*) , intent(in) :: caseid_in + character(len=*) , intent(in) :: starttype + character(len=*) , intent(in) :: atm_calendar + integer , intent(in) :: atm_timestep + integer , intent(in) :: atm_start_year !(yyyy) + integer , intent(in) :: atm_start_mon !(mm) + integer , intent(in) :: atm_start_day + integer , intent(in) :: atm_start_secs + integer , intent(in) :: atm_stop_year !(yyyy) + integer , intent(in) :: atm_stop_mon !(mm) + integer , intent(in) :: atm_stop_day + integer , intent(in) :: atm_stop_secs + integer , intent(in) :: logunit + type(ESMF_Clock) , intent(inout) :: lilac_clock + integer , intent(out) :: rc + + ! local variables + type(ESMF_Alarm) :: lilac_restart_alarm + type(ESMF_Alarm) :: lilac_stop_alarm + type(ESMF_Clock) :: clock + type(ESMF_VM) :: vm + type(ESMF_Time) :: StartTime ! Start time + type(ESMF_Time) :: CurrTime ! Current time + type(ESMF_Time) :: StopTime ! Stop time + type(ESMF_Time) :: Clocktime ! Loop time + type(ESMF_TimeInterval) :: TimeStep ! Clock time-step + integer :: start_ymd ! Start date (YYYYMMDD) + integer :: start_tod ! Start time of day (seconds) + integer :: curr_ymd ! Current ymd (YYYYMMDD) + integer :: curr_tod ! Current tod (seconds) + integer :: stop_n ! Number until stop + integer :: stop_ymd ! Stop date (YYYYMMDD) + integer :: stop_tod ! Stop time-of-day + character(CS) :: stop_option ! Stop option units + character(len=CL) :: restart_file + character(len=CL) :: restart_pfile + integer :: yr, mon, day ! Year, month, day as integers + integer :: unitn ! unit number + integer :: ierr ! Return code + integer :: tmp(2) ! Array for Broadcast + character(len=*), parameter :: subname = '(lilactime_clockInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + caseid = trim(caseid_in) + + ! ------------------------------ + ! get my task + ! ------------------------------ + + call ESMF_VMGetCurrent(vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ------------------------------ + ! create lilac_calendar + ! ------------------------------ + + if (trim(atm_calendar) == 'NOLEAP') then + lilac_calendar = ESMF_CalendarCreate(name='NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + else if (trim(atm_calendar) == 'GREGORIAN') then + lilac_calendar = ESMF_CalendarCreate(name='GREGORIAN', calkindflag=ESMF_CALKIND_GREGORIAN, rc=rc ) + else + ! TODO: add supported calendars here + end if + + ! ------------------------------ + ! create and initialize lilac_clock + ! ------------------------------ + + call ESMF_TimeIntervalSet(TimeStep, s=atm_timestep, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeSet(StartTime, yy=atm_start_year, mm=atm_start_mon, dd=atm_start_day , s=atm_start_secs, & + calendar=lilac_calendar, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeSet(StopTime , yy=atm_stop_year , mm=atm_stop_mon , dd=atm_stop_day , s=atm_stop_secs , & + calendar=lilac_calendar, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Create the lilac clock (NOTE: the reference time is set to the start time) + lilac_clock = ESMF_ClockCreate(name='lilac_clock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, & + stopTime=stopTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + + ! ------------------------------ + ! For a continue run - obtain current time from the lilac restart file and + ! advance the clock to the current time for a continue run + ! ------------------------------ + + if (starttype == 'continue') then + + ! Read the pointer file to obtain the restart file, read the restart file for curr_ymd and curr_tod + ! and then convert this to an esmf current time (currtime) + if ( len_trim(restart_pfile) == 0 ) then + call ESMF_LogWrite(trim(subname)//' ERROR restart_pfile must be defined', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + rc = ESMF_FAILURE + return + end if + restart_pfile = trim(restart_pfile) + if (mytask == 0) then + call ESMF_LogWrite(trim(subname)//" reading rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) + open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) call shr_sys_abort(trim(subname)//' ERROR rpointer file open returns error') + read(unitn,'(a)', iostat=ierr) restart_file + if (ierr < 0) call shr_sys_abort(trim(subname)//' ERROR rpointer file read returns error') + close(unitn) + call ESMF_LogWrite(trim(subname)//" read driver restart from "//trim(restart_file), ESMF_LOGMSG_INFO) + + ! Read the restart file on mastertask and then broadcast the data + call lilac_time_restart_read(restart_file, curr_ymd, curr_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + tmp(1) = curr_ymd ; tmp(2) = curr_tod + call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + curr_ymd = tmp(1) ; curr_tod = tmp(2) + + ! Determine current time + yr = int(curr_ymd/10000) + mon = int( mod(curr_ymd,10000)/ 100) + day = mod(curr_ymd, 100) + call ESMF_TimeSet( currtime, yy=yr, mm=mon, dd=day, s=curr_tod, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Advance the clock to the current time (in case of a restart) + call ESMF_ClockGet(clock, currTime=clocktime, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do while( clocktime < CurrTime) + call ESMF_ClockAdvance( clock, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet( clock, currTime=clocktime, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if + + ! Write out diagnostic info + if (mytask == 0) then + print *, trim(subname) // "---------------------------------------" + call ESMF_CalendarPrint (lilac_calendar , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockPrint (lilac_clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + print *, trim(subname) // "---------------------------------------" + end if + + ! Add a restart alarm and stop alarm to the clock + ! NTOE: The restart alarm and stop alarm will only go off at the end of the run + ! NOTE: The history alarm will be added in lilac_history_init and can go off multiple times during the run + + lilac_restart_alarm = ESMF_AlarmCreate(lilac_clock, ringTime=StopTime, name='lilac_restart_alarm', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing restart alarm') + + lilac_stop_alarm = ESMF_AlarmCreate(lilac_clock, ringTime=StopTime, name='lilac_stop_alarm', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing stop alarm') + + end subroutine lilac_time_clockInit + +!=============================================================================== + + subroutine lilac_time_alarmInit( clock, alarm, alarmname, option, opt_n, rc) + + ! Setup an alarm in a clock + ! The ringtime sent to AlarmCreate MUST be the next alarm ! time. If you send an arbitrary but proper ringtime from the ! past and the ring interval, the alarm will always go off on the ! next clock advance and this will cause serious problems. Even @@ -57,22 +231,18 @@ subroutine lilac_time_alarmInit( clock, alarm, option, & ! advance it properly based on the ring interval. ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: alarmname ! alarm name + character(len=*) , intent(in) :: option ! alarm option + integer , intent(in) :: opt_n ! alarm freq + integer , intent(inout) :: rc ! Return code ! local variables type(ESMF_Calendar) :: cal ! calendar integer :: lymd ! local ymd integer :: ltod ! local tod integer :: cyy,cmm,cdd,csec ! time info - character(len=64) :: lalarmname ! local alarm name logical :: update_nextalarm ! update next alarm type(ESMF_Time) :: CurrTime ! Current Time type(ESMF_Time) :: NextAlarm ! Next restart alarm time @@ -83,13 +253,6 @@ subroutine lilac_time_alarmInit( clock, alarm, option, & rc = ESMF_SUCCESS - lalarmname = 'alarm_unknown' - if (present(alarmname)) lalarmname = trim(alarmname) - ltod = 0 - if (present(opt_tod)) ltod = opt_tod - lymd = -1 - if (present(opt_ymd)) lymd = opt_ymd - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -97,333 +260,214 @@ subroutine lilac_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif + NextAlarm = CurrTime ! Get calendar from clock call ESMF_ClockGet(clock, calendar=cal) ! Determine inputs for call to create alarm - selectcase (trim(option)) + if (trim(option) == optNone .or. trim(option) == optNever) then - case (optNONE) call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. + else if ( trim(option) == optNSteps .or. trim(option) == optNSeconds .or. & + trim(option) == optNMinutes .or. trim(option) == optNHours .or. trim(option) == optNDays) then - case (optIfdays0) - if (.not. present(opt_ymd)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_ymd', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. + write(6,*)'DEBUG: hist_option, hist_n= ',trim(option), opt_n - case (optNSteps) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - case (optNStep) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + else - case (optNSeconds) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return - case (optNSecond) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + end if - case (optNMinutes) - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + ! ------------------------------------------------- + ! AlarmInterval and NextAlarm should be set + ! ------------------------------------------------- - case (optNMinute) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + ! advance Next Alarm so it won't ring on first timestep for + ! most options above. go back one alarminterval just to be careful - case (optNHours) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + if (update_nextalarm) then + NextAlarm = NextAlarm - AlarmInterval + do while (NextAlarm <= CurrTime) + NextAlarm = NextAlarm + AlarmInterval + enddo + endif - case (optNHour) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + alarm = ESMF_AlarmCreate( name=alarmname, clock=clock, ringTime=NextAlarm, & + ringInterval=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - case (optNDays) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + end subroutine lilac_time_alarmInit - case (optNDay) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. +!=============================================================================== - case (optNMonths) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + subroutine lilac_time_restart_write(clock, rc) - case (optNMonth) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + ! ------------------------------------------------- + ! Write lilac restart time info + ! ------------------------------------------------- - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. + ! Input/output variables + type(ESMF_Clock) :: clock + integer, intent(out) :: rc - case (optNYears) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Time) :: currtime, starttime, nexttime + type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time + type(ESMF_Calendar) :: calendar + character(len=64) :: currtimestr, nexttimestr + integer :: i,j,m,n,n1,ncnt + integer :: curr_ymd ! Current date YYYYMMDD + integer :: curr_tod ! Current time-of-day (s) + integer :: start_ymd ! Starting date YYYYMMDD + integer :: start_tod ! Starting time-of-day (s) + integer :: next_ymd ! Starting date YYYYMMDD + integer :: next_tod ! Starting time-of-day (s) + integer :: nx,ny ! global grid size + integer :: yr,mon,day,sec ! time units + real(R8) :: dayssince ! Time interval since reference time + integer :: unitn ! unit number + character(ESMF_MAXSTR) :: time_units ! units of time variable + character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename + character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename + character(ESMF_MAXSTR) :: freq_option ! freq_option setting (ndays, nsteps, etc) + integer :: freq_n ! freq_n setting relative to freq_option + real(R8) :: tbnds(2) ! CF1.0 time bounds + logical :: whead,wdata ! for writing restart/restart cdf files + character(len=*), parameter :: subname='(lilac_time_phases_restart_write)' + !--------------------------------------- - case (optNYear) - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + rc = ESMF_SUCCESS - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. + call ESMF_VMGetCurrent(vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - case default - call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return + call ESMF_ClockGet(clock, currtime=currtime, starttime=starttime, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - end select + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- + call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=rc) - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful + call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=rc) - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif + timediff = nexttime - starttime + call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) + dayssince = day + sec/real(SecPerDay,R8) - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & - ringInterval=AlarmInterval, rc=rc) + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call shr_cal_ymd2date(yr,mon,day,start_ymd) + start_tod = sec + time_units = 'days since '//trim(lilac_io_date2yyyymmdd(start_ymd))//' '//lilac_io_sec2hms(start_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine lilac_time_alarmInit + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call shr_cal_ymd2date(yr,mon,day,next_ymd) + next_tod = sec + + call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call shr_cal_ymd2date(yr,mon,day,curr_ymd) + curr_tod = sec + + !--------------------------------------- + ! Write restart file + ! Use nexttimestr rather than currtimestr here since that is the time at the end of + ! the timestep and is preferred for restart file names + !--------------------------------------- + + write(restart_file,"(5a)") trim(caseid),'.lilac','.r.', trim(nexttimestr),'.nc' + + if (mytask == 0) then + open(newunit=unitn, file="rpointer.lilac", form='FORMATTED') + write(unitn,'(a)') trim(restart_file) + close(unitn) + call ESMF_LogWrite(trim(subname)//" wrote lilac restart pointer file rpointer.lilac", ESMF_LOGMSG_INFO) + endif + + call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) + call lilac_io_wopen(restart_file, vm, mytask, clobber=.true.) + + do m = 1,2 + if (m == 1) then + whead = .true. + wdata = .false. + else if (m == 2) then + whead = .false. + wdata = .true. + endif + if (wdata) then + call lilac_io_enddef(restart_file) + end if + + tbnds = dayssince + call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO) + if (tbnds(1) >= tbnds(2)) then + call lilac_io_write(restart_file, iam=mytask, & + time_units=time_units, calendar=calendar, time_val=dayssince, & + whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call lilac_io_write(restart_file, iam=mytask, & + time_units=time_units, calendar=calendar, time_val=dayssince, & + whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + ! Write out next ymd/tod in place of curr ymd/tod because + ! the currently the restart represents the time at end of + ! the current timestep and that is where we want to start the next run. + + call lilac_io_write(restart_file, mytask, start_ymd, 'start_ymd', whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call lilac_io_write(restart_file, mytask, start_tod, 'start_tod', whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call lilac_io_write(restart_file, mytask, next_ymd , 'curr_ymd' , whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call lilac_io_write(restart_file, mytask, next_tod , 'curr_tod' , whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call lilac_io_close(restart_file, mytask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end do + + end subroutine lilac_time_restart_write !=============================================================================== - subroutine lilac_time_read_restart(restart_file, & - start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod, rc) + subroutine lilac_time_restart_read(restart_file, curr_ymd, curr_tod, rc) - use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr - use netcdf , only : nf90_inq_varid, nf90_get_var, nf90_close - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO + ! ------------------------------------------------- + ! Read the restart time info needed to initialize the clock + ! ------------------------------------------------- ! input/output variables character(len=*), intent(in) :: restart_file - integer, intent(out) :: ref_ymd ! Reference date (YYYYMMDD) - integer, intent(out) :: ref_tod ! Reference time of day (seconds) - integer, intent(out) :: start_ymd ! Start date (YYYYMMDD) - integer, intent(out) :: start_tod ! Start time of day (seconds) integer, intent(out) :: curr_ymd ! Current ymd (YYYYMMDD) integer, intent(out) :: curr_tod ! Current tod (seconds) integer, intent(out) :: rc @@ -431,111 +475,28 @@ subroutine lilac_time_read_restart(restart_file, & ! local variables integer :: status, ncid, varid ! netcdf stuff character(CL) :: tmpstr ! temporary - character(len=*), parameter :: subname = "(lilac_time_read_restart)" + character(len=*), parameter :: subname = "(lilac_time_restart_read)" !---------------------------------------------------------------- ! use netcdf here since it's serial status = nf90_open(restart_file, NF90_NOWRITE, ncid) - if (status /= nf90_NoErr) then - print *,__FILE__,__LINE__,trim(restart_file) - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_open', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - endif - status = nf90_inq_varid(ncid, 'start_ymd', varid) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_ymd', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - status = nf90_get_var(ncid, varid, start_ymd) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_ymd', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - status = nf90_inq_varid(ncid, 'start_tod', varid) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_tod', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - status = nf90_get_var(ncid, varid, start_tod) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_tod', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - status = nf90_inq_varid(ncid, 'ref_ymd', varid) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid ref_ymd', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - status = nf90_get_var(ncid, varid, ref_ymd) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var ref_ymd', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - status = nf90_inq_varid(ncid, 'ref_tod', varid) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid ref_tod', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - status = nf90_get_var(ncid, varid, ref_tod) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var ref_tod', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_open') status = nf90_inq_varid(ncid, 'curr_ymd', varid) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_ymd', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + if (status /= nf90_NoErr) call shr_sys_abort('ERROR: nf90_inq_varid curr_ymd') status = nf90_get_var(ncid, varid, curr_ymd) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_ymd', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var curr_ymd') status = nf90_inq_varid(ncid, 'curr_tod', varid) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_tod', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_inq_varid curr_tod') status = nf90_get_var(ncid, varid, curr_tod) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_tod', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var curr_tod') status = nf90_close(ncid) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_close', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_close') - write(tmpstr,*) trim(subname)//" read start_ymd = ",start_ymd - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - write(tmpstr,*) trim(subname)//" read start_tod = ",start_tod - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - write(tmpstr,*) trim(subname)//" read ref_ymd = ",ref_ymd - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - write(tmpstr,*) trim(subname)//" read ref_tod = ",ref_tod - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) write(tmpstr,*) trim(subname)//" read curr_ymd = ",curr_ymd call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) write(tmpstr,*) trim(subname)//" read curr_tod = ",curr_tod call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - end subroutine lilac_time_read_restart + end subroutine lilac_time_restart_read end module lilac_time - - From 9133c7ed4d16260cb6968ae3842cddb5ee833ead Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 8 Dec 2019 20:03:51 -0700 Subject: [PATCH 228/556] validated restart capability - but there are still roundoff level differences on restart for the aerosol deposition fields --- lilac/atm_driver/atm_driver.F90 | 7 +- lilac/atm_driver/atm_driver_in | 10 +-- lilac/atm_driver/lilac_in | 3 +- lilac/src/lilac_atmaero.F90 | 12 +-- lilac/src/lilac_history.F90 | 5 +- lilac/src/lilac_mod.F90 | 45 ++++++++--- lilac/src/lilac_time.F90 | 137 ++++++++++++++++++++------------ src/cpl/lilac/lnd_comp_esmf.F90 | 52 ++++++------ 8 files changed, 161 insertions(+), 110 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 1b5d82bd86..fca1852f78 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -52,12 +52,13 @@ program atm_driver integer :: atm_stop_secs integer :: atm_timestep_start ! for internal time loop only integer :: atm_timestep_stop ! for internal time loop only + character(len=32) :: atm_starttype namelist /atm_driver_input/ atm_mesh_file, atm_global_nx, atm_global_ny, & atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, & - atm_timestep_start, atm_timestep_stop + atm_timestep_start, atm_timestep_stop, atm_starttype !------------------------------------------------------------------------ !----------------------------------------------------------------------------- @@ -152,12 +153,12 @@ program atm_driver !------------------------------------------------------------------------ if (mytask == 0 ) then - print *, " initializing lilac " + print *, " initializing lilac with start type ",trim(atm_starttype) end if call lilac_init(comp_comm, atm_global_index, atm_lons, atm_lats, & atm_global_nx, atm_global_ny, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs) + atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, atm_starttype) !------------------------------------------------------------------------ ! Run lilac diff --git a/lilac/atm_driver/atm_driver_in b/lilac/atm_driver/atm_driver_in index 4d88e0b9b1..89f832df21 100644 --- a/lilac/atm_driver/atm_driver_in +++ b/lilac/atm_driver/atm_driver_in @@ -6,13 +6,13 @@ atm_start_mon = 1 atm_start_day = 1 atm_start_secs = 0 + atm_timestep = 1800 + atm_calendar = 'NOLEAP' + atm_starttype = 'startup' atm_stop_year = 2000 atm_stop_mon = 1 - atm_stop_day = 2 + atm_stop_day = 3 atm_stop_secs = 0 - atm_timestep = 1800 - atm_calendar = 'NOLEAP' atm_timestep_start = 1 - atm_timestep_stop = 48 - + atm_timestep_stop = 96 / diff --git a/lilac/atm_driver/lilac_in b/lilac/atm_driver/lilac_in index 25c69a8abd..0849c35816 100644 --- a/lilac/atm_driver/lilac_in +++ b/lilac/atm_driver/lilac_in @@ -1,8 +1,7 @@ &lilac_run_input - starttype = 'startup' caseid = 'test_lilac' / -&lilac_io_input +&lilac_history_input lilac_histfreq_option = 'nsteps' lilac_histfreq_n = 4 / diff --git a/lilac/src/lilac_atmaero.F90 b/lilac/src/lilac_atmaero.F90 index 6472d0a01e..4008c9b942 100644 --- a/lilac/src/lilac_atmaero.F90 +++ b/lilac/src/lilac_atmaero.F90 @@ -48,14 +48,14 @@ module lilac_atmaero contains !============================================================================== - subroutine lilac_atmaero_init(atm2lnd_a_state, rc) + subroutine lilac_atmaero_init(atm2cpl_state, rc) ! ---------------------------------------- ! Initialize data stream information. ! ---------------------------------------- ! input/output variables - type(ESMF_State) , intent(inout) :: atm2lnd_a_state + type(ESMF_State) , intent(inout) :: atm2cpl_state integer , intent(out) :: rc ! local variables @@ -161,7 +161,7 @@ subroutine lilac_atmaero_init(atm2lnd_a_state, rc) ! obtain mesh lats, lons and areas ! ------------------------------ - call ESMF_StateGet(atm2lnd_a_state, 'a2c_fb', lfieldbundle, rc=rc) + call ESMF_StateGet(atm2cpl_state, 'a2c_fb', lfieldbundle, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call lilac_methods_FB_getFieldN(lfieldbundle, fieldnum=1, field=lfield, rc=rc) @@ -245,10 +245,10 @@ end subroutine lilac_atmaero_init !================================================================ - subroutine lilac_atmaero_interp(atm2lnd_a_state, clock, rc) + subroutine lilac_atmaero_interp(atm2cpl_state, clock, rc) ! input/output variables - type(ESMF_State) :: atm2lnd_a_state + type(ESMF_State) :: atm2cpl_state type(ESMF_Clock) :: clock integer, intent(out) :: rc @@ -282,7 +282,7 @@ subroutine lilac_atmaero_interp(atm2lnd_a_state, clock, rc) call shr_strdata_advance(sdat, curr_ymd, sec, mpicom, 'atmaero') ! set field bundle data - call ESMF_StateGet(atm2lnd_a_state, "a2c_fb", lfieldbundle, rc=rc) + call ESMF_StateGet(atm2cpl_state, "a2c_fb", lfieldbundle, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call set_fieldbundle_data('Faxa_bcphidry' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/lilac/src/lilac_history.F90 b/lilac/src/lilac_history.F90 index 58da52d614..d6215b2cb1 100644 --- a/lilac/src/lilac_history.F90 +++ b/lilac/src/lilac_history.F90 @@ -56,20 +56,19 @@ subroutine lilac_history_init(clock, caseid, rc) character(len=*), parameter :: subname='(lilac_history_init)' !--------------------------------------- - namelist /lilac_io_input/ lilac_histfreq_n, lilac_histfreq_option + namelist /lilac_history_input/ lilac_histfreq_n, lilac_histfreq_option rc = ESMF_SUCCESS ! read in history file output frequencies open(newunit=fileunit, status="old", file="lilac_in") - read(fileunit, lilac_io_input, iostat=ierr) + read(fileunit, lilac_history_input, iostat=ierr) if (ierr > 0) then call shr_sys_abort(trim(subname) // 'error reading in lilac_io_input') end if close(fileunit) write(histfile_prefix,"(2a)") trim(caseid),'.lilac.hi.' - write(6,*)'DEBUG: histfile_prefix = ',histfile_prefix !--------------------------------------- ! Get the clock info diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 9e56c25dc8..0a5dd3c2c3 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -82,7 +82,7 @@ module lilac_mod subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & atm_global_nx, atm_global_ny, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs) + atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, starttype_in) ! -------------------------------------------------------------------------------- ! This is called by the host atmosphere @@ -105,6 +105,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & integer , intent(in) :: atm_stop_mon !(mm) integer , intent(in) :: atm_stop_day integer , intent(in) :: atm_stop_secs + character(len=*) , intent(in) :: starttype_in ! local variables character(ESMF_MAXSTR) :: caseid @@ -135,11 +136,16 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & logical :: comp_iamin(1) = (/.true./) ! for pio init2 !------------------------------------------------------------------------ - namelist /lilac_run_input/ caseid, starttype + namelist /lilac_run_input/ caseid ! Initialize return code rc = ESMF_SUCCESS + !------------------------------------------------------------------------- + ! Set module variable starttype + !------------------------------------------------------------------------- + starttype = starttype_in + !------------------------------------------------------------------------- ! Initialize pio with first initialization ! AFTER call to MPI_init (which is in the host atm driver) and @@ -334,35 +340,44 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & ! between components. (these are module variables) ! ------------------------------------------------------------------------- - ! Initialze lilac_atm gridded component + ! Create import and export states for atm_gcomp atm2cpl_state = ESMF_StateCreate(name='state_from_atm', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return cpl2atm_state = ESMF_StateCreate(name='state_to_atm', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Initialze lilac_atm gridded component call ESMF_GridCompInitialize(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing atmcap") call ESMF_LogWrite(subname//"lilac_atm gridded component initialized", ESMF_LOGMSG_INFO) - ! Initialze CTSM Gridded Component + ! Create import and export states for lnd_gcomp (i.e. CTSM) cpl2lnd_state = ESMF_StateCreate(name='state_to_land', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return lnd2cpl_state = ESMF_StateCreate(name='state_fr_land', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Add caseid and starttype as attributes of cpl2lnd_state + call ESMF_AttributeSet(cpl2lnd_state, name="caseid", value=trim(caseid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(cpl2lnd_state, name="starttype", value=trim(starttype), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialze CTSM Gridded Component call ESMF_GridCompInitialize(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing ctsm") call ESMF_LogWrite(subname//"CTSM gridded component initialized", ESMF_LOGMSG_INFO) if (couple_to_river) then - ! Initialize MOSART Gridded Component + ! Create import and export states for rof_gcomp (i.e. MOSART) cpl2rof_state = ESMF_StateCreate(name='state_to_river', stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return rof2cpl_state = ESMF_StateCreate(name='state_fr_river', stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Initialize MOSART Gridded Component call ESMF_GridCompInitialize(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & clock=lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing mosart") @@ -458,10 +473,17 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) ! Set the clock restart alarm if restart_alarm_ringing is true if (restart_alarm_is_ringing) then + ! Turn on lilac restart alarm (this will be needed by ctsm) call ESMF_ClockGetAlarm(lilac_clock, 'lilac_restart_alarm', lilac_restart_alarm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_restart_alarm") call ESMF_AlarmRingerOn(lilac_restart_alarm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") + call ESMF_LogWrite(subname//"lilac restart alarm is ringing", ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("Error in querying lilac restart alarm ring") + + ! Write out lilac restart output if lilac_restart_alarm is ringing + call lilac_time_restart_write(lilac_clock, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in restart write") end if ! Set the clock stop alarm if stop_alarm_ringing is true @@ -470,6 +492,7 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_restart_alarm") call ESMF_AlarmRingerOn(lilac_stop_alarm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") + call ESMF_LogWrite(subname//"lilac stop alarm is ringing", ESMF_LOGMSG_INFO) end if ! Run lilac atmcap - update the cpl2atm_state @@ -538,9 +561,9 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) call ESMF_ClockGetAlarm(lilac_clock, 'lilac_history_alarm', lilac_history_alarm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_history_alarm") if (ESMF_AlarmIsRinging(lilac_history_alarm, rc=rc)) then - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("Error in querying lilac history alarm ring") call ESMF_AlarmRingerOff( lilac_history_alarm, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("Error in turning ringer off in lilac history alarm") if (couple_to_river) then call lilac_history_write(atm2cpl_state, cpl2atm_state, lnd2cpl_state, cpl2lnd_state, & rof2cpl_state=rof2cpl_state, cpl2rof_state=cpl2rof_state, clock=lilac_clock, rc=rc) @@ -552,13 +575,11 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) end if end if - ! Write out lilac restart output if lilac_restart_alarm is ringing - if (ESMF_AlarmIsRinging(lilac_restart_alarm, rc=rc)) then - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (restart_alarm_is_ringing) then + call ESMF_ClockGetAlarm(lilac_clock, 'lilac_restart_alarm', lilac_restart_alarm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_restart_alarm") call ESMF_AlarmRingerOff( lilac_restart_alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_time_restart_write(lilac_clock, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in restart write") end if ! Advance the lilac clock at the end of the time step diff --git a/lilac/src/lilac_time.F90 b/lilac/src/lilac_time.F90 index 7a38bd57ec..748d0e69b6 100644 --- a/lilac/src/lilac_time.F90 +++ b/lilac/src/lilac_time.F90 @@ -78,6 +78,7 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep type(ESMF_Time) :: StopTime ! Stop time type(ESMF_Time) :: Clocktime ! Loop time type(ESMF_TimeInterval) :: TimeStep ! Clock time-step + type(ESMF_TimeInterval) :: TimeStep_advance integer :: start_ymd ! Start date (YYYYMMDD) integer :: start_tod ! Start time of day (seconds) integer :: curr_ymd ! Current ymd (YYYYMMDD) @@ -88,7 +89,7 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep character(CS) :: stop_option ! Stop option units character(len=CL) :: restart_file character(len=CL) :: restart_pfile - integer :: yr, mon, day ! Year, month, day as integers + integer :: yr, mon, day, secs ! Year, month, day, seconds as integers integer :: unitn ! unit number integer :: ierr ! Return code integer :: tmp(2) ! Array for Broadcast @@ -140,7 +141,6 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep stopTime=stopTime, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! ------------------------------ ! For a continue run - obtain current time from the lilac restart file and ! advance the clock to the current time for a continue run @@ -150,14 +150,8 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep ! Read the pointer file to obtain the restart file, read the restart file for curr_ymd and curr_tod ! and then convert this to an esmf current time (currtime) - if ( len_trim(restart_pfile) == 0 ) then - call ESMF_LogWrite(trim(subname)//' ERROR restart_pfile must be defined', & - ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) - rc = ESMF_FAILURE - return - end if - restart_pfile = trim(restart_pfile) if (mytask == 0) then + restart_pfile = 'rpointer.lilac' call ESMF_LogWrite(trim(subname)//" reading rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) if (ierr < 0) call shr_sys_abort(trim(subname)//' ERROR rpointer file open returns error') @@ -167,10 +161,10 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep call ESMF_LogWrite(trim(subname)//" read driver restart from "//trim(restart_file), ESMF_LOGMSG_INFO) ! Read the restart file on mastertask and then broadcast the data - call lilac_time_restart_read(restart_file, curr_ymd, curr_tod, rc) + call lilac_time_restart_read(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + tmp(1) = curr_ymd ; tmp(2) = curr_tod endif - tmp(1) = curr_ymd ; tmp(2) = curr_tod call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return curr_ymd = tmp(1) ; curr_tod = tmp(2) @@ -182,15 +176,44 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep call ESMF_TimeSet( currtime, yy=yr, mm=mon, dd=day, s=curr_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Advance the clock to the current time (in case of a restart) - call ESMF_ClockGet(clock, currTime=clocktime, rc=rc ) + ! Determine the current time from the lilac clock + call ESMF_ClockGet(lilac_clock, currtime=clocktime, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - do while( clocktime < CurrTime) - call ESMF_ClockAdvance( clock, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet( clock, currTime=clocktime, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do + + ! Compute the time step difference from the current time from the restart file to the current lilac clock time + ! (which is really just the start time) + + TimeStep_advance = currtime - clocktime + call ESMF_TimeIntervalGet(timestep_advance, s=secs, rc=rc) + if (mytask == 0) write(6,*)'DEBUG: time step advance is ',secs + + ! Advance the clock to the current time (in case of a restart) + call ESMF_ClockAdvance (lilac_clock, timestep=timestep_advance, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing restart alarm') + + ! call ESMF_TimeGet(currtime, yy=cyr, mm=cmon, dd=cday, s=csecs, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! do while( clocktime < currtime) + ! call ESMF_ClockAdvance( lilac_clock, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call ESMF_ClockGet( lilac_clock, currTime=clocktime, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! !DEBUG + ! call ESMF_TimeGet(currtime, yy=cyr, mm=cmon, dd=cday, s=csecs, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (mytask == 0) write(6,*)'DEBUG: currtime yy,mm,dd,sec= ',cyr, cmon, cday, csecs + + ! call ESMF_TimeGet(clocktime, yy=yr, mm=mon, dd=day, s=secs, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (mytask == 0) write(6,*)'DEBUG: clocktime yy,mm,dd,sec= ',yr, mon, day, secs + + ! if (clocktime < currtime) then + ! if (mytask == 0) write(6,*)'DEBUG: clock time is less than current time' + ! end if + ! !DEBUG + ! end do + end if ! Write out diagnostic info @@ -277,8 +300,6 @@ subroutine lilac_time_alarmInit( clock, alarm, alarmname, option, opt_n, rc) else if ( trim(option) == optNSteps .or. trim(option) == optNSeconds .or. & trim(option) == optNMinutes .or. trim(option) == optNHours .or. trim(option) == optNDays) then - write(6,*)'DEBUG: hist_option, hist_n= ',trim(option), opt_n - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -310,6 +331,7 @@ subroutine lilac_time_alarmInit( clock, alarm, alarmname, option, opt_n, rc) alarm = ESMF_AlarmCreate( name=alarmname, clock=clock, ringTime=NextAlarm, & ringInterval=AlarmInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//'created lilac alarm '//trim(alarmname), ESMF_LOGMSG_INFO) end subroutine lilac_time_alarmInit @@ -347,8 +369,8 @@ subroutine lilac_time_restart_write(clock, rc) character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename character(ESMF_MAXSTR) :: freq_option ! freq_option setting (ndays, nsteps, etc) integer :: freq_n ! freq_n setting relative to freq_option - real(R8) :: tbnds(2) ! CF1.0 time bounds - logical :: whead,wdata ! for writing restart/restart cdf files + logical :: write_header ! true => write netcdf header + logical :: write_data ! true => write netcdf data character(len=*), parameter :: subname='(lilac_time_phases_restart_write)' !--------------------------------------- @@ -398,6 +420,7 @@ subroutine lilac_time_restart_write(clock, rc) !--------------------------------------- write(restart_file,"(5a)") trim(caseid),'.lilac','.r.', trim(nexttimestr),'.nc' + call ESMF_LogWrite(subname//"lilac restart file is "//trim(restart_file), ESMF_LOGMSG_INFO) if (mytask == 0) then open(newunit=unitn, file="rpointer.lilac", form='FORMATTED') @@ -406,61 +429,50 @@ subroutine lilac_time_restart_write(clock, rc) call ESMF_LogWrite(trim(subname)//" wrote lilac restart pointer file rpointer.lilac", ESMF_LOGMSG_INFO) endif - call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": writing "//trim(restart_file), ESMF_LOGMSG_INFO) call lilac_io_wopen(restart_file, vm, mytask, clobber=.true.) do m = 1,2 if (m == 1) then - whead = .true. - wdata = .false. - else if (m == 2) then - whead = .false. - wdata = .true. + write_header = .true. ; write_data = .false. + else + write_header = .false. ; write_data = .true. endif - if (wdata) then + + if (write_data) then call lilac_io_enddef(restart_file) end if - tbnds = dayssince call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO) - if (tbnds(1) >= tbnds(2)) then - call lilac_io_write(restart_file, iam=mytask, & - time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call lilac_io_write(restart_file, iam=mytask, & - time_units=time_units, calendar=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + call lilac_io_write(restart_file, iam=mytask, & + time_units=time_units, calendar=calendar, time_val=dayssince, & + whead=write_header, wdata=write_data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write out next ymd/tod in place of curr ymd/tod because ! the currently the restart represents the time at end of ! the current timestep and that is where we want to start the next run. - call lilac_io_write(restart_file, mytask, start_ymd, 'start_ymd', whead=whead, wdata=wdata, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call lilac_io_write(restart_file, mytask, start_tod, 'start_tod', whead=whead, wdata=wdata, rc=rc) + call lilac_io_write(restart_file, mytask, next_ymd , 'curr_ymd' , whead=write_header, wdata=write_data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call lilac_io_write(restart_file, mytask, next_ymd , 'curr_ymd' , whead=whead, wdata=wdata, rc=rc) + call lilac_io_write(restart_file, mytask, next_tod , 'curr_tod' , whead=write_header, wdata=write_data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lilac_io_write(restart_file, mytask, next_tod , 'curr_tod' , whead=whead, wdata=wdata, rc=rc) + call lilac_io_write(restart_file, mytask, start_ymd , 'start_ymd' , whead=write_header, wdata=write_data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call lilac_io_close(restart_file, mytask, rc=rc) + call lilac_io_write(restart_file, mytask, start_tod , 'start_tod' , whead=write_header, wdata=write_data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do + call lilac_io_close(restart_file, mytask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": closing "//trim(restart_file), ESMF_LOGMSG_INFO) + end subroutine lilac_time_restart_write !=============================================================================== - subroutine lilac_time_restart_read(restart_file, curr_ymd, curr_tod, rc) + subroutine lilac_time_restart_read(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) ! ------------------------------------------------- ! Read the restart time info needed to initialize the clock @@ -468,6 +480,8 @@ subroutine lilac_time_restart_read(restart_file, curr_ymd, curr_tod, rc) ! input/output variables character(len=*), intent(in) :: restart_file + integer, intent(out) :: start_ymd ! Current ymd (YYYYMMDD) + integer, intent(out) :: start_tod ! Current tod (seconds) integer, intent(out) :: curr_ymd ! Current ymd (YYYYMMDD) integer, intent(out) :: curr_tod ! Current tod (seconds) integer, intent(out) :: rc @@ -481,6 +495,7 @@ subroutine lilac_time_restart_read(restart_file, curr_ymd, curr_tod, rc) ! use netcdf here since it's serial status = nf90_open(restart_file, NF90_NOWRITE, ncid) if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_open') + status = nf90_inq_varid(ncid, 'curr_ymd', varid) if (status /= nf90_NoErr) call shr_sys_abort('ERROR: nf90_inq_varid curr_ymd') status = nf90_get_var(ncid, varid, curr_ymd) @@ -489,9 +504,25 @@ subroutine lilac_time_restart_read(restart_file, curr_ymd, curr_tod, rc) if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_inq_varid curr_tod') status = nf90_get_var(ncid, varid, curr_tod) if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var curr_tod') + + status = nf90_inq_varid(ncid, 'start_ymd', varid) + if (status /= nf90_NoErr) call shr_sys_abort('ERROR: nf90_inq_varid start_ymd') + status = nf90_get_var(ncid, varid, start_ymd) + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var start_ymd') + status = nf90_inq_varid(ncid, 'start_tod', varid) + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_inq_varid start_tod') + status = nf90_get_var(ncid, varid, start_tod) + if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var start_tod') + + status = nf90_close(ncid) if (status /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_close') + write(tmpstr,*) trim(subname)//" read start_ymd = ",start_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read start_tod = ",start_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read curr_ymd = ",curr_ymd call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) write(tmpstr,*) trim(subname)//" read curr_tod = ",curr_tod diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 369c3c8260..92db721b38 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -103,22 +103,23 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) type(ESMF_Clock) :: clock ! ESMF synchronization clock integer, intent(out) :: rc ! Return code - ! local variable + ! local variables integer :: ierr ! error code integer :: n,g,i,j ! indices logical :: exists ! true if file exists - real(r8) :: nextsw_cday ! calday from clock of next radiation computation character(len=CL) :: caseid ! case identifier name - character(len=CL) :: ctitle ! case description title character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) + real(r8) :: nextsw_cday ! calday next radiation computation integer :: nsrest ! clm restart type - logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type - logical :: atm_aero ! Flag if aerosol data sent from atm model integer :: lbnum ! input to memory diagnostic integer :: shrlogunit ! old values for log unit and log level type(bounds_type) :: bounds ! bounds character(len=CL) :: cvalue + ! communicator info + type(ESMF_VM) :: vm + integer :: mpicom_vm + ! generation of field bundles type(ESMF_State) :: importState, exportState type(ESMF_FieldBundle) :: c2l_fb_atm, c2l_fb_rof ! field bundles in import state @@ -159,16 +160,12 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) integer :: orb_iyear ! orbital year for current orbital computation integer :: orb_eccen ! orbital year for current orbital computation - type(ESMF_VM) :: vm - integer :: mpicom_vm - - ! input namelist read for ctsm mesh and run info - namelist /lilac_lnd_input/ lnd_mesh_filename - namelist /lilac_run_input/ caseid, starttype - character(len=*), parameter :: subname=trim(modName)//': (lnd_init) ' !------------------------------------------------------------------------ + ! input namelist read for ctsm mesh + namelist /lilac_lnd_input/ lnd_mesh_filename + rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' is called!', ESMF_LOGMSG_INFO) @@ -191,7 +188,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call ESMF_LogWrite(subname//"initialized model mpi info using spmd_init", ESMF_LOGMSG_INFO) !------------------------------------------------------------------------ - !--- Log File --- + ! Initialize output log file !------------------------------------------------------------------------ ! TODO: by default iulog = 6 in clm_varctl - this should be generalized so that we @@ -244,13 +241,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (masterproc) then open(newunit=fileunit, status="old", file="lilac_in") - call shr_nl_find_group_name(fileunit, 'lilac_run_input', ierr) - if (ierr == 0) then - read(fileunit, lilac_run_input, iostat=ierr) - if (ierr > 0) then - call shr_sys_abort( 'problem on read of lilac_run_input') - end if - end if call shr_nl_find_group_name(fileunit, 'lilac_lnd_input', ierr) if (ierr == 0) then read(fileunit, lilac_lnd_input, iostat=ierr) @@ -261,8 +251,18 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) close(fileunit) end if call mpi_bcast(lnd_mesh_filename, len(lnd_mesh_filename), MPI_CHARACTER, 0, mpicom, ierr) - call mpi_bcast(starttype, len(starttype), MPI_CHARACTER, 0, mpicom, ierr) - call mpi_bcast(caseid, len(caseid), MPI_CHARACTER, 0, mpicom, ierr) + + !---------------------- + ! Obtain caseid and start type from attributes in import state + !---------------------- + + call ESMF_AttributeGet(import_state, name="caseid", value=caseid, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"caseid is "//trim(caseid), ESMF_LOGMSG_INFO) + + call ESMF_AttributeGet(import_state, name="starttype", value=starttype, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + call ESMF_LogWrite(subname//"starttype is "//trim(starttype), ESMF_LOGMSG_INFO) if (trim(starttype) == trim('startup')) then nsrest = nsrStartup @@ -633,19 +633,19 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) ! Obtain orbital values !---------------------- - !call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, rc=rc) + !call ESMF_AttributeGet(gcomp, name='orb_eccen', value=cvalue, rc=rc) !if (ChkErr(rc,__LINE__,u_FILE_u)) return !read(cvalue,*) eccen - !call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, rc=rc) + !call ESMF_AttributeGet(gcomp, name='orb_obliqr', value=cvalue, rc=rc) !if (ChkErr(rc,__LINE__,u_FILE_u)) return !read(cvalue,*) obliqr - !call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, rc=rc) + !call ESMF_AttributeGet(gcomp, name='orb_lambm0', value=cvalue, rc=rc) !if (ChkErr(rc,__LINE__,u_FILE_u)) return !read(cvalue,*) lambm0 - !call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) + !call ESMF_AttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) !if (ChkErr(rc,__LINE__,u_FILE_u)) return !read(cvalue,*) mvelpp From f9bed6d21668cfa13f93c0ff19a097e461769c1c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 9 Dec 2019 13:00:54 -0700 Subject: [PATCH 229/556] simplified atm_driver_in to no longer specify time steps --- lilac/atm_driver/atm_driver.F90 | 25 +++++++++++++++---------- lilac/atm_driver/atm_driver_in | 14 ++++++-------- 2 files changed, 21 insertions(+), 18 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index fca1852f78..8fdeafb6ff 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -32,9 +32,10 @@ program atm_driver integer :: my_start, my_end integer :: i_local, i_global integer :: nlocal, nglobal - integer :: nstep ! time step counter integer :: g,i,k ! indices integer :: fileunit ! for namelist input + integer :: nstep ! time step counter + integer :: atm_nsteps ! number of time steps of the simulation ! Namelist and related variables character(len=512) :: atm_mesh_file @@ -43,22 +44,19 @@ program atm_driver character(len=128) :: atm_calendar integer :: atm_timestep integer :: atm_start_year ! (yyyy) - integer :: atm_start_mon ! (mm) - integer :: atm_start_day - integer :: atm_start_secs integer :: atm_stop_year ! (yyyy) + integer :: atm_start_mon ! (mm) integer :: atm_stop_mon ! (mm) + integer :: atm_start_day integer :: atm_stop_day + integer :: atm_start_secs integer :: atm_stop_secs - integer :: atm_timestep_start ! for internal time loop only - integer :: atm_timestep_stop ! for internal time loop only character(len=32) :: atm_starttype namelist /atm_driver_input/ atm_mesh_file, atm_global_nx, atm_global_ny, & atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, & - atm_timestep_start, atm_timestep_stop, atm_starttype + atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, atm_starttype !------------------------------------------------------------------------ !----------------------------------------------------------------------------- @@ -164,11 +162,18 @@ program atm_driver ! Run lilac !------------------------------------------------------------------------ - do nstep = atm_timestep_start, atm_timestep_stop + if ( atm_stop_year == atm_start_year .and. atm_stop_mon == atm_start_mon .and. & + atm_stop_secs == atm_start_secs) then + atm_nsteps = ((atm_stop_day - atm_start_day) * 86400.) / atm_timestep + else + call shr_sys_abort('not supporting start and stop years,months and secs to be different') + end if + + do nstep = 1,atm_nsteps ! fill in the dataptr values in atm2lnd type in lilac_atmcap call atm_driver_to_lilac (atm_lons, atm_lats) - if (nstep == atm_timestep_stop) then + if (nstep == atm_nsteps) then call lilac_run(restart_alarm_is_ringing=.true., stop_alarm_is_ringing=.true.) else call lilac_run(restart_alarm_is_ringing=.false., stop_alarm_is_ringing=.false.) diff --git a/lilac/atm_driver/atm_driver_in b/lilac/atm_driver/atm_driver_in index 89f832df21..e178f6f471 100644 --- a/lilac/atm_driver/atm_driver_in +++ b/lilac/atm_driver/atm_driver_in @@ -2,17 +2,15 @@ atm_mesh_file = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' atm_global_nx = 72 atm_global_ny = 46 - atm_start_year = 2000 - atm_start_mon = 1 - atm_start_day = 1 - atm_start_secs = 0 atm_timestep = 1800 atm_calendar = 'NOLEAP' - atm_starttype = 'startup' + atm_start_year = 2000 atm_stop_year = 2000 + atm_start_mon = 1 atm_stop_mon = 1 - atm_stop_day = 3 + atm_start_secs = 0 atm_stop_secs = 0 - atm_timestep_start = 1 - atm_timestep_stop = 96 + atm_start_day = 1 + atm_stop_day = 2 + atm_starttype = 'startup' / From 1b662f8bb73137fd55110107cba36d6571c074ea Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 9 Dec 2019 19:04:33 -0700 Subject: [PATCH 230/556] changes to get restart working correctly --- lilac/atm_driver/atm_driver.F90 | 79 +++++++++++++++++++++++++++++---- lilac/atm_driver/atm_driver_in | 2 +- lilac/src/lilac_time.F90 | 23 ---------- 3 files changed, 72 insertions(+), 32 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 8fdeafb6ff..8aaa2985a2 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -16,9 +16,12 @@ program atm_driver ! ESMF lilac_atmcap ESMF CTSM cap ESMF river cap (Mizzouroute, Mosart) !---------------------------------------------------------------------------- + use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_close + use netcdf , only : nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_varid, nf90_get_var use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS use lilac_mod , only : lilac_init, lilac_run, lilac_final use lilac_atmcap, only : lilac_atmcap_atm2lnd, lilac_atmcap_lnd2atm + use shr_cal_mod , only : shr_cal_date2ymd use shr_sys_mod , only : shr_sys_abort implicit none @@ -36,6 +39,11 @@ program atm_driver integer :: fileunit ! for namelist input integer :: nstep ! time step counter integer :: atm_nsteps ! number of time steps of the simulation + character(len=512) :: restart_file ! local path to lilac restart filename + integer :: idfile, varid + integer :: atm_restart_ymd + integer :: atm_restart_year, atm_restart_mon + integer :: atm_restart_day, atm_restart_secs ! Namelist and related variables character(len=512) :: atm_mesh_file @@ -162,11 +170,65 @@ program atm_driver ! Run lilac !------------------------------------------------------------------------ - if ( atm_stop_year == atm_start_year .and. atm_stop_mon == atm_start_mon .and. & - atm_stop_secs == atm_start_secs) then - atm_nsteps = ((atm_stop_day - atm_start_day) * 86400.) / atm_timestep - else - call shr_sys_abort('not supporting start and stop years,months and secs to be different') + ! Assume that will always run for N days (no partial days) + + if (atm_starttype == 'startup') then + + if ( atm_stop_year /= atm_start_year) then + call shr_sys_abort('not supporting start and stop years to be different') + else if (atm_stop_mon /= atm_start_mon) then + call shr_sys_abort('not supporting start and stop months to be different') + else if (atm_stop_secs /= 0 .or. atm_start_secs /= 0) then + call shr_sys_abort('not supporting start and stop secs to be nonzero') + else + atm_nsteps = ((atm_stop_day - atm_start_day) * 86400.) / atm_timestep + end if + + else ! continue + + open(newunit=fileunit, file='rpointer.lilac', form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) call shr_sys_abort('Error opening rpointer.lilac') + read(fileunit,'(a)', iostat=ierr) restart_file + if (ierr < 0) call shr_sys_abort('Error reading rpointer.lilac') + close(fileunit) + if (mytask == 0) then + print *,'lilac restart_file = ',trim(restart_file) + end if + + ierr = nf90_open(restart_file, NF90_NOWRITE, idfile) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_open') + + ierr = nf90_inq_varid(idfile, 'curr_ymd', varid) + if (ierr /= nf90_NoErr) call shr_sys_abort('ERROR: nf90_inq_varid curr_ymd') + ierr = nf90_get_var(idfile, varid, atm_restart_ymd) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var curr_ymd') + + ierr = nf90_inq_varid(idfile, 'curr_tod', varid) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_inq_varid curr_tod') + ierr = nf90_get_var(idfile, varid, atm_restart_secs) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_get_var curr_tod') + + ierr = nf90_close(idfile) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_close') + + if (mytask == 0) then + print *,'restart_ymd = ',atm_restart_ymd + end if + call shr_cal_date2ymd(atm_restart_ymd, atm_restart_year, atm_restart_mon, atm_restart_day) + + if ( atm_stop_year /= atm_restart_year) then + write(6,*)'atm_stop_year = ',atm_stop_year,'atm_restart_year = ',atm_restart_year + call shr_sys_abort('not supporting restart and stop years to be different') + else if (atm_stop_mon /= atm_restart_mon) then + write(6,*)'atm_stop_mon = ',atm_stop_mon,'atm_restart_mon = ',atm_restart_mon + call shr_sys_abort('not supporting restart and stop months to be different') + else if (atm_stop_secs /= 0 .or. atm_restart_secs /= 0) then + write(6,*)'atm_stop_secs = ',atm_stop_secs,'atm_restart_secs = ',atm_restart_secs + call shr_sys_abort('not supporting restart and stop secs to be nonzero') + else + atm_nsteps = ((atm_stop_day - atm_restart_day) * 86400.) / atm_timestep + end if + end if do nstep = 1,atm_nsteps @@ -198,9 +260,6 @@ program atm_driver subroutine read_netcdf_mesh(filename, nglobal) - use netcdf - implicit none - ! input/output variables character(*) , intent(in) :: filename integer , intent(out) :: nglobal @@ -249,6 +308,10 @@ subroutine read_netcdf_mesh(filename, nglobal) ierr = nf90_get_var(idfile, idvar_CenterCoords, centerCoords, start=(/1,1/), count=(/coordDim, nelem/)) call nc_check_err(ierr,"get_var CenterCoords", filename) + ! Close the file + ierr = nf90_close(idfile) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_close') + nglobal = nelem end subroutine read_netcdf_mesh diff --git a/lilac/atm_driver/atm_driver_in b/lilac/atm_driver/atm_driver_in index e178f6f471..09d1037741 100644 --- a/lilac/atm_driver/atm_driver_in +++ b/lilac/atm_driver/atm_driver_in @@ -11,6 +11,6 @@ atm_start_secs = 0 atm_stop_secs = 0 atm_start_day = 1 - atm_stop_day = 2 + atm_stop_day = 3 atm_starttype = 'startup' / diff --git a/lilac/src/lilac_time.F90 b/lilac/src/lilac_time.F90 index 748d0e69b6..dd41284ef2 100644 --- a/lilac/src/lilac_time.F90 +++ b/lilac/src/lilac_time.F90 @@ -191,29 +191,6 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep call ESMF_ClockAdvance (lilac_clock, timestep=timestep_advance, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing restart alarm') - ! call ESMF_TimeGet(currtime, yy=cyr, mm=cmon, dd=cday, s=csecs, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! do while( clocktime < currtime) - ! call ESMF_ClockAdvance( lilac_clock, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call ESMF_ClockGet( lilac_clock, currTime=clocktime, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! !DEBUG - ! call ESMF_TimeGet(currtime, yy=cyr, mm=cmon, dd=cday, s=csecs, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! if (mytask == 0) write(6,*)'DEBUG: currtime yy,mm,dd,sec= ',cyr, cmon, cday, csecs - - ! call ESMF_TimeGet(clocktime, yy=yr, mm=mon, dd=day, s=secs, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! if (mytask == 0) write(6,*)'DEBUG: clocktime yy,mm,dd,sec= ',yr, mon, day, secs - - ! if (clocktime < currtime) then - ! if (mytask == 0) write(6,*)'DEBUG: clock time is less than current time' - ! end if - ! !DEBUG - ! end do - end if ! Write out diagnostic info From 819a3414bb57e0f6cf45d269824b6f24427318b7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 9 Dec 2019 19:27:51 -0700 Subject: [PATCH 231/556] fixed bug in setting default calendar needed for restart --- lilac/src/lilac_time.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lilac/src/lilac_time.F90 b/lilac/src/lilac_time.F90 index dd41284ef2..358fecbb31 100644 --- a/lilac/src/lilac_time.F90 +++ b/lilac/src/lilac_time.F90 @@ -118,8 +118,10 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep else if (trim(atm_calendar) == 'GREGORIAN') then lilac_calendar = ESMF_CalendarCreate(name='GREGORIAN', calkindflag=ESMF_CALKIND_GREGORIAN, rc=rc ) else - ! TODO: add supported calendars here + call shr_sys_abort(trim(subname)//'ERROR: only NOLEAP and GREGORIAN calendars currently supported') end if + call ESMF_CalendarSetDefault(lilac_calendar, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort(trim(subname)//'ERROR: default calendar set error') ! ------------------------------ ! create and initialize lilac_clock @@ -139,7 +141,7 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep ! Create the lilac clock (NOTE: the reference time is set to the start time) lilac_clock = ESMF_ClockCreate(name='lilac_clock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, & stopTime=stopTime, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort(trim(subname)//'error initializing lilac clock') ! ------------------------------ ! For a continue run - obtain current time from the lilac restart file and From 2235b9c1c19029aec61d411ee3fba77b504b9b46 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 11 Dec 2019 12:40:57 -0700 Subject: [PATCH 232/556] Remove a few unnecessary things from the lilac atm_driver Makefile --- lilac/atm_driver/Makefile | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index d17925627c..bc42d6b752 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -7,24 +7,23 @@ # # Note: You must set the environment BLDDIR before running this - e.g. # export BLDDIR=/glade/scratch/sacks/test_lilac_1205a/bld +# +# ESMFMKFILE must also be set in the environment #================================================================================ -ESMFMKFILE = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default/esmf.mk -ESMF_LIB_DIR = /glade/work/turuncu/ESMF/8.0.0b50/lib/libg/Linux.intel.64.mpt.default include $(ESMFMKFILE) SHARED_BLD_DIR = $(BLDDIR)/intel/mpt/debug/nothreads/nuopc CTSM_BLD_DIR = $(SHARED_BLD_DIR)/nuopc/esmf DEPENDS_LIB = $(SHARED_BLD_DIR)/lib SHR_LIB = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/lib -SHR_INC = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/csm_share CTSM_INC = $(CTSM_BLD_DIR)/clm/obj FFLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free -LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIB_DIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIB_DIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib +LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIBSDIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIBSDIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib -INCLUDES = -I$(CTSM_BLD_DIR)/include -I$(SHR_INC) -I$(CTSM_INC) +INCLUDES = -I$(CTSM_INC) #================================================================================ # Compiler and linker rules using ESMF_ variables supplied by esmf.mk From 2d5082974bf2e711e7ba88a15562db10d4323a37 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 11 Dec 2019 13:02:50 -0700 Subject: [PATCH 233/556] Split parts of Makefile into a ctsm.mk file The point of this is: I'll move to auto-generating this ctsm.mk file; then it can be included in the atmosphere model build. --- lilac/atm_driver/Makefile | 23 ++++++++--------------- lilac/atm_driver/ctsm.mk | 27 +++++++++++++++++++++++++++ 2 files changed, 35 insertions(+), 15 deletions(-) create mode 100644 lilac/atm_driver/ctsm.mk diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index bc42d6b752..41840146cd 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -3,28 +3,21 @@ #================================================================================ #================================================================================ -# Define directory paths -# # Note: You must set the environment BLDDIR before running this - e.g. # export BLDDIR=/glade/scratch/sacks/test_lilac_1205a/bld # # ESMFMKFILE must also be set in the environment #================================================================================ -include $(ESMFMKFILE) +include $(CURDIR)/ctsm.mk -SHARED_BLD_DIR = $(BLDDIR)/intel/mpt/debug/nothreads/nuopc -CTSM_BLD_DIR = $(SHARED_BLD_DIR)/nuopc/esmf -DEPENDS_LIB = $(SHARED_BLD_DIR)/lib -SHR_LIB = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/lib -CTSM_INC = $(CTSM_BLD_DIR)/clm/obj +# Most atmosphere model builds shouldn't need this directly, but we use +# it here in order to easily get a f90 compiler and f90 compile opts for +# building atm_driver.o. +include $(ESMFMKFILE) FFLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free -LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L$(ESMF_LIBSDIR) -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,$(ESMF_LIBSDIR) -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib - -INCLUDES = -I$(CTSM_INC) - #================================================================================ # Compiler and linker rules using ESMF_ variables supplied by esmf.mk #================================================================================ @@ -32,13 +25,13 @@ INCLUDES = -I$(CTSM_INC) .SUFFIXES: .F90 %.o : %.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(INCLUDES) $(FFLAGS) $< + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(CTSM_INCLUDES) $(FFLAGS) $< atm_driver.o : $(CURDIR)/atm_driver.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(INCLUDES) $(FFLAGS) $< + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(CTSM_INCLUDES) $(FFLAGS) $< atm_driver: atm_driver.o - $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(LIBS) + $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) -o $@ $^ $(CTSM_LIBS) mv atm_driver atm_driver.exe # module dependencies: diff --git a/lilac/atm_driver/ctsm.mk b/lilac/atm_driver/ctsm.mk new file mode 100644 index 0000000000..e344fcfd26 --- /dev/null +++ b/lilac/atm_driver/ctsm.mk @@ -0,0 +1,27 @@ +# ====================================================================== +# Include this file to get makefile variables needed to include / link +# LILAC/CTSM in an atmosphere model's build +# +# Variables of interest are: +# - CTSM_INCLUDES: add this to the compilation line +# - CTSM_LIBS: add this to the link line +# +# Note: You must set the environment BLDDIR before running this - e.g. +# export BLDDIR=/glade/scratch/sacks/test_lilac_1205a/bld +# +# ESMFMKFILE must also be set in the environment +# ====================================================================== + +include $(ESMFMKFILE) + +SHARED_BLD_DIR = $(BLDDIR)/intel/mpt/debug/nothreads/nuopc +CTSM_BLD_DIR = $(SHARED_BLD_DIR)/nuopc/esmf +DEPENDS_LIB = $(SHARED_BLD_DIR)/lib +SHR_LIB = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/lib +CTSM_INC = $(CTSM_BLD_DIR)/clm/obj + +LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib + +CTSM_INCLUDES = $(ESMF_F90COMPILEPATHS) -I$(CTSM_INC) + +CTSM_LIBS = $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) $(LIBS) From 97d1725131cf797ae23a477df5909c65fb369e06 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 11 Dec 2019 13:41:19 -0700 Subject: [PATCH 234/556] Write a ctsm.mk file in the course of building ctsm with LILAC_MODE set We'll use this in place of the current ctsm.mk file to do an atmosphere build (either for atm_driver or a real atmosphere). --- cime_config/buildlib | 47 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/cime_config/buildlib b/cime_config/buildlib index a71e4e5615..b63dc930c8 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -29,6 +29,52 @@ def _get_osvar(key, default): value = default return value +############################################################################### +def _write_ctsm_mk(exeroot): + """Writes a ctsm.mk file in exeroot. + + This file can be included by atmosphere model builds outside of cime. + + NOTE: This currently has some hard-coded settings for cheyenne. Also, it assumes that + ESMFMKFILE is set in your environment. + """ + + ctsm_mk_path = os.path.join(exeroot, 'ctsm.mk') + esmfmkfile = os.environ['ESMFMKFILE'] + with open(ctsm_mk_path, 'w') as ctsm_mk: + ctsm_mk.write(""" +# ====================================================================== +# Include this file to get makefile variables needed to include / link +# LILAC/CTSM in an atmosphere model's build +# +# Variables of interest are: +# - CTSM_INCLUDES: add this to the compilation line +# - CTSM_LIBS: add this to the link line +# ====================================================================== + +# ====================================================================== +# The following settings are meant for internal use, and generally +# should not be included directly in an atmosphere model's build. +# ====================================================================== + +include {esmfmkfile} + +SHARED_BLD_DIR = {exeroot}/intel/mpt/debug/nothreads/nuopc +CTSM_BLD_DIR = $(SHARED_BLD_DIR)/nuopc/esmf +DEPENDS_LIB = $(SHARED_BLD_DIR)/lib +SHR_LIB = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/lib +CTSM_INC = $(CTSM_BLD_DIR)/clm/obj + +LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib + +# ====================================================================== +# The following settings should be included in an atmosphere model's build. +# ====================================================================== + +CTSM_INCLUDES = $(ESMF_F90COMPILEPATHS) -I$(CTSM_INC) +CTSM_LIBS = $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) $(LIBS) +""".format(exeroot=exeroot, esmfmkfile=esmfmkfile)) + ############################################################################### def _main_func(): ############################################################################### @@ -46,6 +92,7 @@ def _main_func(): lilac_mode = _get_osvar('LILAC_MODE', 'off') if lilac_mode == 'on': driver = "lilac" + _write_ctsm_mk(exeroot=case.get_value("EXEROOT")) #------------------------------------------------------- # create Filepath file From 514d7baaff69aea6756ed92dc0fe9aa4c5533965 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 11 Dec 2019 15:03:04 -0700 Subject: [PATCH 235/556] Fix ctsm.mk so that share code is included in the include paths This is needed for compilation to work. Note that my last 3 commits (where I was messing with the build) were originally on top of 63beebb3, then I rebased them to be up to date with the lilac_cap branch. When I did this rebase, the build started failing; this fixes it. I thought that we could skip SHR_INC in CTSM_INCLUDES: this include is needed when compiling CTSM source, but I didn't think it would be needed when compiling the atmosphere. However, without that, I get an error when compiling atm_driver.F90: /glade/work/sacks/ctsm_code/current_branch1/lilac/atm_driver/atm_driver.F90(23): error #7002: Error in opening the compiled module file. Check INCLUDE paths. [SHR_KIND_MOD] use lilac_atmcap, only : lilac_atmcap_atm2lnd, lilac_atmcap_lnd2atm ------^ So apparently it needs to be able to find SHR_KIND_MOD due to its indirect use? (There are also errors due to new direct uses of share code from atm_driver.F90, but the surprising thing to me was this apparent need to have indirectly-used modules in the include path.) --- cime_config/buildlib | 3 ++- lilac/atm_driver/ctsm.mk | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/cime_config/buildlib b/cime_config/buildlib index b63dc930c8..53b5a54434 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -63,6 +63,7 @@ SHARED_BLD_DIR = {exeroot}/intel/mpt/debug/nothreads/nuopc CTSM_BLD_DIR = $(SHARED_BLD_DIR)/nuopc/esmf DEPENDS_LIB = $(SHARED_BLD_DIR)/lib SHR_LIB = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/lib +SHR_INC = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/csm_share CTSM_INC = $(CTSM_BLD_DIR)/clm/obj LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib @@ -71,7 +72,7 @@ LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lp # The following settings should be included in an atmosphere model's build. # ====================================================================== -CTSM_INCLUDES = $(ESMF_F90COMPILEPATHS) -I$(CTSM_INC) +CTSM_INCLUDES = $(ESMF_F90COMPILEPATHS) -I$(SHR_INC) -I$(CTSM_INC) CTSM_LIBS = $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) $(LIBS) """.format(exeroot=exeroot, esmfmkfile=esmfmkfile)) diff --git a/lilac/atm_driver/ctsm.mk b/lilac/atm_driver/ctsm.mk index e344fcfd26..c094f1b6a0 100644 --- a/lilac/atm_driver/ctsm.mk +++ b/lilac/atm_driver/ctsm.mk @@ -18,10 +18,11 @@ SHARED_BLD_DIR = $(BLDDIR)/intel/mpt/debug/nothreads/nuopc CTSM_BLD_DIR = $(SHARED_BLD_DIR)/nuopc/esmf DEPENDS_LIB = $(SHARED_BLD_DIR)/lib SHR_LIB = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/lib +SHR_INC = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/csm_share CTSM_INC = $(CTSM_BLD_DIR)/clm/obj LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib -CTSM_INCLUDES = $(ESMF_F90COMPILEPATHS) -I$(CTSM_INC) +CTSM_INCLUDES = $(ESMF_F90COMPILEPATHS) -I$(SHR_INC) -I$(CTSM_INC) CTSM_LIBS = $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) $(LIBS) From adce16aea1d66d1111b1d5d0a8e98d2e7e7c31ba Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 11 Dec 2019 15:35:11 -0700 Subject: [PATCH 236/556] Use the auto-generated ctsm.mk file in the atm_driver build And delete the original one in the source tree --- README.lilac | 42 +++++++++++++++++++++++++++++++++------ lilac/atm_driver/Makefile | 9 +++++---- lilac/atm_driver/ctsm.mk | 28 -------------------------- 3 files changed, 41 insertions(+), 38 deletions(-) delete mode 100644 lilac/atm_driver/ctsm.mk diff --git a/README.lilac b/README.lilac index 59da475bc8..cf12106e85 100644 --- a/README.lilac +++ b/README.lilac @@ -1,3 +1,7 @@ +======================================================================== +I. Building a CTSM / LILAC library for inclusion in an atmosphere model +======================================================================== + 1) check out the code (ctsm and lilac are now bundled together) and built as one library > git clone https://github.com/ESCOMP/ctsm.git @@ -10,7 +14,6 @@ > export LILAC_MODE='on' > export SRCROOT=`pwd` > export CASEDIR=/glade/scratch/mvertens/test_lilac - > export BLDDIR=$CASEDIR/bld 3) build the ctsm/lilac library using a CIME case @@ -21,14 +24,22 @@ > ./case.setup > ./case.build --sharedlib-only -4) To build the atm_driver executable on cheyenne +======================================================================== +II. Building and running the test atmosphere driver +======================================================================== + +After following the above instructions for building a CTSM / LILAC +library (I), do the following: + +1) To build the atm_driver executable on cheyenne (***CTSM_MKFILE IS CRITICAL for the operation of the atm_driver makefile) + > export CTSM_MKFILE=$CASEDIR/bld/ctsm.mk > cd $SRCROOT/lilac/atm_driver > make clean > source $CASEDIR/.env_mach_specific.sh > make atm_driver -5) to generate the input namelists +2) to generate the input namelists - to customize the generated namelist - edit the file ctsm.cfg (in this directory) - to create the ctsm namelist FROM THIS DIRECTORY: @@ -39,11 +50,11 @@ THIS ONLY NEEDS TO BE DONE ONCE to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory -6) run the atm_driver on cheyenne +3) run the atm_driver on cheyenne > qsub cheyenne.sub -7) compare with latest baselines +4) compare with latest baselines use something like this to compare the last clm and last cpl hist files: @@ -51,8 +62,27 @@ > cprnc test_lilac.clm2.h0.2000-01-02-00000.nc $basedir/test_lilac.clm2.h0.2000-01-02-00000.nc | tail -30 > cprnc test_lilac.cpl.hi.2000-01-02-00000.nc $basedir/test_lilac.cpl.hi.2000-01-02-00000.nc | tail -30 -8) if there are differences, and those are intentional, then create new +5) if there are differences, and those are intentional, then create new baselines copy all *.nc files, plus ctsm.cfg, lilac_in and lnd_in to the baseline directory + +======================================================================== +III. Linking the CTSM / LILAC library into another atmosphere model +======================================================================== + +After following the above instructions for building a CTSM / LILAC +library (I), you should do the following, assuming that the atmosphere +model is built using a makefile: + +1) Set some environment variable (e.g., CTSM_MKFILE) to point to the + ctsm.mk file generated in CTSM's bld directory. + +2) Modify the atmosphere model's makefile to include the file given by + the environment variable $CTSM_MAKEFILE. + +3) In the compilation line for the atmosphere model, add + $(CTSM_INCLUDES) + +4) In the link line for the atmosphere model, add $(CTSM_LIBS) diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index 41840146cd..e586643f81 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -3,17 +3,18 @@ #================================================================================ #================================================================================ -# Note: You must set the environment BLDDIR before running this - e.g. -# export BLDDIR=/glade/scratch/sacks/test_lilac_1205a/bld +# Note: You must set the environment variable CTSM_MKFILE before running this - e.g. +# export CTSM_MKFILE=/glade/scratch/sacks/test_lilac_1205a/bld/ctsm.mk # # ESMFMKFILE must also be set in the environment #================================================================================ -include $(CURDIR)/ctsm.mk +include $(CTSM_MKFILE) # Most atmosphere model builds shouldn't need this directly, but we use # it here in order to easily get a f90 compiler and f90 compile opts for -# building atm_driver.o. +# building atm_driver.o. (This is a bit of a kludge that we should +# change later.) include $(ESMFMKFILE) FFLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free diff --git a/lilac/atm_driver/ctsm.mk b/lilac/atm_driver/ctsm.mk deleted file mode 100644 index c094f1b6a0..0000000000 --- a/lilac/atm_driver/ctsm.mk +++ /dev/null @@ -1,28 +0,0 @@ -# ====================================================================== -# Include this file to get makefile variables needed to include / link -# LILAC/CTSM in an atmosphere model's build -# -# Variables of interest are: -# - CTSM_INCLUDES: add this to the compilation line -# - CTSM_LIBS: add this to the link line -# -# Note: You must set the environment BLDDIR before running this - e.g. -# export BLDDIR=/glade/scratch/sacks/test_lilac_1205a/bld -# -# ESMFMKFILE must also be set in the environment -# ====================================================================== - -include $(ESMFMKFILE) - -SHARED_BLD_DIR = $(BLDDIR)/intel/mpt/debug/nothreads/nuopc -CTSM_BLD_DIR = $(SHARED_BLD_DIR)/nuopc/esmf -DEPENDS_LIB = $(SHARED_BLD_DIR)/lib -SHR_LIB = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/lib -SHR_INC = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/csm_share -CTSM_INC = $(CTSM_BLD_DIR)/clm/obj - -LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib - -CTSM_INCLUDES = $(ESMF_F90COMPILEPATHS) -I$(SHR_INC) -I$(CTSM_INC) - -CTSM_LIBS = $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) $(LIBS) From eb022120f58b58decf793cbb657a6815e1f6af80 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 16 Dec 2019 19:48:38 -0700 Subject: [PATCH 237/556] In ctsm.mk file, handle either debug or nodebug Previously, it only worked if built in DEBUG mode --- cime_config/buildlib | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/cime_config/buildlib b/cime_config/buildlib index 53b5a54434..eb08f06144 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -30,15 +30,24 @@ def _get_osvar(key, default): return value ############################################################################### -def _write_ctsm_mk(exeroot): +def _write_ctsm_mk(exeroot, debug): """Writes a ctsm.mk file in exeroot. This file can be included by atmosphere model builds outside of cime. NOTE: This currently has some hard-coded settings for cheyenne. Also, it assumes that ESMFMKFILE is set in your environment. + + Arguments: + exeroot (str): path to build directory + debug (str): TRUE if building in debug mode, FALSE otherwise """ + if debug.lower() == 'true': + debug_path = 'debug' + else: + debug_path = 'nodebug' + ctsm_mk_path = os.path.join(exeroot, 'ctsm.mk') esmfmkfile = os.environ['ESMFMKFILE'] with open(ctsm_mk_path, 'w') as ctsm_mk: @@ -59,7 +68,7 @@ def _write_ctsm_mk(exeroot): include {esmfmkfile} -SHARED_BLD_DIR = {exeroot}/intel/mpt/debug/nothreads/nuopc +SHARED_BLD_DIR = {exeroot}/intel/mpt/{debug_path}/nothreads/nuopc CTSM_BLD_DIR = $(SHARED_BLD_DIR)/nuopc/esmf DEPENDS_LIB = $(SHARED_BLD_DIR)/lib SHR_LIB = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/lib @@ -74,7 +83,7 @@ LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lp CTSM_INCLUDES = $(ESMF_F90COMPILEPATHS) -I$(SHR_INC) -I$(CTSM_INC) CTSM_LIBS = $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) $(LIBS) -""".format(exeroot=exeroot, esmfmkfile=esmfmkfile)) +""".format(esmfmkfile=esmfmkfile, exeroot=exeroot, debug_path=debug_path)) ############################################################################### def _main_func(): @@ -93,7 +102,8 @@ def _main_func(): lilac_mode = _get_osvar('LILAC_MODE', 'off') if lilac_mode == 'on': driver = "lilac" - _write_ctsm_mk(exeroot=case.get_value("EXEROOT")) + _write_ctsm_mk(exeroot=case.get_value("EXEROOT"), + debug=case.get_value("DEBUG")) #------------------------------------------------------- # create Filepath file From 8e03e4071d1dd3dcee5fc28c751d61b481654b3e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 16 Dec 2019 19:52:07 -0700 Subject: [PATCH 238/556] Apparently the case's DEBUG is a logical, not a string --- cime_config/buildlib | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/buildlib b/cime_config/buildlib index eb08f06144..1cc10f0bc5 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -40,10 +40,10 @@ def _write_ctsm_mk(exeroot, debug): Arguments: exeroot (str): path to build directory - debug (str): TRUE if building in debug mode, FALSE otherwise + debug (logical): True if building in debug mode, False otherwise """ - if debug.lower() == 'true': + if debug: debug_path = 'debug' else: debug_path = 'nodebug' From 7fea397a2dfbaa8d7359370eff4454e43e8a6af0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 16 Dec 2019 20:02:07 -0700 Subject: [PATCH 239/556] In LILAC buildnml, handle gridmask of null/UNSET --- lilac_config/buildnml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index d808edefa8..4fefdaaf9d 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -204,7 +204,6 @@ def buildnml(rundir, bldnmldir): '-namelist', '\'&clm_inparm start_ymd={} {}/\''.format(start_ymd, clm_namelist_opts), '-use_case',use_case, '-res', lnd_grid, - '-mask',gridmask, '-clm_start_type', start_type, '-l_ncpl', str(1), # this will not be used in lilac - but is needed as input '-configuration', configuration, @@ -218,6 +217,8 @@ def buildnml(rundir, bldnmldir): '-config',os.path.join(rundir, "config_cache.xml"), '-envxml_dir', rundir, clm_bldnml_opts] + if gridmask != 'null' and gridmask != 'UNSET': + command.extend(['-mask', gridmask]) cmd = ' '.join(command) rc, out, err = run_cmd(cmd, from_dir=os.getcwd()) From efdca62b7a597ba079c28a5d53a97d2359bb0ea5 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 16 Dec 2019 20:25:30 -0700 Subject: [PATCH 240/556] lons and lats need to be real, not integer --- lilac/src/lilac_atmcap.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index 1b915911aa..e2939a3921 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -30,8 +30,8 @@ module lilac_atmcap ! Time invariant input from host atmosphere integer, public, allocatable :: gindex_atm(:) ! global index space - integer, public, allocatable :: atm_lons(:) ! local longitudes - integer, public, allocatable :: atm_lats(:) ! local latitudes + real , public, allocatable :: atm_lons(:) ! local longitudes + real , public, allocatable :: atm_lats(:) ! local latitudes integer, public :: atm_global_nx integer, public :: atm_global_ny From 5a30e176960f8dbd5d0da45d5333637f2dba89d8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 16 Dec 2019 20:36:04 -0700 Subject: [PATCH 241/556] Send un-rounded lats and lons to lilac We want rounded lats and lons for the generation of fake data, but not for the values sent from the atm driver to lilac. --- lilac/atm_driver/atm_driver.F90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 8aaa2985a2..ab6d43971f 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -149,9 +149,7 @@ program atm_driver do i = 1,nlocal i_global = atm_global_index(i) atm_lons(i) = centerCoords(1,i_global) - atm_lons(i) = real(nint(atm_lons(i))) ! rounding to nearest int atm_lats(i) = centerCoords(2,i_global) - atm_lats(i) = real(nint(atm_lats(i))) ! rounding to nearest int end do !------------------------------------------------------------------------ @@ -337,6 +335,8 @@ subroutine atm_driver_to_lilac (lon, lat) real, intent(in) :: lat(:) ! local variables + real, allocatable :: lon_rounded(:) + real, allocatable :: lat_rounded(:) integer :: lsize real*8, allocatable :: data(:) integer :: i @@ -344,8 +344,15 @@ subroutine atm_driver_to_lilac (lon, lat) ! -------------------------------------------------------- lsize = size(lon) + allocate(lon_rounded(lsize)) + allocate(lat_rounded(lsize)) allocate(data(lsize)) + do i = 1, lsize + lon_rounded(i) = real(nint(lon(i))) + lat_rounded(i) = real(nint(lat(i))) + end do + data(:) = 30.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 call lilac_atmcap_atm2lnd('Sa_z', data) From 324a209cdf1bb34f210031dfe8fac01fd97d3a4c Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 17 Dec 2019 11:37:02 -0700 Subject: [PATCH 242/556] In LILAC atm driver, call mpi_finalize --- lilac/atm_driver/atm_driver.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index ab6d43971f..7ed7c9f4c5 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -252,6 +252,8 @@ program atm_driver print *, "=======================================" end if + call MPI_finalize(ierr) + !======================================================= contains !======================================================= From 62b27442209a079eba675d9680cc69d802f804ab Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 17 Dec 2019 12:37:39 -0700 Subject: [PATCH 243/556] In LILAC's ESMF_Finalize, keep mpi alive Rocky Dunlap suggested this: We want to keep mpi alive so that the atmosphere can do any finalization it needs. --- lilac/src/lilac_mod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 0a5dd3c2c3..aab27201d7 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -685,8 +685,9 @@ subroutine lilac_final( ) write(logunit,*) "end of Lilac Finalization routine" end if - ! Finalize ESMF - call ESMF_Finalize ( ) + ! Finalize ESMF; keep mpi alive so that atmosphere can do any finalization needed + ! before it calls MPI_Finalize + call ESMF_Finalize (endflag=ESMF_END_KEEPMPI) end subroutine lilac_final From 529892089535a5c435da979bc1468b45c4499c9a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 17 Dec 2019 13:47:43 -0700 Subject: [PATCH 244/556] Only destroy rof esmf objects if they were actually created --- lilac/src/lilac_mod.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index aab27201d7..6d89080d72 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -658,10 +658,13 @@ subroutine lilac_final( ) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_StateDestroy(cpl2lnd_state, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateDestroy(rof2cpl_state, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_StateDestroy(cpl2rof_state, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + if (couple_to_river) then + call ESMF_StateDestroy(rof2cpl_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(cpl2rof_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end if call ESMF_LogWrite(subname//"destroying all components ", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -672,8 +675,11 @@ subroutine lilac_final( ) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_GridCompDestroy(lnd_gcomp, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) - call ESMF_GridCompDestroy(rof_gcomp, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + if (couple_to_river) then + call ESMF_GridCompDestroy(rof_gcomp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end if call ESMF_CplCompDestroy(cpl_atm2lnd_comp, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) From 13edb59504ee8b813e16729efccbaf89fff02788 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 18 Dec 2019 13:15:21 -0700 Subject: [PATCH 245/556] Add lnd_modelio.nml file This is needed in order to set various pio parameters I took these settings from a recent I compset case --- lilac/atm_driver/lnd_modelio.nml | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 lilac/atm_driver/lnd_modelio.nml diff --git a/lilac/atm_driver/lnd_modelio.nml b/lilac/atm_driver/lnd_modelio.nml new file mode 100644 index 0000000000..0032f9135b --- /dev/null +++ b/lilac/atm_driver/lnd_modelio.nml @@ -0,0 +1,8 @@ +&pio_inparm + pio_netcdf_format = "64bit_offset" + pio_numiotasks = -99 + pio_rearranger = 1 + pio_root = 1 + pio_stride = 36 + pio_typename = "pnetcdf" +/ From b16be4719e74baf470683346dd67a0b91886dfba Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 18 Dec 2019 16:13:18 -0700 Subject: [PATCH 246/556] Add to README.lilac --- README.lilac | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/README.lilac b/README.lilac index cf12106e85..48dca4184b 100644 --- a/README.lilac +++ b/README.lilac @@ -46,7 +46,7 @@ library (I), do the following: > $SRCROOT/lilac_config/buildnml - - this will now create the files lnd_in, drv_flds_in, and clm.input_data_list in this directory + - this will now create the files lnd_in and clm.input_data_list in this directory THIS ONLY NEEDS TO BE DONE ONCE to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory @@ -86,3 +86,22 @@ model is built using a makefile: $(CTSM_INCLUDES) 4) In the link line for the atmosphere model, add $(CTSM_LIBS) + +======================================================================== +IV. Running CTSM / LILAC from another atmosphere model +======================================================================== + +After (III), the following steps are needed to stage the inputs needed +for running the atmosphere model + +1) Generate the input namelists following the instructions given in part + (II). + +2) Copy the following files from $SRCROOT/lilac/atm_driver into the + directory from which the atmosphere model will be run: + + - lilac_in + - lnd_in + - lnd_modelio.nml + +3) Run the atmosphere model From b3ffed5c529a07073d465aa5fe824a102d614b14 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 27 Dec 2019 16:38:05 -0700 Subject: [PATCH 247/556] Minor tweak to README.lilac --- README.lilac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.lilac b/README.lilac index 48dca4184b..3f30846745 100644 --- a/README.lilac +++ b/README.lilac @@ -13,7 +13,7 @@ I. Building a CTSM / LILAC library for inclusion in an atmosphere model > export LILAC_MODE='on' > export SRCROOT=`pwd` - > export CASEDIR=/glade/scratch/mvertens/test_lilac + > export CASEDIR=/glade/scratch/$USER/test_lilac 3) build the ctsm/lilac library using a CIME case From dff78064da7491b2e81fa6e7b7be649fe58c1a84 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 30 Dec 2019 14:27:39 -0700 Subject: [PATCH 248/556] Update files used in lilac baseline comparisons --- README.lilac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.lilac b/README.lilac index 3f30846745..95f464c0fb 100644 --- a/README.lilac +++ b/README.lilac @@ -59,8 +59,8 @@ library (I), do the following: use something like this to compare the last clm and last cpl hist files: > basedir=/glade/p/cgd/tss/ctsm_baselines/lilac_20191202 - > cprnc test_lilac.clm2.h0.2000-01-02-00000.nc $basedir/test_lilac.clm2.h0.2000-01-02-00000.nc | tail -30 - > cprnc test_lilac.cpl.hi.2000-01-02-00000.nc $basedir/test_lilac.cpl.hi.2000-01-02-00000.nc | tail -30 + > cprnc test_lilac.clm2.h0.2000-01-03-00000.nc $basedir/test_lilac.clm2.h0.2000-01-03-00000.nc | tail -30 + > cprnc test_lilac.lilac.hi.2000-01-02-81000.nc $basedir/test_lilac.lilac.hi.2000-01-02-81000.nc | tail -30 5) if there are differences, and those are intentional, then create new baselines From 27c938b0fe3a23df8bb499f8d45483f0e59e0c16 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 2 Jan 2020 14:17:17 -0700 Subject: [PATCH 249/556] Fix units in comment Note this in lnd2atmMod: do g = bounds%begg,bounds%endg bulk_or_tracer%waterlnd2atm_inst%h2osno_grc(g) = & bulk_or_tracer%waterlnd2atm_inst%h2osno_grc(g)/1000._r8 end do --- src/biogeophys/Waterlnd2atmType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/Waterlnd2atmType.F90 b/src/biogeophys/Waterlnd2atmType.F90 index fdef91695c..ed6e9ca0dd 100644 --- a/src/biogeophys/Waterlnd2atmType.F90 +++ b/src/biogeophys/Waterlnd2atmType.F90 @@ -25,7 +25,7 @@ module Waterlnd2atmType class(water_info_base_type), pointer :: info real(r8), pointer :: q_ref2m_grc (:) ! 2m surface specific humidity (kg/kg) - real(r8), pointer :: h2osno_grc (:) ! snow water (mm H2O) + real(r8), pointer :: h2osno_grc (:) ! snow water (m H2O) real(r8), pointer :: qflx_evap_tot_grc (:) ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg real(r8), pointer :: qflx_rofliq_grc (:) ! rof liq forcing real(r8), pointer :: qflx_rofliq_qsur_grc (:) ! rof liq -- surface runoff component From d1f8a1d31c7ede7489b247190e839987c6037a85 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 25 Jan 2020 11:26:56 -0700 Subject: [PATCH 250/556] Calculate gridcell-level momentum roughness length This can be sent to atmosphere models that want it --- src/biogeophys/FrictionVelocityMod.F90 | 69 ++++++++++++++++++++++++++ src/main/clm_driver.F90 | 14 ++++++ src/main/lnd2atmMod.F90 | 5 ++ src/main/lnd2atmType.F90 | 2 + 4 files changed, 90 insertions(+) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 0416a9e053..19af9c9343 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -55,6 +55,7 @@ module FrictionVelocityMod real(r8), pointer, public :: z0mg_col (:) ! col roughness length over ground, momentum [m] real(r8), pointer, public :: z0hg_col (:) ! col roughness length over ground, sensible heat [m] real(r8), pointer, public :: z0qg_col (:) ! col roughness length over ground, latent heat [m] + real(r8), pointer, public :: z0m_actual_patch (:) ! patch roughness length actually used in flux calculations, momentum [m] contains @@ -62,6 +63,7 @@ module FrictionVelocityMod procedure, public :: Init procedure, public :: Restart procedure, public :: SetRoughnessLengthsAndForcHeightsNonLake ! Set roughness lengths and forcing heights for non-lake points + procedure, public :: SetActualRoughnessLengths ! Set roughness lengths actually used in flux calculations procedure, public :: FrictionVelocity ! Calculate friction velocity procedure, public :: MoninObukIni ! Initialization of the Monin-Obukhov length @@ -136,6 +138,7 @@ subroutine InitAllocate(this, bounds) allocate(this%z0mg_col (begc:endc)) ; this%z0mg_col (:) = nan allocate(this%z0qg_col (begc:endc)) ; this%z0qg_col (:) = nan allocate(this%z0hg_col (begc:endc)) ; this%z0hg_col (:) = nan + allocate(this%z0m_actual_patch (begp:endp)) ; this%z0m_actual_patch (:) = nan end subroutine InitAllocate @@ -493,6 +496,72 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & end subroutine SetRoughnessLengthsAndForcHeightsNonLake + !----------------------------------------------------------------------- + subroutine SetActualRoughnessLengths(this, bounds, & + num_exposedvegp, filter_exposedvegp, & + num_noexposedvegp, filter_noexposedvegp, & + num_urbanp, filter_urbanp, & + num_lakep, filter_lakep) + ! + ! !DESCRIPTION: + ! Set roughness lengths actually used in flux calculations + ! + ! !ARGUMENTS: + class(frictionvel_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + integer , intent(in) :: num_noexposedvegp ! number of points in filter_noexposedvegp + integer , intent(in) :: filter_noexposedvegp(:) ! patch filter where frac_veg_nosno is 0 (but does NOT include lake or urban) + integer , intent(in) :: num_urbanp ! number of points in filter_urbanp + integer , intent(in) :: filter_urbanp(:) ! patch filter for urban + integer , intent(in) :: num_lakep ! number of points in filter_lakep + integer , intent(in) :: filter_lakep(:) ! patch filter for lake + ! + ! !LOCAL VARIABLES: + integer :: fp, p, c, l + + character(len=*), parameter :: subname = 'SetActualRoughnessLengths' + !----------------------------------------------------------------------- + + associate( & + z_0_town => lun%z_0_town , & ! Input: [real(r8) (:)] momentum roughness length of urban landunit [m] + + z0mv => this%z0mv_patch , & ! Input: [real(r8) (:)] roughness length over vegetation, momentum [m] + z0mg => this%z0mg_col , & ! Input: [real(r8) (:)] roughness length over ground, momentum [m] + z0m_actual => this%z0m_actual_patch & ! Output: [real(r8) (:)] roughness length actually used in flux calculations, momentum [m] + ) + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + + z0m_actual(p) = z0mv(p) + end do + + do fp = 1, num_noexposedvegp + p = filter_noexposedvegp(fp) + c = patch%column(p) + + z0m_actual(p) = z0mg(c) + end do + + do fp = 1, num_urbanp + p = filter_urbanp(fp) + l = patch%landunit(p) + + z0m_actual(p) = z_0_town(l) + end do + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = patch%column(p) + + z0m_actual(p) = z0mg(c) + end do + + end associate + end subroutine SetActualRoughnessLengths + !------------------------------------------------------------------------------ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & displa, z0m, z0h, z0q, & diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index f931d3ee40..e6f51fc2a1 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -575,6 +575,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! Determine fluxes ! ============================================================================ + call t_startf('bgp_fluxes') call t_startf('bgflux') ! Bareground fluxes for all patches except lakes and urban landunits @@ -657,6 +658,19 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro humanindex_inst) call t_stopf('bgplake') + call frictionvel_inst%SetActualRoughnessLengths( & + bounds = bounds_clump, & + num_exposedvegp = filter(nc)%num_exposedvegp, & + filter_exposedvegp = filter(nc)%exposedvegp, & + num_noexposedvegp = filter(nc)%num_noexposedvegp, & + filter_noexposedvegp = filter(nc)%noexposedvegp, & + num_urbanp = filter(nc)%num_urbanp, & + filter_urbanp = filter(nc)%urbanp, & + num_lakep = filter(nc)%num_lakep, & + filter_lakep = filter(nc)%lakep) + + call t_stopf('bgp_fluxes') + if (irrigate) then ! ============================================================================ diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90 index acb0f5cfff..658f5e6286 100644 --- a/src/main/lnd2atmMod.F90 +++ b/src/main/lnd2atmMod.F90 @@ -240,6 +240,11 @@ subroutine lnd2atm(bounds, & lnd2atm_inst%fsa_grc (bounds%begg:bounds%endg), & p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + call p2g(bounds, & + frictionvel_inst%z0m_actual_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%z0m_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'urbans', l2g_scale_type='unity') + call p2g(bounds, & frictionvel_inst%fv_patch (bounds%begp:bounds%endp), & lnd2atm_inst%fv_grc (bounds%begg:bounds%endg), & diff --git a/src/main/lnd2atmType.F90 b/src/main/lnd2atmType.F90 index 509a8afaf2..48a65c77aa 100644 --- a/src/main/lnd2atmType.F90 +++ b/src/main/lnd2atmType.F90 @@ -47,6 +47,7 @@ module lnd2atmType real(r8), pointer :: eflx_sh_ice_to_liq_col(:) => null() ! sensible HF generated from conversion of ice runoff to liquid (W/m**2) [+ to atm] real(r8), pointer :: eflx_lwrad_out_grc (:) => null() ! IR (longwave) radiation (W/m**2) real(r8), pointer :: fsa_grc (:) => null() ! solar rad absorbed (total) (W/m**2) + real(r8), pointer :: z0m_grc (:) => null() ! roughness length, momentum (m) real(r8), pointer :: net_carbon_exchange_grc(:) => null() ! net CO2 flux (kg CO2/m**2/s) [+ to atm] real(r8), pointer :: nem_grc (:) => null() ! gridcell average net methane correction to CO2 flux (g C/m^2/s) real(r8), pointer :: ram1_grc (:) => null() ! aerodynamical resistance (s/m) @@ -145,6 +146,7 @@ subroutine InitAllocate(this, bounds) allocate(this%eflx_sh_ice_to_liq_col(begc:endc)) ; this%eflx_sh_ice_to_liq_col(:) = ival allocate(this%eflx_lh_tot_grc (begg:endg)) ; this%eflx_lh_tot_grc (:) =ival allocate(this%fsa_grc (begg:endg)) ; this%fsa_grc (:) =ival + allocate(this%z0m_grc (begg:endg)) ; this%z0m_grc (:) =ival allocate(this%net_carbon_exchange_grc(begg:endg)) ; this%net_carbon_exchange_grc(:) =ival allocate(this%nem_grc (begg:endg)) ; this%nem_grc (:) =ival allocate(this%ram1_grc (begg:endg)) ; this%ram1_grc (:) =ival From 6665f3e760026175f497d21708fd2fc1b7ab8abd Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 27 Jan 2020 11:41:44 -0700 Subject: [PATCH 251/556] Add Sl_z0m export field in lilac coupling --- lilac/src/lilac_atmcap.F90 | 1 + src/cpl/lilac/lnd_import_export.F90 | 4 ++++ 2 files changed, 5 insertions(+) diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index e2939a3921..eb7aaba40e 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -143,6 +143,7 @@ subroutine lilac_atmcap_init_vars(atm_gindex_in, atm_lons_in, atm_lats_in, atm_g call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_u10' , units='unknown', lsize=lsize) call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_fv' , units='unknown', lsize=lsize) call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_ram1' , units='unknown', lsize=lsize) + call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_z0m' , units='m' , lsize=lsize) call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_taux' , units='unknown', lsize=lsize) call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_tauy' , units='unknown', lsize=lsize) call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_lat' , units='unknown', lsize=lsize) diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 9768b6dc25..9fc41fc296 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -448,6 +448,10 @@ subroutine export_fields(exportState, bounds, rc) input=lnd2atm_inst%fv_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_z0m', bounds, & + input=lnd2atm_inst%z0m_grc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! methanem ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_methane', bounds, & ! input=lnd2atm_inst%flux_ch4_grc, minus=.true., rc=rc) From 10297afcbb83fa3695468f6f700957c0f9f3d6ec Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 27 Jan 2020 11:51:58 -0700 Subject: [PATCH 252/556] Add a default-inactive history variable for lnd2atm%z0m_grc --- src/main/lnd2atmType.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/main/lnd2atmType.F90 b/src/main/lnd2atmType.F90 index 48a65c77aa..512ab41ec7 100644 --- a/src/main/lnd2atmType.F90 +++ b/src/main/lnd2atmType.F90 @@ -270,6 +270,14 @@ subroutine InitHistory(this, bounds) ptr_lnd=this%net_carbon_exchange_grc, & default='inactive') + ! No need to set this to spval (or 0) because it is a gridcell-level field, so should + ! have valid values everywhere + call hist_addfld1d(fname='Z0M_TO_COUPLER', units='m', & + avgflag='A', & + long_name='roughness length, momentum: gridcell average sent to coupler', & + ptr_lnd=this%z0m_grc, & + default='inactive') + if (use_lch4) then this%flux_ch4_grc(begg:endg) = 0._r8 call hist_addfld1d (fname='FCH4', units='kgC/m2/s', & From 0779ae0405ffd37bd6ecae94bfadb66064174de4 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 28 Jan 2020 13:41:42 -0700 Subject: [PATCH 253/556] Change atm_lats and atm_lons to double precision --- lilac/atm_driver/atm_driver.F90 | 6 +++--- lilac/src/lilac_atmcap.F90 | 14 +++++++------- lilac/src/lilac_mod.F90 | 5 +++-- 3 files changed, 13 insertions(+), 12 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 7ed7c9f4c5..09239c05ed 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -29,7 +29,7 @@ program atm_driver integer :: comp_comm integer :: ierr real , allocatable :: centerCoords(:,:) - real , allocatable :: atm_lons(:), atm_lats(:) + real*8 , allocatable :: atm_lons(:), atm_lats(:) integer , allocatable :: atm_global_index(:) integer :: mytask, ntasks integer :: my_start, my_end @@ -333,8 +333,8 @@ end subroutine nc_check_err subroutine atm_driver_to_lilac (lon, lat) ! input/output variables - real, intent(in) :: lon(:) - real, intent(in) :: lat(:) + real*8, intent(in) :: lon(:) + real*8, intent(in) :: lat(:) ! local variables real, allocatable :: lon_rounded(:) diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index eb7aaba40e..2c0f756592 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -29,11 +29,11 @@ module lilac_atmcap private :: lilac_atmcap_add_fld ! Time invariant input from host atmosphere - integer, public, allocatable :: gindex_atm(:) ! global index space - real , public, allocatable :: atm_lons(:) ! local longitudes - real , public, allocatable :: atm_lats(:) ! local latitudes - integer, public :: atm_global_nx - integer, public :: atm_global_ny + integer , public, allocatable :: gindex_atm(:) ! global index space + real(r8), public, allocatable :: atm_lons(:) ! local longitudes + real(r8), public, allocatable :: atm_lats(:) ! local latitudes + integer , public :: atm_global_nx + integer , public :: atm_global_ny ! Time variant input from host atmosphere real(r8) :: nextsw_cday = 1.e36_r8 ! calendar day of the next sw calculation @@ -61,8 +61,8 @@ subroutine lilac_atmcap_init_vars(atm_gindex_in, atm_lons_in, atm_lats_in, atm_g ! input/output variables integer , intent(in) :: atm_gindex_in(:) - real , intent(in) :: atm_lons_in(:) - real , intent(in) :: atm_lats_in(:) + real(r8), intent(in) :: atm_lons_in(:) + real(r8), intent(in) :: atm_lats_in(:) integer , intent(in) :: atm_global_nx_in integer , intent(in) :: atm_global_ny_in diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 6d89080d72..620a06f18e 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -13,6 +13,7 @@ module lilac_mod ! shr code routines use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 use shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8 => shr_kind_r8 ! lilac routines use lilac_io , only : lilac_io_init @@ -91,8 +92,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & ! input/output variables integer , intent(inout) :: mpicom ! input commiunicator from atm integer , intent(in) :: atm_global_index(:) - real , intent(in) :: atm_lons(:) - real , intent(in) :: atm_lats(:) + real(r8) , intent(in) :: atm_lons(:) + real(r8) , intent(in) :: atm_lats(:) integer , intent(in) :: atm_global_nx integer , intent(in) :: atm_global_ny character(len=*) , intent(in) :: atm_calendar From ed6b4b520ec1951256dcf25f3016d5612502f81b Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 29 Jan 2020 06:08:33 -0700 Subject: [PATCH 254/556] Fix typo regarding stop alarm --- lilac/src/lilac_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 620a06f18e..5bf23dbb1a 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -489,8 +489,8 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) ! Set the clock stop alarm if stop_alarm_ringing is true if (stop_alarm_is_ringing) then - call ESMF_ClockGetAlarm(lilac_clock, 'lilac_restart_alarm', lilac_stop_alarm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_restart_alarm") + call ESMF_ClockGetAlarm(lilac_clock, 'lilac_stop_alarm', lilac_stop_alarm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_stop_alarm") call ESMF_AlarmRingerOn(lilac_stop_alarm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") call ESMF_LogWrite(subname//"lilac stop alarm is ringing", ESMF_LOGMSG_INFO) From adcb690265cc501b72840b520b7c4cacb37d4ec1 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 29 Jan 2020 14:14:05 -0700 Subject: [PATCH 255/556] Remove some unused code from the time manager The point of this removal is to facilitate removing stop time from the time manager. So I have removed some unused routines related to stop time. I have also removed the unused get_clock because I want to prevent anyone from trying to get the clock and then trying to get the soon-to-be-non-existent stop time out of the clock. --- src/main/histFileMod.F90 | 3 -- src/main/restFileMod.F90 | 3 -- src/utils/clm_time_manager.F90 | 89 ---------------------------------- 3 files changed, 95 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 23690ad51f..849d2f43df 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -5199,9 +5199,6 @@ subroutine hist_do_disp (ntapes, hist_ntimes, hist_mfilt, if_stop, if_disphist, ! Remove history files unless this is end of run or ! history file is not full. ! - ! !USES: - use clm_time_manager, only : is_last_step - ! ! !ARGUMENTS: integer, intent(in) :: ntapes !actual number of history tapes integer, intent(in) :: hist_ntimes(ntapes) !current numbers of time samples on history tape diff --git a/src/main/restFileMod.F90 b/src/main/restFileMod.F90 index 4f718b9228..91967c5ed3 100644 --- a/src/main/restFileMod.F90 +++ b/src/main/restFileMod.F90 @@ -361,9 +361,6 @@ subroutine restFile_closeRestart( file ) ! Close restart file and write restart pointer file if ! in write mode, otherwise just close restart file if in read mode ! - ! !USES: - use clm_time_manager, only : is_last_step - ! ! !ARGUMENTS: character(len=*) , intent(in) :: file ! local output filename ! diff --git a/src/utils/clm_time_manager.F90 b/src/utils/clm_time_manager.F90 index 889258fd06..599e73e0a3 100644 --- a/src/utils/clm_time_manager.F90 +++ b/src/utils/clm_time_manager.F90 @@ -21,7 +21,6 @@ module clm_time_manager timemgr_restart, &! restart the time manager using info from timemgr_restart timemgr_datediff, &! calculate difference between two time instants advance_timestep, &! increment timestep number - get_clock, &! get the clock from the time-manager get_curr_ESMF_Time, &! get current time in terms of the ESMF_Time get_step_size, &! return step size in seconds get_step_size_real, &! return step size in seconds, real-valued @@ -54,7 +53,6 @@ module clm_time_manager is_end_curr_month, &! return true on last timestep in current month is_beg_curr_year, &! return true on first timestep in current year is_end_curr_year, &! return true on last timestep in current year - is_last_step, &! return true on last timestep is_perpetual, &! return true if perpetual calendar is in use is_near_local_noon, &! return true if near local noon is_restart, &! return true if this is a restart run @@ -111,7 +109,6 @@ module clm_time_manager logical, save :: tm_first_restart_step = .false. ! true for first step of a restart or branch run logical, save :: tm_perp_calendar = .false. ! true when using perpetual calendar logical, save :: timemgr_set = .false. ! true when timemgr initialized - integer, save :: nestep = uninit_int ! ending time-step ! ! Next short-wave radiation calendar day ! @@ -126,7 +123,6 @@ module clm_time_manager private :: timemgr_spmdbcast private :: init_calendar private :: init_clock - private :: calc_nestep private :: timemgr_print private :: TimeGetymd private :: check_timemgr_initialized @@ -646,10 +642,6 @@ subroutine timemgr_restart( ) tm_first_restart_step = .true. - ! Calculate ending time step - - call calc_nestep( ) - ! Print configuration summary to log file (stdout). if (masterproc) call timemgr_print() @@ -660,33 +652,6 @@ end subroutine timemgr_restart !========================================================================================= - subroutine calc_nestep() - !--------------------------------------------------------------------------------- - ! - ! Calculate ending timestep number - ! Calculation of ending timestep number (nestep) assumes a constant stepsize. - ! - character(len=*), parameter :: sub = 'clm::calc_nestep' - integer :: ntspday ! Number of time-steps per day - type(ESMF_TimeInterval) :: diff ! - type(ESMF_Time) :: start_date ! start date for run - type(ESMF_Time) :: stop_date ! stop date for run - integer :: ndays, nsecs ! Number of days, seconds to ending time - integer :: rc ! return code - !--------------------------------------------------------------------------------- - - call ESMF_ClockGet( tm_clock, stopTime=stop_date, startTime=start_date, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_ClockGet') - ntspday = isecspday/dtime - diff = stop_date - start_date - call ESMF_TimeIntervalGet( diff, d=ndays, s=nsecs, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet calculating nestep') - nestep = ntspday*ndays + nsecs/dtime - if ( mod(nsecs,dtime) /= 0 ) nestep = nestep + 1 - end subroutine calc_nestep - - !========================================================================================= - subroutine init_calendar( ) !--------------------------------------------------------------------------------- @@ -781,7 +746,6 @@ subroutine timemgr_print() write(iulog,*)' Reference date (yr mon day tod): ', ref_yr, ref_mon, & ref_day, ref_tod write(iulog,*)' Current step number: ', nstep - write(iulog,*)' Ending step number: ', nestep write(iulog,*)' Current date (yr mon day tod): ', curr_yr, curr_mon, & curr_day, curr_tod @@ -814,30 +778,6 @@ end subroutine advance_timestep !========================================================================================= - subroutine get_clock( clock ) - - ! Return the ESMF clock - - type(ESMF_Clock), intent(inout) :: clock - - character(len=*), parameter :: sub = 'clm::get_clock' - type(ESMF_TimeInterval) :: step_size - type(ESMF_Time) :: start_date, stop_date, ref_date - integer :: rc - - if ( .not. check_timemgr_initialized(sub) ) return - - call ESMF_ClockGet( tm_clock, timeStep=step_size, startTime=start_date, & - stoptime=stop_date, reftime=ref_date, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_ClockGet') - call ESMF_ClockSet(clock, timeStep=step_size, startTime=start_date, & - stoptime=stop_date, reftime=ref_date, rc=rc) - call chkrc(rc, sub//': error return from ESMF_ClockSet') - - end subroutine get_clock - - !========================================================================================= - function get_curr_ESMF_Time( ) ! Return the current time as ESMF_Time @@ -1780,34 +1720,6 @@ end function is_first_step_of_this_run_segment !========================================================================================= - logical function is_last_step() - - !--------------------------------------------------------------------------------- - ! Return true on last timestep. - - ! Local variables - character(len=*), parameter :: sub = 'clm::is_last_step' - type(ESMF_Time) :: stop_date - type(ESMF_Time) :: curr_date - type(ESMF_TimeInterval) :: time_step - integer :: rc - !--------------------------------------------------------------------------------- - - if ( .not. check_timemgr_initialized(sub) ) return - - call ESMF_ClockGet( tm_clock, stopTime=stop_date, & - currTime=curr_date, TimeStep=time_step, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_ClockGet') - if ( curr_date+time_step > stop_date ) then - is_last_step = .true. - else - is_last_step = .false. - end if - - end function is_last_step - - !========================================================================================= - logical function is_perpetual() ! Return true on last timestep. @@ -2004,7 +1916,6 @@ subroutine timemgr_reset() tm_first_restart_step = .false. tm_perp_calendar = .false. timemgr_set = .false. - nestep = uninit_int nextsw_cday = uninit_r8 From 9ef8f2bceeb1b5e8dee9bdfe639fc7c7b683bf31 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 31 Jan 2020 15:25:24 -0700 Subject: [PATCH 256/556] Don't set a real stop time on CTSM's internal clock Stop time was being set but never used. For LILAC, it is awkward to require the stop time to be set in initialization. So I'm removing the need for it entirely. We instead set a dummy stop time far in the future. (If we were using the real ESMF time manager, we could avoid setting stopTime on the clock, but it appears that cime's ESMF time manager requires stopTime to be set.) Also remove unused get_timemgr_defaults. --- src/cpl/lilac/lnd_comp_esmf.F90 | 11 +- src/cpl/mct/lnd_comp_mct.F90 | 10 +- src/cpl/nuopc/lnd_comp_nuopc.F90 | 13 +-- src/utils/clm_time_manager.F90 | 191 ++++++------------------------- 4 files changed, 44 insertions(+), 181 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 92db721b38..36df5fba26 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -146,11 +146,8 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) integer :: ref_tod ! reference time of day (sec) integer :: start_ymd ! start date (YYYYMMDD) integer :: start_tod ! start time of day (sec) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) type(ESMF_Time) :: currTime ! Current time type(ESMF_Time) :: startTime ! Start time - type(ESMF_Time) :: stopTime ! Stop time type(ESMF_Time) :: refTime ! Ref time type(ESMF_TimeInterval) :: timeStep ! time step from lilac clock @@ -277,7 +274,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !---------------------- call ESMF_ClockGet( clock, & - currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, timeStep=timeStep, rc=rc) + currTime=currTime, startTime=startTime, refTime=RefTime, timeStep=timeStep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) @@ -288,10 +285,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,start_ymd) - call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,stop_ymd) - call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,ref_ymd) @@ -313,7 +306,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call set_timemgr_init( & calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & - ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, stop_ymd_in=stop_ymd, stop_tod_in=stop_tod) + ref_ymd_in=ref_ymd, ref_tod_in=ref_tod) !---------------------- ! Read namelist, grid and surface data diff --git a/src/cpl/mct/lnd_comp_mct.F90 b/src/cpl/mct/lnd_comp_mct.F90 index 8a8f86342b..eeacdcd89a 100644 --- a/src/cpl/mct/lnd_comp_mct.F90 +++ b/src/cpl/mct/lnd_comp_mct.F90 @@ -100,8 +100,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) integer :: ref_tod ! reference time of day (sec) integer :: start_ymd ! start date (YYYYMMDD) integer :: start_tod ! start time of day (sec) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type integer :: lbnum ! input to memory diagnostic integer :: shrlogunit,shrloglev ! old values for log unit and log level @@ -167,8 +165,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call seq_timemgr_EClockGetData(EClock, & start_ymd=start_ymd, & start_tod=start_tod, ref_ymd=ref_ymd, & - ref_tod=ref_tod, stop_ymd=stop_ymd, & - stop_tod=stop_tod, & + ref_tod=ref_tod, & calendar=calendar ) call seq_infodata_GetData(infodata, case_name=caseid, & case_desc=ctitle, single_column=single_column, & @@ -177,8 +174,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) start_type=starttype, model_version=version, & hostname=hostname, username=username ) call set_timemgr_init( calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & - ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, stop_ymd_in=stop_ymd, & - stop_tod_in=stop_tod) + ref_ymd_in=ref_ymd, ref_tod_in=ref_tod) if ( trim(starttype) == trim(seq_infodata_start_type_start)) then nsrest = nsrStartup else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then @@ -439,7 +435,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) end if call update_rad_dtime(doalb) - ! Determine if time to write cam restart and stop + ! Determine if time to write restart and stop rstwr = .false. if (rstwr_sync .and. dosend) rstwr = .true. diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index e5a1174868..df4919d10d 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -313,7 +313,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_DistGrid) :: DistGrid ! esmf global index space descriptor type(ESMF_Time) :: currTime ! Current time type(ESMF_Time) :: startTime ! Start time - type(ESMF_Time) :: stopTime ! Stop time type(ESMF_Time) :: refTime ! Ref time type(ESMF_TimeInterval) :: timeStep ! Model timestep type(ESMF_Calendar) :: esmf_calendar ! esmf calendar @@ -323,8 +322,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: yy,mm,dd ! Temporaries for time query integer :: start_ymd ! start date (YYYYMMDD) integer :: start_tod ! start time of day (sec) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) integer :: curr_ymd ! Start date (YYYYMMDD) integer :: curr_tod ! Start time of day (sec) integer :: dtime_sync ! coupling time-step from the input synchronization clock @@ -458,7 +455,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------- call ESMF_ClockGet( clock, & - currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, & + currTime=currTime, startTime=startTime, refTime=RefTime, & timeStep=timeStep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -470,10 +467,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,start_ymd) - call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,stop_ymd) - call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,ref_ymd) @@ -498,9 +491,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) start_ymd_in=start_ymd, & start_tod_in=start_tod, & ref_ymd_in=ref_ymd, & - ref_tod_in=ref_tod, & - stop_ymd_in=stop_ymd, & - stop_tod_in=stop_tod) + ref_tod_in=ref_tod) !---------------------- ! Read namelist, grid and surface data diff --git a/src/utils/clm_time_manager.F90 b/src/utils/clm_time_manager.F90 index 599e73e0a3..f4b69a2608 100644 --- a/src/utils/clm_time_manager.F90 +++ b/src/utils/clm_time_manager.F90 @@ -14,7 +14,6 @@ module clm_time_manager ! Public methods public ::& - get_timemgr_defaults, &! get startup default values set_timemgr_init, &! setup startup values timemgr_init, &! time manager initialization timemgr_restart_io, &! read/write time manager restart info and restart time manager @@ -76,6 +75,9 @@ module clm_time_manager integer, parameter :: uninit_int = -999999999 real(r8), parameter :: uninit_r8 = -999999999.0 + ! We'll use this really big year to effectively mean infinitely into the future. + integer, parameter :: really_big_year = 999999999 + ! Input integer, save ::& dtime = uninit_int, &! timestep in seconds @@ -84,11 +86,8 @@ module clm_time_manager ! Input from CESM driver integer, save ::& - nelapse = uninit_int, &! number of timesteps (or days if negative) to extend a run start_ymd = uninit_int, &! starting date for run in yearmmdd format start_tod = 0, &! starting time of day for run in seconds - stop_ymd = uninit_int, &! stopping date for run in yearmmdd format - stop_tod = 0, &! stopping time of day for run in seconds ref_ymd = uninit_int, &! reference date for time coordinate in yearmmdd format ref_tod = 0 ! reference time of day for time coordinate in seconds type(ESMF_Calendar), target, save :: tm_cal ! calendar @@ -131,57 +130,18 @@ module clm_time_manager contains !========================================================================================= - subroutine get_timemgr_defaults( calendar_out, start_ymd_out, start_tod_out, ref_ymd_out, & - ref_tod_out, stop_ymd_out, stop_tod_out, nelapse_out, & - dtime_out ) - - !--------------------------------------------------------------------------------- - ! get time manager startup default values - ! - ! Arguments - character(len=*), optional, intent(OUT) :: calendar_out ! Calendar type - integer , optional, intent(OUT) :: nelapse_out ! Number of step (or days) to advance - integer , optional, intent(OUT) :: start_ymd_out ! Start date (YYYYMMDD) - integer , optional, intent(OUT) :: start_tod_out ! Start time of day (sec) - integer , optional, intent(OUT) :: ref_ymd_out ! Reference date (YYYYMMDD) - integer , optional, intent(OUT) :: ref_tod_out ! Reference time of day (sec) - integer , optional, intent(OUT) :: stop_ymd_out ! Stop date (YYYYMMDD) - integer , optional, intent(OUT) :: stop_tod_out ! Stop time of day (sec) - integer , optional, intent(OUT) :: dtime_out ! Time-step (sec) - ! - character(len=*), parameter :: sub = 'clm::get_timemgr_defaults' - - if ( timemgr_set ) call shr_sys_abort( sub//":: timemgr_init or timemgr_restart already called" ) - if (present(calendar_out) ) calendar_out = trim(calendar) - if (present(start_ymd_out) ) start_ymd_out = start_ymd - if (present(start_tod_out) ) start_tod_out = start_tod - if (present(ref_ymd_out) ) ref_ymd_out = ref_ymd - if (present(ref_tod_out) ) ref_tod_out = ref_tod - if (present(stop_ymd_out) ) stop_ymd_out = stop_ymd - if (present(stop_tod_out) ) stop_tod_out = stop_tod - if (present(nelapse_out) ) nelapse_out = nelapse - if (present(dtime_out) ) dtime_out = dtime - - end subroutine get_timemgr_defaults - - !========================================================================================= - subroutine set_timemgr_init( calendar_in, start_ymd_in, start_tod_in, ref_ymd_in, & - ref_tod_in, stop_ymd_in, stop_tod_in, perpetual_run_in, & - perpetual_ymd_in, nelapse_in, dtime_in ) + ref_tod_in, perpetual_run_in, perpetual_ymd_in, dtime_in ) !--------------------------------------------------------------------------------- ! set time manager startup values ! ! Arguments character(len=*), optional, intent(IN) :: calendar_in ! Calendar type - integer , optional, intent(IN) :: nelapse_in ! Number of step (or days) to advance integer , optional, intent(IN) :: start_ymd_in ! Start date (YYYYMMDD) integer , optional, intent(IN) :: start_tod_in ! Start time of day (sec) integer , optional, intent(IN) :: ref_ymd_in ! Reference date (YYYYMMDD) integer , optional, intent(IN) :: ref_tod_in ! Reference time of day (sec) - integer , optional, intent(IN) :: stop_ymd_in ! Stop date (YYYYMMDD) - integer , optional, intent(IN) :: stop_tod_in ! Stop time of day (sec) logical , optional, intent(IN) :: perpetual_run_in ! If in perpetual mode or not integer , optional, intent(IN) :: perpetual_ymd_in ! Perpetual date (YYYYMMDD) integer , optional, intent(IN) :: dtime_in ! Time-step (sec) @@ -194,8 +154,6 @@ subroutine set_timemgr_init( calendar_in, start_ymd_in, start_tod_in, r if (present(start_tod_in) ) start_tod = start_tod_in if (present(ref_ymd_in) ) ref_ymd = ref_ymd_in if (present(ref_tod_in) ) ref_tod = ref_tod_in - if (present(stop_ymd_in) ) stop_ymd = stop_ymd_in - if (present(stop_tod_in) ) stop_tod = stop_tod_in if (present(perpetual_run_in) )then tm_perp_calendar = perpetual_run_in if ( tm_perp_calendar ) then @@ -204,7 +162,6 @@ subroutine set_timemgr_init( calendar_in, start_ymd_in, start_tod_in, r perpetual_ymd = perpetual_ymd_in end if end if - if (present(nelapse_in) ) nelapse = nelapse_in if (present(dtime_in) ) dtime = dtime_in end subroutine set_timemgr_init @@ -222,11 +179,8 @@ subroutine timemgr_init( ) integer :: rc ! return code integer :: yr, mon, day, tod ! Year, month, day, and second as integers type(ESMF_Time) :: start_date ! start date for run - type(ESMF_Time) :: stop_date ! stop date for run type(ESMF_Time) :: curr_date ! temporary date used in logic type(ESMF_Time) :: ref_date ! reference date for time coordinate - logical :: run_length_specified = .false. - type(ESMF_Time) :: current ! current date (from clock) type(ESMF_TimeInterval) :: day_step_size ! day step size type(ESMF_TimeInterval) :: step_size ! timestep size !--------------------------------------------------------------------------------- @@ -252,53 +206,12 @@ subroutine timemgr_init( ) curr_date = start_date - ! Initalize stop date. - - stop_date = TimeSetymd( 99991231, stop_tod, "stop_date" ) - call ESMF_TimeIntervalSet( step_size, s=dtime, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting step_size') call ESMF_TimeIntervalSet( day_step_size, d=1, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting day_step_size') - if ( stop_ymd /= uninit_int ) then - current = TimeSetymd( stop_ymd, stop_tod, "stop_date" ) - if ( current < stop_date ) stop_date = current - run_length_specified = .true. - end if - if ( nelapse /= uninit_int ) then - if ( nelapse >= 0 ) then - current = curr_date + step_size*nelapse - else - current = curr_date - day_step_size*nelapse - end if - if ( current < stop_date ) stop_date = current - run_length_specified = .true. - end if - if ( .not. run_length_specified ) then - call shr_sys_abort (sub//': Must specify stop_ymd or nelapse') - end if - - ! Error check - - if ( stop_date <= start_date ) then - write(iulog,*)sub, ': stop date must be specified later than start date: ' - call ESMF_TimeGet( start_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Start date (yr, mon, day, tod): ', yr, mon, day, tod - call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod - call shr_sys_abort - end if - if ( curr_date >= stop_date ) then - write(iulog,*)sub, ': stop date must be specified later than current date: ' - call ESMF_TimeGet( curr_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Current date (yr, mon, day, tod): ', yr, mon, day, tod - call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod - call shr_sys_abort - end if - ! Initalize reference date for time coordinate. if ( ref_ymd /= uninit_int ) then @@ -309,7 +222,7 @@ subroutine timemgr_init( ) ! Initialize clock - call init_clock( start_date, ref_date, curr_date, stop_date ) + call init_clock( start_date, ref_date, curr_date) ! Initialize date used for perpetual calendar day calculation. @@ -327,18 +240,17 @@ end subroutine timemgr_init !========================================================================================= - subroutine init_clock( start_date, ref_date, curr_date, stop_date ) + subroutine init_clock( start_date, ref_date, curr_date ) !--------------------------------------------------------------------------------- - ! Purpose: Initialize the clock based on the start_date, ref_date, and curr_date - ! as well as the settings from the namelist specifying the time to stop + ! Purpose: Initialize the clock based on the start_date, ref_date and curr_date ! type(ESMF_Time), intent(in) :: start_date ! start date for run type(ESMF_Time), intent(in) :: ref_date ! reference date for time coordinate type(ESMF_Time), intent(in) :: curr_date ! current date (equal to start_date) - type(ESMF_Time), intent(in) :: stop_date ! stop date for run ! character(len=*), parameter :: sub = 'clm::init_clock' + type(ESMF_Time) :: stop_date ! stop date for run type(ESMF_TimeInterval) :: step_size ! timestep size type(ESMF_Time) :: current ! current date (from clock) integer :: rc ! return code @@ -347,6 +259,33 @@ subroutine init_clock( start_date, ref_date, curr_date, stop_date ) call ESMF_TimeIntervalSet( step_size, s=dtime, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting step_size') + ! We don't use a stop time in the CTSM clock. Instead, we set the clock to + ! effectively have a stop time infinitely far into the future, and rely on other + ! mechanisms to tell CTSM when to stop. If we were always using the real ESMF + ! library, we could avoid setting the stopTime on the clock. But the ESMF time + ! manager included in cime appears to require stopTime. + call ESMF_TimeSet(stop_date, yy=really_big_year, mm=12, dd=31, s=0, & + calendar=tm_cal, rc=rc) + + ! Error check + + if ( stop_date <= start_date ) then + write(iulog,*)sub, ': Assumed stop date is earlier than start date: ' + call ESMF_TimeGet( start_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Start date (yr, mon, day, tod): ', yr, mon, day, tod + call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod + call shr_sys_abort + end if + if ( stop_date <= curr_date ) then + write(iulog,*)sub, ': Assumed stop date is earlier than current date: ' + call ESMF_TimeGet( curr_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Current date (yr, mon, day, tod): ', yr, mon, day, tod + call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) + write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod + call shr_sys_abort + end if + ! Initialize the clock tm_clock = ESMF_ClockCreate(name="CLM Time-manager clock", timeStep=step_size, startTime=start_date, & @@ -551,11 +490,8 @@ subroutine timemgr_restart( ) type(ESMF_Time) :: start_date ! start date for run type(ESMF_Time) :: ref_date ! reference date for run type(ESMF_Time) :: curr_date ! date of data in restart file - type(ESMF_Time) :: stop_date ! stop date for run - type(ESMF_Time) :: current ! current date (from clock) type(ESMF_TimeInterval) :: day_step_size ! day step size type(ESMF_TimeInterval) :: step_size ! timestep size - logical :: run_length_specified = .false. !--------------------------------------------------------------------------------- call timemgr_spmdbcast( ) @@ -575,52 +511,12 @@ subroutine timemgr_restart( ) curr_date = TimeSetymd( rst_curr_ymd, rst_curr_tod, "curr_date" ) - ! Initialize stop date from sync clock or namelist input - - stop_date = TimeSetymd( 99991231, stop_tod, "stop_date" ) - call ESMF_TimeIntervalSet( step_size, s=dtime, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting step_size') call ESMF_TimeIntervalSet( day_step_size, d=1, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet: setting day_step_size') - if ( stop_ymd /= uninit_int ) then - current = TimeSetymd( stop_ymd, stop_tod, "stop_date" ) - if ( current < stop_date ) stop_date = current - run_length_specified = .true. - else if ( nelapse /= uninit_int ) then - if ( nelapse >= 0 ) then - current = curr_date + step_size*nelapse - else - current = curr_date - day_step_size*nelapse - end if - if ( current < stop_date ) stop_date = current - run_length_specified = .true. - end if - if ( .not. run_length_specified ) then - call shr_sys_abort (sub//': Must specify stop_ymd or nelapse') - end if - - ! Error check - - if ( stop_date <= start_date ) then - write(iulog,*)sub, ': stop date must be specified later than start date: ' - call ESMF_TimeGet( start_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Start date (yr, mon, day, tod): ', yr, mon, day, tod - call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod - call shr_sys_abort - end if - if ( curr_date >= stop_date ) then - write(iulog,*)sub, ': stop date must be specified later than current date: ' - call ESMF_TimeGet( curr_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Current date (yr, mon, day, tod): ', yr, mon, day, tod - call ESMF_TimeGet( stop_date, yy=yr, mm=mon, dd=day, s=tod ) - write(iulog,*) ' Stop date (yr, mon, day, tod): ', yr, mon, day, tod - call shr_sys_abort - end if - ! Initialize nstep_rad_prev from restart info nstep_rad_prev = rst_nstep_rad_prev @@ -631,7 +527,7 @@ subroutine timemgr_restart( ) ! Initialize clock - call init_clock( start_date, ref_date, curr_date, stop_date ) + call init_clock( start_date, ref_date, curr_date) ! Advance the timestep. ! Data from the restart file corresponds to the last timestep of the previous run. @@ -693,10 +589,6 @@ subroutine timemgr_print() start_mon = uninit_int, &! start month start_day = uninit_int, &! start day of month start_tod = uninit_int, &! start time of day - stop_yr = uninit_int, &! stop year - stop_mon = uninit_int, &! stop month - stop_day = uninit_int, &! stop day of month - stop_tod = uninit_int, &! stop time of day ref_yr = uninit_int, &! reference year ref_mon = uninit_int, &! reference month ref_day = uninit_int, &! reference day of month @@ -707,14 +599,13 @@ subroutine timemgr_print() curr_tod = uninit_int ! current time of day integer(ESMF_KIND_I8) :: step_no type(ESMF_Time) :: start_date! start date for run - type(ESMF_Time) :: stop_date ! stop date for run type(ESMF_Time) :: curr_date ! date of data in restart file type(ESMF_Time) :: ref_date ! reference date type(ESMF_TimeInterval) :: step ! Time-step !--------------------------------------------------------------------------------- call ESMF_ClockGet( tm_clock, startTime=start_date, currTime=curr_date, & - refTime=ref_date, stopTime=stop_date, timeStep=step, & + refTime=ref_date, timeStep=step, & advanceCount=step_no, rc=rc ) call chkrc(rc, sub//': error return from ESMF_ClockGet') nstep = step_no @@ -727,9 +618,6 @@ subroutine timemgr_print() call ESMF_TimeGet( start_date, yy=start_yr, mm=start_mon, dd=start_day, & s=start_tod, rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeGet') - call ESMF_TimeGet( stop_date, yy=stop_yr, mm=stop_mon, dd=stop_day, & - s=stop_tod, rc=rc ) - call chkrc(rc, sub//': error return from ESMF_TimeGet') call ESMF_TimeGet( ref_date, yy=ref_yr, mm=ref_mon, dd=ref_day, s=ref_tod, & rc=rc ) call chkrc(rc, sub//': error return from ESMF_TimeGet') @@ -741,8 +629,6 @@ subroutine timemgr_print() write(iulog,*)' Timestep size (seconds): ', step_sec write(iulog,*)' Start date (yr mon day tod): ', start_yr, start_mon, & start_day, start_tod - write(iulog,*)' Stop date (yr mon day tod): ', stop_yr, stop_mon, & - stop_day, stop_tod write(iulog,*)' Reference date (yr mon day tod): ', ref_yr, ref_mon, & ref_day, ref_tod write(iulog,*)' Current step number: ', nstep @@ -1894,11 +1780,8 @@ subroutine timemgr_reset() dtime_rad = uninit_int nstep_rad_prev = uninit_int - nelapse = uninit_int start_ymd = uninit_int start_tod = 0 - stop_ymd = uninit_int - stop_tod = 0 ref_ymd = uninit_int ref_tod = 0 From 9410cf43796d19196bed144b239476c9714fd33f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 31 Jan 2020 15:49:35 -0700 Subject: [PATCH 257/556] Don't set stopTime on LILAC's clock Stopping will be determined via an argument to lilac_run. This allows us to avoid passing the atmosphere's stop time in lilac initialization, which could be awkward (and wasn't being used anyway). Also, rename arguments to lilac_run to avoid referencing the somewhat obscure alarm idea. --- lilac/atm_driver/atm_driver.F90 | 6 ++-- lilac/src/lilac_atmcap.F90 | 2 +- lilac/src/lilac_methods.F90 | 6 ---- lilac/src/lilac_mod.F90 | 23 ++++++---------- lilac/src/lilac_time.F90 | 49 ++++++++++++++++----------------- 5 files changed, 35 insertions(+), 51 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 09239c05ed..1e93269446 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -162,7 +162,7 @@ program atm_driver call lilac_init(comp_comm, atm_global_index, atm_lons, atm_lats, & atm_global_nx, atm_global_ny, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, atm_starttype) + atm_starttype) !------------------------------------------------------------------------ ! Run lilac @@ -234,9 +234,9 @@ program atm_driver call atm_driver_to_lilac (atm_lons, atm_lats) if (nstep == atm_nsteps) then - call lilac_run(restart_alarm_is_ringing=.true., stop_alarm_is_ringing=.true.) + call lilac_run(write_restarts_now=.true., stop_now=.true.) else - call lilac_run(restart_alarm_is_ringing=.false., stop_alarm_is_ringing=.false.) + call lilac_run(write_restarts_now=.false., stop_now=.false.) end if end do diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index 2c0f756592..88fd3e45aa 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -10,7 +10,7 @@ module lilac_atmcap ! call lilac_init() ! the host atm run phase will be ! call lilac_atm2lnd(fldname, data1d) - ! call lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) + ! call lilac_run(write_restarts_now, stop_now) ! call lilac_lnd2atm(fldname, data1d) !----------------------------------------------------------------------- diff --git a/lilac/src/lilac_methods.F90 b/lilac/src/lilac_methods.F90 index 7052a6a355..cdfff14c8b 100644 --- a/lilac/src/lilac_methods.F90 +++ b/lilac/src/lilac_methods.F90 @@ -1422,12 +1422,6 @@ subroutine lilac_methods_Clock_TimePrint(clock,string,rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(lstring)//": startime = "//trim(timestr), ESMF_LOGMSG_INFO) - call ESMF_ClockGet(clock,stoptime=time,rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(time,timestring=timestr,rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(lstring)//": stoptime = "//trim(timestr), ESMF_LOGMSG_INFO) - call ESMF_ClockGet(clock,timestep=timestep,rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalGet(timestep,timestring=timestr,rc=rc) diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 5bf23dbb1a..5b217f0298 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -83,7 +83,7 @@ module lilac_mod subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & atm_global_nx, atm_global_ny, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, starttype_in) + starttype_in) ! -------------------------------------------------------------------------------- ! This is called by the host atmosphere @@ -102,18 +102,12 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & integer , intent(in) :: atm_start_mon !(mm) integer , intent(in) :: atm_start_day integer , intent(in) :: atm_start_secs - integer , intent(in) :: atm_stop_year !(yyyy) - integer , intent(in) :: atm_stop_mon !(mm) - integer , intent(in) :: atm_stop_day - integer , intent(in) :: atm_stop_secs character(len=*) , intent(in) :: starttype_in ! local variables character(ESMF_MAXSTR) :: caseid type(ESMF_TimeInterval) :: timeStep type(ESMF_Time) :: startTime - type(ESMF_Time) :: stopTime - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest integer :: yy,mm,dd,sec integer :: lsize type(ESMF_State) :: importState, exportState @@ -329,8 +323,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & call lilac_time_clockInit(caseid, starttype, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, logunit, & - lilac_clock, rc) + logunit, lilac_clock, rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing clock") call ESMF_LogWrite(subname//"lilac_clock initialized", ESMF_LOGMSG_INFO) @@ -447,11 +440,11 @@ end subroutine lilac_init !======================================================================== - subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) + subroutine lilac_run(write_restarts_now, stop_now) ! input/output variables - logical, intent(in) :: restart_alarm_is_ringing - logical, intent(in) :: stop_alarm_is_ringing + logical, intent(in) :: write_restarts_now ! if true, CTSM will write restarts at end of time step + logical, intent(in) :: stop_now ! if true, CTSM will do some finalization at end of time step ! local variables type(ESMF_Alarm) :: lilac_history_alarm @@ -473,7 +466,7 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) ! listen to the restart and stop alarms on the lilac clock ! Set the clock restart alarm if restart_alarm_ringing is true - if (restart_alarm_is_ringing) then + if (write_restarts_now) then ! Turn on lilac restart alarm (this will be needed by ctsm) call ESMF_ClockGetAlarm(lilac_clock, 'lilac_restart_alarm', lilac_restart_alarm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_restart_alarm") @@ -488,7 +481,7 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) end if ! Set the clock stop alarm if stop_alarm_ringing is true - if (stop_alarm_is_ringing) then + if (stop_now) then call ESMF_ClockGetAlarm(lilac_clock, 'lilac_stop_alarm', lilac_stop_alarm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_stop_alarm") call ESMF_AlarmRingerOn(lilac_stop_alarm, rc=rc) @@ -576,7 +569,7 @@ subroutine lilac_run(restart_alarm_is_ringing, stop_alarm_is_ringing) end if end if - if (restart_alarm_is_ringing) then + if (write_restarts_now) then call ESMF_ClockGetAlarm(lilac_clock, 'lilac_restart_alarm', lilac_restart_alarm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in obtaining lilac_restart_alarm") call ESMF_AlarmRingerOff( lilac_restart_alarm, rc=rc ) diff --git a/lilac/src/lilac_time.F90 b/lilac/src/lilac_time.F90 index 358fecbb31..1438451cca 100644 --- a/lilac/src/lilac_time.F90 +++ b/lilac/src/lilac_time.F90 @@ -35,6 +35,10 @@ module lilac_time type(ESMF_Calendar) :: lilac_calendar integer :: mytask integer, parameter :: SecPerDay = 86400 ! Seconds per day + + ! We'll use this really big year to effectively mean infinitely into the future. + integer, parameter :: really_big_year = 999999999 + character(len=*), parameter :: u_FILE_u = & __FILE__ @@ -44,8 +48,7 @@ module lilac_time subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, logunit, & - lilac_clock, rc) + logunit, lilac_clock, rc) ! ------------------------------------------------- ! Initialize the lilac clock @@ -60,10 +63,6 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep integer , intent(in) :: atm_start_mon !(mm) integer , intent(in) :: atm_start_day integer , intent(in) :: atm_start_secs - integer , intent(in) :: atm_stop_year !(yyyy) - integer , intent(in) :: atm_stop_mon !(mm) - integer , intent(in) :: atm_stop_day - integer , intent(in) :: atm_stop_secs integer , intent(in) :: logunit type(ESMF_Clock) , intent(inout) :: lilac_clock integer , intent(out) :: rc @@ -75,7 +74,6 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep type(ESMF_VM) :: vm type(ESMF_Time) :: StartTime ! Start time type(ESMF_Time) :: CurrTime ! Current time - type(ESMF_Time) :: StopTime ! Stop time type(ESMF_Time) :: Clocktime ! Loop time type(ESMF_TimeInterval) :: TimeStep ! Clock time-step type(ESMF_TimeInterval) :: TimeStep_advance @@ -83,10 +81,6 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep integer :: start_tod ! Start time of day (seconds) integer :: curr_ymd ! Current ymd (YYYYMMDD) integer :: curr_tod ! Current tod (seconds) - integer :: stop_n ! Number until stop - integer :: stop_ymd ! Stop date (YYYYMMDD) - integer :: stop_tod ! Stop time-of-day - character(CS) :: stop_option ! Stop option units character(len=CL) :: restart_file character(len=CL) :: restart_pfile integer :: yr, mon, day, secs ! Year, month, day, seconds as integers @@ -134,13 +128,11 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep calendar=lilac_calendar, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet(StopTime , yy=atm_stop_year , mm=atm_stop_mon , dd=atm_stop_day , s=atm_stop_secs , & - calendar=lilac_calendar, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Create the lilac clock (NOTE: the reference time is set to the start time) + ! Create the lilac clock + ! NOTE: the reference time is set to the start time + ! NOTE: no stop time is given. Stopping will be determined via an argument passed to lilac_run. lilac_clock = ESMF_ClockCreate(name='lilac_clock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, & - stopTime=stopTime, rc=rc) + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort(trim(subname)//'error initializing lilac clock') ! ------------------------------ @@ -205,15 +197,20 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep print *, trim(subname) // "---------------------------------------" end if - ! Add a restart alarm and stop alarm to the clock - ! NTOE: The restart alarm and stop alarm will only go off at the end of the run + ! Add a restart alarm and stop alarm to the clock. + ! + ! These alarms are initially set up to never go off, but they are turned on by + ! arguments passed to lilac_run. + ! ! NOTE: The history alarm will be added in lilac_history_init and can go off multiple times during the run - lilac_restart_alarm = ESMF_AlarmCreate(lilac_clock, ringTime=StopTime, name='lilac_restart_alarm', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing restart alarm') + call lilac_time_alarmInit(lilac_clock, lilac_restart_alarm, 'lilac_restart_alarm', & + option = optNever, opt_n = -1) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - lilac_stop_alarm = ESMF_AlarmCreate(lilac_clock, ringTime=StopTime, name='lilac_stop_alarm', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error in initializing stop alarm') + call lilac_time_alarmInit(lilac_clock, lilac_stop_alarm, 'lilac_stop_alarm', & + option = optNever, opt_n = -1) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine lilac_time_clockInit @@ -237,7 +234,7 @@ subroutine lilac_time_alarmInit( clock, alarm, alarmname, option, opt_n, rc) type(ESMF_Alarm) , intent(inout) :: alarm ! alarm character(len=*) , intent(in) :: alarmname ! alarm name character(len=*) , intent(in) :: option ! alarm option - integer , intent(in) :: opt_n ! alarm freq + integer , intent(in) :: opt_n ! alarm freq (ignored for option of optNone or optNever) integer , intent(inout) :: rc ! Return code ! local variables @@ -270,9 +267,9 @@ subroutine lilac_time_alarmInit( clock, alarm, alarmname, option, opt_n, rc) ! Determine inputs for call to create alarm if (trim(option) == optNone .or. trim(option) == optNever) then - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + call ESMF_TimeIntervalSet(AlarmInterval, yy=really_big_year, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + call ESMF_TimeSet( NextAlarm, yy=really_big_year, mm=12, dd=1, s=0, calendar=cal, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. From f8c3cc713c4ab3ee69bfcf534e26e74c705c108c Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 1 Feb 2020 09:50:19 -0700 Subject: [PATCH 258/556] Fix compilation errors --- lilac/src/lilac_time.F90 | 4 ++-- src/utils/clm_time_manager.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lilac/src/lilac_time.F90 b/lilac/src/lilac_time.F90 index 1438451cca..524270f283 100644 --- a/lilac/src/lilac_time.F90 +++ b/lilac/src/lilac_time.F90 @@ -205,11 +205,11 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep ! NOTE: The history alarm will be added in lilac_history_init and can go off multiple times during the run call lilac_time_alarmInit(lilac_clock, lilac_restart_alarm, 'lilac_restart_alarm', & - option = optNever, opt_n = -1) + option = optNever, opt_n = -1, rc = rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call lilac_time_alarmInit(lilac_clock, lilac_stop_alarm, 'lilac_stop_alarm', & - option = optNever, opt_n = -1) + option = optNever, opt_n = -1, rc = rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine lilac_time_clockInit diff --git a/src/utils/clm_time_manager.F90 b/src/utils/clm_time_manager.F90 index f4b69a2608..9ad956ebc8 100644 --- a/src/utils/clm_time_manager.F90 +++ b/src/utils/clm_time_manager.F90 @@ -177,7 +177,6 @@ subroutine timemgr_init( ) ! character(len=*), parameter :: sub = 'clm::timemgr_init' integer :: rc ! return code - integer :: yr, mon, day, tod ! Year, month, day, and second as integers type(ESMF_Time) :: start_date ! start date for run type(ESMF_Time) :: curr_date ! temporary date used in logic type(ESMF_Time) :: ref_date ! reference date for time coordinate @@ -253,6 +252,7 @@ subroutine init_clock( start_date, ref_date, curr_date ) type(ESMF_Time) :: stop_date ! stop date for run type(ESMF_TimeInterval) :: step_size ! timestep size type(ESMF_Time) :: current ! current date (from clock) + integer :: yr, mon, day, tod ! Year, month, day, and second as integers integer :: rc ! return code !--------------------------------------------------------------------------------- From 7c0d6dc75b11fc75b2da1930ebfc09ceca2f3fd3 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 4 Feb 2020 13:36:35 -0700 Subject: [PATCH 259/556] Don't send Sl_lfrin to LILAC I don't think this will be needed by atmosphere models in general. If it's needed later, we can always add it back in. --- lilac/atm_driver/atm_driver.F90 | 1 - lilac/src/lilac_atmcap.F90 | 1 - src/cpl/lilac/lnd_import_export.F90 | 4 ---- 3 files changed, 6 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 1e93269446..1d94bae6b2 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -419,7 +419,6 @@ subroutine lilac_to_atm_driver lsize = size(atm_global_index) allocate(data(lsize)) - call lilac_atmcap_lnd2atm('Sl_lfrin' , data) call lilac_atmcap_lnd2atm('Sl_t' , data) call lilac_atmcap_lnd2atm('Sl_tref' , data) call lilac_atmcap_lnd2atm('Sl_qref' , data) diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index 88fd3e45aa..337b00fe62 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -131,7 +131,6 @@ subroutine lilac_atmcap_init_vars(atm_gindex_in, atm_lons_in, atm_lats_in, atm_g atm2lnd(n)%provided_by_atm = .false. end do - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_lfrin' , units='unknown', lsize=lsize) call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_t' , units='unknown', lsize=lsize) call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_tref' , units='unknown', lsize=lsize) call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_qref' , units='unknown', lsize=lsize) diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 9fc41fc296..4f26d6f671 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -359,10 +359,6 @@ subroutine export_fields(exportState, bounds, rc) ! output to atm ! ----------------------- - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_lfrin', bounds, & - input=ldomain%frac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_t', bounds, & input=lnd2atm_inst%t_rad_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 8c99cba0a7695e4330f726d2891598ce236d3be0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 4 Feb 2020 13:40:49 -0700 Subject: [PATCH 260/556] Remove some unneeded code in state_getimport --- src/cpl/lilac/lnd_import_export.F90 | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 4f26d6f671..8dce2d0a0c 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -544,15 +544,9 @@ subroutine state_getimport(state, fb, fldname, bounds, output, ungridded_index, ! local variables integer :: g, i,n - integer :: fieldcount real(R8), pointer :: fldptr1d(:) real(R8), pointer :: fldptr2d(:,:) - type(ESMF_StateItem_Flag) :: itemFlag character(len=cs) :: cvalue - type (ESMF_FieldBundle) :: field - type(ESMF_Field) :: lfield - type (ESMF_FieldBundle) :: fieldBundle - logical :: isPresent character(len=*), parameter :: subname='(lnd_import_export:state_getimport)' ! ---------------------------------------------- @@ -566,14 +560,6 @@ subroutine state_getimport(state, fb, fldname, bounds, output, ungridded_index, if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Get the field bundle - call ESMF_StateGet(state, trim(fb), fieldBundle, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("ERROR: fb "//trim(fb)//" not found in import state") - - ! Get the field - call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Get the pointer to data in the field if (present(ungridded_index)) then write(cvalue,*) ungridded_index From 5a9363f1b9d2a6beef005d70c5f0b870698e09d8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 5 Feb 2020 05:54:27 -0700 Subject: [PATCH 261/556] Pass atm landfrac to CTSM and check land mask consistency It is important to ensure that CTSM is running over any point that the atmosphere considers to be land. (The reverse doesn't matter: it's okay for CTSM to run over ocean points; this will result in less efficiency, but won't cause scientific problems.) --- lilac/atm_driver/atm_driver.F90 | 10 +++++ lilac/src/lilac_atmcap.F90 | 1 + src/cpl/lilac/lnd_comp_esmf.F90 | 5 ++- src/cpl/lilac/lnd_import_export.F90 | 65 +++++++++++++++++++++++++++-- 4 files changed, 77 insertions(+), 4 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 1d94bae6b2..9dbc32de50 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -355,6 +355,16 @@ subroutine atm_driver_to_lilac (lon, lat) lat_rounded(i) = real(nint(lat(i))) end do + ! We don't have a good way to set a land mask / fraction in this demo driver. Since it + ! is okay for the atmosphere to call a point ocean when CTSM calls it land, but not + ! the reverse, here we call all points ocean. In a real atmosphere, the atmosphere + ! should set landfrac to > 0 for any point for which it needs land input, to ensure + ! that CTSM is running over all of the necessary points. Note that this landfrac + ! variable doesn't actually impact the running of CTSM, but it is used for + ! consistency checking. + data(:) = 0.d0 + call lilac_atmcap_atm2lnd('Sa_landfrac', data) + data(:) = 30.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 call lilac_atmcap_atm2lnd('Sa_z', data) diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index 337b00fe62..d03ba1e506 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -90,6 +90,7 @@ subroutine lilac_atmcap_init_vars(atm_gindex_in, atm_lons_in, atm_lats_in, atm_g ! should it pass an array of character strings or a colon deliminited set of fields ! to specify the fields it will not provide - and then these are checked against those fields + call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_landfrac' , units='fraction', required_fr_atm=.true. , lsize=lsize) call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_z' , units='unknown', required_fr_atm=.true. , lsize=lsize) call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_topo' , units='unknown', required_fr_atm=.true. , lsize=lsize) call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_u' , units='unknown', required_fr_atm=.true. , lsize=lsize) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 36df5fba26..8068e6d42c 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -608,6 +608,7 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) real(r8) :: eccf ! earth orbit eccentricity factor type(bounds_type) :: bounds ! bounds character(len=32) :: rdate ! date char string for restart file names + logical :: first_call = .true. ! true if and only if this is the first time this routine is called in this execution character(*) , parameter :: F02 = "('[lnd_comp_esmf] ',a, d26.19)" character(len=*), parameter :: subname=trim(modName)//':[lnd_run] ' !------------------------------------------------------------------------------- @@ -653,7 +654,7 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) !-------------------------------- call t_startf ('lc_lnd_import') - call import_fields(import_state, bounds, rc) + call import_fields(import_state, bounds, first_call, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf ('lc_lnd_import') @@ -866,6 +867,8 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) endif #endif + first_call = .false. + end subroutine lnd_run !--------------------------------------------------------------------------- diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 8dce2d0a0c..726143211f 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -50,15 +50,16 @@ module lnd_import_export contains !=============================================================================== - subroutine import_fields( importState, bounds, rc) + subroutine import_fields( importState, bounds, first_call, rc) !--------------------------------------------------------------------------- - ! Convert the input data from the lilac to the land model + ! Convert the input data from lilac to the land model !--------------------------------------------------------------------------- - ! input/output variabes + ! input/output variables type(ESMF_State) :: importState type(bounds_type) , intent(in) :: bounds ! bounds + logical , intent(in) :: first_call ! true if and only if this is the first time we're calling import_fields from the run method integer , intent(out) :: rc ! local variables @@ -108,6 +109,14 @@ subroutine import_fields( importState, bounds, rc) ! Set bounds begg = bounds%begg; endg=bounds%endg + if (first_call) then + ! We only do this for the first call because we assume that the atmosphere's land + ! mask is constant in time. To allow for a varying land mask in the atmosphere + ! (doing checking each time), remove this first_call conditional. + call check_atm_landfrac(importState, bounds, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + ! Note: precipitation fluxes received from the coupler ! are in units of kg/s/m^2. To convert these precipitation rates ! in units of mm/sec, one must divide by 1000 kg/m^3 and multiply @@ -334,6 +343,56 @@ subroutine import_fields( importState, bounds, rc) end subroutine import_fields + !=============================================================================== + + subroutine check_atm_landfrac(importState, bounds, rc) + + ! ------------------------------------------------------------------------ + ! Import Sa_landfrac and check it against CTSM's internal land mask. + ! + ! We require that CTSM's internal land mask contains all of the atmosphere's land + ! points (defined as points with landfrac > 0). It is okay for CTSM to include some + ! points that the atmosphere considers to be ocean, but not the reverse. + ! ------------------------------------------------------------------------ + + ! input/output variables + type(ESMF_State) :: importState + type(bounds_type) , intent(in) :: bounds + integer , intent(out) :: rc + + ! local variables + real(r8), pointer :: atm_landfrac(:) + integer :: last_land_index + integer :: n + + character(len=*), parameter :: subname='(check_atm_landfrac)' + !--------------------------------------------------------------------------- + + ! Implementation notes: The CTSM decomposition is set up so that ocean points appear + ! at the end of the vectors received from the coupler. Thus, in order to check if + ! there are any points that the atmosphere considers land but CTSM considers ocean, + ! it is sufficient to check the points following the typical ending bounds in the + ! vectors received from the coupler. + ! + ! Note that we can't use state_getimport here, because that only gets points from + ! bounds%begg:bounds%endg, whereas we want the points following bounds%endg. + + call state_getfldptr(importState, 'c2l_fb_atm', 'Sa_landfrac', fldptr1d=atm_landfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + last_land_index = bounds%endg - bounds%begg + 1 + do n = last_land_index + 1, ubound(atm_landfrac, 1) + if (atm_landfrac(n) > 0._r8) then + write(iulog,*) 'At point ', n, ' atm landfrac = ', atm_landfrac(n) + write(iulog,*) 'but CTSM thinks this is ocean.' + write(iulog,*) "Make sure the mask on CTSM's fatmlndfrc file agrees with the atmosphere's land mask" + call shr_sys_abort( subname//& + ' ERROR: atm landfrac > 0 for a point that CTSM thinks is ocean') + end if + end do + + end subroutine check_atm_landfrac + !============================================================================== subroutine export_fields(exportState, bounds, rc) From d974ad2d2b317a8ada5941f0dcd60b6f08be9c1a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 5 Feb 2020 06:36:03 -0700 Subject: [PATCH 262/556] Add a comment --- src/cpl/lilac/lnd_import_export.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 726143211f..beae8c7fb4 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -112,7 +112,10 @@ subroutine import_fields( importState, bounds, first_call, rc) if (first_call) then ! We only do this for the first call because we assume that the atmosphere's land ! mask is constant in time. To allow for a varying land mask in the atmosphere - ! (doing checking each time), remove this first_call conditional. + ! (doing checking each time), remove this first_call conditional. (It would be + ! more straightforward to pass this and check it in initialization, but that would + ! require atm-land communication in initialization, which currently isn't done + ! with the LILAC coupler.) call check_atm_landfrac(importState, bounds, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if From 34c9b79e3379390bee322bf1a09dd7ca53aa2301 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 5 Feb 2020 11:30:37 -0700 Subject: [PATCH 263/556] Tweak some of the fields sent from dummy atm to land Goals: - All fields should be non-zero - All fields should be spatially-varying - All fields should have different values --- lilac/atm_driver/atm_driver.F90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 9dbc32de50..b977a2ec94 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -365,6 +365,10 @@ subroutine atm_driver_to_lilac (lon, lat) data(:) = 0.d0 call lilac_atmcap_atm2lnd('Sa_landfrac', data) + ! In the following, try to have each field have different values, in order to catch + ! mis-matches (e.g., if foo and bar were accidentally swapped in CTSM, we couldn't + ! catch that if they both had the same value). + data(:) = 30.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 call lilac_atmcap_atm2lnd('Sa_z', data) @@ -377,7 +381,7 @@ subroutine atm_driver_to_lilac (lon, lat) data(:) = 40.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 call lilac_atmcap_atm2lnd('Sa_v', data) - data(:) = 280.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 280.1d0 + lat(:)*0.01d0 + lon(:)*0.01d0 call lilac_atmcap_atm2lnd('Sa_ptem', data) data(:) = 100100.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 @@ -386,22 +390,22 @@ subroutine atm_driver_to_lilac (lon, lat) data(:) = 280.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 call lilac_atmcap_atm2lnd('Sa_tbot', data) - data(:) = 0.0004d0 !+(lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 + data(:) = 0.0004d0 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 call lilac_atmcap_atm2lnd('Sa_shum', data) data(:) = 200.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 call lilac_atmcap_atm2lnd('Faxa_lwdn', data) - data(:) = 0.0d0 + data(:) = 1.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 call lilac_atmcap_atm2lnd('Faxa_rainc', data) - data(:) = 3.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 + data(:) = 2.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 call lilac_atmcap_atm2lnd('Faxa_rainl', data) - data(:) = 1.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 + data(:) = 1.0d-9 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-9 call lilac_atmcap_atm2lnd('Faxa_snowc', data) - data(:) = 2.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 + data(:) = 2.0d-9 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-9 call lilac_atmcap_atm2lnd('Faxa_snowl', data) data(:) = 100.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 @@ -410,10 +414,10 @@ subroutine atm_driver_to_lilac (lon, lat) data(:) = 50.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 call lilac_atmcap_atm2lnd('Faxa_swvdr', data) - data(:) = 20.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 25.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 call lilac_atmcap_atm2lnd('Faxa_swndf', data) - data(:) = 40.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 45.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 call lilac_atmcap_atm2lnd('Faxa_swvdf', data) end subroutine atm_driver_to_lilac From a05469c9526402ff2744b8aa86a38e5abe2f47ea Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 5 Feb 2020 12:01:03 -0700 Subject: [PATCH 264/556] Remove unused lat_rounded and lon_rounded These were originally here for the sake of comparison against datm: The idea was that lats and lons could differ by a little between datm and this dummy driver, but the rounded-to-the-nearest-integer values should be the same. But it looks like either these were never used, or they were used at one point but then stopped being used. --- lilac/atm_driver/atm_driver.F90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index b977a2ec94..e68d6fe221 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -337,24 +337,14 @@ subroutine atm_driver_to_lilac (lon, lat) real*8, intent(in) :: lat(:) ! local variables - real, allocatable :: lon_rounded(:) - real, allocatable :: lat_rounded(:) integer :: lsize real*8, allocatable :: data(:) - integer :: i integer :: i_local ! -------------------------------------------------------- lsize = size(lon) - allocate(lon_rounded(lsize)) - allocate(lat_rounded(lsize)) allocate(data(lsize)) - do i = 1, lsize - lon_rounded(i) = real(nint(lon(i))) - lat_rounded(i) = real(nint(lat(i))) - end do - ! We don't have a good way to set a land mask / fraction in this demo driver. Since it ! is okay for the atmosphere to call a point ocean when CTSM calls it land, but not ! the reverse, here we call all points ocean. In a real atmosphere, the atmosphere From faf75629eea0f61990f4134340da2180ceefbfa0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 5 Feb 2020 12:05:55 -0700 Subject: [PATCH 265/556] Introduce a shared variable for dummy atm's space-time perturbation --- lilac/atm_driver/atm_driver.F90 | 39 +++++++++++++++++++-------------- 1 file changed, 22 insertions(+), 17 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index e68d6fe221..4d75881814 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -338,13 +338,18 @@ subroutine atm_driver_to_lilac (lon, lat) ! local variables integer :: lsize + real*8, allocatable :: space_time_perturbation(:) real*8, allocatable :: data(:) + integer :: i integer :: i_local ! -------------------------------------------------------- lsize = size(lon) + allocate(space_time_perturbation(lsize)) allocate(data(lsize)) + space_time_perturbation(:) = lat(:)*0.01d0 + lon(:)*0.01d0 + ! We don't have a good way to set a land mask / fraction in this demo driver. Since it ! is okay for the atmosphere to call a point ocean when CTSM calls it land, but not ! the reverse, here we call all points ocean. In a real atmosphere, the atmosphere @@ -359,55 +364,55 @@ subroutine atm_driver_to_lilac (lon, lat) ! mis-matches (e.g., if foo and bar were accidentally swapped in CTSM, we couldn't ! catch that if they both had the same value). - data(:) = 30.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 30.0d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Sa_z', data) - data(:) = 10.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 10.0d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Sa_topo', data) - data(:) = 20.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 20.0d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Sa_u', data) - data(:) = 40.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 40.0d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Sa_v', data) - data(:) = 280.1d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 280.1d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Sa_ptem', data) - data(:) = 100100.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 100100.0d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Sa_pbot', data) - data(:) = 280.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 280.0d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Sa_tbot', data) - data(:) = 0.0004d0 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 + data(:) = 0.0004d0 + space_time_perturbation(:)*1.0e-8 call lilac_atmcap_atm2lnd('Sa_shum', data) - data(:) = 200.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 200.0d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Faxa_lwdn', data) - data(:) = 1.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 + data(:) = 1.0d-8 + space_time_perturbation(:)*1.0e-8 call lilac_atmcap_atm2lnd('Faxa_rainc', data) - data(:) = 2.0d-8 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-8 + data(:) = 2.0d-8 + space_time_perturbation(:)*1.0e-8 call lilac_atmcap_atm2lnd('Faxa_rainl', data) - data(:) = 1.0d-9 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-9 + data(:) = 1.0d-9 + space_time_perturbation(:)*1.0e-9 call lilac_atmcap_atm2lnd('Faxa_snowc', data) - data(:) = 2.0d-9 + (lat(:)*0.01d0 + lon(:)*0.01d0)*1.0e-9 + data(:) = 2.0d-9 + space_time_perturbation(:)*1.0e-9 call lilac_atmcap_atm2lnd('Faxa_snowl', data) - data(:) = 100.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 100.0d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Faxa_swndr', data) - data(:) = 50.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 50.0d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Faxa_swvdr', data) - data(:) = 25.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 25.0d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Faxa_swndf', data) - data(:) = 45.0d0 + lat(:)*0.01d0 + lon(:)*0.01d0 + data(:) = 45.0d0 + space_time_perturbation(:) call lilac_atmcap_atm2lnd('Faxa_swvdf', data) end subroutine atm_driver_to_lilac From ec35b5043b50a9a1271cd99368aba2880c5262df Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 5 Feb 2020 13:16:45 -0700 Subject: [PATCH 266/556] Add a time dependence in lilac's demo atm driver --- lilac/atm_driver/atm_driver.F90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 4d75881814..eb0bf03814 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -231,7 +231,7 @@ program atm_driver do nstep = 1,atm_nsteps ! fill in the dataptr values in atm2lnd type in lilac_atmcap - call atm_driver_to_lilac (atm_lons, atm_lats) + call atm_driver_to_lilac (atm_lons, atm_lats, nstep, atm_nsteps) if (nstep == atm_nsteps) then call lilac_run(write_restarts_now=.true., stop_now=.true.) @@ -330,14 +330,18 @@ subroutine nc_check_err(ierror, description, filename) end subroutine nc_check_err !======================================================================== - subroutine atm_driver_to_lilac (lon, lat) + subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) ! input/output variables real*8, intent(in) :: lon(:) real*8, intent(in) :: lat(:) + integer, intent(in) :: nstep ! current step number + integer, intent(in) :: atm_nsteps ! total number of steps in simulation ! local variables integer :: lsize + real*8 :: time_midpoint + real*8 :: time_perturbation real*8, allocatable :: space_time_perturbation(:) real*8, allocatable :: data(:) integer :: i @@ -348,7 +352,10 @@ subroutine atm_driver_to_lilac (lon, lat) allocate(space_time_perturbation(lsize)) allocate(data(lsize)) - space_time_perturbation(:) = lat(:)*0.01d0 + lon(:)*0.01d0 + ! The time perturbation will range from about -0.5 to 0.5 + time_midpoint = atm_nsteps / 2.d0 + time_perturbation = 0.5d0 * (nstep - time_midpoint)/time_midpoint + space_time_perturbation(:) = time_perturbation + lat(:)*0.01d0 + lon(:)*0.01d0 ! We don't have a good way to set a land mask / fraction in this demo driver. Since it ! is okay for the atmosphere to call a point ocean when CTSM calls it land, but not From 67470cf4251abb051197b55ee79f7d1fcfc82a82 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 7 Feb 2020 13:19:58 -0700 Subject: [PATCH 267/556] Write fields sent to atm at end of run This is useful for validating the fields sent from CTSM to the atmosphere, ensuring that that side of the data flow is working right. I'll use it to do a one-time manual validation, then it will also be leveraged in the future to ensure that this side of the data flow doesn't break, by checking these files in our automated testing of lilac with the demo atm driver. --- lilac/atm_driver/atm_driver.F90 | 145 ++++++++++++++++++++++++++------ lilac/atm_driver/atm_driver_in | 1 + 2 files changed, 118 insertions(+), 28 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index eb0bf03814..3b9f318fcb 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -16,9 +16,12 @@ program atm_driver ! ESMF lilac_atmcap ESMF CTSM cap ESMF river cap (Mizzouroute, Mosart) !---------------------------------------------------------------------------- - use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_close - use netcdf , only : nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_varid, nf90_get_var + use netcdf , only : nf90_open, nf90_create, nf90_enddef, nf90_close + use netcdf , only : nf90_clobber, nf90_write, nf90_nowrite, nf90_noerr, nf90_double + use netcdf , only : nf90_def_dim, nf90_def_var, nf90_put_var + use netcdf , only : nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_varid, nf90_get_var use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS + use mpi , only : MPI_GATHER, MPI_DOUBLE use lilac_mod , only : lilac_init, lilac_run, lilac_final use lilac_atmcap, only : lilac_atmcap_atm2lnd, lilac_atmcap_lnd2atm use shr_cal_mod , only : shr_cal_date2ymd @@ -32,6 +35,7 @@ program atm_driver real*8 , allocatable :: atm_lons(:), atm_lats(:) integer , allocatable :: atm_global_index(:) integer :: mytask, ntasks + logical :: masterproc integer :: my_start, my_end integer :: i_local, i_global integer :: nlocal, nglobal @@ -46,6 +50,7 @@ program atm_driver integer :: atm_restart_day, atm_restart_secs ! Namelist and related variables + character(len=512) :: caseid character(len=512) :: atm_mesh_file integer :: atm_global_nx integer :: atm_global_ny @@ -61,7 +66,7 @@ program atm_driver integer :: atm_stop_secs character(len=32) :: atm_starttype - namelist /atm_driver_input/ atm_mesh_file, atm_global_nx, atm_global_ny, & + namelist /atm_driver_input/ caseid, atm_mesh_file, atm_global_nx, atm_global_ny, & atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, atm_starttype @@ -80,8 +85,13 @@ program atm_driver comp_comm = MPI_COMM_WORLD call MPI_COMM_RANK(comp_comm, mytask, ierr) call MPI_COMM_SIZE(comp_comm, ntasks, ierr) + if (mytask == 0) then + masterproc = .true. + else + masterproc = .false. + end if - if (mytask == 0 ) then + if (masterproc ) then print *, "MPI initialization done ..., ntasks=", ntasks end if @@ -89,7 +99,7 @@ program atm_driver ! Read in namelist file ... !----------------------------------------------------------------------------- - if (mytask == 0) then + if (masterproc) then print *,"---------------------------------------" print *, "MPI initialized in atm_driver ..." end if @@ -115,7 +125,7 @@ program atm_driver print *, " atm global nx, ny, nglobal = ",atm_global_nx, atm_global_ny, nglobal call shr_sys_abort("Error atm_nx*atm_ny is not equal to nglobal") end if - if (mytask == 0 ) then + if (masterproc ) then print *, " atm_driver mesh file ",trim(atm_mesh_file) print *, " atm global nx = ",atm_global_nx print *, " atm global nx = ",atm_global_ny @@ -124,6 +134,10 @@ program atm_driver !----------------------------------------------------------------------------- ! atmosphere domain decomposition + ! + ! Note that other code in this module relies on this simple decomposition, where we + ! assign the first points to task 0, then the next points to task 1, etc. Specifically, + ! code in write_lilac_to_atm_driver_fields relies on this decomposition. !----------------------------------------------------------------------------- nlocal = nglobal / ntasks @@ -156,7 +170,7 @@ program atm_driver ! Initialize lilac !------------------------------------------------------------------------ - if (mytask == 0 ) then + if (masterproc ) then print *, " initializing lilac with start type ",trim(atm_starttype) end if call lilac_init(comp_comm, atm_global_index, atm_lons, atm_lats, & @@ -189,7 +203,7 @@ program atm_driver read(fileunit,'(a)', iostat=ierr) restart_file if (ierr < 0) call shr_sys_abort('Error reading rpointer.lilac') close(fileunit) - if (mytask == 0) then + if (masterproc) then print *,'lilac restart_file = ',trim(restart_file) end if @@ -209,7 +223,7 @@ program atm_driver ierr = nf90_close(idfile) if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_close') - if (mytask == 0) then + if (masterproc) then print *,'restart_ymd = ',atm_restart_ymd end if call shr_cal_date2ymd(atm_restart_ymd, atm_restart_year, atm_restart_mon, atm_restart_day) @@ -240,13 +254,20 @@ program atm_driver end if end do + call write_lilac_to_atm_driver_fields( & + caseid = caseid, & + nlocal = nlocal, & + atm_global_nx = atm_global_nx, & + atm_global_ny = atm_global_ny, & + masterproc = masterproc) + !------------------------------------------------------------------------ ! Finalize lilac !------------------------------------------------------------------------ call lilac_final( ) - if (mytask == 0 ) then + if (masterproc ) then print *, "=======================================" print *, " ............. DONE ..................." print *, "=======================================" @@ -293,7 +314,7 @@ subroutine read_netcdf_mesh(filename, nglobal) ierr = nf90_inquire_dimension(idfile, dimid_coordDim, string, coordDim) call nc_check_err(ierr, "inq_dim coordDim", filename) - if (mytask == 0 ) then + if (masterproc ) then print *, "=======================================" print *, "number of elements is : ", nelem print *, "coordDim is :", coordDim @@ -425,28 +446,96 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) end subroutine atm_driver_to_lilac !======================================================================== - subroutine lilac_to_atm_driver + subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, atm_global_ny, masterproc) + + ! Fetch lnd2atm fields from LILAC and write them out. + ! + ! This should only be called once, at the end of the run. (Calling it multiple times + ! will lead to the output file being overwritten.) + + ! input/output variables + character(len=*), intent(in) :: caseid + integer, intent(in) :: nlocal + integer, intent(in) :: atm_global_nx + integer, intent(in) :: atm_global_ny + logical, intent(in) :: masterproc ! local variables - integer :: lsize + integer, parameter :: field_name_len = 64 + integer :: ierr + integer :: ncid + integer :: dimid_x + integer :: dimid_y + integer :: nglobal + integer :: i + integer, allocatable :: varids(:) + character(len=field_name_len) :: field_name real*8, allocatable :: data(:) + real*8, allocatable :: data_global(:) + real*8, allocatable :: data_2d(:,:) + + character(len=field_name_len), parameter :: fields(23) = [character(len=field_name_len) :: & + 'Sl_t', 'Sl_tref', 'Sl_qref', 'Sl_avsdr', 'Sl_anidr', 'Sl_avsdf', 'Sl_anidf', & + 'Sl_snowh', 'Sl_u10', 'Sl_fv', 'Sl_ram1', 'Sl_z0m', & + 'Fall_taux', 'Fall_tauy', 'Fall_lat', 'Fall_sen', 'Fall_lwup', 'Fall_evap', 'Fall_swnet', & + 'Fall_flxdst1', 'Fall_flxdst2', 'Fall_flxdst3', 'Fall_flxdst4'] ! -------------------------------------------- - lsize = size(atm_global_index) - allocate(data(lsize)) + if (masterproc) then + ! Use an arbitrary time rather than trying to figure out the correct time stamp. This + ! works because this subroutine is only called once, at the end of the run + ierr = nf90_create(trim(caseid)//'.atm.h0.0001-01.nc', nf90_clobber, ncid) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_create atm driver output file') + + ierr = nf90_def_dim(ncid, 'atm_nx', atm_global_nx, dimid_x) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_def_dim nx atm driver output file') + ierr = nf90_def_dim(ncid, 'atm_ny', atm_global_ny, dimid_y) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_def_dim ny atm driver output file') + + allocate(varids(size(fields))) + do i = 1, size(fields) + field_name = fields(i) + ierr = nf90_def_var(ncid, field_name, nf90_double, [dimid_x, dimid_y], varids(i)) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_def_var atm driver output file: '//trim(field_name)) + end do + + ierr = nf90_enddef(ncid) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_enddef atm driver output file') + end if + + allocate(data(nlocal)) + nglobal = atm_global_nx * atm_global_ny + if (masterproc) then + allocate(data_global(nglobal)) + allocate(data_2d(atm_global_nx, atm_global_ny)) + end if + + do i = 1, size(fields) + field_name = fields(i) + call lilac_atmcap_lnd2atm(field_name, data) + + ! Because of the way we set up the decomposition, we can use a simple mpi_gather + ! without needing to worry about any rearrangement, and points will appear in the + ! correct order on the master proc. Specifically, we rely on the fact that the + ! first points are assigned to task 0, then the next points to task 1, etc. + call mpi_gather(data, size(data), mpi_double, data_global, nglobal, mpi_double, 0, & + mpi_comm_world, ierr) + if (ierr .ne. MPI_SUCCESS) then + call shr_sys_abort(' ERROR in mpi_gather for ' // trim(field_name)) + end if + + if (masterproc) then + data_2d = reshape(data_global, [atm_global_nx, atm_global_ny]) + ierr = nf90_put_var(ncid, varids(i), data_2d) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_put_var atm driver output file: '//trim(field_name)) + end if + end do + + if (masterproc) then + ierr = nf90_close(ncid) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_close atm driver output file') + end if - call lilac_atmcap_lnd2atm('Sl_t' , data) - call lilac_atmcap_lnd2atm('Sl_tref' , data) - call lilac_atmcap_lnd2atm('Sl_qref' , data) - call lilac_atmcap_lnd2atm('Sl_avsdr' , data) - call lilac_atmcap_lnd2atm('Sl_anidr' , data) - call lilac_atmcap_lnd2atm('Sl_avsdf' , data) - call lilac_atmcap_lnd2atm('Sl_anidf' , data) - call lilac_atmcap_lnd2atm('Sl_snowh' , data) - call lilac_atmcap_lnd2atm('Sl_u10' , data) - call lilac_atmcap_lnd2atm('Sl_fv' , data) - call lilac_atmcap_lnd2atm('Sl_ram1' , data) - - end subroutine lilac_to_atm_driver + end subroutine write_lilac_to_atm_driver_fields end program diff --git a/lilac/atm_driver/atm_driver_in b/lilac/atm_driver/atm_driver_in index 09d1037741..a9bda2e0d3 100644 --- a/lilac/atm_driver/atm_driver_in +++ b/lilac/atm_driver/atm_driver_in @@ -1,4 +1,5 @@ &atm_driver_input + caseid = 'test_lilac' atm_mesh_file = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' atm_global_nx = 72 atm_global_ny = 46 From 899a6faac902e0d3fc4f40325dee1376736adf29 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 10 Feb 2020 09:54:38 -0700 Subject: [PATCH 268/556] Allocate data_global on non-master procs Without this, I get an error: Attempt to fetch from allocatable variable DATA_GLOBAL when it is not allocated --- lilac/atm_driver/atm_driver.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 3b9f318fcb..01cfef8b72 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -508,6 +508,8 @@ subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, atm_g if (masterproc) then allocate(data_global(nglobal)) allocate(data_2d(atm_global_nx, atm_global_ny)) + else + allocate(data_global(1)) end if do i = 1, size(fields) From 20913fab9aacab8df71954bffd41d43e41828c7d Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 10 Feb 2020 12:17:10 -0700 Subject: [PATCH 269/556] Need to use mpi_gatherv rather than mpi_gather There are different counts per proc, so need mpi_gatherv. Also, I had previously made a mistake in using the global count for the receive count; this is supposed to be the number of points received per task. --- lilac/atm_driver/atm_driver.F90 | 46 ++++++++++++++++++++++++++++----- 1 file changed, 40 insertions(+), 6 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 01cfef8b72..ca5594f6bc 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -21,7 +21,7 @@ program atm_driver use netcdf , only : nf90_def_dim, nf90_def_var, nf90_put_var use netcdf , only : nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_varid, nf90_get_var use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS - use mpi , only : MPI_GATHER, MPI_DOUBLE + use mpi , only : MPI_GATHER, MPI_INT, MPI_DOUBLE use lilac_mod , only : lilac_init, lilac_run, lilac_final use lilac_atmcap, only : lilac_atmcap_atm2lnd, lilac_atmcap_lnd2atm use shr_cal_mod , only : shr_cal_date2ymd @@ -259,6 +259,7 @@ program atm_driver nlocal = nlocal, & atm_global_nx = atm_global_nx, & atm_global_ny = atm_global_ny, & + ntasks = ntasks, & masterproc = masterproc) !------------------------------------------------------------------------ @@ -446,7 +447,8 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) end subroutine atm_driver_to_lilac !======================================================================== - subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, atm_global_ny, masterproc) + subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, & + atm_global_ny, ntasks, masterproc) ! Fetch lnd2atm fields from LILAC and write them out. ! @@ -458,6 +460,7 @@ subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, atm_g integer, intent(in) :: nlocal integer, intent(in) :: atm_global_nx integer, intent(in) :: atm_global_ny + integer, intent(in) :: ntasks logical, intent(in) :: masterproc ! local variables @@ -470,6 +473,8 @@ subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, atm_g integer :: i integer, allocatable :: varids(:) character(len=field_name_len) :: field_name + integer, allocatable :: counts(:) + integer, allocatable :: displacements(:) real*8, allocatable :: data(:) real*8, allocatable :: data_global(:) real*8, allocatable :: data_2d(:,:) @@ -481,6 +486,10 @@ subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, atm_g 'Fall_flxdst1', 'Fall_flxdst2', 'Fall_flxdst3', 'Fall_flxdst4'] ! -------------------------------------------- + ! ------------------------------------------------------------------------ + ! Set up output file + ! ------------------------------------------------------------------------ + if (masterproc) then ! Use an arbitrary time rather than trying to figure out the correct time stamp. This ! works because this subroutine is only called once, at the end of the run @@ -503,27 +512,52 @@ subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, atm_g if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_enddef atm driver output file') end if + ! ------------------------------------------------------------------------ + ! Determine number of points on each processor and set up arrays needed for gathering + ! data to master proc + ! ------------------------------------------------------------------------ + allocate(data(nlocal)) nglobal = atm_global_nx * atm_global_ny if (masterproc) then + allocate(counts(ntasks)) + allocate(displacements(ntasks)) allocate(data_global(nglobal)) allocate(data_2d(atm_global_nx, atm_global_ny)) else + allocate(counts(1)) + allocate(displacements(1)) allocate(data_global(1)) end if + call mpi_gather(nlocal, 1, mpi_int, counts, 1, mpi_int, 0, mpi_comm_world, ierr) + if (ierr .ne. MPI_SUCCESS) then + call shr_sys_abort(' ERROR in mpi_gather for counts') + end if + + if (masterproc) then + displacements(1) = 0 + do i = 2, ntasks + displacements(i) = displacements(i-1) + counts(i-1) + end do + end if + + ! ------------------------------------------------------------------------ + ! Retrieve data for each field, gather to master and write to file + ! ------------------------------------------------------------------------ + do i = 1, size(fields) field_name = fields(i) call lilac_atmcap_lnd2atm(field_name, data) - ! Because of the way we set up the decomposition, we can use a simple mpi_gather + ! Because of the way we set up the decomposition, we can use a simple mpi_gatherv ! without needing to worry about any rearrangement, and points will appear in the ! correct order on the master proc. Specifically, we rely on the fact that the ! first points are assigned to task 0, then the next points to task 1, etc. - call mpi_gather(data, size(data), mpi_double, data_global, nglobal, mpi_double, 0, & - mpi_comm_world, ierr) + call mpi_gatherv(data, size(data), mpi_double, data_global, counts, displacements, & + mpi_double, 0, mpi_comm_world, ierr) if (ierr .ne. MPI_SUCCESS) then - call shr_sys_abort(' ERROR in mpi_gather for ' // trim(field_name)) + call shr_sys_abort(' ERROR in mpi_gatherv for ' // trim(field_name)) end if if (masterproc) then From ed0227f02f435c794edcb9d001f4dfc4924ae7e9 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 10 Feb 2020 16:03:32 -0700 Subject: [PATCH 270/556] Add to readme: also compare output from demo atm driver --- README.lilac | 1 + 1 file changed, 1 insertion(+) diff --git a/README.lilac b/README.lilac index 95f464c0fb..dd3ee0e0fe 100644 --- a/README.lilac +++ b/README.lilac @@ -61,6 +61,7 @@ library (I), do the following: > basedir=/glade/p/cgd/tss/ctsm_baselines/lilac_20191202 > cprnc test_lilac.clm2.h0.2000-01-03-00000.nc $basedir/test_lilac.clm2.h0.2000-01-03-00000.nc | tail -30 > cprnc test_lilac.lilac.hi.2000-01-02-81000.nc $basedir/test_lilac.lilac.hi.2000-01-02-81000.nc | tail -30 + > cprnc test_lilac.atm.h0.0001-01.nc $basedir/test_lilac.atm.h0.0001-01.nc | tail -30 5) if there are differences, and those are intentional, then create new baselines From 5af1f5750991c7cf87fb83d05640fe79df296961 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 11 Feb 2020 09:42:43 -0700 Subject: [PATCH 271/556] Fix uses of some optional arguments --- src/cpl/lilac/lnd_import_export.F90 | 10 ++++++++-- src/cpl/lilac/lnd_shr_methods.F90 | 13 +++---------- src/cpl/nuopc/lnd_import_export.F90 | 10 ++++++++-- src/cpl/nuopc/lnd_shr_methods.F90 | 13 +++---------- 4 files changed, 22 insertions(+), 24 deletions(-) diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index beae8c7fb4..5807d58a8c 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -683,6 +683,7 @@ subroutine state_setexport(state, fb, fldname, bounds, input, minus, ungridded_i integer , intent(out) :: rc ! local variables + logical :: l_minus ! local version of minus integer :: g, i, n real(R8), pointer :: fldptr1d(:) real(R8), pointer :: fldptr2d(:,:) @@ -692,6 +693,11 @@ subroutine state_setexport(state, fb, fldname, bounds, input, minus, ungridded_i rc = ESMF_SUCCESS + l_minus = .false. + if (present(minus)) then + l_minus = minus + end if + ! get field pointer if (present(ungridded_index)) then call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname)//" index "//trim(cvalue), & @@ -715,7 +721,7 @@ subroutine state_setexport(state, fb, fldname, bounds, input, minus, ungridded_i n = g - bounds%begg + 1 fldptr2d(ungridded_index,n) = input(g) end do - if (present(minus)) then + if (l_minus) then fldptr2d(ungridded_index,:) = -fldptr2d(ungridded_index,:) end if else @@ -724,7 +730,7 @@ subroutine state_setexport(state, fb, fldname, bounds, input, minus, ungridded_i n = g - bounds%begg + 1 fldptr1d(n) = input(g) end do - if (present(minus)) then + if (l_minus) then fldptr1d(:) = -fldptr1d(:) end if end if diff --git a/src/cpl/lilac/lnd_shr_methods.F90 b/src/cpl/lilac/lnd_shr_methods.F90 index c20a3e4360..078aef08d9 100644 --- a/src/cpl/lilac/lnd_shr_methods.F90 +++ b/src/cpl/lilac/lnd_shr_methods.F90 @@ -53,7 +53,7 @@ subroutine state_diagnose(State, string, rc) call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + call field_getfldptr(lfield, rc=rc, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank) if (chkerr(rc,__LINE__,u_FILE_u)) return if (lrank == 0) then @@ -86,7 +86,7 @@ end subroutine state_diagnose !=============================================================================== - subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) + subroutine field_getfldptr(field, rc, fldptr1, fldptr2, rank, abort) ! ---------------------------------------------- ! for a field, determine rank and return fldptr1 or fldptr2 @@ -96,11 +96,11 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) ! input/output variables type(ESMF_Field) , intent(in) :: field + integer , intent(out) :: rc real(r8), pointer , intent(inout), optional :: fldptr1(:) real(r8), pointer , intent(inout), optional :: fldptr2(:,:) integer , intent(out) , optional :: rank logical , intent(in) , optional :: abort - integer , intent(out) , optional :: rc ! local variables type(ESMF_GeomType_Flag) :: geomtype @@ -111,13 +111,6 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) character(len=*), parameter :: subname='(field_getfldptr)' ! ---------------------------------------------- - if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - rc = ESMF_SUCCESS labort = .true. diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 6fcc84ab80..55497578f7 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -1206,6 +1206,7 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index integer , intent(out) :: rc ! local variables + logical :: l_minus ! local version of minus integer :: g, i, n real(R8), pointer :: fldptr1d(:) real(R8), pointer :: fldptr2d(:,:) @@ -1216,6 +1217,11 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index rc = ESMF_SUCCESS + l_minus = .false. + if (present(minus)) then + l_minus = minus + end if + ! Determine if field with name fldname exists in state call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1247,7 +1253,7 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index n = g - bounds%begg + 1 fldptr2d(ungridded_index,n) = input(g) end do - if (present(minus)) then + if (l_minus) then fldptr2d(ungridded_index,:) = -fldptr2d(ungridded_index,:) end if else @@ -1256,7 +1262,7 @@ subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index n = g - bounds%begg + 1 fldptr1d(n) = input(g) end do - if (present(minus)) then + if (l_minus) then fldptr1d(:) = -fldptr1d(:) end if end if diff --git a/src/cpl/nuopc/lnd_shr_methods.F90 b/src/cpl/nuopc/lnd_shr_methods.F90 index 344eda650e..13438e855f 100644 --- a/src/cpl/nuopc/lnd_shr_methods.F90 +++ b/src/cpl/nuopc/lnd_shr_methods.F90 @@ -321,7 +321,7 @@ subroutine state_diagnose(State, string, rc) call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + call field_getfldptr(lfield, rc=rc, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank) if (chkerr(rc,__LINE__,u_FILE_u)) return if (lrank == 0) then @@ -354,7 +354,7 @@ end subroutine state_diagnose !=============================================================================== - subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) + subroutine field_getfldptr(field, rc, fldptr1, fldptr2, rank, abort) ! ---------------------------------------------- ! for a field, determine rank and return fldptr1 or fldptr2 @@ -364,11 +364,11 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) ! input/output variables type(ESMF_Field) , intent(in) :: field + integer , intent(out) :: rc real(r8), pointer , intent(inout), optional :: fldptr1(:) real(r8), pointer , intent(inout), optional :: fldptr2(:,:) integer , intent(out) , optional :: rank logical , intent(in) , optional :: abort - integer , intent(out) , optional :: rc ! local variables type(ESMF_GeomType_Flag) :: geomtype @@ -379,13 +379,6 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) character(len=*), parameter :: subname='(field_getfldptr)' ! ---------------------------------------------- - if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - rc = ESMF_SUCCESS labort = .true. From 024aa5c6f8764248d35c3b08dbfc4f1426a93f76 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 11 Feb 2020 10:00:17 -0700 Subject: [PATCH 272/556] In nuopc cap, abort if error in fldlist_add Previously, an error seemed to be silently ignored if ESMF logging wasn't set up to abort on error. --- src/cpl/nuopc/lnd_import_export.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 55497578f7..eed5a3e0c6 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -989,7 +989,7 @@ subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound if (num > fldsMax) then call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - return + call shr_sys_abort(trim(subname)//": ERROR: num > fldsMax") endif fldlist(num)%stdname = trim(stdname) From 294f9e706704258e907b2680f0b358af1335c1bc Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 12 Feb 2020 09:53:45 -0700 Subject: [PATCH 273/556] Minor changes in CLMBuildNamelist to reduce prints to stdout For the sake of running CLMBuildNamelist using lilac's buildnml, I wanted to remove prints to stdout when things were working correctly. This commit removes two sets of output: (1) Messages about the obsolescence of glob: File::Glob::glob() will disappear in perl 5.30. Use File::Glob::bsd_glob() instead. at /Users/sacks/ctsm/ctsm2/bld/CLMBuildNamelist.pm line 4105. (2) Messages about the use case: CLM adding use_case 2000_control defaults for var 'sim_year' with val '2000' CLM adding use_case 2000_control defaults for var 'sim_year_range' with val 'constant' CLM adding use_case 2000_control defaults for var 'stream_year_first_urbantv' with val '2000' CLM adding use_case 2000_control defaults for var 'stream_year_last_urbantv' with val '2000' CLM adding use_case 2000_control defaults for var 'use_case_desc' with val 'Conditions to simulate 2000 land-use' --- bld/CLMBuildNamelist.pm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index ae58cbaf12..0ccf7ffb0d 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -35,7 +35,7 @@ use File::Basename qw(dirname); use English; use Getopt::Long; use IO::File; -use File::Glob ':glob'; +use File::Glob ':bsd_glob'; #------------------------------------------------------------------------------- # @@ -476,7 +476,7 @@ sub read_envxml_case_files { my %envxml = (); if ( defined($opts->{'envxml_dir'}) ) { (-d $opts->{'envxml_dir'}) or $log->fatal_error( "envxml_dir is not a directory" ); - my @files = glob( $opts->{'envxml_dir'}."/env_*xml" ); + my @files = bsd_glob( $opts->{'envxml_dir'}."/env_*xml" ); ($#files >= 0) or $log->fatal_error( "there are no env_*xml files in the envxml_dir" ); foreach my $file (@files) { $log->verbose_message( "Open env.xml file: $file" ); @@ -1443,7 +1443,7 @@ sub process_namelist_commandline_use_case { my $val = $uc_defaults->get_value($var, \%settings ); if ( defined($val) ) { - $log->message("CLM adding use_case $opts->{'use_case'} defaults for var '$var' with val '$val'"); + $log->verbose_message("CLM adding use_case $opts->{'use_case'} defaults for var '$var' with val '$val'"); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl_usecase, $var, 'val'=>$val); } @@ -4102,7 +4102,7 @@ sub validate_options { # create the @expect array by listing the files in $use_case_dir # and strip off the ".xml" part of the filename @expect = (); - my @files = glob("$opts->{'use_case_dir'}/*.xml"); + my @files = bsd_glob("$opts->{'use_case_dir'}/*.xml"); foreach my $file (@files) { $file =~ m{.*/(.*)\.xml}; &check_use_case_name( $1 ); @@ -4116,7 +4116,7 @@ sub validate_options { } else { print "Use cases are:...\n\n"; my @ucases; - foreach my $file( sort( glob($opts->{'use_case_dir'}."/*.xml") ) ) { + foreach my $file( sort( bsd_glob($opts->{'use_case_dir'}."/*.xml") ) ) { my $use_case; if ( $file =~ /\/([^\/]+)\.xml$/ ) { &check_use_case_name( $1 ); From a18cbb07fed3931ed019eb03ada3ff3b0e8ee932 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 12 Feb 2020 10:58:49 -0700 Subject: [PATCH 274/556] LILAC buildnml: Remove python2 support and run_cmd function Removing python2 support because it relied on six, which may not be present on every system. Removing run_cmd function because it introduced unnecessary complexity. --- lilac_config/buildnml | 131 +++++------------------------------------- 1 file changed, 15 insertions(+), 116 deletions(-) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 4fefdaaf9d..a826d9477b 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -1,37 +1,13 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """ CTSM namelist creator """ -import sys, os, shutil, subprocess, logging, argparse -import six -from argparse import RawTextHelpFormatter +import sys, os, subprocess, argparse -try: - # python2 - from ConfigParser import SafeConfigParser as config_parser - from ConfigParser import MissingSectionHeaderError - from ConfigParser import NoSectionError, NoOptionError - - def config_string_cleaner(text): - """convert strings into unicode - """ - return text.decode('utf-8') -except ImportError: - # python3 - from configparser import ConfigParser as config_parser - from configparser import MissingSectionHeaderError - from configparser import NoSectionError, NoOptionError - - def config_string_cleaner(text): - """Python3 already uses unicode strings, so just return the string - without modification. - - """ - return text - -logger = logging.getLogger(__name__) +from configparser import ConfigParser +from configparser import NoSectionError, NoOptionError _config_cache_template = """ @@ -41,7 +17,7 @@ _config_cache_template = """ """ -# Note the following is needed in env_lilac.xml otherwise the following error appers in the call to build_namelist +# Note the following is needed in env_lilac.xml otherwise the following error appears in the call to build_namelist #err=ERROR : CLM build-namelist::CLMBuildNamelist::logical_to_fortran() : Unexpected value in logical_to_fortran: _env_lilac_template = """ @@ -62,10 +38,10 @@ _hack=object() def parse_command_line(args, description): ############################################################################### - parser = argparse.ArgumentParser(formatter_class=RawTextHelpFormatter, description=description) + parser = argparse.ArgumentParser(formatter_class=argparse.RawTextHelpFormatter, description=description) parser.add_argument("--rundir", type=str, default=os.getcwd(), - help="(required) specify the full path of the run directory)") + help="specify the full path of the run directory") arguments = parser.parse_args(args) @@ -75,81 +51,6 @@ def parse_command_line(args, description): return arguments.rundir -############################################################################### -def run_cmd(cmd, input_str=None, from_dir=None, verbose=None, - arg_stdout=_hack, arg_stderr=_hack, env=None, combine_output=False): -############################################################################### - - """ - Wrapper around subprocess to make it much more convenient to run shell commands - - >>> run_cmd('ls file_i_hope_doesnt_exist')[0] != 0 - True - """ - import subprocess # Not safe to do globally, module not available in older pythons - - # Real defaults for these value should be subprocess.PIPE - if arg_stdout is _hack: - arg_stdout = subprocess.PIPE - elif isinstance(arg_stdout, six.string_types): - arg_stdout = _convert_to_fd(arg_stdout, from_dir) - - if arg_stderr is _hack: - arg_stderr = subprocess.STDOUT if combine_output else subprocess.PIPE - elif isinstance(arg_stderr, six.string_types): - arg_stderr = _convert_to_fd(arg_stdout, from_dir) - - if (verbose != False and (verbose or logger.isEnabledFor(logging.DEBUG))): - logger.info("RUN: {}\nFROM: {}".format(cmd, os.getcwd() if from_dir is None else from_dir)) - - if (input_str is not None): - stdin = subprocess.PIPE - else: - stdin = None - - proc = subprocess.Popen(cmd, - shell=True, - stdout=arg_stdout, - stderr=arg_stderr, - stdin=stdin, - cwd=from_dir, - env=env) - - output, errput = proc.communicate(input_str) - if output is not None: - try: - output = output.decode('utf-8', errors='ignore').strip() - except AttributeError: - pass - if errput is not None: - try: - errput = errput.decode('utf-8', errors='ignore').strip() - except AttributeError: - pass - - stat = proc.wait() - if six.PY2: - if isinstance(arg_stdout, file): # pylint: disable=undefined-variable - arg_stdout.close() # pylint: disable=no-member - if isinstance(arg_stderr, file) and arg_stderr is not arg_stdout: # pylint: disable=undefined-variable - arg_stderr.close() # pylint: disable=no-member - else: - if isinstance(arg_stdout, io.IOBase): - arg_stdout.close() # pylint: disable=no-member - if isinstance(arg_stderr, io.IOBase) and arg_stderr is not arg_stdout: - arg_stderr.close() # pylint: disable=no-member - - - if (verbose != False and (verbose or logger.isEnabledFor(logging.DEBUG))): - if stat != 0: - logger.info(" stat: {:d}\n".format(stat)) - if output: - logger.info(" output: {}\n".format(output)) - if errput: - logger.info(" errput: {}\n".format(errput)) - - return stat, output, errput - ############################################################################### def buildnml(rundir, bldnmldir): ############################################################################### @@ -159,8 +60,8 @@ def buildnml(rundir, bldnmldir): file_path = os.path.join(rundir,'ctsm.cfg') # read the config file - config = config_parser() - config.read(file_path) # TODO: add the code in externals_description.py to get the error checks + config = ConfigParser() + config.read(file_path) clm_phys = config.get('buildnml_input', 'clm_phys') start_type = config.get('buildnml_input', 'start_type') @@ -201,8 +102,8 @@ def buildnml(rundir, bldnmldir): command = [cmd, '-csmdata', din_loc_root, '-inputdata', os.path.join(rundir, "clm.input_data_list"), - '-namelist', '\'&clm_inparm start_ymd={} {}/\''.format(start_ymd, clm_namelist_opts), - '-use_case',use_case, + '-namelist', '&clm_inparm start_ymd={} {}/'.format(start_ymd, clm_namelist_opts), + '-use_case',use_case, '-res', lnd_grid, '-clm_start_type', start_type, '-l_ncpl', str(1), # this will not be used in lilac - but is needed as input @@ -215,15 +116,13 @@ def buildnml(rundir, bldnmldir): '-clm_accelerated_spinup', spinup, '-lnd_tuning_mode',lnd_tuning_mode, '-config',os.path.join(rundir, "config_cache.xml"), - '-envxml_dir', rundir, - clm_bldnml_opts] + '-envxml_dir', rundir] + command.extend(clm_bldnml_opts.split()) if gridmask != 'null' and gridmask != 'UNSET': command.extend(['-mask', gridmask]) - cmd = ' '.join(command) - rc, out, err = run_cmd(cmd, from_dir=os.getcwd()) - if rc > 0: - raise Exception("Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err)) + subprocess.check_call(command, + universal_newlines=True) # remove temporary files in rundir os.remove(os.path.join(rundir, "config_cache.xml")) From c2e0c50dab546a22036eb258f1e385249afc1b2b Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 12 Feb 2020 11:32:53 -0700 Subject: [PATCH 275/556] Add better error handling in config.get calls --- lilac_config/buildnml | 59 ++++++++++++++++++++++++++++--------------- 1 file changed, 39 insertions(+), 20 deletions(-) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index a826d9477b..4d90cb582f 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -47,10 +47,29 @@ def parse_command_line(args, description): # check if rundir exists if not os.path.isdir(arguments.rundir): - raise Exception("rundir %s does not exist".format(arguments.rundir)) + raise RuntimeError("rundir %s does not exist".format(arguments.rundir)) return arguments.rundir +############################################################################### +def get_config_value(config, section, item, file_path): + """Get a given item from a given section of the config object + + Give a helpful error message if we can't find the given section or item + + Note that the file_path argument is only used for the sake of the error message + """ + try: + val = config.get(section, item) + except NoSectionError: + print("ERROR: Config file {} must contain section '{}'\n".format(file_path, section)) + raise + except NoOptionError: + print("ERROR: Config file {} must contain item '{}' in section '{}'\n".format( + file_path, item, section)) + raise + return val + ############################################################################### def buildnml(rundir, bldnmldir): ############################################################################### @@ -63,25 +82,25 @@ def buildnml(rundir, bldnmldir): config = ConfigParser() config.read(file_path) - clm_phys = config.get('buildnml_input', 'clm_phys') - start_type = config.get('buildnml_input', 'start_type') - start_ymd = config.get('buildnml_input', 'start_ymd') - startfile_type = config.get('buildnml_input', 'startfile_type') - ignore = config.get('buildnml_input', 'ignore') - configuration = config.get('buildnml_input', 'configuration') - structure = config.get('buildnml_input', 'structure') - ccsm_co2_ppmv = config.get('buildnml_input', 'ccsm_co2_ppmv') - clm_co2_type = config.get('buildnml_input', 'clm_co2_type') - clm_bldnml_opts = config.get('buildnml_input', 'clm_bldnml_opts') - use_case = config.get('buildnml_input', 'use_case') - lnd_tuning_mode = config.get('buildnml_input', 'lnd_tuning_mode') - spinup = config.get('buildnml_input', 'spinup') - gridmask = config.get('buildnml_input', 'gridmask') - lnd_grid = config.get('buildnml_input', 'lnd_grid') - lnd_domain_file = config.get('buildnml_input', 'lnd_domain_file') - lnd_domain_path = config.get('buildnml_input', 'lnd_domain_path') - din_loc_root = config.get('buildnml_input', 'din_loc_root') - clm_namelist_opts = config.get('buildnml_input', 'clm_namelist_opts') + clm_phys = get_config_value(config, 'buildnml_input', 'clm_phys', file_path) + start_type = get_config_value(config, 'buildnml_input', 'start_type', file_path) + start_ymd = get_config_value(config, 'buildnml_input', 'start_ymd', file_path) + startfile_type = get_config_value(config, 'buildnml_input', 'startfile_type', file_path) + ignore = get_config_value(config, 'buildnml_input', 'ignore', file_path) + configuration = get_config_value(config, 'buildnml_input', 'configuration', file_path) + structure = get_config_value(config, 'buildnml_input', 'structure', file_path) + ccsm_co2_ppmv = get_config_value(config, 'buildnml_input', 'ccsm_co2_ppmv', file_path) + clm_co2_type = get_config_value(config, 'buildnml_input', 'clm_co2_type', file_path) + clm_bldnml_opts = get_config_value(config, 'buildnml_input', 'clm_bldnml_opts', file_path) + use_case = get_config_value(config, 'buildnml_input', 'use_case', file_path) + lnd_tuning_mode = get_config_value(config, 'buildnml_input', 'lnd_tuning_mode', file_path) + spinup = get_config_value(config, 'buildnml_input', 'spinup', file_path) + gridmask = get_config_value(config, 'buildnml_input', 'gridmask', file_path) + lnd_grid = get_config_value(config, 'buildnml_input', 'lnd_grid', file_path) + lnd_domain_file = get_config_value(config, 'buildnml_input', 'lnd_domain_file', file_path) + lnd_domain_path = get_config_value(config, 'buildnml_input', 'lnd_domain_path', file_path) + din_loc_root = get_config_value(config, 'buildnml_input', 'din_loc_root', file_path) + clm_namelist_opts = get_config_value(config, 'buildnml_input', 'clm_namelist_opts', file_path) # create config_cache.xml file # Note that build-namelist utilizes the contents of the config_cache.xml file in From ef75e803be570c897b2e46adbbde64a6d63c4cd1 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 12 Feb 2020 13:14:24 -0700 Subject: [PATCH 276/556] Add -ignore_ic_year to build-namelist call This was being read from the config file but not actually passed to build-namelist. For now, we assume the use of -ignore_ic_year, NOT -ignore_ic_date. --- lilac/atm_driver/ctsm.cfg | 1 - lilac_config/buildnml | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/lilac/atm_driver/ctsm.cfg b/lilac/atm_driver/ctsm.cfg index a2e46981e7..9705e84a27 100644 --- a/lilac/atm_driver/ctsm.cfg +++ b/lilac/atm_driver/ctsm.cfg @@ -3,7 +3,6 @@ clm_phys = clm5_0 start_type = default start_ymd = 20000101 startfile_type = finidat -ignore = -ignore_ic_year configuration = clm structure = standard ccsm_co2_ppmv = 367.0 diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 4d90cb582f..6e40c9502a 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -86,7 +86,6 @@ def buildnml(rundir, bldnmldir): start_type = get_config_value(config, 'buildnml_input', 'start_type', file_path) start_ymd = get_config_value(config, 'buildnml_input', 'start_ymd', file_path) startfile_type = get_config_value(config, 'buildnml_input', 'startfile_type', file_path) - ignore = get_config_value(config, 'buildnml_input', 'ignore', file_path) configuration = get_config_value(config, 'buildnml_input', 'configuration', file_path) structure = get_config_value(config, 'buildnml_input', 'structure', file_path) ccsm_co2_ppmv = get_config_value(config, 'buildnml_input', 'ccsm_co2_ppmv', file_path) @@ -123,6 +122,7 @@ def buildnml(rundir, bldnmldir): '-inputdata', os.path.join(rundir, "clm.input_data_list"), '-namelist', '&clm_inparm start_ymd={} {}/'.format(start_ymd, clm_namelist_opts), '-use_case',use_case, + '-ignore_ic_year', # For now, we assume ignore_ic_year, not ignore_ic_date '-res', lnd_grid, '-clm_start_type', start_type, '-l_ncpl', str(1), # this will not be used in lilac - but is needed as input From 2952c703d4ed6c80399279b164623205170ec168 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 12 Feb 2020 14:46:42 -0700 Subject: [PATCH 277/556] Fix pylint issues --- lilac/atm_driver/ctsm.cfg | 1 - lilac_config/buildnml | 107 +++++++++++++++++++++----------------- 2 files changed, 60 insertions(+), 48 deletions(-) diff --git a/lilac/atm_driver/ctsm.cfg b/lilac/atm_driver/ctsm.cfg index 9705e84a27..3bea08674f 100644 --- a/lilac/atm_driver/ctsm.cfg +++ b/lilac/atm_driver/ctsm.cfg @@ -2,7 +2,6 @@ clm_phys = clm5_0 start_type = default start_ymd = 20000101 -startfile_type = finidat configuration = clm structure = standard ccsm_co2_ppmv = 367.0 diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 6e40c9502a..dc76f9bcb1 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -4,12 +4,15 @@ CTSM namelist creator """ -import sys, os, subprocess, argparse +import sys +import os +import subprocess +import argparse from configparser import ConfigParser from configparser import NoSectionError, NoOptionError -_config_cache_template = """ +_CONFIG_CACHE_TEMPLATE = """ @@ -17,10 +20,13 @@ _config_cache_template = """ """ -# Note the following is needed in env_lilac.xml otherwise the following error appears in the call to build_namelist -#err=ERROR : CLM build-namelist::CLMBuildNamelist::logical_to_fortran() : Unexpected value in logical_to_fortran: +# Note the following is needed in env_lilac.xml otherwise the following error appears in +# the call to build_namelist -_env_lilac_template = """ +#err=ERROR : CLM build-namelist::CLMBuildNamelist::logical_to_fortran() : +# Unexpected value in logical_to_fortran: + +_ENV_LILAC_TEMPLATE = """ @@ -32,13 +38,14 @@ _env_lilac_template = """ """ -_hack=object() - ############################################################################### def parse_command_line(args, description): ############################################################################### - parser = argparse.ArgumentParser(formatter_class=argparse.RawTextHelpFormatter, description=description) + """Parse the command line, return rundir""" + + parser = argparse.ArgumentParser(formatter_class=argparse.RawTextHelpFormatter, + description=description) parser.add_argument("--rundir", type=str, default=os.getcwd(), help="specify the full path of the run directory") @@ -47,7 +54,7 @@ def parse_command_line(args, description): # check if rundir exists if not os.path.isdir(arguments.rundir): - raise RuntimeError("rundir %s does not exist".format(arguments.rundir)) + raise RuntimeError("rundir {} does not exist".format(arguments.rundir)) return arguments.rundir @@ -74,70 +81,71 @@ def get_config_value(config, section, item, file_path): def buildnml(rundir, bldnmldir): ############################################################################### - """Build the ctsm namelist """ + """Build the ctsm namelist""" + + # pylint: disable=too-many-locals - file_path = os.path.join(rundir,'ctsm.cfg') + file_path = os.path.join(rundir, 'ctsm.cfg') # read the config file config = ConfigParser() config.read(file_path) - clm_phys = get_config_value(config, 'buildnml_input', 'clm_phys', file_path) - start_type = get_config_value(config, 'buildnml_input', 'start_type', file_path) - start_ymd = get_config_value(config, 'buildnml_input', 'start_ymd', file_path) - startfile_type = get_config_value(config, 'buildnml_input', 'startfile_type', file_path) - configuration = get_config_value(config, 'buildnml_input', 'configuration', file_path) - structure = get_config_value(config, 'buildnml_input', 'structure', file_path) - ccsm_co2_ppmv = get_config_value(config, 'buildnml_input', 'ccsm_co2_ppmv', file_path) - clm_co2_type = get_config_value(config, 'buildnml_input', 'clm_co2_type', file_path) - clm_bldnml_opts = get_config_value(config, 'buildnml_input', 'clm_bldnml_opts', file_path) - use_case = get_config_value(config, 'buildnml_input', 'use_case', file_path) - lnd_tuning_mode = get_config_value(config, 'buildnml_input', 'lnd_tuning_mode', file_path) - spinup = get_config_value(config, 'buildnml_input', 'spinup', file_path) - gridmask = get_config_value(config, 'buildnml_input', 'gridmask', file_path) - lnd_grid = get_config_value(config, 'buildnml_input', 'lnd_grid', file_path) - lnd_domain_file = get_config_value(config, 'buildnml_input', 'lnd_domain_file', file_path) - lnd_domain_path = get_config_value(config, 'buildnml_input', 'lnd_domain_path', file_path) - din_loc_root = get_config_value(config, 'buildnml_input', 'din_loc_root', file_path) + clm_phys = get_config_value(config, 'buildnml_input', 'clm_phys', file_path) + start_type = get_config_value(config, 'buildnml_input', 'start_type', file_path) + start_ymd = get_config_value(config, 'buildnml_input', 'start_ymd', file_path) + configuration = get_config_value(config, 'buildnml_input', 'configuration', file_path) + structure = get_config_value(config, 'buildnml_input', 'structure', file_path) + ccsm_co2_ppmv = get_config_value(config, 'buildnml_input', 'ccsm_co2_ppmv', file_path) + clm_co2_type = get_config_value(config, 'buildnml_input', 'clm_co2_type', file_path) + clm_bldnml_opts = get_config_value(config, 'buildnml_input', 'clm_bldnml_opts', file_path) + use_case = get_config_value(config, 'buildnml_input', 'use_case', file_path) + lnd_tuning_mode = get_config_value(config, 'buildnml_input', 'lnd_tuning_mode', file_path) + spinup = get_config_value(config, 'buildnml_input', 'spinup', file_path) + gridmask = get_config_value(config, 'buildnml_input', 'gridmask', file_path) + lnd_grid = get_config_value(config, 'buildnml_input', 'lnd_grid', file_path) + lnd_domain_file = get_config_value(config, 'buildnml_input', 'lnd_domain_file', file_path) + lnd_domain_path = get_config_value(config, 'buildnml_input', 'lnd_domain_path', file_path) + din_loc_root = get_config_value(config, 'buildnml_input', 'din_loc_root', file_path) clm_namelist_opts = get_config_value(config, 'buildnml_input', 'clm_namelist_opts', file_path) - # create config_cache.xml file - # Note that build-namelist utilizes the contents of the config_cache.xml file in + # create config_cache.xml file + # Note that build-namelist utilizes the contents of the config_cache.xml file in # the namelist_defaults.xml file to obtain namelist variables - config_cache = os.path.join(rundir, "config_cache.xml") - config_cache_text = _config_cache_template.format(clm_phys=clm_phys) + config_cache = os.path.join(rundir, "config_cache.xml") + config_cache_text = _CONFIG_CACHE_TEMPLATE.format(clm_phys=clm_phys) with open(config_cache, 'w') as tempfile: tempfile.write(config_cache_text) # create temporary env_lilac.xml env_lilac = os.path.join(rundir, "env_lilac.xml") - env_lilac_text = _env_lilac_template.format() + env_lilac_text = _ENV_LILAC_TEMPLATE.format() with open(env_lilac, 'w') as tempfile: tempfile.write(env_lilac_text) # call build-namelist - cmd = os.path.abspath(os.path.join(bldnmldir, os.pardir, "bld","build-namelist")) + cmd = os.path.abspath(os.path.join(bldnmldir, os.pardir, "bld", "build-namelist")) command = [cmd, - '-csmdata', din_loc_root, - '-inputdata', os.path.join(rundir, "clm.input_data_list"), + '-csmdata', din_loc_root, + '-inputdata', os.path.join(rundir, "clm.input_data_list"), '-namelist', '&clm_inparm start_ymd={} {}/'.format(start_ymd, clm_namelist_opts), - '-use_case',use_case, + '-use_case', use_case, '-ignore_ic_year', # For now, we assume ignore_ic_year, not ignore_ic_date - '-res', lnd_grid, - '-clm_start_type', start_type, + '-res', lnd_grid, + '-clm_start_type', start_type, '-l_ncpl', str(1), # this will not be used in lilac - but is needed as input - '-configuration', configuration, + '-configuration', configuration, '-structure', structure, - '-lnd_frac', os.path.join(lnd_domain_path,lnd_domain_file), - '-glc_nec', str(10), + '-lnd_frac', os.path.join(lnd_domain_path, lnd_domain_file), + '-glc_nec', str(10), '-co2_ppmv', ccsm_co2_ppmv, - '-co2_type', clm_co2_type, + '-co2_type', clm_co2_type, '-clm_accelerated_spinup', spinup, - '-lnd_tuning_mode',lnd_tuning_mode, - '-config',os.path.join(rundir, "config_cache.xml"), + '-lnd_tuning_mode', lnd_tuning_mode, + '-config', os.path.join(rundir, "config_cache.xml"), '-envxml_dir', rundir] command.extend(clm_bldnml_opts.split()) - if gridmask != 'null' and gridmask != 'UNSET': + if gridmask not in ('null', 'UNSET'): command.extend(['-mask', gridmask]) subprocess.check_call(command, @@ -149,10 +157,15 @@ def buildnml(rundir, bldnmldir): os.remove(os.path.join(rundir, "drv_flds_in")) ############################################################################### +def main(): + """Main function""" -if __name__ == "__main__": rundir = parse_command_line(sys.argv[1:], __doc__) bldnmldir = os.path.dirname(os.path.abspath(__file__)) buildnml(rundir, bldnmldir) +############################################################################### + +if __name__ == "__main__": + main() From 7c29ebb6d6708ee2435bea9aa5cb1b02695f8146 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 12 Feb 2020 15:04:47 -0700 Subject: [PATCH 278/556] For now, use -no-megan in lilac's buildnml Eventually we'll want more flexibility in this respect, but for now assume no-megan. See also https://github.com/ESCOMP/CTSM/issues/924. Note that this doesn't appear to actually change anything about lnd_in. --- lilac_config/buildnml | 1 + 1 file changed, 1 insertion(+) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index dc76f9bcb1..30c1ee6b2e 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -142,6 +142,7 @@ def buildnml(rundir, bldnmldir): '-co2_type', clm_co2_type, '-clm_accelerated_spinup', spinup, '-lnd_tuning_mode', lnd_tuning_mode, + '-no-megan', '-config', os.path.join(rundir, "config_cache.xml"), '-envxml_dir', rundir] command.extend(clm_bldnml_opts.split()) From c8b628a5a968f7017b74dc86beee2785e5b66b20 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 12 Feb 2020 15:16:41 -0700 Subject: [PATCH 279/556] Remove any existing clm.input_data_list file Otherwise build-namelist keeps appending to the same file, leading to lots of duplicate entries if you rerun the script multiple times --- lilac_config/buildnml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 30c1ee6b2e..479e53bb34 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -123,11 +123,15 @@ def buildnml(rundir, bldnmldir): with open(env_lilac, 'w') as tempfile: tempfile.write(env_lilac_text) + # remove any existing clm.input_data_list file + inputdatalist_path = os.path.join(rundir, "clm.input_data_list") + os.remove(inputdatalist_path) + # call build-namelist cmd = os.path.abspath(os.path.join(bldnmldir, os.pardir, "bld", "build-namelist")) command = [cmd, '-csmdata', din_loc_root, - '-inputdata', os.path.join(rundir, "clm.input_data_list"), + '-inputdata', inputdatalist_path, '-namelist', '&clm_inparm start_ymd={} {}/'.format(start_ymd, clm_namelist_opts), '-use_case', use_case, '-ignore_ic_year', # For now, we assume ignore_ic_year, not ignore_ic_date From 62b8d39a1a60964c87ca82e4849736c3bfd3f4ff Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 12 Feb 2020 15:32:48 -0700 Subject: [PATCH 280/556] Fix cprnc command in readme --- README.lilac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.lilac b/README.lilac index dd3ee0e0fe..edaf916403 100644 --- a/README.lilac +++ b/README.lilac @@ -61,7 +61,7 @@ library (I), do the following: > basedir=/glade/p/cgd/tss/ctsm_baselines/lilac_20191202 > cprnc test_lilac.clm2.h0.2000-01-03-00000.nc $basedir/test_lilac.clm2.h0.2000-01-03-00000.nc | tail -30 > cprnc test_lilac.lilac.hi.2000-01-02-81000.nc $basedir/test_lilac.lilac.hi.2000-01-02-81000.nc | tail -30 - > cprnc test_lilac.atm.h0.0001-01.nc $basedir/test_lilac.atm.h0.0001-01.nc | tail -30 + > cprnc -m test_lilac.atm.h0.0001-01.nc $basedir/test_lilac.atm.h0.0001-01.nc | tail -30 5) if there are differences, and those are intentional, then create new baselines From d9701e03560215c362c7108ec6a383cab0417a9e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 12 Feb 2020 16:55:55 -0700 Subject: [PATCH 281/556] Add some references to GitHub issues --- lilac_config/buildnml | 2 +- src/cpl/lilac/lnd_comp_esmf.F90 | 16 ++++++++++++++-- src/cpl/lilac/lnd_import_export.F90 | 2 +- 3 files changed, 16 insertions(+), 4 deletions(-) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 479e53bb34..5ce6010a3c 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -146,7 +146,7 @@ def buildnml(rundir, bldnmldir): '-co2_type', clm_co2_type, '-clm_accelerated_spinup', spinup, '-lnd_tuning_mode', lnd_tuning_mode, - '-no-megan', + '-no-megan', # Eventually make this dynamic (see https://github.com/ESCOMP/CTSM/issues/926) '-config', os.path.join(rundir, "config_cache.xml"), '-envxml_dir', rundir] command.extend(clm_bldnml_opts.split()) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 8068e6d42c..56d4ebc164 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -190,6 +190,8 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! TODO: by default iulog = 6 in clm_varctl - this should be generalized so that we ! can control the output log file for ctsm running with a lilac driver + ! + ! See also https://github.com/ESCOMP/CTSM/issues/861 inst_name = 'LND'; inst_index = 1; inst_suffix = "" @@ -212,6 +214,8 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! TODO: orbital values should be provided by lilac - but for now lets use defaults !! hard wire these these in and we can decide on maybe having a namelist/ + ! + ! See also https://github.com/ESCOMP/CTSM/issues/865 !call shr_cal_date2ymd(ymd,year,month,day) !orb_cyear = orb_iyear + (year - orb_iyear_align) @@ -501,6 +505,8 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else ! TODO: get this from the import state nextsw_cday attribute + ! + ! See also https://github.com/ESCOMP/CTSM/issues/860 end if ! Set nextsw_cday @@ -666,8 +672,12 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) dosend = .false. do while(.not. dosend) - ! TODO: This is currently hard-wired - is there a better way for nuopc? - ! Note that the model clock is updated at the end of the time step not at the beginning + ! We assume that the land model time step matches the coupling interval. However, + ! we still need this while loop to handle the initial time step (time 0). We may + ! want to get rid of this time step 0 in the lilac coupling, at which point we + ! should be able to remove this while loop and dosend variable. + ! + ! See also https://github.com/ESCOMP/CTSM/issues/925 nstep = get_nstep() if (nstep > 0) then dosend = .true. @@ -686,6 +696,8 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) ! TODO(NS): nextsw_cday should come directly from atmosphere! ! For now I am setting nextsw_cday to be the same caldayp1 + ! + ! See also https://github.com/ESCOMP/CTSM/issues/860 nextsw_cday = calday if (masterproc) then diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 5807d58a8c..d47069b63a 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -17,7 +17,7 @@ module lnd_import_export use lnd2glcMod , only : lnd2glc_type use atm2lndType , only : atm2lnd_type use lnd_shr_methods , only : chkerr - use shr_megan_mod , only : shr_megan_mechcomps_n ! TODO: need to add a namelist read nere + use shr_megan_mod , only : shr_megan_mechcomps_n ! TODO: need to add a namelist read here (see https://github.com/ESCOMP/CTSM/issues/926) implicit none private ! except From dd8c99c512e2e82713c4be778bc867e54c39c0b7 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 13 Feb 2020 14:48:38 -0700 Subject: [PATCH 282/556] Remove some todo notes related to calendar By adding some print statements, I checked that both CTSM and lilac_atmaero use the calendar prescribed by atm_driver_in. --- lilac/src/lilac_mod.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 5b217f0298..0716416ece 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -154,9 +154,6 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & ! NOTE: the default calendar is set to GREGORIAN and is reset below in the initialization of ! the lilac clock - ! TODO: ensure that CTSM queries the lilac_clock for the calendar and initializes its own - ! internal clock accordingly - ! TODO: the same is true for the datm time manager that reads in prescribed data call ESMF_Initialize(mpiCommunicator=mpicom, defaultCalKind=ESMF_CALKIND_GREGORIAN, & logappendflag=.false., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 2a7fe085ccec28c598a1322e98efb6c4e0053f7a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 13 Feb 2020 14:52:21 -0700 Subject: [PATCH 283/556] Change 'and' to 'or' in time sync check --- src/cpl/lilac/lnd_comp_esmf.F90 | 2 +- src/cpl/nuopc/lnd_comp_nuopc.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 56d4ebc164..fc7a7ba6b7 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -849,7 +849,7 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) ! Note that the driver clock has not been updated yet - so at this point ! CTSM is actually 1 coupling intervals ahead of the driver clock - if ( (ymd /= ymd_lilac) .and. (tod /= tod_lilac) ) then + if ( (ymd /= ymd_lilac) .or. (tod /= tod_lilac) ) then write(iulog,*)'ctsm ymd=',ymd ,' ctsm tod= ',tod write(iulog,*)'lilac ymd=',ymd_lilac,' lilac tod= ',tod_lilac rc = ESMF_FAILURE diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index df4919d10d..d3218c5b8d 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -889,7 +889,7 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) - if ( (ymd /= ymd_sync) .and. (tod /= tod_sync) ) then + if ( (ymd /= ymd_sync) .or. (tod /= tod_sync) ) then write(iulog,*)'ctsm ymd=',ymd ,' ctsm tod= ',tod write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync rc = ESMF_FAILURE From b4212e284180fd8ed031357643a966af78e15aa5 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 13 Feb 2020 15:03:37 -0700 Subject: [PATCH 284/556] Return after detecting clocks out of sync This follows the pattern of what is done elsewhere when setting rc = ESMF_FAILURE: we generally return immediately after doing that. --- src/cpl/lilac/lnd_comp_esmf.F90 | 3 ++- src/cpl/nuopc/lnd_comp_nuopc.F90 | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index fc7a7ba6b7..5a8455b173 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -852,8 +852,9 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) if ( (ymd /= ymd_lilac) .or. (tod /= tod_lilac) ) then write(iulog,*)'ctsm ymd=',ymd ,' ctsm tod= ',tod write(iulog,*)'lilac ymd=',ymd_lilac,' lilac tod= ',tod_lilac - rc = ESMF_FAILURE call ESMF_LogWrite(subname//" CTSM clock not in sync with lilac clock",ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return end if !-------------------------------- diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index d3218c5b8d..4ee197c746 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -892,8 +892,9 @@ subroutine ModelAdvance(gcomp, rc) if ( (ymd /= ymd_sync) .or. (tod /= tod_sync) ) then write(iulog,*)'ctsm ymd=',ymd ,' ctsm tod= ',tod write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync - rc = ESMF_FAILURE call ESMF_LogWrite(subname//" CTSM clock not in sync with Master Sync clock",ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return end if !-------------------------------- From 2d277c107940aa941d0649432e0aba9cc3d94cd2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 20 Feb 2020 16:01:19 -0700 Subject: [PATCH 285/556] Make gindex_ocn intent(inout) rather than intent(out) Although gindex_ocn could be intent(out), intel18.0.3 generates a runtime segmentation fault in runs that don't have this argument present when this is declared intent(out). (It works fine on intel 19.0.2 when declared as intent(out).) Resolves ESCOMP/ctsm#930 --- src/main/clm_initializeMod.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 535e8bc2a3..32ff522a91 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -61,7 +61,12 @@ subroutine initialize1(gindex_ocn, dtime_driver) use UrbanParamsType , only: UrbanInput, IsSimpleBuildTemp ! ! !ARGUMENTS - integer, pointer, optional, intent(out) :: gindex_ocn(:) ! If present, this will hold the decomposition of ocean points (which is needed for the nuopc interface); note that this variable is allocated here, and is assumed to start unallocated + ! COMPILER_BUG(wjs, 2020-02-20, intel18.0.3) Although gindex_ocn could be + ! intent(out), intel18.0.3 generates a runtime segmentation fault in runs that don't + ! have this argument present when this is declared intent(out). (It works fine on + ! intel 19.0.2 when declared as intent(out).) See also + ! https://github.com/ESCOMP/CTSM/issues/930. + integer, pointer, optional, intent(inout) :: gindex_ocn(:) ! If present, this will hold the decomposition of ocean points (which is needed for the nuopc interface); note that this variable is allocated here, and is assumed to start unallocated integer, intent(in), optional :: dtime_driver ! ! !LOCAL VARIABLES: From 6e416d9cca8bf86f5a9cf1ee4bc7d45dc5db657b Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 21 Feb 2020 06:06:39 -0700 Subject: [PATCH 286/556] Check userRc in addition to rc Some ESMF routines have an optional userRc argument that holds the return code from the user callback that is called from these ESMF routines. It is important to check this argument, too, in order to catch errors that occur in the user routine. In fact, most errors will show up in this argument rather than the standard rc argument: the userRc argument captures any error that is raised in routines like lnd_init and lnd_run. --- lilac/src/lilac_mod.F90 | 87 +++++++++++++++++++++++++++-------------- 1 file changed, 58 insertions(+), 29 deletions(-) diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 0716416ece..d05746c89c 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -112,7 +112,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & integer :: lsize type(ESMF_State) :: importState, exportState type(ESMF_VM) :: vm - integer :: rc + integer :: user_rc, rc character(len=ESMF_MAXSTR) :: cname !components or cpl names integer :: ierr integer :: n, i @@ -259,7 +259,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & !------------------------------------------------------------------------- ! Register section -- set services -- atmcap - call ESMF_GridCompSetServices(atm_gcomp, userRoutine=lilac_atmcap_register, rc=rc) + call ESMF_GridCompSetServices(atm_gcomp, userRoutine=lilac_atmcap_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('atm_gcomp register failure') if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('atm_gcomp register failure') call ESMF_LogWrite(subname//" atmos SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -267,7 +268,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & end if ! Register section -- set services -- ctsm - call ESMF_GridCompSetServices(lnd_gcomp, userRoutine=lnd_register, rc=rc) + call ESMF_GridCompSetServices(lnd_gcomp, userRoutine=lnd_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('lnd_gcomp register failure') if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('lnd_gcomp register failure') call ESMF_LogWrite(subname//"CSTM SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -275,7 +277,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & end if ! Register section -- set services -- mosart - call ESMF_GridCompSetServices(rof_gcomp, userRoutine=rof_register, rc=rc) + call ESMF_GridCompSetServices(rof_gcomp, userRoutine=rof_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('rof_gcomp register failure') if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('rof_gcomp register failure') call ESMF_LogWrite(subname//"MOSART SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -283,7 +286,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & end if ! Register section -- set services -- coupler atmosphere to land - call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, rc=rc) + call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_atm2lnd_comp register failure') if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_atm2lnd_comp register failure') call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -291,7 +295,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & end if ! Register section -- set services -- river to land - call ESMF_CplCompSetServices(cpl_rof2lnd_comp, userRoutine=cpl_rof2lnd_register, rc=rc) + call ESMF_CplCompSetServices(cpl_rof2lnd_comp, userRoutine=cpl_rof2lnd_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_rof2lnd_comp register failure') if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_rof2lnd_comp register failure') call ESMF_LogWrite(subname//"Coupler from river to land SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -299,7 +304,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & end if ! Register section -- set services -- coupler land to atmosphere - call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_lnd2atm_register, rc=rc) + call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_lnd2atm_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2atm_comp register failure') if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2atm_comp register failure') call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -307,7 +313,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & end if ! Register section -- set services -- coupler land to river - call ESMF_CplCompSetServices(cpl_lnd2rof_comp, userRoutine=cpl_lnd2rof_register, rc=rc) + call ESMF_CplCompSetServices(cpl_lnd2rof_comp, userRoutine=cpl_lnd2rof_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2rof_comp register failure') if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2rof_comp register failure') call ESMF_LogWrite(subname//"Coupler from land to river SetServices finished!", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -339,7 +346,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & ! Initialze lilac_atm gridded component call ESMF_GridCompInitialize(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing atmcap") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing atmcap") call ESMF_LogWrite(subname//"lilac_atm gridded component initialized", ESMF_LOGMSG_INFO) @@ -357,7 +365,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & ! Initialze CTSM Gridded Component call ESMF_GridCompInitialize(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing ctsm") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing ctsm") call ESMF_LogWrite(subname//"CTSM gridded component initialized", ESMF_LOGMSG_INFO) @@ -370,7 +379,8 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & ! Initialize MOSART Gridded Component call ESMF_GridCompInitialize(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing mosart") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing mosart") call ESMF_LogWrite(subname//"MOSART gridded component initialized", ESMF_LOGMSG_INFO) end if @@ -383,26 +393,30 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & ! one for the river and one for the atm - ! The following fills in the atm field bundle in cpl2lnd_state call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_atm2lnd component") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_atm2lnd component") call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) ! The following maps the atm field bundle in lnd2cpl_state to the atm mesh call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2cpl_state, exportState=cpl2atm_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) if (couple_to_river) then ! The following maps the rof field bundle in lnd2cpl_state to the rof mesh call ESMF_CplCompInitialize(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2rof component") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2rof component") call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) ! The following fills in the rof field bundle in cpl2lnd_state call ESMF_CplCompInitialize(cpl_rof2lnd_comp, importState=rof2cpl_state, exportState=cpl2lnd_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing cpl_lnd2atm component") call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) end if @@ -447,7 +461,7 @@ subroutine lilac_run(write_restarts_now, stop_now) type(ESMF_Alarm) :: lilac_history_alarm type(ESMF_Alarm) :: lilac_restart_alarm type(ESMF_State) :: importState, exportState - integer :: rc + integer :: user_rc, rc character(len=*), parameter :: subname=trim(modname)//': [lilac_run] ' !------------------------------------------------------------------------ @@ -490,7 +504,8 @@ subroutine lilac_run(write_restarts_now, stop_now) call ESMF_LogWrite(subname//"running lilac atmos_cap", ESMF_LOGMSG_INFO) if (mytask == 0) write(logunit,*) "Running atmos_cap gridded component , rc =", rc call ESMF_GridCompRun(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") ! Update prescribed aerosols atm2cpl_a_state @@ -501,7 +516,8 @@ subroutine lilac_run(write_restarts_now, stop_now) call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) write(logunit,*) "Running coupler component..... cpl_atm2lnd_comp" call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_atm2lnd") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_atm2lnd") ! Run ctsm @@ -510,7 +526,8 @@ subroutine lilac_run(write_restarts_now, stop_now) call ESMF_LogWrite(subname//"running ctsm", ESMF_LOGMSG_INFO) if (mytask == 0) write(logunit,*) "Running ctsm" call ESMF_GridCompRun(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") ! Run cpl_lnd2atm @@ -519,7 +536,8 @@ subroutine lilac_run(write_restarts_now, stop_now) write(logunit,*) "Running coupler component..... cpl_lnd2atm_comp , rc =", rc end if call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2cpl_state, exportState=cpl2atm_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in cpl_lnd2atm") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in cpl_lnd2atm") if (couple_to_river) then @@ -527,7 +545,8 @@ subroutine lilac_run(write_restarts_now, stop_now) call ESMF_LogWrite(subname//"running cpl_lnd2rof_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) write(logunit,*) "Running coupler component..... cpl_lnd2rof_comp" call ESMF_CplCompRun(cpl_lnd2rof_comp, importState=lnd2cpl_state, exportState=cpl2rof_state, & - clock=lilac_clock, rc=rc) + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_lnd2rof") if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_lnd2rof") ! Run mosart @@ -536,15 +555,17 @@ subroutine lilac_run(write_restarts_now, stop_now) call ESMF_LogWrite(subname//"running mosart", ESMF_LOGMSG_INFO) if (mytask == 0) write(logunit,*) "Running mosart" call ESMF_GridCompRun(rof_gcomp, importState=cpl2rof_state, exportState=rof2cpl_state, & - clock=lilac_clock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running ctsm") + clock=lilac_clock, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running rof") + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running rof") ! Run cpl_rof2lnd ! TODO: uncommenting this needs to be tested ! call ESMF_LogWrite(subname//"running cpl_rof2lnd_comp ", ESMF_LOGMSG_INFO) ! if (mytask == 0) write(logunit,*) "Running coupler component..... cpl_rof2lnd_comp" ! call ESMF_CplCompRun(cpl_rof2lnd_comp, importState=rof2cpl_state, exportState=cpl2lnd_state, & - ! clock=lilac_clock, rc=rc) + ! clock=lilac_clock, userRc=user_rc, rc=rc) + ! if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_rof2lnd") ! if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running cpl_rof2lnd") end if @@ -589,7 +610,7 @@ subroutine lilac_final( ) ! local variables type(ESMF_State) :: importState, exportState - integer :: rc, userRC + integer :: rc, user_rc character(len=*), parameter :: subname=trim(modname)//': [lilac_final] ' !------------------------------------------------------------------------ @@ -603,7 +624,9 @@ subroutine lilac_final( ) end if ! Gridded Component Finalizing! --- atmosphere - call ESMF_GridCompFinalize(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, clock=lilac_clock, rc=rc) + call ESMF_GridCompFinalize(atm_gcomp, importState=cpl2atm_state, exportState=atm2cpl_state, clock=lilac_clock, & + userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) return if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"atmos_cap or atm_gcomp is running", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -611,7 +634,9 @@ subroutine lilac_final( ) end if ! Coupler component Finalizing --- coupler atmos to land - call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, clock=lilac_clock, rc=rc) + call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2cpl_state, exportState=cpl2lnd_state, clock=lilac_clock, & + userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) return if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -619,7 +644,9 @@ subroutine lilac_final( ) end if ! Gridded Component Finalizing! --- land - call ESMF_GridCompFinalize(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, clock=lilac_clock, rc=rc) + call ESMF_GridCompFinalize(lnd_gcomp, importState=cpl2lnd_state, exportState=lnd2cpl_state, clock=lilac_clock, & + userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) return if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"lnd_cap or lnd_gcomp is running", ESMF_LOGMSG_INFO) if (mytask == 0) then @@ -627,7 +654,9 @@ subroutine lilac_final( ) end if ! Coupler component Finalizing --- coupler land to atmos - call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=cpl2lnd_state, exportState=cpl2atm_state, clock=lilac_clock, rc=rc) + call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=cpl2lnd_state, exportState=cpl2atm_state, clock=lilac_clock, & + userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) return if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) then From 2301d1301d12da6b09e4d0050ac2a3fd3450972b Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 24 Feb 2020 13:55:27 -0700 Subject: [PATCH 287/556] Change mpi_bcast to shr_mpi_bcast I needed this on my mac because 'use mpi' doesn't work there (I think we'd need to '#include ', but it's more robust to just use shr_mpi_mod). --- Externals.cfg | 2 +- src/cpl/lilac/lnd_comp_esmf.F90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index d2c294c57f..041aa445bc 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -23,7 +23,7 @@ required = True local_path = components/mosart protocol = git repo_url = https://github.com/ESCOMP/mosart -tag = 14d02bb +tag = a4baa3c required = True [cime] diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 5a8455b173..676d4bf34c 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -7,7 +7,7 @@ module lnd_comp_esmf ! external libraries use ESMF - use mpi , only : MPI_BCAST, MPI_CHARACTER + use shr_mpi_mod , only : shr_mpi_bcast use perf_mod , only : t_startf, t_stopf, t_barrierf ! lilac code @@ -251,7 +251,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) end if close(fileunit) end if - call mpi_bcast(lnd_mesh_filename, len(lnd_mesh_filename), MPI_CHARACTER, 0, mpicom, ierr) + call shr_mpi_bcast(lnd_mesh_filename, mpicom) !---------------------- ! Obtain caseid and start type from attributes in import state From bcf43e4fdc3ed962d2b504845bc5c9dde7e24a58 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 24 Feb 2020 16:00:06 -0700 Subject: [PATCH 288/556] Fix / generalize lilac build to work on my mac --- cime_config/buildlib | 46 +++++++++++++++++++++------------ lilac/atm_driver/Makefile | 19 ++++++++++---- lilac/atm_driver/atm_driver.F90 | 5 ++-- lilac_config/buildnml | 3 ++- 4 files changed, 48 insertions(+), 25 deletions(-) diff --git a/cime_config/buildlib b/cime_config/buildlib index 1cc10f0bc5..3b6be45163 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -30,26 +30,37 @@ def _get_osvar(key, default): return value ############################################################################### -def _write_ctsm_mk(exeroot, debug): +def _write_ctsm_mk(exeroot, libroot, machine): """Writes a ctsm.mk file in exeroot. This file can be included by atmosphere model builds outside of cime. - NOTE: This currently has some hard-coded settings for cheyenne. Also, it assumes that - ESMFMKFILE is set in your environment. + NOTE: This currently only supports the machines cheyenne (intel) and bishorn + (gnu). Also, it assumes that ESMFMKFILE is set in your environment. Arguments: exeroot (str): path to build directory - debug (logical): True if building in debug mode, False otherwise + libroot (str): path to directory containing libclm.a + machine (str): name of machine """ - if debug: - debug_path = 'debug' - else: - debug_path = 'nodebug' - ctsm_mk_path = os.path.join(exeroot, 'ctsm.mk') + ctsm_bld_dir = os.path.abspath(os.path.join(libroot, os.pardir)) + shared_bld_dir = os.path.abspath(os.path.join(ctsm_bld_dir, os.pardir, os.pardir)) esmfmkfile = os.environ['ESMFMKFILE'] + + # Set machine-specific libs for machines we currently support. Note there are a lot of + # hard-coded assumptions here, regarding the compiler, paths to libraries, etc. + # + # ESMF library doesn't need to be included here, because the necessary elements of the + # link line for that are included elsewhere. + if machine == 'cheyenne': + machine_specific_libs = '-mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib' + elif machine == 'bishorn': + machine_specific_libs = '-L/usr/local/lib -lnetcdff -lnetcdf -framework Accelerate' + else: + expect(False, "Unknown machine for LILAC's ctsm.mk file: {}".format(machine)) + with open(ctsm_mk_path, 'w') as ctsm_mk: ctsm_mk.write(""" # ====================================================================== @@ -68,14 +79,14 @@ def _write_ctsm_mk(exeroot, debug): include {esmfmkfile} -SHARED_BLD_DIR = {exeroot}/intel/mpt/{debug_path}/nothreads/nuopc -CTSM_BLD_DIR = $(SHARED_BLD_DIR)/nuopc/esmf +SHARED_BLD_DIR = {shared_bld_dir} +CTSM_BLD_DIR = {ctsm_bld_dir} DEPENDS_LIB = $(SHARED_BLD_DIR)/lib -SHR_LIB = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/lib -SHR_INC = $(SHARED_BLD_DIR)/nuopc/esmf/c1a1l1/csm_share +SHR_LIB = $(CTSM_BLD_DIR)/c1a1l1/lib +SHR_INC = $(CTSM_BLD_DIR)/c1a1l1/csm_share CTSM_INC = $(CTSM_BLD_DIR)/clm/obj -LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib +LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu {machine_specific_libs} # ====================================================================== # The following settings should be included in an atmosphere model's build. @@ -83,7 +94,8 @@ LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lp CTSM_INCLUDES = $(ESMF_F90COMPILEPATHS) -I$(SHR_INC) -I$(CTSM_INC) CTSM_LIBS = $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) $(LIBS) -""".format(esmfmkfile=esmfmkfile, exeroot=exeroot, debug_path=debug_path)) +""".format(esmfmkfile=esmfmkfile, shared_bld_dir=shared_bld_dir, ctsm_bld_dir=ctsm_bld_dir, + machine_specific_libs=machine_specific_libs)) ############################################################################### def _main_func(): @@ -102,8 +114,10 @@ def _main_func(): lilac_mode = _get_osvar('LILAC_MODE', 'off') if lilac_mode == 'on': driver = "lilac" + machine = case.get_value('MACH') _write_ctsm_mk(exeroot=case.get_value("EXEROOT"), - debug=case.get_value("DEBUG")) + libroot=libroot, + machine=machine) #------------------------------------------------------- # create Filepath file diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index e586643f81..8aaea82e93 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -3,12 +3,23 @@ #================================================================================ #================================================================================ -# Note: You must set the environment variable CTSM_MKFILE before running this - e.g. -# export CTSM_MKFILE=/glade/scratch/sacks/test_lilac_1205a/bld/ctsm.mk +# NOTE: Before running this, you must: +# +# (1) Run cime's configure tool in order to generate a Macros.make file +# +# (2) Source the .env_mach_specific.sh file created by the configure +# tool in order to set up the environment correctly. Among other +# things, this should set the environment variable ESMFMKFILE. (See +# notes below about the need for this.) +# +# (3) Set the environment variable CTSM_MKFILE - e.g. +# +# export CTSM_MKFILE=/glade/scratch/sacks/test_lilac_1205a/bld/ctsm.mk # -# ESMFMKFILE must also be set in the environment #================================================================================ +include Macros.make + include $(CTSM_MKFILE) # Most atmosphere model builds shouldn't need this directly, but we use @@ -17,8 +28,6 @@ include $(CTSM_MKFILE) # change later.) include $(ESMFMKFILE) -FFLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -free - #================================================================================ # Compiler and linker rules using ESMF_ variables supplied by esmf.mk #================================================================================ diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index ca5594f6bc..e8be46079b 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -15,19 +15,18 @@ program atm_driver ! | | | ! ESMF lilac_atmcap ESMF CTSM cap ESMF river cap (Mizzouroute, Mosart) !---------------------------------------------------------------------------- - + use netcdf , only : nf90_open, nf90_create, nf90_enddef, nf90_close use netcdf , only : nf90_clobber, nf90_write, nf90_nowrite, nf90_noerr, nf90_double use netcdf , only : nf90_def_dim, nf90_def_var, nf90_put_var use netcdf , only : nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_varid, nf90_get_var - use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS - use mpi , only : MPI_GATHER, MPI_INT, MPI_DOUBLE use lilac_mod , only : lilac_init, lilac_run, lilac_final use lilac_atmcap, only : lilac_atmcap_atm2lnd, lilac_atmcap_lnd2atm use shr_cal_mod , only : shr_cal_date2ymd use shr_sys_mod , only : shr_sys_abort implicit none +#include integer :: comp_comm integer :: ierr diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 5ce6010a3c..6ce420d417 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -125,7 +125,8 @@ def buildnml(rundir, bldnmldir): # remove any existing clm.input_data_list file inputdatalist_path = os.path.join(rundir, "clm.input_data_list") - os.remove(inputdatalist_path) + if os.path.exists(inputdatalist_path): + os.remove(inputdatalist_path) # call build-namelist cmd = os.path.abspath(os.path.join(bldnmldir, os.pardir, "bld", "build-namelist")) From 9408f35957c492ce4c6200ece1326c7305b0c0c2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 24 Feb 2020 16:04:09 -0700 Subject: [PATCH 289/556] Change a comment --- lilac/atm_driver/atm_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index e8be46079b..d81e09c504 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -243,7 +243,7 @@ program atm_driver end if do nstep = 1,atm_nsteps - ! fill in the dataptr values in atm2lnd type in lilac_atmcap + ! fill in the dataptr in lilac_coupling_fields call atm_driver_to_lilac (atm_lons, atm_lats, nstep, atm_nsteps) if (nstep == atm_nsteps) then From b04af8c5b1d6291999e1955800611e9a6dc2dafb Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 24 Feb 2020 16:15:32 -0700 Subject: [PATCH 290/556] Update README for new build process --- README.lilac | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/README.lilac b/README.lilac index edaf916403..c94debf68d 100644 --- a/README.lilac +++ b/README.lilac @@ -35,8 +35,10 @@ library (I), do the following: > export CTSM_MKFILE=$CASEDIR/bld/ctsm.mk > cd $SRCROOT/lilac/atm_driver + > $SRCROOT/cime/tools/configure --comp-interface nuopc --macros-format Makefile --clean > make clean - > source $CASEDIR/.env_mach_specific.sh + > source ./.env_mach_specific.sh + > export DEBUG=TRUE > make atm_driver 2) to generate the input namelists From 73ea0276c93865d6ef732d7b269af29bc418d153 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 27 Feb 2020 16:25:41 -0700 Subject: [PATCH 291/556] Major overhaul of how LILAC fields are stored and interacted with Part of the point of this is to clean things up: use integer indices rather than strings, and use the dynamic vector infrastructure. Part of the point is to provide some new functionality, such as the atmosphere dictating which fields should be read from data. --- lilac/atm_driver/atm_driver.F90 | 104 ++-- lilac/src/ctsm_LilacAtm2LndFieldListType.F90 | 493 +++++++++++++++++++ lilac/src/ctsm_LilacCouplingFieldIndices.F90 | 83 ++++ lilac/src/ctsm_LilacCouplingFields.F90 | 295 +++++++++++ lilac/src/ctsm_LilacLnd2AtmFieldListType.F90 | 357 ++++++++++++++ lilac/src/lilac_atmcap.F90 | 250 +--------- lilac/src/lilac_constants.F90 | 2 + lilac/src/lilac_io.F90 | 3 +- lilac/src/lilac_mod.F90 | 57 ++- lilac/src/lilac_time.F90 | 6 +- src/cpl/lilac/lnd_comp_esmf.F90 | 10 +- 11 files changed, 1364 insertions(+), 296 deletions(-) create mode 100644 lilac/src/ctsm_LilacAtm2LndFieldListType.F90 create mode 100644 lilac/src/ctsm_LilacCouplingFieldIndices.F90 create mode 100644 lilac/src/ctsm_LilacCouplingFields.F90 create mode 100644 lilac/src/ctsm_LilacLnd2AtmFieldListType.F90 diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index d81e09c504..65ec080a88 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -20,8 +20,13 @@ program atm_driver use netcdf , only : nf90_clobber, nf90_write, nf90_nowrite, nf90_noerr, nf90_double use netcdf , only : nf90_def_dim, nf90_def_var, nf90_put_var use netcdf , only : nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_varid, nf90_get_var - use lilac_mod , only : lilac_init, lilac_run, lilac_final - use lilac_atmcap, only : lilac_atmcap_atm2lnd, lilac_atmcap_lnd2atm + use lilac_mod , only : lilac_init1, lilac_init2, lilac_run, lilac_final + use ctsm_LilacCouplingFieldIndices + use ctsm_LilacCouplingFields, only : lilac_atm2lnd, lilac_lnd2atm + ! A real atmosphere should not use l2a_fields directly. We use it here just for + ! convenience of writing every lnd -> atm field to a diagnostic output file. + use ctsm_LilacCouplingFields, only : l2a_fields + use shr_cal_mod , only : shr_cal_date2ymd use shr_sys_mod , only : shr_sys_abort @@ -172,10 +177,28 @@ program atm_driver if (masterproc ) then print *, " initializing lilac with start type ",trim(atm_starttype) end if - call lilac_init(comp_comm, atm_global_index, atm_lons, atm_lats, & - atm_global_nx, atm_global_ny, atm_calendar, atm_timestep, & - atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - atm_starttype) + call lilac_init1() + call lilac_init2( & + mpicom = comp_comm, & + atm_global_index = atm_global_index, & + atm_lons = atm_lons, & + atm_lats = atm_lats, & + atm_global_nx = atm_global_nx, & + atm_global_ny = atm_global_ny, & + atm_calendar = atm_calendar, & + atm_timestep = atm_timestep, & + atm_start_year = atm_start_year, & + atm_start_mon = atm_start_mon, & + atm_start_day = atm_start_day, & + atm_start_secs = atm_start_secs, & + starttype_in = atm_starttype, & + fields_needed_from_data = [ & + lilac_a2l_Faxa_bcphidry, lilac_a2l_Faxa_bcphodry, lilac_a2l_Faxa_bcphiwet, & + lilac_a2l_Faxa_ocphidry, lilac_a2l_Faxa_ocphodry, lilac_a2l_Faxa_ocphiwet, & + lilac_a2l_Faxa_dstwet1, lilac_a2l_Faxa_dstdry1, & + lilac_a2l_Faxa_dstwet2, lilac_a2l_Faxa_dstdry2, & + lilac_a2l_Faxa_dstwet3, lilac_a2l_Faxa_dstdry3, & + lilac_a2l_Faxa_dstwet4, lilac_a2l_Faxa_dstdry4]) !------------------------------------------------------------------------ ! Run lilac @@ -386,62 +409,62 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) ! variable doesn't actually impact the running of CTSM, but it is used for ! consistency checking. data(:) = 0.d0 - call lilac_atmcap_atm2lnd('Sa_landfrac', data) + call lilac_atm2lnd(lilac_a2l_Sa_landfrac, data) ! In the following, try to have each field have different values, in order to catch ! mis-matches (e.g., if foo and bar were accidentally swapped in CTSM, we couldn't ! catch that if they both had the same value). data(:) = 30.0d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Sa_z', data) + call lilac_atm2lnd(lilac_a2l_Sa_z, data) data(:) = 10.0d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Sa_topo', data) + call lilac_atm2lnd(lilac_a2l_Sa_topo, data) data(:) = 20.0d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Sa_u', data) + call lilac_atm2lnd(lilac_a2l_Sa_u, data) data(:) = 40.0d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Sa_v', data) + call lilac_atm2lnd(lilac_a2l_Sa_v, data) data(:) = 280.1d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Sa_ptem', data) + call lilac_atm2lnd(lilac_a2l_Sa_ptem, data) data(:) = 100100.0d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Sa_pbot', data) + call lilac_atm2lnd(lilac_a2l_Sa_pbot, data) data(:) = 280.0d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Sa_tbot', data) + call lilac_atm2lnd(lilac_a2l_Sa_tbot, data) data(:) = 0.0004d0 + space_time_perturbation(:)*1.0e-8 - call lilac_atmcap_atm2lnd('Sa_shum', data) + call lilac_atm2lnd(lilac_a2l_Sa_shum, data) data(:) = 200.0d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Faxa_lwdn', data) + call lilac_atm2lnd(lilac_a2l_Faxa_lwdn, data) data(:) = 1.0d-8 + space_time_perturbation(:)*1.0e-8 - call lilac_atmcap_atm2lnd('Faxa_rainc', data) + call lilac_atm2lnd(lilac_a2l_Faxa_rainc, data) data(:) = 2.0d-8 + space_time_perturbation(:)*1.0e-8 - call lilac_atmcap_atm2lnd('Faxa_rainl', data) + call lilac_atm2lnd(lilac_a2l_Faxa_rainl, data) data(:) = 1.0d-9 + space_time_perturbation(:)*1.0e-9 - call lilac_atmcap_atm2lnd('Faxa_snowc', data) + call lilac_atm2lnd(lilac_a2l_Faxa_snowc, data) data(:) = 2.0d-9 + space_time_perturbation(:)*1.0e-9 - call lilac_atmcap_atm2lnd('Faxa_snowl', data) + call lilac_atm2lnd(lilac_a2l_Faxa_snowl, data) data(:) = 100.0d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Faxa_swndr', data) + call lilac_atm2lnd(lilac_a2l_Faxa_swndr, data) data(:) = 50.0d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Faxa_swvdr', data) + call lilac_atm2lnd(lilac_a2l_Faxa_swvdr, data) data(:) = 25.0d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Faxa_swndf', data) + call lilac_atm2lnd(lilac_a2l_Faxa_swndf, data) data(:) = 45.0d0 + space_time_perturbation(:) - call lilac_atmcap_atm2lnd('Faxa_swvdf', data) + call lilac_atm2lnd(lilac_a2l_Faxa_swvdf, data) end subroutine atm_driver_to_lilac @@ -463,7 +486,7 @@ subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, & logical, intent(in) :: masterproc ! local variables - integer, parameter :: field_name_len = 64 + integer :: nfields integer :: ierr integer :: ncid integer :: dimid_x @@ -471,20 +494,23 @@ subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, & integer :: nglobal integer :: i integer, allocatable :: varids(:) - character(len=field_name_len) :: field_name + character(len=:), allocatable :: field_name integer, allocatable :: counts(:) integer, allocatable :: displacements(:) real*8, allocatable :: data(:) real*8, allocatable :: data_global(:) real*8, allocatable :: data_2d(:,:) - character(len=field_name_len), parameter :: fields(23) = [character(len=field_name_len) :: & - 'Sl_t', 'Sl_tref', 'Sl_qref', 'Sl_avsdr', 'Sl_anidr', 'Sl_avsdf', 'Sl_anidf', & - 'Sl_snowh', 'Sl_u10', 'Sl_fv', 'Sl_ram1', 'Sl_z0m', & - 'Fall_taux', 'Fall_tauy', 'Fall_lat', 'Fall_sen', 'Fall_lwup', 'Fall_evap', 'Fall_swnet', & - 'Fall_flxdst1', 'Fall_flxdst2', 'Fall_flxdst3', 'Fall_flxdst4'] ! -------------------------------------------- + ! Implementation note: for convenience and ease of maintenance, we directly leverage + ! l2a_fields in this subroutine, and loop through all available indices in that + ! list. A real atmosphere should not use that variable directly; instead, it should + ! use the indices defined in ctsm_LilacCouplingFieldIndices, similarly to what is done + ! above in atm_driver_to_lilac. + + nfields = l2a_fields%num_fields() + ! ------------------------------------------------------------------------ ! Set up output file ! ------------------------------------------------------------------------ @@ -500,9 +526,9 @@ subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, & ierr = nf90_def_dim(ncid, 'atm_ny', atm_global_ny, dimid_y) if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_def_dim ny atm driver output file') - allocate(varids(size(fields))) - do i = 1, size(fields) - field_name = fields(i) + allocate(varids(nfields)) + do i = 1, nfields + field_name = l2a_fields%get_fieldname(i) ierr = nf90_def_var(ncid, field_name, nf90_double, [dimid_x, dimid_y], varids(i)) if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_def_var atm driver output file: '//trim(field_name)) end do @@ -545,9 +571,13 @@ subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, & ! Retrieve data for each field, gather to master and write to file ! ------------------------------------------------------------------------ - do i = 1, size(fields) - field_name = fields(i) - call lilac_atmcap_lnd2atm(field_name, data) + do i = 1, nfields + field_name = l2a_fields%get_fieldname(i) + ! See implementation note above: typically a host atmosphere should NOT loop + ! through fields, accessing them anonymously by index as is done here. Instead, + ! typically the host atmosphere would access specific fields using the indices + ! defined in ctsm_LilacCouplingFieldIndices. + call lilac_lnd2atm(i, data) ! Because of the way we set up the decomposition, we can use a simple mpi_gatherv ! without needing to worry about any rearrangement, and points will appear in the diff --git a/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 b/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 new file mode 100644 index 0000000000..14ae5f22a4 --- /dev/null +++ b/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 @@ -0,0 +1,493 @@ +module ctsm_LilacAtm2LndFieldListType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Defines a class and related methods for a list of lilac fields sent from atm -> lnd. + ! + ! (Note: this is very similar to LilacLnd2AtmFieldListType. However, between the fact + ! that (1) they have different sets of supported methods, and (2) the use of the + ! dynamic vector, it seemed to make more sense to have totally separate classes rather + ! than trying to share code between the two.) + ! + ! To set up this list (lilac_atm2lnd_field_list_type): + ! + ! - Initialize it by calling the 'init' method + ! + ! - Add variables with add_var + ! + ! - When done adding variables, call complete_setup + ! - Note that you cannot access or perform any operations on any of the fields until + ! this is done! + ! + ! - Set which fields are needed from data with set_needed_from_data + ! + ! To use this list (after complete_setup has been called), here is the workflow: + ! + ! - Query number of fields with num_fields + ! + ! - Set fields each time step with set_field + ! + ! - After fields are set, check that all required fields have been set by calling check_all_set + ! + ! - At the end of each time step, call reset_provided + ! + ! !USES: + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : OOBMsg => shr_log_OOBMsg + use shr_sys_mod , only : shr_sys_abort + use lilac_constants, only : field_index_unset, logunit + + implicit none + private + + ! !PRIVATE TYPES: + + type, private :: lilac_atm2lnd_field_type + private + + ! Metadata set initially in initialization + character(len=:), allocatable :: fieldname + character(len=:), allocatable :: units + logical :: available_from_data ! whether this field can be obtained from data if not provided by the sending component + + ! Metadata set later in initialization + logical :: needed_from_data ! whether the host atmosphere wants LILAC to read this field from data + logical :: required_by_lnd ! whether this field is actually required by the land + + ! Data set each time step + real(r8), pointer :: dataptr(:) + logical :: provided_this_time ! whether this variable has been set this time step + end type lilac_atm2lnd_field_type + + ! Define a dynamic vector for lilac_atm2lnd_field_type +#define VECTOR_NAME lilac_atm2lnd_field_vector +#define TYPE_NAME type(lilac_atm2lnd_field_type) +#define THROW(string) call shr_sys_abort(string) +#include "dynamic_vector_typedef.inc" + + ! + ! !PUBLIC TYPES: + type, public :: lilac_atm2lnd_field_list_type + private + type(lilac_atm2lnd_field_vector) :: field_vec + type(lilac_atm2lnd_field_type), allocatable :: fields(:) + contains + ! Methods for setting up the list: + procedure, public :: init + procedure, public :: add_var + procedure, public :: complete_setup + + ! Methods to query or set data: + procedure, public :: num_fields ! return the number of fields + procedure, public :: set_needed_from_data ! dictate that the given fields need to be read from data + procedure, public :: is_needed_from_data ! query whether the given field is needed from data + procedure, public :: set_field ! set data for one field + procedure, public :: check_all_set ! check to ensure that all required fields have been set this time + procedure, public :: reset_provided ! reset the provided_this_time variable for all fields + procedure, public :: get_fieldname ! get the field name for a given field + procedure, public :: get_units ! get the units for a given field + procedure, public :: get_dataptr ! get a pointer to the data for a given field (this should be treated as read-only!) + + ! Private methods: + procedure, private :: check_field_index ! check whether a field index is valid + end type lilac_atm2lnd_field_list_type + + interface lilac_atm2lnd_field_type + module procedure new_lilac_atm2lnd_field_type + end interface lilac_atm2lnd_field_type + +contains + + ! Complete the dynamic vector definition. +#include "dynamic_vector_procdef.inc" + + !----------------------------------------------------------------------- + function new_lilac_atm2lnd_field_type(fieldname, units, available_from_data) result(this) + ! + ! !DESCRIPTION: + ! Initialize a new lilac_atm2lnd_field_type object + ! + ! !ARGUMENTS: + type(lilac_atm2lnd_field_type) :: this ! function result + character(len=*), intent(in) :: fieldname + character(len=*), intent(in) :: units + logical, intent(in) :: available_from_data ! whether this field can be obtained from data if not provided by the sending component + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'new_lilac_atm2lnd_field_type' + !----------------------------------------------------------------------- + + this%fieldname = fieldname + this%units = units + this%available_from_data = available_from_data + + ! Assume false until told otherwise + this%needed_from_data = .false. + + ! Assume true until told otherwise + this%required_by_lnd = .true. + + nullify(this%dataptr) + this%provided_this_time = .false. + + end function new_lilac_atm2lnd_field_type + + !----------------------------------------------------------------------- + subroutine init(this) + ! + ! !DESCRIPTION: + ! Initialize a new lilac_atm2lnd_field_list_type object + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'init' + !----------------------------------------------------------------------- + + this%field_vec = lilac_atm2lnd_field_vector() + + end subroutine init + + !----------------------------------------------------------------------- + subroutine add_var(this, fieldname, units, available_from_data, field_index) + ! + ! !DESCRIPTION: + ! Add the given field to this list + ! + ! Also set field_index to be the index of this field in list. For the sake of error + ! checking, field_index should be initialized to field_index_unset before the call to + ! this subroutine. + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + character(len=*), intent(in) :: fieldname + character(len=*), intent(in) :: units + logical, intent(in) :: available_from_data ! whether this field can be obtained from data if not provided by the sending component + integer, intent(inout) :: field_index + ! + ! !LOCAL VARIABLES: + type(lilac_atm2lnd_field_type) :: one_field + + character(len=*), parameter :: subname = 'add_var' + !----------------------------------------------------------------------- + + if (allocated(this%fields)) then + write(logunit,*) subname//' ERROR: this%fields is already allocated.' + write(logunit,*) 'fieldname = ', trim(fieldname) + write(logunit,*) 'This is likely a sign that you are trying to add a variable' + write(logunit,*) 'after complete_setup has already been called.' + call shr_sys_abort('Attempt to call '//subname//' after complete_setup was called') + end if + + if (field_index /= field_index_unset) then + write(logunit,*) subname//' ERROR: attempt to add var with a field index that has already been set.' + write(logunit,*) 'fieldname, field_index = ', trim(fieldname), field_index + call shr_sys_abort('Attempt to add var with a field index that has already been set') + end if + + one_field = lilac_atm2lnd_field_type( & + fieldname = trim(fieldname), & + units = trim(units), & + available_from_data = available_from_data) + + call this%field_vec%push_back(one_field) + + field_index = this%field_vec%vsize() + end subroutine add_var + + !----------------------------------------------------------------------- + subroutine complete_setup(this, data_size) + ! + ! !DESCRIPTION: + ! Finalize the creation of this field list; this includes allocating the data arrays for each field + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + integer, intent(in) :: data_size ! number of points in each field (assumed to be the same for all fields) + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'complete_setup' + !----------------------------------------------------------------------- + + call this%field_vec%move_out(this%fields) + + do i = 1, this%num_fields() + allocate(this%fields(i)%dataptr(data_size)) + end do + + end subroutine complete_setup + + !----------------------------------------------------------------------- + function num_fields(this) + ! + ! !DESCRIPTION: + ! Return the number of fields + ! + ! !ARGUMENTS: + integer :: num_fields ! function result + class(lilac_atm2lnd_field_list_type), intent(in) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'num_fields' + !----------------------------------------------------------------------- + + if (.not. allocated(this%fields)) then + write(logunit,*) subname//' ERROR: this%fields has not yet been allocated' + write(logunit,*) 'This is likely a sign that you are trying to call num_fields' + write(logunit,*) 'before complete_setup has been called.' + call shr_sys_abort('Attempt to get number of fields before complete_setup was called') + end if + + num_fields = size(this%fields) + + end function num_fields + + !----------------------------------------------------------------------- + subroutine set_needed_from_data(this, fields_needed_from_data) + ! + ! !DESCRIPTION: + ! Dictate that the given fields need to be read from data + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + integer, intent(in) :: fields_needed_from_data(:) ! vector of field indices that need to be read from data + ! + ! !LOCAL VARIABLES: + integer :: i + integer :: field_index + + character(len=*), parameter :: subname = 'set_needed_from_data' + !----------------------------------------------------------------------- + + do i = 1, size(fields_needed_from_data) + field_index = fields_needed_from_data(i) + call this%check_field_index(field_index, subname) + + if (this%fields(field_index)%needed_from_data) then + call shr_sys_abort(subname//' attempt to set needed_from_data on field for which it has already been set: '//& + this%fields(field_index)%fieldname) + end if + + if (.not. this%fields(field_index)%available_from_data) then + call shr_sys_abort(subname//' attempt to set needed_from_data on field not available from data: '//& + this%fields(field_index)%fieldname) + end if + + this%fields(field_index)%needed_from_data = .true. + end do + + end subroutine set_needed_from_data + + !----------------------------------------------------------------------- + function is_needed_from_data(this, field_index) + ! + ! !DESCRIPTION: + ! Query whether the given field is needed from data + ! + ! !ARGUMENTS: + logical :: is_needed_from_data ! function result + class(lilac_atm2lnd_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'is_needed_from_data' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + is_needed_from_data = this%fields(field_index)%needed_from_data + + end function is_needed_from_data + + !----------------------------------------------------------------------- + subroutine set_field(this, field_index, data) + ! + ! !DESCRIPTION: + ! Set data for the given field + ! + ! It is an error to try to set a field that has already been set this time + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + integer, intent(in) :: field_index + real(r8), intent(in) :: data(:) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'set_field' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + if (size(data) /= size(this%fields(field_index)%dataptr)) then + call shr_sys_abort(subname//' field size mismatch for '//trim(this%fields(field_index)%fieldname)) + end if + + if (this%fields(field_index)%provided_this_time) then + ! This can typically happen in one of two ways: + ! - A component tries to re-set a field that has already been set + ! - reset_provided hasn't been called in between times + call shr_sys_abort(subname//' attempt to set an already-set field: '//this%fields(field_index)%fieldname) + end if + + this%fields(field_index)%dataptr(:) = data(:) + this%fields(field_index)%provided_this_time = .true. + + end subroutine set_field + + !----------------------------------------------------------------------- + subroutine check_all_set(this) + ! + ! !DESCRIPTION: + ! Check to ensure that all required fields have been set this time + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(in) :: this + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'check_all_set' + !----------------------------------------------------------------------- + + do i = 1, this%num_fields() + if (this%fields(i)%required_by_lnd .and. .not. this%fields(i)%provided_this_time) then + call shr_sys_abort(trim(this%fields(i)%fieldname)//' required but not provided') + end if + end do + + end subroutine check_all_set + + !----------------------------------------------------------------------- + subroutine reset_provided(this) + ! + ! !DESCRIPTION: + ! Reset the provided_this_time variable for all fields + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'reset_provided' + !----------------------------------------------------------------------- + + do i = 1, this%num_fields() + this%fields(i)%provided_this_time = .false. + end do + + end subroutine reset_provided + + !----------------------------------------------------------------------- + function get_fieldname(this, field_index) result(fieldname) + ! + ! !DESCRIPTION: + ! Get the field name for a given field + ! + ! (This will already be trimmed - no further trimming is needed.) + ! + ! !ARGUMENTS: + character(len=:), allocatable :: fieldname ! function result + class(lilac_atm2lnd_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_fieldname' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + fieldname = this%fields(field_index)%fieldname + + end function get_fieldname + + !----------------------------------------------------------------------- + function get_units(this, field_index) result(units) + ! + ! !DESCRIPTION: + ! Get the units for a given field + ! + ! (This will already be trimmed - no further trimming is needed.) + ! + ! !ARGUMENTS: + character(len=:), allocatable :: units ! function result + class(lilac_atm2lnd_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_units' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + units = this%fields(field_index)%units + + end function get_units + + !----------------------------------------------------------------------- + function get_dataptr(this, field_index) result(dataptr) + ! + ! !DESCRIPTION: + ! Get a pointer to the data for a given field + ! + ! This should be treated as read-only! Setting data should be done via the provided + ! methods in this class. + ! + ! !ARGUMENTS: + real(r8), pointer :: dataptr(:) ! function result + class(lilac_atm2lnd_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_dataptr' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + dataptr => this%fields(field_index)%dataptr + + end function get_dataptr + + !----------------------------------------------------------------------- + subroutine check_field_index(this, field_index, caller) + ! + ! !DESCRIPTION: + ! Check the provided field_index for validity. If not valid, aborts. + ! + ! !ARGUMENTS: + class(lilac_atm2lnd_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + character(len=*), intent(in) :: caller ! name of caller, for error messages + ! + ! !LOCAL VARIABLES: + integer :: nfields + + character(len=*), parameter :: subname = 'check_field_index' + !----------------------------------------------------------------------- + + if (field_index == field_index_unset) then + call shr_sys_abort(caller//':'//subname//' attempt to set field for unset field index') + end if + + if (field_index < 1 .or. field_index > this%num_fields()) then + write(logunit,*) caller//':'//subname//' ERROR: field_index out of bounds' + nfields = this%num_fields() + write(logunit,*) 'field_index, num_fields = ', field_index, nfields + call shr_sys_abort(caller//':'//subname//' field_index out of bounds') + end if + + end subroutine check_field_index + +end module ctsm_LilacAtm2LndFieldListType diff --git a/lilac/src/ctsm_LilacCouplingFieldIndices.F90 b/lilac/src/ctsm_LilacCouplingFieldIndices.F90 new file mode 100644 index 0000000000..c28a497a31 --- /dev/null +++ b/lilac/src/ctsm_LilacCouplingFieldIndices.F90 @@ -0,0 +1,83 @@ +module ctsm_LilacCouplingFieldIndices + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Defines all possible coupling field indices for coupling between atmosphere and land + ! + ! !USES: + use lilac_constants, only : field_index_unset + + implicit none + private + ! + ! !PUBLIC DATA: + + ! ------------------------------------------------------------------------ + ! These are the fields that can be passed from atm -> lnd. The host atmosphere model + ! will refer to these indices when setting fields. + ! ------------------------------------------------------------------------ + + integer, public :: lilac_a2l_Sa_landfrac = field_index_unset + integer, public :: lilac_a2l_Sa_z = field_index_unset + integer, public :: lilac_a2l_Sa_topo = field_index_unset + integer, public :: lilac_a2l_Sa_u = field_index_unset + integer, public :: lilac_a2l_Sa_v = field_index_unset + integer, public :: lilac_a2l_Sa_ptem = field_index_unset + integer, public :: lilac_a2l_Sa_pbot = field_index_unset + integer, public :: lilac_a2l_Sa_tbot = field_index_unset + integer, public :: lilac_a2l_Sa_shum = field_index_unset + integer, public :: lilac_a2l_Faxa_lwdn = field_index_unset + integer, public :: lilac_a2l_Faxa_rainc = field_index_unset + integer, public :: lilac_a2l_Faxa_rainl = field_index_unset + integer, public :: lilac_a2l_Faxa_snowc = field_index_unset + integer, public :: lilac_a2l_Faxa_snowl = field_index_unset + integer, public :: lilac_a2l_Faxa_swndr = field_index_unset + integer, public :: lilac_a2l_Faxa_swvdr = field_index_unset + integer, public :: lilac_a2l_Faxa_swndf = field_index_unset + integer, public :: lilac_a2l_Faxa_swvdf = field_index_unset + + integer, public :: lilac_a2l_Faxa_bcphidry = field_index_unset + integer, public :: lilac_a2l_Faxa_bcphodry = field_index_unset + integer, public :: lilac_a2l_Faxa_bcphiwet = field_index_unset + integer, public :: lilac_a2l_Faxa_ocphidry = field_index_unset + integer, public :: lilac_a2l_Faxa_ocphodry = field_index_unset + integer, public :: lilac_a2l_Faxa_ocphiwet = field_index_unset + integer, public :: lilac_a2l_Faxa_dstwet1 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstdry1 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstwet2 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstdry2 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstwet3 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstdry3 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstwet4 = field_index_unset + integer, public :: lilac_a2l_Faxa_dstdry4 = field_index_unset + + ! ------------------------------------------------------------------------ + ! These are the fields that can be passed from lnd -> atm. The host atmosphere model + ! will refer to these indices when retrieving fields. + ! ------------------------------------------------------------------------ + + integer, public :: lilac_l2a_Sl_t = field_index_unset + integer, public :: lilac_l2a_Sl_tref = field_index_unset + integer, public :: lilac_l2a_Sl_qref = field_index_unset + integer, public :: lilac_l2a_Sl_avsdr = field_index_unset + integer, public :: lilac_l2a_Sl_anidr = field_index_unset + integer, public :: lilac_l2a_Sl_avsdf = field_index_unset + integer, public :: lilac_l2a_Sl_anidf = field_index_unset + integer, public :: lilac_l2a_Sl_snowh = field_index_unset + integer, public :: lilac_l2a_Sl_u10 = field_index_unset + integer, public :: lilac_l2a_Sl_fv = field_index_unset + integer, public :: lilac_l2a_Sl_ram1 = field_index_unset + integer, public :: lilac_l2a_Sl_z0m = field_index_unset + integer, public :: lilac_l2a_Fall_taux = field_index_unset + integer, public :: lilac_l2a_Fall_tauy = field_index_unset + integer, public :: lilac_l2a_Fall_lat = field_index_unset + integer, public :: lilac_l2a_Fall_sen = field_index_unset + integer, public :: lilac_l2a_Fall_lwup = field_index_unset + integer, public :: lilac_l2a_Fall_evap = field_index_unset + integer, public :: lilac_l2a_Fall_swnet = field_index_unset + integer, public :: lilac_l2a_Fall_flxdst1 = field_index_unset + integer, public :: lilac_l2a_Fall_flxdst2 = field_index_unset + integer, public :: lilac_l2a_Fall_flxdst3 = field_index_unset + integer, public :: lilac_l2a_Fall_flxdst4 = field_index_unset + +end module ctsm_LilacCouplingFieldIndices diff --git a/lilac/src/ctsm_LilacCouplingFields.F90 b/lilac/src/ctsm_LilacCouplingFields.F90 new file mode 100644 index 0000000000..f93315f74d --- /dev/null +++ b/lilac/src/ctsm_LilacCouplingFields.F90 @@ -0,0 +1,295 @@ +module ctsm_LilacCouplingFields + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Defines the coupling fields between atmosphere and land + ! + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use ctsm_LilacCouplingFieldIndices + use ctsm_LilacLnd2AtmFieldListType, only : lilac_lnd2atm_field_list_type + use ctsm_LilacAtm2LndFieldListType, only : lilac_atm2lnd_field_list_type + + implicit none + private + + ! + ! !PUBLIC ROUTINES: + + ! ------------------------------------------------------------------------ + ! Routines that should be called by the host atmosphere to set / get coupling fields + ! ------------------------------------------------------------------------ + + public :: lilac_atm2lnd ! Set a single atm -> lnd field + public :: lilac_lnd2atm ! Get a single lnd -> atm field + + ! ------------------------------------------------------------------------ + ! Routines that should be used internally by LILAC, *not* called directly from the host + ! atmosphere + ! ------------------------------------------------------------------------ + + public :: create_a2l_field_list + public :: create_l2a_field_list + public :: complete_a2l_field_list + public :: complete_l2a_field_list + + ! + ! !PUBLIC DATA: + + ! ------------------------------------------------------------------------ + ! These variables should only be used internally by LILAC. The host atmosphere model + ! should interact with them via the lilac_atm2lnd and lilac_lnd2atm routines. + ! ------------------------------------------------------------------------ + + type(lilac_atm2lnd_field_list_type), public :: a2l_fields + type(lilac_lnd2atm_field_list_type), public :: l2a_fields + +contains + + !----------------------------------------------------------------------- + subroutine lilac_atm2lnd(field_index, data) + ! + ! !DESCRIPTION: + ! Set a single atm -> lnd field + ! + ! field_index should be one of the lilac_a2l_* indices defined in this module + ! + ! !ARGUMENTS: + integer, intent(in) :: field_index + real(r8), intent(in) :: data(:) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'lilac_atm2lnd' + !----------------------------------------------------------------------- + + call a2l_fields%set_field(field_index, data) + + end subroutine lilac_atm2lnd + + !----------------------------------------------------------------------- + subroutine lilac_lnd2atm(field_index, data) + ! + ! !DESCRIPTION: + ! Get a single lnd -> atm field + ! + ! field_index should be one of the lilac_l2a_* indices defined in this module + ! + ! !ARGUMENTS: + integer, intent(in) :: field_index + real(r8), intent(out) :: data(:) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'lilac_lnd2atm' + !----------------------------------------------------------------------- + + call l2a_fields%get_field(field_index, data) + + end subroutine lilac_lnd2atm + + !----------------------------------------------------------------------- + subroutine create_a2l_field_list() + ! + ! !DESCRIPTION: + ! Create the list of fields passed from atm -> lnd. + ! + ! All of the lilac_a2l_* indices are valid after this is called. However, note that + ! a2l_fields still isn't fully usable until complete_a2l_field_list is called. + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'create_a2l_field_list' + !----------------------------------------------------------------------- + + call a2l_fields%init() + + call a2l_fields%add_var(fieldname='Sa_landfrac' , units='fraction', available_from_data=.false., & + field_index=lilac_a2l_Sa_landfrac) + call a2l_fields%add_var(fieldname='Sa_z' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Sa_z) + call a2l_fields%add_var(fieldname='Sa_topo' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Sa_topo) + call a2l_fields%add_var(fieldname='Sa_u' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Sa_u) + call a2l_fields%add_var(fieldname='Sa_v' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Sa_v) + call a2l_fields%add_var(fieldname='Sa_ptem' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Sa_ptem) + call a2l_fields%add_var(fieldname='Sa_pbot' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Sa_pbot) + call a2l_fields%add_var(fieldname='Sa_tbot' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Sa_tbot) + call a2l_fields%add_var(fieldname='Sa_shum' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Sa_shum) + call a2l_fields%add_var(fieldname='Faxa_lwdn' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Faxa_lwdn) + call a2l_fields%add_var(fieldname='Faxa_rainc' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Faxa_rainc) + call a2l_fields%add_var(fieldname='Faxa_rainl' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Faxa_rainl) + call a2l_fields%add_var(fieldname='Faxa_snowc' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Faxa_snowc) + call a2l_fields%add_var(fieldname='Faxa_snowl' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Faxa_snowl) + call a2l_fields%add_var(fieldname='Faxa_swndr' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Faxa_swndr) + call a2l_fields%add_var(fieldname='Faxa_swvdr' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Faxa_swvdr) + call a2l_fields%add_var(fieldname='Faxa_swndf' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Faxa_swndf) + call a2l_fields%add_var(fieldname='Faxa_swvdf' , units='unknown', available_from_data=.false., & + field_index=lilac_a2l_Faxa_swvdf) + + call a2l_fields%add_var(fieldname='Faxa_bcphidry' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_bcphidry) + call a2l_fields%add_var(fieldname='Faxa_bcphodry' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_bcphodry) + call a2l_fields%add_var(fieldname='Faxa_bcphiwet' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_bcphiwet) + call a2l_fields%add_var(fieldname='Faxa_ocphidry' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_ocphidry) + call a2l_fields%add_var(fieldname='Faxa_ocphodry' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_ocphodry) + call a2l_fields%add_var(fieldname='Faxa_ocphiwet' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_ocphiwet) + call a2l_fields%add_var(fieldname='Faxa_dstwet1' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_dstwet1) + call a2l_fields%add_var(fieldname='Faxa_dstdry1' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_dstdry1) + call a2l_fields%add_var(fieldname='Faxa_dstwet2' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_dstwet2) + call a2l_fields%add_var(fieldname='Faxa_dstdry2' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_dstdry2) + call a2l_fields%add_var(fieldname='Faxa_dstwet3' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_dstwet3) + call a2l_fields%add_var(fieldname='Faxa_dstdry3' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_dstdry3) + call a2l_fields%add_var(fieldname='Faxa_dstwet4' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_dstwet4) + call a2l_fields%add_var(fieldname='Faxa_dstdry4' , units='unknown', available_from_data=.true., & + field_index=lilac_a2l_Faxa_dstdry4) + + end subroutine create_a2l_field_list + + !----------------------------------------------------------------------- + subroutine create_l2a_field_list() + ! + ! !DESCRIPTION: + ! Create the list of fields passed from lnd -> atm. + ! + ! All of the lilac_l2a_* indices are valid after this is called. However, note that + ! l2a_fields still isn't fully usable until complete_l2a_field_list is called. + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'create_l2a_field_list' + !----------------------------------------------------------------------- + + call l2a_fields%init() + + call l2a_fields%add_var(fieldname='Sl_t' , units='unknown', & + field_index=lilac_l2a_Sl_t) + call l2a_fields%add_var(fieldname='Sl_tref' , units='unknown', & + field_index=lilac_l2a_Sl_tref) + call l2a_fields%add_var(fieldname='Sl_qref' , units='unknown', & + field_index=lilac_l2a_Sl_qref) + call l2a_fields%add_var(fieldname='Sl_avsdr' , units='unknown', & + field_index=lilac_l2a_Sl_avsdr) + call l2a_fields%add_var(fieldname='Sl_anidr' , units='unknown', & + field_index=lilac_l2a_Sl_anidr) + call l2a_fields%add_var(fieldname='Sl_avsdf' , units='unknown', & + field_index=lilac_l2a_Sl_avsdf) + call l2a_fields%add_var(fieldname='Sl_anidf' , units='unknown', & + field_index=lilac_l2a_Sl_anidf) + call l2a_fields%add_var(fieldname='Sl_snowh' , units='unknown', & + field_index=lilac_l2a_Sl_snowh) + call l2a_fields%add_var(fieldname='Sl_u10' , units='unknown', & + field_index=lilac_l2a_Sl_u10) + call l2a_fields%add_var(fieldname='Sl_fv' , units='unknown', & + field_index=lilac_l2a_Sl_fv) + call l2a_fields%add_var(fieldname='Sl_ram1' , units='unknown', & + field_index=lilac_l2a_Sl_ram1) + call l2a_fields%add_var(fieldname='Sl_z0m' , units='m' , & + field_index=lilac_l2a_Sl_z0m) + call l2a_fields%add_var(fieldname='Fall_taux' , units='unknown', & + field_index=lilac_l2a_Fall_taux) + call l2a_fields%add_var(fieldname='Fall_tauy' , units='unknown', & + field_index=lilac_l2a_Fall_tauy) + call l2a_fields%add_var(fieldname='Fall_lat' , units='unknown', & + field_index=lilac_l2a_Fall_lat) + call l2a_fields%add_var(fieldname='Fall_sen' , units='unknown', & + field_index=lilac_l2a_Fall_sen) + call l2a_fields%add_var(fieldname='Fall_lwup' , units='unknown', & + field_index=lilac_l2a_Fall_lwup) + call l2a_fields%add_var(fieldname='Fall_evap' , units='unknown', & + field_index=lilac_l2a_Fall_evap) + call l2a_fields%add_var(fieldname='Fall_swnet' , units='unknown', & + field_index=lilac_l2a_Fall_swnet) + call l2a_fields%add_var(fieldname='Fall_flxdst1' , units='unknown', & + field_index=lilac_l2a_Fall_flxdst1) + call l2a_fields%add_var(fieldname='Fall_flxdst2' , units='unknown', & + field_index=lilac_l2a_Fall_flxdst2) + call l2a_fields%add_var(fieldname='Fall_flxdst3' , units='unknown', & + field_index=lilac_l2a_Fall_flxdst3) + call l2a_fields%add_var(fieldname='Fall_flxdst4' , units='unknown', & + field_index=lilac_l2a_Fall_flxdst4) + + end subroutine create_l2a_field_list + + !----------------------------------------------------------------------- + subroutine complete_a2l_field_list(lsize_atm, fields_needed_from_data) + ! + ! !DESCRIPTION: + ! Complete the setup of a2l_fields. + ! + ! This is separated from create_a2l_field_list because lsize may not be available at + ! the point when that routine is called. Also, note that this sets + ! fields_needed_from_data, which won't be available until later in initialization. + ! + ! !ARGUMENTS: + integer, intent(in) :: lsize_atm ! number of atm points on this proc + + ! List of field indices that need to be read from data, because the host atmosphere + ! isn't going to provide them. These should be indices given in + ! ctsm_LilacCouplingFields (lilac_a2l_Faxa_bcphidry). This can be an empty list if no + ! fields need to be read from data. + integer , intent(in) :: fields_needed_from_data(:) + + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'complete_a2l_field_list' + !----------------------------------------------------------------------- + + call a2l_fields%complete_setup(lsize_atm) + call a2l_fields%set_needed_from_data(fields_needed_from_data) + + end subroutine complete_a2l_field_list + + !----------------------------------------------------------------------- + subroutine complete_l2a_field_list(lsize_atm) + ! + ! !DESCRIPTION: + ! Complete the setup of l2a_fields. + ! + ! This is separated from create_l2a_field_list because lsize may not be available at + ! the point when that routine is called. + ! + ! !ARGUMENTS: + integer, intent(in) :: lsize_atm ! number of atm points on this proc + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'complete_l2a_field_list' + !----------------------------------------------------------------------- + + call l2a_fields%complete_setup(lsize_atm) + + end subroutine complete_l2a_field_list + +end module ctsm_LilacCouplingFields diff --git a/lilac/src/ctsm_LilacLnd2AtmFieldListType.F90 b/lilac/src/ctsm_LilacLnd2AtmFieldListType.F90 new file mode 100644 index 0000000000..dfc1ec9857 --- /dev/null +++ b/lilac/src/ctsm_LilacLnd2AtmFieldListType.F90 @@ -0,0 +1,357 @@ +module ctsm_LilacLnd2AtmFieldListType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Defines a class and related methods for a list of lilac fields sent from lnd -> atm. + ! + ! (Note: this is very similar to LilacAtm2LndFieldListType. However, between the fact + ! that (1) they have different sets of supported methods, and (2) the use of the + ! dynamic vector, it seemed to make more sense to have totally separate classes rather + ! than trying to share code between the two.) + ! + ! To set up this list (lilac_lnd2atm_field_list_type): + ! + ! - Initialize it by calling the 'init' method + ! + ! - Add variables with add_var + ! + ! - When done adding variables, call complete_setup + ! - Note that you cannot access or perform any operations on any of the fields until + ! this is done! + ! + ! To use this list (after complete_setup has been called): + ! + ! - Query number of fields with num_fields + ! + ! - Extract data from a field with get_field + ! + ! !USES: + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : OOBMsg => shr_log_OOBMsg + use shr_sys_mod , only : shr_sys_abort + use lilac_constants, only : field_index_unset, logunit + + implicit none + private + + ! !PRIVATE TYPES: + + type, private :: lilac_lnd2atm_field_type + private + + ! Metadata set initially in initialization + character(len=:), allocatable :: fieldname + character(len=:), allocatable :: units + + ! Metadata set later in initialization + logical :: required_by_atm ! whether this field is actually required by the atmosphere + + ! Data set each time step + real(r8), pointer :: dataptr(:) + end type lilac_lnd2atm_field_type + + ! Define a dynamic vector for lilac_lnd2atm_field_type +#define VECTOR_NAME lilac_lnd2atm_field_vector +#define TYPE_NAME type(lilac_lnd2atm_field_type) +#define THROW(string) call shr_sys_abort(string) +#include "dynamic_vector_typedef.inc" + + ! + ! !PUBLIC TYPES: + type, public :: lilac_lnd2atm_field_list_type + private + type(lilac_lnd2atm_field_vector) :: field_vec + type(lilac_lnd2atm_field_type), allocatable :: fields(:) + contains + ! Methods for setting up the list: + procedure, public :: init + procedure, public :: add_var + procedure, public :: complete_setup + + ! Methods to query or set data: + procedure, public :: num_fields ! return the number of fields + procedure, public :: get_field ! get data for one field + procedure, public :: get_fieldname ! get the field name for a given field + procedure, public :: get_units ! get the units for a given field + procedure, public :: get_dataptr ! get a pointer to the data for a given field + + ! Private methods: + procedure, private :: check_field_index ! check whether a field index is valid + end type lilac_lnd2atm_field_list_type + + interface lilac_lnd2atm_field_type + module procedure new_lilac_lnd2atm_field_type + end interface lilac_lnd2atm_field_type + +contains + + ! Complete the dynamic vector definition. +#include "dynamic_vector_procdef.inc" + + !----------------------------------------------------------------------- + function new_lilac_lnd2atm_field_type(fieldname, units) result(this) + ! + ! !DESCRIPTION: + ! Initialize a new lilac_lnd2atm_field_type object + ! + ! !ARGUMENTS: + type(lilac_lnd2atm_field_type) :: this ! function result + character(len=*), intent(in) :: fieldname + character(len=*), intent(in) :: units + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'new_lilac_lnd2atm_field_type' + !----------------------------------------------------------------------- + + this%fieldname = fieldname + this%units = units + + ! Assume true until told otherwise + this%required_by_atm = .true. + + nullify(this%dataptr) + + end function new_lilac_lnd2atm_field_type + + !----------------------------------------------------------------------- + subroutine init(this) + ! + ! !DESCRIPTION: + ! Initialize a new lilac_lnd2atm_field_list_type object + ! + ! !ARGUMENTS: + class(lilac_lnd2atm_field_list_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'init' + !----------------------------------------------------------------------- + + this%field_vec = lilac_lnd2atm_field_vector() + + end subroutine init + + !----------------------------------------------------------------------- + subroutine add_var(this, fieldname, units, field_index) + ! + ! !DESCRIPTION: + ! Add the given field to this list + ! + ! Also set field_index to be the index of this field in list. For the sake of error + ! checking, field_index should be initialized to field_index_unset before the call to + ! this subroutine. + ! + ! !ARGUMENTS: + class(lilac_lnd2atm_field_list_type), intent(inout) :: this + character(len=*), intent(in) :: fieldname + character(len=*), intent(in) :: units + integer, intent(inout) :: field_index + ! + ! !LOCAL VARIABLES: + type(lilac_lnd2atm_field_type) :: one_field + + character(len=*), parameter :: subname = 'add_var' + !----------------------------------------------------------------------- + + if (allocated(this%fields)) then + write(logunit,*) subname//' ERROR: this%fields is already allocated.' + write(logunit,*) 'fieldname = ', trim(fieldname) + write(logunit,*) 'This is likely a sign that you are trying to add a variable' + write(logunit,*) 'after complete_setup has already been called.' + call shr_sys_abort('Attempt to call '//subname//' after complete_setup was called') + end if + + if (field_index /= field_index_unset) then + write(logunit,*) subname//' ERROR: attempt to add var with a field index that has already been set.' + write(logunit,*) 'fieldname, field_index = ', trim(fieldname), field_index + call shr_sys_abort('Attempt to add var with a field index that has already been set') + end if + + one_field = lilac_lnd2atm_field_type( & + fieldname = trim(fieldname), & + units = trim(units)) + + call this%field_vec%push_back(one_field) + + field_index = this%field_vec%vsize() + end subroutine add_var + + !----------------------------------------------------------------------- + subroutine complete_setup(this, data_size) + ! + ! !DESCRIPTION: + ! Finalize the creation of this field list; this includes allocating the data arrays for each field + ! + ! !ARGUMENTS: + class(lilac_lnd2atm_field_list_type), intent(inout) :: this + integer, intent(in) :: data_size ! number of points in each field (assumed to be the same for all fields) + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'complete_setup' + !----------------------------------------------------------------------- + + call this%field_vec%move_out(this%fields) + + do i = 1, this%num_fields() + allocate(this%fields(i)%dataptr(data_size)) + end do + + end subroutine complete_setup + + !----------------------------------------------------------------------- + function num_fields(this) + ! + ! !DESCRIPTION: + ! Return the number of fields + ! + ! !ARGUMENTS: + integer :: num_fields ! function result + class(lilac_lnd2atm_field_list_type), intent(in) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'num_fields' + !----------------------------------------------------------------------- + + if (.not. allocated(this%fields)) then + write(logunit,*) subname//' ERROR: this%fields has not yet been allocated' + write(logunit,*) 'This is likely a sign that you are trying to call num_fields' + write(logunit,*) 'before complete_setup has been called.' + call shr_sys_abort('Attempt to get number of fields before complete_setup was called') + end if + + num_fields = size(this%fields) + + end function num_fields + + !----------------------------------------------------------------------- + subroutine get_field(this, field_index, data) + ! + ! !DESCRIPTION: + ! Get data for the given field + ! + ! !ARGUMENTS: + class(lilac_lnd2atm_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + real(r8), intent(out) :: data(:) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_field' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + if (size(data) /= size(this%fields(field_index)%dataptr)) then + call shr_sys_abort(subname//' field size mismatch for '//trim(this%fields(field_index)%fieldname)) + end if + + data(:) = this%fields(field_index)%dataptr(:) + + end subroutine get_field + + !----------------------------------------------------------------------- + function get_fieldname(this, field_index) result(fieldname) + ! + ! !DESCRIPTION: + ! Get the field name for a given field + ! + ! (This will already be trimmed - no further trimming is needed.) + ! + ! !ARGUMENTS: + character(len=:), allocatable :: fieldname ! function result + class(lilac_lnd2atm_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_fieldname' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + fieldname = this%fields(field_index)%fieldname + + end function get_fieldname + + !----------------------------------------------------------------------- + function get_units(this, field_index) result(units) + ! + ! !DESCRIPTION: + ! Get the units for a given field + ! + ! (This will already be trimmed - no further trimming is needed.) + ! + ! !ARGUMENTS: + character(len=:), allocatable :: units ! function result + class(lilac_lnd2atm_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_units' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + units = this%fields(field_index)%units + + end function get_units + + !----------------------------------------------------------------------- + function get_dataptr(this, field_index) result(dataptr) + ! + ! !DESCRIPTION: + ! Get a pointer to the data for a given field + ! + ! !ARGUMENTS: + real(r8), pointer :: dataptr(:) ! function result + class(lilac_lnd2atm_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_dataptr' + !----------------------------------------------------------------------- + + call this%check_field_index(field_index, subname) + + dataptr => this%fields(field_index)%dataptr + + end function get_dataptr + + !----------------------------------------------------------------------- + subroutine check_field_index(this, field_index, caller) + ! + ! !DESCRIPTION: + ! Check the provided field_index for validity. If not valid, aborts. + ! + ! !ARGUMENTS: + class(lilac_lnd2atm_field_list_type), intent(in) :: this + integer, intent(in) :: field_index + character(len=*), intent(in) :: caller ! name of caller, for error messages + ! + ! !LOCAL VARIABLES: + integer :: nfields + + character(len=*), parameter :: subname = 'check_field_index' + !----------------------------------------------------------------------- + + if (field_index == field_index_unset) then + call shr_sys_abort(caller//':'//subname//' attempt to set field for unset field index') + end if + + if (field_index < 1 .or. field_index > this%num_fields()) then + write(logunit,*) caller//':'//subname//' ERROR: field_index out of bounds' + nfields = this%num_fields() + write(logunit,*) 'field_index, num_fields = ', field_index, nfields + call shr_sys_abort(caller//':'//subname//' field_index out of bounds') + end if + + end subroutine check_field_index + +end module ctsm_LilacLnd2AtmFieldListType diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index d03ba1e506..96b70e918c 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -18,16 +18,14 @@ module lilac_atmcap use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl, CS => shr_kind_cs use shr_sys_mod , only : shr_sys_abort use lilac_methods , only : chkerr + use lilac_constants, only : logunit + use ctsm_LilacCouplingFields, only : a2l_fields, l2a_fields implicit none public :: lilac_atmcap_init - public :: lilac_atmcap_atm2lnd - public :: lilac_atmcap_lnd2atm public :: lilac_atmcap_register - private :: lilac_atmcap_add_fld - ! Time invariant input from host atmosphere integer , public, allocatable :: gindex_atm(:) ! global index space real(r8), public, allocatable :: atm_lons(:) ! local longitudes @@ -38,16 +36,6 @@ module lilac_atmcap ! Time variant input from host atmosphere real(r8) :: nextsw_cday = 1.e36_r8 ! calendar day of the next sw calculation - type :: atmcap_type - character(len=CL) :: fldname - real(r8), pointer :: dataptr(:) - character(len=CS) :: units - logical :: provided_by_atm - logical :: required_fr_atm - end type atmcap_type - type(atmcap_type), pointer, public :: atm2lnd(:) - type(atmcap_type), pointer, public :: lnd2atm(:) - integer :: mytask integer , parameter :: debug = 0 ! internal debug level character(*), parameter :: u_FILE_u = & @@ -82,85 +70,6 @@ subroutine lilac_atmcap_init_vars(atm_gindex_in, atm_lons_in, atm_lats_in, atm_g atm_global_nx = atm_global_nx_in atm_global_ny = atm_global_ny_in - !------------------------------------------------------------------------- - ! Set module arrays atm2lnd and lnd2atm - !------------------------------------------------------------------------- - - ! TODO: how is the atm going to specify which fields are not provided = - ! should it pass an array of character strings or a colon deliminited set of fields - ! to specify the fields it will not provide - and then these are checked against those fields - - call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_landfrac' , units='fraction', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_z' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_topo' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_u' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_v' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_ptem' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_pbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_tbot' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_shum' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_lwdn' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_rainc' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_rainl' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_snowc' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_snowl' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_swndr' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_swvdr' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_swndf' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_swvdf' , units='unknown', required_fr_atm=.true. , lsize=lsize) - - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_bcphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_bcphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_bcphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_ocphidry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_ocphodry' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_ocphiwet' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstwet1' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstdry1' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstwet2' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstdry2' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstwet3' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstdry3' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstwet4' , units='unknown', required_fr_atm=.true. , lsize=lsize) - call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_dstdry4' , units='unknown', required_fr_atm=.true. , lsize=lsize) - ! call lilac_atmcap_add_fld (atm2lnd, fldname='Sa_methane' , units='unknown', required_fr_atm=.false. , lsize=lsize) - ! call lilac_atmcap_add_fld (atm2lnd, fldname='Faxa_bcph' , units='unknown', required_fr_atm=.false. , lsize=lsize) - - ! now add dataptr memory for all of the fields and set default values of provided_by_atm to false - do n = 1,size(atm2lnd) - allocate(atm2lnd(n)%dataptr(lsize)) - atm2lnd(n)%provided_by_atm = .false. - end do - - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_t' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_tref' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_qref' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_avsdr' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_anidr' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_avsdf' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_anidf' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_snowh' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_u10' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_fv' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_ram1' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Sl_z0m' , units='m' , lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_taux' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_tauy' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_lat' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_sen' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_lwup' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_evap' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_swnet' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_flxdst1' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_flxdst2' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_flxdst3' , units='unknown', lsize=lsize) - call lilac_atmcap_add_fld (lnd2atm , fldname='Fall_flxdst4' , units='unknown', lsize=lsize) - - ! now add dataptr memory for all of the fields - do n = 1,size(lnd2atm) - allocate(lnd2atm(n)%dataptr(lsize)) - end do - end subroutine lilac_atmcap_init_vars !======================================================================== @@ -292,12 +201,12 @@ subroutine lilac_atmcap_init (comp, lnd2atm_state, atm2lnd_state, clock, rc) mesh_lon = ownedElemCoords(2*n-1) mesh_lat = ownedElemCoords(2*n) if ( abs(mesh_lon - atm_lons(n)) > tolerance) then - write(6,101),n, atm_lons(n), mesh_lon + write(logunit,101),n, atm_lons(n), mesh_lon 101 format('ERROR: lilac_atmcap: n, lon, mesh_lon = ',i6,2(f20.10,2x)) call shr_sys_abort() end if if ( abs(mesh_lat - atm_lats(n)) > tolerance) then - write(6,102),n, atm_lats(n), mesh_lat + write(logunit,102),n, atm_lats(n), mesh_lat 102 format('ERROR: lilac_atmcap: n, lat, mesh_lat = ',i6,2(f20.10,2x)) call shr_sys_abort() end if @@ -313,9 +222,10 @@ subroutine lilac_atmcap_init (comp, lnd2atm_state, atm2lnd_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create fields and add to field bundle - do n = 1, size(atm2lnd) + do n = 1, a2l_fields%num_fields() field = ESMF_FieldCreate(atm_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & - name=trim(atm2lnd(n)%fldname), farrayPtr=atm2lnd(n)%dataptr, rc=rc) + name=a2l_fields%get_fieldname(n), farrayPtr=a2l_fields%get_dataptr(n), & + rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) @@ -349,9 +259,10 @@ subroutine lilac_atmcap_init (comp, lnd2atm_state, atm2lnd_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create fields and add to field bundle - do n = 1, size(lnd2atm) + do n = 1, l2a_fields%num_fields() field = ESMF_FieldCreate(atm_mesh, meshloc=ESMF_MESHLOC_ELEMENT, & - name=trim(lnd2atm(n)%fldname), farrayPtr=lnd2atm(n)%dataptr, rc=rc) + name=l2a_fields%get_fieldname(n), farrayPtr=l2a_fields%get_dataptr(n), & + rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) @@ -415,145 +326,4 @@ subroutine lilac_atmcap_final(comp, importState, exportState, clock, rc) end subroutine lilac_atmcap_final -!======================================================================== - subroutine lilac_atmcap_atm2lnd(fldname, data) - - ! input/output variables - character(len=*), intent(in) :: fldname - real(r8), intent(in) :: data(:) - - ! local variables - integer :: n - logical :: found - character(len=*), parameter :: subname='(lilac_atmcap_atm2lnd)' - ! -------------------------------------------- - - found = .false. - do n = 1,size(atm2lnd) - if (trim(fldname) == atm2lnd(n)%fldname) then - found = .true. - if (size(data) /= size(atm2lnd(n)%dataptr)) then - call shr_sys_abort(trim(subname) // 'size(data) not equal to size(atm2lnd(n)%dataptr') - else - atm2lnd(n)%dataptr(:) = data(:) - end if - atm2lnd(n)%provided_by_atm = .true. - exit - end if - end do - if (.not. found) then - call shr_sys_abort(trim(subname) // 'atm2lnd field name ' // trim(fldname) //' not found') - end if - - contains - - subroutine lilac_atm2lnd_check() - integer :: n ! if there are fields that the atmosphere does not provide but - ! that are required - then abort - do n = 1,size(atm2lnd) - if (atm2lnd(n)%required_fr_atm .and. (.not. atm2lnd(n)%provided_by_atm)) then - ! call abort or provide default values? - else if (.not. atm2lnd(n)%provided_by_atm) then - ! create default values - end if - end do - end subroutine lilac_atm2lnd_check - - end subroutine lilac_atmcap_atm2lnd - -!======================================================================== - subroutine lilac_atmcap_lnd2atm(fldname, data) - - ! input/output variables - character(len=*) , intent(in) :: fldname - real(r8) , intent(out) :: data(:) - - ! local variables - integer :: n - character(len=*), parameter :: subname='(lilac_atmcap_lnd2atm)' - ! -------------------------------------------- - - do n = 1,size(lnd2atm) - if (trim(fldname) == lnd2atm(n)%fldname) then - if (size(data) /= size(lnd2atm(n)%dataptr)) then - call shr_sys_abort(trim(subname) // 'size(data) not equal to size(lnd2atm(n)%dataptr') - else - data(:) = lnd2atm(n)%dataptr(:) - end if - end if - end do - end subroutine lilac_atmcap_lnd2atm - -!======================================================================== - subroutine lilac_atmcap_add_fld(flds, fldname, units, lsize, required_fr_atm) - - ! ---------------------------------------------- - ! Add an entry to to the flds array - ! Use pointers to create an extensible allocatable array. - ! to allow the size of flds to grow, the process for - ! adding a new field is: - ! 1) allocate newflds to be N (one element larger than flds) - ! 2) copy flds into first N-1 elements of newflds - ! 3) newest flds entry is Nth element of newflds - ! 4) deallocate / nullify flds - ! 5) point flds => newflds - ! ---------------------------------------------- - - type(atmcap_type), pointer :: flds(:) - character(len=*) , intent(in) :: fldname - character(len=*) , intent(in) :: units - integer , intent(in) :: lsize - logical, optional, intent(in) :: required_fr_atm - - ! local variables - integer :: n,oldsize,newsize - type(atmcap_type), pointer :: newflds(:) - character(len=*), parameter :: subname='(lilac_atmcap_atm2lnd_fld)' - ! ---------------------------------------------- - - if (associated(flds)) then - oldsize = size(flds) - else - oldsize = 0 - end if - newsize = oldsize + 1 - - if (oldsize > 0) then - ! 1) allocate newfld to be size (one element larger than input flds) - allocate(newflds(newsize)) - - ! 2) copy flds into first N-1 elements of newflds - do n = 1,oldsize - newflds(n)%fldname = flds(n)%fldname - newflds(n)%units = flds(n)%units - newflds(n)%required_fr_atm = flds(n)%required_fr_atm - end do - - ! 3) deallocate / nullify flds - if (oldsize > 0) then - deallocate(flds) - nullify(flds) - end if - - ! 4) point flds => new_flds - flds => newflds - - ! 5) update flds information for new entry - flds(newsize)%fldname = trim(fldname) - flds(newsize)%units = trim(units) - if (present(required_fr_atm)) then - flds(newsize)%required_fr_atm = required_fr_atm - end if - - else - allocate(flds(newsize)) - flds(newsize)%fldname = trim(fldname) - flds(newsize)%units = trim(units) - if (present(required_fr_atm)) then - flds(newsize)%required_fr_atm = required_fr_atm - end if - end if - - end subroutine lilac_atmcap_add_fld - end module lilac_atmcap diff --git a/lilac/src/lilac_constants.F90 b/lilac/src/lilac_constants.F90 index d564e14420..847fe2cc1d 100644 --- a/lilac/src/lilac_constants.F90 +++ b/lilac/src/lilac_constants.F90 @@ -12,5 +12,7 @@ module lilac_constants integer, parameter :: lilac_constants_ispval_mask = -987987 ! spval for RH mask values integer, parameter :: lilac_constants_SecPerDay = 86400 ! Seconds per day integer :: lilac_constants_dbug_flag = 0 + integer, parameter :: field_index_unset = -1 + integer :: logunit = 6 ! TODO: fix/generalize this end module lilac_constants diff --git a/lilac/src/lilac_io.F90 b/lilac/src/lilac_io.F90 index 431d785e06..159f6d6209 100644 --- a/lilac/src/lilac_io.F90 +++ b/lilac/src/lilac_io.F90 @@ -11,6 +11,7 @@ module lilac_io use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat use shr_sys_mod , only : shr_sys_abort use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag + use lilac_constants , only : logunit use lilac_methods , only : FB_getFieldN => lilac_methods_FB_getFieldN use lilac_methods , only : FB_getFldPtr => lilac_methods_FB_getFldPtr use lilac_methods , only : FB_getNameN => lilac_methods_FB_getNameN @@ -32,8 +33,6 @@ module lilac_io implicit none private - integer :: logunit = 6 ! TODO: fix this - ! public member functions: public :: lilac_io_wopen public :: lilac_io_close diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index d05746c89c..cfc7343329 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -15,7 +15,7 @@ module lilac_mod use shr_sys_mod , only : shr_sys_abort use shr_kind_mod , only : r8 => shr_kind_r8 - ! lilac routines + ! lilac routines and data use lilac_io , only : lilac_io_init use lilac_time , only : lilac_time_clockinit, lilac_time_alarminit use lilac_time , only : lilac_time_restart_write, lilac_time_restart_read @@ -24,6 +24,10 @@ module lilac_mod use lilac_history , only : lilac_history_init use lilac_history , only : lilac_history_write use lilac_methods , only : chkerr + use lilac_constants, only : logunit + use ctsm_LilacCouplingFields, only : create_a2l_field_list, create_l2a_field_list + use ctsm_LilacCouplingFields, only : complete_a2l_field_list, complete_l2a_field_list + use ctsm_LilacCouplingFields, only : a2l_fields ! lilac register phaes use lilac_atmcap , only : lilac_atmcap_register @@ -38,7 +42,8 @@ module lilac_mod implicit none - public :: lilac_init + public :: lilac_init1 + public :: lilac_init2 public :: lilac_run public :: lilac_final @@ -74,19 +79,32 @@ module lilac_mod character(*), parameter :: u_FILE_u = & __FILE__ - integer :: logunit = 6 ! TODO: generalize this - !======================================================================== contains !======================================================================== - subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & + subroutine lilac_init1() + + ! -------------------------------------------------------------------------------- + ! This is called by the host atmosphere. This is phase 1 of the lilac initialization. + ! + ! Indices defined in lilac_coupling_fields (lilac_a2l_* and lilac_l2a_*) are not + ! valid until this is called. + ! -------------------------------------------------------------------------------- + + call create_a2l_field_list() + call create_l2a_field_list() + + end subroutine lilac_init1 + + + subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & atm_global_nx, atm_global_ny, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - starttype_in) + starttype_in, fields_needed_from_data) ! -------------------------------------------------------------------------------- - ! This is called by the host atmosphere + ! This is called by the host atmosphere. This is phase 2 of the lilac initialization. ! -------------------------------------------------------------------------------- ! input/output variables @@ -104,6 +122,12 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & integer , intent(in) :: atm_start_secs character(len=*) , intent(in) :: starttype_in + ! List of field indices that need to be read from data, because the host atmosphere + ! isn't going to provide them. These should be indices given in + ! ctsm_LilacCouplingFields (lilac_a2l_Faxa_bcphidry). This can be an empty list if no + ! fields need to be read from data. + integer , intent(in) :: fields_needed_from_data(:) + ! local variables character(ESMF_MAXSTR) :: caseid type(ESMF_TimeInterval) :: timeStep @@ -141,6 +165,13 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & !------------------------------------------------------------------------- starttype = starttype_in + ! ------------------------------------------------------------------------ + ! Complete setup of field lists started in lilac_init1, now that we know the number + ! of atm points. + ! ------------------------------------------------------------------------ + call complete_a2l_field_list(size(atm_global_index), fields_needed_from_data) + call complete_l2a_field_list(size(atm_global_index)) + !------------------------------------------------------------------------- ! Initialize pio with first initialization ! AFTER call to MPI_init (which is in the host atm driver) and @@ -327,7 +358,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & call lilac_time_clockInit(caseid, starttype, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - logunit, lilac_clock, rc) + lilac_clock, rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing clock") call ESMF_LogWrite(subname//"lilac_clock initialized", ESMF_LOGMSG_INFO) @@ -447,7 +478,7 @@ subroutine lilac_init(mpicom, atm_global_index, atm_lons, atm_lats, & if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in initializing lilac_history_init") call ESMF_LogWrite(subname//"initialized lilac history output ...", ESMF_LOGMSG_INFO) - end subroutine lilac_init + end subroutine lilac_init2 !======================================================================== @@ -512,6 +543,11 @@ subroutine lilac_run(write_restarts_now, stop_now) call lilac_atmaero_interp(atm2cpl_state, lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac_atmaero_interp") + ! Make sure all atm2lnd fields have been set + ! FIXME(wjs, 2020-02-27) Uncomment this once data model functionality has been + ! properly hooked up + ! call a2l_fields%check_all_set() + ! Run cpl_atm2lnd call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) if (mytask == 0) write(logunit,*) "Running coupler component..... cpl_atm2lnd_comp" @@ -594,6 +630,9 @@ subroutine lilac_run(write_restarts_now, stop_now) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + ! Reset atm2lnd provided flags for next time step + call a2l_fields%reset_provided() + ! Advance the lilac clock at the end of the time step call ESMF_ClockAdvance(lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in advancing time step") diff --git a/lilac/src/lilac_time.F90 b/lilac/src/lilac_time.F90 index 524270f283..31929e8a42 100644 --- a/lilac/src/lilac_time.F90 +++ b/lilac/src/lilac_time.F90 @@ -7,6 +7,7 @@ module lilac_time use lilac_io , only : lilac_io_write, lilac_io_wopen, lilac_io_enddef use lilac_io , only : lilac_io_close, lilac_io_date2yyyymmdd, lilac_io_sec2hms use lilac_methods , only : chkerr + use lilac_constants, only : logunit use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr use netcdf , only : nf90_inq_varid, nf90_get_var, nf90_close @@ -48,7 +49,7 @@ module lilac_time subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - logunit, lilac_clock, rc) + lilac_clock, rc) ! ------------------------------------------------- ! Initialize the lilac clock @@ -63,7 +64,6 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep integer , intent(in) :: atm_start_mon !(mm) integer , intent(in) :: atm_start_day integer , intent(in) :: atm_start_secs - integer , intent(in) :: logunit type(ESMF_Clock) , intent(inout) :: lilac_clock integer , intent(out) :: rc @@ -179,7 +179,7 @@ subroutine lilac_time_clockInit(caseid_in, starttype, atm_calendar, atm_timestep TimeStep_advance = currtime - clocktime call ESMF_TimeIntervalGet(timestep_advance, s=secs, rc=rc) - if (mytask == 0) write(6,*)'DEBUG: time step advance is ',secs + if (mytask == 0) write(logunit,*)'DEBUG: time step advance is ',secs ! Advance the clock to the current time (in case of a restart) call ESMF_ClockAdvance (lilac_clock, timestep=timestep_advance, rc=rc) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 676d4bf34c..f0591be358 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -11,7 +11,7 @@ module lnd_comp_esmf use perf_mod , only : t_startf, t_stopf, t_barrierf ! lilac code - use lilac_atmcap , only : atm2lnd, lnd2atm + use ctsm_LilacCouplingFields, only : a2l_fields, l2a_fields ! cime share code use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl @@ -407,9 +407,9 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! now add atm import fields on lnd_mesh to this field bundle - do n = 1, size(atm2lnd) + do n = 1, a2l_fields%num_fields() lfield = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT, & - name=trim(atm2lnd(n)%fldname), rc=rc) + name=a2l_fields%get_fieldname(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleAdd(c2l_fb_atm, (/lfield/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -443,9 +443,9 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! now add atm export fields on lnd_mesh to this field bundle - do n = 1, size(lnd2atm) + do n = 1, l2a_fields%num_fields() lfield = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT, & - name=trim(lnd2atm(n)%fldname), rc=rc) + name=l2a_fields%get_fieldname(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleAdd(l2c_fb_atm, (/lfield/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From e5ae987359958b79177e0bd97f9788776b8e1e12 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 28 Feb 2020 09:58:41 -0700 Subject: [PATCH 292/556] For fields lilac reads from data, set via lilac_atm2lnd interface Rather than directly setting fields in the esmf field bundle, use the same interface that the host atmosphere would use to set these fields. This allows for error checking, ensuring that exactly one of the host atmosphere and the data atmosphere set a given field. --- lilac/src/ctsm_LilacAtm2LndFieldListType.F90 | 6 + lilac/src/lilac_atmaero.F90 | 128 ++++++++++--------- lilac/src/lilac_mod.F90 | 6 +- 3 files changed, 76 insertions(+), 64 deletions(-) diff --git a/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 b/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 index 14ae5f22a4..ce191f4e3c 100644 --- a/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 +++ b/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 @@ -335,6 +335,12 @@ subroutine set_field(this, field_index, data) ! This can typically happen in one of two ways: ! - A component tries to re-set a field that has already been set ! - reset_provided hasn't been called in between times + write(logunit,*) subname//' ERROR: attempt to set an already-set field: ', this%fields(field_index)%fieldname + if (this%fields(field_index)%needed_from_data) then + write(logunit,*) "This field was marked as being needed from data." + write(logunit,*) "A possible cause of this error is that it is being set by both" + write(logunit,*) "the host atmosphere and LILAC's internal data atmosphere." + end if call shr_sys_abort(subname//' attempt to set an already-set field: '//this%fields(field_index)%fieldname) end if diff --git a/lilac/src/lilac_atmaero.F90 b/lilac/src/lilac_atmaero.F90 index 4008c9b942..f9098f4a89 100644 --- a/lilac/src/lilac_atmaero.F90 +++ b/lilac/src/lilac_atmaero.F90 @@ -16,6 +16,7 @@ module lilac_atmaero use shr_mpi_mod , only : shr_mpi_bcast use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create use shr_strdata_mod , only : shr_strdata_print, shr_strdata_advance + use shr_string_mod , only : shr_string_listAppend use shr_cal_mod , only : shr_cal_ymd2date use shr_pio_mod , only : shr_pio_getiotype use mct_mod , only : mct_avect_indexra, mct_gsmap, mct_ggrid @@ -31,16 +32,30 @@ module lilac_atmaero use lilac_atmcap , only : gindex_atm use lilac_methods , only : chkerr use lilac_methods , only : lilac_methods_FB_getFieldN + use lilac_constants , only : field_index_unset + use ctsm_LilacCouplingFields, only : a2l_fields, lilac_atm2lnd + use ctsm_LilacCouplingFieldIndices implicit none private + type, private :: field_mapping_type + character(len=:), allocatable :: field_name + integer :: field_index = field_index_unset + end type field_mapping_type + public :: lilac_atmaero_init ! initialize stream data type sdat public :: lilac_atmaero_interp ! interpolates between two years of ndep file data ! module data type(shr_strdata_type) :: sdat ! input data stream + ! The first num_fields_to_read in the fields_to_read list are the fields that this + ! module will read from data. This is set up to have the same ordering as the fields in + ! sdat. + integer :: num_fields_to_read + type(field_mapping_type), allocatable :: fields_to_read(:) + character(*),parameter :: u_file_u = & __FILE__ @@ -65,9 +80,11 @@ subroutine lilac_atmaero_init(atm2cpl_state, rc) type(ESMF_Field) :: lfield type(mct_ggrid) :: ggrid_atm ! domain information type(mct_gsmap) :: gsmap_atm ! decompositoin info + type(field_mapping_type), allocatable :: all_fields(:) ! all fields that can possibly be read from data integer :: mytask ! mpi task number integer :: mpicom ! mpi communicator - integer :: n,i,j ! index + integer :: n ! index + integer :: field_index integer :: lsize ! local size integer :: gsize ! global size integer :: nunit ! namelist input unit @@ -76,7 +93,7 @@ subroutine lilac_atmaero_init(atm2cpl_state, rc) character(len=CL) :: mapalgo = 'bilinear' ! type of 2d mapping character(len=CS) :: taxmode = 'extend' ! time extrapolation character(len=CL) :: fldlistFile ! name of fields in input stream file - character(len=CL) :: fldlistModel ! name of fields in data stream code + character(len=CL) :: fldlistModel ! name of fields in model integer :: stream_year_first ! first year in stream to use integer :: stream_year_last ! last year in stream to use integer :: model_year_align ! align stream_year_first with model year @@ -96,6 +113,40 @@ subroutine lilac_atmaero_init(atm2cpl_state, rc) rc = ESMF_SUCCESS + all_fields = [ & + field_mapping_type('BCDEPWET', lilac_a2l_Faxa_bcphiwet), & + field_mapping_type('BCPHODRY', lilac_a2l_Faxa_bcphodry), & + field_mapping_type('BCPHIDRY', lilac_a2l_Faxa_bcphidry), & + field_mapping_type('OCDEPWET', lilac_a2l_Faxa_ocphiwet), & + field_mapping_type('OCPHIDRY', lilac_a2l_Faxa_ocphidry), & + field_mapping_type('OCPHODRY', lilac_a2l_Faxa_ocphodry), & + field_mapping_type('DSTX01WD', lilac_a2l_Faxa_dstwet1), & + field_mapping_type('DSTX01DD', lilac_a2l_Faxa_dstdry1), & + field_mapping_type('DSTX02WD', lilac_a2l_Faxa_dstwet2), & + field_mapping_type('DSTX02DD', lilac_a2l_Faxa_dstdry2), & + field_mapping_type('DSTX03WD', lilac_a2l_Faxa_dstwet3), & + field_mapping_type('DSTX03DD', lilac_a2l_Faxa_dstdry3), & + field_mapping_type('DSTX04WD', lilac_a2l_Faxa_dstwet4), & + field_mapping_type('DSTX04DD', lilac_a2l_Faxa_dstdry4)] + + num_fields_to_read = 0 + allocate(fields_to_read(size(all_fields))) + fldlistFile = ' ' + fldlistModel = ' ' + do n = 1, size(all_fields) + field_index = all_fields(n)%field_index + if (a2l_fields%is_needed_from_data(field_index)) then + num_fields_to_read = num_fields_to_read + 1 + fields_to_read(num_fields_to_read) = all_fields(n) + call shr_string_listAppend(fldlistFile, fields_to_read(num_fields_to_read)%field_name) + call shr_string_listAppend(fldlistModel, a2l_fields%get_fieldname(field_index)) + end if + end do + + if (num_fields_to_read == 0) then + return + end if + ! default values for namelist stream_year_first = 1 ! first year in stream to use stream_year_last = 1 ! last year in stream to use @@ -137,19 +188,6 @@ subroutine lilac_atmaero_init(atm2cpl_state, rc) print *, ' ' endif - ! ------------------------------ - ! create the field list for these urbantv fields...use in shr_strdata_create - ! ------------------------------ - fldlistFile = 'BCDEPWET:BCPHODRY:BCPHIDRY:' - fldlistFile = trim(fldlistFile) // 'OCDEPWET:OCPHIDRY:OCPHODRY:DSTX01WD:' - fldlistFile = trim(fldlistFile) // 'DSTX01DD:DSTX02WD:DSTX02DD:DSTX03WD:' - fldlistFile = trim(fldlistFile) // 'DSTX03DD:DSTX04WD:DSTX04DD' - - fldlistModel = 'Faxa_bcphiwet:Faxa_bcphodry:Faxa_bcphidry:' - fldlistModel = trim(fldlistModel) // 'Faxa_ocphiwet:Faxa_ocphidry:Faxa_ocphodry:' - fldlistModel = trim(fldlistModel) // 'Faxa_dstwet1:Faxa_dstdry1:Faxa_dstwet2:Faxa_dstdry2:' - fldlistModel = trim(fldlistModel) // 'Faxa_dstwet3:Faxa_dstdry3:Faxa_dstwet4:Faxa_dstdry4' - ! ------------------------------ ! create the mct gsmap ! ------------------------------ @@ -245,10 +283,9 @@ end subroutine lilac_atmaero_init !================================================================ - subroutine lilac_atmaero_interp(atm2cpl_state, clock, rc) + subroutine lilac_atmaero_interp(clock, rc) ! input/output variables - type(ESMF_State) :: atm2cpl_state type(ESMF_Clock) :: clock integer, intent(out) :: rc @@ -259,11 +296,16 @@ subroutine lilac_atmaero_interp(atm2cpl_state, clock, rc) type(ESMF_FieldBundle) :: lfieldbundle type(ESMF_Time) :: currTime integer :: yy, mm, dd, sec, curr_ymd + integer :: n character(len=*), parameter :: subname='lilac_atmaero: [lilac_atmaero_interp]' !----------------------------------------------------------------------- rc = ESMF_SUCCESS + if (num_fields_to_read == 0) then + return + end if + ! get mytask and mpicom call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -281,60 +323,26 @@ subroutine lilac_atmaero_interp(atm2cpl_state, clock, rc) ! advance the streams call shr_strdata_advance(sdat, curr_ymd, sec, mpicom, 'atmaero') - ! set field bundle data - call ESMF_StateGet(atm2cpl_state, "a2c_fb", lfieldbundle, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call set_fieldbundle_data('Faxa_bcphidry' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_bcphodry' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_bcphiwet' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_ocphidry' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_ocphodry' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_ocphiwet' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstwet1' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstdry1' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstwet2' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstdry2' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstwet3' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstdry3' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstwet4' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return - call set_fieldbundle_data('Faxa_dstdry4' , lfieldbundle, rc) ; if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1, num_fields_to_read + call set_field(n) + end do end subroutine lilac_atmaero_interp !============================================================================== - subroutine set_fieldbundle_data(fldname, fieldbundle, rc) + subroutine set_field(fieldnum) ! input/output data - character(len=*) , intent(in) :: fldname - type(ESMF_FieldBundle) , intent(inout) :: fieldbundle - integer , intent(out) :: rc + integer, intent(in) :: fieldnum ! index into fields_to_read and sdat (which are assumed to have the same ordering) ! local data - type(ESMF_field) :: lfield - integer :: nfld, i - real(r8), pointer :: fldptr1d(:) + integer :: field_index ! index in a2l_fields !----------------------------------------------------------------------- - rc = ESMF_SUCCESS - - call ESMF_FieldBundleGet(fieldBundle, fieldName=trim(fldname), field=lfield, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! error check - if (size(fldptr1d) /= size(sdat%avs(1)%rAttr, dim=2)) then - call shr_sys_abort("ERROR: size of fldptr1d and sdat%avs(1)%rattr dim2 are not equal") - end if - - nfld = mct_avect_indexra(sdat%avs(1),trim(fldname)) - do i = 1, size(fldptr1d) - fldptr1d(i)= sdat%avs(1)%rAttr(nfld,i) - end do + field_index = fields_to_read(fieldnum)%field_index + call lilac_atm2lnd(field_index, sdat%avs(1)%rAttr(fieldnum,:)) - end subroutine set_fieldbundle_data + end subroutine set_field end module lilac_atmaero diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index cfc7343329..1900e1281b 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -540,13 +540,11 @@ subroutine lilac_run(write_restarts_now, stop_now) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac atm_cap") ! Update prescribed aerosols atm2cpl_a_state - call lilac_atmaero_interp(atm2cpl_state, lilac_clock, rc=rc) + call lilac_atmaero_interp(lilac_clock, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("lilac error in running lilac_atmaero_interp") ! Make sure all atm2lnd fields have been set - ! FIXME(wjs, 2020-02-27) Uncomment this once data model functionality has been - ! properly hooked up - ! call a2l_fields%check_all_set() + call a2l_fields%check_all_set() ! Run cpl_atm2lnd call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) From 514195483e44a32a50fda47f661599a9742afaab Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 28 Feb 2020 10:31:28 -0700 Subject: [PATCH 293/556] Provide bcphidry from the demo driver rather than from data This way we actually test the logic that avoids reading fields from data unless the host atmosphere asks for it. --- lilac/atm_driver/atm_driver.F90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 65ec080a88..947a92319e 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -193,7 +193,9 @@ program atm_driver atm_start_secs = atm_start_secs, & starttype_in = atm_starttype, & fields_needed_from_data = [ & - lilac_a2l_Faxa_bcphidry, lilac_a2l_Faxa_bcphodry, lilac_a2l_Faxa_bcphiwet, & + ! Deliberately excluding bcphidry to test the logic that says that a field should + ! only be read from data if explicitly requested by the host atmosphere. + lilac_a2l_Faxa_bcphodry, lilac_a2l_Faxa_bcphiwet, & lilac_a2l_Faxa_ocphidry, lilac_a2l_Faxa_ocphodry, lilac_a2l_Faxa_ocphiwet, & lilac_a2l_Faxa_dstwet1, lilac_a2l_Faxa_dstdry1, & lilac_a2l_Faxa_dstwet2, lilac_a2l_Faxa_dstdry2, & @@ -466,6 +468,12 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) data(:) = 45.0d0 + space_time_perturbation(:) call lilac_atm2lnd(lilac_a2l_Faxa_swvdf, data) + ! This field has the potential to be read from data. We're setting it here to provide + ! a test of the logic that says that a field should only be read from data if + ! explicitly requested by the host atmosphere. + data(:) = 1.0d-13 + space_time_perturbation(:)*1.0e-14 + call lilac_atm2lnd(lilac_a2l_Faxa_bcphidry, data) + end subroutine atm_driver_to_lilac !======================================================================== From 498c355db1a9764a74317904a7ec08ff4cab1eae Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 28 Feb 2020 10:38:26 -0700 Subject: [PATCH 294/556] Avoid writing garbage units to lilac history file This was not filled in correctly, so the units attribute was garbage. Eventually we should fix this properly. For now I'm commenting out these lines similarly to what's done in other, similar routines in this module. --- lilac/src/lilac_io.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lilac/src/lilac_io.F90 b/lilac/src/lilac_io.F90 index 159f6d6209..276fc23cc6 100644 --- a/lilac/src/lilac_io.F90 +++ b/lilac/src/lilac_io.F90 @@ -591,7 +591,7 @@ subroutine lilac_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",lfillvalue) end if if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + ! rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then @@ -611,7 +611,7 @@ subroutine lilac_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", lfillvalue) end if if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(cunit)) + ! rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(cunit)) rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then From 8cb9f3c028b48a95f5ce45ef090fa90451511b23 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 28 Feb 2020 10:45:30 -0700 Subject: [PATCH 295/556] In lilac's demo driver, ensure rain & snow are always positive --- lilac/atm_driver/atm_driver.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 947a92319e..15d29f8568 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -438,22 +438,22 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) data(:) = 280.0d0 + space_time_perturbation(:) call lilac_atm2lnd(lilac_a2l_Sa_tbot, data) - data(:) = 0.0004d0 + space_time_perturbation(:)*1.0e-8 + data(:) = 0.0004d0 + space_time_perturbation(:)*1.0d-8 call lilac_atm2lnd(lilac_a2l_Sa_shum, data) data(:) = 200.0d0 + space_time_perturbation(:) call lilac_atm2lnd(lilac_a2l_Faxa_lwdn, data) - data(:) = 1.0d-8 + space_time_perturbation(:)*1.0e-8 + data(:) = 1.0d-8 + space_time_perturbation(:)*1.0d-9 call lilac_atm2lnd(lilac_a2l_Faxa_rainc, data) - data(:) = 2.0d-8 + space_time_perturbation(:)*1.0e-8 + data(:) = 2.0d-8 + space_time_perturbation(:)*1.0d-9 call lilac_atm2lnd(lilac_a2l_Faxa_rainl, data) - data(:) = 1.0d-9 + space_time_perturbation(:)*1.0e-9 + data(:) = 1.0d-9 + space_time_perturbation(:)*1.0d-10 call lilac_atm2lnd(lilac_a2l_Faxa_snowc, data) - data(:) = 2.0d-9 + space_time_perturbation(:)*1.0e-9 + data(:) = 2.0d-9 + space_time_perturbation(:)*1.0d-10 call lilac_atm2lnd(lilac_a2l_Faxa_snowl, data) data(:) = 100.0d0 + space_time_perturbation(:) @@ -471,7 +471,7 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) ! This field has the potential to be read from data. We're setting it here to provide ! a test of the logic that says that a field should only be read from data if ! explicitly requested by the host atmosphere. - data(:) = 1.0d-13 + space_time_perturbation(:)*1.0e-14 + data(:) = 1.0d-13 + space_time_perturbation(:)*1.0d-14 call lilac_atm2lnd(lilac_a2l_Faxa_bcphidry, data) end subroutine atm_driver_to_lilac From 845c162b5bce8f8de52ddf1e9926eefc9ff9e78a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 28 Feb 2020 12:54:55 -0700 Subject: [PATCH 296/556] Delete documentation that is no longer correct This was also out of place after the recent rework --- lilac/src/lilac_atmcap.F90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index 96b70e918c..f4b041f3d7 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -2,16 +2,6 @@ module lilac_atmcap !----------------------------------------------------------------------- ! This is an ESMF lilac cap for the host atmosphere - ! - ! THE HOST ATMOSPHERE IS RESPONSIBLE for calling lilac_init() and in turn - ! lilac_init() calls the initialization routines for atm2lnd and lnd2atm - ! - ! the host atm init call will be - ! call lilac_init() - ! the host atm run phase will be - ! call lilac_atm2lnd(fldname, data1d) - ! call lilac_run(write_restarts_now, stop_now) - ! call lilac_lnd2atm(fldname, data1d) !----------------------------------------------------------------------- use ESMF From 36154c5b5853ed75bf6e08f4b8244e53e39e0c06 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 28 Feb 2020 13:22:23 -0700 Subject: [PATCH 297/556] Make atm_lons and atm_lats private These didn't need to be public --- lilac/src/lilac_atmcap.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index f4b041f3d7..c34859df49 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -18,8 +18,8 @@ module lilac_atmcap ! Time invariant input from host atmosphere integer , public, allocatable :: gindex_atm(:) ! global index space - real(r8), public, allocatable :: atm_lons(:) ! local longitudes - real(r8), public, allocatable :: atm_lats(:) ! local latitudes + real(r8), private, allocatable :: atm_lons(:) ! local longitudes + real(r8), private, allocatable :: atm_lats(:) ! local latitudes integer , public :: atm_global_nx integer , public :: atm_global_ny From c9a7cb9bb074b20f5f9e6f204245d2076cb3afb3 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 9 Mar 2020 09:32:09 -0600 Subject: [PATCH 298/556] Fix some comments --- lilac/src/ctsm_LilacCouplingFields.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lilac/src/ctsm_LilacCouplingFields.F90 b/lilac/src/ctsm_LilacCouplingFields.F90 index f93315f74d..7587522b4f 100644 --- a/lilac/src/ctsm_LilacCouplingFields.F90 +++ b/lilac/src/ctsm_LilacCouplingFields.F90 @@ -52,7 +52,7 @@ subroutine lilac_atm2lnd(field_index, data) ! !DESCRIPTION: ! Set a single atm -> lnd field ! - ! field_index should be one of the lilac_a2l_* indices defined in this module + ! field_index should be one of the lilac_a2l_* indices defined in ctsm_LilacCouplingFieldIndices ! ! !ARGUMENTS: integer, intent(in) :: field_index @@ -73,7 +73,7 @@ subroutine lilac_lnd2atm(field_index, data) ! !DESCRIPTION: ! Get a single lnd -> atm field ! - ! field_index should be one of the lilac_l2a_* indices defined in this module + ! field_index should be one of the lilac_l2a_* indices defined in ctsm_LilacCouplingFieldIndices ! ! !ARGUMENTS: integer, intent(in) :: field_index From 47b6cf127e4475d04aa15c6cd09566e734f33d10 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 9 Mar 2020 10:33:43 -0600 Subject: [PATCH 299/556] Update cmeps version I started getting errors in preview_namelists with the old version: Traceback (most recent call last): File "/Users/sacks/ctsm/ctsm2/cime/src/drivers/nuopc/cime_config/buildnml", line 509, in _main_func() File "/Users/sacks/ctsm/ctsm2/cime/src/drivers/nuopc/cime_config/buildnml", line 506, in _main_func buildnml(case, caseroot, "drv") File "/Users/sacks/ctsm/ctsm2/cime/src/drivers/nuopc/cime_config/buildnml", line 474, in buildnml _create_drv_namelists(case, infile, confdir, nmlgen, files) File "/Users/sacks/ctsm/ctsm2/cime/src/drivers/nuopc/cime_config/buildnml", line 241, in _create_drv_namelists _create_runseq(case, coupling_times) File "/Users/sacks/ctsm/ctsm2/cime/src/drivers/nuopc/cime_config/buildnml", line 332, in _create_runseq from runseq_I import runseq File "/Users/sacks/ctsm/ctsm2/cime/src/drivers/nuopc/cime_config/../../../../src/drivers/nuopc/cime_config/runseq/runseq_I.py", line 70 print "cism_evolve = ",cism_evolve ^ SyntaxError: Missing parentheses in call to 'print'. Did you mean print("cism_evolve = ",cism_evolve)? ERROR: /Users/sacks/ctsm/ctsm2/cime/src/drivers/nuopc/cime_config/buildnml /Users/sacks/projects/scratch/test_lilac_0309b FAILED, see above The immediate error was a lack of parentheses in the print function (needed with python3), but the weirder error is that this is in a code block that should only be executed if using cism (not stub glc), but this was in a compset using stub glc. I'm not sure why this started now, but updating to the latest cmeps version seems to fix the issue, so I'm doing that. --- Externals_cime.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_cime.cfg b/Externals_cime.cfg index cbede7df52..2ff29da9f9 100644 --- a/Externals_cime.cfg +++ b/Externals_cime.cfg @@ -1,5 +1,5 @@ [cmeps] -hash = 181ff1ed9dfb279e619e8a2173f43baf7bf1dce3 +hash = 36e352b2735a8e3478bde4129ff58214521c7409 protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = src/drivers/nuopc/ From 1989b0572197ec7f274e89bbff3262bb52ea1a82 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 9 Mar 2020 11:42:45 -0600 Subject: [PATCH 300/556] Add capability for time-constant fields landfrac, and possibly some other fields, will typically just be provided in the first time step, and don't need to be re-set every time step. Allow that, and change the demo atm driver to exercise this logic for landfrac. --- lilac/atm_driver/atm_driver.F90 | 9 ++- lilac/src/ctsm_LilacAtm2LndFieldListType.F90 | 25 ++++++-- lilac/src/ctsm_LilacCouplingFields.F90 | 64 ++++++++++---------- 3 files changed, 59 insertions(+), 39 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 15d29f8568..578fc1d32b 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -403,6 +403,9 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) time_perturbation = 0.5d0 * (nstep - time_midpoint)/time_midpoint space_time_perturbation(:) = time_perturbation + lat(:)*0.01d0 + lon(:)*0.01d0 + ! Only set landfrac in the first time step, similar to what most real atmospheres + ! will probably do. + ! ! We don't have a good way to set a land mask / fraction in this demo driver. Since it ! is okay for the atmosphere to call a point ocean when CTSM calls it land, but not ! the reverse, here we call all points ocean. In a real atmosphere, the atmosphere @@ -410,8 +413,10 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) ! that CTSM is running over all of the necessary points. Note that this landfrac ! variable doesn't actually impact the running of CTSM, but it is used for ! consistency checking. - data(:) = 0.d0 - call lilac_atm2lnd(lilac_a2l_Sa_landfrac, data) + if (nstep == 1) then + data(:) = 0.d0 + call lilac_atm2lnd(lilac_a2l_Sa_landfrac, data) + end if ! In the following, try to have each field have different values, in order to catch ! mis-matches (e.g., if foo and bar were accidentally swapped in CTSM, we couldn't diff --git a/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 b/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 index ce191f4e3c..b18c376f98 100644 --- a/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 +++ b/lilac/src/ctsm_LilacAtm2LndFieldListType.F90 @@ -50,6 +50,7 @@ module ctsm_LilacAtm2LndFieldListType character(len=:), allocatable :: fieldname character(len=:), allocatable :: units logical :: available_from_data ! whether this field can be obtained from data if not provided by the sending component + logical :: can_be_time_const ! if true, it's okay for this field to be set just once, in the first time step, keeping its same value for the entire run (e.g., a landfrac field that doesn't vary in time) ! Metadata set later in initialization logical :: needed_from_data ! whether the host atmosphere wants LILAC to read this field from data @@ -58,6 +59,7 @@ module ctsm_LilacAtm2LndFieldListType ! Data set each time step real(r8), pointer :: dataptr(:) logical :: provided_this_time ! whether this variable has been set this time step + logical :: provided_ever ! whether this variable has ever been set end type lilac_atm2lnd_field_type ! Define a dynamic vector for lilac_atm2lnd_field_type @@ -103,7 +105,7 @@ module ctsm_LilacAtm2LndFieldListType #include "dynamic_vector_procdef.inc" !----------------------------------------------------------------------- - function new_lilac_atm2lnd_field_type(fieldname, units, available_from_data) result(this) + function new_lilac_atm2lnd_field_type(fieldname, units, available_from_data, can_be_time_const) result(this) ! ! !DESCRIPTION: ! Initialize a new lilac_atm2lnd_field_type object @@ -113,6 +115,7 @@ function new_lilac_atm2lnd_field_type(fieldname, units, available_from_data) res character(len=*), intent(in) :: fieldname character(len=*), intent(in) :: units logical, intent(in) :: available_from_data ! whether this field can be obtained from data if not provided by the sending component + logical, intent(in) :: can_be_time_const ! if true, it's okay for this field to be set just once, in the first time step, keeping its same value for the entire run (e.g., a landfrac field that doesn't vary in time) ! ! !LOCAL VARIABLES: @@ -122,6 +125,7 @@ function new_lilac_atm2lnd_field_type(fieldname, units, available_from_data) res this%fieldname = fieldname this%units = units this%available_from_data = available_from_data + this%can_be_time_const = can_be_time_const ! Assume false until told otherwise this%needed_from_data = .false. @@ -131,6 +135,7 @@ function new_lilac_atm2lnd_field_type(fieldname, units, available_from_data) res nullify(this%dataptr) this%provided_this_time = .false. + this%provided_ever = .false. end function new_lilac_atm2lnd_field_type @@ -153,7 +158,7 @@ subroutine init(this) end subroutine init !----------------------------------------------------------------------- - subroutine add_var(this, fieldname, units, available_from_data, field_index) + subroutine add_var(this, fieldname, units, available_from_data, can_be_time_const, field_index) ! ! !DESCRIPTION: ! Add the given field to this list @@ -167,6 +172,7 @@ subroutine add_var(this, fieldname, units, available_from_data, field_index) character(len=*), intent(in) :: fieldname character(len=*), intent(in) :: units logical, intent(in) :: available_from_data ! whether this field can be obtained from data if not provided by the sending component + logical, intent(in) :: can_be_time_const ! if true, it's okay for this field to be set just once, in the first time step, keeping its same value for the entire run (e.g., a landfrac field that doesn't vary in time) integer, intent(inout) :: field_index ! ! !LOCAL VARIABLES: @@ -192,7 +198,8 @@ subroutine add_var(this, fieldname, units, available_from_data, field_index) one_field = lilac_atm2lnd_field_type( & fieldname = trim(fieldname), & units = trim(units), & - available_from_data = available_from_data) + available_from_data = available_from_data, & + can_be_time_const = can_be_time_const) call this%field_vec%push_back(one_field) @@ -346,6 +353,7 @@ subroutine set_field(this, field_index, data) this%fields(field_index)%dataptr(:) = data(:) this%fields(field_index)%provided_this_time = .true. + this%fields(field_index)%provided_ever = .true. end subroutine set_field @@ -365,8 +373,15 @@ subroutine check_all_set(this) !----------------------------------------------------------------------- do i = 1, this%num_fields() - if (this%fields(i)%required_by_lnd .and. .not. this%fields(i)%provided_this_time) then - call shr_sys_abort(trim(this%fields(i)%fieldname)//' required but not provided') + if (this%fields(i)%required_by_lnd) then + if (.not. this%fields(i)%provided_ever) then + call shr_sys_abort(trim(this%fields(i)%fieldname)//' required but never provided') + end if + if (.not. this%fields(i)%can_be_time_const) then + if (.not. this%fields(i)%provided_this_time) then + call shr_sys_abort(trim(this%fields(i)%fieldname)//' required but not provided this time') + end if + end if end if end do diff --git a/lilac/src/ctsm_LilacCouplingFields.F90 b/lilac/src/ctsm_LilacCouplingFields.F90 index 7587522b4f..29e1f7ae57 100644 --- a/lilac/src/ctsm_LilacCouplingFields.F90 +++ b/lilac/src/ctsm_LilacCouplingFields.F90 @@ -107,70 +107,70 @@ subroutine create_a2l_field_list() call a2l_fields%init() call a2l_fields%add_var(fieldname='Sa_landfrac' , units='fraction', available_from_data=.false., & - field_index=lilac_a2l_Sa_landfrac) + can_be_time_const=.true., field_index=lilac_a2l_Sa_landfrac) call a2l_fields%add_var(fieldname='Sa_z' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Sa_z) + can_be_time_const=.true., field_index=lilac_a2l_Sa_z) call a2l_fields%add_var(fieldname='Sa_topo' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Sa_topo) + can_be_time_const=.true., field_index=lilac_a2l_Sa_topo) call a2l_fields%add_var(fieldname='Sa_u' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Sa_u) + can_be_time_const=.false., field_index=lilac_a2l_Sa_u) call a2l_fields%add_var(fieldname='Sa_v' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Sa_v) + can_be_time_const=.false., field_index=lilac_a2l_Sa_v) call a2l_fields%add_var(fieldname='Sa_ptem' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Sa_ptem) + can_be_time_const=.false., field_index=lilac_a2l_Sa_ptem) call a2l_fields%add_var(fieldname='Sa_pbot' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Sa_pbot) + can_be_time_const=.false., field_index=lilac_a2l_Sa_pbot) call a2l_fields%add_var(fieldname='Sa_tbot' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Sa_tbot) + can_be_time_const=.false., field_index=lilac_a2l_Sa_tbot) call a2l_fields%add_var(fieldname='Sa_shum' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Sa_shum) + can_be_time_const=.false., field_index=lilac_a2l_Sa_shum) call a2l_fields%add_var(fieldname='Faxa_lwdn' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Faxa_lwdn) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_lwdn) call a2l_fields%add_var(fieldname='Faxa_rainc' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Faxa_rainc) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_rainc) call a2l_fields%add_var(fieldname='Faxa_rainl' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Faxa_rainl) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_rainl) call a2l_fields%add_var(fieldname='Faxa_snowc' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Faxa_snowc) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_snowc) call a2l_fields%add_var(fieldname='Faxa_snowl' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Faxa_snowl) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_snowl) call a2l_fields%add_var(fieldname='Faxa_swndr' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Faxa_swndr) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_swndr) call a2l_fields%add_var(fieldname='Faxa_swvdr' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Faxa_swvdr) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_swvdr) call a2l_fields%add_var(fieldname='Faxa_swndf' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Faxa_swndf) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_swndf) call a2l_fields%add_var(fieldname='Faxa_swvdf' , units='unknown', available_from_data=.false., & - field_index=lilac_a2l_Faxa_swvdf) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_swvdf) call a2l_fields%add_var(fieldname='Faxa_bcphidry' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_bcphidry) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_bcphidry) call a2l_fields%add_var(fieldname='Faxa_bcphodry' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_bcphodry) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_bcphodry) call a2l_fields%add_var(fieldname='Faxa_bcphiwet' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_bcphiwet) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_bcphiwet) call a2l_fields%add_var(fieldname='Faxa_ocphidry' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_ocphidry) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_ocphidry) call a2l_fields%add_var(fieldname='Faxa_ocphodry' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_ocphodry) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_ocphodry) call a2l_fields%add_var(fieldname='Faxa_ocphiwet' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_ocphiwet) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_ocphiwet) call a2l_fields%add_var(fieldname='Faxa_dstwet1' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_dstwet1) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstwet1) call a2l_fields%add_var(fieldname='Faxa_dstdry1' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_dstdry1) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstdry1) call a2l_fields%add_var(fieldname='Faxa_dstwet2' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_dstwet2) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstwet2) call a2l_fields%add_var(fieldname='Faxa_dstdry2' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_dstdry2) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstdry2) call a2l_fields%add_var(fieldname='Faxa_dstwet3' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_dstwet3) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstwet3) call a2l_fields%add_var(fieldname='Faxa_dstdry3' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_dstdry3) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstdry3) call a2l_fields%add_var(fieldname='Faxa_dstwet4' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_dstwet4) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstwet4) call a2l_fields%add_var(fieldname='Faxa_dstdry4' , units='unknown', available_from_data=.true., & - field_index=lilac_a2l_Faxa_dstdry4) + can_be_time_const=.false., field_index=lilac_a2l_Faxa_dstdry4) end subroutine create_a2l_field_list From 8b8bf980296055475b0428a76ecd3c15730c0108 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 9 Mar 2020 11:51:47 -0600 Subject: [PATCH 301/556] In demo atm driver, calculate space_perturbation separately This will be needed for an upcoming change. This changes answers, but just at the roundoff-level for the atm -> lnd fields (but these roundoff-level changes can grow). --- lilac/atm_driver/atm_driver.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 578fc1d32b..10566cdf6f 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -388,6 +388,7 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) integer :: lsize real*8 :: time_midpoint real*8 :: time_perturbation + real*8, allocatable :: space_perturbation(:) real*8, allocatable :: space_time_perturbation(:) real*8, allocatable :: data(:) integer :: i @@ -395,13 +396,15 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) ! -------------------------------------------------------- lsize = size(lon) + allocate(space_perturbation(lsize)) allocate(space_time_perturbation(lsize)) allocate(data(lsize)) ! The time perturbation will range from about -0.5 to 0.5 time_midpoint = atm_nsteps / 2.d0 time_perturbation = 0.5d0 * (nstep - time_midpoint)/time_midpoint - space_time_perturbation(:) = time_perturbation + lat(:)*0.01d0 + lon(:)*0.01d0 + space_perturbation(:) = lat(:)*0.01d0 + lon(:)*0.01d0 + space_time_perturbation(:) = time_perturbation + space_perturbation(:) ! Only set landfrac in the first time step, similar to what most real atmospheres ! will probably do. From 0f22288e40a025b52126bad433349c3c61315f6f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 9 Mar 2020 12:00:42 -0600 Subject: [PATCH 302/556] Use a time-constant topo field This changes answers, and is a preparatory answer-changing commit for an upcoming commit where I want to exercise the infrastructure that allows fields to just be set in the first time step (which hopefully will be bfb with this commit). --- lilac/atm_driver/atm_driver.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 10566cdf6f..9d9df4c139 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -428,7 +428,10 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) data(:) = 30.0d0 + space_time_perturbation(:) call lilac_atm2lnd(lilac_a2l_Sa_z, data) - data(:) = 10.0d0 + space_time_perturbation(:) + ! Use a time-constant topo field (which may be typical of atmospheres), in order to + ! test the infrastructure that allows fields to be just set once, in the first time + ! step. + data(:) = 10.0d0 + space_perturbation(:) call lilac_atm2lnd(lilac_a2l_Sa_topo, data) data(:) = 20.0d0 + space_time_perturbation(:) From c4ef195834c8b1e4d87b5bb8c62c64dd1cf78251 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 9 Mar 2020 12:13:05 -0600 Subject: [PATCH 303/556] Only set Sa_topo in the first time step This is so that we test the infrastructure that allows fields to be just set once. (To some extent that was already tested via Sa_landfrac, but this is a field that is actually accessed each time step inside CTSM, so this provides a better test that we're actually sending the correct field across each time step.) This is bit-for-bit with the last commit, as desired. --- lilac/atm_driver/atm_driver.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 9d9df4c139..e466caed34 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -425,14 +425,19 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) ! mis-matches (e.g., if foo and bar were accidentally swapped in CTSM, we couldn't ! catch that if they both had the same value). + ! Sa_z is allowed to be time-constant, but we're keeping it time-varying here in + ! order to test the ability to have an allowed-to-be-time-constant field actually be + ! time-varying. data(:) = 30.0d0 + space_time_perturbation(:) call lilac_atm2lnd(lilac_a2l_Sa_z, data) ! Use a time-constant topo field (which may be typical of atmospheres), in order to ! test the infrastructure that allows fields to be just set once, in the first time ! step. - data(:) = 10.0d0 + space_perturbation(:) - call lilac_atm2lnd(lilac_a2l_Sa_topo, data) + if (nstep == 1) then + data(:) = 10.0d0 + space_perturbation(:) + call lilac_atm2lnd(lilac_a2l_Sa_topo, data) + end if data(:) = 20.0d0 + space_time_perturbation(:) call lilac_atm2lnd(lilac_a2l_Sa_u, data) From e0fe64b673d484a77afc8704a49347ec62823b0e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 9 Mar 2020 14:00:36 -0600 Subject: [PATCH 304/556] Define _FillValue attribute on atm driver output file This is bit-for-bit with the previous commit. This is in preparation for some more upcoming changes. --- lilac/atm_driver/atm_driver.F90 | 5 ++++- lilac/src/lilac_constants.F90 | 4 ++-- lilac/src/lilac_io.F90 | 2 +- lilac/src/lilac_methods.F90 | 1 - 4 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index e466caed34..611991de0b 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -18,9 +18,10 @@ program atm_driver use netcdf , only : nf90_open, nf90_create, nf90_enddef, nf90_close use netcdf , only : nf90_clobber, nf90_write, nf90_nowrite, nf90_noerr, nf90_double - use netcdf , only : nf90_def_dim, nf90_def_var, nf90_put_var + use netcdf , only : nf90_def_dim, nf90_def_var, nf90_put_att, nf90_put_var use netcdf , only : nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_varid, nf90_get_var use lilac_mod , only : lilac_init1, lilac_init2, lilac_run, lilac_final + use lilac_constants , only : fillvalue => lilac_constants_fillvalue use ctsm_LilacCouplingFieldIndices use ctsm_LilacCouplingFields, only : lilac_atm2lnd, lilac_lnd2atm ! A real atmosphere should not use l2a_fields directly. We use it here just for @@ -555,6 +556,8 @@ subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, & field_name = l2a_fields%get_fieldname(i) ierr = nf90_def_var(ncid, field_name, nf90_double, [dimid_x, dimid_y], varids(i)) if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_def_var atm driver output file: '//trim(field_name)) + ierr = nf90_put_att(ncid, varids(i), '_FillValue', fillvalue) + if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_put_att atm driver output file: '//trim(field_name)) end do ierr = nf90_enddef(ncid) diff --git a/lilac/src/lilac_constants.F90 b/lilac/src/lilac_constants.F90 index 847fe2cc1d..77edbfbe92 100644 --- a/lilac/src/lilac_constants.F90 +++ b/lilac/src/lilac_constants.F90 @@ -1,13 +1,13 @@ module lilac_constants use shr_kind_mod, only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use shr_const_mod, only : SHR_CONST_SPVAL implicit none public logical, parameter :: lilac_constants_statewrite_flag = .false. - real(R8), parameter :: lilac_constants_spval_init = 0.0_R8 ! spval for initialization - real(R8), parameter :: lilac_constants_spval = 0.0_R8 ! spval + real(R8), parameter :: lilac_constants_fillvalue = SHR_CONST_SPVAL real(R8), parameter :: lilac_constants_czero = 0.0_R8 ! spval integer, parameter :: lilac_constants_ispval_mask = -987987 ! spval for RH mask values integer, parameter :: lilac_constants_SecPerDay = 86400 ! Seconds per day diff --git a/lilac/src/lilac_io.F90 b/lilac/src/lilac_io.F90 index 276fc23cc6..f4eec5d485 100644 --- a/lilac/src/lilac_io.F90 +++ b/lilac/src/lilac_io.F90 @@ -7,10 +7,10 @@ module lilac_io use ESMF use shr_kind_mod , only : cx=>shr_kind_cx, cs=>shr_kind_cs, cl=>shr_kind_cl use shr_kind_mod , only : r4=>shr_kind_r4, i8=>shr_kind_i8, r8=>shr_kind_r8 - use shr_const_mod , only : fillvalue => SHR_CONST_SPVAL use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat use shr_sys_mod , only : shr_sys_abort use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag + use lilac_constants , only : fillvalue => lilac_constants_fillvalue use lilac_constants , only : logunit use lilac_methods , only : FB_getFieldN => lilac_methods_FB_getFieldN use lilac_methods , only : FB_getFldPtr => lilac_methods_FB_getFldPtr diff --git a/lilac/src/lilac_methods.F90 b/lilac/src/lilac_methods.F90 index cdfff14c8b..eb2aa38dab 100644 --- a/lilac/src/lilac_methods.F90 +++ b/lilac/src/lilac_methods.F90 @@ -9,7 +9,6 @@ module lilac_methods use shr_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use lilac_constants , only : dbug_flag => lilac_constants_dbug_flag use lilac_constants , only : czero => lilac_constants_czero - use lilac_constants , only : spval_init => lilac_constants_spval_init implicit none private From fb435bca3c584b75c7124e2eb68ec0cf1ac20fa0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 9 Mar 2020 14:31:36 -0600 Subject: [PATCH 305/556] Initialize export fields to fillvalue, not 0, over ocean points I have tested this with the demo atm driver, and found: - cprnc output indicates differences only in fillvalue, not in any actual field values, both for lilac file and demo atm output file - Looked at a field with 'minus' (evap) and without minus (swnet); both look identical between the two, other than the fill value (both on lilac hist file and demo atm hist file) - snowh (which was referenced in the deleted comment) also looks reasonable (both on lilac hist file and demo atm hist file) (note: I think this reference may have been a carry-over from the original nuopc cap implementation) - Also: tried keeping the initialization at 0 rather than fillvalue (reverted two lines); this was bfb with the previous commit, as expected, verifying that the rework of the 'minus' handling here doesn't change answers --- src/cpl/lilac/lnd_import_export.F90 | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index d47069b63a..313d0ce635 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -710,29 +710,27 @@ subroutine state_setexport(state, fb, fldname, bounds, input, minus, ungridded_i if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! TODO: if fillvalue = shr_const_spval the snowhl sent to the atm will have the spval over some points - ! rather than 0 - this is very odd and needs to be understood - ! fldptr(:) = fillvalue - ! determine output array if (present(ungridded_index)) then - fldptr2d(ungridded_index,:) = 0._r8 + fldptr2d(ungridded_index,:) = fillvalue do g = bounds%begg, bounds%endg n = g - bounds%begg + 1 - fldptr2d(ungridded_index,n) = input(g) + if (l_minus) then + fldptr2d(ungridded_index,n) = -input(g) + else + fldptr2d(ungridded_index,n) = input(g) + end if end do - if (l_minus) then - fldptr2d(ungridded_index,:) = -fldptr2d(ungridded_index,:) - end if else - fldptr1d(:) = 0._r8 + fldptr1d(:) = fillvalue do g = bounds%begg, bounds%endg n = g - bounds%begg + 1 - fldptr1d(n) = input(g) + if (l_minus) then + fldptr1d(n) = -input(g) + else + fldptr1d(n) = input(g) + end if end do - if (l_minus) then - fldptr1d(:) = -fldptr1d(:) - end if end if ! write debug output if appropriate From 041db069629ecc49450531467c8bec4c99cf88ab Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 9 Mar 2020 16:32:44 -0600 Subject: [PATCH 306/556] Remove dtime from namelist: always use dtime from driver For LILAC, @mvertens had put in place some code that would ignore dtime from the namelist, instead using LILAC's specified dtime. She pointed out that we should really be doing this for all drivers: Apparently CLM used to support sub-cycling (running multiple land model time steps per coupling interval), but this hasn't been supported for quite a while. Thus, this commit removes dtime from the namelist and, regardless of the coupling cap we are using, we always get CTSM's internal dtime from the driver / coupler. --- bld/CLMBuildNamelist.pm | 26 ------------ bld/namelist_files/namelist_defaults_ctsm.xml | 3 -- .../namelist_definition_ctsm.xml | 5 --- bld/unit_testers/build-namelist_test.pl | 26 ++---------- cime_config/buildnml | 5 +-- .../testmods_dirs/clm/fire_emis/user_nl_clm | 1 - cime_config/user_nl_clm | 1 - .../_includes/output_base/user_nl_clm | 1 - lilac_config/buildnml | 1 - src/cpl/lilac/lnd_comp_esmf.F90 | 25 ++++++----- src/cpl/mct/lnd_comp_mct.F90 | 41 ++++++++++--------- src/cpl/nuopc/lnd_comp_nuopc.F90 | 35 ++++++---------- src/main/clm_initializeMod.F90 | 7 ++-- src/main/controlMod.F90 | 22 +--------- 14 files changed, 58 insertions(+), 141 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 0ccf7ffb0d..06fefdd86f 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -189,7 +189,6 @@ OPTIONS form \$CASEDIR/user_nl_clm/user_nl_clm_????) -inputdata "filepath" Writes out a list containing pathnames for required input datasets in file specified. - -l_ncpl "LND_NCPL" Number of CLM coupling time-steps in a day. -lnd_tuning_mode "value" Use the parameters tuned for the given configuration (CLM version and atmospheric forcing) -mask "landmask" Type of land-mask (default, navy, gx3v5, gx1v5 etc.) "-mask list" to list valid land masks. @@ -254,7 +253,6 @@ sub process_commandline { help => 0, glc_nec => "default", light_res => "default", - l_ncpl => undef, lnd_tuning_mode => "default", lnd_frac => undef, dir => "$cwd", @@ -306,7 +304,6 @@ sub process_commandline { "infile=s" => \$opts{'infile'}, "lnd_frac=s" => \$opts{'lnd_frac'}, "lnd_tuning_mode=s" => \$opts{'lnd_tuning_mode'}, - "l_ncpl=i" => \$opts{'l_ncpl'}, "inputdata=s" => \$opts{'inputdata'}, "mask=s" => \$opts{'mask'}, "namelist=s" => \$opts{'namelist'}, @@ -1491,7 +1488,6 @@ sub process_namelist_inline_logic { setup_logic_co2_type($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_irrigate($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_start_type($opts, $nl_flags, $nl); - setup_logic_delta_time($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_decomp_performance($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_snow($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_glacier($opts, $nl_flags, $definition, $defaults, $nl, $envxml_ref); @@ -1851,28 +1847,6 @@ sub setup_logic_start_type { #------------------------------------------------------------------------------- -sub setup_logic_delta_time { - my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; - - if ( defined($opts->{'l_ncpl'}) ) { - my $l_ncpl = $opts->{'l_ncpl'}; - if ( $l_ncpl <= 0 ) { - $log->fatal_error("bad value for -l_ncpl option."); - } - my $val = ( 3600 * 24 ) / $l_ncpl; - my $dtime = $nl->get_value('dtime'); - if ( ! defined($dtime) ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'dtime', 'val'=>$val); - } elsif ( $dtime ne $val ) { - $log->fatal_error("can NOT set both -l_ncpl option (via LND_NCPL env variable) AND dtime namelist variable."); - } - } else { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'dtime', 'hgrid'=>$nl_flags->{'res'}); - } -} - -#------------------------------------------------------------------------------- - sub setup_logic_decomp_performance { my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index a32c807f16..bb7db629b2 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -19,9 +19,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 2000 - -1800 - 379.0 379.0 diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 83502c5f32..72b30571c1 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -619,11 +619,6 @@ The maximum value to use for zeta under stable conditions baseline proportion of nitrogen allocated for electron transport (J) - -Time step (seconds) - - Toggle to turn on the FATES model diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 77ea34f13c..cd8fb5edd3 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -287,15 +287,15 @@ sub make_config_cache { &make_config_cache($phys); print "\n===============================================================================\n"; -print "Test configuration, structure, irrigate, verbose, clm_demand, rcp, test, sim_year, use_case, l_ncpl\n"; +print "Test configuration, structure, irrigate, verbose, clm_demand, rcp, test, sim_year, use_case\n"; print "=================================================================================\n"; -# configuration, structure, irrigate, verbose, clm_demand, rcp, test, sim_year, use_case, l_ncpl +# configuration, structure, irrigate, verbose, clm_demand, rcp, test, sim_year, use_case my $startfile = "clmrun.clm2.r.1964-05-27-00000.nc"; foreach my $options ( "-configuration nwp", "-structure fast", "-namelist '&a irrigate=.true./'", "-verbose", "-rcp 2.6", "-test", "-sim_year 1850", - "-use_case 1850_control", "-l_ncpl 1", + "-use_case 1850_control", "-clm_start_type startup", "-namelist '&a irrigate=.false./' -crop -bgc bgc", "-envxml_dir . -infile myuser_nl_clm", "-ignore_ic_date -clm_start_type branch -namelist '&a nrevsn=\"thing.nc\"/' -bgc bgc -crop", @@ -308,10 +308,7 @@ sub make_config_cache { $cfiles->checkfilesexist( "$options", $mode ); $cfiles->shownmldiff( "default", $mode ); my $finidat = `grep finidat lnd_in`; - if ( $options eq "-l_ncpl 1" ) { - my $dtime = `grep dtime lnd_in`; - like( $dtime, "/ 86400\$/", "$options" ); - } elsif ( $options =~ /myuser_nl_clm/ ) { + if ( $options =~ /myuser_nl_clm/ ) { my $fsurdat = `grep fsurdat lnd_in`; like( $fsurdat, "/MYDINLOCROOT/lnd/clm2/PTCLMmydatafiles/1x1pt_US-UMB/surfdata_1x1pt_US-UMB_simyr2000_clm4_5_c131122.nc/", "$options" ); } @@ -388,21 +385,6 @@ sub make_config_cache { GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, - "l_ncpl is zero" =>{ options=>"-l_ncpl 0 -envxml_dir .", - namelst=>"", - GLC_TWO_WAY_COUPLING=>"FALSE", - phys=>"clm5_0", - }, - "l_ncpl not integer" =>{ options=>"-l_ncpl 1.0 -envxml_dir .", - namelst=>"", - GLC_TWO_WAY_COUPLING=>"FALSE", - phys=>"clm5_0", - }, - "both l_ncpl and dtime" =>{ options=>"-l_ncpl 24 -envxml_dir .", - namelst=>"dtime=1800", - GLC_TWO_WAY_COUPLING=>"FALSE", - phys=>"clm5_0", - }, "use_crop without -crop" =>{ options=>" -envxml_dir .", namelst=>"use_crop=.true.", GLC_TWO_WAY_COUPLING=>"FALSE", diff --git a/cime_config/buildnml b/cime_config/buildnml index 9940de97a3..a33fadb864 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -50,7 +50,6 @@ def buildnml(case, caseroot, compname): clm_accelerated_spinup = case.get_value("CLM_ACCELERATED_SPINUP") comp_atm = case.get_value("COMP_ATM") lnd_grid = case.get_value("LND_GRID") - lnd_ncpl = case.get_value("LND_NCPL") lnd_domain_path = case.get_value("LND_DOMAIN_PATH") lnd_domain_file = case.get_value("LND_DOMAIN_FILE") ninst_lnd = case.get_value("NINST_LND") @@ -209,12 +208,12 @@ def buildnml(case, caseroot, compname): cmd = os.path.join(lnd_root,"bld","build-namelist") command = ("%s -cimeroot %s -infile %s -csmdata %s -inputdata %s %s -namelist \"&clm_inparm start_ymd=%s %s/ \" " - "%s %s -res %s %s -clm_start_type %s -envxml_dir %s -l_ncpl %s " + "%s %s -res %s %s -clm_start_type %s -envxml_dir %s " "-configuration %s -structure %s " "-lnd_frac %s -glc_nec %s -co2_ppmv %s -co2_type %s -config %s " "%s %s %s %s" %(cmd, _CIMEROOT, infile, din_loc_root, inputdata_file, ignore, start_ymd, clm_namelist_opts, - nomeg, usecase, lnd_grid, clmusr, start_type, caseroot, lnd_ncpl, + nomeg, usecase, lnd_grid, clmusr, start_type, caseroot, configuration, structure, lndfrac_file, glc_nec, ccsm_co2_ppmv, clm_co2_type, config_cache_file, clm_bldnml_opts, spinup, tuning, gridmask)) diff --git a/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm index 3f5749e61f..410035f89c 100644 --- a/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm @@ -7,7 +7,6 @@ ! ! EXCEPTIONS: ! Set co2_ppmv with CCSM_CO2_PPMV option -! Set dtime with L_NCPL option ! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options ! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases ! (includes $inst_string for multi-ensemble cases) diff --git a/cime_config/user_nl_clm b/cime_config/user_nl_clm index cfc5c71308..a333f1a603 100644 --- a/cime_config/user_nl_clm +++ b/cime_config/user_nl_clm @@ -9,7 +9,6 @@ ! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting ! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting ! Set co2_ppmv with CCSM_CO2_PPMV option -! Set dtime with L_NCPL option ! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options ! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases ! (includes $inst_string for multi-ensemble cases) diff --git a/cime_config/usermods_dirs/_includes/output_base/user_nl_clm b/cime_config/usermods_dirs/_includes/output_base/user_nl_clm index d46ce25859..b307b644aa 100644 --- a/cime_config/usermods_dirs/_includes/output_base/user_nl_clm +++ b/cime_config/usermods_dirs/_includes/output_base/user_nl_clm @@ -9,7 +9,6 @@ ! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting ! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting ! Set co2_ppmv with CCSM_CO2_PPMV option -! Set dtime with L_NCPL option ! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options ! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases ! (includes $inst_string for multi-ensemble cases) diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 6ce420d417..edb72709fc 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -138,7 +138,6 @@ def buildnml(rundir, bldnmldir): '-ignore_ic_year', # For now, we assume ignore_ic_year, not ignore_ic_date '-res', lnd_grid, '-clm_start_type', start_type, - '-l_ncpl', str(1), # this will not be used in lilac - but is needed as input '-configuration', configuration, '-structure', structure, '-lnd_frac', os.path.join(lnd_domain_path, lnd_domain_file), diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index f0591be358..ba5f73c2b7 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -304,13 +304,22 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) end if + call ESMF_TimeIntervalGet(timeStep, s=dtime_lilac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (masterproc) then + write(iulog,*)'dtime = ',dtime_lilac + end if + ! The following sets the module variables in clm_time_mamanger.F90 - BUT DOES NOT intialize the ! clock. Routine timemgr_init (called by initialize1) initializes the clock using the module variables ! that have been set via calls to set_timemgr_init. + ! Note that we assume that CTSM's internal dtime matches the coupling time step. + ! i.e., we currently do NOT allow sub-cycling within a coupling time step. call set_timemgr_init( & calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & - ref_ymd_in=ref_ymd, ref_tod_in=ref_tod) + ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, dtime_in=dtime_lilac) !---------------------- ! Read namelist, grid and surface data @@ -330,19 +339,9 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Call initialize1 !---------------------- - call ESMF_TimeIntervalGet(timeStep, s=dtime_lilac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (masterproc) then - write(iulog,*)'dtime_lilac= ',dtime_lilac - end if - - ! Note that routine controlMod.F90 will initialze the dtime module - ! variable in clm_time_manager to the dtime_lilac AND NOT the - ! dtime read in from the clm_inparm namelist in this case. Note - ! that the memory for gindex_ocn will be allocated in the following call + ! Note that the memory for gindex_ocn will be allocated in the following call - call initialize1(gindex_ocn=gindex_ocn, dtime_driver=dtime_lilac) + call initialize1(dtime=dtime_lilac, gindex_ocn=gindex_ocn) call ESMF_LogWrite(subname//"ctsm time manager initialized....", ESMF_LOGMSG_INFO) call ESMF_LogWrite(subname//"ctsm initialize1 done...", ESMF_LOGMSG_INFO) diff --git a/src/cpl/mct/lnd_comp_mct.F90 b/src/cpl/mct/lnd_comp_mct.F90 index eeacdcd89a..b5b46ca97e 100644 --- a/src/cpl/mct/lnd_comp_mct.F90 +++ b/src/cpl/mct/lnd_comp_mct.F90 @@ -42,7 +42,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) ! !USES: use shr_kind_mod , only : shr_kind_cl use abortutils , only : endrun - use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, set_nextsw_cday + use clm_time_manager , only : get_nstep, set_timemgr_init, set_nextsw_cday use clm_initializeMod, only : initialize1, initialize2 use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog, noland @@ -82,7 +82,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) integer :: lsize ! size of attribute vector integer :: g,i,j ! indices integer :: dtime_sync ! coupling time-step from the input synchronization clock - integer :: dtime_clm ! clm time-step logical :: exists ! true if file exists logical :: atm_aero ! Flag if aerosol data sent from atm model real(r8) :: scmlat ! single-column latitude @@ -166,15 +165,24 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) start_ymd=start_ymd, & start_tod=start_tod, ref_ymd=ref_ymd, & ref_tod=ref_tod, & - calendar=calendar ) + calendar=calendar, & + dtime=dtime_sync) + if (masterproc) then + write(iulog,*)'dtime = ',dtime_sync + end if + call seq_infodata_GetData(infodata, case_name=caseid, & case_desc=ctitle, single_column=single_column, & scmlat=scmlat, scmlon=scmlon, & brnch_retain_casename=brnch_retain_casename, & start_type=starttype, model_version=version, & hostname=hostname, username=username ) + + ! Note that we assume that CTSM's internal dtime matches the coupling time step. + ! i.e., we currently do NOT allow sub-cycling within a coupling time step. call set_timemgr_init( calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & - ref_ymd_in=ref_ymd, ref_tod_in=ref_tod) + ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, dtime_in=dtime_sync) + if ( trim(starttype) == trim(seq_infodata_start_type_start)) then nsrest = nsrStartup else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then @@ -193,7 +201,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) ! Read namelist, grid and surface data - call initialize1( ) + call initialize1(dtime=dtime_sync) ! If no land then exit out of initialization @@ -229,20 +237,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call initialize2() - ! Check that clm internal dtime aligns with clm coupling interval - - call seq_timemgr_EClockGetData(EClock, dtime=dtime_sync ) - dtime_clm = get_step_size() - if (masterproc) then - write(iulog,*)'dtime_sync= ',dtime_sync,& - ' dtime_clm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) - end if - if (mod(dtime_sync,dtime_clm) /= 0) then - write(iulog,*)'clm dtime ',dtime_clm,' and Eclock dtime ',& - dtime_sync,' never align' - call endrun( sub//' ERROR: time out of sync' ) - end if - ! Create land export state call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) @@ -416,6 +410,15 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) ! Determine if dosend ! When time is not updated at the beginning of the loop - then return only if ! are in sync with clock before time is updated + ! + ! NOTE(wjs, 2020-03-09) I think the do while (.not. dosend) loop only is important + ! for the first time step (when we run 2 steps). After that, we now assume that we + ! run one time step per coupling interval (based on setting the model's dtime from + ! the driver). (According to Mariana Vertenstein, sub-cycling (running multiple + ! land model time steps per coupling interval) used to be supported, but hasn't + ! been fully supported for a long time.) We may want to rework this logic to make + ! this more explicit, or - ideally - get rid of this extra time step at the start + ! of the run, at which point I think we could do away with this looping entirely. call get_curr_date( yr, mon, day, tod ) ymd = yr*10000 + mon*100 + day diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 4ee197c746..b4e6029588 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -325,7 +325,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: curr_ymd ! Start date (YYYYMMDD) integer :: curr_tod ! Start time of day (sec) integer :: dtime_sync ! coupling time-step from the input synchronization clock - integer :: dtime_clm ! ctsm time-step integer, pointer :: gindex(:) ! global index space for land and ocean points integer, pointer :: gindex_lnd(:) ! global index space for just land points integer, pointer :: gindex_ocn(:) ! global index space for just ocean points @@ -482,16 +481,26 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) end if + call ESMF_TimeIntervalGet( timeStep, s=dtime_sync, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (masterproc) then + write(iulog,*)'dtime = ', dtime_sync + end if + !---------------------- ! Initialize CTSM time manager !---------------------- + ! Note that we assume that CTSM's internal dtime matches the coupling time step. + ! i.e., we currently do NOT allow sub-cycling within a coupling time step. call set_timemgr_init( & calendar_in=calendar, & start_ymd_in=start_ymd, & start_tod_in=start_tod, & ref_ymd_in=ref_ymd, & - ref_tod_in=ref_tod) + ref_tod_in=ref_tod, & + dtime_in=dtime_sync) !---------------------- ! Read namelist, grid and surface data @@ -508,7 +517,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) username_in=username) ! note that the memory for gindex_ocn will be allocated in the following call - call initialize1(gindex_ocn) + call initialize1(dtime=dtime_sync, gindex_ocn=gindex_ocn) ! obtain global index array for just land points which includes mask=0 or ocean points call get_proc_bounds( bounds ) @@ -563,26 +572,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call initialize2() - !-------------------------------- - ! Check that ctsm internal dtime aligns with ctsm coupling interval - !-------------------------------- - - call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet( timeStep, s=dtime_sync, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - dtime_clm = get_step_size() - - if (masterproc) then - write(iulog,*)'dtime_sync= ',dtime_sync,' dtime_ctsm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) - end if - if (mod(dtime_sync,dtime_clm) /= 0) then - write(iulog,*)'ctsm dtime ',dtime_clm,' and clock dtime ',dtime_sync,' never align' - rc = ESMF_FAILURE - return - end if - !-------------------------------- ! Create land export state !-------------------------------- diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 32ff522a91..4064f3e756 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -39,7 +39,7 @@ module clm_initializeMod contains !----------------------------------------------------------------------- - subroutine initialize1(gindex_ocn, dtime_driver) + subroutine initialize1(dtime, gindex_ocn) ! ! !DESCRIPTION: ! CLM initialization first phase @@ -61,13 +61,14 @@ subroutine initialize1(gindex_ocn, dtime_driver) use UrbanParamsType , only: UrbanInput, IsSimpleBuildTemp ! ! !ARGUMENTS + integer, intent(in) :: dtime ! model time step (seconds) + ! COMPILER_BUG(wjs, 2020-02-20, intel18.0.3) Although gindex_ocn could be ! intent(out), intel18.0.3 generates a runtime segmentation fault in runs that don't ! have this argument present when this is declared intent(out). (It works fine on ! intel 19.0.2 when declared as intent(out).) See also ! https://github.com/ESCOMP/CTSM/issues/930. integer, pointer, optional, intent(inout) :: gindex_ocn(:) ! If present, this will hold the decomposition of ocean points (which is needed for the nuopc interface); note that this variable is allocated here, and is assumed to start unallocated - integer, intent(in), optional :: dtime_driver ! ! !LOCAL VARIABLES: integer :: ier ! error status @@ -99,7 +100,7 @@ subroutine initialize1(gindex_ocn, dtime_driver) call shr_sys_flush(iulog) endif - call control_init(dtime_driver) + call control_init(dtime) call ncd_pio_init() call surfrd_get_num_patches(fsurdat, actual_maxsoil_patches, actual_numcft) call clm_varpar_init(actual_maxsoil_patches, actual_numcft) diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 880d28005c..be3ece7026 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -110,13 +110,12 @@ end subroutine control_setNL !------------------------------------------------------------------------ - subroutine control_init(dtime_driver) + subroutine control_init(dtime) ! ! !DESCRIPTION: ! Initialize CLM run control information ! ! !USES: - use clm_time_manager , only : set_timemgr_init use CNMRespMod , only : CNMRespReadNML use LunaMod , only : LunaReadNML use CNNDynamicsMod , only : CNNDynamicsReadNML @@ -125,13 +124,12 @@ subroutine control_init(dtime_driver) use landunit_varcon , only : max_lunit ! ! ARGUMENTS - integer, intent(in), optional :: dtime_driver + integer, intent(in) :: dtime ! model time step (seconds) ! !LOCAL VARIABLES: integer :: i ! loop indices integer :: ierr ! error code integer :: unitn ! unit for namelist file - integer :: dtime ! Integer time-step logical :: use_init_interp ! Apply initInterp to the file given by finidat !------------------------------------------------------------------------ @@ -139,10 +137,6 @@ subroutine control_init(dtime_driver) ! Namelist Variables ! ---------------------------------------------------------------------- - ! Time step - namelist / clm_inparm/ & - dtime - ! CLM namelist settings namelist /clm_inparm / & @@ -342,18 +336,6 @@ subroutine control_init(dtime_driver) ! Process some namelist variables, and perform consistency checks ! ---------------------------------------------------------------------- - if (present(dtime_driver)) then - ! overwrite dtime with dtime_in - instead of what is being used in the namelist - if (masterproc) then - write(iulog,*) 'WARNING: using dtime from cap rather than what is being read in from namelist' - end if - dtime = dtime_driver - end if - - ! Now initialize the module variable dtime in clm_time_manger - this will be utilized to create the - ! internal clm clock - call set_timemgr_init( dtime_in=dtime ) - ! History and restart files (dependent on settings of dtime) do i = 1, max_tapes if (hist_nhtfrq(i) < 0) then From 205d0cd0c69384f5ecc68103601fdc9e35d17729 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 10 Mar 2020 08:25:29 -0600 Subject: [PATCH 307/556] Revert "Update cmeps version" This reverts commit 47b6cf127e4475d04aa15c6cd09566e734f33d10. This seemed to cause problems on cheyenne. I'm trying going back to the older cmeps version. --- Externals_cime.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_cime.cfg b/Externals_cime.cfg index 2ff29da9f9..cbede7df52 100644 --- a/Externals_cime.cfg +++ b/Externals_cime.cfg @@ -1,5 +1,5 @@ [cmeps] -hash = 36e352b2735a8e3478bde4129ff58214521c7409 +hash = 181ff1ed9dfb279e619e8a2173f43baf7bf1dce3 protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = src/drivers/nuopc/ From 821c6788fa3e74d461b5ca5656bc42cf7e17f27f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 10 Mar 2020 09:13:03 -0600 Subject: [PATCH 308/556] Point to a slightly more recent version of cmeps The old version results in an error with python3 during preview_namelists, whereas the latest version results in a runtime error on cheyenne. I'm trying this version that is slightly newer than the previous version and fixes the preview_namelists issue with python3. --- Externals_cime.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_cime.cfg b/Externals_cime.cfg index cbede7df52..b6611bd1d2 100644 --- a/Externals_cime.cfg +++ b/Externals_cime.cfg @@ -1,5 +1,5 @@ [cmeps] -hash = 181ff1ed9dfb279e619e8a2173f43baf7bf1dce3 +hash = 5ae44d0c16089bff4f65668138e05255af93428d protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = src/drivers/nuopc/ From 6704bc028e9b457c1fcbb7d3e8929c98ef85e2d9 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 10 Mar 2020 09:44:22 -0600 Subject: [PATCH 309/556] Update number of expected tests in build-namelist tester --- bld/unit_testers/build-namelist_test.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index cd8fb5edd3..35dab75497 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,9 +138,9 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 927; +my $ntests = 919; if ( defined($opts{'compare'}) ) { - $ntests += 588; + $ntests += 585; } plan( tests=>$ntests ); From 89704ce220f872716f99dbcfbe8e9b83d02689bc Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 2 Apr 2020 11:37:51 -0600 Subject: [PATCH 310/556] Fix bug #953 where day-time tleaf10 was used instead of night-time --- src/biogeophys/LunaMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index 35a38701ec..4947d1c130 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -332,7 +332,7 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & hourpd = dayl(g) / 3600._r8 tleafd10 = t_veg10_day(p) - tfrz tleafn10 = t_veg10_night(p) - tfrz - tleaf10 = (dayl(g)*tleafd10 +(86400._r8-dayl(g)) * tleafd10)/86400._r8 + tleaf10 = (dayl(g)*tleafd10 +(86400._r8-dayl(g)) * tleafn10)/86400._r8 tair10 = t10(p)- tfrz relh10 = min(1.0_r8, rh10_p(p)) rb10v = rb10_p(p) From 19d0518503f4ed3fb358c58dd8cad8b234979405 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 2 Apr 2020 12:00:32 -0600 Subject: [PATCH 311/556] Changes from @lmbirch89 to fix #958 so that actual max daylength is used rather than assuming 12 hours, it also constains the effect between 0.01 and 1 --- src/biogeophys/LunaMod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index 4947d1c130..4b19e64cd4 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -402,7 +402,7 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & PNcbold = 0.0_r8 call NitrogenAllocation(FNCa,forc_pbot10(p), relh10, CO2a10, O2a10, PARi10, PARimx10, rb10v, hourpd, & tair10, tleafd10, tleafn10, & - Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp, PNlcold, PNetold, PNrespold, & + Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp, PNlcold, PNetold, PNrespold, dayl_factor(p), & PNcbold, PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) vcmx25_opt= PNcbopt * FNCa * Fc25 jmx25_opt= PNetopt * FNCa * Fj25 @@ -791,7 +791,7 @@ end subroutine Clear24_Climate_LUNA !Use the LUNA model to calculate the Nitrogen partioning subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PARimx10,rb10, hourpd, tair10, tleafd10, tleafn10, & Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp,& - PNlcold, PNetold, PNrespold, PNcbold, & + PNlcold, PNetold, PNrespold, PNcbold, dayl_factor & PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) implicit none real(r8), intent (in) :: FNCa !Area based functional nitrogen content (g N/m2 leaf) @@ -814,6 +814,7 @@ subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PAR real(r8), intent (in) :: PNetold !old value of the proportion of nitrogen allocated to electron transport (unitless) real(r8), intent (in) :: PNrespold !old value of the proportion of nitrogen allocated to respiration (unitless) real(r8), intent (in) :: PNcbold !old value of the proportion of nitrogen allocated to carboxylation (unitless) + real(r8), intent (in) :: dayl_factor !daylight scale factor real(r8), intent (out):: PNstoreopt !optimal proportion of nitrogen for storage real(r8), intent (out):: PNlcopt !optimal proportion of nitrogen for light capture real(r8), intent (out):: PNetopt !optimal proportion of nitrogen for electron transport @@ -897,7 +898,7 @@ subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PAR tleafd10c = min(max(tleafd10, Trange1), Trange2) !constrain the physiological range tleafn10c = min(max(tleafn10, Trange1), Trange2) !constrain the physiological range ci = 0.7_r8 * CO2a10 - JmaxCoef = Jmaxb1 * ((hourpd / 12.0_r8)**2.0_r8) * (1.0_r8 - exp(-relhExp * max(relh10 - minrelh, 0.0_r8) / & + JmaxCoef = Jmaxb1 * dayl_factor * (1.0_r8 - exp(-relhExp * max(relh10 - minrelh, 0.0_r8) / & (1.0_r8 - minrelh))) do while (PNlcoldi .NE. PNlc .and. jj < 100) Fc = VcmxTKattge(tair10, tleafd10c) * Fc25 From a415e30f2ae899be02c102964316837bca49327b Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 2 Apr 2020 12:15:27 -0600 Subject: [PATCH 312/556] Missing comma in argument list, allows it to compile --- src/biogeophys/LunaMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index 4b19e64cd4..2ca8406a87 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -791,7 +791,7 @@ end subroutine Clear24_Climate_LUNA !Use the LUNA model to calculate the Nitrogen partioning subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PARimx10,rb10, hourpd, tair10, tleafd10, tleafn10, & Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp,& - PNlcold, PNetold, PNrespold, PNcbold, dayl_factor & + PNlcold, PNetold, PNrespold, PNcbold, dayl_factor, & PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) implicit none real(r8), intent (in) :: FNCa !Area based functional nitrogen content (g N/m2 leaf) From 410bf09d9f962014978913f682f90db46582bde8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 7 Apr 2020 16:23:10 -0600 Subject: [PATCH 313/556] Fixes to atm_driver to allow dummy data to be bfb across restarts --- lilac/atm_driver/atm_driver.F90 | 51 +++++++++++++++++++++++---------- lilac/atm_driver/atm_driver_in | 1 + 2 files changed, 37 insertions(+), 15 deletions(-) diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 611991de0b..19112f7837 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -48,6 +48,8 @@ program atm_driver integer :: fileunit ! for namelist input integer :: nstep ! time step counter integer :: atm_nsteps ! number of time steps of the simulation + integer :: nsteps_prev_segs ! number of steps run in previous run segments + integer :: atm_nsteps_all_segs ! number of time steps of the simulation, across all run segments (see comment below about atm_ndays_all_segs) character(len=512) :: restart_file ! local path to lilac restart filename integer :: idfile, varid integer :: atm_restart_ymd @@ -70,11 +72,20 @@ program atm_driver integer :: atm_start_secs integer :: atm_stop_secs character(len=32) :: atm_starttype + ! atm_ndays_all_segs is used for generating the fake data. This should give the total + ! number of days that will be run across all restart segments. If this isn't exactly + ! right, it's not a big deal: it just means that the fake data won't be symmetrical in + ! time. It's just important that we have some rough measure of the run length for the + ! generation of temporal variability, and that this measure be independent of the + ! number of restart segments that the run is broken into (so that we can get the same + ! answers in a restart run as in a straight-through run). + integer :: atm_ndays_all_segs namelist /atm_driver_input/ caseid, atm_mesh_file, atm_global_nx, atm_global_ny, & atm_calendar, atm_timestep, & atm_start_year, atm_start_mon, atm_start_day, atm_start_secs, & - atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, atm_starttype + atm_stop_year, atm_stop_mon, atm_stop_day, atm_stop_secs, atm_starttype, & + atm_ndays_all_segs !------------------------------------------------------------------------ !----------------------------------------------------------------------------- @@ -220,6 +231,7 @@ program atm_driver else atm_nsteps = ((atm_stop_day - atm_start_day) * 86400.) / atm_timestep end if + nsteps_prev_segs = 0 else ! continue @@ -253,24 +265,32 @@ program atm_driver end if call shr_cal_date2ymd(atm_restart_ymd, atm_restart_year, atm_restart_mon, atm_restart_day) - if ( atm_stop_year /= atm_restart_year) then - write(6,*)'atm_stop_year = ',atm_stop_year,'atm_restart_year = ',atm_restart_year - call shr_sys_abort('not supporting restart and stop years to be different') - else if (atm_stop_mon /= atm_restart_mon) then - write(6,*)'atm_stop_mon = ',atm_stop_mon,'atm_restart_mon = ',atm_restart_mon - call shr_sys_abort('not supporting restart and stop months to be different') - else if (atm_stop_secs /= 0 .or. atm_restart_secs /= 0) then - write(6,*)'atm_stop_secs = ',atm_stop_secs,'atm_restart_secs = ',atm_restart_secs - call shr_sys_abort('not supporting restart and stop secs to be nonzero') + if ( atm_stop_year /= atm_restart_year .or. atm_restart_year /= atm_start_year) then + write(6,*)'atm_stop_year, atm_restart_year, atm_start_year = ',& + atm_stop_year, atm_restart_year, atm_start_year + call shr_sys_abort('not supporting restart, stop and start years to be different') + else if (atm_stop_mon /= atm_restart_mon .or. atm_restart_mon /= atm_start_mon) then + write(6,*)'atm_stop_mon, atm_restart_mon, atm_start_mon = ',& + atm_stop_mon, atm_restart_mon, atm_start_mon + call shr_sys_abort('not supporting restart, stop and start months to be different') + else if (atm_stop_secs /= 0 .or. atm_restart_secs /= 0 .or. atm_start_secs /= 0) then + write(6,*)'atm_stop_secs, atm_restart_secs, atm_start_secs = ',& + atm_stop_secs, atm_restart_secs, atm_start_secs + call shr_sys_abort('not supporting restart, stop or start secs to be nonzero') else atm_nsteps = ((atm_stop_day - atm_restart_day) * 86400.) / atm_timestep + ! The following calculation of nsteps_prev_segs is why we need to check the start + ! time in the above error checks. + nsteps_prev_segs = ((atm_restart_day - atm_start_day) * 86400.) / atm_timestep end if end if + atm_nsteps_all_segs = atm_ndays_all_segs * (86400 / atm_timestep) + do nstep = 1,atm_nsteps ! fill in the dataptr in lilac_coupling_fields - call atm_driver_to_lilac (atm_lons, atm_lats, nstep, atm_nsteps) + call atm_driver_to_lilac (atm_lons, atm_lats, nstep, nsteps_prev_segs, atm_nsteps_all_segs) if (nstep == atm_nsteps) then call lilac_run(write_restarts_now=.true., stop_now=.true.) @@ -377,13 +397,14 @@ subroutine nc_check_err(ierror, description, filename) end subroutine nc_check_err !======================================================================== - subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) + subroutine atm_driver_to_lilac (lon, lat, nstep, nsteps_prev_segs, atm_nsteps_all_segs) ! input/output variables real*8, intent(in) :: lon(:) real*8, intent(in) :: lat(:) integer, intent(in) :: nstep ! current step number - integer, intent(in) :: atm_nsteps ! total number of steps in simulation + integer, intent(in) :: nsteps_prev_segs ! number of time steps in previous run segments + integer, intent(in) :: atm_nsteps_all_segs ! total number of steps in simulation ! local variables integer :: lsize @@ -402,8 +423,8 @@ subroutine atm_driver_to_lilac (lon, lat, nstep, atm_nsteps) allocate(data(lsize)) ! The time perturbation will range from about -0.5 to 0.5 - time_midpoint = atm_nsteps / 2.d0 - time_perturbation = 0.5d0 * (nstep - time_midpoint)/time_midpoint + time_midpoint = atm_nsteps_all_segs / 2.d0 + time_perturbation = 0.5d0 * ((nstep + nsteps_prev_segs) - time_midpoint)/time_midpoint space_perturbation(:) = lat(:)*0.01d0 + lon(:)*0.01d0 space_time_perturbation(:) = time_perturbation + space_perturbation(:) diff --git a/lilac/atm_driver/atm_driver_in b/lilac/atm_driver/atm_driver_in index a9bda2e0d3..de8b9a6bd3 100644 --- a/lilac/atm_driver/atm_driver_in +++ b/lilac/atm_driver/atm_driver_in @@ -14,4 +14,5 @@ atm_start_day = 1 atm_stop_day = 3 atm_starttype = 'startup' + atm_ndays_all_segs = 2 / From 918169831f9f4ca4949984decf037be4b92be143 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 8 Apr 2020 15:37:12 -0600 Subject: [PATCH 314/556] Fix the list of arguments in the call that @olyson noticed --- src/biogeophys/LunaMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index 2ca8406a87..9087d1e14f 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -402,8 +402,8 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & PNcbold = 0.0_r8 call NitrogenAllocation(FNCa,forc_pbot10(p), relh10, CO2a10, O2a10, PARi10, PARimx10, rb10v, hourpd, & tair10, tleafd10, tleafn10, & - Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp, PNlcold, PNetold, PNrespold, dayl_factor(p), & - PNcbold, PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) + Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp, PNlcold, PNetold, PNrespold, PNcbold, dayl_factor(p), & + PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) vcmx25_opt= PNcbopt * FNCa * Fc25 jmx25_opt= PNetopt * FNCa * Fj25 From 11446f14d713bb23470da8697329cdb6848e7ea8 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 14 Apr 2020 14:31:20 -0600 Subject: [PATCH 315/556] Changes for the initialization bug in luna so that the last value from the previous year is normally used, unless it's a restart rather than hard-coded values addresses #981 --- src/biogeophys/LunaMod.F90 | 10 +++++++--- src/biogeophys/PhotosynthesisMod.F90 | 12 ++++++++++++ 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index 9087d1e14f..6bf6010db3 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -306,7 +306,9 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & vcmx25_z => photosyns_inst%vcmx25_z_patch , & ! Output: [real(r8) (:,:) ] patch leaf Vc,max25 (umol/m2 leaf/s) for canopy layer jmx25_z => photosyns_inst%jmx25_z_patch , & ! Output: [real(r8) (:,:) ] patch leaf Jmax25 (umol electron/m**2/s) for canopy layer pnlc_z => photosyns_inst%pnlc_z_patch , & ! Output: [real(r8) (:,:) ] patch proportion of leaf nitrogen allocated for light capture for canopy layer - enzs_z => photosyns_inst%enzs_z_patch & ! Output: [real(r8) (:,:) ] enzyme decay status 1.0-fully active; 0-all decayed during stress + enzs_z => photosyns_inst%enzs_z_patch , & ! Output: [real(r8) (:,:) ] enzyme decay status 1.0-fully active; 0-all decayed during stress + vcmx_prevyr => photosyns_inst%vcmx_prevyr , & ! Output: [real(r8) (:,:) ] patch leaf Vc,max25 from previous year avg + jmx_prevyr => photosyns_inst%jmx_prevyr & ! Output: [real(r8) (:,:) ] patch leaf Jmax25 from previous year avg ) !---------------------------------------------------------------------------------------------------------------------------------------------------------- !set timestep @@ -410,10 +412,12 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & chg = vcmx25_opt-vcmx25_z(p, z) chg_constrn = min(abs(chg),vcmx25_z(p, z)*max_daily_pchg) vcmx25_z(p, z) = vcmx25_z(p, z)+sign(1.0_r8,chg)*chg_constrn + vcmx_prevyr(p,z) = vcmx25_z(p,z) chg = jmx25_opt-jmx25_z(p, z) chg_constrn = min(abs(chg),jmx25_z(p, z)*max_daily_pchg) jmx25_z(p, z) = jmx25_z(p, z)+sign(1.0_r8,chg)*chg_constrn + jmx_prevyr(p,z) = jmx25_z(p,z) PNlc_z(p, z)= PNlcopt @@ -472,8 +476,8 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & endif !if not C3 plants else do z = 1 , nrad(p) - jmx25_z(p, z) = 85._r8 - vcmx25_z(p, z) = 50._r8 + jmx25_z(p, z) = jmx_prevyr(p,z) + vcmx25_z(p, z) = vcmx_prevyr(p,z) end do endif !checking for LAI and LNC endif !the first daycheck diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index a111cab156..a0710358fc 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -183,6 +183,8 @@ module PhotosynthesisMod ! LUNA specific variables real(r8), pointer, public :: vcmx25_z_patch (:,:) ! patch leaf Vc,max25 (umol CO2/m**2/s) for canopy layer real(r8), pointer, public :: jmx25_z_patch (:,:) ! patch leaf Jmax25 (umol electron/m**2/s) for canopy layer + real(r8), pointer, public :: vcmx_prevyr (:,:) ! patch leaf Vc,max25 previous year running avg + real(r8), pointer, public :: jmx_prevyr (:,:) ! patch leaf Jmax25 previous year running avg real(r8), pointer, public :: pnlc_z_patch (:,:) ! patch proportion of leaf nitrogen allocated for light capture for canopy layer real(r8), pointer, public :: enzs_z_patch (:,:) ! enzyme decay status 1.0-fully active; 0-all decayed during stress real(r8), pointer, public :: fpsn24_patch (:) ! 24 hour mean patch photosynthesis (umol CO2/m**2 ground/day) @@ -328,6 +330,8 @@ subroutine InitAllocate(this, bounds) ! statements. allocate(this%vcmx25_z_patch (begp:endp,1:nlevcan)) ; this%vcmx25_z_patch (:,:) = 30._r8 allocate(this%jmx25_z_patch (begp:endp,1:nlevcan)) ; this%jmx25_z_patch (:,:) = 60._r8 + allocate(this%vcmx_prevyr (begp:endp,1:nlevcan)) ; this%vcmx_prevyr (:,:) = 85._r8 + allocate(this%jmx_prevyr (begp:endp,1:nlevcan)) ; this%jmx_prevyr (:,:) = 50._r8 allocate(this%pnlc_z_patch (begp:endp,1:nlevcan)) ; this%pnlc_z_patch (:,:) = 0.01_r8 allocate(this%fpsn24_patch (begp:endp)) ; this%fpsn24_patch (:) = nan allocate(this%enzs_z_patch (begp:endp,1:nlevcan)) ; this%enzs_z_patch (:,:) = 1._r8 @@ -833,6 +837,14 @@ subroutine Restart(this, bounds, ncid, flag) dim1name='pft', dim2name='levcan', switchdim=.true., & long_name='Maximum carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_patch) + call restartvar(ncid=ncid, flag=flag, varname='vcmx_prevyr', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='avg carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & + interpinic_flag='interp', readvar=readvar, data=this%vcmx_prevyr) + call restartvar(ncid=ncid, flag=flag, varname='jmx_prevyr', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='avg carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & + interpinic_flag='interp', readvar=readvar, data=this%jmx_prevyr) call restartvar(ncid=ncid, flag=flag, varname='pnlc_z', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & long_name='proportion of leaf nitrogen allocated for light capture', units='unitless', & From ed69a150b30f37fe311cccde10f837cedae2df73 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 5 May 2020 13:36:30 -0600 Subject: [PATCH 316/556] Add initial version of config_machines_template.xml This was copied directly from cime master (ESMCI/cime@ebb9dd6c9). --- .../config_machines_template.xml | 163 ++++++++++++++++++ 1 file changed, 163 insertions(+) create mode 100644 lilac_config/build_templates/config_machines_template.xml diff --git a/lilac_config/build_templates/config_machines_template.xml b/lilac_config/build_templates/config_machines_template.xml new file mode 100644 index 0000000000..99c2bc7258 --- /dev/null +++ b/lilac_config/build_templates/config_machines_template.xml @@ -0,0 +1,163 @@ + + + + + + + + SITE VENDOR platform, os is ---, xx pes/node, batch system is --- + + + .*.cheyenne.ucar.edu + + + LINUX + + + https://howto.get.out + + + intel,gnu + + + mpt,openmpi,impi + + + couldbethis + + + couldbethis + + + + + + + + + /glade/scratch/$USER + + + $ENV{CESMDATAROOT}/inputdata + + + $ENV{CESMDATAROOT}/lmwg + + + $CIME_OUTPUT_ROOT/archive/$CASE + + + $ENV{CESMDATAROOT}/cesm_baselines + + + $ENV{CESMDATAROOT}/tools/cime/tools/cprnc/cprnc.cheyenne + + + gmake + + + 8 + + + none + + + cseg + + + 36 + + + 36 + + + TRUE + + + + + mpiexec_mpt + + + -p "%g:" + omplace + + + + + + + + /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/init/perl + /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/init/env_modules_python.py + /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/init/csh + /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/init/sh + /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/libexec/lmod perl + /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/libexec/lmod python + module + module + + + ncarenv/1.0 + + + intel/16.0.3 + mkl + + + gnu/6.3.0 + + + mpt/2.15 + ncarcompilers/0.3.5 + + + netcdf/4.4.1 + + + netcdf/4.4.1 + + pnetcdf/1.8.0 + + + + + 256M + 16 + + + + -1 + + + From 7db2458241e59c51bcd2a1def5f92b626efbcba4 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 6 May 2020 18:02:54 -0600 Subject: [PATCH 317/556] Turn config_machines_template.xml into a template Then we can transform it into an actual config_machines.xml file with python code like this: with open('/Users/sacks/ctsm/ctsm3/lilac_config/build_templates/config_machines_template.xml') as f: contents = f.read() config_machines_template = string.Template(contents) config_machines = config_machines_template.substitute(OS='Darwin', COMPILER='gnu', MPILIB='mpich', CIME_OUTPUT_ROOT='/path/to/build', GMAKE='gmake', GMAKE_J=4) with open('/Users/sacks/temporary/config_machines.xml', 'w') as f: f.write(config_machines) --- .../config_machines_template.xml | 176 ++++++------------ 1 file changed, 62 insertions(+), 114 deletions(-) diff --git a/lilac_config/build_templates/config_machines_template.xml b/lilac_config/build_templates/config_machines_template.xml index 99c2bc7258..d1b2ea5354 100644 --- a/lilac_config/build_templates/config_machines_template.xml +++ b/lilac_config/build_templates/config_machines_template.xml @@ -1,163 +1,111 @@ - - - - - - - SITE VENDOR platform, os is ---, xx pes/node, batch system is --- - - - .*.cheyenne.ucar.edu - - LINUX + - https://howto.get.out - + If you are looking at the template file: Variable names prefixed + with a dollar sign will be replaced with machine-specific values. A + double dollar sign gets replaced with a single dollar sign, so + something like $$MYVAR refers to the MYVAR cime variable. + --> - intel,gnu - - - mpt,openmpi,impi + + - - couldbethis + + Temporary build information for a CTSM build - - couldbethis + + $OS - - + + $COMPILER - - + + $MPILIB - /glade/scratch/$USER + $CIME_OUTPUT_ROOT - $ENV{CESMDATAROOT}/inputdata + long as the user has write access to this directory. --> + $$CIME_OUTPUT_ROOT/inputdata - $ENV{CESMDATAROOT}/lmwg + $$CIME_OUTPUT_ROOT/inputdata_clmforc - $CIME_OUTPUT_ROOT/archive/$CASE - - - $ENV{CESMDATAROOT}/cesm_baselines - - - $ENV{CESMDATAROOT}/tools/cime/tools/cprnc/cprnc.cheyenne + $$CIME_OUTPUT_ROOT/archive/$$CASE - gmake + $GMAKE - 8 + $GMAKE_J + supported values are: none, cobalt, lsf, pbs, slurm. + + This is irrelevant for this build-only port. + --> none - cseg + CTSM - - 36 + - 36 + This is irrelevant for this build-only port. + --> + 1 - - TRUE + + 1 + are values listed in MPILIBS above, default and mpi-serial. + + This is irrelevant for this build-only port. + --> - mpiexec_mpt + mpirun - -p "%g:" - omplace + -np $$TOTALPES + -prepend-rank - - - + - - /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/init/perl - /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/init/env_modules_python.py - /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/init/csh - /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/init/sh - /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/libexec/lmod perl - /glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/libexec/lmod python - module - module - - - ncarenv/1.0 - - - intel/16.0.3 - mkl - - - gnu/6.3.0 - - - mpt/2.15 - ncarcompilers/0.3.5 - - - netcdf/4.4.1 - - - netcdf/4.4.1 - - pnetcdf/1.8.0 - - - - - 256M - 16 - - - - -1 - + + From 41e859f969f35d9f134702ffa1d386907360dacd Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 11 May 2020 16:49:24 -0600 Subject: [PATCH 318/556] Add a template file for config_compilers.xml --- .../config_compilers_template.xml | 44 +++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 lilac_config/build_templates/config_compilers_template.xml diff --git a/lilac_config/build_templates/config_compilers_template.xml b/lilac_config/build_templates/config_compilers_template.xml new file mode 100644 index 0000000000..9fc3358408 --- /dev/null +++ b/lilac_config/build_templates/config_compilers_template.xml @@ -0,0 +1,44 @@ + + + + + + + + + + $GPTL_CPPDEFS + + + $NETCDF_PATH + + + $PIO_FILESYSTEM_HINTS + + + $PNETCDF_PATH + + $ESMF_LIBDIR + + + $EXTRA_CFLAGS + + + + $EXTRA_FFLAGS + + + + + From 328f38cd17a9a3f7193e1c1d0998e5704c41ad53 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 13 May 2020 13:00:16 -0600 Subject: [PATCH 319/556] No longer need 'from __future__ import print_function' --- run_sys_tests | 2 -- 1 file changed, 2 deletions(-) diff --git a/run_sys_tests b/run_sys_tests index 6963e99d8a..bccf6f00e1 100755 --- a/run_sys_tests +++ b/run_sys_tests @@ -1,8 +1,6 @@ #!/usr/bin/env python """Driver for running CTSM system tests""" -from __future__ import print_function - import os import sys From c134c4c6bbf9798c3754ab7206e164f2a4ae7e76 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 20 May 2020 11:37:03 -0600 Subject: [PATCH 320/556] Fix for #938, get CCW order for single point corners, and use NCL to calculate corners for other cases --- tools/mkmapgrids/mkscripgrid.ncl | 34 ++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 13 deletions(-) diff --git a/tools/mkmapgrids/mkscripgrid.ncl b/tools/mkmapgrids/mkscripgrid.ncl index 65b9306f2d..16f4018dac 100644 --- a/tools/mkmapgrids/mkscripgrid.ncl +++ b/tools/mkmapgrids/mkscripgrid.ncl @@ -119,21 +119,27 @@ end latCenters = fspan1up( (latS + delY/2.d0), (latN - delY/2.d0), ny) lon = new( (/ny, nx/), "double" ); lat = new( (/ny, nx/), "double" ); - lonCorners = new( (/ny, nx, 4/), "double" ); - latCorners = new( (/ny, nx, 4/), "double" ); + if ( (nx == 1) .or. (ny == 1) )then + lonCorners = new( (/ny, nx, 4/), "double" ); + latCorners = new( (/ny, nx, 4/), "double" ); + end if do i = 0, nx-1 lat(:,i) = latCenters; - latCorners(:,i,0) = latCenters - delY/2.d0; - latCorners(:,i,1) = latCenters + delY/2.d0; - latCorners(:,i,2) = latCenters + delY/2.d0; - latCorners(:,i,3) = latCenters - delY/2.d0; + if ( (nx == 1) .or. (ny == 1) )then + latCorners(:,i,0) = latCenters - delY/2.d0; + latCorners(:,i,1) = latCenters - delY/2.d0; + latCorners(:,i,2) = latCenters + delY/2.d0; + latCorners(:,i,3) = latCenters + delY/2.d0; + end if end do do j = 0, ny-1 lon(j,:) = lonCenters; - lonCorners(j,:,0) = lonCenters - delX/2.d0; - lonCorners(j,:,1) = lonCenters - delX/2.d0; - lonCorners(j,:,2) = lonCenters + delX/2.d0; - lonCorners(j,:,3) = lonCenters + delX/2.d0; + if ( (nx == 1) .or. (ny == 1) )then + lonCorners(j,:,0) = lonCenters - delX/2.d0; + lonCorners(j,:,1) = lonCenters + delX/2.d0; + lonCorners(j,:,2) = lonCenters + delX/2.d0; + lonCorners(j,:,3) = lonCenters - delX/2.d0; + end if end do ; for some reason, "No_FillValue" isn't working in the case where imask=1 @@ -147,8 +153,10 @@ end Opt = True Opt@Mask2D = Mask2D - Opt@GridCornerLat = latCorners - Opt@GridCornerLon = lonCorners + if ( (nx == 1) .or. (ny == 1) )then + Opt@GridCornerLat = latCorners + Opt@GridCornerLon = lonCorners + end if Opt@Title = "SCRIP grid file for "+name if (printn) then Opt@Debug = True @@ -161,7 +169,7 @@ end nc = addfile( outfilename, "w" ); nc@history = ldate+": create using mkscripgrid.ncl"; - nc@comment = "Ocean is assumed to non-existant at this point"; + nc@comment = "Ocean is assumed to be non-existant in this region"; nc@Version = gitdescribe; if ( printn )then print( "================================================================================================" ); From 08e2b0c21bf0ad8da6046bd377c6cf5335d5cb5b Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 20 May 2020 11:40:42 -0600 Subject: [PATCH 321/556] Fix == for .eq. in NCL --- tools/mkmapgrids/mkscripgrid.ncl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tools/mkmapgrids/mkscripgrid.ncl b/tools/mkmapgrids/mkscripgrid.ncl index 16f4018dac..0ff4b52134 100644 --- a/tools/mkmapgrids/mkscripgrid.ncl +++ b/tools/mkmapgrids/mkscripgrid.ncl @@ -119,13 +119,13 @@ end latCenters = fspan1up( (latS + delY/2.d0), (latN - delY/2.d0), ny) lon = new( (/ny, nx/), "double" ); lat = new( (/ny, nx/), "double" ); - if ( (nx == 1) .or. (ny == 1) )then + if ( (nx .eq. 1) .or. (ny .eq. 1) )then lonCorners = new( (/ny, nx, 4/), "double" ); latCorners = new( (/ny, nx, 4/), "double" ); end if do i = 0, nx-1 lat(:,i) = latCenters; - if ( (nx == 1) .or. (ny == 1) )then + if ( (nx .eq. 1) .or. (ny .eq. 1) )then latCorners(:,i,0) = latCenters - delY/2.d0; latCorners(:,i,1) = latCenters - delY/2.d0; latCorners(:,i,2) = latCenters + delY/2.d0; @@ -134,7 +134,7 @@ end end do do j = 0, ny-1 lon(j,:) = lonCenters; - if ( (nx == 1) .or. (ny == 1) )then + if ( (nx .eq. 1) .or. (ny .eq. 1) )then lonCorners(j,:,0) = lonCenters - delX/2.d0; lonCorners(j,:,1) = lonCenters + delX/2.d0; lonCorners(j,:,2) = lonCenters + delX/2.d0; @@ -153,7 +153,7 @@ end Opt = True Opt@Mask2D = Mask2D - if ( (nx == 1) .or. (ny == 1) )then + if ( (nx .eq. 1) .or. (ny .eq. 1) )then Opt@GridCornerLat = latCorners Opt@GridCornerLon = lonCorners end if From 8838dc9486c340a336e69913c128bc0e803ba31b Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 20 May 2020 11:46:05 -0600 Subject: [PATCH 322/556] If verbose print comment about if corners are being calculated or not --- tools/mkmapgrids/mkscripgrid.ncl | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tools/mkmapgrids/mkscripgrid.ncl b/tools/mkmapgrids/mkscripgrid.ncl index 0ff4b52134..0cbd1a8960 100644 --- a/tools/mkmapgrids/mkscripgrid.ncl +++ b/tools/mkmapgrids/mkscripgrid.ncl @@ -120,8 +120,15 @@ end lon = new( (/ny, nx/), "double" ); lat = new( (/ny, nx/), "double" ); if ( (nx .eq. 1) .or. (ny .eq. 1) )then + if ( printn )then + print( "Calculate corners" ) + end if lonCorners = new( (/ny, nx, 4/), "double" ); latCorners = new( (/ny, nx, 4/), "double" ); + else + if ( printn )then + print( "Have NCL calculate corners" ) + end if end if do i = 0, nx-1 lat(:,i) = latCenters; From 98cf4c63137a868feefed71da7239d12b8e5a298 Mon Sep 17 00:00:00 2001 From: wwieder Date: Thu, 21 May 2020 05:44:52 -0600 Subject: [PATCH 323/556] increases resorbtion from live to dead wood --- src/biogeochem/CNNStateUpdate1Mod.F90 | 9 +- src/biogeochem/CNPhenologyMod.F90 | 18 ++-- src/biogeochem/CNVegCarbonFluxType.F90 | 84 +++++++++------- src/biogeochem/CNVegNitrogenFluxType.F90 | 71 +++++++++---- .../NutrientCompetitionFlexibleCNMod.F90 | 99 ++++++++++++++++--- 5 files changed, 201 insertions(+), 80 deletions(-) diff --git a/src/biogeochem/CNNStateUpdate1Mod.F90 b/src/biogeochem/CNNStateUpdate1Mod.F90 index 996426246a..56e6ddbd55 100644 --- a/src/biogeochem/CNNStateUpdate1Mod.F90 +++ b/src/biogeochem/CNNStateUpdate1Mod.F90 @@ -6,7 +6,7 @@ module CNNStateUpdate1Mod ! ! !USES: use shr_kind_mod , only: r8 => shr_kind_r8 - use clm_time_manager , only : get_step_size_real + use clm_time_manager , only : get_step_size, get_step_size_real use clm_varpar , only : nlevdecomp, ndecomp_pools, ndecomp_cascade_transitions use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd use clm_varctl , only : iulog, use_nitrif_denitrif @@ -119,7 +119,7 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ) ! set time steps - dt = get_step_size_real() + dt = real( get_step_size(), r8 ) ! soilbiogeochemistry fluxes TODO - this should be moved elsewhere @@ -189,6 +189,11 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) + nf_veg%livecrootn_to_deadcrootn_patch(p)*dt ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) - nf_veg%livecrootn_to_retransn_patch(p)*dt ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) + nf_veg%livecrootn_to_retransn_patch(p)*dt + ! WW change logic so livestem_retrans goes to npool (via free_retrans flux) + ! this should likely be done more cleanly if it works, i.e. not update fluxes w/ states + ! additional considerations for crop? + nf_veg%free_retransn_to_npool_patch(p) = nf_veg%free_retransn_to_npool_patch(p) + nf_veg%livestemn_to_retransn_patch(p) + nf_veg%free_retransn_to_npool_patch(p) = nf_veg%free_retransn_to_npool_patch(p) + nf_veg%livecrootn_to_retransn_patch(p) end if if (ivt(p) >= npcropmin) then ! Beth adds retrans from froot ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) - nf_veg%frootn_to_retransn_patch(p)*dt diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 6f9b004c04..674c27dda5 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -2720,8 +2720,10 @@ subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & if (CNratio_floating .eqv. .true.) then if (livestemc(p) == 0.0_r8) then ntovr = 0.0_r8 + livestemn_to_deadstemn(p) = 0.0_r8 else ntovr = ctovr * (livestemn(p) / livestemc(p)) + livestemn_to_deadstemn(p) = ctovr / deadwdcn(ivt(p)) end if livestemn_to_deadstemn(p) = 0.5_r8 * ntovr ! assuming 50% goes to deadstemn @@ -2739,19 +2741,23 @@ subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & if (CNratio_floating .eqv. .true.) then if (livecrootc(p) == 0.0_r8) then ntovr = 0.0_r8 + livecrootn_to_deadcrootn(p) = 0.0_r8 else ntovr = ctovr * (livecrootn(p) / livecrootc(p)) + livecrootn_to_deadcrootn(p) = ctovr / deadwdcn(ivt(p)) end if - livecrootn_to_deadcrootn(p) = 0.5_r8 * ntovr ! assuming 50% goes to deadstemn +! livecrootn_to_deadcrootn(p) = 0.5_r8 * ntovr ! assuming 50% goes to deadstemn end if livecrootn_to_retransn(p) = ntovr - livecrootn_to_deadcrootn(p) - if(use_fun)then - !TURNED OFF FLUXES TO CORRECT N ACCUMULATION ISSUE. RF. Oct 2015. - livecrootn_to_retransn(p) = 0.0_r8 - livestemn_to_retransn(p) = 0.0_r8 - endif + +! Allow resorbtion with FUN +! if(use_fun)then +! !TURNED OFF FLUXES TO CORRECT N ACCUMULATION ISSUE. RF. Oct 2015. +! livecrootn_to_retransn(p) = 0.0_r8 +! livestemn_to_retransn(p) = 0.0_r8 +! endif end if diff --git a/src/biogeochem/CNVegCarbonFluxType.F90 b/src/biogeochem/CNVegCarbonFluxType.F90 index 2c1d8ff4b7..8a5bb32abe 100644 --- a/src/biogeochem/CNVegCarbonFluxType.F90 +++ b/src/biogeochem/CNVegCarbonFluxType.F90 @@ -838,6 +838,16 @@ subroutine InitHistory(this, bounds, carbon_type) ptr_patch=this%grainc_to_seed_patch) end if + this%hrv_livestemc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='HRV_LIVESTEMC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='harvest livestem C mortality', & + ptr_patch=this%hrv_livestemc_to_litter_patch, default='active') + + this%livestemc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='livestem C mortality', & + ptr_patch=this%hrv_livestemc_to_litter_patch, default='active') + this%litterc_loss_col(begc:endc) = spval call hist_addfld1d (fname='LITTERC_LOSS', units='gC/m^2/s', & avgflag='A', long_name='litter C loss', & @@ -896,12 +906,12 @@ subroutine InitHistory(this, bounds, carbon_type) this%m_livestemc_storage_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_LITTER', units='gC/m^2/s', & avgflag='A', long_name='live stem C storage mortality', & - ptr_patch=this%m_livestemc_storage_to_litter_patch, default='inactive') + ptr_patch=this%m_livestemc_storage_to_litter_patch, default='active') this%m_deadstemc_storage_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMC_STORAGE_TO_LITTER', units='gC/m^2/s', & avgflag='A', long_name='dead stem C storage mortality', & - ptr_patch=this%m_deadstemc_storage_to_litter_patch, default='inactive') + ptr_patch=this%m_deadstemc_storage_to_litter_patch, default='active') this%m_livecrootc_storage_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVECROOTC_STORAGE_TO_LITTER', units='gC/m^2/s', & @@ -926,7 +936,7 @@ subroutine InitHistory(this, bounds, carbon_type) this%m_livestemc_xfer_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_LITTER', units='gC/m^2/s', & avgflag='A', long_name='live stem C transfer mortality', & - ptr_patch=this%m_livestemc_xfer_to_litter_patch, default='inactive') + ptr_patch=this%m_livestemc_xfer_to_litter_patch, default='active') this%m_deadstemc_xfer_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMC_XFER_TO_LITTER', units='gC/m^2/s', & @@ -946,7 +956,7 @@ subroutine InitHistory(this, bounds, carbon_type) this%m_livestemc_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_TO_LITTER', units='gC/m^2/s', & avgflag='A', long_name='live stem C mortality', & - ptr_patch=this%m_livestemc_to_litter_patch, default='inactive') + ptr_patch=this%m_livestemc_to_litter_patch, default='active') this%m_deadstemc_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMC_TO_LITTER', units='gC/m^2/s', & @@ -991,17 +1001,17 @@ subroutine InitHistory(this, bounds, carbon_type) this%m_livestemc_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_TO_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C fire loss', & - ptr_patch=this%m_livestemc_to_fire_patch, default='inactive') + ptr_patch=this%m_livestemc_to_fire_patch, default='active') this%m_livestemc_storage_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C storage fire loss', & - ptr_patch=this%m_livestemc_storage_to_fire_patch, default='inactive') + ptr_patch=this%m_livestemc_storage_to_fire_patch, default='active') this%m_livestemc_xfer_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C transfer fire loss', & - ptr_patch=this%m_livestemc_xfer_to_fire_patch, default='inactive') + ptr_patch=this%m_livestemc_xfer_to_fire_patch, default='active') this%m_deadstemc_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMC_TO_FIRE', units='gC/m^2/s', & @@ -1092,22 +1102,22 @@ subroutine InitHistory(this, bounds, carbon_type) this%m_livestemc_to_litter_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_TO_LITTER_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C fire mortality to litter', & - ptr_patch=this%m_livestemc_to_litter_fire_patch, default='inactive') + ptr_patch=this%m_livestemc_to_litter_fire_patch, default='active') this%m_livestemc_storage_to_litter_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C storage fire mortality to litter', & - ptr_patch=this%m_livestemc_storage_to_litter_fire_patch, default='inactive') + ptr_patch=this%m_livestemc_storage_to_litter_fire_patch, default='active') this%m_livestemc_xfer_to_litter_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C transfer fire mortality to litter', & - ptr_patch=this%m_livestemc_xfer_to_litter_fire_patch, default='inactive') + ptr_patch=this%m_livestemc_xfer_to_litter_fire_patch, default='active') this%m_livestemc_to_deadstemc_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_TO_DEADSTEMC_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C fire mortality to dead stem C', & - ptr_patch=this%m_livestemc_to_deadstemc_fire_patch, default='inactive') + ptr_patch=this%m_livestemc_to_deadstemc_fire_patch, default='active') this%m_deadstemc_to_litter_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMC_TO_LITTER_FIRE', units='gC/m^2/s', & @@ -1198,7 +1208,7 @@ subroutine InitHistory(this, bounds, carbon_type) this%leafc_xfer_to_leafc_patch(begp:endp) = spval call hist_addfld1d (fname='LEAFC_XFER_TO_LEAFC', units='gC/m^2/s', & avgflag='A', long_name='leaf C growth from storage', & - ptr_patch=this%leafc_xfer_to_leafc_patch, default='inactive') + ptr_patch=this%leafc_xfer_to_leafc_patch, default='active') this%frootc_xfer_to_frootc_patch(begp:endp) = spval call hist_addfld1d (fname='FROOTC_XFER_TO_FROOTC', units='gC/m^2/s', & @@ -1208,12 +1218,12 @@ subroutine InitHistory(this, bounds, carbon_type) this%livestemc_xfer_to_livestemc_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMC_XFER_TO_LIVESTEMC', units='gC/m^2/s', & avgflag='A', long_name='live stem C growth from storage', & - ptr_patch=this%livestemc_xfer_to_livestemc_patch, default='inactive') + ptr_patch=this%livestemc_xfer_to_livestemc_patch, default='active') this%deadstemc_xfer_to_deadstemc_patch(begp:endp) = spval call hist_addfld1d (fname='DEADSTEMC_XFER_TO_DEADSTEMC', units='gC/m^2/s', & avgflag='A', long_name='dead stem C growth from storage', & - ptr_patch=this%deadstemc_xfer_to_deadstemc_patch, default='inactive') + ptr_patch=this%deadstemc_xfer_to_deadstemc_patch, default='active') this%livecrootc_xfer_to_livecrootc_patch(begp:endp) = spval call hist_addfld1d (fname='LIVECROOTC_XFER_TO_LIVECROOTC', units='gC/m^2/s', & @@ -1245,7 +1255,7 @@ subroutine InitHistory(this, bounds, carbon_type) this%cpool_to_resp_patch(begp:endp) = spval call hist_addfld1d (fname='EXCESSC_MR', units='gC/m^2/s', & avgflag='A', long_name='excess C maintenance respiration', & - ptr_patch=this%cpool_to_resp_patch, default='inactive') + ptr_patch=this%cpool_to_resp_patch, default='active') this%leaf_mr_patch(begp:endp) = spval call hist_addfld1d (fname='LEAF_MR', units='gC/m^2/s', & avgflag='A', long_name='leaf maintenance respiration', & @@ -1259,12 +1269,12 @@ subroutine InitHistory(this, bounds, carbon_type) this%livestem_mr_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEM_MR', units='gC/m^2/s', & avgflag='A', long_name='live stem maintenance respiration', & - ptr_patch=this%livestem_mr_patch, default='inactive') + ptr_patch=this%livestem_mr_patch, default='active') this%livecroot_mr_patch(begp:endp) = spval call hist_addfld1d (fname='LIVECROOT_MR', units='gC/m^2/s', & avgflag='A', long_name='live coarse root maintenance respiration', & - ptr_patch=this%livecroot_mr_patch, default='inactive') + ptr_patch=this%livecroot_mr_patch, default='active') this%psnsun_to_cpool_patch(begp:endp) = spval call hist_addfld1d (fname='PSNSUN_TO_CPOOL', units='gC/m^2/s', & @@ -1299,42 +1309,42 @@ subroutine InitHistory(this, bounds, carbon_type) this%cpool_to_livestemc_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_LIVESTEMC', units='gC/m^2/s', & avgflag='A', long_name='allocation to live stem C', & - ptr_patch=this%cpool_to_livestemc_patch, default='inactive') + ptr_patch=this%cpool_to_livestemc_patch, default='active') this%cpool_to_livestemc_storage_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_LIVESTEMC_STORAGE', units='gC/m^2/s', & avgflag='A', long_name='allocation to live stem C storage', & - ptr_patch=this%cpool_to_livestemc_storage_patch, default='inactive') + ptr_patch=this%cpool_to_livestemc_storage_patch, default='active') this%cpool_to_deadstemc_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_DEADSTEMC', units='gC/m^2/s', & avgflag='A', long_name='allocation to dead stem C', & - ptr_patch=this%cpool_to_deadstemc_patch, default='inactive') + ptr_patch=this%cpool_to_deadstemc_patch, default='active') this%cpool_to_deadstemc_storage_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_DEADSTEMC_STORAGE', units='gC/m^2/s', & avgflag='A', long_name='allocation to dead stem C storage', & - ptr_patch=this%cpool_to_deadstemc_storage_patch, default='inactive') + ptr_patch=this%cpool_to_deadstemc_storage_patch, default='active') this%cpool_to_livecrootc_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_LIVECROOTC', units='gC/m^2/s', & avgflag='A', long_name='allocation to live coarse root C', & - ptr_patch=this%cpool_to_livecrootc_patch, default='inactive') + ptr_patch=this%cpool_to_livecrootc_patch, default='active') this%cpool_to_livecrootc_storage_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_LIVECROOTC_STORAGE', units='gC/m^2/s', & avgflag='A', long_name='allocation to live coarse root C storage', & - ptr_patch=this%cpool_to_livecrootc_storage_patch, default='inactive') + ptr_patch=this%cpool_to_livecrootc_storage_patch, default='active') this%cpool_to_deadcrootc_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_DEADCROOTC', units='gC/m^2/s', & avgflag='A', long_name='allocation to dead coarse root C', & - ptr_patch=this%cpool_to_deadcrootc_patch, default='inactive') + ptr_patch=this%cpool_to_deadcrootc_patch, default='active') this%cpool_to_deadcrootc_storage_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_DEADCROOTC_STORAGE', units='gC/m^2/s', & avgflag='A', long_name='allocation to dead coarse root C storage', & - ptr_patch=this%cpool_to_deadcrootc_storage_patch, default='inactive') + ptr_patch=this%cpool_to_deadcrootc_storage_patch, default='active') this%cpool_to_gresp_storage_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_GRESP_STORAGE', units='gC/m^2/s', & @@ -1374,42 +1384,42 @@ subroutine InitHistory(this, bounds, carbon_type) this%cpool_livestem_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_LIVESTEM_GR', units='gC/m^2/s', & avgflag='A', long_name='live stem growth respiration', & - ptr_patch=this%cpool_livestem_gr_patch, default='inactive') + ptr_patch=this%cpool_livestem_gr_patch, default='active') this%cpool_livestem_storage_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_LIVESTEM_STORAGE_GR', units='gC/m^2/s', & avgflag='A', long_name='live stem growth respiration to storage', & - ptr_patch=this%cpool_livestem_storage_gr_patch, default='inactive') + ptr_patch=this%cpool_livestem_storage_gr_patch, default='active') this%transfer_livestem_gr_patch(begp:endp) = spval call hist_addfld1d (fname='TRANSFER_LIVESTEM_GR', units='gC/m^2/s', & avgflag='A', long_name='live stem growth respiration from storage', & - ptr_patch=this%transfer_livestem_gr_patch, default='inactive') + ptr_patch=this%transfer_livestem_gr_patch, default='active') this%cpool_deadstem_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_DEADSTEM_GR', units='gC/m^2/s', & avgflag='A', long_name='dead stem growth respiration', & - ptr_patch=this%cpool_deadstem_gr_patch, default='inactive') + ptr_patch=this%cpool_deadstem_gr_patch, default='active') this%cpool_deadstem_storage_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_DEADSTEM_STORAGE_GR', units='gC/m^2/s', & avgflag='A', long_name='dead stem growth respiration to storage', & - ptr_patch=this%cpool_deadstem_storage_gr_patch, default='inactive') + ptr_patch=this%cpool_deadstem_storage_gr_patch, default='active') this%transfer_deadstem_gr_patch(begp:endp) = spval call hist_addfld1d (fname='TRANSFER_DEADSTEM_GR', units='gC/m^2/s', & avgflag='A', long_name='dead stem growth respiration from storage', & - ptr_patch=this%transfer_deadstem_gr_patch, default='inactive') + ptr_patch=this%transfer_deadstem_gr_patch, default='active') this%cpool_livecroot_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_LIVECROOT_GR', units='gC/m^2/s', & avgflag='A', long_name='live coarse root growth respiration', & - ptr_patch=this%cpool_livecroot_gr_patch, default='inactive') + ptr_patch=this%cpool_livecroot_gr_patch, default='active') this%cpool_livecroot_storage_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_LIVECROOT_STORAGE_GR', units='gC/m^2/s', & avgflag='A', long_name='live coarse root growth respiration to storage', & - ptr_patch=this%cpool_livecroot_storage_gr_patch, default='inactive') + ptr_patch=this%cpool_livecroot_storage_gr_patch, default='active') this%transfer_livecroot_gr_patch(begp:endp) = spval call hist_addfld1d (fname='TRANSFER_LIVECROOT_GR', units='gC/m^2/s', & @@ -1444,12 +1454,12 @@ subroutine InitHistory(this, bounds, carbon_type) this%livestemc_storage_to_xfer_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMC_STORAGE_TO_XFER', units='gC/m^2/s', & avgflag='A', long_name='live stem C shift storage to transfer', & - ptr_patch=this%livestemc_storage_to_xfer_patch, default='inactive') + ptr_patch=this%livestemc_storage_to_xfer_patch, default='active') this%deadstemc_storage_to_xfer_patch(begp:endp) = spval call hist_addfld1d (fname='DEADSTEMC_STORAGE_TO_XFER', units='gC/m^2/s', & avgflag='A', long_name='dead stem C shift storage to transfer', & - ptr_patch=this%deadstemc_storage_to_xfer_patch, default='inactive') + ptr_patch=this%deadstemc_storage_to_xfer_patch, default='active') this%livecrootc_storage_to_xfer_patch(begp:endp) = spval call hist_addfld1d (fname='LIVECROOTC_STORAGE_TO_XFER', units='gC/m^2/s', & @@ -1469,12 +1479,12 @@ subroutine InitHistory(this, bounds, carbon_type) this%livestemc_to_deadstemc_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMC_TO_DEADSTEMC', units='gC/m^2/s', & avgflag='A', long_name='live stem C turnover', & - ptr_patch=this%livestemc_to_deadstemc_patch, default='inactive') + ptr_patch=this%livestemc_to_deadstemc_patch, default='active') this%livecrootc_to_deadcrootc_patch(begp:endp) = spval call hist_addfld1d (fname='LIVECROOTC_TO_DEADCROOTC', units='gC/m^2/s', & avgflag='A', long_name='live coarse root C turnover', & - ptr_patch=this%livecrootc_to_deadcrootc_patch, default='inactive') + ptr_patch=this%livecrootc_to_deadcrootc_patch, default='active') this%gpp_before_downreg_patch(begp:endp) = spval call hist_addfld1d (fname='INIT_GPP', units='gC/m^2/s', & diff --git a/src/biogeochem/CNVegNitrogenFluxType.F90 b/src/biogeochem/CNVegNitrogenFluxType.F90 index f9f2b37215..212333155c 100644 --- a/src/biogeochem/CNVegNitrogenFluxType.F90 +++ b/src/biogeochem/CNVegNitrogenFluxType.F90 @@ -557,7 +557,29 @@ subroutine InitHistory(this, bounds) else vr_suffix = "" endif - +! WW added these two fields + ! This may just be a crop variable + this%livestemn_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='livestem N mortality', & + ptr_patch=this%livestemn_to_litter_patch, default='active') + + this%hrv_livestemn_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='HRV_LIVESTEMN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='harvest livestem N mortality', & + ptr_patch=this%hrv_livestemn_to_litter_patch, default='active') + + this%m_livestemn_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMN_TO_LITTER_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live stem N fire mortality to litter', & + ptr_patch=this%m_livestemn_to_litter_fire_patch, default='active') + + this%m_livestemn_to_deadstemn_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMN_TO_DEADSTEMN_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live stem N fire mortality to dead stem N', & + ptr_patch=this%m_livestemn_to_deadstemn_fire_patch, default='active') +! end WW additions + this%m_leafn_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LEAFN_TO_LITTER', units='gN/m^2/s', & avgflag='A', long_name='leaf N mortality', & @@ -581,7 +603,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_storage_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_STORAGE_TO_LITTER', units='gN/m^2/s', & avgflag='A', long_name='live stem N storage mortality', & - ptr_patch=this%m_livestemn_storage_to_litter_patch, default='inactive') + ptr_patch=this%m_livestemn_storage_to_litter_patch, default='active') this%m_deadstemn_storage_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_STORAGE_TO_LITTER', units='gN/m^2/s', & @@ -611,7 +633,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_xfer_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_XFER_TO_LITTER', units='gN/m^2/s', & avgflag='A', long_name='live stem N transfer mortality', & - ptr_patch=this%m_livestemn_xfer_to_litter_patch, default='inactive') + ptr_patch=this%m_livestemn_xfer_to_litter_patch, default='active') this%m_deadstemn_xfer_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_XFER_TO_LITTER', units='gN/m^2/s', & @@ -631,7 +653,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_TO_LITTER', units='gN/m^2/s', & avgflag='A', long_name='live stem N mortality', & - ptr_patch=this%m_livestemn_to_litter_patch, default='inactive') + ptr_patch=this%m_livestemn_to_litter_patch, default='active') this%m_deadstemn_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_TO_LITTER', units='gN/m^2/s', & @@ -676,7 +698,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_storage_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_STORAGE_TO_FIRE', units='gN/m^2/s', & avgflag='A', long_name='live stem N storage fire loss', & - ptr_patch=this%m_livestemn_storage_to_fire_patch, default='inactive') + ptr_patch=this%m_livestemn_storage_to_fire_patch, default='active') this%m_deadstemn_storage_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_STORAGE_TO_FIRE', units='gN/m^2/s', & @@ -706,7 +728,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_xfer_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_XFER_TO_FIRE', units='gN/m^2/s', & avgflag='A', long_name='live stem N transfer fire loss', & - ptr_patch=this%m_livestemn_xfer_to_fire_patch, default='inactive') + ptr_patch=this%m_livestemn_xfer_to_fire_patch, default='active') this%m_deadstemn_xfer_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_XFER_TO_FIRE', units='gN/m^2/s', & @@ -726,7 +748,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_TO_FIRE', units='gN/m^2/s', & avgflag='A', long_name='live stem N fire loss', & - ptr_patch=this%m_livestemn_to_fire_patch, default='inactive') + ptr_patch=this%m_livestemn_to_fire_patch, default='active') this%m_deadstemn_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_TO_FIRE', units='gN/m^2/s', & @@ -761,7 +783,7 @@ subroutine InitHistory(this, bounds) this%leafn_xfer_to_leafn_patch(begp:endp) = spval call hist_addfld1d (fname='LEAFN_XFER_TO_LEAFN', units='gN/m^2/s', & avgflag='A', long_name='leaf N growth from storage', & - ptr_patch=this%leafn_xfer_to_leafn_patch, default='inactive') + ptr_patch=this%leafn_xfer_to_leafn_patch, default='active') this%frootn_xfer_to_frootn_patch(begp:endp) = spval call hist_addfld1d (fname='FROOTN_XFER_TO_FROOTN', units='gN/m^2/s', & @@ -771,7 +793,7 @@ subroutine InitHistory(this, bounds) this%livestemn_xfer_to_livestemn_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMN_XFER_TO_LIVESTEMN', units='gN/m^2/s', & avgflag='A', long_name='live stem N growth from storage', & - ptr_patch=this%livestemn_xfer_to_livestemn_patch, default='inactive') + ptr_patch=this%livestemn_xfer_to_livestemn_patch, default='active') this%deadstemn_xfer_to_deadstemn_patch(begp:endp) = spval call hist_addfld1d (fname='DEADSTEMN_XFER_TO_DEADSTEMN', units='gN/m^2/s', & @@ -796,12 +818,12 @@ subroutine InitHistory(this, bounds) this%leafn_to_retransn_patch(begp:endp) = spval call hist_addfld1d (fname='LEAFN_TO_RETRANSN', units='gN/m^2/s', & avgflag='A', long_name='leaf N to retranslocated N pool', & - ptr_patch=this%leafn_to_retransn_patch, default='inactive') + ptr_patch=this%leafn_to_retransn_patch, default='active') this%frootn_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='FROOTN_TO_LITTER', units='gN/m^2/s', & avgflag='A', long_name='fine root N litterfall', & - ptr_patch=this%frootn_to_litter_patch, default='inactive') + ptr_patch=this%frootn_to_litter_patch, default='active') this%retransn_to_npool_patch(begp:endp) = spval call hist_addfld1d (fname='RETRANSN_TO_NPOOL', units='gN/m^2/s', & @@ -841,22 +863,22 @@ subroutine InitHistory(this, bounds) this%npool_to_livestemn_patch(begp:endp) = spval call hist_addfld1d (fname='NPOOL_TO_LIVESTEMN', units='gN/m^2/s', & avgflag='A', long_name='allocation to live stem N', & - ptr_patch=this%npool_to_livestemn_patch, default='inactive') + ptr_patch=this%npool_to_livestemn_patch, default='active') this%npool_to_livestemn_storage_patch(begp:endp) = spval call hist_addfld1d (fname='NPOOL_TO_LIVESTEMN_STORAGE', units='gN/m^2/s', & avgflag='A', long_name='allocation to live stem N storage', & - ptr_patch=this%npool_to_livestemn_storage_patch, default='inactive') + ptr_patch=this%npool_to_livestemn_storage_patch, default='active') this%npool_to_deadstemn_patch(begp:endp) = spval call hist_addfld1d (fname='NPOOL_TO_DEADSTEMN', units='gN/m^2/s', & avgflag='A', long_name='allocation to dead stem N', & - ptr_patch=this%npool_to_deadstemn_patch, default='inactive') + ptr_patch=this%npool_to_deadstemn_patch, default='active') this%npool_to_deadstemn_storage_patch(begp:endp) = spval call hist_addfld1d (fname='NPOOL_TO_DEADSTEMN_STORAGE', units='gN/m^2/s', & avgflag='A', long_name='allocation to dead stem N storage', & - ptr_patch=this%npool_to_deadstemn_storage_patch, default='inactive') + ptr_patch=this%npool_to_deadstemn_storage_patch, default='active') this%npool_to_livecrootn_patch(begp:endp) = spval call hist_addfld1d (fname='NPOOL_TO_LIVECROOTN', units='gN/m^2/s', & @@ -891,7 +913,7 @@ subroutine InitHistory(this, bounds) this%livestemn_storage_to_xfer_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMN_STORAGE_TO_XFER', units='gN/m^2/s', & avgflag='A', long_name='live stem N shift storage to transfer', & - ptr_patch=this%livestemn_storage_to_xfer_patch, default='inactive') + ptr_patch=this%livestemn_storage_to_xfer_patch, default='active') this%deadstemn_storage_to_xfer_patch(begp:endp) = spval call hist_addfld1d (fname='DEADSTEMN_STORAGE_TO_XFER', units='gN/m^2/s', & @@ -911,12 +933,12 @@ subroutine InitHistory(this, bounds) this%livestemn_to_deadstemn_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMN_TO_DEADSTEMN', units='gN/m^2/s', & avgflag='A', long_name='live stem N turnover', & - ptr_patch=this%livestemn_to_deadstemn_patch, default='inactive') + ptr_patch=this%livestemn_to_deadstemn_patch, default='active') this%livestemn_to_retransn_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMN_TO_RETRANSN', units='gN/m^2/s', & avgflag='A', long_name='live stem N to retranslocated N pool', & - ptr_patch=this%livestemn_to_retransn_patch, default='inactive') + ptr_patch=this%livestemn_to_retransn_patch, default='active') this%livecrootn_to_deadcrootn_patch(begp:endp) = spval call hist_addfld1d (fname='LIVECROOTN_TO_DEADCROOTN', units='gN/m^2/s', & @@ -950,7 +972,7 @@ subroutine InitHistory(this, bounds) ptr_patch=this%fert_patch) end if - if (use_crop .and. .not. use_fun) then + if (use_crop) then this%soyfixn_patch(begp:endp) = spval call hist_addfld1d (fname='SOYFIXN', units='gN/m^2/s', & avgflag='A', long_name='soybean fixation', & @@ -1402,6 +1424,11 @@ subroutine Restart (this, bounds, ncid, flag ) long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%avail_retransn_patch) + call restartvar(ncid=ncid, flag=flag, varname='plant_nalloc', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%plant_nalloc_patch) + if ( use_fun ) then ! set_missing_vals_to_constant for BACKWARDS_COMPATIBILITY(wrw, 2018-06-28) re. issue #426 ! special land units previously set to spval, not 0 @@ -1521,6 +1548,12 @@ subroutine Restart (this, bounds, ncid, flag ) long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%Nuptake_patch) call set_missing_vals_to_constant(this%Nuptake_patch, 0._r8) + + call restartvar(ncid=ncid, flag=flag, varname='sminn_to_plant_fun', xtype=ncd_double, & + dim1name='pft', & + long_name='Total soil N uptake of FUN', units='gN/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%sminn_to_plant_fun_patch) + call set_missing_vals_to_constant(this%sminn_to_plant_fun_patch, 0._r8) end if ! End BACKWARDS_COMPATIBILITY(wrw, 2018-06-28) re. issue #426 diff --git a/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 b/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 index b69c666ea4..81e33315c0 100644 --- a/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 +++ b/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 @@ -18,6 +18,7 @@ module NutrientCompetitionFlexibleCNMod ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use LandunitType , only : lun use ColumnType , only : col @@ -36,6 +37,10 @@ module NutrientCompetitionFlexibleCNMod private real(r8), pointer :: actual_leafcn(:) ! leaf CN ratio used by flexible CN real(r8), pointer :: actual_storage_leafcn(:) ! storage leaf CN ratio used by flexible CN + real(r8), pointer :: actual_livestemcn(:) ! live wood CN ratio used by flexible CN + real(r8), pointer :: actual_livestemcn_storage(:) ! storage live wood CN ratio used by flexible CN + real(r8), pointer :: npool_to_livestemn(:) ! npool to live stem n + real(r8), pointer :: npool_to_livestemn_storage(:) ! npool to live stem storage n contains ! public methocs procedure, public :: Init ! Initialization @@ -97,6 +102,10 @@ subroutine InitAllocate(this, bounds) allocate(this%actual_leafcn(bounds%begp:bounds%endp)) ; this%actual_leafcn(:) = nan allocate(this%actual_storage_leafcn(bounds%begp:bounds%endp)) ; this%actual_storage_leafcn(:) = nan + allocate(this%actual_livestemcn(bounds%begp:bounds%endp)) ; this%actual_livestemcn(:) = nan + allocate(this%actual_livestemcn_storage(bounds%begp:bounds%endp)) ; this%actual_livestemcn_storage(:) = nan + allocate(this%npool_to_livestemn(bounds%begp:bounds%endp)) ; this%npool_to_livestemn(:) = nan + allocate(this%npool_to_livestemn_storage(bounds%begp:bounds%endp)) ; this%npool_to_livestemn_storage(:) = nan end subroutine InitAllocate @@ -127,7 +136,25 @@ subroutine InitHistory(this, bounds) this%actual_storage_leafcn(begp:endp) = spval call hist_addfld1d (fname='LEAFCN_STORAGE', units='gC/gN', & avgflag='A', long_name='Storage Leaf CN ratio used for flexible CN', & - ptr_patch=this%actual_storage_leafcn, default='inactive') + ptr_patch=this%actual_storage_leafcn, default='active') + + this%actual_livestemcn(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMCN', units='gC/gN', & + avgflag='A', long_name='Live wood CN ratio used for flexible CN', & + ptr_patch=this%actual_livestemcn ) + this%actual_livestemcn_storage(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMCN_STORAGE', units='gC/gN', & + avgflag='A', long_name='Storage Live wood CN ratio used for flexible CN', & + ptr_patch=this%actual_livestemcn_storage, default='active') + + this%npool_to_livestemn(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_LIVESTEM', units='gN m^-1 s^-1', & + avgflag='A', long_name='NPOOL to live stem N', & + ptr_patch=this%npool_to_livestemn ) + this%npool_to_livestemn_storage(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_LIVESTEM_STORAGE', units='gN m^-1 s^-1', & + avgflag='A', long_name='NPOOL to live stem N storage', & + ptr_patch=this%npool_to_livestemn_storage ) end subroutine InitHistory @@ -195,7 +222,7 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & use clm_varctl , only : downreg_opt use clm_varctl , only : CN_residual_opt use clm_varctl , only : CN_partition_opt - use clm_time_manager , only : get_step_size_real + use clm_time_manager , only : get_step_size use CNVegStateType , only : cnveg_state_type use CropType , only : crop_type use CanopyStateType , only : canopystate_type @@ -297,11 +324,11 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & ! ----------------------------------------------------------------------- - SHR_ASSERT_ALL_FL((ubound(aroot) == (/bounds%endp/)) , sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(arepr) == (/bounds%endp/)) , sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(fpg_col) == (/bounds%endc/)) , sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(this%actual_storage_leafcn) >= (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((lbound(this%actual_storage_leafcn) <= (/bounds%begp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL((ubound(aroot) == (/bounds%endp/)) , errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((ubound(arepr) == (/bounds%endp/)) , errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((ubound(fpg_col) == (/bounds%endc/)) , errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((ubound(this%actual_storage_leafcn) >= (/bounds%endp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((lbound(this%actual_storage_leafcn) <= (/bounds%begp/)), errMsg(sourcefile, __LINE__)) associate( & fpg => fpg_col , & ! Input: [real(r8) (:) ] fraction of potential gpp (no units) @@ -400,7 +427,7 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & ) ! set time steps - dt = get_step_size_real() + dt = real( get_step_size(), r8 ) ! patch loop to distribute the available N between the competing patches ! on the basis of relative demand, and allocate C and N to new growth and storage @@ -766,6 +793,9 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (downreg_opt .eqv. .false. .AND. CN_partition_opt == 1) then + ! WW this is where demand could also be modified based on actual leaf and live wood C:N + ! allocation from npool to storage would also have to be modified? + ! computing nitrogen demand for different pools based on carbon allocated and CN ratio npool_to_leafn_demand(p) = (nlc / cnl) * fcur npool_to_leafn_storage_demand(p) = (nlc / cnl) * (1._r8 - fcur) @@ -943,7 +973,9 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & / cnveg_nitrogenstate_inst%leafn_storage_patch(p) end if end if - + + !! WW none of this is done in CLM5 w/ FUN because carbon_resp_opt = 0 by default !! + !! WW remove this redundant code? if (carbon_resp_opt == 1 .AND. laisun(p)+laisha(p) > 0.0_r8) then ! computing carbon to nitrogen ratio of different plant parts @@ -1192,7 +1224,7 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & use clm_varctl , only : use_c13, use_c14 use clm_varctl , only : nscalar_opt, plant_ndemand_opt, substrate_term_opt, temp_scalar_opt use clm_varpar , only : nlevdecomp - use clm_time_manager , only : get_step_size_real + use clm_time_manager , only : get_step_size use CanopyStateType , only : canopystate_type use PhotosynthesisMod , only : photosyns_type use CropType , only : crop_type @@ -1256,10 +1288,16 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & ! ----------------------------------------------------------------------- - SHR_ASSERT_ALL_FL((ubound(aroot) == (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(arepr) == (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(this%actual_leafcn) >= (/bounds%endp/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((lbound(this%actual_leafcn) <= (/bounds%begp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL((ubound(aroot) == (/bounds%endp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((ubound(arepr) == (/bounds%endp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((ubound(this%actual_leafcn) >= (/bounds%endp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((lbound(this%actual_leafcn) <= (/bounds%begp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((ubound(this%actual_storage_leafcn) >= (/bounds%endp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((lbound(this%actual_storage_leafcn) <= (/bounds%begp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((ubound(this%actual_livestemcn) >= (/bounds%endp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((lbound(this%actual_livestemcn) <= (/bounds%begp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((ubound(this%actual_livestemcn_storage) >= (/bounds%endp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((lbound(this%actual_livestemcn_storage) <= (/bounds%begp/)), errMsg(sourcefile, __LINE__)) associate( & ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type @@ -1322,8 +1360,10 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & xsmrpool => cnveg_carbonstate_inst%xsmrpool_patch , & ! Input: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:) ] livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N @@ -1351,6 +1391,7 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & cpool_to_xsmrpool => cnveg_carbonflux_inst%cpool_to_xsmrpool_patch , & ! Output: [real(r8) (:) ] leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) avail_retransn => cnveg_nitrogenflux_inst%avail_retransn_patch , & ! Output: [real(r8) (:) ] N flux available from retranslocation pool (gN/m2/s) retransn_to_npool => cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) @@ -1359,6 +1400,7 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & frootn_to_retransn => cnveg_nitrogenflux_inst%frootn_to_retransn_patch , & ! Output: [real(r8) (:) ] livestemn_to_retransn => cnveg_nitrogenflux_inst%livestemn_to_retransn_patch,& ! Output: [real(r8) (:) ] livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) livestem N + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) livestem N frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N sminn_vr => soilbiogeochem_nitrogenstate_inst%sminn_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral N btran => energyflux_inst%btran_patch , & ! Input: [real(r8) (:) ] transpiration wetness factor (0 to 1) @@ -1367,7 +1409,7 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & ) ! set time steps - dt = get_step_size_real() + dt = real( get_step_size(), r8 ) ! set number of days to recover negative cpool dayscrecover = params_inst%dayscrecover ! loop over patches to assess the total plant N demand @@ -1652,7 +1694,32 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & ! leaf CN ratio this%actual_leafcn(p) = leafc(p) / leafn(p) end if - + ! WW added here to simplify diagnostics + if (leafn_storage(p) < n_min ) then + this%actual_storage_leafcn(p) = spval + else + this%actual_storage_leafcn(p) = leafc_storage(p) / leafn_storage(p) + end if + + + ! when we have "if (livestemn(p) == 0.0_r8)" below then we + ! have floating overflow (out of floating point range) + ! error in "actual_livestemcn(p) = livestemc(p) / livestemn(p)" + if (woody(ivt(p)) == 1.0_r8) then + if (livestemn(p) < n_min ) then + ! to avoid division by zero, and to set livestemcn to missing value for history files + this%actual_livestemcn(p) = spval + else + ! livestem CN ratio + this%actual_livestemcn(p) = livestemc(p) / livestemn(p) + end if + + if (livestemn_storage(p) < n_min ) then + this%actual_livestemcn_storage(p) = spval + else + this%actual_livestemcn_storage(p) = livestemc(p) / livestemn_storage(p) + end if + end if if (nscalar_opt) then From e28ea2851523008468e94a26f2b56b99fd3d2742 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 25 May 2020 22:43:57 -0600 Subject: [PATCH 324/556] Gricell-level error check for methane (CH4) --- src/biogeochem/ch4Mod.F90 | 156 ++++++++++++++++++++++++++++++-------- src/main/clm_driver.F90 | 10 ++- 2 files changed, 131 insertions(+), 35 deletions(-) diff --git a/src/biogeochem/ch4Mod.F90 b/src/biogeochem/ch4Mod.F90 index 8e90f730d4..b833ec4c76 100644 --- a/src/biogeochem/ch4Mod.F90 +++ b/src/biogeochem/ch4Mod.F90 @@ -49,7 +49,8 @@ module ch4Mod ! !PUBLIC MEMBER FUNCTIONS: public :: readParams - public :: ch4_init_balance_check + public :: ch4_init_column_balance_check + public :: ch4_init_gridcell_balance_check public :: ch4 ! !PRIVATE MEMBER FUNCTIONS: @@ -155,7 +156,9 @@ module ch4Mod real(r8), pointer, private :: zwt_ch4_unsat_col (:) ! col depth of water table for unsaturated fraction (m) real(r8), pointer, private :: lake_soilc_col (:,:) ! col total soil organic matter found in level (g C / m^3) (nlevsoi) real(r8), pointer, private :: totcolch4_col (:) ! col total methane found in soil col (g C / m^2) + real(r8), pointer, private :: totcolch4_grc (:) ! grc total methane found in soil col (g C / m^2) real(r8), pointer, private :: totcolch4_bef_col (:) ! col total methane found in soil col, start of timestep (g C / m^2) + real(r8), pointer, private :: totcolch4_bef_grc (:) ! grc total methane found in soil col, start of timestep (g C / m^2) real(r8), pointer, private :: annsum_counter_col (:) ! col seconds since last annual accumulator turnover real(r8), pointer, private :: tempavg_somhr_col (:) ! col temporary average SOM heterotrophic resp. (gC/m2/s) real(r8), pointer, private :: annavg_somhr_col (:) ! col annual average SOM heterotrophic resp. (gC/m2/s) @@ -198,6 +201,7 @@ module ch4Mod real(r8), pointer, public :: o2_decomp_depth_sat_col (:,:) ! col O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) real(r8), pointer, public :: o2_decomp_depth_unsat_col (:,:) ! col O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) real(r8), pointer, public :: ch4_surf_flux_tot_col (:) ! col CH4 surface flux (to atm) (kg C/m**2/s) + real(r8), pointer, public :: ch4_surf_flux_tot_grc (:) ! grc CH4 surface flux (to atm) (kg C/m**2/s) real(r8), pointer, public :: grnd_ch4_cond_patch (:) ! patch tracer conductance for boundary layer [m/s] real(r8), pointer, public :: grnd_ch4_cond_col (:) ! col tracer conductance for boundary layer [m/s] @@ -302,7 +306,9 @@ subroutine InitAllocate(this, bounds) allocate(this%zwt_ch4_unsat_col (begc:endc)) ; this%zwt_ch4_unsat_col (:) = nan allocate(this%lake_soilc_col (begc:endc,1:nlevgrnd)) ; this%lake_soilc_col (:,:) = spval !first time-step allocate(this%totcolch4_col (begc:endc)) ; this%totcolch4_col (:) = nan + allocate(this%totcolch4_grc (begg:endg)) ; this%totcolch4_grc (:) = nan allocate(this%totcolch4_bef_col (begc:endc)) ; this%totcolch4_bef_col (:) = nan + allocate(this%totcolch4_bef_grc (begg:endg)) ; this%totcolch4_bef_grc (:) = nan allocate(this%annsum_counter_col (begc:endc)) ; this%annsum_counter_col (:) = nan allocate(this%tempavg_somhr_col (begc:endc)) ; this%tempavg_somhr_col (:) = nan allocate(this%annavg_somhr_col (begc:endc)) ; this%annavg_somhr_col (:) = nan @@ -316,6 +322,7 @@ subroutine InitAllocate(this, bounds) allocate(this%layer_sat_lag_col (begc:endc,1:nlevgrnd)) ; this%layer_sat_lag_col (:,:) = nan allocate(this%pH_col (begc:endc)) ; this%pH_col (:) = nan allocate(this%ch4_surf_flux_tot_col (begc:endc)) ; this%ch4_surf_flux_tot_col (:) = nan + allocate(this%ch4_surf_flux_tot_grc (begg:endg)) ; this%ch4_surf_flux_tot_grc (:) = nan allocate(this%dyn_ch4bal_adjustments_col (begc:endc)) ; this%dyn_ch4bal_adjustments_col (:) = nan allocate(this%c_atm_grc (begg:endg,1:ngases)) ; this%c_atm_grc (:,:) = nan @@ -337,7 +344,6 @@ subroutine InitAllocate(this, bounds) allocate(this%conc_o2_unsat_col (begc:endc,1:nlevgrnd)) ; this%conc_o2_unsat_col (:,:) = nan allocate(this%o2_decomp_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%o2_decomp_depth_sat_col (:,:) = nan allocate(this%o2_decomp_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%o2_decomp_depth_unsat_col (:,:) = nan - allocate(this%ch4_surf_flux_tot_col (begc:endc)) ; this%ch4_surf_flux_tot_col (:) = nan allocate(this%grnd_ch4_cond_patch (begp:endp)) ; this%grnd_ch4_cond_patch (:) = nan allocate(this%grnd_ch4_cond_col (begc:endc)) ; this%grnd_ch4_cond_col (:) = nan @@ -1554,13 +1560,61 @@ subroutine readParams ( ncid ) end subroutine readParams !----------------------------------------------------------------------- - subroutine ch4_init_balance_check(bounds, num_nolakec, filter_nolakec, num_lakec, filter_lakec, & + subroutine ch4_init_gridcell_balance_check(bounds, num_nolakec, & + filter_nolakec, num_lakec, filter_lakec, ch4_inst) + ! + ! !DESCRIPTION: + ! Calculate beginning gridcell-level ch4 balance for mass conservation + ! check + ! + ! This sets ch4_inst%totcolch4_bef_grc + ! + ! Called before the weight updates done for dynamic landunits and the + ! associated filter updates + ! + ! !USES: + use subgridAveMod, only: c2g + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_lakec ! number of column lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for lake points + type(ch4_type) , intent(inout) :: ch4_inst + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'ch4_init_gridcell_balance_check' + !----------------------------------------------------------------------- + + ! Initialize to zero for columns outside the filters because will + ! average up to gridcell + ch4_inst%totcolch4_bef_col(bounds%begc:bounds%endc) = 0._r8 + + ! This is only really needed for soilc and lakec, but we use nolakec rather + ! than just soilc for consistency with the other call to ch4_totcolch4 + ! (which computes ch4_inst%totcolch4 over all columns for diagnostic + ! purposes). + call ch4_totcolch4(bounds, num_nolakec, filter_nolakec, num_lakec, & + filter_lakec, ch4_inst, & + ch4_inst%totcolch4_bef_col(bounds%begc:bounds%endc)) + + call c2g( bounds, & + ch4_inst%totcolch4_bef_col(bounds%begc:bounds%endc), & + ch4_inst%totcolch4_bef_grc(bounds%begg:bounds%endg), & + c2l_scale_type= 'unity', l2g_scale_type='unity' ) + + end subroutine ch4_init_gridcell_balance_check + + !----------------------------------------------------------------------- + subroutine ch4_init_column_balance_check(bounds, num_nolakec, filter_nolakec, num_lakec, filter_lakec, & ch4_inst) ! ! !DESCRIPTION: ! Calculate beginning column-level ch4 balance, for mass conservation check ! - ! This sets ch4_inst%totcolch4_bef + ! This sets ch4_inst%totcolch4_bef_col ! ! This should be called after the weight updates due to dynamic landunits, and the ! associated filter updates - i.e., using the new version of the filters. @@ -1576,9 +1630,8 @@ subroutine ch4_init_balance_check(bounds, num_nolakec, filter_nolakec, num_lakec type(ch4_type) , intent(inout) :: ch4_inst ! ! !LOCAL VARIABLES: - integer :: fc, c - character(len=*), parameter :: subname = 'ch4_init_balance_check' + character(len=*), parameter :: subname = 'ch4_init_column_balance_check' !----------------------------------------------------------------------- ! This is only really needed for soilc and lakec, but we use nolakec rather than just @@ -1587,7 +1640,7 @@ subroutine ch4_init_balance_check(bounds, num_nolakec, filter_nolakec, num_lakec call ch4_totcolch4(bounds, num_nolakec, filter_nolakec, num_lakec, filter_lakec, & ch4_inst, ch4_inst%totcolch4_bef_col(bounds%begc:bounds%endc)) - end subroutine ch4_init_balance_check + end subroutine ch4_init_column_balance_check !----------------------------------------------------------------------- @@ -1698,7 +1751,8 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & qflx_surf => waterfluxbulk_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] total surface runoff (mm H2O /s) conc_o2_sat => ch4_inst%conc_o2_sat_col , & ! Input: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi) - totcolch4_bef => ch4_inst%totcolch4_bef_col , & ! Input: [real(r8) (:) ] total methane in soil column, start of timestep (g C / m^2) + totcolch4_bef_col => ch4_inst%totcolch4_bef_col , & ! Input: [real(r8) (:) ] column-level total methane in soil column, start of timestep (g C / m^2) + totcolch4_bef_grc => ch4_inst%totcolch4_bef_grc , & ! Input: [real(r8) (:) ] gridcell-level total methane in soil column, start of timestep (g C / m^2) grnd_ch4_cond_patch => ch4_inst%grnd_ch4_cond_patch , & ! Input: [real(r8) (:) ] tracer conductance for boundary layer [m/s] grnd_ch4_cond_col => ch4_inst%grnd_ch4_cond_col , & ! Output: [real(r8) (:) ] tracer conductance for boundary layer [m/s] (p2c) @@ -1724,17 +1778,19 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & conc_o2_lake => ch4_inst%conc_o2_lake_col , & ! Output: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi) ch4_dfsat_flux => ch4_inst%ch4_dfsat_flux_col , & ! Output: [real(r8) (:) ] CH4 flux to atm due to decreasing finundated (kg C/m^2/s) [+] zwt_ch4_unsat => ch4_inst%zwt_ch4_unsat_col , & ! Output: [real(r8) (:) ] depth of water table for unsaturated fraction (m) - totcolch4 => ch4_inst%totcolch4_col , & ! Output: [real(r8) (:) ] total methane in soil column (g C / m^2) + totcolch4_col => ch4_inst%totcolch4_col , & ! Output: [real(r8) (:) ] column-level total methane in soil column (g C / m^2) + totcolch4_grc => ch4_inst%totcolch4_grc , & ! Output: [real(r8) (:) ] gridcell-level total methane in soil column (g C / m^2) finundated => ch4_inst%finundated_col , & ! Output: [real(r8) (:) ] fractional inundated area in soil column (excluding dedicated wetland columns) finundated_pre_snow => ch4_inst%finundated_pre_snow_col , & ! Output: [real(r8) (:) ] fractional inundated area in soil column (excluding dedicated wetland columns) before snow - ch4_first_time => ch4_inst%ch4_first_time_col , & ! Output: [logical (:) ] whether this is the first time step that includes ch4 + ch4_first_time_col => ch4_inst%ch4_first_time_col , & ! Output: [logical (:) ] col whether this is the first time step that includes ch4 qflx_surf_lag => ch4_inst%qflx_surf_lag_col , & ! Output: [real(r8) (:) ] time-lagged surface runoff (mm H2O /s) finundated_lag => ch4_inst%finundated_lag_col , & ! Output: [real(r8) (:) ] time-lagged fractional inundated area layer_sat_lag => ch4_inst%layer_sat_lag_col , & ! Output: [real(r8) (:,:) ] Lagged saturation status of soil layer in the unsaturated zone (1 = sat) c_atm => ch4_inst%c_atm_grc , & ! Output: [real(r8) (:,:) ] CH4, O2, CO2 atmospheric conc (mol/m3) ch4co2f => ch4_inst%ch4co2f_grc , & ! Output: [real(r8) (:) ] gridcell CO2 production from CH4 oxidation (g C/m**2/s) ch4prodg => ch4_inst%ch4prodg_grc , & ! Output: [real(r8) (:) ] gridcell average CH4 production (g C/m^2/s) - ch4_surf_flux_tot => ch4_inst%ch4_surf_flux_tot_col , & ! Output: [real(r8) (:) ] col CH4 flux to atm. (kg C/m**2/s) + ch4_surf_flux_tot_col => ch4_inst%ch4_surf_flux_tot_col , & ! Output: [real(r8) (:) ] col CH4 flux to atm. (kg C/m**2/s) + ch4_surf_flux_tot_grc => ch4_inst%ch4_surf_flux_tot_grc , & ! Output: [real(r8) (:) ] grc CH4 flux to atm. (kg C/m**2/s) nem_grc => lnd2atm_inst%nem_grc , & ! Output: [real(r8) (:) ] gridcell average net methane correction to CO2 flux (g C/m^2/s) @@ -1762,7 +1818,7 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & jwt(begc:endc) = huge(1) ! Initialize local fluxes to zero: necessary for columns outside the filters because averaging up to gridcell will be done - ch4_surf_flux_tot(begc:endc) = 0._r8 + ch4_surf_flux_tot_col(begc:endc) = 0._r8 ch4_prod_tot(begc:endc) = 0._r8 ch4_oxid_tot(begc:endc) = 0._r8 rootfraction(begp:endp,:) = spval @@ -1770,6 +1826,10 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & ! Adjustment to NEE for methane production - oxidation nem_col(begc:endc) = 0._r8 + ! Initialize to zero for columns outside the filters because will + ! average up to gridcell + totcolch4_col(begc:endc) = 0._r8 + do g= begg, endg if (ch4offline) then forc_pch4(g) = atmch4*forc_pbot(g) @@ -1848,7 +1908,7 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & ch4_dfsat_flux(c) = 0._r8 end if - if (.not. ch4_first_time(c)) then + if (.not. ch4_first_time_col(c)) then if (finundated(c) > fsat_bef(c)) then !Reduce conc_ch4_sat dfsat = finundated(c) - fsat_bef(c) conc_ch4_sat(c,j) = (fsat_bef(c)*conc_ch4_sat(c,j) + dfsat*conc_ch4_unsat(c,j)) / finundated(c) @@ -2060,7 +2120,7 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & if (j == 1) then totalsat = ch4_surf_diff_sat(c) + ch4_surf_aere_sat(c) + ch4_surf_ebul_sat(c) totalunsat = ch4_surf_diff_unsat(c) + ch4_surf_aere_unsat(c) + ch4_surf_ebul_unsat(c) - ch4_surf_flux_tot(c) = (finundated(c)*totalsat + (1._r8 - finundated(c))*totalunsat) * & + ch4_surf_flux_tot_col(c) = (finundated(c)*totalsat + (1._r8 - finundated(c))*totalunsat) * & catomw / 1000._r8 !Convert from mol to kg C ! ch4_oxid_tot and ch4_prod_tot are initialized to zero above @@ -2086,7 +2146,7 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & do fc = 1, num_soilc c = filter_soilc(fc) - ch4_surf_flux_tot(c) = ch4_surf_flux_tot(c) + ch4_dfsat_flux(c) + ch4_surf_flux_tot_col(c) = ch4_surf_flux_tot_col(c) + ch4_dfsat_flux(c) end do if (allowlakeprod) then @@ -2097,7 +2157,7 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & if (j == 1) then ! ch4_oxid_tot and ch4_prod_tot are initialized to zero above totalsat = ch4_surf_diff_sat(c) + ch4_surf_aere_sat(c) + ch4_surf_ebul_sat(c) - ch4_surf_flux_tot(c) = totalsat*catomw / 1000._r8 + ch4_surf_flux_tot_col(c) = totalsat*catomw / 1000._r8 end if ch4_oxid_tot(c) = ch4_oxid_tot(c) + ch4_oxid_depth_sat(c,j)*dz(c,j)*catomw @@ -2144,27 +2204,29 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & ! Finalize CH4 balance and check for errors call ch4_totcolch4(bounds, num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - ch4_inst, totcolch4(bounds%begc:bounds%endc)) + ch4_inst, totcolch4_col(bounds%begc:bounds%endc)) + + ! Column level balance do fc = 1, num_soilc c = filter_soilc(fc) - if (.not. ch4_first_time(c)) then + if (.not. ch4_first_time_col(c)) then ! Check balance - errch4 = totcolch4(c) - totcolch4_bef(c) & + errch4 = totcolch4_col(c) - totcolch4_bef_col(c) & - dtime*(ch4_prod_tot(c) - ch4_oxid_tot(c) & - - ch4_surf_flux_tot(c)*1000._r8) ! kg C --> g C + - ch4_surf_flux_tot_col(c)*1000._r8) ! kg C --> g C if (abs(errch4) > 1.e-7_r8) then ! g C / m^2 / timestep - write(iulog,*)'CH4 Conservation Error in CH4Mod driver, nstep, c, errch4 (gC /m^2.timestep)', & + write(iulog,*)'Column-level CH4 Conservation Error in CH4Mod driver, nstep, c, errch4 (gC /m^2.timestep)', & nstep,c,errch4 g = col%gridcell(c) write(iulog,*)'Latdeg,Londeg,col%itype=',grc%latdeg(g),grc%londeg(g),col%itype(c) - write(iulog,*)'totcolch4 = ', totcolch4(c) - write(iulog,*)'totcolch4_bef = ', totcolch4_bef(c) + write(iulog,*)'totcolch4_col = ', totcolch4_col(c) + write(iulog,*)'totcolch4_bef_col = ', totcolch4_bef_col(c) write(iulog,*)'dtime*ch4_prod_tot = ', dtime*ch4_prod_tot(c) write(iulog,*)'dtime*ch4_oxid_tot = ', dtime*ch4_oxid_tot(c) write(iulog,*)'dtime*ch4_surf_flux_tot*1000 = ', dtime*& - ch4_surf_flux_tot(c)*1000._r8 + ch4_surf_flux_tot_col(c)*1000._r8 call endrun(msg=' ERROR: Methane conservation error'//errMsg(sourcefile, __LINE__)) end if end if @@ -2174,22 +2236,22 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & do fc = 1, num_lakec c = filter_lakec(fc) - if (.not. ch4_first_time(c)) then + if (.not. ch4_first_time_col(c)) then ! Check balance - errch4 = totcolch4(c) - totcolch4_bef(c) & + errch4 = totcolch4_col(c) - totcolch4_bef_col(c) & - dtime*(ch4_prod_tot(c) - ch4_oxid_tot(c) & - - ch4_surf_flux_tot(c)*1000._r8) ! kg C --> g C + - ch4_surf_flux_tot_col(c)*1000._r8) ! kg C --> g C if (abs(errch4) > 1.e-7_r8) then ! g C / m^2 / timestep - write(iulog,*)'CH4 Conservation Error in CH4Mod driver for lake column, nstep, c, errch4 (gC/m^2.timestep)', & + write(iulog,*)'Column-level CH4 Conservation Error in CH4Mod driver for lake column, nstep, c, errch4 (gC/m^2.timestep)', & nstep,c,errch4 g = col%gridcell(c) write(iulog,*)'Latdeg,Londeg=',grc%latdeg(g),grc%londeg(g) - write(iulog,*)'totcolch4 = ', totcolch4(c) - write(iulog,*)'totcolch4_bef = ', totcolch4_bef(c) + write(iulog,*)'totcolch4_col = ', totcolch4_col(c) + write(iulog,*)'totcolch4_bef_col = ', totcolch4_bef_col(c) write(iulog,*)'dtime*ch4_prod_tot = ', dtime*ch4_prod_tot(c) write(iulog,*)'dtime*ch4_oxid_tot = ', dtime*ch4_oxid_tot(c) write(iulog,*)'dtime*ch4_surf_flux_tot*1000 = ', dtime*& - ch4_surf_flux_tot(c)*1000._r8 + ch4_surf_flux_tot_col(c)*1000._r8 call endrun(msg=' ERROR: Methane conservation error, allowlakeprod'//& errMsg(sourcefile, __LINE__)) end if @@ -2198,7 +2260,7 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & end do end if - ! Now average up to gridcell for fluxes + ! Now average up to gridcell for fluxes and totcolch4 call c2g( bounds, & ch4_oxid_tot(begc:endc), ch4co2f(begg:endg), & c2l_scale_type= 'unity', l2g_scale_type='unity' ) @@ -2211,7 +2273,35 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & nem_col(begc:endc), nem_grc(begg:endg), & c2l_scale_type= 'unity', l2g_scale_type='unity' ) - ch4_first_time(begc:endc) = .false. + call c2g( bounds, & + ch4_surf_flux_tot_col(begc:endc), ch4_surf_flux_tot_grc(begg:endg), & + c2l_scale_type= 'unity', l2g_scale_type='unity' ) + + call c2g( bounds, & + ch4_inst%totcolch4_col(begc:endc), & + ch4_inst%totcolch4_grc(begg:endg), & + c2l_scale_type= 'unity', l2g_scale_type='unity' ) + + ! Gricell level balance + + do g = begg, endg + ! Check balance + errch4 = totcolch4_grc(g) - totcolch4_bef_grc(g) + dtime * & + (nem_grc(g) + ch4_surf_flux_tot_grc(g) * 1000._r8) ! kg C --> g C + + if (abs(errch4) > 1.e-7_r8) then ! g C / m^2 / timestep + write(iulog,*)'Gridcell-level CH4 Conservation Error in CH4Mod driver, nstep, g, errch4 (gC /m^2.timestep)', & + nstep, g, errch4 + write(iulog,*)'latdeg, londeg =', grc%latdeg(g), grc%londeg(g) + write(iulog,*)'totcolch4_grc =', totcolch4_grc(g) + write(iulog,*)'totcolch4_bef_grc =', totcolch4_bef_grc(g) + write(iulog,*)'dtime * nem_grc =', dtime * nem_grc(g) + write(iulog,*)'dtime * ch4_surf_flux_tot * 1000 =', dtime * ch4_surf_flux_tot_grc(g) * 1000._r8 + call endrun(msg=' ERROR: Methane conservation error'//errMsg(sourcefile, __LINE__)) + end if + end do + + ch4_first_time_col(begc:endc) = .false. end associate diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 92c2372a52..4c117abc35 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -58,7 +58,7 @@ module clm_driver use SoilBiogeochemVerticalProfileMod , only : SoilBiogeochemVerticalProfile use SatellitePhenologyMod , only : SatellitePhenology, interpMonthlyVeg use ndepStreamMod , only : ndep_interp - use ch4Mod , only : ch4, ch4_init_balance_check + use ch4Mod , only : ch4, ch4_init_gridcell_balance_check, ch4_init_column_balance_check use DUSTMod , only : DustDryDep, DustEmission use VOCEmissionMod , only : VOCEmission ! @@ -318,6 +318,12 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro c14_soilbiogeochem_carbonstate_inst, & soilbiogeochem_nitrogenstate_inst) end if + if (use_lch4) then + call ch4_init_gridcell_balance_check(bounds_clump, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_lakec, filter(nc)%lakec, & + ch4_inst) + end if call t_stopf('begcnbal_grc') end do @@ -397,7 +403,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro end if if (use_lch4) then - call ch4_init_balance_check(bounds_clump, & + call ch4_init_column_balance_check(bounds_clump, & filter(nc)%num_nolakec, filter(nc)%nolakec, & filter(nc)%num_lakec, filter(nc)%lakec, & ch4_inst) From 89ee7368f99fbd5136459b36cb91d1022b4607a2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 26 May 2020 13:36:30 -0600 Subject: [PATCH 325/556] Start work on build_ctsm script At this point, it parses arguments and fills out the machine template files, then stops. --- build_ctsm | 17 + .../config_machines_template.xml | 10 +- python/ctsm/build_ctsm.py | 355 ++++++++++++++++++ python/ctsm/test/test_build_ctsm.py | 101 +++++ 4 files changed, 481 insertions(+), 2 deletions(-) create mode 100755 build_ctsm create mode 100644 python/ctsm/build_ctsm.py create mode 100644 python/ctsm/test/test_build_ctsm.py diff --git a/build_ctsm b/build_ctsm new file mode 100755 index 0000000000..04c184c355 --- /dev/null +++ b/build_ctsm @@ -0,0 +1,17 @@ +#!/usr/bin/env python +"""Script to build CTSM library and its dependencies using cime's build system""" + +import os +import sys + +_CTSM_PYTHON = os.path.join(os.path.dirname(os.path.abspath(__file__)), 'python') +sys.path.insert(1, _CTSM_PYTHON) + +from ctsm.path_utils import add_cime_lib_to_path + +cime_path = add_cime_lib_to_path() + +from ctsm.build_ctsm import main + +if __name__ == "__main__": + main(cime_path=cime_path) diff --git a/lilac_config/build_templates/config_machines_template.xml b/lilac_config/build_templates/config_machines_template.xml index d1b2ea5354..fd99561e06 100644 --- a/lilac_config/build_templates/config_machines_template.xml +++ b/lilac_config/build_templates/config_machines_template.xml @@ -25,8 +25,14 @@ $COMPILER - $MPILIB + first is default, mpi-serial is assumed and not required in + this list. + + It appears that the particular value is not important here: all + that matters is that we're self-consistent. (See + https://github.com/ESMCI/cime/issues/3537) + --> + mpich diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py new file mode 100644 index 0000000000..43c9ed1f7d --- /dev/null +++ b/python/ctsm/build_ctsm.py @@ -0,0 +1,355 @@ +"""Functions implementing build_ctsm command""" + +import argparse +import logging +import sys +import os +import string + +from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args +from ctsm.path_utils import path_to_ctsm_root + +logger = logging.getLogger(__name__) + +_MACHINE_CONFIG_DIRNAME = 'machine_configuration' +_INPUTDATA_DIRNAME = 'inputdata' +_GPTL_NANOTIMERS_CPPDEFS = '-DHAVE_NANOTIME -DBIT64 -DHAVE_VPRINTF -DHAVE_BACKTRACE -DHAVE_SLASHPROC -DHAVE_COMM_F2C -DHAVE_TIMES -DHAVE_GETTIMEOFDAY' # pylint: disable=line-too-long + +# ======================================================================== +# Public functions +# ======================================================================== + +def main(cime_path): + """Main function called when build_ctsm is run from the command-line + + Args: + cime_path (str): path to the cime that we're using (this is passed in explicitly + rather than relying on calling path_to_cime so that we can be absolutely sure that + the scripts called here are coming from the same cime as the cime library we're + using). + """ + setup_logging_pre_config() + args = _commandline_args() + process_logging_args(args) + + if not args.rebuild: + build_ctsm(cime_path=cime_path, + build_dir=args.build_dir, + os_type=args.os, + compiler=args.compiler, + netcdf_path=args.netcdf_path, + esmf_lib_path=args.esmf_lib_path, + gmake=args.gmake, + gmake_j=args.gmake_j, + pnetcdf_path=args.pnetcdf_path, + pio_filesystem_hints=args.pio_filesystem_hints, + gptl_nano_timers=args.gptl_nano_timers, + extra_fflags=args.extra_fflags, + extra_cflags=args.extra_cflags) + +def build_ctsm(cime_path, + build_dir, + os_type, + compiler, + netcdf_path, + esmf_lib_path, + gmake, + gmake_j, + pnetcdf_path=None, + pio_filesystem_hints=None, + gptl_nano_timers=False, + extra_fflags='', + extra_cflags=''): + """Implementation of build_ctsm command + + Args: + cime_path (str): path to root of cime + build_dir (str): path to build directory + os_type (str): operating system type; one of linux, aix, darwin or cnl + compiler (str): compiler type + netcdf_path (str): path to NetCDF installation + esmf_lib_path (str): path to ESMF library directory + gmake (str): name of GNU make tool + gmake_j (int): number of threads to use when building + pnetcdf_path (str): path to PNetCDF installation, if present (or None) + pio_filesystem_hints (str): if present (not None), enable filesystem hints for the + given filesystem type + gptl_nano_timers (bool): if True, enable timers in build of the GPTL timing library + extra_fflags (str): any extra flags to include when compiling Fortran files + extra_cflags (str): any extra flags to include when compiling C files + """ + + os_type = _check_and_transform_os(os_type) + _create_build_dir(build_dir) + _fill_out_machine_files(build_dir=build_dir, + os_type=os_type, + compiler=compiler, + netcdf_path=netcdf_path, + esmf_lib_path=esmf_lib_path, + gmake=gmake, + gmake_j=gmake_j, + pnetcdf_path=pnetcdf_path, + pio_filesystem_hints=pio_filesystem_hints, + gptl_nano_timers=gptl_nano_timers, + extra_fflags=extra_fflags, + extra_cflags=extra_cflags) + +# ======================================================================== +# Private functions +# ======================================================================== + +def _commandline_args(args_to_parse=None): + """Parse and return command-line arguments + + Args: + args_to_parse: list of strings or None: Generally only used for unit testing; if None, + reads args from sys.argv + """ + + description = """ +Script to build CTSM library and its dependencies + +Typical usage: + + For a fresh build: + + build_ctsm /path/to/nonexistent/directory --os OS --compiler COMPILER --netcdf-path NETCDF_PATH --esmf-lib-path ESMF_LIB_PATH + + (Other optional arguments are also allowed in this usage.) + + For rebuilding: + + build_ctsm /path/to/existing/directory --rebuild + + (No other arguments are allowed in this usage.) +""" + + parser = argparse.ArgumentParser( + description=description, + formatter_class=argparse.RawTextHelpFormatter) + + parser.add_argument('build_dir', + help='Path to build directory\n' + 'If --rebuild is given, this should be the path to an existing build,\n' + 'otherwise this directory must not already exist.') + + parser.add_argument('--rebuild', action='store_true', + help='Rebuild in an existing build directory\n' + 'If given, none of the build-related optional arguments should be given.\n') + + non_rebuild_required = parser.add_argument_group( + title='required arguments without --rebuild; not allowed with --rebuild') + non_rebuild_required_list = [] + + non_rebuild_required.add_argument('--os', type=str.lower, + choices=['linux', 'aix', 'darwin', 'cnl'], + help='Operating system type') + non_rebuild_required_list.append('os') + + # For now, only support the compilers that we regularly test with, even though cime + # supports many other options + non_rebuild_required.add_argument('--compiler', type=str.lower, + choices=['gnu', 'intel', 'nag', 'pgi'], + help='Compiler type') + non_rebuild_required_list.append('compiler') + + non_rebuild_required.add_argument('--netcdf-path', + help='Path to NetCDF installation\n' + '(path to top-level directory, containing subdirectories\n' + 'named lib, include, etc.)') + non_rebuild_required_list.append('netcdf-path') + + non_rebuild_required.add_argument('--esmf-lib-path', + help='Path to ESMF library directory\n' + 'This directory should include an esmf.mk file') + non_rebuild_required_list.append('esmf-lib-path') + + non_rebuild_optional = parser.add_argument_group( + title='optional arguments without --rebuild; not allowed with --rebuild') + non_rebuild_optional_list = [] + + non_rebuild_optional.add_argument('--gmake', default='gmake', + help='Name of GNU Make tool on your system\n' + 'Default: gmake') + non_rebuild_optional_list.append('gmake') + + non_rebuild_optional.add_argument('--gmake-j', default=8, type=int, + help='Number of threads to use when building\n' + 'Default: 8') + non_rebuild_optional_list.append('gmake-j') + + non_rebuild_optional.add_argument('--pnetcdf-path', + help='Path to PNetCDF installation, if present\n') + non_rebuild_optional_list.append('pnetcdf-path') + + non_rebuild_optional.add_argument('--pio-filesystem-hints', type=str.lower, + choices=['gpfs', 'lustre'], + help='Enable filesystem hints for the given filesystem type\n' + 'when building the Parallel IO library') + non_rebuild_optional_list.append('pio-filesystem-hints') + + non_rebuild_optional.add_argument('--gptl-nano-timers', action='store_true', + help='Enable nano timers in build of the GPTL timing library') + non_rebuild_optional_list.append('gptl-nano-timers') + + non_rebuild_optional.add_argument('--extra-fflags', default='', + help='Any extra, non-standard flags to include\n' + 'when compiling Fortran files\n' + 'Tip: to allow a dash at the start of these flags,\n' + 'use a quoted string with an initial space, as in:\n' + ' --extra-fflags " -flag1 -flag2"') + non_rebuild_optional_list.append('extra-fflags') + + non_rebuild_optional.add_argument('--extra-cflags', default='', + help='Any extra, non-standard flags to include\n' + 'when compiling C files\n' + 'Tip: to allow a dash at the start of these flags,\n' + 'use a quoted string with an initial space, as in:\n' + ' --extra-cflags " -flag1 -flag2"') + non_rebuild_optional_list.append('extra-cflags') + + add_logging_args(parser) + + args = parser.parse_args(args_to_parse) + if args.rebuild: + _check_args_rebuild(parser, args, non_rebuild_required_list+non_rebuild_optional_list) + else: + _check_args_non_rebuild(parser, args, non_rebuild_required_list) + + return args + +def _check_args_rebuild(parser, args, args_not_allowed_in_rebuild): + """Checks if any arguments not allowed with --rebuild are set + + Calls parser.error if there are problems + + Args: + parser: ArgumentParser + args: list of parsed arguments + args_not_allowed_in_rebuild: list of strings - argument names in this category + """ + for arg in args_not_allowed_in_rebuild: + arg_no_dashes = arg.replace('-', '_') + # To determine whether the user specified an argument, we look at whether it's + # value differs from its default value. This won't catch the case where the user + # explicitly set an argument to its default value, but it's not a big deal if we + # miss printing an error in that case. + if vars(args)[arg_no_dashes] != parser.get_default(arg_no_dashes): + parser.error('--{} cannot be provided if --rebuild is set'.format(arg)) + +def _check_args_non_rebuild(parser, args, non_rebuild_required_list): + """Checks if any arguments required without --rebuild are absent + + Calls parser.error if there are problems + + Args: + parser: ArgumentParser + args: list of parsed arguments + non_rebuild_required_list: list of strings - argument names in this category + """ + for arg in non_rebuild_required_list: + arg_no_dashes = arg.replace('-', '_') + if vars(args)[arg_no_dashes] is None: + parser.error('--{} must be provided if --rebuild is not set'.format(arg)) + +def _check_and_transform_os(os_type): + """Check validity of os_type argument and transform it to proper case + + os_type should be a lowercase string; returns a transformed string + """ + transforms = {'linux': 'LINUX', + 'aix': 'AIX', + 'darwin': 'Darwin', + 'cnl': 'CNL'} + try: + os_type_transformed = transforms[os_type] + except KeyError: + raise ValueError("Unknown OS: {}".format(os_type)) + return os_type_transformed + +def _create_build_dir(build_dir): + """Create the given build directory and any necessary sub-directories + + Args: + build_dir (str): path to build directory; this directory shouldn't exist yet! + """ + if os.path.exists(build_dir): + sys.exit('ERROR: When running without --rebuild, the build directory must not exist yet\n' + '(<{}> already exists)'.format(build_dir)) + os.makedirs(build_dir) + os.makedirs(os.path.join(build_dir, _INPUTDATA_DIRNAME)) + os.makedirs(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME)) + +def _fill_out_machine_files(build_dir, + os_type, + compiler, + netcdf_path, + esmf_lib_path, + gmake, + gmake_j, + pnetcdf_path=None, + pio_filesystem_hints=None, + gptl_nano_timers=False, + extra_fflags='', + extra_cflags=''): + """Fill out the machine porting templates for this machine / compiler + + For documentation of args, see the documentation in the build_ctsm function + """ + path_to_templates = os.path.join(path_to_ctsm_root(), + 'lilac_config', + 'build_templates') + + # ------------------------------------------------------------------------ + # Fill in config_machines.xml + # ------------------------------------------------------------------------ + + with open(os.path.join(path_to_templates, 'config_machines_template.xml')) as cm_template_file: + cm_template_file_contents = cm_template_file.read() + config_machines_template = string.Template(cm_template_file_contents) + config_machines = config_machines_template.substitute( + OS=os_type, + COMPILER=compiler, + CIME_OUTPUT_ROOT=build_dir, + GMAKE=gmake, + GMAKE_J=gmake_j) + with open(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME, 'config_machines.xml'), + 'w') as cm_file: + cm_file.write(config_machines) + + # ------------------------------------------------------------------------ + # Fill in config_compilers.xml + # ------------------------------------------------------------------------ + + if gptl_nano_timers: + gptl_cppdefs = _GPTL_NANOTIMERS_CPPDEFS + else: + gptl_cppdefs = '' + + if pio_filesystem_hints: + pio_filesystem_hints_tag = '{}'.format( + pio_filesystem_hints) + else: + pio_filesystem_hints_tag = '' + + if pnetcdf_path: + pnetcdf_path_tag = '{}'.format( + pnetcdf_path) + else: + pnetcdf_path_tag = '' + + with open(os.path.join(path_to_templates, 'config_compilers_template.xml')) as cc_template_file: + cc_template_file_contents = cc_template_file.read() + config_compilers_template = string.Template(cc_template_file_contents) + config_compilers = config_compilers_template.substitute( + COMPILER=compiler, + GPTL_CPPDEFS=gptl_cppdefs, + NETCDF_PATH=netcdf_path, + PIO_FILESYSTEM_HINTS=pio_filesystem_hints_tag, + PNETCDF_PATH=pnetcdf_path_tag, + ESMF_LIBDIR=esmf_lib_path, + EXTRA_CFLAGS=extra_cflags, + EXTRA_FFLAGS=extra_fflags) + with open(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME, 'config_compilers.xml'), + 'w') as cc_file: + cc_file.write(config_compilers) diff --git a/python/ctsm/test/test_build_ctsm.py b/python/ctsm/test/test_build_ctsm.py new file mode 100644 index 0000000000..ccd1ea678e --- /dev/null +++ b/python/ctsm/test/test_build_ctsm.py @@ -0,0 +1,101 @@ +#!/usr/bin/env python + +"""Unit tests for build_ctsm +""" + +import unittest +from unittest.mock import patch +from io import StringIO + +from ctsm import unit_testing +from ctsm.build_ctsm import _commandline_args, _check_and_transform_os + +# Allow names that pylint doesn't like, because otherwise I find it hard +# to make readable unit test names +# pylint: disable=invalid-name + +class TestBuildCtsm(unittest.TestCase): + """Tests of build_ctsm""" + + def test_commandlineArgs_rebuild_valid(self): + """Test _commandline_args with --rebuild, with a valid argument list (no disallowed args)""" + # pylint: disable=no-self-use + _ = _commandline_args(args_to_parse=['build/directory', '--rebuild']) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_rebuild_invalid1(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is invalid with this option + + This tests an argument that is required for non-rebuilds, without a dash + """ + expected_re = r"--compiler cannot be provided if --rebuild is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--rebuild', + '--compiler', 'intel']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_rebuild_invalid2(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is invalid with this option + + This tests an argument that is required for non-rebuilds, with a dash + """ + expected_re = r"--netcdf-path cannot be provided if --rebuild is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--rebuild', + '--netcdf-path', '/path/to/netcdf']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_rebuild_invalid3(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is invalid with this option + + This tests an argument that is optional for non-rebuilds, which also has a default + that isn't None + """ + expected_re = r"--gmake cannot be provided if --rebuild is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--rebuild', + '--gmake', 'mymake']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + def test_commandlineArgs_noRebuild_valid(self): + """Test _commandline_args without --rebuild, with a valid argument list + + (all required things present) + """ + # pylint: disable=no-self-use + _ = _commandline_args(args_to_parse=['build/directory', + '--os', 'linux', + '--compiler', 'intel', + '--netcdf-path', '/path/to/netcdf', + '--esmf-lib-path', '/path/to/esmf/lib']) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_noRebuild_invalid(self, mock_stderr): + """Test _commandline_args without --rebuild, with a missing required argument""" + expected_re = r"--compiler must be provided if --rebuild is not set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--os', 'linux', + '--netcdf-path', '/path/to/netcdf', + '--esmf-lib-path', '/path/to/esmf/lib']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + + def test_checkAndTransformOs_valid(self): + """Test _check_and_transform_os with valid input""" + os = _check_and_transform_os('linux') + self.assertEqual(os, 'LINUX') + + def test_checkAndTransformOs_invalid(self): + """Test _check_and_transform_os with invalid input""" + with self.assertRaises(ValueError): + _ = _check_and_transform_os('bad_os') + +if __name__ == '__main__': + unit_testing.setup_for_tests() + unittest.main() From 1b13d4246a5e39a01b76168f5d1ac9b2d64cb8e2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 26 May 2020 13:51:32 -0600 Subject: [PATCH 326/556] Give an error message for now if try to specify --rebuild --- python/ctsm/build_ctsm.py | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 43c9ed1f7d..4b4b657111 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -32,7 +32,9 @@ def main(cime_path): args = _commandline_args() process_logging_args(args) - if not args.rebuild: + if args.rebuild: + sys.exit('ERROR: --rebuild not yet implemented') + else: build_ctsm(cime_path=cime_path, build_dir=args.build_dir, os_type=args.os, From 551ba268a5f527893dff29afa857feb46448a90e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 26 May 2020 16:35:24 -0600 Subject: [PATCH 327/556] Make LILAC_MODE an xml variable rather than an environment variable This will be helpful for the lilac build script. I have not yet tested this thoroughly! --- README.lilac | 4 ++-- cime_config/buildlib | 11 +---------- cime_config/config_component.xml | 9 +++++++++ 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/README.lilac b/README.lilac index c94debf68d..7f8a36c200 100644 --- a/README.lilac +++ b/README.lilac @@ -8,10 +8,9 @@ I. Building a CTSM / LILAC library for inclusion in an atmosphere model > git checkout lilac_cap > ./manage_externals/checkout_externals -v -2) set the following environment variables (***LILAC_MODE IS CRITICAL to have the lilac code built as part of ctsm) +2) set the following environment variables SRCROOT is where ctsm is checked out - > export LILAC_MODE='on' > export SRCROOT=`pwd` > export CASEDIR=/glade/scratch/$USER/test_lilac @@ -20,6 +19,7 @@ I. Building a CTSM / LILAC library for inclusion in an atmosphere model > cd $SRCROOT/cime/scripts > ./create_newcase --case $CASEDIR --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver nuopc > cd $CASEDIR + > ./xmlchange LILAC_MODE=on > ./xmlchange DEBUG=TRUE > ./case.setup > ./case.build --sharedlib-only diff --git a/cime_config/buildlib b/cime_config/buildlib index 32dbd2feda..9b6656166f 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -20,15 +20,6 @@ from CIME.utils import run_cmd, expect logger = logging.getLogger(__name__) -############################################################################### -def _get_osvar(key, default): -############################################################################### - if key in os.environ: - value = os.environ[key] - else: - value = default - return value - ############################################################################### def _write_ctsm_mk(exeroot, libroot, machine): """Writes a ctsm.mk file in exeroot. @@ -110,8 +101,8 @@ def _main_func(): gmake_j = case.get_value("GMAKE_J") gmake = case.get_value("GMAKE") driver = case.get_value("COMP_INTERFACE").lower() + lilac_mode = case.get_value("LILAC_MODE") - lilac_mode = _get_osvar('LILAC_MODE', 'off') if lilac_mode == 'on': driver = "lilac" machine = case.get_value('MACH') diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 388fcd88ee..545c17d9c4 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -46,6 +46,15 @@ Name of land component + + char + on,off + off + build_component_clm + env_build.xml + Flag to enable building the LILAC cap and coupling code + + char run_component_clm From 68a16708953aaa8f2379f6761008953a7cc3a143 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 27 May 2020 15:03:54 -0600 Subject: [PATCH 328/556] Work on build script This isn't yet fully working, but it's close --- .../config_machines_template.xml | 10 +++- python/ctsm/build_ctsm.py | 55 ++++++++++++++++++- python/ctsm/machine_utils.py | 13 ----- python/ctsm/os_utils.py | 40 ++++++++++++++ python/ctsm/run_sys_tests.py | 3 +- 5 files changed, 105 insertions(+), 16 deletions(-) create mode 100644 python/ctsm/os_utils.py diff --git a/lilac_config/build_templates/config_machines_template.xml b/lilac_config/build_templates/config_machines_template.xml index fd99561e06..114d1a419d 100644 --- a/lilac_config/build_templates/config_machines_template.xml +++ b/lilac_config/build_templates/config_machines_template.xml @@ -45,7 +45,7 @@ - $$CIME_OUTPUT_ROOT/inputdata_clmforc + $$CIME_OUTPUT_ROOT/inputdata + + $$CIME_OUTPUT_ROOT/bld + diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 4b4b657111..13c59e47d9 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -2,15 +2,29 @@ import argparse import logging -import sys import os import string +import subprocess +import sys from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args +from ctsm.os_utils import run_cmd_output_on_error from ctsm.path_utils import path_to_ctsm_root logger = logging.getLogger(__name__) +# ======================================================================== +# Define some constants +# ======================================================================== + +# this matches the machine name in config_machines_template.xml +_MACH_NAME = 'ctsm_build' + +# these are arbitrary, since we only use the case for its build, not any of the runtime +# settings; they just need to be valid +_COMPSET = 'I2000Ctsm50NwpSpNldasRsGs' +_RES = 'nldas2_rnldas2_mnldas2' + _MACHINE_CONFIG_DIRNAME = 'machine_configuration' _INPUTDATA_DIRNAME = 'inputdata' _GPTL_NANOTIMERS_CPPDEFS = '-DHAVE_NANOTIME -DBIT64 -DHAVE_VPRINTF -DHAVE_BACKTRACE -DHAVE_SLASHPROC -DHAVE_COMM_F2C -DHAVE_TIMES -DHAVE_GETTIMEOFDAY' # pylint: disable=line-too-long @@ -95,6 +109,8 @@ def build_ctsm(cime_path, gptl_nano_timers=gptl_nano_timers, extra_fflags=extra_fflags, extra_cflags=extra_cflags) + _create_and_build_case(cime_path=cime_path, + build_dir=build_dir) # ======================================================================== # Private functions @@ -355,3 +371,40 @@ def _fill_out_machine_files(build_dir, with open(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME, 'config_compilers.xml'), 'w') as cc_file: cc_file.write(config_compilers) + +def _create_and_build_case(cime_path, build_dir): + """Create a case and build the CTSM library and its dependencies + + Args: + cime_path (str): path to root of cime + build_dir (str): path to build directory + """ + casedir = os.path.join(build_dir, 'case') + + # Note that, for some commands, we want to suppress output, only showing the output if + # the command fails; for these we use run_cmd_output_on_error. For other commands, we + # want to always show output (or there should be no output in general); for these, we + # directly use subprocess.check_call or similar. + + run_cmd_output_on_error( + ['create_newcase', + '--case', casedir, + '--compset', _COMPSET, + '--res', _RES, + '--machine', _MACH_NAME, + '--driver', 'nuopc', + '--extra-machines-dir', os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME), + '--run-unsupported'], + errmsg='Problem creating CTSM case directory', + cwd=os.path.join(cime_path, 'scripts')) + + run_cmd_output_on_error(['case.setup'], + errmsg='Problem setting up CTSM case directory', + cwd=casedir) + + subprocess.check_call(['xmlchange', 'LILAC_MODE=on'], cwd=casedir) + + try: + subprocess.check_call(['case.build'], cwd=casedir) + except subprocess.CalledProcessError: + sys.exit('ERROR building CTSM or its dependencies - see above for details') diff --git a/python/ctsm/machine_utils.py b/python/ctsm/machine_utils.py index 78f6ea85bf..41459ce3de 100644 --- a/python/ctsm/machine_utils.py +++ b/python/ctsm/machine_utils.py @@ -6,7 +6,6 @@ import getpass import socket import re -import os # ======================================================================== # Public functions @@ -22,18 +21,6 @@ def get_machine_name(): hostname = full_hostname.split('.')[0] return _machine_from_hostname(hostname) -def make_link(src, dst): - """Makes a link pointing to src named dst - - Does nothing if link is already set up correctly - """ - if os.path.islink(dst) and os.readlink(dst) == src: - # Link is already set up correctly: do nothing (os.symlink raises an exception if - # you try to replace an existing file) - pass - else: - os.symlink(src, dst) - # ======================================================================== # Private functions # ======================================================================== diff --git a/python/ctsm/os_utils.py b/python/ctsm/os_utils.py new file mode 100644 index 0000000000..574320e9ec --- /dev/null +++ b/python/ctsm/os_utils.py @@ -0,0 +1,40 @@ +"""Various OS-related utility functions +""" + +import os +import subprocess +import sys + +def run_cmd_output_on_error(cmd, errmsg, cwd=None): + """Run the given command; suppress output but print it if there is an error + + If there is an error running the command, print the output from the command and abort + with the given errmsg. + + Args: + cmd: list of strings - command and its arguments + errmsg: string - error message to print if the command returns an error code + cwd: string or None - path from which the command should be run + """ + try: + _ = subprocess.check_output(cmd, + stderr=subprocess.STDOUT, + universal_newlines=True, + cwd=cwd) + except subprocess.CalledProcessError as error: + print('ERROR:\n') + print(error.output) + print('') + sys.exit('ERROR: {}'.format(errmsg)) + +def make_link(src, dst): + """Makes a link pointing to src named dst + + Does nothing if link is already set up correctly + """ + if os.path.islink(dst) and os.readlink(dst) == src: + # Link is already set up correctly: do nothing (os.symlink raises an exception if + # you try to replace an existing file) + pass + else: + os.symlink(src, dst) diff --git a/python/ctsm/run_sys_tests.py b/python/ctsm/run_sys_tests.py index 7792db6918..c769817b01 100644 --- a/python/ctsm/run_sys_tests.py +++ b/python/ctsm/run_sys_tests.py @@ -8,9 +8,10 @@ from datetime import datetime from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args -from ctsm.machine_utils import get_machine_name, make_link +from ctsm.machine_utils import get_machine_name from ctsm.machine import create_machine, get_possibly_overridden_baseline_dir from ctsm.machine_defaults import MACHINE_DEFAULTS +from ctsm.os_utils import make_link from ctsm.path_utils import path_to_ctsm_root from ctsm.joblauncher.job_launcher_factory import JOB_LAUNCHER_NOBATCH From 3e887211278b82c2ff3456bc207036700735d6f8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 27 May 2020 16:31:13 -0600 Subject: [PATCH 329/556] Stop writing ctsm.mk file for now This was giving an error because ESMFMKFILE is no longer defined in the environment on bishorn. Rather than fixing it, I'm stopping writing this for now. My plan is to rework how this is written, writing it from the top-level build_ctsm script instead of from within buildlib. --- cime_config/buildlib | 3 --- 1 file changed, 3 deletions(-) diff --git a/cime_config/buildlib b/cime_config/buildlib index 9b6656166f..f19e6b55bd 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -106,9 +106,6 @@ def _main_func(): if lilac_mode == 'on': driver = "lilac" machine = case.get_value('MACH') - _write_ctsm_mk(exeroot=case.get_value("EXEROOT"), - libroot=libroot, - machine=machine) #------------------------------------------------------- # create Filepath file From 3e03968a5ccd58b28ed4fd28f02344fd9b1b8139 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 27 May 2020 16:41:32 -0600 Subject: [PATCH 330/556] Build sharedlib-only Now the build passes on bishorn, with: ./build_ctsm ~/temporary/test_lilac_bishorn_0527b --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default --- python/ctsm/build_ctsm.py | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 13c59e47d9..c6fedef3b7 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -405,6 +405,9 @@ def _create_and_build_case(cime_path, build_dir): subprocess.check_call(['xmlchange', 'LILAC_MODE=on'], cwd=casedir) try: - subprocess.check_call(['case.build'], cwd=casedir) + subprocess.check_call( + ['case.build', + '--sharedlib-only'], + cwd=casedir) except subprocess.CalledProcessError: sys.exit('ERROR building CTSM or its dependencies - see above for details') From ff50e92e6c4a1c160728505a68c2b49ebea835b1 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 27 May 2020 17:31:16 -0600 Subject: [PATCH 331/556] Replace calls to sys.exit with our own abort function This borrows from cime's "expect": it enables pdb if debugging is set --- python/ctsm/build_ctsm.py | 10 +++++----- python/ctsm/os_utils.py | 8 +++++--- python/ctsm/utils.py | 17 +++++++++++++++++ 3 files changed, 27 insertions(+), 8 deletions(-) create mode 100644 python/ctsm/utils.py diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index c6fedef3b7..0f2384a026 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -5,11 +5,11 @@ import os import string import subprocess -import sys from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args from ctsm.os_utils import run_cmd_output_on_error from ctsm.path_utils import path_to_ctsm_root +from ctsm.utils import abort logger = logging.getLogger(__name__) @@ -47,7 +47,7 @@ def main(cime_path): process_logging_args(args) if args.rebuild: - sys.exit('ERROR: --rebuild not yet implemented') + abort('ERROR: --rebuild not yet implemented') else: build_ctsm(cime_path=cime_path, build_dir=args.build_dir, @@ -292,8 +292,8 @@ def _create_build_dir(build_dir): build_dir (str): path to build directory; this directory shouldn't exist yet! """ if os.path.exists(build_dir): - sys.exit('ERROR: When running without --rebuild, the build directory must not exist yet\n' - '(<{}> already exists)'.format(build_dir)) + abort('ERROR: When running without --rebuild, the build directory must not exist yet\n' + '(<{}> already exists)'.format(build_dir)) os.makedirs(build_dir) os.makedirs(os.path.join(build_dir, _INPUTDATA_DIRNAME)) os.makedirs(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME)) @@ -410,4 +410,4 @@ def _create_and_build_case(cime_path, build_dir): '--sharedlib-only'], cwd=casedir) except subprocess.CalledProcessError: - sys.exit('ERROR building CTSM or its dependencies - see above for details') + abort('ERROR building CTSM or its dependencies - see above for details') diff --git a/python/ctsm/os_utils.py b/python/ctsm/os_utils.py index 574320e9ec..28dcbb15ad 100644 --- a/python/ctsm/os_utils.py +++ b/python/ctsm/os_utils.py @@ -3,7 +3,7 @@ import os import subprocess -import sys +from ctsm.utils import abort def run_cmd_output_on_error(cmd, errmsg, cwd=None): """Run the given command; suppress output but print it if there is an error @@ -22,10 +22,12 @@ def run_cmd_output_on_error(cmd, errmsg, cwd=None): universal_newlines=True, cwd=cwd) except subprocess.CalledProcessError as error: - print('ERROR:\n') + print('ERROR while running:') + print(' '.join(cmd)) + print('') print(error.output) print('') - sys.exit('ERROR: {}'.format(errmsg)) + abort(errmsg) def make_link(src, dst): """Makes a link pointing to src named dst diff --git a/python/ctsm/utils.py b/python/ctsm/utils.py new file mode 100644 index 0000000000..c75214f711 --- /dev/null +++ b/python/ctsm/utils.py @@ -0,0 +1,17 @@ +"""General-purpose utility functions""" + +import logging +import sys + +logger = logging.getLogger(__name__) + +def abort(errmsg): + """Abort the program with the given error message + + No traceback is given, but if the logging level is DEBUG, then we'll enter pdb + """ + if logger.isEnabledFor(logging.DEBUG): + import pdb + pdb.set_trace() + + sys.exit('ERROR: {}'.format(errmsg)) From 8e27e72076023101bf6dbf5e6d6215ff36df1d83 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 27 May 2020 17:34:41 -0600 Subject: [PATCH 332/556] Catch other errors when trying to execute a subprocess I was getting an OSError: OSError: [Errno 2] No such file or directory I want to see some additional information, so I'm catching it (and any other exceptions) and re-raising it --- python/ctsm/os_utils.py | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/python/ctsm/os_utils.py b/python/ctsm/os_utils.py index 28dcbb15ad..c51d84e003 100644 --- a/python/ctsm/os_utils.py +++ b/python/ctsm/os_utils.py @@ -28,6 +28,10 @@ def run_cmd_output_on_error(cmd, errmsg, cwd=None): print(error.output) print('') abort(errmsg) + except: + print('ERROR trying to run:') + print(' '.join(cmd)) + raise def make_link(src, dst): """Makes a link pointing to src named dst From 97976e71486e66f80010b759c24717da6d4bc445 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 27 May 2020 17:37:17 -0600 Subject: [PATCH 333/556] Also print cwd if error running cmd --- python/ctsm/os_utils.py | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/python/ctsm/os_utils.py b/python/ctsm/os_utils.py index c51d84e003..aac5680057 100644 --- a/python/ctsm/os_utils.py +++ b/python/ctsm/os_utils.py @@ -24,6 +24,8 @@ def run_cmd_output_on_error(cmd, errmsg, cwd=None): except subprocess.CalledProcessError as error: print('ERROR while running:') print(' '.join(cmd)) + if cwd is not None: + print('From {}'.format(cwd)) print('') print(error.output) print('') @@ -31,6 +33,8 @@ def run_cmd_output_on_error(cmd, errmsg, cwd=None): except: print('ERROR trying to run:') print(' '.join(cmd)) + if cwd is not None: + print('From {}'.format(cwd)) raise def make_link(src, dst): From 1eb22adfdcd5c71fef4647c28079184eab12f1a1 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 28 May 2020 11:22:10 -0600 Subject: [PATCH 334/556] Specify path to commands Now, for commands executed from the case directory, we specify the path to the case directory both in the command itself and in the cwd argument. We do the former in case dot isn't in the user's path; we do the latter in case the commands require you to be in the case directory when you execute them. --- python/ctsm/build_ctsm.py | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 0f2384a026..95c9a64ab8 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -386,8 +386,13 @@ def _create_and_build_case(cime_path, build_dir): # want to always show output (or there should be no output in general); for these, we # directly use subprocess.check_call or similar. + # Also note that, for commands executed from the case directory, we specify the path + # to the case directory both in the command itself and in the cwd argument. We do the + # former in case dot isn't in the user's path; we do the latter in case the commands + # require you to be in the case directory when you execute them. + run_cmd_output_on_error( - ['create_newcase', + [os.path.join(cime_path, 'scripts', 'create_newcase'), '--case', casedir, '--compset', _COMPSET, '--res', _RES, @@ -395,18 +400,17 @@ def _create_and_build_case(cime_path, build_dir): '--driver', 'nuopc', '--extra-machines-dir', os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME), '--run-unsupported'], - errmsg='Problem creating CTSM case directory', - cwd=os.path.join(cime_path, 'scripts')) + errmsg='Problem creating CTSM case directory') - run_cmd_output_on_error(['case.setup'], + run_cmd_output_on_error([os.path.join(casedir, 'case.setup')], errmsg='Problem setting up CTSM case directory', cwd=casedir) - subprocess.check_call(['xmlchange', 'LILAC_MODE=on'], cwd=casedir) + subprocess.check_call([os.path.join(casedir, 'xmlchange'), 'LILAC_MODE=on'], cwd=casedir) try: subprocess.check_call( - ['case.build', + [os.path.join(casedir, 'case.build'), '--sharedlib-only'], cwd=casedir) except subprocess.CalledProcessError: From 2a029ea13d14d03710d58703a3ad2a69f3e80a15 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 28 May 2020 13:31:26 -0600 Subject: [PATCH 335/556] Allow use of a predefined machine Can give the --machine argument, with the name of a machine known to cime, as an alternative to creating a machine port on the fly. --- python/ctsm/build_ctsm.py | 242 ++++++++++++++++++---------- python/ctsm/test/test_build_ctsm.py | 89 +++++++++- 2 files changed, 238 insertions(+), 93 deletions(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 95c9a64ab8..e36b62c732 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -51,8 +51,9 @@ def main(cime_path): else: build_ctsm(cime_path=cime_path, build_dir=args.build_dir, - os_type=args.os, compiler=args.compiler, + machine=args.machine, + os_type=args.os, netcdf_path=args.netcdf_path, esmf_lib_path=args.esmf_lib_path, gmake=args.gmake, @@ -65,12 +66,13 @@ def main(cime_path): def build_ctsm(cime_path, build_dir, - os_type, compiler, - netcdf_path, - esmf_lib_path, - gmake, - gmake_j, + machine=None, + os_type=None, + netcdf_path=None, + esmf_lib_path=None, + gmake=None, + gmake_j=None, pnetcdf_path=None, pio_filesystem_hints=None, gptl_nano_timers=False, @@ -81,36 +83,55 @@ def build_ctsm(cime_path, Args: cime_path (str): path to root of cime build_dir (str): path to build directory - os_type (str): operating system type; one of linux, aix, darwin or cnl compiler (str): compiler type - netcdf_path (str): path to NetCDF installation - esmf_lib_path (str): path to ESMF library directory - gmake (str): name of GNU make tool - gmake_j (int): number of threads to use when building - pnetcdf_path (str): path to PNetCDF installation, if present (or None) - pio_filesystem_hints (str): if present (not None), enable filesystem hints for the + machine (str or None): machine name (a machine known to cime) + os_type (str or None): operating system type; one of linux, aix, darwin or cnl + Must be given if machine isn't given; ignored if machine is given + netcdf_path (str or None): path to NetCDF installation + Must be given if machine isn't given; ignored if machine is given + esmf_lib_path (str or None): path to ESMF library directory + Must be given if machine isn't given; ignored if machine is given + gmake (str or None): name of GNU make tool + Ignored if machine is given + gmake_j (int or None): number of threads to use when building + Ignored if machine is given + pnetcdf_path (str or None): path to PNetCDF installation, if present (or None) + Ignored if machine is given + pio_filesystem_hints (str or None): if present (not None), enable filesystem hints for the given filesystem type + Ignored if machine is given gptl_nano_timers (bool): if True, enable timers in build of the GPTL timing library + Ignored if machine is given extra_fflags (str): any extra flags to include when compiling Fortran files + Ignored if machine is given extra_cflags (str): any extra flags to include when compiling C files + Ignored if machine is given """ - os_type = _check_and_transform_os(os_type) - _create_build_dir(build_dir) - _fill_out_machine_files(build_dir=build_dir, - os_type=os_type, - compiler=compiler, - netcdf_path=netcdf_path, - esmf_lib_path=esmf_lib_path, - gmake=gmake, - gmake_j=gmake_j, - pnetcdf_path=pnetcdf_path, - pio_filesystem_hints=pio_filesystem_hints, - gptl_nano_timers=gptl_nano_timers, - extra_fflags=extra_fflags, - extra_cflags=extra_cflags) + _create_build_dir(build_dir=build_dir, + existing_machine=(machine is not None)) + + if machine is None: + assert os_type is not None, 'with machine absent, os_type must be given' + assert netcdf_path is not None, 'with machine absent, netcdf_path must be given' + assert esmf_lib_path is not None, 'with machine absent, esmf_lib_path must be given' + os_type = _check_and_transform_os(os_type) + _fill_out_machine_files(build_dir=build_dir, + os_type=os_type, + compiler=compiler, + netcdf_path=netcdf_path, + esmf_lib_path=esmf_lib_path, + gmake=gmake, + gmake_j=gmake_j, + pnetcdf_path=pnetcdf_path, + pio_filesystem_hints=pio_filesystem_hints, + gptl_nano_timers=gptl_nano_timers, + extra_fflags=extra_fflags, + extra_cflags=extra_cflags) + _create_and_build_case(cime_path=cime_path, - build_dir=build_dir) + build_dir=build_dir, + machine=machine) # ======================================================================== # Private functions @@ -123,15 +144,23 @@ def _commandline_args(args_to_parse=None): args_to_parse: list of strings or None: Generally only used for unit testing; if None, reads args from sys.argv """ + # pylint: disable=line-too-long description = """ Script to build CTSM library and its dependencies Typical usage: - For a fresh build: + For a fresh build with a machine that has been ported to cime + (http://esmci.github.io/cime/versions/master/html/users_guide/porting-cime.html): + + build_ctsm /path/to/nonexistent/directory --machine MACHINE --compiler COMPILER + + (Some other optional arguments are also allowed in this usage, but many are not.) - build_ctsm /path/to/nonexistent/directory --os OS --compiler COMPILER --netcdf-path NETCDF_PATH --esmf-lib-path ESMF_LIB_PATH + For a fresh build with a machine that has NOT been ported to cime: + + build_ctsm /path/to/nonexistent/directory --compiler COMPILER --os OS --netcdf-path NETCDF_PATH --esmf-lib-path ESMF_LIB_PATH (Other optional arguments are also allowed in this usage.) @@ -139,7 +168,7 @@ def _commandline_args(args_to_parse=None): build_ctsm /path/to/existing/directory --rebuild - (No other arguments are allowed in this usage.) + (Most other arguments are NOT allowed in this usage.) """ parser = argparse.ArgumentParser( @@ -151,19 +180,24 @@ def _commandline_args(args_to_parse=None): 'If --rebuild is given, this should be the path to an existing build,\n' 'otherwise this directory must not already exist.') - parser.add_argument('--rebuild', action='store_true', - help='Rebuild in an existing build directory\n' - 'If given, none of the build-related optional arguments should be given.\n') + main_opts = parser.add_mutually_exclusive_group() + + main_opts.add_argument('--machine', + help='Name of machine; this must be a machine that has been ported to cime\n' + '(http://esmci.github.io/cime/versions/master/html/users_guide/porting-cime.html)\n' + 'If given, then none of the machine-definition optional arguments should be given.\n') + + main_opts.add_argument('--rebuild', action='store_true', + help='Rebuild in an existing build directory\n' + 'If given, none of the machine-definition or build-related optional arguments\n' + 'should be given.\n') non_rebuild_required = parser.add_argument_group( - title='required arguments without --rebuild; not allowed with --rebuild') + title='required arguments when not rebuilding', + description='These arguments are required if --rebuild is not given; ' + 'they are not allowed with --rebuild:') non_rebuild_required_list = [] - non_rebuild_required.add_argument('--os', type=str.lower, - choices=['linux', 'aix', 'darwin', 'cnl'], - help='Operating system type') - non_rebuild_required_list.append('os') - # For now, only support the compilers that we regularly test with, even though cime # supports many other options non_rebuild_required.add_argument('--compiler', type=str.lower, @@ -171,104 +205,127 @@ def _commandline_args(args_to_parse=None): help='Compiler type') non_rebuild_required_list.append('compiler') - non_rebuild_required.add_argument('--netcdf-path', + new_machine_required = parser.add_argument_group( + title='required arguments for a user-defined machine', + description='These arguments are required if neither --machine nor --rebuild are given; ' + 'they are not allowed with either of those arguments:') + new_machine_required_list = [] + + new_machine_required.add_argument('--os', type=str.lower, + choices=['linux', 'aix', 'darwin', 'cnl'], + help='Operating system type') + new_machine_required_list.append('os') + + new_machine_required.add_argument('--netcdf-path', help='Path to NetCDF installation\n' '(path to top-level directory, containing subdirectories\n' 'named lib, include, etc.)') - non_rebuild_required_list.append('netcdf-path') + new_machine_required_list.append('netcdf-path') - non_rebuild_required.add_argument('--esmf-lib-path', + new_machine_required.add_argument('--esmf-lib-path', help='Path to ESMF library directory\n' 'This directory should include an esmf.mk file') - non_rebuild_required_list.append('esmf-lib-path') + new_machine_required_list.append('esmf-lib-path') - non_rebuild_optional = parser.add_argument_group( - title='optional arguments without --rebuild; not allowed with --rebuild') - non_rebuild_optional_list = [] + new_machine_optional = parser.add_argument_group( + title='optional arguments for a user-defined machine', + description='These arguments are optional if neither --machine nor --rebuild are given; ' + 'they are not allowed with either of those arguments:') + new_machine_optional_list = [] - non_rebuild_optional.add_argument('--gmake', default='gmake', + new_machine_optional.add_argument('--gmake', default='gmake', help='Name of GNU Make tool on your system\n' 'Default: gmake') - non_rebuild_optional_list.append('gmake') + new_machine_optional_list.append('gmake') - non_rebuild_optional.add_argument('--gmake-j', default=8, type=int, + new_machine_optional.add_argument('--gmake-j', default=8, type=int, help='Number of threads to use when building\n' 'Default: 8') - non_rebuild_optional_list.append('gmake-j') + new_machine_optional_list.append('gmake-j') - non_rebuild_optional.add_argument('--pnetcdf-path', + new_machine_optional.add_argument('--pnetcdf-path', help='Path to PNetCDF installation, if present\n') - non_rebuild_optional_list.append('pnetcdf-path') + new_machine_optional_list.append('pnetcdf-path') - non_rebuild_optional.add_argument('--pio-filesystem-hints', type=str.lower, + new_machine_optional.add_argument('--pio-filesystem-hints', type=str.lower, choices=['gpfs', 'lustre'], help='Enable filesystem hints for the given filesystem type\n' 'when building the Parallel IO library') - non_rebuild_optional_list.append('pio-filesystem-hints') + new_machine_optional_list.append('pio-filesystem-hints') - non_rebuild_optional.add_argument('--gptl-nano-timers', action='store_true', + new_machine_optional.add_argument('--gptl-nano-timers', action='store_true', help='Enable nano timers in build of the GPTL timing library') - non_rebuild_optional_list.append('gptl-nano-timers') + new_machine_optional_list.append('gptl-nano-timers') - non_rebuild_optional.add_argument('--extra-fflags', default='', + new_machine_optional.add_argument('--extra-fflags', default='', help='Any extra, non-standard flags to include\n' 'when compiling Fortran files\n' 'Tip: to allow a dash at the start of these flags,\n' 'use a quoted string with an initial space, as in:\n' ' --extra-fflags " -flag1 -flag2"') - non_rebuild_optional_list.append('extra-fflags') + new_machine_optional_list.append('extra-fflags') - non_rebuild_optional.add_argument('--extra-cflags', default='', + new_machine_optional.add_argument('--extra-cflags', default='', help='Any extra, non-standard flags to include\n' 'when compiling C files\n' 'Tip: to allow a dash at the start of these flags,\n' 'use a quoted string with an initial space, as in:\n' ' --extra-cflags " -flag1 -flag2"') - non_rebuild_optional_list.append('extra-cflags') + new_machine_optional_list.append('extra-cflags') add_logging_args(parser) args = parser.parse_args(args_to_parse) if args.rebuild: - _check_args_rebuild(parser, args, non_rebuild_required_list+non_rebuild_optional_list) + _confirm_args_absent(parser, args, "cannot be provided if --rebuild is set", + non_rebuild_required_list + new_machine_required_list + new_machine_optional_list) else: - _check_args_non_rebuild(parser, args, non_rebuild_required_list) + _confirm_args_present(parser, args, "must be provided if --rebuild is not set", + non_rebuild_required_list) + if args.machine: + _confirm_args_absent(parser, args, "cannot be provided if --machine is set", + new_machine_required_list + new_machine_optional_list) + else: + _confirm_args_present(parser, args, "must be provided if neither --machine nor --rebuild are set", + new_machine_required_list) return args -def _check_args_rebuild(parser, args, args_not_allowed_in_rebuild): - """Checks if any arguments not allowed with --rebuild are set +def _confirm_args_absent(parser, args, errmsg, args_not_allowed): + """Confirms that all args not allowed in this usage are absent Calls parser.error if there are problems Args: parser: ArgumentParser args: list of parsed arguments - args_not_allowed_in_rebuild: list of strings - argument names in this category + errmsg: string - message printed if there is a problem + args_not_allowed: list of strings - argument names in this category """ - for arg in args_not_allowed_in_rebuild: + for arg in args_not_allowed: arg_no_dashes = arg.replace('-', '_') # To determine whether the user specified an argument, we look at whether it's # value differs from its default value. This won't catch the case where the user # explicitly set an argument to its default value, but it's not a big deal if we # miss printing an error in that case. if vars(args)[arg_no_dashes] != parser.get_default(arg_no_dashes): - parser.error('--{} cannot be provided if --rebuild is set'.format(arg)) + parser.error('--{} {}'.format(arg, errmsg)) -def _check_args_non_rebuild(parser, args, non_rebuild_required_list): - """Checks if any arguments required without --rebuild are absent +def _confirm_args_present(parser, args, errmsg, args_required): + """Confirms that all args required in this usage are present Calls parser.error if there are problems Args: parser: ArgumentParser args: list of parsed arguments - non_rebuild_required_list: list of strings - argument names in this category + errmsg: string - message printed if there is a problem + args_required: list of strings - argument names in this category """ - for arg in non_rebuild_required_list: + for arg in args_required: arg_no_dashes = arg.replace('-', '_') if vars(args)[arg_no_dashes] is None: - parser.error('--{} must be provided if --rebuild is not set'.format(arg)) + parser.error('--{} {}'.format(arg, errmsg)) def _check_and_transform_os(os_type): """Check validity of os_type argument and transform it to proper case @@ -285,18 +342,20 @@ def _check_and_transform_os(os_type): raise ValueError("Unknown OS: {}".format(os_type)) return os_type_transformed -def _create_build_dir(build_dir): +def _create_build_dir(build_dir, existing_machine): """Create the given build directory and any necessary sub-directories Args: build_dir (str): path to build directory; this directory shouldn't exist yet! + existing_machine (bool): whether this build is for a machine known to cime + (as opposed to an on-the-fly machine port) """ if os.path.exists(build_dir): abort('ERROR: When running without --rebuild, the build directory must not exist yet\n' '(<{}> already exists)'.format(build_dir)) os.makedirs(build_dir) - os.makedirs(os.path.join(build_dir, _INPUTDATA_DIRNAME)) - os.makedirs(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME)) + if not existing_machine: + os.makedirs(os.path.join(build_dir, _INPUTDATA_DIRNAME)) def _fill_out_machine_files(build_dir, os_type, @@ -317,6 +376,7 @@ def _fill_out_machine_files(build_dir, path_to_templates = os.path.join(path_to_ctsm_root(), 'lilac_config', 'build_templates') + os.makedirs(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME)) # ------------------------------------------------------------------------ # Fill in config_machines.xml @@ -372,12 +432,15 @@ def _fill_out_machine_files(build_dir, 'w') as cc_file: cc_file.write(config_compilers) -def _create_and_build_case(cime_path, build_dir): +def _create_and_build_case(cime_path, build_dir, machine=None): """Create a case and build the CTSM library and its dependencies Args: cime_path (str): path to root of cime build_dir (str): path to build directory + machine (str or None): name of machine or None + If None, we assume we're using an on-the-fly machine port + Otherwise, machine should be the name of a machine known to cime """ casedir = os.path.join(build_dir, 'case') @@ -391,16 +454,21 @@ def _create_and_build_case(cime_path, build_dir): # former in case dot isn't in the user's path; we do the latter in case the commands # require you to be in the case directory when you execute them. - run_cmd_output_on_error( - [os.path.join(cime_path, 'scripts', 'create_newcase'), - '--case', casedir, - '--compset', _COMPSET, - '--res', _RES, - '--machine', _MACH_NAME, - '--driver', 'nuopc', - '--extra-machines-dir', os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME), - '--run-unsupported'], - errmsg='Problem creating CTSM case directory') + if machine is None: + machine_args = ['--machine', _MACH_NAME, + '--extra-machines-dir', os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME)] + else: + machine_args = ['--machine', machine] + + create_newcase_cmd = [os.path.join(cime_path, 'scripts', 'create_newcase'), + '--case', casedir, + '--compset', _COMPSET, + '--res', _RES, + '--driver', 'nuopc', + '--run-unsupported'] + create_newcase_cmd.extend(machine_args) + run_cmd_output_on_error(create_newcase_cmd, + errmsg='Problem creating CTSM case directory') run_cmd_output_on_error([os.path.join(casedir, 'case.setup')], errmsg='Problem setting up CTSM case directory', diff --git a/python/ctsm/test/test_build_ctsm.py b/python/ctsm/test/test_build_ctsm.py index ccd1ea678e..f30bd03fbf 100644 --- a/python/ctsm/test/test_build_ctsm.py +++ b/python/ctsm/test/test_build_ctsm.py @@ -39,7 +39,20 @@ def test_commandlineArgs_rebuild_invalid1(self, mock_stderr): def test_commandlineArgs_rebuild_invalid2(self, mock_stderr): """Test _commandline_args with --rebuild, with an argument that is invalid with this option - This tests an argument that is required for non-rebuilds, with a dash + This tests an argument that is required for new machines, without a dash + """ + expected_re = r"--os cannot be provided if --rebuild is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--rebuild', + '--os', 'linux']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_rebuild_invalid3(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is invalid with this option + + This tests an argument that is required for new machines, with a dash """ expected_re = r"--netcdf-path cannot be provided if --rebuild is set" with self.assertRaises(SystemExit): @@ -49,10 +62,10 @@ def test_commandlineArgs_rebuild_invalid2(self, mock_stderr): self.assertRegex(mock_stderr.getvalue(), expected_re) @patch('sys.stderr', new_callable=StringIO) - def test_commandlineArgs_rebuild_invalid3(self, mock_stderr): + def test_commandlineArgs_rebuild_invalid4(self, mock_stderr): """Test _commandline_args with --rebuild, with an argument that is invalid with this option - This tests an argument that is optional for non-rebuilds, which also has a default + This tests an argument that is optional for new machines, which also has a default that isn't None """ expected_re = r"--gmake cannot be provided if --rebuild is set" @@ -63,7 +76,7 @@ def test_commandlineArgs_rebuild_invalid3(self, mock_stderr): self.assertRegex(mock_stderr.getvalue(), expected_re) def test_commandlineArgs_noRebuild_valid(self): - """Test _commandline_args without --rebuild, with a valid argument list + """Test _commandline_args without --rebuild or --machine, with a valid argument list (all required things present) """ @@ -75,8 +88,11 @@ def test_commandlineArgs_noRebuild_valid(self): '--esmf-lib-path', '/path/to/esmf/lib']) @patch('sys.stderr', new_callable=StringIO) - def test_commandlineArgs_noRebuild_invalid(self, mock_stderr): - """Test _commandline_args without --rebuild, with a missing required argument""" + def test_commandlineArgs_noRebuild_invalid1(self, mock_stderr): + """Test _commandline_args without --rebuild or --machine, with a missing required argument + + This tests an argument in the non-rebuild-required list + """ expected_re = r"--compiler must be provided if --rebuild is not set" with self.assertRaises(SystemExit): _ = _commandline_args(args_to_parse=['build/directory', @@ -85,6 +101,67 @@ def test_commandlineArgs_noRebuild_invalid(self, mock_stderr): '--esmf-lib-path', '/path/to/esmf/lib']) self.assertRegex(mock_stderr.getvalue(), expected_re) + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_noRebuild_invalid2(self, mock_stderr): + """Test _commandline_args without --rebuild or --machine, with a missing required argument + + This tests an argument in the new-machine-required list + """ + expected_re = r"--os must be provided if neither --machine nor --rebuild are set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--compiler', 'intel', + '--netcdf-path', '/path/to/netcdf', + '--esmf-lib-path', '/path/to/esmf/lib']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + def test_commandlineArgs_machine_valid(self): + """Test _commandline_args with --machine, with a valid argument list + + (all required things present) + """ + # pylint: disable=no-self-use + _ = _commandline_args(args_to_parse=['build/directory', + '--machine', 'mymachine', + '--compiler', 'intel']) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_machine_missingRequired(self, mock_stderr): + """Test _commandline_args with --machine, with a missing required argument + """ + expected_re = r"--compiler must be provided if --rebuild is not set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--machine', 'mymachine']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_machine_illegalArg1(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is illegal with this option + + This tests an argument that is required for new machines + """ + expected_re = r"--os cannot be provided if --machine is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--machine', 'mymachine', + '--compiler', 'intel', + '--os', 'linux']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_machine_illegalArg2(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is illegal with this option + + This tests an argument that is optional for new machines + """ + expected_re = r"--gmake cannot be provided if --machine is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--machine', 'mymachine', + '--compiler', 'intel', + '--gmake', 'mymake']) + self.assertRegex(mock_stderr.getvalue(), expected_re) def test_checkAndTransformOs_valid(self): """Test _check_and_transform_os with valid input""" From 1ca7debd01df815eccfd0bce729441473677823e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 28 May 2020 13:36:06 -0600 Subject: [PATCH 336/556] Put the bld directory back under the case I'm going to use a symlink instead, for consistency between the user-defined machine and a predefined machine --- lilac_config/build_templates/config_machines_template.xml | 8 -------- 1 file changed, 8 deletions(-) diff --git a/lilac_config/build_templates/config_machines_template.xml b/lilac_config/build_templates/config_machines_template.xml index 114d1a419d..e6e102fa53 100644 --- a/lilac_config/build_templates/config_machines_template.xml +++ b/lilac_config/build_templates/config_machines_template.xml @@ -113,13 +113,5 @@ --> - - $$CIME_OUTPUT_ROOT/bld - From 82b5db089f1855b8de5c470ebce09bb1b41c4e62 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 28 May 2020 13:46:17 -0600 Subject: [PATCH 337/556] Add a --skip-build argument This is useful for testing (manual testing for now, but I think it will also be useful for automated testing). It could also be useful for experts - so you can change some things in between the set up of the directories and the actual build. --- python/ctsm/build_ctsm.py | 38 +++++++++++++++++++++-------- python/ctsm/test/test_build_ctsm.py | 14 +++++++++++ 2 files changed, 42 insertions(+), 10 deletions(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index e36b62c732..d9398e6221 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -52,6 +52,7 @@ def main(cime_path): build_ctsm(cime_path=cime_path, build_dir=args.build_dir, compiler=args.compiler, + skip_build=args.skip_build, machine=args.machine, os_type=args.os, netcdf_path=args.netcdf_path, @@ -67,6 +68,7 @@ def main(cime_path): def build_ctsm(cime_path, build_dir, compiler, + skip_build=False, machine=None, os_type=None, netcdf_path=None, @@ -84,6 +86,7 @@ def build_ctsm(cime_path, cime_path (str): path to root of cime build_dir (str): path to build directory compiler (str): compiler type + skip_build (bool): If True, set things up, but skip doing the actual build machine (str or None): machine name (a machine known to cime) os_type (str or None): operating system type; one of linux, aix, darwin or cnl Must be given if machine isn't given; ignored if machine is given @@ -131,7 +134,8 @@ def build_ctsm(cime_path, _create_and_build_case(cime_path=cime_path, build_dir=build_dir, - machine=machine) + machine=machine, + skip_build=skip_build) # ======================================================================== # Private functions @@ -205,6 +209,17 @@ def _commandline_args(args_to_parse=None): help='Compiler type') non_rebuild_required_list.append('compiler') + non_rebuild_optional = parser.add_argument_group( + title='optional arguments when not rebuilding', + description='These arguments are optional if --rebuild is not given; ' + 'they are not allowed with --rebuild:') + non_rebuild_optional_list = [] + + non_rebuild_optional.add_argument('--skip-build', action='store_true', + help='Do the pre-build setup, but do not actually build CTSM\n' + '(This is useful for testing, or for expert use.)') + non_rebuild_optional_list.append('skip-build') + new_machine_required = parser.add_argument_group( title='required arguments for a user-defined machine', description='These arguments are required if neither --machine nor --rebuild are given; ' @@ -278,7 +293,8 @@ def _commandline_args(args_to_parse=None): args = parser.parse_args(args_to_parse) if args.rebuild: _confirm_args_absent(parser, args, "cannot be provided if --rebuild is set", - non_rebuild_required_list + new_machine_required_list + new_machine_optional_list) + (non_rebuild_required_list + non_rebuild_optional_list + + new_machine_required_list + new_machine_optional_list)) else: _confirm_args_present(parser, args, "must be provided if --rebuild is not set", non_rebuild_required_list) @@ -432,7 +448,7 @@ def _fill_out_machine_files(build_dir, 'w') as cc_file: cc_file.write(config_compilers) -def _create_and_build_case(cime_path, build_dir, machine=None): +def _create_and_build_case(cime_path, build_dir, machine=None, skip_build=False): """Create a case and build the CTSM library and its dependencies Args: @@ -441,6 +457,7 @@ def _create_and_build_case(cime_path, build_dir, machine=None): machine (str or None): name of machine or None If None, we assume we're using an on-the-fly machine port Otherwise, machine should be the name of a machine known to cime + skip_build (bool): If True, set things up, but skip doing the actual build """ casedir = os.path.join(build_dir, 'case') @@ -476,10 +493,11 @@ def _create_and_build_case(cime_path, build_dir, machine=None): subprocess.check_call([os.path.join(casedir, 'xmlchange'), 'LILAC_MODE=on'], cwd=casedir) - try: - subprocess.check_call( - [os.path.join(casedir, 'case.build'), - '--sharedlib-only'], - cwd=casedir) - except subprocess.CalledProcessError: - abort('ERROR building CTSM or its dependencies - see above for details') + if not skip_build: + try: + subprocess.check_call( + [os.path.join(casedir, 'case.build'), + '--sharedlib-only'], + cwd=casedir) + except subprocess.CalledProcessError: + abort('ERROR building CTSM or its dependencies - see above for details') diff --git a/python/ctsm/test/test_build_ctsm.py b/python/ctsm/test/test_build_ctsm.py index f30bd03fbf..9ec08349bf 100644 --- a/python/ctsm/test/test_build_ctsm.py +++ b/python/ctsm/test/test_build_ctsm.py @@ -65,6 +65,20 @@ def test_commandlineArgs_rebuild_invalid3(self, mock_stderr): def test_commandlineArgs_rebuild_invalid4(self, mock_stderr): """Test _commandline_args with --rebuild, with an argument that is invalid with this option + This tests an argument that is optional for new non-rebuild + that isn't None + """ + expected_re = r"--skip-build cannot be provided if --rebuild is set" + with self.assertRaises(SystemExit): + _ = _commandline_args(args_to_parse=['build/directory', + '--rebuild', + '--skip-build']) + self.assertRegex(mock_stderr.getvalue(), expected_re) + + @patch('sys.stderr', new_callable=StringIO) + def test_commandlineArgs_rebuild_invalid5(self, mock_stderr): + """Test _commandline_args with --rebuild, with an argument that is invalid with this option + This tests an argument that is optional for new machines, which also has a default that isn't None """ From b29ab308b7c13c989319495f9d56b125e8b3cd54 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 28 May 2020 13:50:47 -0600 Subject: [PATCH 338/556] Make a sym link to the bld directory at the top level --- python/ctsm/build_ctsm.py | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index d9398e6221..0af77b482a 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -7,7 +7,7 @@ import subprocess from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args -from ctsm.os_utils import run_cmd_output_on_error +from ctsm.os_utils import run_cmd_output_on_error, make_link from ctsm.path_utils import path_to_ctsm_root from ctsm.utils import abort @@ -47,7 +47,7 @@ def main(cime_path): process_logging_args(args) if args.rebuild: - abort('ERROR: --rebuild not yet implemented') + abort('--rebuild not yet implemented') else: build_ctsm(cime_path=cime_path, build_dir=args.build_dir, @@ -367,7 +367,7 @@ def _create_build_dir(build_dir, existing_machine): (as opposed to an on-the-fly machine port) """ if os.path.exists(build_dir): - abort('ERROR: When running without --rebuild, the build directory must not exist yet\n' + abort('When running without --rebuild, the build directory must not exist yet\n' '(<{}> already exists)'.format(build_dir)) os.makedirs(build_dir) if not existing_machine: @@ -493,6 +493,9 @@ def _create_and_build_case(cime_path, build_dir, machine=None, skip_build=False) subprocess.check_call([os.path.join(casedir, 'xmlchange'), 'LILAC_MODE=on'], cwd=casedir) + make_link(os.path.join(casedir, 'bld'), + os.path.join(build_dir, 'bld')) + if not skip_build: try: subprocess.check_call( From 5d22d66e8d275bb0d16854768e8a2791104a18a9 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 28 May 2020 15:33:47 -0600 Subject: [PATCH 339/556] Use abspath for build_dir --- python/ctsm/build_ctsm.py | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 0af77b482a..8064ec89d9 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -45,12 +45,13 @@ def main(cime_path): setup_logging_pre_config() args = _commandline_args() process_logging_args(args) + build_dir = os.path.abspath(args.build_dir) if args.rebuild: abort('--rebuild not yet implemented') else: build_ctsm(cime_path=cime_path, - build_dir=args.build_dir, + build_dir=build_dir, compiler=args.compiler, skip_build=args.skip_build, machine=args.machine, From 0806364a47d20f67ed0ed059bdbe0dea21582c03 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 28 May 2020 15:38:42 -0600 Subject: [PATCH 340/556] Fixes for predefined machine --- python/ctsm/build_ctsm.py | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 8064ec89d9..290afa41c8 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -135,6 +135,7 @@ def build_ctsm(cime_path, _create_and_build_case(cime_path=cime_path, build_dir=build_dir, + compiler=compiler, machine=machine, skip_build=skip_build) @@ -449,12 +450,13 @@ def _fill_out_machine_files(build_dir, 'w') as cc_file: cc_file.write(config_compilers) -def _create_and_build_case(cime_path, build_dir, machine=None, skip_build=False): +def _create_and_build_case(cime_path, build_dir, compiler, machine=None, skip_build=False): """Create a case and build the CTSM library and its dependencies Args: cime_path (str): path to root of cime build_dir (str): path to build directory + compiler (str): compiler to use machine (str or None): name of machine or None If None, we assume we're using an on-the-fly machine port Otherwise, machine should be the name of a machine known to cime @@ -479,9 +481,11 @@ def _create_and_build_case(cime_path, build_dir, machine=None, skip_build=False) machine_args = ['--machine', machine] create_newcase_cmd = [os.path.join(cime_path, 'scripts', 'create_newcase'), + '--output-root', build_dir, '--case', casedir, '--compset', _COMPSET, '--res', _RES, + '--compiler', compiler, '--driver', 'nuopc', '--run-unsupported'] create_newcase_cmd.extend(machine_args) From a3c4f46d911e3a072a523aca57f32cad695951e7 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 28 May 2020 15:51:29 -0600 Subject: [PATCH 341/556] Make links to .env_mach_specific files with more intuitive names --- python/ctsm/build_ctsm.py | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 290afa41c8..165eabcc77 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -500,6 +500,12 @@ def _create_and_build_case(cime_path, build_dir, compiler, machine=None, skip_bu make_link(os.path.join(casedir, 'bld'), os.path.join(build_dir, 'bld')) + if machine is not None: + # For a pre-existing machine, the .env_mach_specific files are likely useful to + # the user. Make sym links to these with more intuitive names. + for extension in ('sh', 'csh'): + make_link(os.path.join(casedir, '.env_mach_specific.{}'.format(extension)), + os.path.join(build_dir, 'ctsm_build_environment.{}'.format(extension))) if not skip_build: try: From be2c78d7e966ffe8b32c9dc1443af2d866f119a9 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 28 May 2020 15:53:32 -0600 Subject: [PATCH 342/556] Rename --skip-build to --no-build --- python/ctsm/build_ctsm.py | 18 +++++++++--------- python/ctsm/test/test_build_ctsm.py | 4 ++-- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 165eabcc77..47ef2d32f6 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -53,7 +53,7 @@ def main(cime_path): build_ctsm(cime_path=cime_path, build_dir=build_dir, compiler=args.compiler, - skip_build=args.skip_build, + no_build=args.no_build, machine=args.machine, os_type=args.os, netcdf_path=args.netcdf_path, @@ -69,7 +69,7 @@ def main(cime_path): def build_ctsm(cime_path, build_dir, compiler, - skip_build=False, + no_build=False, machine=None, os_type=None, netcdf_path=None, @@ -87,7 +87,7 @@ def build_ctsm(cime_path, cime_path (str): path to root of cime build_dir (str): path to build directory compiler (str): compiler type - skip_build (bool): If True, set things up, but skip doing the actual build + no_build (bool): If True, set things up, but skip doing the actual build machine (str or None): machine name (a machine known to cime) os_type (str or None): operating system type; one of linux, aix, darwin or cnl Must be given if machine isn't given; ignored if machine is given @@ -137,7 +137,7 @@ def build_ctsm(cime_path, build_dir=build_dir, compiler=compiler, machine=machine, - skip_build=skip_build) + no_build=no_build) # ======================================================================== # Private functions @@ -217,10 +217,10 @@ def _commandline_args(args_to_parse=None): 'they are not allowed with --rebuild:') non_rebuild_optional_list = [] - non_rebuild_optional.add_argument('--skip-build', action='store_true', + non_rebuild_optional.add_argument('--no-build', action='store_true', help='Do the pre-build setup, but do not actually build CTSM\n' '(This is useful for testing, or for expert use.)') - non_rebuild_optional_list.append('skip-build') + non_rebuild_optional_list.append('no-build') new_machine_required = parser.add_argument_group( title='required arguments for a user-defined machine', @@ -450,7 +450,7 @@ def _fill_out_machine_files(build_dir, 'w') as cc_file: cc_file.write(config_compilers) -def _create_and_build_case(cime_path, build_dir, compiler, machine=None, skip_build=False): +def _create_and_build_case(cime_path, build_dir, compiler, machine=None, no_build=False): """Create a case and build the CTSM library and its dependencies Args: @@ -460,7 +460,7 @@ def _create_and_build_case(cime_path, build_dir, compiler, machine=None, skip_bu machine (str or None): name of machine or None If None, we assume we're using an on-the-fly machine port Otherwise, machine should be the name of a machine known to cime - skip_build (bool): If True, set things up, but skip doing the actual build + no_build (bool): If True, set things up, but skip doing the actual build """ casedir = os.path.join(build_dir, 'case') @@ -507,7 +507,7 @@ def _create_and_build_case(cime_path, build_dir, compiler, machine=None, skip_bu make_link(os.path.join(casedir, '.env_mach_specific.{}'.format(extension)), os.path.join(build_dir, 'ctsm_build_environment.{}'.format(extension))) - if not skip_build: + if not no_build: try: subprocess.check_call( [os.path.join(casedir, 'case.build'), diff --git a/python/ctsm/test/test_build_ctsm.py b/python/ctsm/test/test_build_ctsm.py index 9ec08349bf..24f00ab358 100644 --- a/python/ctsm/test/test_build_ctsm.py +++ b/python/ctsm/test/test_build_ctsm.py @@ -68,11 +68,11 @@ def test_commandlineArgs_rebuild_invalid4(self, mock_stderr): This tests an argument that is optional for new non-rebuild that isn't None """ - expected_re = r"--skip-build cannot be provided if --rebuild is set" + expected_re = r"--no-build cannot be provided if --rebuild is set" with self.assertRaises(SystemExit): _ = _commandline_args(args_to_parse=['build/directory', '--rebuild', - '--skip-build']) + '--no-build']) self.assertRegex(mock_stderr.getvalue(), expected_re) @patch('sys.stderr', new_callable=StringIO) From 33e459ba5a9c204f99c8f5c127c69f927654c5c7 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 28 May 2020 16:48:46 -0600 Subject: [PATCH 343/556] Allow running unit & system tests separately --- python/Makefile | 17 +++++++++---- python/README.md | 19 ++++++++++---- python/ctsm/run_ctsm_py_tests.py | 25 ++++++++++++++++--- ....py => test_unit_job_launcher_no_batch.py} | 0 ..._build_ctsm.py => test_unit_build_ctsm.py} | 0 .../{test_machine.py => test_unit_machine.py} | 0 ..._path_utils.py => test_unit_path_utils.py} | 0 ...ys_tests.py => test_unit_run_sys_tests.py} | 0 8 files changed, 47 insertions(+), 14 deletions(-) rename python/ctsm/test/joblauncher/{test_job_launcher_no_batch.py => test_unit_job_launcher_no_batch.py} (100%) rename python/ctsm/test/{test_build_ctsm.py => test_unit_build_ctsm.py} (100%) rename python/ctsm/test/{test_machine.py => test_unit_machine.py} (100%) rename python/ctsm/test/{test_path_utils.py => test_unit_path_utils.py} (100%) rename python/ctsm/test/{test_run_sys_tests.py => test_unit_run_sys_tests.py} (100%) diff --git a/python/Makefile b/python/Makefile index e4e39d2b5b..470d32b9d4 100644 --- a/python/Makefile +++ b/python/Makefile @@ -6,9 +6,9 @@ verbose = not-set debug = not-set ifneq ($(python), not-set) -PYTHON=$(python) + PYTHON=$(python) else -PYTHON=python + PYTHON=python endif ifneq ($(debug), not-set) @@ -23,9 +23,16 @@ PYLINT_ARGS=-j 4 --rcfile=ctsm/.pylintrc PYLINT_SRC = \ ctsm -.PHONY: test -test: FORCE - $(PYTHON) ./run_ctsm_py_tests $(TEST_ARGS) +all: test lint +test: utest stest + +.PHONY: utest +utest: FORCE + $(PYTHON) ./run_ctsm_py_tests $(TEST_ARGS) --unit + +.PHONY: stest +stest: FORCE + $(PYTHON) ./run_ctsm_py_tests $(TEST_ARGS) --sys .PHONY: lint lint: FORCE diff --git a/python/README.md b/python/README.md index 8b265d3290..c1cd00e4aa 100644 --- a/python/README.md +++ b/python/README.md @@ -1,9 +1,14 @@ # Testing the code here -## Unit tests +## Running everything -Unit tests can be run in one of two ways; these do the same thing, but -support different options: +To run all tests (unit tests, system tests and pylint), simply run `make +all` from this directory. + +## Unit and system tests + +Unit and system tests can be run in one of two ways; these do the same +thing, but support different options: 1. via `make test` @@ -12,12 +17,16 @@ support different options: - python version: `make python=python3 test` - verbose: `make verbose=true test` - debug: `make debug=true test` - + + Note that unit tests and system tests can be run separately with + `make utest` or `make stest`, or they can all be run with `make + test`. + 2. via `./run_ctsm_py_tests` You can specify various arguments to this; run `./run_ctsm_py_tests -h` for details - + ## pylint You can run pylint on everything in the ctsm package with `make lint`. diff --git a/python/ctsm/run_ctsm_py_tests.py b/python/ctsm/run_ctsm_py_tests.py index 469940581a..f0171a1940 100644 --- a/python/ctsm/run_ctsm_py_tests.py +++ b/python/ctsm/run_ctsm_py_tests.py @@ -21,6 +21,15 @@ def main(description): args = _commandline_args(description) verbosity = _get_verbosity_level(args) + if args.pattern is not None: + pattern = args.pattern + elif args.unit: + pattern = 'test_unit*.py' + elif args.sys: + pattern = 'test_sys*.py' + else: + pattern = 'test*.py' + # This setup_for_tests call is the main motivation for having this wrapper script to # run the tests rather than just using 'python -m unittest discover' unit_testing.setup_for_tests(enable_critical_logs=args.debug) @@ -28,7 +37,7 @@ def main(description): mydir = os.path.dirname(os.path.abspath(__file__)) testsuite = unittest.defaultTestLoader.discover( start_dir=mydir, - pattern=args.pattern) + pattern=pattern) # NOTE(wjs, 2018-08-29) We may want to change the meaning of '--debug' # vs. '--verbose': I could imagine having --verbose set buffer=False, and --debug # additionally sets the logging level to much higher - e.g., debug level. @@ -51,9 +60,17 @@ def _commandline_args(description): output_level.add_argument('-d', '--debug', action='store_true', help='Run tests with even more verbosity') - parser.add_argument('-p', '--pattern', default='test*.py', - help='File name pattern to match\n' - 'Default is test*.py') + test_subset = parser.add_mutually_exclusive_group() + + test_subset.add_argument('-u', '--unit', action='store_true', + help='Only run unit tests') + + test_subset.add_argument('-s', '--sys', action='store_true', + help='Only run system tests') + + test_subset.add_argument('-p', '--pattern', + help='File name pattern to match\n' + 'Default is test*.py') args = parser.parse_args() diff --git a/python/ctsm/test/joblauncher/test_job_launcher_no_batch.py b/python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py similarity index 100% rename from python/ctsm/test/joblauncher/test_job_launcher_no_batch.py rename to python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py diff --git a/python/ctsm/test/test_build_ctsm.py b/python/ctsm/test/test_unit_build_ctsm.py similarity index 100% rename from python/ctsm/test/test_build_ctsm.py rename to python/ctsm/test/test_unit_build_ctsm.py diff --git a/python/ctsm/test/test_machine.py b/python/ctsm/test/test_unit_machine.py similarity index 100% rename from python/ctsm/test/test_machine.py rename to python/ctsm/test/test_unit_machine.py diff --git a/python/ctsm/test/test_path_utils.py b/python/ctsm/test/test_unit_path_utils.py similarity index 100% rename from python/ctsm/test/test_path_utils.py rename to python/ctsm/test/test_unit_path_utils.py diff --git a/python/ctsm/test/test_run_sys_tests.py b/python/ctsm/test/test_unit_run_sys_tests.py similarity index 100% rename from python/ctsm/test/test_run_sys_tests.py rename to python/ctsm/test/test_unit_run_sys_tests.py From a9ac792fe6a88b9413a9a72c92c8d113218b37f1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 29 May 2020 00:12:47 -0600 Subject: [PATCH 344/556] Start moving CNFireMethodMod to a more generic FireMethodType that could be used for FATES --- src/biogeochem/CNDriverMod.F90 | 10 ++-- src/biogeochem/CNFireBaseMod.F90 | 24 ++++---- src/biogeochem/CNFireFactoryMod.F90 | 12 ++-- src/biogeochem/CNFireLi2014Mod.F90 | 2 +- src/biogeochem/CNFireLi2016Mod.F90 | 2 +- src/biogeochem/CNFireNoFireMod.F90 | 2 +- src/biogeochem/CNVegetationFacade.F90 | 6 +- .../FireMethodType.F90} | 57 ++++++++++--------- 8 files changed, 58 insertions(+), 57 deletions(-) rename src/{biogeochem/CNFireMethodMod.F90 => main/FireMethodType.F90} (87%) diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index aee1e804e7..f9f4b4532c 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -64,17 +64,17 @@ subroutine CNDriverInit(bounds, NLFilename, cnfire_method) ! !USES: use CNSharedParamsMod , only : use_fun use CNPhenologyMod , only : CNPhenologyInit - use CNFireMethodMod , only : cnfire_method_type + use FireMethodType , only : fire_method_type use SoilBiogeochemCompetitionMod, only : SoilBiogeochemCompetitionInit ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds character(len=*) , intent(in) :: NLFilename ! Namelist filename - class(cnfire_method_type) , intent(inout) :: cnfire_method + class(fire_method_type) , intent(inout) :: cnfire_method !----------------------------------------------------------------------- call SoilBiogeochemCompetitionInit(bounds) call CNPhenologyInit(bounds) - call cnfire_method%CNFireInit(bounds, NLFilename) + call cnfire_method%FireInit(bounds, NLFilename) end subroutine CNDriverInit @@ -114,7 +114,7 @@ subroutine CNDriverNoLeaching(bounds, use CNFUNMod , only: CNFUNInit !, CNFUN use CNPhenologyMod , only: CNPhenology use CNGRespMod , only: CNGResp - use CNFireMethodMod , only: cnfire_method_type + use FireMethodType , only: fire_method_type use CNCIsoFluxMod , only: CIsoFlux1, CIsoFlux2, CIsoFlux2h, CIsoFlux3 use CNC14DecayMod , only: C14Decay use CNCStateUpdate1Mod , only: CStateUpdate1,CStateUpdate0 @@ -185,7 +185,7 @@ subroutine CNDriverNoLeaching(bounds, type(saturated_excess_runoff_type) , intent(in) :: saturated_excess_runoff_inst type(energyflux_type) , intent(in) :: energyflux_inst class(nutrient_competition_method_type) , intent(inout) :: nutrient_competition_method - class(cnfire_method_type) , intent(inout) :: cnfire_method + class(fire_method_type) , intent(inout) :: cnfire_method logical , intent(in) :: dribble_crophrv_xsmrpool_2atm ! ! !LOCAL VARIABLES: diff --git a/src/biogeochem/CNFireBaseMod.F90 b/src/biogeochem/CNFireBaseMod.F90 index bb4f6612cf..d0641c7145 100644 --- a/src/biogeochem/CNFireBaseMod.F90 +++ b/src/biogeochem/CNFireBaseMod.F90 @@ -42,7 +42,7 @@ module CNFireBaseMod use ColumnType , only : col use PatchType , only : patch use mct_mod - use CNFireMethodMod , only : cnfire_method_type + use FireMethodType , only : fire_method_type ! implicit none private @@ -74,7 +74,7 @@ module CNFireBaseMod end type ! - type, abstract, extends(cnfire_method_type) :: cnfire_base_type + type, abstract, extends(fire_method_type) :: cnfire_base_type private ! !PRIVATE MEMBER DATA: @@ -88,9 +88,9 @@ module CNFireBaseMod contains ! ! !PUBLIC MEMBER FUNCTIONS: - procedure, public :: CNFireInit ! Initialization of CNFire - procedure, public :: CNFireReadNML ! Read in namelist for CNFire - procedure, public :: CNFireInterp ! Interpolate fire data + procedure, public :: FireInit ! Initialization of CNFire + procedure, public :: FireReadNML ! Read in namelist for CNFire + procedure, public :: FireInterp ! Interpolate fire data procedure, public :: CNFireArea ! Calculate fire area procedure, public :: CNFireFluxes ! Calculate fire fluxes procedure(need_lightning_and_popdens_interface), public, deferred :: & @@ -129,7 +129,7 @@ end function need_lightning_and_popdens_interface contains !----------------------------------------------------------------------- - subroutine CNFireInit( this, bounds, NLFilename ) + subroutine FireInit( this, bounds, NLFilename ) ! ! !DESCRIPTION: ! Initialize CN Fire module @@ -156,10 +156,10 @@ subroutine CNFireInit( this, bounds, NLFilename ) call this%lnfm_interp(bounds) end if - end subroutine CNFireInit + end subroutine FireInit !----------------------------------------------------------------------- - subroutine CNFireReadNML( this, NLFilename ) + subroutine FireReadNML( this, NLFilename ) ! ! !DESCRIPTION: ! Read the namelist for CNFire @@ -179,7 +179,7 @@ subroutine CNFireReadNML( this, NLFilename ) integer :: ierr ! error code integer :: unitn ! unit for namelist file - character(len=*), parameter :: subname = 'CNFireReadNML' + character(len=*), parameter :: subname = 'FireReadNML' character(len=*), parameter :: nmlname = 'lifire_inparm' !----------------------------------------------------------------------- real(r8) :: cli_scale, boreal_peatfire_c, pot_hmn_ign_counts_alpha @@ -261,10 +261,10 @@ subroutine CNFireReadNML( this, NLFilename ) end if end if - end subroutine CNFireReadNML + end subroutine FireReadNML !----------------------------------------------------------------------- - subroutine CNFireInterp(this,bounds) + subroutine FireInterp(this,bounds) ! ! !DESCRIPTION: ! Interpolate CN Fire datasets @@ -279,7 +279,7 @@ subroutine CNFireInterp(this,bounds) call this%lnfm_interp(bounds) end if - end subroutine CNFireInterp + end subroutine FireInterp !----------------------------------------------------------------------- subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & diff --git a/src/biogeochem/CNFireFactoryMod.F90 b/src/biogeochem/CNFireFactoryMod.F90 index d1ad7f9452..d224348cdf 100644 --- a/src/biogeochem/CNFireFactoryMod.F90 +++ b/src/biogeochem/CNFireFactoryMod.F90 @@ -2,7 +2,7 @@ module CNFireFactoryMod !--------------------------------------------------------------------------- ! !DESCRIPTION: - ! Factory to create an instance of cnfire_method_type. This module figures + ! Factory to create an instance of fire_method_type. This module figures ! out the particular type to return. ! ! !USES: @@ -16,7 +16,7 @@ module CNFireFactoryMod ! ! !PUBLIC ROUTINES: public :: CNFireReadNML ! read the fire namelist - public :: create_cnfire_method ! create an object of class cnfire_method_type + public :: create_cnfire_method ! create an object of class fire_method_type ! !PRIVATE DATA MEMBERS: character(len=80), private :: fire_method = "li2014qianfrc" @@ -85,12 +85,12 @@ end subroutine CNFireReadNML subroutine create_cnfire_method( NLFilename, cnfire_method ) ! ! !DESCRIPTION: - ! Create and return an object of cnfire_method_type. The particular type + ! Create and return an object of fire_method_type. The particular type ! is determined based on a namelist parameter. ! ! !USES: use shr_kind_mod , only : SHR_KIND_CL - use CNFireMethodMod , only : cnfire_method_type + use FireMethodType , only : fire_method_type use CNFireNoFireMod , only : cnfire_nofire_type use CNFireLi2014Mod , only : cnfire_li2014_type use CNFireLi2016Mod , only : cnfire_li2016_type @@ -98,7 +98,7 @@ subroutine create_cnfire_method( NLFilename, cnfire_method ) ! ! !ARGUMENTS: character(len=*), intent(in) :: NLFilename ! Namelist filename - class(cnfire_method_type), allocatable, intent(inout) :: cnfire_method + class(fire_method_type), allocatable, intent(inout) :: cnfire_method ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'create_cnfire_method' @@ -118,7 +118,7 @@ subroutine create_cnfire_method( NLFilename, cnfire_method ) call endrun(msg=errMsg(sourcefile, __LINE__)) end select - call cnfire_method%CNFireReadNML( NLFilename ) + call cnfire_method%FireReadNML( NLFilename ) end subroutine create_cnfire_method diff --git a/src/biogeochem/CNFireLi2014Mod.F90 b/src/biogeochem/CNFireLi2014Mod.F90 index 68d2d52a0e..0118cf748a 100644 --- a/src/biogeochem/CNFireLi2014Mod.F90 +++ b/src/biogeochem/CNFireLi2014Mod.F90 @@ -39,7 +39,7 @@ module CNFireLi2014Mod use GridcellType , only : grc use ColumnType , only : col use PatchType , only : patch - use CNFireMethodMod , only : cnfire_method_type + use FireMethodType , only : fire_method_type use CNFireBaseMod , only : cnfire_base_type, cnfire_const ! implicit none diff --git a/src/biogeochem/CNFireLi2016Mod.F90 b/src/biogeochem/CNFireLi2016Mod.F90 index 7649c7d1aa..6a6a73e453 100644 --- a/src/biogeochem/CNFireLi2016Mod.F90 +++ b/src/biogeochem/CNFireLi2016Mod.F90 @@ -40,7 +40,7 @@ module CNFireLi2016Mod use ColumnType , only : col use PatchType , only : patch use SoilBiogeochemStateType , only : get_spinup_latitude_term - use CNFireMethodMod , only : cnfire_method_type + use FireMethodType , only : fire_method_type use CNFireBaseMod , only : cnfire_base_type, cnfire_const ! implicit none diff --git a/src/biogeochem/CNFireNoFireMod.F90 b/src/biogeochem/CNFireNoFireMod.F90 index 4adc36b04c..025d45cbd8 100644 --- a/src/biogeochem/CNFireNoFireMod.F90 +++ b/src/biogeochem/CNFireNoFireMod.F90 @@ -19,7 +19,7 @@ module CNFireNoFireMod use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type use Wateratm2lndBulkType , only : wateratm2lndbulk_type - use CNFireMethodMod , only : cnfire_method_type + use FireMethodType , only : fire_method_type use CNFireBaseMod , only : cnfire_base_type ! implicit none diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index b79869aa6e..d69f4a81ef 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -55,7 +55,7 @@ module CNVegetationFacade use CNVegCarbonStateType , only : cnveg_carbonstate_type use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type - use CNFireMethodMod , only : cnfire_method_type + use FireMethodType , only : fire_method_type use CNProductsMod , only : cn_products_type use NutrientCompetitionMethodMod , only : nutrient_competition_method_type use SpeciesIsotopeType , only : species_isotope_type @@ -123,7 +123,7 @@ module CNVegetationFacade type(cn_products_type) :: n_products_inst type(cn_balance_type) :: cn_balance_inst - class(cnfire_method_type), allocatable :: cnfire_method + class(fire_method_type), allocatable :: cnfire_method type(dgvs_type) :: dgvs_inst ! Control variables @@ -602,7 +602,7 @@ subroutine InterpFileInputs(this, bounds) character(len=*), parameter :: subname = 'InterpFileInputs' !----------------------------------------------------------------------- - call this%cnfire_method%CNFireInterp(bounds) + call this%cnfire_method%FireInterp(bounds) end subroutine InterpFileInputs diff --git a/src/biogeochem/CNFireMethodMod.F90 b/src/main/FireMethodType.F90 similarity index 87% rename from src/biogeochem/CNFireMethodMod.F90 rename to src/main/FireMethodType.F90 index 76af46a334..c4606e4e52 100644 --- a/src/biogeochem/CNFireMethodMod.F90 +++ b/src/main/FireMethodType.F90 @@ -1,8 +1,9 @@ -module CNFireMethodMod +module FireMethodType !--------------------------------------------------------------------------- ! !DESCRIPTION: - ! Abstract base class for functions to implement CN and BGC fire model + ! Abstract base class for functions to implement fire model and fire data for + ! both FATES and BGC. ! ! Created by Erik Kluzek, following Bill Sack's implementation of polymorphism ! !USES: @@ -10,19 +11,19 @@ module CNFireMethodMod private ! ! !PUBLIC TYPES: - public :: cnfire_method_type + public :: fire_method_type - type, abstract :: cnfire_method_type + type, abstract :: fire_method_type contains ! Initialize the fire datasets - procedure(CNFireInit_interface) , public, deferred :: CNFireInit + procedure(FireInit_interface) , public, deferred :: FireInit ! Read namelist for the fire datasets - procedure(CNFireReadNML_interface), public, deferred :: CNFireReadNML + procedure(FireReadNML_interface), public, deferred :: FireReadNML ! Interpolate the fire datasets - procedure(CNFireInterp_interface) , public, deferred :: CNFireInterp + procedure(FireInterp_interface) , public, deferred :: FireInterp ! Figure out the fire area procedure(CNFireArea_interface) , public, deferred :: CNFireArea @@ -30,7 +31,7 @@ module CNFireMethodMod ! Figure out the fire fluxes procedure(CNFireFluxes_interface) , public, deferred :: CNFireFluxes - end type cnfire_method_type + end type fire_method_type abstract interface @@ -48,50 +49,50 @@ module CNFireMethodMod ! consistent between different implementations. ! !--------------------------------------------------------------------------- - subroutine CNFireInit_interface(this, bounds, NLFilename ) + subroutine FireInit_interface(this, bounds, NLFilename ) ! ! !DESCRIPTION: - ! Initialize CN Fire datasets + ! Initialize Fire datasets ! ! USES use decompMod , only : bounds_type - import :: cnfire_method_type + import :: fire_method_type ! !ARGUMENTS: - class(cnfire_method_type) :: this + class(fire_method_type) :: this type(bounds_type), intent(in) :: bounds character(len=*), intent(in) :: NLFilename !----------------------------------------------------------------------- - end subroutine CNFireInit_interface + end subroutine FireInit_interface - subroutine CNFireReadNML_interface(this, NLFilename ) + subroutine FireReadNML_interface(this, NLFilename ) ! ! !DESCRIPTION: ! Read general fire namelist ! ! USES - import :: cnfire_method_type + import :: fire_method_type ! !ARGUMENTS: - class(cnfire_method_type) :: this + class(fire_method_type) :: this character(len=*), intent(in) :: NLFilename !----------------------------------------------------------------------- - end subroutine CNFireReadNML_interface + end subroutine FireReadNML_interface - subroutine CNFireInterp_interface(this, bounds) + subroutine FireInterp_interface(this, bounds) ! ! !DESCRIPTION: - ! Interpolate CN Fire datasets + ! Interpolate Fire datasets ! ! USES use decompMod , only : bounds_type - import :: cnfire_method_type + import :: fire_method_type ! !ARGUMENTS: - class(cnfire_method_type) :: this + class(fire_method_type) :: this type(bounds_type), intent(in) :: bounds !----------------------------------------------------------------------- - end subroutine CNFireInterp_interface + end subroutine FireInterp_interface !----------------------------------------------------------------------- subroutine CNFireArea_interface (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & @@ -112,10 +113,10 @@ subroutine CNFireArea_interface (this, bounds, num_soilc, filter_soilc, num_soil use Wateratm2lndBulkType , only : wateratm2lndbulk_type use CNVegStateType , only : cnveg_state_type use CNVegCarbonStateType , only : cnveg_carbonstate_type - import :: cnfire_method_type + import :: fire_method_type ! ! !ARGUMENTS: - class(cnfire_method_type) :: this + class(fire_method_type) :: this type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns @@ -143,7 +144,7 @@ subroutine CNFireFluxes_interface (this, bounds, num_soilc, filter_soilc, num_so ! ! !DESCRIPTION: ! Fire effects routine for coupled carbon-nitrogen code (CN). - ! Relies primarily on estimate of fractional area burned, from CNFireArea(). + ! Relies primarily on estimate of fractional area burned, from FireArea(). ! ! Total fire carbon emissions (g C/m2 land area/yr) ! =avg(COL_FIRE_CLOSS)*seconds_per_year + avg(SOMC_FIRE)*seconds_per_year + @@ -160,10 +161,10 @@ subroutine CNFireFluxes_interface (this, bounds, num_soilc, filter_soilc, num_so use CNVegCarbonFluxType , only : cnveg_carbonflux_type use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type - import :: cnfire_method_type + import :: fire_method_type ! ! !ARGUMENTS: - class(cnfire_method_type) :: this + class(fire_method_type) :: this type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns @@ -190,4 +191,4 @@ end subroutine CNFireFluxes_interface end interface -end module CNFireMethodMod +end module FireMethodType From aca2996cdc6844bc0190f13bf88eaadaaa897069 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 29 May 2020 01:02:07 -0600 Subject: [PATCH 345/556] Create a new level FireDataBaseType for reading of data --- src/biogeochem/CNFireBaseMod.F90 | 391 +------------------------- src/main/FireDataBaseType.F90 | 455 +++++++++++++++++++++++++++++++ 2 files changed, 459 insertions(+), 387 deletions(-) create mode 100644 src/main/FireDataBaseType.F90 diff --git a/src/biogeochem/CNFireBaseMod.F90 b/src/biogeochem/CNFireBaseMod.F90 index d0641c7145..e30dc7270c 100644 --- a/src/biogeochem/CNFireBaseMod.F90 +++ b/src/biogeochem/CNFireBaseMod.F90 @@ -15,14 +15,8 @@ module CNFireBaseMod ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL - use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create, shr_strdata_print - use shr_strdata_mod , only : shr_strdata_advance use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varctl , only : iulog - use spmdMod , only : masterproc, mpicom, comp_id - use fileutils , only : getavu, relavu - use decompMod , only : gsmap_lnd_gdc2glo - use domainMod , only : ldomain use pftconMod , only : noveg, pftcon use abortutils , only : endrun use decompMod , only : bounds_type @@ -36,13 +30,13 @@ module CNFireBaseMod use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con use EnergyFluxType , only : energyflux_type use SaturatedExcessRunoffMod , only : saturated_excess_runoff_type - use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type - use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type use GridcellType , only : grc use ColumnType , only : col use PatchType , only : patch - use mct_mod use FireMethodType , only : fire_method_type + use FireDataBaseType , only : fire_base_type ! implicit none private @@ -74,33 +68,17 @@ module CNFireBaseMod end type ! - type, abstract, extends(fire_method_type) :: cnfire_base_type + type, abstract, extends(fire_base_type) :: cnfire_base_type private ! !PRIVATE MEMBER DATA: - real(r8), public, pointer :: forc_lnfm(:) ! Lightning frequency - real(r8), public, pointer :: forc_hdm(:) ! Human population density - - type(shr_strdata_type) :: sdat_hdm ! Human population density input data stream - type(shr_strdata_type) :: sdat_lnfm ! Lightning input data stream - - contains ! ! !PUBLIC MEMBER FUNCTIONS: - procedure, public :: FireInit ! Initialization of CNFire procedure, public :: FireReadNML ! Read in namelist for CNFire - procedure, public :: FireInterp ! Interpolate fire data procedure, public :: CNFireArea ! Calculate fire area procedure, public :: CNFireFluxes ! Calculate fire fluxes - procedure(need_lightning_and_popdens_interface), public, deferred :: & - need_lightning_and_popdens ! Returns true if need lightning & popdens ! - ! !PRIVATE MEMBER FUNCTIONS: - procedure, private :: hdm_init ! position datasets for dynamic human population density - procedure, private :: hdm_interp ! interpolates between two years of human pop. density file data - procedure, private :: lnfm_init ! position datasets for Lightning - procedure, private :: lnfm_interp ! interpolates between two years of Lightning file data end type cnfire_base_type !----------------------------------------------------------------------- @@ -128,36 +106,6 @@ end function need_lightning_and_popdens_interface contains - !----------------------------------------------------------------------- - subroutine FireInit( this, bounds, NLFilename ) - ! - ! !DESCRIPTION: - ! Initialize CN Fire module - ! !USES: - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - ! - ! !ARGUMENTS: - class(cnfire_base_type) :: this - type(bounds_type), intent(in) :: bounds - character(len=*), intent(in) :: NLFilename - !----------------------------------------------------------------------- - - if ( this%need_lightning_and_popdens() ) then - ! Allocate lightning forcing data - allocate( this%forc_lnfm(bounds%begg:bounds%endg) ) - this%forc_lnfm(bounds%begg:) = nan - ! Allocate pop dens forcing data - allocate( this%forc_hdm(bounds%begg:bounds%endg) ) - this%forc_hdm(bounds%begg:) = nan - - call this%hdm_init(bounds, NLFilename) - call this%hdm_interp(bounds) - call this%lnfm_init(bounds, NLFilename) - call this%lnfm_interp(bounds) - end if - - end subroutine FireInit - !----------------------------------------------------------------------- subroutine FireReadNML( this, NLFilename ) ! @@ -263,24 +211,6 @@ subroutine FireReadNML( this, NLFilename ) end subroutine FireReadNML - !----------------------------------------------------------------------- - subroutine FireInterp(this,bounds) - ! - ! !DESCRIPTION: - ! Interpolate CN Fire datasets - ! - ! !ARGUMENTS: - class(cnfire_base_type) :: this - type(bounds_type), intent(in) :: bounds - !----------------------------------------------------------------------- - - if ( this%need_lightning_and_popdens() ) then - call this%hdm_interp(bounds) - call this%lnfm_interp(bounds) - end if - - end subroutine FireInterp - !----------------------------------------------------------------------- subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, & @@ -975,317 +905,4 @@ subroutine CNFireFluxes (this, bounds, num_soilc, filter_soilc, num_soilp, filte end subroutine CNFireFluxes - !----------------------------------------------------------------------- - subroutine hdm_init( this, bounds, NLFilename ) - ! - ! !DESCRIPTION: - ! Initialize data stream information for population density. - ! - ! !USES: - use clm_varctl , only : inst_name - use clm_time_manager , only : get_calendar - use ncdio_pio , only : pio_subsystem - use shr_pio_mod , only : shr_pio_getiotype - use clm_nlUtilsMod , only : find_nlgroup_name - use ndepStreamMod , only : clm_domain_mct - use histFileMod , only : hist_addfld1d - ! - ! !ARGUMENTS: - implicit none - class(cnfire_base_type) :: this - type(bounds_type), intent(in) :: bounds - character(len=*), intent(in) :: NLFilename ! Namelist filename - ! - ! !LOCAL VARIABLES: - integer :: stream_year_first_popdens ! first year in pop. dens. stream to use - integer :: stream_year_last_popdens ! last year in pop. dens. stream to use - integer :: model_year_align_popdens ! align stream_year_first_hdm with - integer :: nu_nml ! unit for namelist file - integer :: nml_error ! namelist i/o error flag - type(mct_ggrid) :: dom_clm ! domain information - character(len=CL) :: stream_fldFileName_popdens ! population density streams filename - character(len=CL) :: popdensmapalgo = 'bilinear' ! mapping alogrithm for population density - character(len=CL) :: popdens_tintalgo = 'nearest'! time interpolation alogrithm for population density - character(*), parameter :: subName = "('hdmdyn_init')" - character(*), parameter :: F00 = "('(hdmdyn_init) ',4a)" - !----------------------------------------------------------------------- - - namelist /popd_streams/ & - stream_year_first_popdens, & - stream_year_last_popdens, & - model_year_align_popdens, & - popdensmapalgo, & - stream_fldFileName_popdens, & - popdens_tintalgo - - ! Default values for namelist - stream_year_first_popdens = 1 ! first year in stream to use - stream_year_last_popdens = 1 ! last year in stream to use - model_year_align_popdens = 1 ! align stream_year_first_popdens with this model year - stream_fldFileName_popdens = ' ' - - ! Read popd_streams namelist - if (masterproc) then - nu_nml = getavu() - open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call find_nlgroup_name(nu_nml, 'popd_streams', status=nml_error) - if (nml_error == 0) then - read(nu_nml, nml=popd_streams,iostat=nml_error) - if (nml_error /= 0) then - call endrun(msg='ERROR reading popd_streams namelist'//errMsg(sourcefile, __LINE__)) - end if - end if - close(nu_nml) - call relavu( nu_nml ) - endif - - call shr_mpi_bcast(stream_year_first_popdens, mpicom) - call shr_mpi_bcast(stream_year_last_popdens, mpicom) - call shr_mpi_bcast(model_year_align_popdens, mpicom) - call shr_mpi_bcast(stream_fldFileName_popdens, mpicom) - call shr_mpi_bcast(popdens_tintalgo, mpicom) - - if (masterproc) then - write(iulog,*) ' ' - write(iulog,*) 'popdens_streams settings:' - write(iulog,*) ' stream_year_first_popdens = ',stream_year_first_popdens - write(iulog,*) ' stream_year_last_popdens = ',stream_year_last_popdens - write(iulog,*) ' model_year_align_popdens = ',model_year_align_popdens - write(iulog,*) ' stream_fldFileName_popdens = ',stream_fldFileName_popdens - write(iulog,*) ' popdens_tintalgo = ',popdens_tintalgo - write(iulog,*) ' ' - endif - - call clm_domain_mct (bounds, dom_clm) - - call shr_strdata_create(this%sdat_hdm,name="clmhdm", & - pio_subsystem=pio_subsystem, & - pio_iotype=shr_pio_getiotype(inst_name), & - mpicom=mpicom, compid=comp_id, & - gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & - nxg=ldomain%ni, nyg=ldomain%nj, & - yearFirst=stream_year_first_popdens, & - yearLast=stream_year_last_popdens, & - yearAlign=model_year_align_popdens, & - offset=0, & - domFilePath='', & - domFileName=trim(stream_fldFileName_popdens), & - domTvarName='time', & - domXvarName='lon' , & - domYvarName='lat' , & - domAreaName='area', & - domMaskName='mask', & - filePath='', & - filename=(/trim(stream_fldFileName_popdens)/) , & - fldListFile='hdm', & - fldListModel='hdm', & - fillalgo='none', & - mapalgo=popdensmapalgo, & - calendar=get_calendar(), & - tintalgo=popdens_tintalgo, & - taxmode='extend' ) - - if (masterproc) then - call shr_strdata_print(this%sdat_hdm,'population density data') - endif - - ! Add history fields - call hist_addfld1d (fname='HDM', units='counts/km^2', & - avgflag='A', long_name='human population density', & - ptr_lnd=this%forc_hdm, default='inactive') - - end subroutine hdm_init - - !----------------------------------------------------------------------- - subroutine hdm_interp( this, bounds) - ! - ! !DESCRIPTION: - ! Interpolate data stream information for population density. - ! - ! !USES: - use clm_time_manager, only : get_curr_date - ! - ! !ARGUMENTS: - class(cnfire_base_type) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: g, ig - integer :: year ! year (0, ...) for nstep+1 - integer :: mon ! month (1, ..., 12) for nstep+1 - integer :: day ! day of month (1, ..., 31) for nstep+1 - integer :: sec ! seconds into current date for nstep+1 - integer :: mcdate ! Current model date (yyyymmdd) - !----------------------------------------------------------------------- - - call get_curr_date(year, mon, day, sec) - mcdate = year*10000 + mon*100 + day - - call shr_strdata_advance(this%sdat_hdm, mcdate, sec, mpicom, 'hdmdyn') - - ig = 0 - do g = bounds%begg,bounds%endg - ig = ig+1 - this%forc_hdm(g) = this%sdat_hdm%avs(1)%rAttr(1,ig) - end do - - end subroutine hdm_interp - - !----------------------------------------------------------------------- - subroutine lnfm_init( this, bounds, NLFilename ) - ! - ! !DESCRIPTION: - ! - ! Initialize data stream information for Lightning. - ! - ! !USES: - use clm_varctl , only : inst_name - use clm_time_manager , only : get_calendar - use ncdio_pio , only : pio_subsystem - use shr_pio_mod , only : shr_pio_getiotype - use clm_nlUtilsMod , only : find_nlgroup_name - use ndepStreamMod , only : clm_domain_mct - use histFileMod , only : hist_addfld1d - ! - ! !ARGUMENTS: - implicit none - class(cnfire_base_type) :: this - type(bounds_type), intent(in) :: bounds - character(len=*), intent(in) :: NLFilename - ! - ! !LOCAL VARIABLES: - integer :: stream_year_first_lightng ! first year in Lightning stream to use - integer :: stream_year_last_lightng ! last year in Lightning stream to use - integer :: model_year_align_lightng ! align stream_year_first_lnfm with - integer :: nu_nml ! unit for namelist file - integer :: nml_error ! namelist i/o error flag - type(mct_ggrid) :: dom_clm ! domain information - character(len=CL) :: stream_fldFileName_lightng ! lightning stream filename to read - character(len=CL) :: lightng_tintalgo = 'linear'! time interpolation alogrithm - character(len=CL) :: lightngmapalgo = 'bilinear'! Mapping alogrithm - character(*), parameter :: subName = "('lnfmdyn_init')" - character(*), parameter :: F00 = "('(lnfmdyn_init) ',4a)" - !----------------------------------------------------------------------- - - namelist /light_streams/ & - stream_year_first_lightng, & - stream_year_last_lightng, & - model_year_align_lightng, & - lightngmapalgo, & - stream_fldFileName_lightng, & - lightng_tintalgo - - ! Default values for namelist - stream_year_first_lightng = 1 ! first year in stream to use - stream_year_last_lightng = 1 ! last year in stream to use - model_year_align_lightng = 1 ! align stream_year_first_lnfm with this model year - stream_fldFileName_lightng = ' ' - - ! Read light_streams namelist - if (masterproc) then - nu_nml = getavu() - open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call find_nlgroup_name(nu_nml, 'light_streams', status=nml_error) - if (nml_error == 0) then - read(nu_nml, nml=light_streams,iostat=nml_error) - if (nml_error /= 0) then - call endrun(msg='ERROR reading light_streams namelist'//errMsg(sourcefile, __LINE__)) - end if - end if - close(nu_nml) - call relavu( nu_nml ) - endif - - call shr_mpi_bcast(stream_year_first_lightng, mpicom) - call shr_mpi_bcast(stream_year_last_lightng, mpicom) - call shr_mpi_bcast(model_year_align_lightng, mpicom) - call shr_mpi_bcast(stream_fldFileName_lightng, mpicom) - call shr_mpi_bcast(lightng_tintalgo, mpicom) - - if (masterproc) then - write(iulog,*) ' ' - write(iulog,*) 'light_stream settings:' - write(iulog,*) ' stream_year_first_lightng = ',stream_year_first_lightng - write(iulog,*) ' stream_year_last_lightng = ',stream_year_last_lightng - write(iulog,*) ' model_year_align_lightng = ',model_year_align_lightng - write(iulog,*) ' stream_fldFileName_lightng = ',stream_fldFileName_lightng - write(iulog,*) ' lightng_tintalgo = ',lightng_tintalgo - write(iulog,*) ' ' - endif - - call clm_domain_mct (bounds, dom_clm) - - call shr_strdata_create(this%sdat_lnfm,name="clmlnfm", & - pio_subsystem=pio_subsystem, & - pio_iotype=shr_pio_getiotype(inst_name), & - mpicom=mpicom, compid=comp_id, & - gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & - nxg=ldomain%ni, nyg=ldomain%nj, & - yearFirst=stream_year_first_lightng, & - yearLast=stream_year_last_lightng, & - yearAlign=model_year_align_lightng, & - offset=0, & - domFilePath='', & - domFileName=trim(stream_fldFileName_lightng), & - domTvarName='time', & - domXvarName='lon' , & - domYvarName='lat' , & - domAreaName='area', & - domMaskName='mask', & - filePath='', & - filename=(/trim(stream_fldFileName_lightng)/),& - fldListFile='lnfm', & - fldListModel='lnfm', & - fillalgo='none', & - tintalgo=lightng_tintalgo, & - mapalgo=lightngmapalgo, & - calendar=get_calendar(), & - taxmode='cycle' ) - - if (masterproc) then - call shr_strdata_print(this%sdat_lnfm,'Lightning data') - endif - - ! Add history fields - call hist_addfld1d (fname='LNFM', units='counts/km^2/hr', & - avgflag='A', long_name='Lightning frequency', & - ptr_lnd=this%forc_lnfm, default='inactive') - - end subroutine lnfm_init - - !----------------------------------------------------------------------- - subroutine lnfm_interp(this, bounds ) - ! - ! !DESCRIPTION: - ! Interpolate data stream information for Lightning. - ! - ! !USES: - use clm_time_manager, only : get_curr_date - ! - ! !ARGUMENTS: - class(cnfire_base_type) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: g, ig - integer :: year ! year (0, ...) for nstep+1 - integer :: mon ! month (1, ..., 12) for nstep+1 - integer :: day ! day of month (1, ..., 31) for nstep+1 - integer :: sec ! seconds into current date for nstep+1 - integer :: mcdate ! Current model date (yyyymmdd) - !----------------------------------------------------------------------- - - call get_curr_date(year, mon, day, sec) - mcdate = year*10000 + mon*100 + day - - call shr_strdata_advance(this%sdat_lnfm, mcdate, sec, mpicom, 'lnfmdyn') - - ig = 0 - do g = bounds%begg,bounds%endg - ig = ig+1 - this%forc_lnfm(g) = this%sdat_lnfm%avs(1)%rAttr(1,ig) - end do - - end subroutine lnfm_interp - end module CNFireBaseMod diff --git a/src/main/FireDataBaseType.F90 b/src/main/FireDataBaseType.F90 new file mode 100644 index 0000000000..be9325d798 --- /dev/null +++ b/src/main/FireDataBaseType.F90 @@ -0,0 +1,455 @@ +module FireDataBaseType + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! module for handling of fire data + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL + use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create, shr_strdata_print + use shr_strdata_mod , only : shr_strdata_advance + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use spmdMod , only : masterproc, mpicom, comp_id + use fileutils , only : getavu, relavu + use decompMod , only : gsmap_lnd_gdc2glo + use domainMod , only : ldomain + use abortutils , only : endrun + use decompMod , only : bounds_type + use mct_mod + use FireMethodType , only : fire_method_type + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: fire_base_type + + ! + type, abstract, extends(fire_method_type) :: fire_base_type + private + ! !PRIVATE MEMBER DATA: + + real(r8), public, pointer :: forc_lnfm(:) ! Lightning frequency + real(r8), public, pointer :: forc_hdm(:) ! Human population density + + type(shr_strdata_type) :: sdat_hdm ! Human population density input data stream + type(shr_strdata_type) :: sdat_lnfm ! Lightning input data stream + + + contains + ! + ! !PUBLIC MEMBER FUNCTIONS: + procedure, public :: FireInit ! Initialization of Fire + procedure(FireReadNML_interface), public, deferred :: FireReadNML ! Read in namelist for Fire + procedure, public :: FireInterp ! Interpolate fire data + procedure(need_lightning_and_popdens_interface), public, deferred :: & + need_lightning_and_popdens ! Returns true if need lightning & popdens + ! + ! !PRIVATE MEMBER FUNCTIONS: + procedure, private :: hdm_init ! position datasets for dynamic human population density + procedure, private :: hdm_interp ! interpolates between two years of human pop. density file data + procedure, private :: lnfm_init ! position datasets for Lightning + procedure, private :: lnfm_interp ! interpolates between two years of Lightning file data + end type fire_base_type + !----------------------------------------------------------------------- + + abstract interface + !----------------------------------------------------------------------- + function need_lightning_and_popdens_interface(this) result(need_lightning_and_popdens) + ! + ! !DESCRIPTION: + ! Returns true if need lightning and popdens, false otherwise + ! + ! USES + import :: fire_base_type + ! + ! !ARGUMENTS: + class(fire_base_type), intent(in) :: this + logical :: need_lightning_and_popdens ! function result + !----------------------------------------------------------------------- + end function need_lightning_and_popdens_interface + end interface + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + subroutine FireReadNML_interface( this, NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for Fire + ! + ! !USES: + ! + ! !ARGUMENTS: + class(fire_base_type) :: this + character(len=*), intent(in) :: NLFilename ! Namelist filename + end subroutine FireReadNML_interface + + !----------------------------------------------------------------------- + subroutine FireInit( this, bounds, NLFilename ) + ! + ! !DESCRIPTION: + ! Initialize CN Fire module + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(fire_base_type) :: this + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: NLFilename + !----------------------------------------------------------------------- + + if ( this%need_lightning_and_popdens() ) then + ! Allocate lightning forcing data + allocate( this%forc_lnfm(bounds%begg:bounds%endg) ) + this%forc_lnfm(bounds%begg:) = nan + ! Allocate pop dens forcing data + allocate( this%forc_hdm(bounds%begg:bounds%endg) ) + this%forc_hdm(bounds%begg:) = nan + + call this%hdm_init(bounds, NLFilename) + call this%hdm_interp(bounds) + call this%lnfm_init(bounds, NLFilename) + call this%lnfm_interp(bounds) + end if + + end subroutine FireInit + + !----------------------------------------------------------------------- + subroutine FireInterp(this,bounds) + ! + ! !DESCRIPTION: + ! Interpolate CN Fire datasets + ! + ! !ARGUMENTS: + class(fire_base_type) :: this + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + + if ( this%need_lightning_and_popdens() ) then + call this%hdm_interp(bounds) + call this%lnfm_interp(bounds) + end if + + end subroutine FireInterp + + !----------------------------------------------------------------------- + subroutine hdm_init( this, bounds, NLFilename ) + ! + ! !DESCRIPTION: + ! Initialize data stream information for population density. + ! + ! !USES: + use clm_varctl , only : inst_name + use clm_time_manager , only : get_calendar + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use clm_nlUtilsMod , only : find_nlgroup_name + use ndepStreamMod , only : clm_domain_mct + use histFileMod , only : hist_addfld1d + ! + ! !ARGUMENTS: + implicit none + class(fire_base_type) :: this + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: stream_year_first_popdens ! first year in pop. dens. stream to use + integer :: stream_year_last_popdens ! last year in pop. dens. stream to use + integer :: model_year_align_popdens ! align stream_year_first_hdm with + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + type(mct_ggrid) :: dom_clm ! domain information + character(len=CL) :: stream_fldFileName_popdens ! population density streams filename + character(len=CL) :: popdensmapalgo = 'bilinear' ! mapping alogrithm for population density + character(len=CL) :: popdens_tintalgo = 'nearest'! time interpolation alogrithm for population density + character(*), parameter :: subName = "('hdmdyn_init')" + character(*), parameter :: F00 = "('(hdmdyn_init) ',4a)" + !----------------------------------------------------------------------- + + namelist /popd_streams/ & + stream_year_first_popdens, & + stream_year_last_popdens, & + model_year_align_popdens, & + popdensmapalgo, & + stream_fldFileName_popdens, & + popdens_tintalgo + + ! Default values for namelist + stream_year_first_popdens = 1 ! first year in stream to use + stream_year_last_popdens = 1 ! last year in stream to use + model_year_align_popdens = 1 ! align stream_year_first_popdens with this model year + stream_fldFileName_popdens = ' ' + + ! Read popd_streams namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'popd_streams', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=popd_streams,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg='ERROR reading popd_streams namelist'//errMsg(sourcefile, __LINE__)) + end if + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast(stream_year_first_popdens, mpicom) + call shr_mpi_bcast(stream_year_last_popdens, mpicom) + call shr_mpi_bcast(model_year_align_popdens, mpicom) + call shr_mpi_bcast(stream_fldFileName_popdens, mpicom) + call shr_mpi_bcast(popdens_tintalgo, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'popdens_streams settings:' + write(iulog,*) ' stream_year_first_popdens = ',stream_year_first_popdens + write(iulog,*) ' stream_year_last_popdens = ',stream_year_last_popdens + write(iulog,*) ' model_year_align_popdens = ',model_year_align_popdens + write(iulog,*) ' stream_fldFileName_popdens = ',stream_fldFileName_popdens + write(iulog,*) ' popdens_tintalgo = ',popdens_tintalgo + write(iulog,*) ' ' + endif + + call clm_domain_mct (bounds, dom_clm) + + call shr_strdata_create(this%sdat_hdm,name="clmhdm", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_popdens, & + yearLast=stream_year_last_popdens, & + yearAlign=model_year_align_popdens, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_popdens), & + domTvarName='time', & + domXvarName='lon' , & + domYvarName='lat' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_popdens)/) , & + fldListFile='hdm', & + fldListModel='hdm', & + fillalgo='none', & + mapalgo=popdensmapalgo, & + calendar=get_calendar(), & + tintalgo=popdens_tintalgo, & + taxmode='extend' ) + + if (masterproc) then + call shr_strdata_print(this%sdat_hdm,'population density data') + endif + + ! Add history fields + call hist_addfld1d (fname='HDM', units='counts/km^2', & + avgflag='A', long_name='human population density', & + ptr_lnd=this%forc_hdm, default='inactive') + + end subroutine hdm_init + + !----------------------------------------------------------------------- + subroutine hdm_interp( this, bounds) + ! + ! !DESCRIPTION: + ! Interpolate data stream information for population density. + ! + ! !USES: + use clm_time_manager, only : get_curr_date + ! + ! !ARGUMENTS: + class(fire_base_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g, ig + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + !----------------------------------------------------------------------- + + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + + call shr_strdata_advance(this%sdat_hdm, mcdate, sec, mpicom, 'hdmdyn') + + ig = 0 + do g = bounds%begg,bounds%endg + ig = ig+1 + this%forc_hdm(g) = this%sdat_hdm%avs(1)%rAttr(1,ig) + end do + + end subroutine hdm_interp + + !----------------------------------------------------------------------- + subroutine lnfm_init( this, bounds, NLFilename ) + ! + ! !DESCRIPTION: + ! + ! Initialize data stream information for Lightning. + ! + ! !USES: + use clm_varctl , only : inst_name + use clm_time_manager , only : get_calendar + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use clm_nlUtilsMod , only : find_nlgroup_name + use ndepStreamMod , only : clm_domain_mct + use histFileMod , only : hist_addfld1d + ! + ! !ARGUMENTS: + implicit none + class(fire_base_type) :: this + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: NLFilename + ! + ! !LOCAL VARIABLES: + integer :: stream_year_first_lightng ! first year in Lightning stream to use + integer :: stream_year_last_lightng ! last year in Lightning stream to use + integer :: model_year_align_lightng ! align stream_year_first_lnfm with + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + type(mct_ggrid) :: dom_clm ! domain information + character(len=CL) :: stream_fldFileName_lightng ! lightning stream filename to read + character(len=CL) :: lightng_tintalgo = 'linear'! time interpolation alogrithm + character(len=CL) :: lightngmapalgo = 'bilinear'! Mapping alogrithm + character(*), parameter :: subName = "('lnfmdyn_init')" + character(*), parameter :: F00 = "('(lnfmdyn_init) ',4a)" + !----------------------------------------------------------------------- + + namelist /light_streams/ & + stream_year_first_lightng, & + stream_year_last_lightng, & + model_year_align_lightng, & + lightngmapalgo, & + stream_fldFileName_lightng, & + lightng_tintalgo + + ! Default values for namelist + stream_year_first_lightng = 1 ! first year in stream to use + stream_year_last_lightng = 1 ! last year in stream to use + model_year_align_lightng = 1 ! align stream_year_first_lnfm with this model year + stream_fldFileName_lightng = ' ' + + ! Read light_streams namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'light_streams', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=light_streams,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg='ERROR reading light_streams namelist'//errMsg(sourcefile, __LINE__)) + end if + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast(stream_year_first_lightng, mpicom) + call shr_mpi_bcast(stream_year_last_lightng, mpicom) + call shr_mpi_bcast(model_year_align_lightng, mpicom) + call shr_mpi_bcast(stream_fldFileName_lightng, mpicom) + call shr_mpi_bcast(lightng_tintalgo, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'light_stream settings:' + write(iulog,*) ' stream_year_first_lightng = ',stream_year_first_lightng + write(iulog,*) ' stream_year_last_lightng = ',stream_year_last_lightng + write(iulog,*) ' model_year_align_lightng = ',model_year_align_lightng + write(iulog,*) ' stream_fldFileName_lightng = ',stream_fldFileName_lightng + write(iulog,*) ' lightng_tintalgo = ',lightng_tintalgo + write(iulog,*) ' ' + endif + + call clm_domain_mct (bounds, dom_clm) + + call shr_strdata_create(this%sdat_lnfm,name="clmlnfm", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_lightng, & + yearLast=stream_year_last_lightng, & + yearAlign=model_year_align_lightng, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_lightng), & + domTvarName='time', & + domXvarName='lon' , & + domYvarName='lat' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_lightng)/),& + fldListFile='lnfm', & + fldListModel='lnfm', & + fillalgo='none', & + tintalgo=lightng_tintalgo, & + mapalgo=lightngmapalgo, & + calendar=get_calendar(), & + taxmode='cycle' ) + + if (masterproc) then + call shr_strdata_print(this%sdat_lnfm,'Lightning data') + endif + + ! Add history fields + call hist_addfld1d (fname='LNFM', units='counts/km^2/hr', & + avgflag='A', long_name='Lightning frequency', & + ptr_lnd=this%forc_lnfm, default='inactive') + + end subroutine lnfm_init + + !----------------------------------------------------------------------- + subroutine lnfm_interp(this, bounds ) + ! + ! !DESCRIPTION: + ! Interpolate data stream information for Lightning. + ! + ! !USES: + use clm_time_manager, only : get_curr_date + ! + ! !ARGUMENTS: + class(fire_base_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g, ig + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + !----------------------------------------------------------------------- + + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + + call shr_strdata_advance(this%sdat_lnfm, mcdate, sec, mpicom, 'lnfmdyn') + + ig = 0 + do g = bounds%begg,bounds%endg + ig = ig+1 + this%forc_lnfm(g) = this%sdat_lnfm%avs(1)%rAttr(1,ig) + end do + + end subroutine lnfm_interp + +end module FireDataBaseType From e123aa6636d93825fa452acdebbd1d72c1de0626 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 29 May 2020 15:53:55 -0600 Subject: [PATCH 346/556] Rework writing of ctsm.mk to use information from cime This makes us no longer tied to specific machines (previously we had hard-coded information for cheyenne and bishorn). This depends on cime changes currently on a branch. --- cime_config/buildlib | 80 ++++++++++++++++++++++---------------------- 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/cime_config/buildlib b/cime_config/buildlib index f19e6b55bd..569ef99914 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -21,37 +21,23 @@ from CIME.utils import run_cmd, expect logger = logging.getLogger(__name__) ############################################################################### -def _write_ctsm_mk(exeroot, libroot, machine): +def _write_ctsm_mk(gmake, gmake_opts, makefile, exeroot, libroot): """Writes a ctsm.mk file in exeroot. This file can be included by atmosphere model builds outside of cime. - - NOTE: This currently only supports the machines cheyenne (intel) and bishorn - (gnu). Also, it assumes that ESMFMKFILE is set in your environment. - - Arguments: - exeroot (str): path to build directory - libroot (str): path to directory containing libclm.a - machine (str): name of machine """ - ctsm_mk_path = os.path.join(exeroot, 'ctsm.mk') - ctsm_bld_dir = os.path.abspath(os.path.join(libroot, os.pardir)) - shared_bld_dir = os.path.abspath(os.path.join(ctsm_bld_dir, os.pardir, os.pardir)) - esmfmkfile = os.environ['ESMFMKFILE'] - - # Set machine-specific libs for machines we currently support. Note there are a lot of - # hard-coded assumptions here, regarding the compiler, paths to libraries, etc. - # - # ESMF library doesn't need to be included here, because the necessary elements of the - # link line for that are included elsewhere. - if machine == 'cheyenne': - machine_specific_libs = '-mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -cxxlib -lrt -ldl -lnetcdff -lnetcdf -cxxlib' - elif machine == 'bishorn': - machine_specific_libs = '-L/usr/local/lib -lnetcdff -lnetcdf -framework Accelerate' - else: - expect(False, "Unknown machine for LILAC's ctsm.mk file: {}".format(machine)) + cime_output_file = os.path.join(exeroot, 'cime_variables.mk') + # Set MODEL=driver because some link flags are set differently when MODEL=driver, and + # those are the ones we want here. + cmd = ("{gmake} write_include_and_link_flags OUTPUT_FILE={cime_output_file} " + "MODEL=driver {gmake_opts} -f {makefile} ").format( + gmake=gmake, cime_output_file=cime_output_file, gmake_opts=gmake_opts, makefile=makefile) + rc, out, err = run_cmd(cmd) + logger.info("%s: \n\n output:\n %s \n\n err:\n\n%s\n"%(cmd,out,err)) + expect(rc == 0, "Command %s failed with rc=%s" % (cmd, rc)) + ctsm_mk_path = os.path.join(exeroot, 'ctsm.mk') with open(ctsm_mk_path, 'w') as ctsm_mk: ctsm_mk.write(""" # ====================================================================== @@ -64,29 +50,32 @@ def _write_ctsm_mk(exeroot, libroot, machine): # ====================================================================== # ====================================================================== -# The following settings are meant for internal use, and generally +# The following CIME variables are meant for internal use, and generally # should not be included directly in an atmosphere model's build. # ====================================================================== -include {esmfmkfile} +""") + with open(cime_output_file) as infile: + ctsm_mk.write(infile.read()) + + ctsm_bld_dir = os.path.abspath(os.path.join(libroot, os.pardir)) + with open(ctsm_mk_path, 'a') as ctsm_mk: + ctsm_mk.write(""" +# ====================================================================== +# The following settings are meant for internal use, and generally +# should not be included directly in an atmosphere model's build. +# ====================================================================== -SHARED_BLD_DIR = {shared_bld_dir} CTSM_BLD_DIR = {ctsm_bld_dir} -DEPENDS_LIB = $(SHARED_BLD_DIR)/lib -SHR_LIB = $(CTSM_BLD_DIR)/c1a1l1/lib -SHR_INC = $(CTSM_BLD_DIR)/c1a1l1/csm_share CTSM_INC = $(CTSM_BLD_DIR)/clm/obj -LIBS = -L$(CTSM_BLD_DIR)/lib -lclm -L$(SHR_LIB) -lcsm_share -L$(DEPENDS_LIB) -lpiof -lpioc -lgptl -lmct -lmpeu {machine_specific_libs} - # ====================================================================== # The following settings should be included in an atmosphere model's build. # ====================================================================== -CTSM_INCLUDES = $(ESMF_F90COMPILEPATHS) -I$(SHR_INC) -I$(CTSM_INC) -CTSM_LIBS = $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) $(LIBS) -""".format(esmfmkfile=esmfmkfile, shared_bld_dir=shared_bld_dir, ctsm_bld_dir=ctsm_bld_dir, - machine_specific_libs=machine_specific_libs)) +CTSM_INCLUDES = $(CIME_ESMF_F90COMPILEPATHS) -I$(CIME_CSM_SHR_INCLUDE) -I$(CTSM_INC) +CTSM_LIBS = -L$(CTSM_BLD_DIR)/lib -lclm $(CIME_ULIBS) $(CIME_SLIBS) $(CIME_MLIBS) $(CIME_F90_LDFLAGS) +""".format(ctsm_bld_dir=ctsm_bld_dir)) ############################################################################### def _main_func(): @@ -97,15 +86,16 @@ def _main_func(): with Case(caseroot) as case: casetools = case.get_value("CASETOOLS") + makefile = os.path.join(casetools, "Makefile") lnd_root = case.get_value("COMP_ROOT_DIR_LND") gmake_j = case.get_value("GMAKE_J") gmake = case.get_value("GMAKE") + gmake_opts = get_standard_makefile_args(case) driver = case.get_value("COMP_INTERFACE").lower() lilac_mode = case.get_value("LILAC_MODE") if lilac_mode == 'on': driver = "lilac" - machine = case.get_value('MACH') #------------------------------------------------------- # create Filepath file @@ -146,15 +136,25 @@ def _main_func(): #------------------------------------------------------- complib = os.path.join(libroot,"libclm.a") - makefile = os.path.join(casetools, "Makefile") cmd = "{} complib -j {} MODEL=clm COMPLIB={} -f {} {}" \ - .format(gmake, gmake_j, complib, makefile, get_standard_makefile_args(case)) + .format(gmake, gmake_j, complib, makefile, gmake_opts) rc, out, err = run_cmd(cmd) logger.info("%s: \n\n output:\n %s \n\n err:\n\n%s\n"%(cmd,out,err)) expect(rc == 0, "Command %s failed with rc=%s" % (cmd, rc)) + # ------------------------------------------------------------------------ + # for lilac usage, we need a file containing some Makefile variables (for the atmosphere model's build) + # ------------------------------------------------------------------------ + + if lilac_mode == 'on': + _write_ctsm_mk(gmake=gmake, + gmake_opts=gmake_opts, + makefile=makefile, + exeroot=case.get_value("EXEROOT"), + libroot=libroot) + ############################################################################### if __name__ == "__main__": From 608fb5da06285bf8ab366fcd77215c790ea84d18 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 30 May 2020 14:05:00 -0600 Subject: [PATCH 347/556] No longer require ESMFMKFILE when building the lilac driver --- README.lilac | 2 +- lilac/atm_driver/Makefile | 20 ++++---------------- 2 files changed, 5 insertions(+), 17 deletions(-) diff --git a/README.lilac b/README.lilac index 7f8a36c200..6a4414e6ae 100644 --- a/README.lilac +++ b/README.lilac @@ -39,7 +39,7 @@ library (I), do the following: > make clean > source ./.env_mach_specific.sh > export DEBUG=TRUE - > make atm_driver + > make COMPILER=intel atm_driver 2) to generate the input namelists diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index 8aaea82e93..a3a594189b 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -8,9 +8,7 @@ # (1) Run cime's configure tool in order to generate a Macros.make file # # (2) Source the .env_mach_specific.sh file created by the configure -# tool in order to set up the environment correctly. Among other -# things, this should set the environment variable ESMFMKFILE. (See -# notes below about the need for this.) +# tool in order to set up the environment correctly. # # (3) Set the environment variable CTSM_MKFILE - e.g. # @@ -22,26 +20,16 @@ include Macros.make include $(CTSM_MKFILE) -# Most atmosphere model builds shouldn't need this directly, but we use -# it here in order to easily get a f90 compiler and f90 compile opts for -# building atm_driver.o. (This is a bit of a kludge that we should -# change later.) -include $(ESMFMKFILE) - -#================================================================================ -# Compiler and linker rules using ESMF_ variables supplied by esmf.mk -#================================================================================ - .SUFFIXES: .F90 %.o : %.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(CTSM_INCLUDES) $(FFLAGS) $< + $(MPIFC) -c $(CTSM_INCLUDES) $(FFLAGS) $< atm_driver.o : $(CURDIR)/atm_driver.F90 - $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(CTSM_INCLUDES) $(FFLAGS) $< + $(MPIFC) -c $(CTSM_INCLUDES) $(FFLAGS) $< atm_driver: atm_driver.o - $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) -o $@ $^ $(CTSM_LIBS) + $(MPIFC) -o $@ $^ $(CTSM_LIBS) mv atm_driver atm_driver.exe # module dependencies: From 29cd8963d6886417259803e5320aebeff7e04a59 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 30 May 2020 14:38:06 -0600 Subject: [PATCH 348/556] Point to cime branch --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 948e0cfbd7..90e4e35c39 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -29,8 +29,8 @@ required = True [cime] local_path = cime protocol = git -repo_url = https://github.com/ESMCI/cime -tag = branch_tags/cime5.8.23_a01 +repo_url = https://github.com/billsacks/cime +branch = changes_for_lilac externals = ../Externals_cime.cfg required = True From f346b65eb0402522c625e2f07759162e4282fde5 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 30 May 2020 19:56:44 -0600 Subject: [PATCH 349/556] Put a link to ctsm.mk at the top level of the build directory --- python/ctsm/build_ctsm.py | 3 +++ 1 file changed, 3 insertions(+) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 47ef2d32f6..86bed1ef89 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -515,3 +515,6 @@ def _create_and_build_case(cime_path, build_dir, compiler, machine=None, no_buil cwd=casedir) except subprocess.CalledProcessError: abort('ERROR building CTSM or its dependencies - see above for details') + + make_link(os.path.join(casedir, 'bld', 'ctsm.mk'), + os.path.join(build_dir, 'ctsm.mk')) From 3bba38e4af64cccad9d888008fe8015119fc3070 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 1 Jun 2020 16:27:22 -0600 Subject: [PATCH 350/556] Point to a cime tag rather than branch --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 90e4e35c39..1322caa387 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -29,8 +29,8 @@ required = True [cime] local_path = cime protocol = git -repo_url = https://github.com/billsacks/cime -branch = changes_for_lilac +repo_url = https://github.com/ESMCI/cime +tag = branch_tags/cime5.8.23_a02 externals = ../Externals_cime.cfg required = True From aec2b52f6545ac64843b61afe9c2f9bc444f82b5 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 3 Jun 2020 15:11:21 -0600 Subject: [PATCH 351/556] Begin lilac documentation --- doc/source/index.rst | 5 +- .../api-init-details.rst | 11 ++ .../calling-ctsm-from-atm/api-overview.rst | 11 ++ .../calling-ctsm-from-atm/api-run-details.rst | 11 ++ .../lilac/calling-ctsm-from-atm/index.rst | 12 ++ doc/source/lilac/index.rst | 13 ++ .../lilac/introduction-and-overview/index.rst | 11 ++ .../organization-of-documentation.rst | 28 ++++ .../overview-of-lilac.rst | 11 ++ .../obtaining-building-and-running/index.rst | 11 ++ .../obtaining-and-building-ctsm.rst | 130 ++++++++++++++++++ .../setting-ctsm-runtime-options.rst | 11 ++ .../lilac/specific-atm-models/index.rst | 10 ++ doc/source/lilac/specific-atm-models/wrf.rst | 9 ++ 14 files changed, 282 insertions(+), 2 deletions(-) create mode 100644 doc/source/lilac/calling-ctsm-from-atm/api-init-details.rst create mode 100644 doc/source/lilac/calling-ctsm-from-atm/api-overview.rst create mode 100644 doc/source/lilac/calling-ctsm-from-atm/api-run-details.rst create mode 100644 doc/source/lilac/calling-ctsm-from-atm/index.rst create mode 100644 doc/source/lilac/index.rst create mode 100644 doc/source/lilac/introduction-and-overview/index.rst create mode 100644 doc/source/lilac/introduction-and-overview/organization-of-documentation.rst create mode 100644 doc/source/lilac/introduction-and-overview/overview-of-lilac.rst create mode 100644 doc/source/lilac/obtaining-building-and-running/index.rst create mode 100644 doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst create mode 100644 doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst create mode 100644 doc/source/lilac/specific-atm-models/index.rst create mode 100644 doc/source/lilac/specific-atm-models/wrf.rst diff --git a/doc/source/index.rst b/doc/source/index.rst index f7f35abeda..9a9d8016ef 100644 --- a/doc/source/index.rst +++ b/doc/source/index.rst @@ -3,10 +3,10 @@ You can adapt this file completely to your liking, but it should at least contain the root `toctree` directive. -Welcome to the CLM documentation +Welcome to the CTSM documentation ================================== -This document has two major sections. +This document has three major sections. .. toctree:: :maxdepth: 2 @@ -14,6 +14,7 @@ This document has two major sections. users_guide/index.rst tech_note/index.rst + lilac/index.rst Indices and tables ================== diff --git a/doc/source/lilac/calling-ctsm-from-atm/api-init-details.rst b/doc/source/lilac/calling-ctsm-from-atm/api-init-details.rst new file mode 100644 index 0000000000..9a9073d188 --- /dev/null +++ b/doc/source/lilac/calling-ctsm-from-atm/api-init-details.rst @@ -0,0 +1,11 @@ +.. _api-init-details: + +.. highlight:: shell + +================================================ + Details on the CTSM-LILAC initialization phase +================================================ + +.. todo:: + + TODO: write this section diff --git a/doc/source/lilac/calling-ctsm-from-atm/api-overview.rst b/doc/source/lilac/calling-ctsm-from-atm/api-overview.rst new file mode 100644 index 0000000000..286d175758 --- /dev/null +++ b/doc/source/lilac/calling-ctsm-from-atm/api-overview.rst @@ -0,0 +1,11 @@ +.. _api-overview: + +.. highlight:: shell + +================================ + Overview of the CTSM-LILAC API +================================ + +.. todo:: + + TODO: write this section diff --git a/doc/source/lilac/calling-ctsm-from-atm/api-run-details.rst b/doc/source/lilac/calling-ctsm-from-atm/api-run-details.rst new file mode 100644 index 0000000000..61575427b9 --- /dev/null +++ b/doc/source/lilac/calling-ctsm-from-atm/api-run-details.rst @@ -0,0 +1,11 @@ +.. _api-run-details: + +.. highlight:: shell + +===================================== + Details on the CTSM-LILAC run phase +===================================== + +.. todo:: + + TODO: write this section diff --git a/doc/source/lilac/calling-ctsm-from-atm/index.rst b/doc/source/lilac/calling-ctsm-from-atm/index.rst new file mode 100644 index 0000000000..4c42740df3 --- /dev/null +++ b/doc/source/lilac/calling-ctsm-from-atm/index.rst @@ -0,0 +1,12 @@ +.. _calling-ctsm-from-atm: + +======================================= + Calling CTSM from an atmosphere model +======================================= + +.. toctree:: + :maxdepth: 2 + + api-overview.rst + api-init-details.rst + api-run-details.rst diff --git a/doc/source/lilac/index.rst b/doc/source/lilac/index.rst new file mode 100644 index 0000000000..3aac77f9ef --- /dev/null +++ b/doc/source/lilac/index.rst @@ -0,0 +1,13 @@ +.. _lilac-users-guide: + +####################### +CTSM-LILAC User's Guide +####################### + +.. toctree:: + :maxdepth: 2 + + introduction-and-overview/index.rst + obtaining-building-and-running/index.rst + calling-ctsm-from-atm/index.rst + specific-atm-models/index.rst diff --git a/doc/source/lilac/introduction-and-overview/index.rst b/doc/source/lilac/introduction-and-overview/index.rst new file mode 100644 index 0000000000..4c2878797e --- /dev/null +++ b/doc/source/lilac/introduction-and-overview/index.rst @@ -0,0 +1,11 @@ +.. _introduction-and-overview: + +==================================== + Introduction and overview of LILAC +==================================== + +.. toctree:: + :maxdepth: 2 + + overview-of-lilac.rst + organization-of-documentation.rst diff --git a/doc/source/lilac/introduction-and-overview/organization-of-documentation.rst b/doc/source/lilac/introduction-and-overview/organization-of-documentation.rst new file mode 100644 index 0000000000..7a91c6ee54 --- /dev/null +++ b/doc/source/lilac/introduction-and-overview/organization-of-documentation.rst @@ -0,0 +1,28 @@ +.. _organization-of-documentation: + +.. highlight:: shell + +=================================== + Organization of the documentation +=================================== + +This documentation is organized into the following high-level sections: + +- :numref:`{number}. {name} `: This section gives a general + introduction to LILAC and describes the organization of this documentation (you're + reading this now!) + +- :numref:`{number}. {name} `: This section provides + instructions for building and running CTSM within an atmosphere model that has been set + up to run with CTSM (e.g., WRF). If you are starting to use CTSM with an atmosphere + model that does not yet have any calls to CTSM-LILAC, then you should start with section + :numref:`{number}. {name} `. + +- :numref:`{number}. {name} `: This section provides details on the + Fortran code that needs to be added to an atmosphere model in order to call CTSM via + LILAC as its land surface scheme. (In practice, this step comes before + :numref:`{number}. {name} `, but it is included later in + the documentation because it is of interest to fewer people.) + +- :numref:`{number}. {name} `: This section provides notes on running + CTSM within specific atmosphere models. diff --git a/doc/source/lilac/introduction-and-overview/overview-of-lilac.rst b/doc/source/lilac/introduction-and-overview/overview-of-lilac.rst new file mode 100644 index 0000000000..545386ee93 --- /dev/null +++ b/doc/source/lilac/introduction-and-overview/overview-of-lilac.rst @@ -0,0 +1,11 @@ +.. _overview-of-lilac: + +.. highlight:: shell + +=================== + Overview of LILAC +=================== + +.. todo:: + + TODO: write this section diff --git a/doc/source/lilac/obtaining-building-and-running/index.rst b/doc/source/lilac/obtaining-building-and-running/index.rst new file mode 100644 index 0000000000..a1386fe909 --- /dev/null +++ b/doc/source/lilac/obtaining-building-and-running/index.rst @@ -0,0 +1,11 @@ +.. _obtaining-building-and-running: + +====================================== + Obtaining, building and running CTSM +====================================== + +.. toctree:: + :maxdepth: 2 + + obtaining-and-building-ctsm.rst + setting-ctsm-runtime-options.rst diff --git a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst new file mode 100644 index 0000000000..4b8e093b39 --- /dev/null +++ b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst @@ -0,0 +1,130 @@ +.. _obtaining-and-building-ctsm: + +.. highlight:: shell + +======================================= + Obtaining and building CTSM and LILAC +======================================= + +This section describes the process for obtaining and building the CTSM library and its +dependencies, and linking to these libraries in an atmosphere model's build. + +Quick start example +=================== + +The basic process for obtaining and building CTSM is the following: + +Obtain CTSM by running:: + + git clone https://github.com/ESCOMP/CTSM.git + cd CTSM + ./manage_externals/checkout_externals + +Then build CTSM and its dependencies. On a machine that has been ported to CIME, the +command will look like this (example given for NCAR's ``cheyenne`` machine):: + + ./build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne + +On a machine that has *not* been ported to CIME, you will need to provide some additional +information. Run ``build_ctsm -h`` for details, but the basic command will look like +this:: + + ./build_ctsm ~/ctsm_build_dir --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default + +.. _building-ctsm-and-lilac-prerequisites: + +Prerequisites +============= + +Building CTSM requires: + +- a Unix-like operating system (Linux, AIX, OS X, etc.) + +- git version 1.8 or newer + +- python3 + + - The default version of python (when you run python without specifying 2 vs. 3) should + be python3 + +- perl version 5 + +- a GNU version of the make tool (gmake) + +- CMake + +- Fortran and C compilers + + - See https://github.com/escomp/cesm#details-on-fortran-compiler-versions for + information on compiler versions known to work with CESM, and thus CTSM. + +- LAPACK and BLAS libraries + +- a NetCDF library version 4.3 or newer built with the same compiler you will use for CTSM + + - a PnetCDF library is optional + +- a functioning MPI environment + + - typically, this includes compiler wrappers like ``mpif90`` and ``mpicc`` + +Obtaining CTSM +============== + +CTSM and its dependencies (excluding the :ref:`prerequisites noted +above`) can be obtained with:: + + git clone https://github.com/ESCOMP/CTSM.git + cd CTSM + ./manage_externals/checkout_externals + +By default, this will put you on the ``master`` branch of CTSM, which is the main +development branch. You can checkout a different branch or tag using ``git checkout``; +**be sure to rerun** ``./manage_externals/checkout_externals`` **after doing so.** + +For more details, see +https://github.com/ESCOMP/CTSM/wiki/Quick-start-to-CTSM-development-with-git + +Building CTSM and its dependencies, and including CTSM in the atmosphere model's build +====================================================================================== + +Overview +-------- + +CTSM provides a build script, ``build_ctsm`` for building CTSM and its dependencies. (The +dependencies built with this build script include various libraries that are packaged with +CIME_. This does *not* build the :ref:`prerequisites noted +above`: it is assumed that those are already built +on your machine.) + +There are two possible workflows for building CTSM and its dependencies. The first works +if you are using a machine that has been ported to CIME_; the second works if you are +using a machine that has *not* been ported to CIME_. Both workflows are described +below. If you are using a machine that has not been ported to CIME, it is possible to do a +complete CIME port and then use the first workflow (by following the `CIME porting guide +`_), but +it is generally simpler to use the second workflow below. + +There is a third usage where you simply want to rebuild after making some source code +changes to CTSM. This is also documented below. + +All of these workflows use CIME's build system behind the scenes. Typically, you will not +need to be aware of any of those details, but if problems arise, you may want to consult +the `CIME documentation `_. + +Building on a CIME-supported machine +------------------------------------ + + + +Rebuilding after changing CTSM source code +------------------------------------------ + +To rebuild after changing CTSM source code, you should follow one of the above workflows, +but the ``build_ctsm`` command will simply be:: + + ./build_ctsm /PATH/TO/CTSM/BUILD --rebuild + +where ``/PATH/TO/CTSM/BUILD`` should point to the same directory you originally used. + +.. _CIME: https://github.com/esmci/cime diff --git a/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst new file mode 100644 index 0000000000..1ef397db97 --- /dev/null +++ b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst @@ -0,0 +1,11 @@ +.. _setting-ctsm-runtime-options: + +.. highlight:: shell + +============================== + Setting CTSM runtime options +============================== + +.. todo:: + + TODO: write this section diff --git a/doc/source/lilac/specific-atm-models/index.rst b/doc/source/lilac/specific-atm-models/index.rst new file mode 100644 index 0000000000..04a1976253 --- /dev/null +++ b/doc/source/lilac/specific-atm-models/index.rst @@ -0,0 +1,10 @@ +.. _specific-atm-models: + +===================================== + Notes on specific atmosphere models +===================================== + +.. toctree:: + :maxdepth: 2 + + wrf.rst diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst new file mode 100644 index 0000000000..0a5813a659 --- /dev/null +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -0,0 +1,9 @@ +.. _wrf: + +===================== + Using CTSM with WRF +===================== + +.. todo:: + + TODO: write this section From 915a9e6e599263c324ccbe0b5b3a497174de7ea7 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 3 Jun 2020 16:55:49 -0600 Subject: [PATCH 352/556] Fix section underline lengths --- .../CLM50_Tech_Note_Crop_Irrigation.rst | 54 +++++++++---------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/doc/source/tech_note/Crop_Irrigation/CLM50_Tech_Note_Crop_Irrigation.rst b/doc/source/tech_note/Crop_Irrigation/CLM50_Tech_Note_Crop_Irrigation.rst index 6fb9da4c55..a0a0778e45 100644 --- a/doc/source/tech_note/Crop_Irrigation/CLM50_Tech_Note_Crop_Irrigation.rst +++ b/doc/source/tech_note/Crop_Irrigation/CLM50_Tech_Note_Crop_Irrigation.rst @@ -1,12 +1,12 @@ .. _rst_Crops and Irrigation: Crops and Irrigation -======================== +==================== .. _Summary of CLM5.0 updates relative to the CLM4.5: Summary of CLM5.0 updates relative to the CLM4.5 ------------------------------------------------------ +------------------------------------------------ We describe here the complete crop and irrigation parameterizations that appear in CLM5.0. Corresponding information for CLM4.5 appeared in the @@ -42,7 +42,7 @@ These updates appear in detail in the sections below. Many also appear in Available new features since the CLM5 release -^^^^^^^^^^^^^^^^^^^ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Addition of bioenergy crops @@ -51,10 +51,10 @@ Available new features since the CLM5 release .. _The crop model: The crop model: cash and bioenergy crops -------------------- +---------------------------------------- Introduction -^^^^^^^^^^^^^^^^^^^ +^^^^^^^^^^^^ Groups developing Earth System Models generally account for the human footprint on the landscape in simulations of historical and future @@ -93,7 +93,7 @@ phenology, and allocation, as well as fertilizer and irrigation management. .. _Crop plant functional types: Crop plant functional types -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +^^^^^^^^^^^^^^^^^^^^^^^^^^^ To allow crops to coexist with natural vegetation in a grid cell, the vegetated land unit is separated into a naturally vegetated land unit and @@ -230,7 +230,7 @@ managed crop types that are using the same parameter set. .. _Phenology: Phenology -^^^^^^^^^^^^^^^^ +^^^^^^^^^ CLM5-BGC includes evergreen, seasonally deciduous (responding to changes in day length), and stress deciduous (responding to changes in @@ -246,7 +246,7 @@ maturity and harvest. .. _Planting: Planting -''''''''''''''''' +'''''''' All crops must meet the following requirements between the minimum planting date and the maximum planting date (for the northern hemisphere) in :numref:`Table Crop phenology parameters`: @@ -318,7 +318,7 @@ the range for that day. :math:`{T}_{f}` is the freezing temperature of water and .. _Leaf emergence: Leaf emergence -''''''''''''''''''''''' +'''''''''''''' According to AgroIBIS, leaves may emerge when the growing degree-days of soil temperature to 0.05 m depth (:math:`GDD_{T_{soi} }` ), which is tracked since planting, @@ -335,7 +335,7 @@ the carbon allocation algorithm in section :numref:`Leaf emergence to grain fill .. _Grain fill: Grain fill -''''''''''''''''''' +'''''''''' The grain fill phase (phase 3) begins in one of two ways. The first potential trigger is based on temperature, similar to phase 2. A variable tracked since planting, similar to :math:`GDD_{T_{soi} }` but for 2-m air temperature, @@ -352,7 +352,7 @@ leaf longevity for the pft as done in the BGC part of the model. .. _Harvest: Harvest -'''''''''''''''' +''''''' Harvest is assumed to occur as soon as the crop reaches maturity. When :math:`GDD_{T_{{\rm 2m}} }` reaches 100% of :math:`{GDD}_{mat}` or @@ -407,7 +407,7 @@ fcur is the fraction of allocation that goes to currently displayed growth. .. _Allocation: Allocation -^^^^^^^^^^^^^^^^^ +^^^^^^^^^^ Allocation changes based on the crop phenology phases phenology (section :numref:`Phenology`). Simulated C assimilation begins every year upon leaf emergence in phase @@ -447,8 +447,8 @@ respiration had not taken place. .. _Leaf emergence to grain fill: -Leaf emergence -''''''''''''''''''''''''''''''''''''' +Leaf emergence +'''''''''''''' During phase 2, the allocation coefficients (fraction of available C) to each C pool are defined as: @@ -467,8 +467,8 @@ exclusively to the fine roots. .. _Grain fill to harvest: -Grain fill -'''''''''''''''''''''''''''''' +Grain fill +'''''''''' The calculation of :math:`a_{froot}` remains the same from phase 2 to phase 3. During grain fill (phase 3), other allocation coefficients change to: @@ -497,7 +497,7 @@ coefficients (:numref:`Table Crop allocation parameters`). .. _Nitrogen retranslocation for crops: Nitrogen retranslocation for crops -'''''''''''''''''''''''''''''''''''''' +'''''''''''''''''''''''''''''''''' Nitrogen retranslocation in crops occurs when nitrogen that was used for tissue growth of leaves, stems, and fine roots during the early growth @@ -551,7 +551,7 @@ fulfill plant nitrogen demands. .. _Harvest to food and seed: Harvest -'''''''''''''''''''''''''''''' +''''''' Variables track the flow of grain C and N to food and of all other plant pools, including live stem C and N, to litter, and to biofuel feedstock. A fraction (determined by the :math:`biofuel\_harvfrac`, defined in @@ -712,12 +712,12 @@ the target C:N ratios used during the leaf emergence phase (phase 2). .. _Other Features: Other Features -^^^^^^^^^^^^^^^^^^^^^^^ +^^^^^^^^^^^^^^ .. _Physical Crop Characteristics: Physical Crop Characteristics -'''''''''''''''''''''''''''''' +''''''''''''''''''''''''''''' Leaf area index (*L*) is calculated as a function of specific leaf area (SLA, :numref:`Table Crop phenology parameters`) and leaf C. Stem area index (*S*) is equal to 0.1\ *L* for temperate and tropical corn, sugarcane, switchgrass, and miscanthus and 0.2\ *L* for @@ -742,8 +742,8 @@ and :math:`L_{\max }` is the maximum leaf area index (:numref:`Table Crop alloca .. _Interactive fertilization: -Interactive Fertilization -'''''''''''''''''''''''''''''' +Interactive Fertilization +''''''''''''''''''''''''' CLM simulates fertilization by adding nitrogen directly to the soil mineral nitrogen pool to meet crop nitrogen demands using both industrial fertilizer and manure application. CLM’s separate crop land unit ensures that natural vegetation will not access the fertilizer applied to crops. @@ -790,7 +790,7 @@ the counter is reached. .. _Biological nitrogen fixation for soybeans: Biological nitrogen fixation for soybeans -'''''''''''''''''''''''''''''''''''''''''' +''''''''''''''''''''''''''''''''''''''''' Biological N fixation for soybeans is calculated by the fixation and uptake of nitrogen module (Chapter :numref:`rst_FUN`) and is the same as N fixation in natural vegetation. Unlike natural vegetation, where a fraction of each pft are N fixers, all soybeans @@ -798,8 +798,8 @@ are treated as N fixers. .. _Latitude vary base tempereature for growing degree days: -Latitudinal variation in base growth tempereature -'''''''''''''''''''''''''''''''''''''''''''''''''''''''' +Latitudinal variation in base growth tempereature +''''''''''''''''''''''''''''''''''''''''''''''''' For most crops, :math:`GDD_{T_{{\rm 2m}} }` (growing degree days since planting) is the same in all locations. However, the for both rainfed and irrigated spring wheat and sugarcane, the calculation of @@ -822,7 +822,7 @@ and sugarcane. .. _Separate reproductive pool: Separate reproductive pool -'''''''''''''''''''''''''''''' +'''''''''''''''''''''''''' One notable difference between natural vegetation and crops is the presence of reproductive carbon and nitrogen pools. Accounting for the reproductive pools helps determine whether crops are performing @@ -839,7 +839,7 @@ nitrogen are available for grain development. .. _The irrigation model: The irrigation model -------------------------- +-------------------- The CLM includes the option to irrigate cropland areas that are equipped for irrigation. The application of irrigation responds dynamically to From e4cc5a03b5843b2e068e51bfef2fa901cfc8e18f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 4 Jun 2020 00:54:22 -0600 Subject: [PATCH 353/556] Set jmaxb1 to 0.17 and set paramfile with leaf changes for arctic plants to compensate for LUNA bugs #953 and #958 --- bld/namelist_files/namelist_defaults_ctsm.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 825db0fc30..195b8946fd 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -372,7 +372,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/clm5_params.c200402.nc +lnd/clm2/paramdata/clm5_params.c200604.nc lnd/clm2/paramdata/clm_params.c200402.nc @@ -421,7 +421,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .true. .true. -0.093563 +0.17 .false. .false. From 9f3bf0a907cff999acf0a72a1e2cb66dbfae8853 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 4 Jun 2020 12:56:53 -0600 Subject: [PATCH 354/556] Update params file so it contains the c200519 update as well as the needed updates from @olyon --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 4634a5f028..57a1fd5743 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -393,7 +393,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/clm5_params.c200604a.nc +lnd/clm2/paramdata/clm5_params.c200604b.nc lnd/clm2/paramdata/clm_params.c200519.nc From 67ff176028963eb88a2d3117d3080798df27bac5 Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Fri, 5 Jun 2020 12:50:36 -0600 Subject: [PATCH 355/556] Add new SE grids --- bld/namelist_files/namelist_defaults_ctsm.xml | 65 +++++++++++++++++-- .../namelist_definition_ctsm.xml | 4 +- 2 files changed, 62 insertions(+), 7 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 266e3178b9..c9f287e04c 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -793,10 +793,26 @@ lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1x1_numaIA_hist_78pfts_CMIP6_si lnd/clm2/surfdata_map/ctsm1.0.dev094-2-g633be0eb/surfdata_1x1_smallvilleIA_hist_78pfts_CMIP6_simyr2000_c200521.nc - -lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_ne30np4_hist_78pfts_CMIP6_simyr2000_c190303.nc lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_ne16np4_hist_78pfts_CMIP6_simyr2000_c190214.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4_hist_78pfts_CMIP6_simyr2000_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg2_hist_78pfts_CMIP6_simyr2000_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg3_hist_78pfts_CMIP6_simyr2000_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4_hist_78pfts_CMIP6_simyr2000_c200427.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4.pg2_hist_78pfts_CMIP6_simyr2000_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4.pg3_hist_78pfts_CMIP6_simyr2000_c200427.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.ARCTICGRIS.ne30x8_hist_78pfts_CMIP6_simyr2000_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.ARCTIC.ne30x4_hist_78pfts_CMIP6_simyr2000_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts_CMIP6_simyr2000_c200426.nc @@ -824,7 +840,6 @@ lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_4x5_hist_16pfts_Irrig_CMIP6_sim lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1x1_brazil_hist_16pfts_Irrig_CMIP6_simyr1850_c190214.nc - lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_ne30np4_hist_16pfts_Irrig_CMIP6_simyr1850_c190303.nc @@ -859,7 +874,23 @@ lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1x1_numaIA_hist_78pfts_CMIP6_si lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1x1_brazil_hist_78pfts_CMIP6_simyr1850_c190214.nc -lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4_hist_78pfts_CMIP6_simyr1850_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg2_hist_78pfts_CMIP6_simyr1850_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg3_hist_78pfts_CMIP6_simyr1850_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4_hist_78pfts_CMIP6_simyr1850_c200427.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4.pg2_hist_78pfts_CMIP6_simyr1850_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4.pg3_hist_78pfts_CMIP6_simyr1850_c200427.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.ARCTICGRIS.ne30x8_hist_78pfts_CMIP6_simyr1850_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.ARCTIC.ne30x4_hist_78pfts_CMIP6_simyr1850_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts_CMIP6_simyr1850_c200426.nc lnd/clm2/surfdata_map/landuse.timeseries_1x1_numaIA_hist_78pfts_CMIP6_simyr1850-2015_c170917.nc lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c179824.nc + use_crop=".true." >lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTIC.ne30x4_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc + lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_C24_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200317.nc lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_C96_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200317.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTIC.ne30x4_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc + lnd/clm2/surfdata_map/release-clm5.0.18/landuse.timeseries_0.9x1.25_SSP1-2.6_78pfts_CMIP6_simyr1850-2100_c190214.nc diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 5d142e4626..1da18f3722 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1953,7 +1953,7 @@ CLM run type. + valid_values="conus_30_x8,512x1024,360x720cru,128x256,64x128,48x96,94x192,0.23x0.31,0.47x0.63,0.9x1.25,1.9x2.5,2.5x3.33,4x5,10x15,0.125nldas2,5x5_amazon,1x1_camdenNJ,1x1_vancouverCAN,1x1_mexicocityMEX,1x1_asphaltjungleNJ,1x1_brazil,1x1_urbanc_alpha,1x1_numaIA,1x1_smallvilleIA,0.1x0.1,0.25x0.25,0.5x0.5,3x3min,5x5min,10x10min,0.33x0.33,0.125x0.125,ne4np4,ne16np4,ne30np4.pg2,ne30pg3,ne30np4,ne60np4,ne120np4,ne120np4.pg2,ne120np4.pg3,ne0np4CONUS.ne30x8,ne0np4.ARCTIC.ne30x4,ne0np4.ARCTICGRIS.ne30x8,ne240np4,1km-merge-10min,C24,C48,C96,C192,C384"> Horizontal resolutions Note: 0.1x0.1, 0.25x0.25, 0.5x0.5, 5x5min, 10x10min, 3x3min, 1km-merge-10min and 0.33x0.33 are only used for CLM toolsI @@ -1970,7 +1970,7 @@ hist means do NOT use a future scenario, just use historical data. + valid_values="USGS,gx3v7,gx1v6,gx1v7,navy,test,tx0.1v2,tx0.1v3,tx1v1,T62,cruncep,nldas2"> Land mask description From ceb56235efc9eda4c8629ae968c9219b427379b3 Mon Sep 17 00:00:00 2001 From: Keith Oleson Date: Mon, 8 Jun 2020 07:56:28 -0600 Subject: [PATCH 356/556] Building energy fix (issue #803). Performance verified through spreadsheet CTSM98_BUILDENERGY_Analysis_Pub --- src/biogeophys/UrbBuildTempOleson2015Mod.F90 | 60 +++++++++++--------- 1 file changed, 32 insertions(+), 28 deletions(-) diff --git a/src/biogeophys/UrbBuildTempOleson2015Mod.F90 b/src/biogeophys/UrbBuildTempOleson2015Mod.F90 index 462101d540..2b2e326c87 100644 --- a/src/biogeophys/UrbBuildTempOleson2015Mod.F90 +++ b/src/biogeophys/UrbBuildTempOleson2015Mod.F90 @@ -229,6 +229,7 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, integer, parameter :: neq = 5 ! number of equation/unknowns integer :: fc,fl,c,l ! indices real(r8) :: dtime ! land model time step (s) + real(r8) :: building_hwr(bounds%begl:bounds%endl) ! building height to building width ratio (-) real(r8) :: t_roof_inner_bef(bounds%begl:bounds%endl) ! roof inside surface temperature at previous time step (K) real(r8) :: t_sunw_inner_bef(bounds%begl:bounds%endl) ! sunwall inside surface temperature at previous time step (K) real(r8) :: t_shdw_inner_bef(bounds%begl:bounds%endl) ! shadewall inside surface temperature at previous time step (K) @@ -341,6 +342,7 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, ! See clm_varcon.F90 ! 3. Set inner surface emissivities (Bueno et al. 2012, GMD). ! 4. Set concrete floor properties (Salamanca et al. 2010, TAC). + ! 5. Calculate building height to building width ratio do fl = 1,num_urbanl l = filter_urbanl(fl) if (urbpoi(l)) then @@ -373,13 +375,15 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, cv_floori(l) = (dz_floori(l) * cp_floori(l)) / dtime ! Density of dry air at standard pressure and t_building (kg m-3) rho_dair(l) = pstd / (rair*t_building_bef(l)) + ! Building height to building width ratio + building_hwr(l) = canyon_hwr(l)*(1._r8-wtlunit_roof(l))/wtlunit_roof(l) end if end do ! Get terms from soil temperature equations to compute conduction flux ! Negative is toward surface - heat added ! Note that the conduction flux here is in W m-2 wall area but for purposes of solving the set of - ! simultaneous equations this must be converted to W m-2 ground area. This is done below when + ! simultaneous equations this must be converted to W m-2 floor area. This is done below when ! setting up the equation coefficients. do fc = 1,num_nolakec @@ -413,14 +417,14 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, l = filter_urbanl(fl) if (urbpoi(l)) then - vf_rf(l) = sqrt(1._r8 + canyon_hwr(l)**2._r8) - canyon_hwr(l) + vf_rf(l) = sqrt(1._r8 + building_hwr(l)**2._r8) - building_hwr(l) vf_fr(l) = vf_rf(l) ! This view factor implicitly converts from per unit wall area to per unit floor area vf_wf(l) = 0.5_r8*(1._r8 - vf_rf(l)) ! This view factor implicitly converts from per unit floor area to per unit wall area - vf_fw(l) = vf_wf(l) / canyon_hwr(l) + vf_fw(l) = vf_wf(l) / building_hwr(l) ! This view factor implicitly converts from per unit roof area to per unit wall area vf_rw(l) = vf_fw(l) @@ -515,8 +519,8 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_ww(l) & - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) - a(2,2) = 0.5_r8*hcv_sunwi(l)*canyon_hwr(l) & - + 0.5_r8*tk_sunw_innerl(l)/(zi_sunw_innerl(l) - z_sunw_innerl(l))*canyon_hwr(l) & + a(2,2) = 0.5_r8*hcv_sunwi(l)*building_hwr(l) & + + 0.5_r8*tk_sunw_innerl(l)/(zi_sunw_innerl(l) - z_sunw_innerl(l))*building_hwr(l) & + 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8 & - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_ww(l) & @@ -529,11 +533,11 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, a(2,4) = - 4._r8*em_sunwi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l) & - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) & - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_ww(l) - a(2,5) = - 0.5_r8*hcv_sunwi(l)*canyon_hwr(l) + a(2,5) = - 0.5_r8*hcv_sunwi(l)*building_hwr(l) - result(2) = 0.5_r8*tk_sunw_innerl(l)*t_sunw_innerl(l)/(zi_sunw_innerl(l) - z_sunw_innerl(l))*canyon_hwr(l) & + result(2) = 0.5_r8*tk_sunw_innerl(l)*t_sunw_innerl(l)/(zi_sunw_innerl(l) - z_sunw_innerl(l))*building_hwr(l) & - 0.5_r8*tk_sunw_innerl(l)*(t_sunw_inner_bef(l)-t_sunw_innerl_bef(l))/(zi_sunw_innerl(l) & - - z_sunw_innerl(l))*canyon_hwr(l) & + - z_sunw_innerl(l))*building_hwr(l) & - 3._r8*em_sunwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l) & - 3._r8*em_sunwi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_ww(l) & - 3._r8*em_sunwi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l) & @@ -547,7 +551,7 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) & - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) & - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_ww(l) & - - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) + - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*building_hwr(l) ! SHADEWALL a(3,1) = - 4._r8*em_shdwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l) & @@ -558,8 +562,8 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) & - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) - a(3,3) = 0.5_r8*hcv_shdwi(l)*canyon_hwr(l) & - + 0.5_r8*tk_shdw_innerl(l)/(zi_shdw_innerl(l) - z_shdw_innerl(l))*canyon_hwr(l) & + a(3,3) = 0.5_r8*hcv_shdwi(l)*building_hwr(l) & + + 0.5_r8*tk_shdw_innerl(l)/(zi_shdw_innerl(l) - z_shdw_innerl(l))*building_hwr(l) & + 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8 & - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_ww(l) & @@ -569,11 +573,11 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) & - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_ww(l) - a(3,5) = - 0.5_r8*hcv_shdwi(l)*canyon_hwr(l) + a(3,5) = - 0.5_r8*hcv_shdwi(l)*building_hwr(l) - result(3) = 0.5_r8*tk_shdw_innerl(l)*t_shdw_innerl(l)/(zi_shdw_innerl(l) - z_shdw_innerl(l))*canyon_hwr(l) & + result(3) = 0.5_r8*tk_shdw_innerl(l)*t_shdw_innerl(l)/(zi_shdw_innerl(l) - z_shdw_innerl(l))*building_hwr(l) & - 0.5_r8*tk_shdw_innerl(l)*(t_shdw_inner_bef(l)-t_shdw_innerl_bef(l))/(zi_shdw_innerl(l) & - - z_shdw_innerl(l))*canyon_hwr(l) & + - z_shdw_innerl(l))*building_hwr(l) & - 3._r8*em_shdwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l) & - 3._r8*em_shdwi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_ww(l) & - 3._r8*em_shdwi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l) & @@ -587,7 +591,7 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) & - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) & - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_ww(l) & - - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) + - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*building_hwr(l) ! FLOOR a(4,1) = - 4._r8*em_floori(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l) & @@ -628,24 +632,24 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, ! Building air temperature a(5,1) = - 0.5_r8*hcv_roofi(l) - a(5,2) = - 0.5_r8*hcv_sunwi(l)*canyon_hwr(l) + a(5,2) = - 0.5_r8*hcv_sunwi(l)*building_hwr(l) - a(5,3) = - 0.5_r8*hcv_shdwi(l)*canyon_hwr(l) + a(5,3) = - 0.5_r8*hcv_shdwi(l)*building_hwr(l) a(5,4) = - 0.5_r8*hcv_floori(l) a(5,5) = ((ht_roof(l)*rho_dair(l)*cpair)/dtime) + & ((ht_roof(l)*vent_ach)/3600._r8)*rho_dair(l)*cpair + & 0.5_r8*hcv_roofi(l) + & - 0.5_r8*hcv_sunwi(l)*canyon_hwr(l) + & - 0.5_r8*hcv_shdwi(l)*canyon_hwr(l) + & + 0.5_r8*hcv_sunwi(l)*building_hwr(l) + & + 0.5_r8*hcv_shdwi(l)*building_hwr(l) + & 0.5_r8*hcv_floori(l) result(5) = (ht_roof(l)*rho_dair(l)*cpair/dtime)*t_building_bef(l) & + ((ht_roof(l)*vent_ach)/3600._r8)*rho_dair(l)*cpair*taf(l) & + 0.5_r8*hcv_roofi(l)*(t_roof_inner_bef(l) - t_building_bef(l)) & - + 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) & - + 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) & + + 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*building_hwr(l) & + + 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*building_hwr(l) & + 0.5_r8*hcv_floori(l)*(t_floor_bef(l) - t_building_bef(l)) ! Solve equations @@ -826,7 +830,7 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, + em_floori(l)*sb*t_floor_bef(l)**4._r8 & + 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*(t_floor(l) - t_floor_bef(l)) - qrd_building(l) = qrd_roof(l) + canyon_hwr(l)*(qrd_sunw(l) + qrd_shdw(l)) + qrd_floor(l) + qrd_building(l) = qrd_roof(l) + building_hwr(l)*(qrd_sunw(l) + qrd_shdw(l)) + qrd_floor(l) if (abs(qrd_building(l)) > .10_r8 ) then write (iulog,*) 'urban inside building net longwave radiation balance error ',qrd_building(l) @@ -851,7 +855,7 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, qcd_sunw(l) = 0.5_r8*tk_sunw_innerl(l)*(t_sunw_inner(l) - t_sunw_innerl(l))/(zi_sunw_innerl(l) - z_sunw_innerl(l)) & + 0.5_r8*tk_sunw_innerl(l)*(t_sunw_inner_bef(l) - t_sunw_innerl_bef(l))/(zi_sunw_innerl(l) & - z_sunw_innerl(l)) - enrgy_bal_sunw(l) = qrd_sunw(l) + qcv_sunw(l)*canyon_hwr(l) + qcd_sunw(l)*canyon_hwr(l) + enrgy_bal_sunw(l) = qrd_sunw(l) + qcv_sunw(l)*building_hwr(l) + qcd_sunw(l)*building_hwr(l) if (abs(enrgy_bal_sunw(l)) > .10_r8 ) then write (iulog,*) 'urban inside sunwall energy balance error ',enrgy_bal_sunw(l) write (iulog,*) 'clm model is stopping' @@ -863,7 +867,7 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, qcd_shdw(l) = 0.5_r8*tk_shdw_innerl(l)*(t_shdw_inner(l) - t_shdw_innerl(l))/(zi_shdw_innerl(l) - z_shdw_innerl(l)) & + 0.5_r8*tk_shdw_innerl(l)*(t_shdw_inner_bef(l) - t_shdw_innerl_bef(l))/(zi_shdw_innerl(l) & - z_shdw_innerl(l)) - enrgy_bal_shdw(l) = qrd_shdw(l) + qcv_shdw(l)*canyon_hwr(l) + qcd_shdw(l)*canyon_hwr(l) + enrgy_bal_shdw(l) = qrd_shdw(l) + qcv_shdw(l)*building_hwr(l) + qcd_shdw(l)*building_hwr(l) if (abs(enrgy_bal_shdw(l)) > .10_r8 ) then write (iulog,*) 'urban inside shadewall energy balance error ',enrgy_bal_shdw(l) write (iulog,*) 'clm model is stopping' @@ -884,10 +888,10 @@ subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, - ht_roof(l)*(vent_ach/3600._r8)*rho_dair(l)*cpair*(taf(l) - t_building(l)) & - 0.5_r8*hcv_roofi(l)*(t_roof_inner(l) - t_building(l)) & - 0.5_r8*hcv_roofi(l)*(t_roof_inner_bef(l) - t_building_bef(l)) & - - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner(l) - t_building(l))*canyon_hwr(l) & - - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) & - - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner(l) - t_building(l))*canyon_hwr(l) & - - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) & + - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner(l) - t_building(l))*building_hwr(l) & + - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*building_hwr(l) & + - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner(l) - t_building(l))*building_hwr(l) & + - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*building_hwr(l) & - 0.5_r8*hcv_floori(l)*(t_floor(l) - t_building(l)) & - 0.5_r8*hcv_floori(l)*(t_floor_bef(l) - t_building_bef(l)) if (abs(enrgy_bal_buildair(l)) > .10_r8 ) then From 1a3f43291f0908bf00477958699495e633cef0f0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 8 Jun 2020 13:18:52 -0600 Subject: [PATCH 357/556] Work on documentation of lilac build --- .../obtaining-and-building-ctsm.rst | 63 +++++++++++++++++-- 1 file changed, 57 insertions(+), 6 deletions(-) diff --git a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst index 4b8e093b39..774b6a0ac9 100644 --- a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst +++ b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst @@ -31,6 +31,8 @@ this:: ./build_ctsm ~/ctsm_build_dir --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default +Further details on these commands are given below. + .. _building-ctsm-and-lilac-prerequisites: Prerequisites @@ -85,13 +87,13 @@ development branch. You can checkout a different branch or tag using ``git check For more details, see https://github.com/ESCOMP/CTSM/wiki/Quick-start-to-CTSM-development-with-git -Building CTSM and its dependencies, and including CTSM in the atmosphere model's build -====================================================================================== +Building CTSM and its dependencies +================================== Overview -------- -CTSM provides a build script, ``build_ctsm`` for building CTSM and its dependencies. (The +CTSM provides a build script, ``build_ctsm``, for building CTSM and its dependencies. (The dependencies built with this build script include various libraries that are packaged with CIME_. This does *not* build the :ref:`prerequisites noted above`: it is assumed that those are already built @@ -103,19 +105,58 @@ using a machine that has *not* been ported to CIME_. Both workflows are describe below. If you are using a machine that has not been ported to CIME, it is possible to do a complete CIME port and then use the first workflow (by following the `CIME porting guide `_), but -it is generally simpler to use the second workflow below. +unless you need to do so for other reasons (such as running CESM, or running CTSM in a +land-only configuration forced by a data atmosphere, using the CIME_ scripting +infrastructure), it is generally simpler to use the second workflow below: A full CIME +port requires many settings that are not needed for just building CTSM. There is a third usage where you simply want to rebuild after making some source code changes to CTSM. This is also documented below. All of these workflows use CIME's build system behind the scenes. Typically, you will not need to be aware of any of those details, but if problems arise, you may want to consult -the `CIME documentation `_. +the `CIME documentation`_. Building on a CIME-supported machine ------------------------------------ +If you are using a machine that has been ported to CIME_ (for example, NCAR's ``cheyenne`` +machine), then you do not need to specify much information to ``build_ctsm``. In addition, +in this case, CIME will load the appropriate modules and set the appropriate environment +variables at build time, so you do not need to do anything to set up your environment +ahead of time. + +To build CTSM and its dependencies in this case, run:: + + ./build_ctsm /PATH/TO/CTSM/BUILD --machine MACHINE --compiler COMPILER + +where you should fill in the capitalized arguments with appropriate values for your +machine. + +.. note:: + + The given directory (``/PATH/TO/CTSM/BUILD``) must *not* exist. This directory is + created for you by the build script. + +Some other options to ``build_ctsm`` are supported in this case (but many are not, since +they are only applicable to the non-CIME-supported machine workflow); run ``build_ctsm +-h`` for details. +Besides the build files themselves, there are two key files that are needed for the build +of the atmosphere model: + +1. ``/PATH/TO/CTSM/BUILD/ctsm.mk``: This Makefile-formatted file gives variables that + should be set in the atmosphere model's build. :ref:`See below for information on how + to use this file`. + +2. ``/PATH/TO/CTSM/BUILD/ctsm_build_environment.sh`` or + ``/PATH/TO/CTSM/BUILD/ctsm_build_environment.csh``: These files specify the build + environment that CIME used to build CTSM and its dependencies. **Before building the + atmosphere model, you should source the appropriate file** (based on your shell - use + the ``.sh`` file for bash and similar shells, and the ``.csh`` file for tcsh and + similar shells). **This will ensure that the atmosphere model is built with the same + compiler and library versions as CTSM.** For example, with bash: ``source + /PATH/TO/CTSM/BUILD/ctsm_build_environment.sh``. Rebuilding after changing CTSM source code ------------------------------------------ @@ -127,4 +168,14 @@ but the ``build_ctsm`` command will simply be:: where ``/PATH/TO/CTSM/BUILD`` should point to the same directory you originally used. -.. _CIME: https://github.com/esmci/cime +.. _including-ctsm-in-the-atmosphere-model-build: + +Including CTSM in the atmosphere model's build +============================================== + +.. todo:: + + TODO: Fill this section in + +.. _CIME: http://esmci.github.io/cime +.. _CIME documentation: http://esmci.github.io/cime From 8b64635e9b5c3f6507e9607139a81e22d46f866f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 8 Jun 2020 16:50:18 -0600 Subject: [PATCH 358/556] Add information on build --- .../obtaining-and-building-ctsm.rst | 107 +++++++++++++++++- 1 file changed, 101 insertions(+), 6 deletions(-) diff --git a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst index 774b6a0ac9..e6254bb643 100644 --- a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst +++ b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst @@ -70,6 +70,10 @@ Building CTSM requires: - typically, this includes compiler wrappers like ``mpif90`` and ``mpicc`` +- ESMF version 8 or later + + - **ESMF is not needed in general for CTSM, but is needed for LILAC** + Obtaining CTSM ============== @@ -117,6 +121,8 @@ All of these workflows use CIME's build system behind the scenes. Typically, you need to be aware of any of those details, but if problems arise, you may want to consult the `CIME documentation`_. +.. _building-on-a-cime-supported-machine: + Building on a CIME-supported machine ------------------------------------ @@ -124,7 +130,10 @@ If you are using a machine that has been ported to CIME_ (for example, NCAR's `` machine), then you do not need to specify much information to ``build_ctsm``. In addition, in this case, CIME will load the appropriate modules and set the appropriate environment variables at build time, so you do not need to do anything to set up your environment -ahead of time. +ahead of time. **Building CTSM with LILAC requires ESMF. ESMF is currently an optional +CIME dependency, so many CIME-ported machines do not provide information on an ESMF +installation. NCAR's cheyenne machine DOES provide ESMF, but for other machines, you may +need to add this to your CIME port.** To build CTSM and its dependencies in this case, run:: @@ -139,11 +148,11 @@ machine. created for you by the build script. Some other options to ``build_ctsm`` are supported in this case (but many are not, since -they are only applicable to the non-CIME-supported machine workflow); run ``build_ctsm +they are only applicable to the non-CIME-supported machine workflow); run ``./build_ctsm -h`` for details. -Besides the build files themselves, there are two key files that are needed for the build -of the atmosphere model: +Besides the build files themselves, ``build_ctsm`` creates the following important files +that are needed for the build of the atmosphere model: 1. ``/PATH/TO/CTSM/BUILD/ctsm.mk``: This Makefile-formatted file gives variables that should be set in the atmosphere model's build. :ref:`See below for information on how @@ -158,6 +167,55 @@ of the atmosphere model: compiler and library versions as CTSM.** For example, with bash: ``source /PATH/TO/CTSM/BUILD/ctsm_build_environment.sh``. +Building on a machine that has not been ported to CIME +------------------------------------------------------ + +If you are using a machine thata has not been ported to CIME_, then you need to specify +additional information to ``build_ctsm`` that is needed by the build system. Before +building CTSM, you should load any modules required by the atmosphere model or CTSM +builds, including all of the :ref:`prerequisites noted +above`. + +The minimal amount of information needed is given by the following:: + + ./build_ctsm /PATH/TO/CTSM/BUILD --compiler COMPILER --os OS --netcdf-path NETCDF_PATH --esmf-lib-path ESMF_LIB_PATH + +where you should fill in the capitalized arguments with appropriate values for your +machine. Run ``./build_ctsm -h`` for details on these arguments, as well as documentation +of additional, optional arguments. Some of these optional arguments may be needed for +successful compilation, while others (such as ``--pnetcdf-path``) may be needed for good +model performance. + +.. note:: + + The given directory (``/PATH/TO/CTSM/BUILD``) must *not* exist. This directory is + created for you by the build script. + +Example usage for a Mac (a simple case) is:: + + ./build_ctsm ~/ctsm_build_dir --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default + +Example usage for NCAR's ``cheyenne`` machine (a more complex case) is:: + + module purge + module load ncarenv/1.3 intel/19.0.5 esmf_libs mkl + module use /glade/work/himanshu/PROGS/modulefiles/esmfpkgs/intel/19.0.5 + module load esmf-8.1.0b14-ncdfio-mpt-O mpt/2.21 netcdf/4.7.3 pnetcdf/1.12.1 ncarcompilers/0.5.0 + module load python + + ./build_ctsm /glade/scratch/$USER/ctsm_build_dir --os linux --compiler intel --netcdf-path '$ENV{NETCDF}' --pio-filesystem-hints gpfs --pnetcdf-path '$ENV{PNETCDF}' --esmf-lib-path '$ENV{ESMF_LIBDIR}' --extra-cflags '-xCORE_AVX2 -no-fma' --extra-fflags '-xCORE_AVX2 -no-fma' + +(It's better to use the :ref:`alternative process for a CIME-supported +machine` in this case, but the above illustrates +what would be needed for a machine similar to this that has not been ported to CIME.) + +Besides the build files themselves, ``build_ctsm`` creates an important file that is +needed for the build of the atmosphere model: ``/PATH/TO/CTSM/BUILD/ctsm.mk``. This +Makefile-formatted file gives variables that should be set in the atmosphere model's +build. :ref:`See below for information on how to use this +file`. + + Rebuilding after changing CTSM source code ------------------------------------------ @@ -173,9 +231,46 @@ where ``/PATH/TO/CTSM/BUILD`` should point to the same directory you originally Including CTSM in the atmosphere model's build ============================================== -.. todo:: +Once you have successfully built CTSM and its dependencies, you will need to add various +paths to the compilation and link lines when building your atmosphere model. For a +Makefile-based build system, we facilitate this by producing a file, +``/PATH/TO/CTSM/BUILD/ctsm.mk``, which you can include in your own build script. (We do +not yet produce an equivalent for CMake or other build systems.) + +There are two important variables defined in this file: + +- ``CTSM_INCLUDES``: This variable should be included in the compilation line for the + atmosphere model's source files. It lists all paths that need to be included in these + compilations so that the compiler can find the appropriate Fortran module files. + +- ``CTSM_LIBS``: This variable should be included in the link line when creating the final + executable. It lists paths and library names that need to be included in the link + step. **Note: This may not include all of the libraries that are** + :ref:`prerequisites`, **such as LAPACK, BLAS and + NetCDF. If your atmosphere doesn't already require these, you may need to add + appropriate information to your atmosphere model's link line.** However, it should + already include all required link information for ESMF. + +Other variables in this file do not need to be included directly in the atmosphere model's +build (they are just intermediate variables used to create ``CTSM_INCLUDES`` and +``CTSM_LIBS``). + +For example, for the WRF build, we do the following: If building with CTSM, then we +expect that the user has set an environment variable:: + + export WRF_CTSM_MKFILE=/PATH/TO/CTSM/BUILD/ctsm.mk + +If that environment variable exists, then the ``configure`` script adds the following to +the Makefile-based build: + +- Adds an include line (like ``include ${WRF_CTSM_MKFILE}``) + +- Adds a CPP definition, ``-DWRF_USE_CTSM``, which is used to do conditional compilation + of the CTSM-LILAC interface code + +- Adds ``$(CTSM_INCLUDES)`` to its variable ``INCLUDE_MODULES`` - TODO: Fill this section in +- Adds ``$(CTSM_LIBS)`` to its variable ``LIB`` .. _CIME: http://esmci.github.io/cime .. _CIME documentation: http://esmci.github.io/cime From d418f969caac53dae6c61a08c333baaeb3a4c934 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 8 Jun 2020 17:04:12 -0600 Subject: [PATCH 359/556] Add to build documentation --- .../obtaining-and-building-ctsm.rst | 22 ++++++++++++++----- 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst index e6254bb643..f19857e510 100644 --- a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst +++ b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst @@ -9,8 +9,8 @@ This section describes the process for obtaining and building the CTSM library and its dependencies, and linking to these libraries in an atmosphere model's build. -Quick start example -=================== +Quick start example / overview +============================== The basic process for obtaining and building CTSM is the following: @@ -25,13 +25,23 @@ command will look like this (example given for NCAR's ``cheyenne`` machine):: ./build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne +and then, before building the atmosphere model:: + + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh + On a machine that has *not* been ported to CIME, you will need to provide some additional information. Run ``build_ctsm -h`` for details, but the basic command will look like this:: ./build_ctsm ~/ctsm_build_dir --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default -Further details on these commands are given below. +In both cases, you will then need to include the necessary information in the include and +link lines of the atmosphere model's build. For a Makefile-based build, this can be done +by including the file ``/PATH/TO/CTSM/BUILD/ctsm.mk`` in the atmosphere model's build +scripts, then adding ``CTSM_INCLUDES`` to the include line and ``CTSM_LIBS`` to the link +line. + +Further details on these steps are given below. .. _building-ctsm-and-lilac-prerequisites: @@ -172,8 +182,8 @@ Building on a machine that has not been ported to CIME If you are using a machine thata has not been ported to CIME_, then you need to specify additional information to ``build_ctsm`` that is needed by the build system. Before -building CTSM, you should load any modules required by the atmosphere model or CTSM -builds, including all of the :ref:`prerequisites noted +building CTSM, you should load any modules and/or set any environment variables required +by the atmosphere model or CTSM builds, including all of the :ref:`prerequisites noted above`. The minimal amount of information needed is given by the following:: @@ -263,7 +273,7 @@ expect that the user has set an environment variable:: If that environment variable exists, then the ``configure`` script adds the following to the Makefile-based build: -- Adds an include line (like ``include ${WRF_CTSM_MKFILE}``) +- Includes the ``ctsm.mk`` file (like ``include ${WRF_CTSM_MKFILE}``) - Adds a CPP definition, ``-DWRF_USE_CTSM``, which is used to do conditional compilation of the CTSM-LILAC interface code From 3be13efb5cd9d1be1060775ddec6980c61d1b72e Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Mon, 8 Jun 2020 18:47:14 -0600 Subject: [PATCH 360/556] Add var-res grids needed for CAM. --- bld/namelist_files/namelist_defaults_ctsm.xml | 64 +++++----- cime_config/config_pes.xml | 111 ++++++++++++++++++ cime_config/testdefs/testlist_clm.xml | 45 +++++++ 3 files changed, 188 insertions(+), 32 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index c9f287e04c..e8a3e4175c 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -793,25 +793,25 @@ lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1x1_numaIA_hist_78pfts_CMIP6_si lnd/clm2/surfdata_map/ctsm1.0.dev094-2-g633be0eb/surfdata_1x1_smallvilleIA_hist_78pfts_CMIP6_simyr2000_c200521.nc - + lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_ne16np4_hist_78pfts_CMIP6_simyr2000_c190214.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4_hist_78pfts_CMIP6_simyr2000_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg2_hist_78pfts_CMIP6_simyr2000_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg3_hist_78pfts_CMIP6_simyr2000_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4_hist_78pfts_CMIP6_simyr2000_c200427.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4.pg2_hist_78pfts_CMIP6_simyr2000_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4.pg3_hist_78pfts_CMIP6_simyr2000_c200427.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.ARCTICGRIS.ne30x8_hist_78pfts_CMIP6_simyr2000_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.ARCTIC.ne30x4_hist_78pfts_CMIP6_simyr2000_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts_CMIP6_simyr2000_c200426.nc @@ -873,23 +873,23 @@ lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1x1_numaIA_hist_78pfts_CMIP6_si lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1x1_brazil_hist_78pfts_CMIP6_simyr1850_c190214.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4_hist_78pfts_CMIP6_simyr1850_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg2_hist_78pfts_CMIP6_simyr1850_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg3_hist_78pfts_CMIP6_simyr1850_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4_hist_78pfts_CMIP6_simyr1850_c200427.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4.pg2_hist_78pfts_CMIP6_simyr1850_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4.pg3_hist_78pfts_CMIP6_simyr1850_c200427.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.ARCTICGRIS.ne30x8_hist_78pfts_CMIP6_simyr1850_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.ARCTIC.ne30x4_hist_78pfts_CMIP6_simyr1850_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts_CMIP6_simyr1850_c200426.nc @@ -933,18 +933,18 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts lnd/clm2/surfdata_map/landuse.timeseries_1x1_numaIA_hist_78pfts_CMIP6_simyr1850-2015_c170917.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTIC.ne30x4_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTIC.ne30x4_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc + +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_C24_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200317.nc @@ -979,7 +979,7 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts use_crop=".true." >lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTIC.ne30x4_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index db9410ad12..0d1559791d 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -409,6 +409,117 @@ + + + + none + + -8 + -8 + -8 + -8 + -8 + -8 + -8 + -8 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -8 + -8 + -8 + -8 + -8 + -8 + -8 + -8 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + none + + -8 + -8 + -8 + -8 + -8 + -8 + -8 + -8 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index fd2b6cbc3c..26860d84a8 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1140,6 +1140,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From 6801e5255a5bc57efa11554ab82e99f5c662a634 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 9 Jun 2020 07:32:20 -0600 Subject: [PATCH 361/556] Move build_ctsm into lilac subdirectory, and tweak documentation People were concerned that having build_ctsm at the top level would be confusing to people who are using this without lilac. --- .../obtaining-building-and-running/index.rst | 6 ++-- .../obtaining-and-building-ctsm.rst | 34 ++++++++++++------- build_ctsm => lilac/build_ctsm | 0 3 files changed, 24 insertions(+), 16 deletions(-) rename build_ctsm => lilac/build_ctsm (100%) diff --git a/doc/source/lilac/obtaining-building-and-running/index.rst b/doc/source/lilac/obtaining-building-and-running/index.rst index a1386fe909..7f18c180f7 100644 --- a/doc/source/lilac/obtaining-building-and-running/index.rst +++ b/doc/source/lilac/obtaining-building-and-running/index.rst @@ -1,8 +1,8 @@ .. _obtaining-building-and-running: -====================================== - Obtaining, building and running CTSM -====================================== +================================================= + Obtaining, building and running CTSM with LILAC +================================================= .. toctree:: :maxdepth: 2 diff --git a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst index f19857e510..04ae3b6236 100644 --- a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst +++ b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst @@ -9,6 +9,14 @@ This section describes the process for obtaining and building the CTSM library and its dependencies, and linking to these libraries in an atmosphere model's build. +.. important:: + + This documentation only applies to the process where you are building CTSM with LILAC + for use in an atmosphere model that has *not* been integrated with CESM or CIME. If you + are using CTSM within CESM, or running CTSM in land-only mode with a data atmosphere, + then you should refer to the :ref:`general CTSM user's guide` as well as + the `CIME documentation`_. + Quick start example / overview ============================== @@ -23,17 +31,17 @@ Obtain CTSM by running:: Then build CTSM and its dependencies. On a machine that has been ported to CIME, the command will look like this (example given for NCAR's ``cheyenne`` machine):: - ./build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne + ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne and then, before building the atmosphere model:: source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh On a machine that has *not* been ported to CIME, you will need to provide some additional -information. Run ``build_ctsm -h`` for details, but the basic command will look like -this:: +information. Run ``./lilac/build_ctsm -h`` for details, but the basic command will look +like this:: - ./build_ctsm ~/ctsm_build_dir --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default + ./lilac/build_ctsm ~/ctsm_build_dir --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default In both cases, you will then need to include the necessary information in the include and link lines of the atmosphere model's build. For a Makefile-based build, this can be done @@ -107,7 +115,7 @@ Building CTSM and its dependencies Overview -------- -CTSM provides a build script, ``build_ctsm``, for building CTSM and its dependencies. (The +CTSM provides a build script, ``lilac/build_ctsm``, for building CTSM and its dependencies. (The dependencies built with this build script include various libraries that are packaged with CIME_. This does *not* build the :ref:`prerequisites noted above`: it is assumed that those are already built @@ -147,7 +155,7 @@ need to add this to your CIME port.** To build CTSM and its dependencies in this case, run:: - ./build_ctsm /PATH/TO/CTSM/BUILD --machine MACHINE --compiler COMPILER + ./lilac/build_ctsm /PATH/TO/CTSM/BUILD --machine MACHINE --compiler COMPILER where you should fill in the capitalized arguments with appropriate values for your machine. @@ -158,8 +166,8 @@ machine. created for you by the build script. Some other options to ``build_ctsm`` are supported in this case (but many are not, since -they are only applicable to the non-CIME-supported machine workflow); run ``./build_ctsm --h`` for details. +they are only applicable to the non-CIME-supported machine workflow); run +``./lilac/build_ctsm -h`` for details. Besides the build files themselves, ``build_ctsm`` creates the following important files that are needed for the build of the atmosphere model: @@ -188,10 +196,10 @@ above`. The minimal amount of information needed is given by the following:: - ./build_ctsm /PATH/TO/CTSM/BUILD --compiler COMPILER --os OS --netcdf-path NETCDF_PATH --esmf-lib-path ESMF_LIB_PATH + ./lilac/build_ctsm /PATH/TO/CTSM/BUILD --compiler COMPILER --os OS --netcdf-path NETCDF_PATH --esmf-lib-path ESMF_LIB_PATH where you should fill in the capitalized arguments with appropriate values for your -machine. Run ``./build_ctsm -h`` for details on these arguments, as well as documentation +machine. Run ``./lilac/build_ctsm -h`` for details on these arguments, as well as documentation of additional, optional arguments. Some of these optional arguments may be needed for successful compilation, while others (such as ``--pnetcdf-path``) may be needed for good model performance. @@ -203,7 +211,7 @@ model performance. Example usage for a Mac (a simple case) is:: - ./build_ctsm ~/ctsm_build_dir --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default + ./lilac/build_ctsm ~/ctsm_build_dir --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default Example usage for NCAR's ``cheyenne`` machine (a more complex case) is:: @@ -213,7 +221,7 @@ Example usage for NCAR's ``cheyenne`` machine (a more complex case) is:: module load esmf-8.1.0b14-ncdfio-mpt-O mpt/2.21 netcdf/4.7.3 pnetcdf/1.12.1 ncarcompilers/0.5.0 module load python - ./build_ctsm /glade/scratch/$USER/ctsm_build_dir --os linux --compiler intel --netcdf-path '$ENV{NETCDF}' --pio-filesystem-hints gpfs --pnetcdf-path '$ENV{PNETCDF}' --esmf-lib-path '$ENV{ESMF_LIBDIR}' --extra-cflags '-xCORE_AVX2 -no-fma' --extra-fflags '-xCORE_AVX2 -no-fma' + ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --os linux --compiler intel --netcdf-path '$ENV{NETCDF}' --pio-filesystem-hints gpfs --pnetcdf-path '$ENV{PNETCDF}' --esmf-lib-path '$ENV{ESMF_LIBDIR}' --extra-cflags '-xCORE_AVX2 -no-fma' --extra-fflags '-xCORE_AVX2 -no-fma' (It's better to use the :ref:`alternative process for a CIME-supported machine` in this case, but the above illustrates @@ -232,7 +240,7 @@ Rebuilding after changing CTSM source code To rebuild after changing CTSM source code, you should follow one of the above workflows, but the ``build_ctsm`` command will simply be:: - ./build_ctsm /PATH/TO/CTSM/BUILD --rebuild + ./lilac/build_ctsm /PATH/TO/CTSM/BUILD --rebuild where ``/PATH/TO/CTSM/BUILD`` should point to the same directory you originally used. diff --git a/build_ctsm b/lilac/build_ctsm similarity index 100% rename from build_ctsm rename to lilac/build_ctsm From 42f0494adf7e8b8104bcdb2eab4666862e0082f5 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 9 Jun 2020 13:18:21 -0600 Subject: [PATCH 362/556] Fix build_ctsm for new location --- lilac/build_ctsm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lilac/build_ctsm b/lilac/build_ctsm index 04c184c355..cc3fd19f7e 100755 --- a/lilac/build_ctsm +++ b/lilac/build_ctsm @@ -4,7 +4,9 @@ import os import sys -_CTSM_PYTHON = os.path.join(os.path.dirname(os.path.abspath(__file__)), 'python') +_CTSM_PYTHON = os.path.join(os.path.dirname(os.path.abspath(__file__)), + os.pardir, + 'python') sys.path.insert(1, _CTSM_PYTHON) from ctsm.path_utils import add_cime_lib_to_path From f1a2442cfdfae4076e02789eba9a774fe21fedff Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 9 Jun 2020 16:12:47 -0600 Subject: [PATCH 363/556] add a system test of build_ctsm --- python/ctsm/build_ctsm.py | 4 +- python/ctsm/test/test_sys_build_ctsm.py | 78 +++++++++++++++++++++++++ 2 files changed, 80 insertions(+), 2 deletions(-) create mode 100644 python/ctsm/test/test_sys_build_ctsm.py diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 86bed1ef89..884afe04c2 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -96,9 +96,9 @@ def build_ctsm(cime_path, esmf_lib_path (str or None): path to ESMF library directory Must be given if machine isn't given; ignored if machine is given gmake (str or None): name of GNU make tool - Ignored if machine is given + Must be given if machine isn't given; ignored if machine is given gmake_j (int or None): number of threads to use when building - Ignored if machine is given + Must be given if machine isn't given; ignored if machine is given pnetcdf_path (str or None): path to PNetCDF installation, if present (or None) Ignored if machine is given pio_filesystem_hints (str or None): if present (not None), enable filesystem hints for the diff --git a/python/ctsm/test/test_sys_build_ctsm.py b/python/ctsm/test/test_sys_build_ctsm.py new file mode 100644 index 0000000000..6141c4a103 --- /dev/null +++ b/python/ctsm/test/test_sys_build_ctsm.py @@ -0,0 +1,78 @@ +#!/usr/bin/env python + +"""System tests for build_ctsm + +These tests do a lot of work (interacting with cime, etc.), and thus take relatively long +to run. +""" + +import unittest +import tempfile +import shutil +import os + +from ctsm.path_utils import add_cime_lib_to_path +from ctsm import unit_testing +from ctsm.build_ctsm import build_ctsm + +_CIME_PATH = add_cime_lib_to_path(standalone_only=True) + +# Allow names that pylint doesn't like, because otherwise I find it hard +# to make readable unit test names +# pylint: disable=invalid-name + +class TestSysBuildCtsm(unittest.TestCase): + """System tests for build_ctsm""" + + def setUp(self): + self._tempdir = tempfile.mkdtemp() + + def tearDown(self): + shutil.rmtree(self._tempdir, ignore_errors=True) + + def test_buildSetup_userDefinedMachine_minimalInfo(self): + """Get through the case.setup phase with a user-defined machine + + This tests that the xml files are created successfully and that they are + compatible with cime's xml schemas. It also ensures that the creation of + various directories goes smoothly. + + This version specifies a minimal amount of information + """ + build_ctsm(cime_path=_CIME_PATH, + build_dir=os.path.join(self._tempdir, 'ctsm_build'), + compiler='gnu', + no_build=True, + os_type='linux', + netcdf_path='/path/to/netcdf', + esmf_lib_path='/path/to/esmf/lib', + gmake='gmake', + gmake_j=8) + + def test_buildSetup_userDefinedMachine_allInfo(self): + """Get through the case.setup phase with a user-defined machine + + This tests that the xml files are created successfully and that they are + compatible with cime's xml schemas. It also ensures that the creation of + various directories goes smoothly. + + This version specifies all possible information + """ + build_ctsm(cime_path=_CIME_PATH, + build_dir=os.path.join(self._tempdir, 'ctsm_build'), + compiler='gnu', + no_build=True, + os_type='linux', + netcdf_path='/path/to/netcdf', + esmf_lib_path='/path/to/esmf/lib', + gmake='gmake', + gmake_j=8, + pnetcdf_path='/path/to/pnetcdf', + pio_filesystem_hints='gpfs', + gptl_nano_timers=True, + extra_fflags='-foo', + extra_cflags='-bar') + +if __name__ == '__main__': + unit_testing.setup_for_tests() + unittest.main() From 3e8085750b7d3c28ce7ff283de5fb2edabe3452d Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 9 Jun 2020 16:26:51 -0600 Subject: [PATCH 364/556] Minor refactoring --- python/ctsm/build_ctsm.py | 25 +++++++++++++------------ python/ctsm/test/test_sys_build_ctsm.py | 2 ++ 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 884afe04c2..8be2196e6d 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -133,8 +133,10 @@ def build_ctsm(cime_path, extra_fflags=extra_fflags, extra_cflags=extra_cflags) + case_dir = os.path.join(build_dir, 'case') _create_and_build_case(cime_path=cime_path, build_dir=build_dir, + case_dir=case_dir, compiler=compiler, machine=machine, no_build=no_build) @@ -450,20 +452,19 @@ def _fill_out_machine_files(build_dir, 'w') as cc_file: cc_file.write(config_compilers) -def _create_and_build_case(cime_path, build_dir, compiler, machine=None, no_build=False): +def _create_and_build_case(cime_path, build_dir, case_dir, compiler, machine=None, no_build=False): """Create a case and build the CTSM library and its dependencies Args: cime_path (str): path to root of cime build_dir (str): path to build directory + case_dir (str): path to case directory compiler (str): compiler to use machine (str or None): name of machine or None If None, we assume we're using an on-the-fly machine port Otherwise, machine should be the name of a machine known to cime no_build (bool): If True, set things up, but skip doing the actual build """ - casedir = os.path.join(build_dir, 'case') - # Note that, for some commands, we want to suppress output, only showing the output if # the command fails; for these we use run_cmd_output_on_error. For other commands, we # want to always show output (or there should be no output in general); for these, we @@ -482,7 +483,7 @@ def _create_and_build_case(cime_path, build_dir, compiler, machine=None, no_buil create_newcase_cmd = [os.path.join(cime_path, 'scripts', 'create_newcase'), '--output-root', build_dir, - '--case', casedir, + '--case', case_dir, '--compset', _COMPSET, '--res', _RES, '--compiler', compiler, @@ -492,29 +493,29 @@ def _create_and_build_case(cime_path, build_dir, compiler, machine=None, no_buil run_cmd_output_on_error(create_newcase_cmd, errmsg='Problem creating CTSM case directory') - run_cmd_output_on_error([os.path.join(casedir, 'case.setup')], + run_cmd_output_on_error([os.path.join(case_dir, 'case.setup')], errmsg='Problem setting up CTSM case directory', - cwd=casedir) + cwd=case_dir) - subprocess.check_call([os.path.join(casedir, 'xmlchange'), 'LILAC_MODE=on'], cwd=casedir) + subprocess.check_call([os.path.join(case_dir, 'xmlchange'), 'LILAC_MODE=on'], cwd=case_dir) - make_link(os.path.join(casedir, 'bld'), + make_link(os.path.join(case_dir, 'bld'), os.path.join(build_dir, 'bld')) if machine is not None: # For a pre-existing machine, the .env_mach_specific files are likely useful to # the user. Make sym links to these with more intuitive names. for extension in ('sh', 'csh'): - make_link(os.path.join(casedir, '.env_mach_specific.{}'.format(extension)), + make_link(os.path.join(case_dir, '.env_mach_specific.{}'.format(extension)), os.path.join(build_dir, 'ctsm_build_environment.{}'.format(extension))) if not no_build: try: subprocess.check_call( - [os.path.join(casedir, 'case.build'), + [os.path.join(case_dir, 'case.build'), '--sharedlib-only'], - cwd=casedir) + cwd=case_dir) except subprocess.CalledProcessError: abort('ERROR building CTSM or its dependencies - see above for details') - make_link(os.path.join(casedir, 'bld', 'ctsm.mk'), + make_link(os.path.join(case_dir, 'bld', 'ctsm.mk'), os.path.join(build_dir, 'ctsm.mk')) diff --git a/python/ctsm/test/test_sys_build_ctsm.py b/python/ctsm/test/test_sys_build_ctsm.py index 6141c4a103..a0b62eae18 100644 --- a/python/ctsm/test/test_sys_build_ctsm.py +++ b/python/ctsm/test/test_sys_build_ctsm.py @@ -48,6 +48,7 @@ def test_buildSetup_userDefinedMachine_minimalInfo(self): esmf_lib_path='/path/to/esmf/lib', gmake='gmake', gmake_j=8) + # no assertions: test passes as long as the command doesn't generate any errors def test_buildSetup_userDefinedMachine_allInfo(self): """Get through the case.setup phase with a user-defined machine @@ -72,6 +73,7 @@ def test_buildSetup_userDefinedMachine_allInfo(self): gptl_nano_timers=True, extra_fflags='-foo', extra_cflags='-bar') + # no assertions: test passes as long as the command doesn't generate any errors if __name__ == '__main__': unit_testing.setup_for_tests() From 76f2f957481d6f167f02d3d9dabf461453813f2b Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 9 Jun 2020 16:27:58 -0600 Subject: [PATCH 365/556] Make unit test modules executable This way, we can run individual sets of tests like: ./ctsm/test/test_unit_build_ctsm.py --- python/ctsm/test/test_sys_build_ctsm.py | 0 python/ctsm/test/test_unit_build_ctsm.py | 0 python/ctsm/test/test_unit_machine.py | 0 python/ctsm/test/test_unit_path_utils.py | 0 python/ctsm/test/test_unit_run_sys_tests.py | 0 5 files changed, 0 insertions(+), 0 deletions(-) mode change 100644 => 100755 python/ctsm/test/test_sys_build_ctsm.py mode change 100644 => 100755 python/ctsm/test/test_unit_build_ctsm.py mode change 100644 => 100755 python/ctsm/test/test_unit_machine.py mode change 100644 => 100755 python/ctsm/test/test_unit_path_utils.py mode change 100644 => 100755 python/ctsm/test/test_unit_run_sys_tests.py diff --git a/python/ctsm/test/test_sys_build_ctsm.py b/python/ctsm/test/test_sys_build_ctsm.py old mode 100644 new mode 100755 diff --git a/python/ctsm/test/test_unit_build_ctsm.py b/python/ctsm/test/test_unit_build_ctsm.py old mode 100644 new mode 100755 diff --git a/python/ctsm/test/test_unit_machine.py b/python/ctsm/test/test_unit_machine.py old mode 100644 new mode 100755 diff --git a/python/ctsm/test/test_unit_path_utils.py b/python/ctsm/test/test_unit_path_utils.py old mode 100644 new mode 100755 diff --git a/python/ctsm/test/test_unit_run_sys_tests.py b/python/ctsm/test/test_unit_run_sys_tests.py old mode 100644 new mode 100755 From a869cc396704c910a6fef12c86577a7f39dc656a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 9 Jun 2020 17:14:01 -0600 Subject: [PATCH 366/556] Refactor --- python/ctsm/build_ctsm.py | 58 +++++++++++++++++++++++---------------- 1 file changed, 35 insertions(+), 23 deletions(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 8be2196e6d..809919d336 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -134,12 +134,14 @@ def build_ctsm(cime_path, extra_cflags=extra_cflags) case_dir = os.path.join(build_dir, 'case') - _create_and_build_case(cime_path=cime_path, - build_dir=build_dir, - case_dir=case_dir, - compiler=compiler, - machine=machine, - no_build=no_build) + _create_case(cime_path=cime_path, + build_dir=build_dir, + case_dir=case_dir, + compiler=compiler, + machine=machine) + if not no_build: + _build_case(build_dir=build_dir, + case_dir=case_dir) # ======================================================================== # Private functions @@ -452,8 +454,8 @@ def _fill_out_machine_files(build_dir, 'w') as cc_file: cc_file.write(config_compilers) -def _create_and_build_case(cime_path, build_dir, case_dir, compiler, machine=None, no_build=False): - """Create a case and build the CTSM library and its dependencies +def _create_case(cime_path, build_dir, case_dir, compiler, machine=None): + """Create a case that can later be used to build the CTSM library and its dependencies Args: cime_path (str): path to root of cime @@ -463,12 +465,11 @@ def _create_and_build_case(cime_path, build_dir, case_dir, compiler, machine=Non machine (str or None): name of machine or None If None, we assume we're using an on-the-fly machine port Otherwise, machine should be the name of a machine known to cime - no_build (bool): If True, set things up, but skip doing the actual build """ # Note that, for some commands, we want to suppress output, only showing the output if - # the command fails; for these we use run_cmd_output_on_error. For other commands, we - # want to always show output (or there should be no output in general); for these, we - # directly use subprocess.check_call or similar. + # the command fails; for these we use run_cmd_output_on_error. For other commands, + # there should be no output in general; for these, we directly use + # subprocess.check_call or similar. # Also note that, for commands executed from the case directory, we specify the path # to the case directory both in the command itself and in the cwd argument. We do the @@ -508,14 +509,25 @@ def _create_and_build_case(cime_path, build_dir, case_dir, compiler, machine=Non make_link(os.path.join(case_dir, '.env_mach_specific.{}'.format(extension)), os.path.join(build_dir, 'ctsm_build_environment.{}'.format(extension))) - if not no_build: - try: - subprocess.check_call( - [os.path.join(case_dir, 'case.build'), - '--sharedlib-only'], - cwd=case_dir) - except subprocess.CalledProcessError: - abort('ERROR building CTSM or its dependencies - see above for details') - - make_link(os.path.join(case_dir, 'bld', 'ctsm.mk'), - os.path.join(build_dir, 'ctsm.mk')) +def _build_case(build_dir, case_dir): + """Build the CTSM library and its dependencies + + Args: + build_dir (str): path to build directory + case_dir (str): path to case directory + """ + # We want user to see output from the build command, so we use subprocess.check_call + # rather than run_cmd_output_on_error. + + # See comment in _create_case for why we use case_dir in both the path to the command + # and in the cwd argument to check_call. + try: + subprocess.check_call( + [os.path.join(case_dir, 'case.build'), + '--sharedlib-only'], + cwd=case_dir) + except subprocess.CalledProcessError: + abort('ERROR building CTSM or its dependencies - see above for details') + + make_link(os.path.join(case_dir, 'bld', 'ctsm.mk'), + os.path.join(build_dir, 'ctsm.mk')) From 9b17958db31a108b1b1945e9e6dae9228301d3c8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 9 Jun 2020 17:23:44 -0600 Subject: [PATCH 367/556] Implement rebuild method --- python/ctsm/build_ctsm.py | 47 +++++++++++++++++++++++++++++++-------- 1 file changed, 38 insertions(+), 9 deletions(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 809919d336..df9d9edd81 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -48,7 +48,7 @@ def main(cime_path): build_dir = os.path.abspath(args.build_dir) if args.rebuild: - abort('--rebuild not yet implemented') + rebuild_ctsm(build_dir=build_dir) else: build_ctsm(cime_path=cime_path, build_dir=build_dir, @@ -133,15 +133,39 @@ def build_ctsm(cime_path, extra_fflags=extra_fflags, extra_cflags=extra_cflags) - case_dir = os.path.join(build_dir, 'case') _create_case(cime_path=cime_path, build_dir=build_dir, - case_dir=case_dir, compiler=compiler, machine=machine) if not no_build: - _build_case(build_dir=build_dir, - case_dir=case_dir) + _build_case(build_dir=build_dir) + +def rebuild_ctsm(build_dir): + """Re-run the build in an existing directory + + Args: + build_dir (str): path to build directory + """ + if not os.path.exists(build_dir): + abort('When running with --rebuild, the build directory must already exist\n' + '(<{}> does not exist)'.format(build_dir)) + + case_dir = _get_case_dir(build_dir) + if not os.path.exists(case_dir): + abort('It appears there was a problem setting up the initial build in\n' + '<{}>\n' + 'You should start over with a fresh build directory.'.format(build_dir)) + + try: + subprocess.check_call( + [os.path.join(case_dir, 'case.build'), + '--clean-depends', + 'lnd'], + cwd=case_dir) + except subprocess.CalledProcessError: + abort('ERROR resetting build for CTSM in order to rebuild - see above for details') + + _build_case(build_dir) # ======================================================================== # Private functions @@ -364,6 +388,10 @@ def _check_and_transform_os(os_type): raise ValueError("Unknown OS: {}".format(os_type)) return os_type_transformed +def _get_case_dir(build_dir): + """Given the path to build_dir, return the path to the case directory""" + return os.path.join(build_dir, 'case') + def _create_build_dir(build_dir, existing_machine): """Create the given build directory and any necessary sub-directories @@ -454,13 +482,12 @@ def _fill_out_machine_files(build_dir, 'w') as cc_file: cc_file.write(config_compilers) -def _create_case(cime_path, build_dir, case_dir, compiler, machine=None): +def _create_case(cime_path, build_dir, compiler, machine=None): """Create a case that can later be used to build the CTSM library and its dependencies Args: cime_path (str): path to root of cime build_dir (str): path to build directory - case_dir (str): path to case directory compiler (str): compiler to use machine (str or None): name of machine or None If None, we assume we're using an on-the-fly machine port @@ -476,6 +503,8 @@ def _create_case(cime_path, build_dir, case_dir, compiler, machine=None): # former in case dot isn't in the user's path; we do the latter in case the commands # require you to be in the case directory when you execute them. + case_dir = _get_case_dir(build_dir) + if machine is None: machine_args = ['--machine', _MACH_NAME, '--extra-machines-dir', os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME)] @@ -509,18 +538,18 @@ def _create_case(cime_path, build_dir, case_dir, compiler, machine=None): make_link(os.path.join(case_dir, '.env_mach_specific.{}'.format(extension)), os.path.join(build_dir, 'ctsm_build_environment.{}'.format(extension))) -def _build_case(build_dir, case_dir): +def _build_case(build_dir): """Build the CTSM library and its dependencies Args: build_dir (str): path to build directory - case_dir (str): path to case directory """ # We want user to see output from the build command, so we use subprocess.check_call # rather than run_cmd_output_on_error. # See comment in _create_case for why we use case_dir in both the path to the command # and in the cwd argument to check_call. + case_dir = _get_case_dir(build_dir) try: subprocess.check_call( [os.path.join(case_dir, 'case.build'), From 05c5d6a734e33a8e21ae26cfd0e0b4b147763639 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 9 Jun 2020 20:04:46 -0600 Subject: [PATCH 368/556] Documentation on how to run WRF-CTSM --- doc/source/lilac/specific-atm-models/wrf.rst | 275 ++++++++++++++++++- 1 file changed, 274 insertions(+), 1 deletion(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 0a5813a659..0cc1f01b67 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -1,9 +1,282 @@ .. _wrf: +.. highlight:: shell + ===================== Using CTSM with WRF ===================== +This section describes the procedure for building and running the CTSM +library and its dependencies, and linking to these libraries in the WRF +model's build via LILAC. As such this section repeats some information +from earlier sections but in recipe form and with minimal detail. + +.. important:: + + This section assumes use of a machine that has been ported to CIME. + In this example we assume NCAR’s cheyenne computer in particular. + +Preparing the CTSM +================== + +Decide where you will work, for example:: + + cd /glade/scratch/$USER + mkdir git_wrf_ctsm + cd git_wrf_ctsm + +.. note:: + + Discs other than /glade/scratch may provide insufficient space for + output from simulations longer than one or two months. + +Obtain CTSM by running:: + + git clone https://github.com/ESCOMP/ctsm.git + cd ctsm + git checkout lilac_cap + ./manage_externals/checkout_externals -v + +Build CTSM and its dependencies:: + + ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne + +Run:: + + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh + +.. note:: + + If the previous command fails due to your environment settings, + try this one instead: + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.csh + +.. note:: + + For additional details on preparing the CTSM, including how to + recompile when making code changes to the CTSM, read section + _obtaining-and-building-ctsm. <-- CREATED LINK TO THE CORRECT SECTION? + +Preparing the WRF model +======================= + +Obtain WRF by running:: + + cd /glade/scratch/$USER/git_wrf_ctsm + git clone git@github.com:billsacks/WRF.git + cd WRF + git checkout lilac_dev + +.. note:: + + If the git clone command fails for you as written, then try it this way: + git clone https://github.com/billsacks/WRF.git + +Build WRF + +.. note:: + + 1) If the export commands below fail due to your environment settings, + try replacing them with setenv commands like this: + + setenv WRF_CTSM_MKFILE /glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk + setenv MPI_USE_ARRAY None + +.. note:: + + 2) The ./clean -a command is unnecessary the first time you build WRF. + All five lines below become necessary when you modify the WRF code and + need to rebuild. + +.. note:: + + 3) The ./configure step will request two inputs while it runs. + Respond with 15 to the first request and with 1 to the second. + +.. note:: + + 4) The ./compile step takes more than 15 minutes to complete. + +Now that you have read notes 1 to 4, proceed with building WRF:: + + export WRF_CTSM_MKFILE=/glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk + export MPI_USE_ARRAY=None + ./clean -a + ./configure + ./compile em_real > compile.log & + +.. note:: + + Check the bottom of your log file for a successful compilation message + or search the file for the string "Error" with a capital E. + Optional: One may use tmux or nohup for configuring and compiling. + Try "man nohup" for more information. + +.. todo:: + I have not heard of tmux on cheyenne. Is it available? + +Create input namelists for CTSM and LILAC +========================================= + +Introduce the following diffs to ./git_wrf_ctsm/ctsm/lilac/atm_driver/ +by replacing the entries preceded by minus signs with the entries +preceded by plus signs. + +diff ./lilac/atm_driver/atm_driver_in ./lilac/atm_driver/atm_driver_in:: + - atm_mesh_file = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + - atm_global_nx = 72 + - atm_global_ny = 46 + + atm_mesh_file = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + + atm_global_nx = 199 + + atm_global_ny = 139 + +diff ./lilac/atm_driver/ctsm.cfg ./lilac/atm_driver/ctsm.cfg:: + -configuration = clm + -structure = standard + -clm_bldnml_opts = -bgc sp + -gridmask = gx3v7 + -lnd_grid = 4x5 + -lnd_domain_file = domain.lnd.fv4x5_gx3v7.091218.nc + -lnd_domain_path = /glade/p/cesmdata/cseg/inputdata/share/domains + -clm_namelist_opts = hist_nhtfrq=-24 hist_mfilt=1 hist_ndens=1 + +configuration = nwp + +structure = fast + +clm_bldnml_opts = -bgc sp -clm_usr_name wrf2ctsm + +gridmask = null + +lnd_grid = wrf2ctsm + +lnd_domain_file = domain.lnd.wrf2ctsm_lnd_wrf2ctsm_ocn.191211.nc + +lnd_domain_path = /glade/work/slevis/barlage_wrf_ctsm/conus/gen_domain_files + +clm_namelist_opts = hist_nhtfrq=1 hist_mfilt=1 hist_ndens=1 fsurdat="/glade/work/barlage/ctsm/conus/surfdata_conus/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c191212.nc" finidat="/glade/scratch/sacks/wrf_code/WRF/test/em_real/nldas_nwp_0109a.clm2.r.2000-04-01-64800.nc" use_init_interp=.true. + +diff ./lilac/atm_driver/lilac_in ./lilac/atm_driver/lilac_in:: + - atm_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + + atm_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + + - lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + + lnd_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + +Generate the lnd_in file by running the following from +./git_wrf_ctsm/ctsm/lilac/atm_driver:: + + ../../lilac_config/buildnml + +Copy lilac_in, lnd_in, and lnd_modelio.nml to the WRF/run directory. + .. todo:: - TODO: write this section + Sam skipped starting here + + +Compile and run the WRF Preprocessing System (WPS) +================================================== + +The WRF Preprocessing System (WPS) is a set of programs to prepare input +to the real program for real-data simulations. + +.. todo:: + + Negin, pls explain how to "follow WRF instructions" and what you mean + by "similar way we did" in the next paragraph. + +To compile WPS using your WRF build, follow WRF instructions. +In summary, configure and compile WPS similar way we did. + +Run WPS tools + +.. todo:: + + First reference to the WRF namelist in the next line. We should + specify where that is. + +Edit namelist.wps for your domain of interest, which should be the same +domain as used in your WRF namelist. + +Define the domain and interpolate static geographical data to the grids:: + + ./geogrid.exe >& log.geogrid + +Link in the input GFS data files:: + + ./link_grib.csh path_where_you_placed_GFS_files + +Extract meteorological fields from GRIB-formatted files:: + + ./ungrib.exe + +Horizontally interpolate the metrological fields extracted by ungrib to +the model grids defined in geogrid:: + + ./metgrid.exe >& log.metgrid + +You should now have met_em.d01* files. + +Run real.exe to generate initial and boundary conditions + +Follow WRF instructions for creating initial and boundary +conditions. In summary, complete the following steps: + +Move or link WPS output files (met_em.d01* files) to your WRF/run directory. + +Edit namelist.input for your WRF domain and desirable configurations. +This should be the same domain as in the namelist used in WPS. +To run WRF-CTSM, change land-surface option to 51:: + + sf_surface_physics = 51 + +.. note:: + + sf_surface_physics values for running WRF-Noah and WRF-NoahMP are + 2 and 4, respectively. + +Run real.exe (if compiled parallel submit a batch job) to generate +wrfinput and wrfbdy files. + +.. todo:: + + Sam skipped up to here + +Run WRF +======= + +Place the following in a script that you may name run_wrf_ctsm.csh:: + + #!/bin/tcsh + #PBS -N job_name + #PBS -A + #PBS -l walltime=01:00:00 + #PBS -q regular + #PBS -k eod + + #PBS -l select=2:ncpus=4:mpiprocs=8 + + ml + + ### Set TMPDIR as recommended + setenv TMPDIR /glade/scratch/$USER/temp + mkdir -p $TMPDIR + + + echo "hello" + ### Run the executable + set MPI_SHEPHERD=true + + ln -sf .../WRF/test/em_real/namelist.input.ctsm_test.2013.d01 namelist.input + ln -sf .../WRF/test/em_real/wrfinput_d01.noseaice wrfinput_d01 + ln -sf .../WRF/test/em_real/wrfbdy_d01.6month wrfbdy_d01 + + mpiexec_mpt ./wrf.exe + +where "..." is the path to your WRF directory. + +.. note:: + + 1) Replace + #PBS -l select=2:ncpus=4:mpiprocs=8 + with + #PBS -l select=4:ncpus=36:mpiprocs=36 + to use more processors and run faster. + +Run:: + + qsub run_wrf_ctsm.csh + From 473f1417253348926b94a264c8a852a0b379f779 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 10 Jun 2020 17:33:43 -0600 Subject: [PATCH 369/556] Start work on a lilac smoke test The build phase of this works so far. I have tested this by running the test LILACSMOKE_P4x1.f10_f10_musgs.I2000Clm50BgcCropQianRsGs.bishorn_gnu, and also rerunning ./case.build after the initial build completed. --- cime_config/SystemTests/lilacsmoke.py | 70 +++++++++++++++++++++++++++ cime_config/config_tests.xml | 32 +++++++----- 2 files changed, 89 insertions(+), 13 deletions(-) create mode 100644 cime_config/SystemTests/lilacsmoke.py diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py new file mode 100644 index 0000000000..c7b3b3d23b --- /dev/null +++ b/cime_config/SystemTests/lilacsmoke.py @@ -0,0 +1,70 @@ +""" +Implementation of the CIME LILACSMOKE (LILAC smoke) test. + +This is a CTSM-specific test. It tests the building and running of CTSM via LILAC. Grid +and compset are ignored. +""" + +import os + +from CIME.SystemTests.system_tests_common import SystemTestsCommon +from CIME.utils import run_cmd_no_fail, append_testlog +from CIME.build import post_build +from CIME.test_status import GENERATE_PHASE, BASELINE_PHASE, TEST_PASS_STATUS +from CIME.XML.standard_module_setup import * + +logger = logging.getLogger(__name__) + +class LILACSMOKE(SystemTestsCommon): + + def __init__(self, case): + SystemTestsCommon.__init__(self, case) + + def build_phase(self, sharedlib_only=False, model_only=False): + if not sharedlib_only: + caseroot = self._case.get_value('CASEROOT') + lndroot = self._case.get_value('COMP_ROOT_DIR_LND') + exeroot = self._case.get_value('EXEROOT') + build_dir = os.path.join(caseroot, 'lilac_build') + script_path = os.path.abspath(os.path.join(lndroot, 'lilac', 'build_ctsm')) + logs = [] + + # We only run the initial build command if the build_dir doesn't exist + # yet. This is to support rebuilding the test case. (The first time through, + # the build_dir won't exist yet; subsequent times, it will already exist, so + # we skip to the rebuild command.) + if not os.path.isdir(build_dir): + machine = self._case.get_value('MACH') + compiler = self._case.get_value('COMPILER') + # TODO(wjs, 2020-06-10) Add --build-debug if the test is a debug test + cmd = '{script_path} {build_dir} --machine {machine} --compiler {compiler}'.format( + script_path=script_path, + build_dir=build_dir, + machine=machine, + compiler=compiler) + append_testlog(cmd) + run_cmd_no_fail(cmd, arg_stdout='build_ctsm.bldlog', combine_output=True, from_dir=exeroot) + logfile = os.path.join(exeroot, 'build_ctsm.bldlog') + logs.append(logfile) + with open(logfile) as lf: + append_testlog(lf.read()) + + # We call the build script with --rebuild even for an initial build. This is + # so we make sure to test the code path for --rebuild. (This is also needed if + # the user rebuilds the test case, in which case this will be the only command + # run, since the build_dir will already exist.) + cmd = '{script_path} {build_dir} --rebuild'.format( + script_path=script_path, + build_dir=build_dir) + append_testlog(cmd) + run_cmd_no_fail(cmd, arg_stdout='rebuild_ctsm.bldlog', combine_output=True, from_dir=exeroot) + logfile = os.path.join(exeroot, 'rebuild_ctsm.bldlog') + logs.append(logfile) + with open(logfile) as lf: + append_testlog(lf.read()) + + post_build(self._case, logs, build_complete=True) + + def run_phase(self): + # TODO(wjs, 2020-06-10) Fill this in + pass diff --git a/cime_config/config_tests.xml b/cime_config/config_tests.xml index 8a40ea9183..8a933581cf 100644 --- a/cime_config/config_tests.xml +++ b/cime_config/config_tests.xml @@ -1,19 +1,7 @@ @@ -47,6 +35,16 @@ SSP smoke CLM spinup test (only valid for CLM compsets with CLM45) $STOP_N + + CTSM test: Smoke test of building and running CTSM via LILAC. Grid and compset (and most case settings) are ignored. + + 1 + ndays + 11 + FALSE + FALSE + + CLM test: Verify that adding virtual glacier columns doesn't change answers 1 @@ -85,6 +83,14 @@ SSP smoke CLM spinup test (only valid for CLM compsets with CLM45) $STOP_N + + smoke CLM spinup test 1 From b41beb2eda09d3a9ae5947e6d461e334db02915d Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 10 Jun 2020 18:33:50 -0600 Subject: [PATCH 370/556] Add --build-debug option --- cime_config/SystemTests/lilacsmoke.py | 6 ++++-- python/ctsm/build_ctsm.py | 20 ++++++++++++++++---- python/ctsm/test/test_sys_build_ctsm.py | 3 ++- 3 files changed, 22 insertions(+), 7 deletions(-) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index c7b3b3d23b..15f9eb908b 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -36,12 +36,14 @@ def build_phase(self, sharedlib_only=False, model_only=False): if not os.path.isdir(build_dir): machine = self._case.get_value('MACH') compiler = self._case.get_value('COMPILER') - # TODO(wjs, 2020-06-10) Add --build-debug if the test is a debug test + debug = self._case.get_value('DEBUG') cmd = '{script_path} {build_dir} --machine {machine} --compiler {compiler}'.format( script_path=script_path, build_dir=build_dir, machine=machine, compiler=compiler) + if debug: + cmd += ' --build-debug' append_testlog(cmd) run_cmd_no_fail(cmd, arg_stdout='build_ctsm.bldlog', combine_output=True, from_dir=exeroot) logfile = os.path.join(exeroot, 'build_ctsm.bldlog') @@ -66,5 +68,5 @@ def build_phase(self, sharedlib_only=False, model_only=False): post_build(self._case, logs, build_complete=True) def run_phase(self): - # TODO(wjs, 2020-06-10) Fill this in + # FIXME(wjs, 2020-06-10) Fill this in pass diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index df9d9edd81..1a5864c4a2 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -64,7 +64,8 @@ def main(cime_path): pio_filesystem_hints=args.pio_filesystem_hints, gptl_nano_timers=args.gptl_nano_timers, extra_fflags=args.extra_fflags, - extra_cflags=args.extra_cflags) + extra_cflags=args.extra_cflags, + build_debug=args.build_debug) def build_ctsm(cime_path, build_dir, @@ -80,7 +81,8 @@ def build_ctsm(cime_path, pio_filesystem_hints=None, gptl_nano_timers=False, extra_fflags='', - extra_cflags=''): + extra_cflags='', + build_debug=False): """Implementation of build_ctsm command Args: @@ -110,6 +112,7 @@ def build_ctsm(cime_path, Ignored if machine is given extra_cflags (str): any extra flags to include when compiling C files Ignored if machine is given + build_debug (bool): if True, build with flags for debugging """ _create_build_dir(build_dir=build_dir, @@ -136,7 +139,8 @@ def build_ctsm(cime_path, _create_case(cime_path=cime_path, build_dir=build_dir, compiler=compiler, - machine=machine) + machine=machine, + build_debug=build_debug) if not no_build: _build_case(build_dir=build_dir) @@ -179,6 +183,7 @@ def _commandline_args(args_to_parse=None): reads args from sys.argv """ # pylint: disable=line-too-long + # pylint: disable=too-many-statements description = """ Script to build CTSM library and its dependencies @@ -245,6 +250,10 @@ def _commandline_args(args_to_parse=None): 'they are not allowed with --rebuild:') non_rebuild_optional_list = [] + non_rebuild_optional.add_argument('--build-debug', action='store_true', + help='Build with flags for debugging rather than production runs') + non_rebuild_optional_list.append('build-debug') + non_rebuild_optional.add_argument('--no-build', action='store_true', help='Do the pre-build setup, but do not actually build CTSM\n' '(This is useful for testing, or for expert use.)') @@ -482,7 +491,7 @@ def _fill_out_machine_files(build_dir, 'w') as cc_file: cc_file.write(config_compilers) -def _create_case(cime_path, build_dir, compiler, machine=None): +def _create_case(cime_path, build_dir, compiler, machine=None, build_debug=False): """Create a case that can later be used to build the CTSM library and its dependencies Args: @@ -492,6 +501,7 @@ def _create_case(cime_path, build_dir, compiler, machine=None): machine (str or None): name of machine or None If None, we assume we're using an on-the-fly machine port Otherwise, machine should be the name of a machine known to cime + build_debug (bool): if True, build with flags for debugging """ # Note that, for some commands, we want to suppress output, only showing the output if # the command fails; for these we use run_cmd_output_on_error. For other commands, @@ -528,6 +538,8 @@ def _create_case(cime_path, build_dir, compiler, machine=None): cwd=case_dir) subprocess.check_call([os.path.join(case_dir, 'xmlchange'), 'LILAC_MODE=on'], cwd=case_dir) + if build_debug: + subprocess.check_call([os.path.join(case_dir, 'xmlchange'), 'DEBUG=TRUE'], cwd=case_dir) make_link(os.path.join(case_dir, 'bld'), os.path.join(build_dir, 'bld')) diff --git a/python/ctsm/test/test_sys_build_ctsm.py b/python/ctsm/test/test_sys_build_ctsm.py index a0b62eae18..cfae22cd87 100755 --- a/python/ctsm/test/test_sys_build_ctsm.py +++ b/python/ctsm/test/test_sys_build_ctsm.py @@ -72,7 +72,8 @@ def test_buildSetup_userDefinedMachine_allInfo(self): pio_filesystem_hints='gpfs', gptl_nano_timers=True, extra_fflags='-foo', - extra_cflags='-bar') + extra_cflags='-bar', + build_debug=True) # no assertions: test passes as long as the command doesn't generate any errors if __name__ == '__main__': From e71b8d621d7e574c8033eb7885e2c47337213a38 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 10 Jun 2020 18:49:27 -0600 Subject: [PATCH 371/556] Build with threading support by default, but allow turning it off --- python/ctsm/build_ctsm.py | 27 +++++++++++++++++++------ python/ctsm/test/test_sys_build_ctsm.py | 3 ++- 2 files changed, 23 insertions(+), 7 deletions(-) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 1a5864c4a2..84aeb888fa 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -65,7 +65,8 @@ def main(cime_path): gptl_nano_timers=args.gptl_nano_timers, extra_fflags=args.extra_fflags, extra_cflags=args.extra_cflags, - build_debug=args.build_debug) + build_debug=args.build_debug, + build_without_openmp=args.build_without_openmp) def build_ctsm(cime_path, build_dir, @@ -82,7 +83,8 @@ def build_ctsm(cime_path, gptl_nano_timers=False, extra_fflags='', extra_cflags='', - build_debug=False): + build_debug=False, + build_without_openmp=False): """Implementation of build_ctsm command Args: @@ -113,6 +115,7 @@ def build_ctsm(cime_path, extra_cflags (str): any extra flags to include when compiling C files Ignored if machine is given build_debug (bool): if True, build with flags for debugging + build_without_openmp (bool): if True, build without OpenMP support """ _create_build_dir(build_dir=build_dir, @@ -140,7 +143,8 @@ def build_ctsm(cime_path, build_dir=build_dir, compiler=compiler, machine=machine, - build_debug=build_debug) + build_debug=build_debug, + build_without_openmp=build_without_openmp) if not no_build: _build_case(build_dir=build_dir) @@ -254,6 +258,12 @@ def _commandline_args(args_to_parse=None): help='Build with flags for debugging rather than production runs') non_rebuild_optional_list.append('build-debug') + non_rebuild_optional.add_argument('--build-without-openmp', action='store_true', + help='By default, CTSM is built with support for OpenMP threading;\n' + 'if this flag is set, then CTSM is built without this support.\n' + 'This is mainly useful if your machine/compiler does not support OpenMP.') + non_rebuild_optional_list.append('build-without-openmp') + non_rebuild_optional.add_argument('--no-build', action='store_true', help='Do the pre-build setup, but do not actually build CTSM\n' '(This is useful for testing, or for expert use.)') @@ -491,7 +501,8 @@ def _fill_out_machine_files(build_dir, 'w') as cc_file: cc_file.write(config_compilers) -def _create_case(cime_path, build_dir, compiler, machine=None, build_debug=False): +def _create_case(cime_path, build_dir, compiler, + machine=None, build_debug=False, build_without_openmp=False): """Create a case that can later be used to build the CTSM library and its dependencies Args: @@ -502,6 +513,7 @@ def _create_case(cime_path, build_dir, compiler, machine=None, build_debug=False If None, we assume we're using an on-the-fly machine port Otherwise, machine should be the name of a machine known to cime build_debug (bool): if True, build with flags for debugging + build_without_openmp (bool): if True, build without OpenMP support """ # Note that, for some commands, we want to suppress output, only showing the output if # the command fails; for these we use run_cmd_output_on_error. For other commands, @@ -514,6 +526,7 @@ def _create_case(cime_path, build_dir, compiler, machine=None, build_debug=False # require you to be in the case directory when you execute them. case_dir = _get_case_dir(build_dir) + xmlchange = os.path.join(case_dir, 'xmlchange') if machine is None: machine_args = ['--machine', _MACH_NAME, @@ -537,9 +550,11 @@ def _create_case(cime_path, build_dir, compiler, machine=None, build_debug=False errmsg='Problem setting up CTSM case directory', cwd=case_dir) - subprocess.check_call([os.path.join(case_dir, 'xmlchange'), 'LILAC_MODE=on'], cwd=case_dir) + subprocess.check_call([xmlchange, 'LILAC_MODE=on'], cwd=case_dir) if build_debug: - subprocess.check_call([os.path.join(case_dir, 'xmlchange'), 'DEBUG=TRUE'], cwd=case_dir) + subprocess.check_call([xmlchange, 'DEBUG=TRUE'], cwd=case_dir) + if not build_without_openmp: + subprocess.check_call([xmlchange, 'FORCE_BUILD_SMP=TRUE'], cwd=case_dir) make_link(os.path.join(case_dir, 'bld'), os.path.join(build_dir, 'bld')) diff --git a/python/ctsm/test/test_sys_build_ctsm.py b/python/ctsm/test/test_sys_build_ctsm.py index cfae22cd87..f0bc42f0ef 100755 --- a/python/ctsm/test/test_sys_build_ctsm.py +++ b/python/ctsm/test/test_sys_build_ctsm.py @@ -73,7 +73,8 @@ def test_buildSetup_userDefinedMachine_allInfo(self): gptl_nano_timers=True, extra_fflags='-foo', extra_cflags='-bar', - build_debug=True) + build_debug=True, + build_without_openmp=True) # no assertions: test passes as long as the command doesn't generate any errors if __name__ == '__main__': From a7103b795b7b43c056721d0751d0a969731b0b4f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 11 Jun 2020 00:02:03 -0600 Subject: [PATCH 372/556] Change to wrf.rst recommended by @billsacks --- doc/source/lilac/specific-atm-models/wrf.rst | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 0cc1f01b67..f6fb328f60 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -122,7 +122,10 @@ Introduce the following diffs to ./git_wrf_ctsm/ctsm/lilac/atm_driver/ by replacing the entries preceded by minus signs with the entries preceded by plus signs. -diff ./lilac/atm_driver/atm_driver_in ./lilac/atm_driver/atm_driver_in:: +diff ./lilac/atm_driver/atm_driver_in ./lilac/atm_driver/atm_driver_in: + +.. code-block:: diff + - atm_mesh_file = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - atm_global_nx = 72 - atm_global_ny = 46 @@ -130,7 +133,10 @@ diff ./lilac/atm_driver/atm_driver_in ./lilac/atm_driver/atm_driver_in:: + atm_global_nx = 199 + atm_global_ny = 139 -diff ./lilac/atm_driver/ctsm.cfg ./lilac/atm_driver/ctsm.cfg:: +diff ./lilac/atm_driver/ctsm.cfg ./lilac/atm_driver/ctsm.cfg: + +.. code-block:: diff + -configuration = clm -structure = standard -clm_bldnml_opts = -bgc sp @@ -148,7 +154,10 @@ diff ./lilac/atm_driver/ctsm.cfg ./lilac/atm_driver/ctsm.cfg:: +lnd_domain_path = /glade/work/slevis/barlage_wrf_ctsm/conus/gen_domain_files +clm_namelist_opts = hist_nhtfrq=1 hist_mfilt=1 hist_ndens=1 fsurdat="/glade/work/barlage/ctsm/conus/surfdata_conus/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c191212.nc" finidat="/glade/scratch/sacks/wrf_code/WRF/test/em_real/nldas_nwp_0109a.clm2.r.2000-04-01-64800.nc" use_init_interp=.true. -diff ./lilac/atm_driver/lilac_in ./lilac/atm_driver/lilac_in:: +diff ./lilac/atm_driver/lilac_in ./lilac/atm_driver/lilac_in: + +.. code-block:: diff + - atm_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + atm_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' From ce5661c3c9b02c81da11ad63a3062999ca5ea717 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 11 Jun 2020 03:12:49 -0600 Subject: [PATCH 373/556] Adding instructions for running WRF with CTSM up to WPS --- doc/source/lilac/specific-atm-models/wrf.rst | 119 +++++++++++++++---- 1 file changed, 94 insertions(+), 25 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index f6fb328f60..8d8b1da338 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -19,6 +19,15 @@ from earlier sections but in recipe form and with minimal detail. Preparing the CTSM ================== +.. todo:: + + I think we don't need some of the following since too much instructions + are usually more confusing... + I tried removing incorrect or redundant information. + + For example, people who do not use cheyenne might get confused by the + following commands on scratch. + Decide where you will work, for example:: cd /glade/scratch/$USER @@ -30,6 +39,7 @@ Decide where you will work, for example:: Discs other than /glade/scratch may provide insufficient space for output from simulations longer than one or two months. + Obtain CTSM by running:: git clone https://github.com/ESCOMP/ctsm.git @@ -37,20 +47,20 @@ Obtain CTSM by running:: git checkout lilac_cap ./manage_externals/checkout_externals -v -Build CTSM and its dependencies:: +Build CTSM and its dependencies, for example for cheyenne:: ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne -Run:: + +Set environment similar to environments used for your CTSM build for bash:: source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh -.. note:: +or Cshell:: - If the previous command fails due to your environment settings, - try this one instead: source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.csh + .. note:: For additional details on preparing the CTSM, including how to @@ -59,10 +69,12 @@ Run:: Preparing the WRF model ======================= +.. todo:: + + update the git address to WRF feature branch... Obtain WRF by running:: - cd /glade/scratch/$USER/git_wrf_ctsm git clone git@github.com:billsacks/WRF.git cd WRF git checkout lilac_dev @@ -72,8 +84,21 @@ Obtain WRF by running:: If the git clone command fails for you as written, then try it this way: git clone https://github.com/billsacks/WRF.git +.. todo:: + + Sam, I think comments like the above are too trivial and make things more confusing... + + Build WRF + +.. todo:: + + Sam, while I think some of the notes below are useful such as number (4), + I believe some of the notes mentioned below such as number (1) is too trivial + and make our instructions less professional. + I tried integrating this into our instructions for example for bash vs. Cshell. + .. note:: 1) If the export commands below fail due to your environment settings, @@ -95,26 +120,50 @@ Build WRF .. note:: - 4) The ./compile step takes more than 15 minutes to complete. + 4) The ./compile step might take more than 30 minutes to complete. -Now that you have read notes 1 to 4, proceed with building WRF:: + + +For building WRF using CTSM, we should set makefile variables needed for WRF build by:: export WRF_CTSM_MKFILE=/glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk + +or:: + + setenv WRF_CTSM_MKFILE /glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk + + +The following is needed in order to undo an undesired setting in that env_mach_specific file:: + export MPI_USE_ARRAY=None + +or:: + + setenv MPI_USE_ARRAY None + + +Then configure and build WRF for your machine and intended compiler by:: + ./clean -a ./configure - ./compile em_real > compile.log & + +Choose one of the options, similar to the compiler used for building CTSM. + +Next, choose one of the options for nesting. Currently nesting is not available for WRF-CTSM, +therefore we should use 1:: + + ./compile em_real >& compile.log .. note:: Check the bottom of your log file for a successful compilation message or search the file for the string "Error" with a capital E. + +.. note:: + Optional: One may use tmux or nohup for configuring and compiling. Try "man nohup" for more information. -.. todo:: - I have not heard of tmux on cheyenne. Is it available? - Create input namelists for CTSM and LILAC ========================================= @@ -171,31 +220,51 @@ Generate the lnd_in file by running the following from Copy lilac_in, lnd_in, and lnd_modelio.nml to the WRF/run directory. -.. todo:: - - Sam skipped starting here -Compile and run the WRF Preprocessing System (WPS) +Compile WRF Preprocessing System (WPS) ================================================== -The WRF Preprocessing System (WPS) is a set of programs to prepare input -to the real program for real-data simulations. +The WRF Preprocessing System (WPS) is a set of programs to prepare +input to the real program for WRF real-data simulations. -.. todo:: +.. note:: + Building WPS requires that WRF be already built successfully. + + +Get WPS zipped tar file from: +http://www2.mmm.ucar.edu/wrf/users/download/get_source.html + +Untar WPS tar file:: + + gzip -cd WPSV4.0.TAR.gz | tar -xf - + + +Then we should compile WPS similar to the way we build WRF. In summary:: - Negin, pls explain how to "follow WRF instructions" and what you mean - by "similar way we did" in the next paragraph. + cd WPS + ./configure + +Here choose one option, for your intended compiler, similar to your WRF build. +After configuring, you can check configure.wps for making sure all the libs and paths +are set correctly. + + +Then, compile WPS:: + ./compile >& compile.log + +.. note:: + If wps build is succsfully you should see geogrid.exe, ungrib.exe, and metgrid.exe. + +Run WRF Preprocessing System (WPS) Steps +================================================== -To compile WPS using your WRF build, follow WRF instructions. -In summary, configure and compile WPS similar way we did. -Run WPS tools .. todo:: First reference to the WRF namelist in the next line. We should - specify where that is. + specify where that is. Edit namelist.wps for your domain of interest, which should be the same domain as used in your WRF namelist. From c797df33cd64c792a86d1edca31ac6e991222419 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 11 Jun 2020 13:14:41 -0600 Subject: [PATCH 374/556] Minor rework of lilacsmoke test Get it passing on my mac (needs --build-without-openmp) and a bit of refactoring --- cime_config/SystemTests/lilacsmoke.py | 43 ++++++++++++++++++--------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index 15f9eb908b..946b439707 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -27,7 +27,6 @@ def build_phase(self, sharedlib_only=False, model_only=False): exeroot = self._case.get_value('EXEROOT') build_dir = os.path.join(caseroot, 'lilac_build') script_path = os.path.abspath(os.path.join(lndroot, 'lilac', 'build_ctsm')) - logs = [] # We only run the initial build command if the build_dir doesn't exist # yet. This is to support rebuilding the test case. (The first time through, @@ -37,6 +36,10 @@ def build_phase(self, sharedlib_only=False, model_only=False): machine = self._case.get_value('MACH') compiler = self._case.get_value('COMPILER') debug = self._case.get_value('DEBUG') + # It would be possible to do this testing via the python interface rather + # than through a separate subprocess. However, we do it through a + # subprocess in order to test the full build_ctsm script, including + # command-line parsing. cmd = '{script_path} {build_dir} --machine {machine} --compiler {compiler}'.format( script_path=script_path, build_dir=build_dir, @@ -44,12 +47,11 @@ def build_phase(self, sharedlib_only=False, model_only=False): compiler=compiler) if debug: cmd += ' --build-debug' - append_testlog(cmd) - run_cmd_no_fail(cmd, arg_stdout='build_ctsm.bldlog', combine_output=True, from_dir=exeroot) - logfile = os.path.join(exeroot, 'build_ctsm.bldlog') - logs.append(logfile) - with open(logfile) as lf: - append_testlog(lf.read()) + # For now, always build this test without threads: it doesn't need + # threads, and building unthreaded ensures that it works on a wider range + # of machines/compilers + cmd += ' --build-without-openmp' + self._run_build_cmd(cmd, exeroot, 'build_ctsm.bldlog') # We call the build script with --rebuild even for an initial build. This is # so we make sure to test the code path for --rebuild. (This is also needed if @@ -58,15 +60,28 @@ def build_phase(self, sharedlib_only=False, model_only=False): cmd = '{script_path} {build_dir} --rebuild'.format( script_path=script_path, build_dir=build_dir) - append_testlog(cmd) - run_cmd_no_fail(cmd, arg_stdout='rebuild_ctsm.bldlog', combine_output=True, from_dir=exeroot) - logfile = os.path.join(exeroot, 'rebuild_ctsm.bldlog') - logs.append(logfile) - with open(logfile) as lf: - append_testlog(lf.read()) + self._run_build_cmd(cmd, exeroot, 'rebuild_ctsm.bldlog') - post_build(self._case, logs, build_complete=True) + # Setting logs=[] implies that we don't bother gzipping any of the build log + # files; that seems fine for these purposes (and it keeps the above code + # simpler). + post_build(self._case, logs=[], build_complete=True) def run_phase(self): # FIXME(wjs, 2020-06-10) Fill this in pass + + @staticmethod + def _run_build_cmd(cmd, exeroot, logfile): + """ + Runs the given build command, with output to the given logfile + + Args: + cmd: str (command to run) + exeroot: str (path to exeroot) + logfile: str (path to logfile) + """ + append_testlog(cmd) + run_cmd_no_fail(cmd, arg_stdout=logfile, combine_output=True, from_dir=exeroot) + with open(os.path.join(exeroot, logfile)) as lf: + append_testlog(lf.read()) From 5866c989f9de00162da52521f9138ef206cd50a4 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 11 Jun 2020 13:51:35 -0600 Subject: [PATCH 375/556] Move build templates I'm going to put other templates in here as well. This feels like a more appropriate location than lilac_config: it keeps files closer to the scripts / code that need them. --- .../bld_templates}/config_compilers_template.xml | 0 .../bld_templates}/config_machines_template.xml | 0 python/ctsm/build_ctsm.py | 4 ++-- 3 files changed, 2 insertions(+), 2 deletions(-) rename {lilac_config/build_templates => lilac/bld_templates}/config_compilers_template.xml (100%) rename {lilac_config/build_templates => lilac/bld_templates}/config_machines_template.xml (100%) diff --git a/lilac_config/build_templates/config_compilers_template.xml b/lilac/bld_templates/config_compilers_template.xml similarity index 100% rename from lilac_config/build_templates/config_compilers_template.xml rename to lilac/bld_templates/config_compilers_template.xml diff --git a/lilac_config/build_templates/config_machines_template.xml b/lilac/bld_templates/config_machines_template.xml similarity index 100% rename from lilac_config/build_templates/config_machines_template.xml rename to lilac/bld_templates/config_machines_template.xml diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 84aeb888fa..48b0c13c6d 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -443,8 +443,8 @@ def _fill_out_machine_files(build_dir, For documentation of args, see the documentation in the build_ctsm function """ path_to_templates = os.path.join(path_to_ctsm_root(), - 'lilac_config', - 'build_templates') + 'lilac', + 'bld_templates') os.makedirs(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME)) # ------------------------------------------------------------------------ From 0f3b19b78e1142b36820d0734175568ae764889b Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 11 Jun 2020 14:17:43 -0600 Subject: [PATCH 376/556] Move lilac namelist files I want to keep all of these in bld_templates. --- lilac/{atm_driver => bld_templates}/atm_driver_in | 0 lilac/{atm_driver => bld_templates}/ctsm.cfg | 0 lilac/{atm_driver => bld_templates}/lilac_in | 0 lilac/{atm_driver => bld_templates}/lnd_modelio.nml | 0 lilac/{atm_driver => bld_templates}/mosart_in | 0 5 files changed, 0 insertions(+), 0 deletions(-) rename lilac/{atm_driver => bld_templates}/atm_driver_in (100%) rename lilac/{atm_driver => bld_templates}/ctsm.cfg (100%) rename lilac/{atm_driver => bld_templates}/lilac_in (100%) rename lilac/{atm_driver => bld_templates}/lnd_modelio.nml (100%) rename lilac/{atm_driver => bld_templates}/mosart_in (100%) diff --git a/lilac/atm_driver/atm_driver_in b/lilac/bld_templates/atm_driver_in similarity index 100% rename from lilac/atm_driver/atm_driver_in rename to lilac/bld_templates/atm_driver_in diff --git a/lilac/atm_driver/ctsm.cfg b/lilac/bld_templates/ctsm.cfg similarity index 100% rename from lilac/atm_driver/ctsm.cfg rename to lilac/bld_templates/ctsm.cfg diff --git a/lilac/atm_driver/lilac_in b/lilac/bld_templates/lilac_in similarity index 100% rename from lilac/atm_driver/lilac_in rename to lilac/bld_templates/lilac_in diff --git a/lilac/atm_driver/lnd_modelio.nml b/lilac/bld_templates/lnd_modelio.nml similarity index 100% rename from lilac/atm_driver/lnd_modelio.nml rename to lilac/bld_templates/lnd_modelio.nml diff --git a/lilac/atm_driver/mosart_in b/lilac/bld_templates/mosart_in similarity index 100% rename from lilac/atm_driver/mosart_in rename to lilac/bld_templates/mosart_in From 3013af3e9fde1d6aa5c08eb1a8d934345fe5fc7d Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Thu, 11 Jun 2020 17:14:57 -0600 Subject: [PATCH 377/556] Rename aux_clm1 back to aux_clm --- cime_config/testdefs/testlist_clm.xml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 26860d84a8..70aa5c6af2 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1142,7 +1142,7 @@ - + @@ -1151,7 +1151,7 @@ - + @@ -1160,7 +1160,7 @@ - + @@ -1169,7 +1169,7 @@ - + @@ -1178,7 +1178,7 @@ - + From 8d0bf1b06d30224ef7b909590c8cf40e1da1d8ca Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 11 Jun 2020 18:12:41 -0600 Subject: [PATCH 378/556] Start work on staging runtime inputs --- lilac/bld_templates/ctsm.cfg | 22 ------ lilac/bld_templates/ctsm_template.cfg | 17 +++++ python/ctsm/build_ctsm.py | 103 +++++++++++++++++--------- python/ctsm/test/test_unit_utils.py | 57 ++++++++++++++ python/ctsm/utils.py | 18 +++++ 5 files changed, 162 insertions(+), 55 deletions(-) delete mode 100644 lilac/bld_templates/ctsm.cfg create mode 100644 lilac/bld_templates/ctsm_template.cfg create mode 100755 python/ctsm/test/test_unit_utils.py diff --git a/lilac/bld_templates/ctsm.cfg b/lilac/bld_templates/ctsm.cfg deleted file mode 100644 index 3bea08674f..0000000000 --- a/lilac/bld_templates/ctsm.cfg +++ /dev/null @@ -1,22 +0,0 @@ -[buildnml_input] -clm_phys = clm5_0 -start_type = default -start_ymd = 20000101 -configuration = clm -structure = standard -ccsm_co2_ppmv = 367.0 -clm_co2_type = constant -clm_bldnml_opts = -bgc sp -use_case = 2000_control -lnd_tuning_mode = clm5_0_GSWP3v1 -spinup = off -gridmask = gx3v7 -lnd_grid = 4x5 -lnd_domain_file = domain.lnd.fv4x5_gx3v7.091218.nc -lnd_domain_path = /glade/p/cesmdata/cseg/inputdata/share/domains -din_loc_root = /glade/p/cesmdata/cseg/inputdata -# clm_namelist_opts can contain space-separated settings of individual namelist variables; -# this should NOT be enclosed in quotes; example: -# clm_namelist_opts = foo=1 bar=2 -# The current setting is useful for testing (giving double-precision output every day) -clm_namelist_opts = hist_nhtfrq=-24 hist_mfilt=1 hist_ndens=1 diff --git a/lilac/bld_templates/ctsm_template.cfg b/lilac/bld_templates/ctsm_template.cfg new file mode 100644 index 0000000000..5e9d9379cd --- /dev/null +++ b/lilac/bld_templates/ctsm_template.cfg @@ -0,0 +1,17 @@ +[buildnml_input] +clm_phys = clm5_0 +start_type = default +start_ymd = 20000101 +configuration = nwp +structure = fast +ccsm_co2_ppmv = 367.0 +clm_co2_type = constant +clm_bldnml_opts = -clm_usr_name lilac -bgc sp +use_case = 2000_control +lnd_tuning_mode = clm5_0_GSWP3v1 +spinup = off +gridmask = null +lnd_grid = lilac +lnd_domain_file = domain.lnd.fv4x5_gx3v7.091218.nc +lnd_domain_path = $INPUTDATA/share/domains +din_loc_root = $INPUTDATA diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 48b0c13c6d..6d77374149 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -3,13 +3,12 @@ import argparse import logging import os -import string import subprocess from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args from ctsm.os_utils import run_cmd_output_on_error, make_link from ctsm.path_utils import path_to_ctsm_root -from ctsm.utils import abort +from ctsm.utils import abort, fill_template_file logger = logging.getLogger(__name__) @@ -25,8 +24,14 @@ _COMPSET = 'I2000Ctsm50NwpSpNldasRsGs' _RES = 'nldas2_rnldas2_mnldas2' +_PATH_TO_TEMPLATES = os.path.join(path_to_ctsm_root(), + 'lilac', + 'bld_templates') + _MACHINE_CONFIG_DIRNAME = 'machine_configuration' _INPUTDATA_DIRNAME = 'inputdata' +_RUNTIME_INPUTS_DIRNAME = 'runtime_inputs' + _GPTL_NANOTIMERS_CPPDEFS = '-DHAVE_NANOTIME -DBIT64 -DHAVE_VPRINTF -DHAVE_BACKTRACE -DHAVE_SLASHPROC -DHAVE_COMM_F2C -DHAVE_TIMES -DHAVE_GETTIMEOFDAY' # pylint: disable=line-too-long # ======================================================================== @@ -118,8 +123,9 @@ def build_ctsm(cime_path, build_without_openmp (bool): if True, build without OpenMP support """ + existing_machine = machine is not None _create_build_dir(build_dir=build_dir, - existing_machine=(machine is not None)) + existing_machine=existing_machine) if machine is None: assert os_type is not None, 'with machine absent, os_type must be given' @@ -145,6 +151,18 @@ def build_ctsm(cime_path, machine=machine, build_debug=build_debug, build_without_openmp=build_without_openmp) + + if existing_machine: + # For a user-defined machine, we create an inputdata directory for this case. For + # an existing cime-ported machine, we still want an inputdata directory alongside + # the other directories, but now it will just be a link to the real inputdata + # space on that machine. (Note that, for a user-defined machine, it's important + # that we have created this directory before creating the case, whereas for an + # existing machine, we need to wait until after we have created the case to know + # where to make the sym link point to.) + _link_to_inputdata(build_dir=build_dir) + + _stage_runtime_inputs(build_dir=build_dir) if not no_build: _build_case(build_dir=build_dir) @@ -442,27 +460,20 @@ def _fill_out_machine_files(build_dir, For documentation of args, see the documentation in the build_ctsm function """ - path_to_templates = os.path.join(path_to_ctsm_root(), - 'lilac', - 'bld_templates') os.makedirs(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME)) # ------------------------------------------------------------------------ # Fill in config_machines.xml # ------------------------------------------------------------------------ - with open(os.path.join(path_to_templates, 'config_machines_template.xml')) as cm_template_file: - cm_template_file_contents = cm_template_file.read() - config_machines_template = string.Template(cm_template_file_contents) - config_machines = config_machines_template.substitute( - OS=os_type, - COMPILER=compiler, - CIME_OUTPUT_ROOT=build_dir, - GMAKE=gmake, - GMAKE_J=gmake_j) - with open(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME, 'config_machines.xml'), - 'w') as cm_file: - cm_file.write(config_machines) + fill_template_file( + path_to_template=os.path.join(_PATH_TO_TEMPLATES, 'config_machines_template.xml'), + path_to_final=os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME, 'config_machines.xml'), + substitutions={'OS':os_type, + 'COMPILER':compiler, + 'CIME_OUTPUT_ROOT':build_dir, + 'GMAKE':gmake, + 'GMAKE_J':gmake_j}) # ------------------------------------------------------------------------ # Fill in config_compilers.xml @@ -485,21 +496,19 @@ def _fill_out_machine_files(build_dir, else: pnetcdf_path_tag = '' - with open(os.path.join(path_to_templates, 'config_compilers_template.xml')) as cc_template_file: - cc_template_file_contents = cc_template_file.read() - config_compilers_template = string.Template(cc_template_file_contents) - config_compilers = config_compilers_template.substitute( - COMPILER=compiler, - GPTL_CPPDEFS=gptl_cppdefs, - NETCDF_PATH=netcdf_path, - PIO_FILESYSTEM_HINTS=pio_filesystem_hints_tag, - PNETCDF_PATH=pnetcdf_path_tag, - ESMF_LIBDIR=esmf_lib_path, - EXTRA_CFLAGS=extra_cflags, - EXTRA_FFLAGS=extra_fflags) - with open(os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME, 'config_compilers.xml'), - 'w') as cc_file: - cc_file.write(config_compilers) + fill_template_file( + path_to_template=os.path.join(_PATH_TO_TEMPLATES, + 'config_compilers_template.xml'), + path_to_final=os.path.join(build_dir, _MACHINE_CONFIG_DIRNAME, 'config_compilers.xml'), + substitutions={'COMPILER':compiler, + 'GPTL_CPPDEFS':gptl_cppdefs, + 'NETCDF_PATH':netcdf_path, + 'PIO_FILESYSTEM_HINTS':pio_filesystem_hints_tag, + 'PNETCDF_PATH':pnetcdf_path_tag, + 'ESMF_LIBDIR':esmf_lib_path, + 'EXTRA_CFLAGS':extra_cflags, + 'EXTRA_FFLAGS':extra_fflags}) + def _create_case(cime_path, build_dir, compiler, machine=None, build_debug=False, build_without_openmp=False): @@ -565,6 +574,34 @@ def _create_case(cime_path, build_dir, compiler, make_link(os.path.join(case_dir, '.env_mach_specific.{}'.format(extension)), os.path.join(build_dir, 'ctsm_build_environment.{}'.format(extension))) +def _link_to_inputdata(build_dir): + """For an existing machine, make a sym link to the inputdata directory + + Args: + build_dir (str): path to build directory + """ + case_dir = _get_case_dir(build_dir) + xmlquery = os.path.join(case_dir, 'xmlquery') + + inputdata_dir = subprocess.check_output([xmlquery, '--value', 'DIN_LOC_ROOT'], + cwd=case_dir, + universal_newlines=True) + make_link(inputdata_dir, + os.path.join(build_dir, _INPUTDATA_DIRNAME)) + +def _stage_runtime_inputs(build_dir): + """Stage CTSM and LILAC runtime inputs + + Args: + build_dir (str): path to build directory + """ + os.makedirs(os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME)) + + fill_template_file( + path_to_template=os.path.join(_PATH_TO_TEMPLATES, 'ctsm_template.cfg'), + path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'ctsm.cfg'), + substitutions={'INPUTDATA':os.path.join(build_dir, _INPUTDATA_DIRNAME)}) + def _build_case(build_dir): """Build the CTSM library and its dependencies diff --git a/python/ctsm/test/test_unit_utils.py b/python/ctsm/test/test_unit_utils.py new file mode 100755 index 0000000000..34449aa93c --- /dev/null +++ b/python/ctsm/test/test_unit_utils.py @@ -0,0 +1,57 @@ +#!/usr/bin/env python + +"""Unit tests for utils +""" + +import tempfile +import shutil +import unittest +import os + +from ctsm import unit_testing +from ctsm.utils import fill_template_file + +# Allow names that pylint doesn't like, because otherwise I find it hard +# to make readable unit test names +# pylint: disable=invalid-name + +class TestUtilsFillTemplateFile(unittest.TestCase): + """Tests of utils: fill_template_file""" + + def setUp(self): + self._testdir = tempfile.mkdtemp() + + def tearDown(self): + shutil.rmtree(self._testdir, ignore_errors=True) + + def test_fillTemplateFile_basic(self): + """Basic test of fill_template_file""" + template_path = os.path.join(self._testdir, 'template.txt') + final_path = os.path.join(self._testdir, 'final.txt') + template_contents = """\ +Hello +$foo +Goodbye +$bar +""" + with open(template_path, 'w') as f: + f.write(template_contents) + + fillins = {'foo':'aardvark', + 'bar':'zyzzyva'} + fill_template_file(template_path, final_path, fillins) + + expected_final_text = """\ +Hello +aardvark +Goodbye +zyzzyva +""" + with open(final_path) as f: + final_contents = f.read() + + self.assertEqual(final_contents, expected_final_text) + +if __name__ == '__main__': + unit_testing.setup_for_tests() + unittest.main() diff --git a/python/ctsm/utils.py b/python/ctsm/utils.py index c75214f711..09a08ff9af 100644 --- a/python/ctsm/utils.py +++ b/python/ctsm/utils.py @@ -2,6 +2,7 @@ import logging import sys +import string logger = logging.getLogger(__name__) @@ -15,3 +16,20 @@ def abort(errmsg): pdb.set_trace() sys.exit('ERROR: {}'.format(errmsg)) + +def fill_template_file(path_to_template, path_to_final, substitutions): + """Given a template file (based on python's template strings), write a copy of the + file with template values filled in. + + Args: + path_to_template (str): path to the existing template file + path_to_final (str): path to where the final version will be written + substitutions (dict): key-value pairs for the template string substitutions + """ + + with open(path_to_template) as template_file: + template_file_contents = template_file.read() + template = string.Template(template_file_contents) + final_file_contents = template.substitute(substitutions) + with open(path_to_final, 'w') as final_file: + final_file.write(final_file_contents) From a28bf5e0f978058ae97a8454660114feaccfe5f2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 11 Jun 2020 18:28:50 -0600 Subject: [PATCH 379/556] Stage lilac_in file Also, make default lilac history output never --- .../bld_templates/{lilac_in => lilac_in_template} | 14 +++++++------- python/ctsm/build_ctsm.py | 5 +++++ 2 files changed, 12 insertions(+), 7 deletions(-) rename lilac/bld_templates/{lilac_in => lilac_in_template} (67%) diff --git a/lilac/bld_templates/lilac_in b/lilac/bld_templates/lilac_in_template similarity index 67% rename from lilac/bld_templates/lilac_in rename to lilac/bld_templates/lilac_in_template index 0849c35816..a10baa472b 100644 --- a/lilac/bld_templates/lilac_in +++ b/lilac/bld_templates/lilac_in_template @@ -1,21 +1,21 @@ &lilac_run_input - caseid = 'test_lilac' + caseid = 'ctsm_lilac' / &lilac_history_input - lilac_histfreq_option = 'nsteps' - lilac_histfreq_n = 4 + lilac_histfreq_option = 'never' + lilac_histfreq_n = 1 / &lilac_atmcap_input - atm_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + atm_mesh_filename = '$INPUTDATA/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' / &lilac_lnd_input - lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + lnd_mesh_filename = '$INPUTDATA/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' / &lilac_rof_input - rof_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/r05_nomask_c110308_ESMFmesh.nc' + rof_mesh_filename = '$INPUTDATA/share/meshes/r05_nomask_c110308_ESMFmesh.nc' / &atmaero_stream - stream_fldfilename='/glade/p/cesmdata/cseg/inputdata/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_WACCM.ensmean_monthly_hist_1849-2015_0.9x1.25_CMIP6_c180926.nc' + stream_fldfilename='$INPUTDATA/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_WACCM.ensmean_monthly_hist_1849-2015_0.9x1.25_CMIP6_c180926.nc' stream_year_first = 2000 stream_year_last = 2000 / diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 6d77374149..2aedabcf50 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -602,6 +602,11 @@ def _stage_runtime_inputs(build_dir): path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'ctsm.cfg'), substitutions={'INPUTDATA':os.path.join(build_dir, _INPUTDATA_DIRNAME)}) + fill_template_file( + path_to_template=os.path.join(_PATH_TO_TEMPLATES, 'lilac_in_template'), + path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'lilac_in'), + substitutions={'INPUTDATA':os.path.join(build_dir, _INPUTDATA_DIRNAME)}) + def _build_case(build_dir): """Build the CTSM library and its dependencies From b4a9c7d8928c736da8861eed6b75cdbab384bd87 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 12 Jun 2020 14:18:44 -0600 Subject: [PATCH 380/556] adding more instructions for building and running WRF with CTSMM --- doc/source/lilac/specific-atm-models/wrf.rst | 263 +++++++++---------- 1 file changed, 119 insertions(+), 144 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 8d8b1da338..d6ccbf1cab 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -67,158 +67,92 @@ or Cshell:: recompile when making code changes to the CTSM, read section _obtaining-and-building-ctsm. <-- CREATED LINK TO THE CORRECT SECTION? -Preparing the WRF model +Building the WRF model with CTSM ======================= .. todo:: update the git address to WRF feature branch... -Obtain WRF by running:: +Clone WRF CTSM branch into your directory:: git clone git@github.com:billsacks/WRF.git cd WRF git checkout lilac_dev -.. note:: - - If the git clone command fails for you as written, then try it this way: - git clone https://github.com/billsacks/WRF.git -.. todo:: - - Sam, I think comments like the above are too trivial and make things more confusing... +For building WRF using CTSM, we should set makefile variables from CTSM needed for +WRF build by (BASH):: + export WRF_CTSM_MKFILE=/glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk -Build WRF +or:: + setenv WRF_CTSM_MKFILE /glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk .. todo:: + Bill and Sam do we need the following still:? - Sam, while I think some of the notes below are useful such as number (4), - I believe some of the notes mentioned below such as number (1) is too trivial - and make our instructions less professional. - I tried integrating this into our instructions for example for bash vs. Cshell. +The following is needed in order to undo an undesired setting in that env_mach_specific file:: -.. note:: + export MPI_USE_ARRAY=None - 1) If the export commands below fail due to your environment settings, - try replacing them with setenv commands like this: +or:: - setenv WRF_CTSM_MKFILE /glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk setenv MPI_USE_ARRAY None -.. note:: +There are also few other environmental setting that should be set for building WRF. +Some of these are not required, but might help if you face any compilation errors. - 2) The ./clean -a command is unnecessary the first time you build WRF. - All five lines below become necessary when you modify the WRF code and - need to rebuild. - -.. note:: +Explicitly define which model core to build by:: - 3) The ./configure step will request two inputs while it runs. - Respond with 15 to the first request and with 1 to the second. + export WRF_EM_CORE=1 -.. note:: - - 4) The ./compile step might take more than 30 minutes to complete. +or:: + setenv WRF_EM_CORE 1 +Explicilty turn off data assimilation by:: -For building WRF using CTSM, we should set makefile variables needed for WRF build by:: - - export WRF_CTSM_MKFILE=/glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk + export WRF_DA_CORE=0 or:: - setenv WRF_CTSM_MKFILE /glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk + setenv WRF_DA_CORE 0 -The following is needed in order to undo an undesired setting in that env_mach_specific file:: - - export MPI_USE_ARRAY=None - -or:: - - setenv MPI_USE_ARRAY None +Make sure you set NETCDF environment variable by:: + setenv NETCDF /usr/local/netcdf/ (or wherever you have netcdf compiled.) Then configure and build WRF for your machine and intended compiler by:: - ./clean -a - ./configure + ./clean -a + ./configure Choose one of the options, similar to the compiler used for building CTSM. Next, choose one of the options for nesting. Currently nesting is not available for WRF-CTSM, -therefore we should use 1:: +therefore we should use 1. - ./compile em_real >& compile.log +Then compile em_real and save the log:: -.. note:: + ./compile em_real >& compile.log - Check the bottom of your log file for a successful compilation message - or search the file for the string "Error" with a capital E. .. note:: - Optional: One may use tmux or nohup for configuring and compiling. - Try "man nohup" for more information. - -Create input namelists for CTSM and LILAC -========================================= - -Introduce the following diffs to ./git_wrf_ctsm/ctsm/lilac/atm_driver/ -by replacing the entries preceded by minus signs with the entries -preceded by plus signs. - -diff ./lilac/atm_driver/atm_driver_in ./lilac/atm_driver/atm_driver_in: + The ./compile step might take more than 30 minutes to complete. -.. code-block:: diff - - - atm_mesh_file = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - - atm_global_nx = 72 - - atm_global_ny = 46 - + atm_mesh_file = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' - + atm_global_nx = 199 - + atm_global_ny = 139 - -diff ./lilac/atm_driver/ctsm.cfg ./lilac/atm_driver/ctsm.cfg: - -.. code-block:: diff - - -configuration = clm - -structure = standard - -clm_bldnml_opts = -bgc sp - -gridmask = gx3v7 - -lnd_grid = 4x5 - -lnd_domain_file = domain.lnd.fv4x5_gx3v7.091218.nc - -lnd_domain_path = /glade/p/cesmdata/cseg/inputdata/share/domains - -clm_namelist_opts = hist_nhtfrq=-24 hist_mfilt=1 hist_ndens=1 - +configuration = nwp - +structure = fast - +clm_bldnml_opts = -bgc sp -clm_usr_name wrf2ctsm - +gridmask = null - +lnd_grid = wrf2ctsm - +lnd_domain_file = domain.lnd.wrf2ctsm_lnd_wrf2ctsm_ocn.191211.nc - +lnd_domain_path = /glade/work/slevis/barlage_wrf_ctsm/conus/gen_domain_files - +clm_namelist_opts = hist_nhtfrq=1 hist_mfilt=1 hist_ndens=1 fsurdat="/glade/work/barlage/ctsm/conus/surfdata_conus/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c191212.nc" finidat="/glade/scratch/sacks/wrf_code/WRF/test/em_real/nldas_nwp_0109a.clm2.r.2000-04-01-64800.nc" use_init_interp=.true. - -diff ./lilac/atm_driver/lilac_in ./lilac/atm_driver/lilac_in: - -.. code-block:: diff - - - atm_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - + atm_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' - - lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - + lnd_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' +.. note:: -Generate the lnd_in file by running the following from -./git_wrf_ctsm/ctsm/lilac/atm_driver:: + Check the bottom of your log file for a successful compilation message + or search the file for the string "Error" with a capital E. - ../../lilac_config/buildnml +.. note:: -Copy lilac_in, lnd_in, and lnd_modelio.nml to the WRF/run directory. + Optional: One may use tmux or nohup for configuring and compiling. + Try "man nohup" for more information. @@ -249,25 +183,19 @@ Here choose one option, for your intended compiler, similar to your WRF build. After configuring, you can check configure.wps for making sure all the libs and paths are set correctly. - Then, compile WPS:: ./compile >& compile.log .. note:: - If wps build is succsfully you should see geogrid.exe, ungrib.exe, and metgrid.exe. + If wps build is succsfully you should see geogrid.exe, ungrib.exe, and metgrid.exe. + Alternatively, you can check the log for successful build message. + Run WRF Preprocessing System (WPS) Steps ================================================== - - -.. todo:: - - First reference to the WRF namelist in the next line. We should - specify where that is. - Edit namelist.wps for your domain of interest, which should be the same -domain as used in your WRF namelist. +domain as used in your WRF namelist. Define the domain and interpolate static geographical data to the grids:: @@ -275,7 +203,7 @@ Define the domain and interpolate static geographical data to the grids:: Link in the input GFS data files:: - ./link_grib.csh path_where_you_placed_GFS_files + ./link_grib.csh $path_where_you_placed_GFS_files Extract meteorological fields from GRIB-formatted files:: @@ -288,7 +216,10 @@ the model grids defined in geogrid:: You should now have met_em.d01* files. -Run real.exe to generate initial and boundary conditions + +Run Real program +================================================== +Run real.exe to generate initial and boundary conditions. Follow WRF instructions for creating initial and boundary conditions. In summary, complete the following steps: @@ -309,52 +240,96 @@ To run WRF-CTSM, change land-surface option to 51:: Run real.exe (if compiled parallel submit a batch job) to generate wrfinput and wrfbdy files. -.. todo:: - Sam skipped up to here +Create input namelists for CTSM and LILAC +========================================= -Run WRF -======= +Introduce the following diffs to ./git_wrf_ctsm/ctsm/lilac/atm_driver/ +by replacing the entries preceded by minus signs with the entries +preceded by plus signs. + +diff ./lilac/atm_driver/atm_driver_in ./lilac/atm_driver/atm_driver_in: + +.. code-block:: diff + + - atm_mesh_file = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + - atm_global_nx = 72 + - atm_global_ny = 46 + + atm_mesh_file = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + + atm_global_nx = 199 + + atm_global_ny = 139 + +diff ./lilac/atm_driver/ctsm.cfg ./lilac/atm_driver/ctsm.cfg: -Place the following in a script that you may name run_wrf_ctsm.csh:: +.. code-block:: diff - #!/bin/tcsh - #PBS -N job_name - #PBS -A - #PBS -l walltime=01:00:00 - #PBS -q regular - #PBS -k eod + -configuration = clm + -structure = standard + -clm_bldnml_opts = -bgc sp + -gridmask = gx3v7 + -lnd_grid = 4x5 + -lnd_domain_file = domain.lnd.fv4x5_gx3v7.091218.nc + -lnd_domain_path = /glade/p/cesmdata/cseg/inputdata/share/domains + -clm_namelist_opts = hist_nhtfrq=-24 hist_mfilt=1 hist_ndens=1 + +configuration = nwp + +structure = fast + +clm_bldnml_opts = -bgc sp -clm_usr_name wrf2ctsm + +gridmask = null + +lnd_grid = wrf2ctsm + +lnd_domain_file = domain.lnd.wrf2ctsm_lnd_wrf2ctsm_ocn.191211.nc + +lnd_domain_path = /glade/work/slevis/barlage_wrf_ctsm/conus/gen_domain_files + +clm_namelist_opts = hist_nhtfrq=1 hist_mfilt=1 hist_ndens=1 fsurdat="/glade/work/barlage/ctsm/conus/surfdata_conus/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c191212.nc" finidat="/glade/scratch/sacks/wrf_code/WRF/test/em_real/nldas_nwp_0109a.clm2.r.2000-04-01-64800.nc" use_init_interp=.true. - #PBS -l select=2:ncpus=4:mpiprocs=8 +diff ./lilac/atm_driver/lilac_in ./lilac/atm_driver/lilac_in: - ml +.. code-block:: diff + + - atm_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + + atm_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + + - lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + + lnd_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + +Generate the lnd_in file by running the following from +./git_wrf_ctsm/ctsm/lilac/atm_driver:: - ### Set TMPDIR as recommended - setenv TMPDIR /glade/scratch/$USER/temp - mkdir -p $TMPDIR + ../../lilac_config/buildnml +Copy lilac_in, lnd_in, and lnd_modelio.nml to the WRF/run directory. - echo "hello" - ### Run the executable - set MPI_SHEPHERD=true - ln -sf .../WRF/test/em_real/namelist.input.ctsm_test.2013.d01 namelist.input - ln -sf .../WRF/test/em_real/wrfinput_d01.noseaice wrfinput_d01 - ln -sf .../WRF/test/em_real/wrfbdy_d01.6month wrfbdy_d01 - mpiexec_mpt ./wrf.exe -where "..." is the path to your WRF directory. +Run WRF +================= -.. note:: +If real program is completed successfully, we should see wrfinput and wrfbdy files +in our directory. + +Next, we should run WRF via batch job. +For Cheyenne, we should submit a batch job to PBS (Pro workload management system). +For more instructions on running a batch job on Cheyenne, please check: +https://www2.cisl.ucar.edu/resources/computational-systems/cheyenne/running-jobs/submitting-jobs-pbs + + +A sample of basic PBS job for Cheyenne:: + + #!/bin/tcsh + #PBS -N job_name + #PBS -A project_code + #PBS -l walltime=01:00:00 + #PBS -q queue_name + #PBS -j oe + #PBS -k eod + #PBS -m abe + #PBS -M your_email_address + #PBS -l select=2:ncpus=36:mpiprocs=36 - 1) Replace - #PBS -l select=2:ncpus=4:mpiprocs=8 - with - #PBS -l select=4:ncpus=36:mpiprocs=36 - to use more processors and run faster. + ### Set TMPDIR as recommended + setenv TMPDIR /glade/scratch/$USER/temp + mkdir -p $TMPDIR -Run:: + ### Run the executable + mpiexec_mpt ./wrf.exe - qsub run_wrf_ctsm.csh From 1843d4ac23054730d5db6535efd6b31be1ebaef8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 12 Jun 2020 16:54:55 -0600 Subject: [PATCH 381/556] Improve user-friendliness of ctsm.cfg --- lilac/bld_templates/ctsm_template.cfg | 60 ++++++++++--- lilac_config/buildnml | 122 +++++++++++++++++++------- python/ctsm/build_ctsm.py | 7 ++ 3 files changed, 145 insertions(+), 44 deletions(-) diff --git a/lilac/bld_templates/ctsm_template.cfg b/lilac/bld_templates/ctsm_template.cfg index 5e9d9379cd..9d697fb4e6 100644 --- a/lilac/bld_templates/ctsm_template.cfg +++ b/lilac/bld_templates/ctsm_template.cfg @@ -1,17 +1,55 @@ [buildnml_input] -clm_phys = clm5_0 -start_type = default -start_ymd = 20000101 + +# ------------------------------------------------------------------------ +# Paths to resolution-dependent files +# +# Note that some other files also need to be set in lilac_in: +# atm_mesh_filename and lnd_mesh_filename +# ------------------------------------------------------------------------ + +lnd_domain_file = FILL_THIS_IN +fsurdat = FILL_THIS_IN +finidat = FILL_THIS_IN + +# ------------------------------------------------------------------------ +# High-level configuration options +# ------------------------------------------------------------------------ + +# ctsm_phys: 'clm4_5' or 'clm5_0' +ctsm_phys = clm5_0 + +# configuration: 'nwp' or 'clm' configuration = nwp + +# structure: 'fast' or 'standard' structure = fast -ccsm_co2_ppmv = 367.0 -clm_co2_type = constant -clm_bldnml_opts = -clm_usr_name lilac -bgc sp + +# bgc_mode: +# - 'sp' (satellite phenology - no biogeochemistry) +# - 'bgc' (full biogeochemistry) +# - 'cn' (CLM4-style biogeochemistry) +# - 'fates' (Functionally Assembled Terrestrial Ecosystem Simulator) +bgc_mode = sp + +# crop: 'off' or 'on' ('on' only allowed for bgc_mode = 'bgc' or 'cn') +crop = off + +# vichydro: 'off' or 'on' ('on' only allowed for bgc_mode = 'sp') +vichydro = off + +# ------------------------------------------------------------------------ +# Specific configuration options +# ------------------------------------------------------------------------ + +co2_ppmv = 367.0 use_case = 2000_control lnd_tuning_mode = clm5_0_GSWP3v1 + +# spinup: whether to do accelerated spinup: 'off' or 'on' spinup = off -gridmask = null -lnd_grid = lilac -lnd_domain_file = domain.lnd.fv4x5_gx3v7.091218.nc -lnd_domain_path = $INPUTDATA/share/domains -din_loc_root = $INPUTDATA + +# ------------------------------------------------------------------------ +# Inputdata location (filled in automatically for your given build directory, but can be changed if desired) +# ------------------------------------------------------------------------ + +inputdata_path = $INPUTDATA diff --git a/lilac_config/buildnml b/lilac_config/buildnml index edb72709fc..004961da9c 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -38,6 +38,10 @@ _ENV_LILAC_TEMPLATE = """ """ +# This string is used in the out-of-the-box ctsm.cfg file to denote a value that needs to +# be filled in +_PLACEHOLDER = 'FILL_THIS_IN' + ############################################################################### def parse_command_line(args, description): ############################################################################### @@ -59,24 +63,55 @@ def parse_command_line(args, description): return arguments.rundir ############################################################################### -def get_config_value(config, section, item, file_path): +def get_config_value(config, section, item, file_path, allowed_values=None): """Get a given item from a given section of the config object Give a helpful error message if we can't find the given section or item Note that the file_path argument is only used for the sake of the error message + + If allowed_values is present, it should be a list of strings giving allowed values """ try: val = config.get(section, item) except NoSectionError: - print("ERROR: Config file {} must contain section '{}'\n".format(file_path, section)) - raise + sys.exit("ERROR: Config file {} must contain section '{}'".format(file_path, section)) except NoOptionError: - print("ERROR: Config file {} must contain item '{}' in section '{}'\n".format( + sys.exit("ERROR: Config file {} must contain item '{}' in section '{}'".format( file_path, item, section)) - raise + + if val == _PLACEHOLDER: + sys.exit("Error: {} needs to be specified in config file {}".format(item, file_path)) + + if allowed_values is not None: + if val not in allowed_values: + sys.exit("Error: {} is not an allowed value for {} in config file {}\n" + "Allowed values: {}".format(val, item, file_path, allowed_values)) + return val +############################################################################### +def determine_bldnml_opts(bgc_mode, crop, vichydro): +############################################################################### + """Return a string giving bldnml options, given some other inputs""" + bldnml_opts = '' + bldnml_opts += ' -bgc {}'.format(bgc_mode) + if bgc_mode == 'fates': + # BUG(wjs, 2020-06-12, ESCOMP/CTSM#115) For now, FATES is incompatible with MEGAN + bldnml_opts += ' -no-megan' + + if crop == 'on': + if bgc_mode not in ['bgc', 'cn']: + sys.exit("Error: setting crop to 'on' is only compatible with bgc_mode of 'bgc' or 'cn'") + bldnml_opts += ' -crop' + + if vichydro == 'on': + if bgc_mode != 'sp': + sys.exit("Error: setting vichydro to 'on' is only compatible with bgc_mode of 'sp'") + bldnml_opts += ' -vichydro' + + return bldnml_opts + ############################################################################### def buildnml(rundir, bldnmldir): ############################################################################### @@ -91,29 +126,40 @@ def buildnml(rundir, bldnmldir): config = ConfigParser() config.read(file_path) - clm_phys = get_config_value(config, 'buildnml_input', 'clm_phys', file_path) - start_type = get_config_value(config, 'buildnml_input', 'start_type', file_path) - start_ymd = get_config_value(config, 'buildnml_input', 'start_ymd', file_path) - configuration = get_config_value(config, 'buildnml_input', 'configuration', file_path) - structure = get_config_value(config, 'buildnml_input', 'structure', file_path) - ccsm_co2_ppmv = get_config_value(config, 'buildnml_input', 'ccsm_co2_ppmv', file_path) - clm_co2_type = get_config_value(config, 'buildnml_input', 'clm_co2_type', file_path) - clm_bldnml_opts = get_config_value(config, 'buildnml_input', 'clm_bldnml_opts', file_path) + lnd_domain_file = get_config_value(config, 'buildnml_input', 'lnd_domain_file', file_path) + fsurdat = get_config_value(config, 'buildnml_input', 'fsurdat', file_path) + finidat = get_config_value(config, 'buildnml_input', 'finidat', file_path) + + ctsm_phys = get_config_value(config, 'buildnml_input', 'ctsm_phys', file_path, + allowed_values=['clm4_5', 'clm5_0']) + configuration = get_config_value(config, 'buildnml_input', 'configuration', file_path, + allowed_values=['nwp', 'clm']) + structure = get_config_value(config, 'buildnml_input', 'structure', file_path, + allowed_values=['fast', 'standard']) + bgc_mode = get_config_value(config, 'buildnml_input', 'bgc_mode', file_path, + allowed_values=['sp', 'bgc', 'cn', 'fates']) + crop = get_config_value(config, 'buildnml_input', 'crop', file_path, + allowed_values=['off', 'on']) + vichydro = get_config_value(config, 'buildnml_input', 'vichydro', file_path, + allowed_values=['off', 'on']) + + bldnml_opts = determine_bldnml_opts(bgc_mode=bgc_mode, + crop=crop, + vichydro=vichydro) + + co2_ppmv = get_config_value(config, 'buildnml_input', 'co2_ppmv', file_path) use_case = get_config_value(config, 'buildnml_input', 'use_case', file_path) lnd_tuning_mode = get_config_value(config, 'buildnml_input', 'lnd_tuning_mode', file_path) - spinup = get_config_value(config, 'buildnml_input', 'spinup', file_path) - gridmask = get_config_value(config, 'buildnml_input', 'gridmask', file_path) - lnd_grid = get_config_value(config, 'buildnml_input', 'lnd_grid', file_path) - lnd_domain_file = get_config_value(config, 'buildnml_input', 'lnd_domain_file', file_path) - lnd_domain_path = get_config_value(config, 'buildnml_input', 'lnd_domain_path', file_path) - din_loc_root = get_config_value(config, 'buildnml_input', 'din_loc_root', file_path) - clm_namelist_opts = get_config_value(config, 'buildnml_input', 'clm_namelist_opts', file_path) + spinup = get_config_value(config, 'buildnml_input', 'spinup', file_path, + allowed_values=['off', 'on']) + + inputdata_path = get_config_value(config, 'buildnml_input', 'inputdata_path', file_path) # create config_cache.xml file # Note that build-namelist utilizes the contents of the config_cache.xml file in # the namelist_defaults.xml file to obtain namelist variables config_cache = os.path.join(rundir, "config_cache.xml") - config_cache_text = _CONFIG_CACHE_TEMPLATE.format(clm_phys=clm_phys) + config_cache_text = _CONFIG_CACHE_TEMPLATE.format(clm_phys=ctsm_phys) with open(config_cache, 'w') as tempfile: tempfile.write(config_cache_text) @@ -128,30 +174,40 @@ def buildnml(rundir, bldnmldir): if os.path.exists(inputdatalist_path): os.remove(inputdatalist_path) + # determine if fsurdat and/or finidat should appear in the -namelist option + extra_namelist_opts = '' + if fsurdat != 'UNSET': + extra_namelist_opts = extra_namelist_opts + " fsurdat = '{}' ".format(fsurdat) + if finidat != 'UNSET': + extra_namelist_opts = extra_namelist_opts + " finidat = '{}' ".format(finidat) + # call build-namelist cmd = os.path.abspath(os.path.join(bldnmldir, os.pardir, "bld", "build-namelist")) command = [cmd, - '-csmdata', din_loc_root, + '-csmdata', inputdata_path, '-inputdata', inputdatalist_path, - '-namelist', '&clm_inparm start_ymd={} {}/'.format(start_ymd, clm_namelist_opts), + # Hard-code start_ymd of year-2000. This is used to set the run type (for + # which a setting of 2000 gives 'startup', which is what we want) and pick + # the initial conditions file (which is pretty much irrelevant when running + # with lilac). + '-namelist', '&clm_inparm start_ymd=20000101 {} /'.format(extra_namelist_opts), '-use_case', use_case, '-ignore_ic_year', # For now, we assume ignore_ic_year, not ignore_ic_date - '-res', lnd_grid, - '-clm_start_type', start_type, + '-res', 'lilac', + '-clm_start_type', 'default', # seems unimportant (see discussion in https://github.com/ESCOMP/CTSM/issues/876) '-configuration', configuration, '-structure', structure, - '-lnd_frac', os.path.join(lnd_domain_path, lnd_domain_file), + '-lnd_frac', lnd_domain_file, '-glc_nec', str(10), - '-co2_ppmv', ccsm_co2_ppmv, - '-co2_type', clm_co2_type, + '-co2_ppmv', co2_ppmv, + '-co2_type', 'constant', '-clm_accelerated_spinup', spinup, '-lnd_tuning_mode', lnd_tuning_mode, '-no-megan', # Eventually make this dynamic (see https://github.com/ESCOMP/CTSM/issues/926) '-config', os.path.join(rundir, "config_cache.xml"), - '-envxml_dir', rundir] - command.extend(clm_bldnml_opts.split()) - if gridmask not in ('null', 'UNSET'): - command.extend(['-mask', gridmask]) + '-envxml_dir', rundir, + '-clm_usr_name', 'lilac'] + command.extend(bldnml_opts.split()) subprocess.check_call(command, universal_newlines=True) @@ -166,7 +222,7 @@ def main(): """Main function""" rundir = parse_command_line(sys.argv[1:], __doc__) - bldnmldir = os.path.dirname(os.path.abspath(__file__)) + bldnmldir = os.path.dirname(os.path.realpath(__file__)) buildnml(rundir, bldnmldir) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index 2aedabcf50..e19a19a850 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -28,6 +28,10 @@ 'lilac', 'bld_templates') +_PATH_TO_BUILDNML = os.path.join(path_to_ctsm_root(), + 'lilac_config', + 'buildnml') + _MACHINE_CONFIG_DIRNAME = 'machine_configuration' _INPUTDATA_DIRNAME = 'inputdata' _RUNTIME_INPUTS_DIRNAME = 'runtime_inputs' @@ -607,6 +611,9 @@ def _stage_runtime_inputs(build_dir): path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'lilac_in'), substitutions={'INPUTDATA':os.path.join(build_dir, _INPUTDATA_DIRNAME)}) + make_link(_PATH_TO_BUILDNML, + os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'buildnml')) + def _build_case(build_dir): """Build the CTSM library and its dependencies From 0ce36157681051204ba6091ee3785b22785db081 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 12 Jun 2020 17:34:37 -0600 Subject: [PATCH 382/556] Remove a warning message According to @ekluzek, this is an out-dated message that we should just ignore --- bld/CLMBuildNamelist.pm | 3 --- 1 file changed, 3 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 985f886c9f..db6fc6cb55 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1391,9 +1391,6 @@ sub process_namelist_commandline_clm_usr_name { $nvars++; } } - if ( $nvars == 0 ) { - $log->message("setting clm_usr_name -- but did NOT find any user datasets: $opts->{'clm_usr_name'}", $opts); - } # Go through all variables and expand any XML env settings in them expand_xml_variables_in_namelist( $nl_usrfile, $envxml_ref ); # Merge input values into namelist. Previously specified values have higher precedence From 2abb3f4a0f477cd0243f032fc625434af8907189 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 15 Jun 2020 17:17:48 -0600 Subject: [PATCH 383/556] Mention generation and use of alternate finidat in wrf.rst --- doc/source/lilac/specific-atm-models/wrf.rst | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index d6ccbf1cab..4f4cf4e81f 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -68,7 +68,7 @@ or Cshell:: _obtaining-and-building-ctsm. <-- CREATED LINK TO THE CORRECT SECTION? Building the WRF model with CTSM -======================= +================================ .. todo:: update the git address to WRF feature branch... @@ -290,6 +290,20 @@ diff ./lilac/atm_driver/lilac_in ./lilac/atm_driver/lilac_in: - lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + lnd_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' +Before you generate the lnd_in file, you may modify user_nl_clm in +/glade/scratch/$USER/ctsm_build_dir/case/. For example you may wish to +point to an alternate CTSM initial condition file. To merge WRF initial +conditions from a wrfinput file into a CTSM initial condition file, type:: + + module load ncl/6.6.2 + ncl transfer_wrfinput_to_ctsm_with_snow.ncl 'finidat="finidat_interp_dest.nc"' 'wrfinput="./git_wrf_ctsm/WRF/test/em_real/wrfinput_d01.noseaice"' 'merged="finidat_interp_dest_wrfinit_snow.nc"' + +.. todo:: + + Need to make the above ncl script available. I assume that the finidat + and the wrfinput files need to be consistent for this to work. If so, + we should prob. explain how to generate a consistent finidat file. + Generate the lnd_in file by running the following from ./git_wrf_ctsm/ctsm/lilac/atm_driver:: @@ -301,7 +315,7 @@ Copy lilac_in, lnd_in, and lnd_modelio.nml to the WRF/run directory. Run WRF -================= +======= If real program is completed successfully, we should see wrfinput and wrfbdy files in our directory. From 78b3f58610f677c0a9521cd328a1288d9b1804cd Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 16 Jun 2020 17:12:14 -0600 Subject: [PATCH 384/556] Allow use of an existing resolution/mask in lilac's buildnml This restores some of the previous flexibility that I had recently deleted. --- lilac/bld_templates/ctsm_template.cfg | 20 ++++++- lilac_config/buildnml | 75 +++++++++++++++++++++------ 2 files changed, 79 insertions(+), 16 deletions(-) diff --git a/lilac/bld_templates/ctsm_template.cfg b/lilac/bld_templates/ctsm_template.cfg index 9d697fb4e6..be485c9708 100644 --- a/lilac/bld_templates/ctsm_template.cfg +++ b/lilac/bld_templates/ctsm_template.cfg @@ -3,13 +3,31 @@ # ------------------------------------------------------------------------ # Paths to resolution-dependent files # +# Values with FILL_THIS_IN generally *must* be specified (however, see +# note below about fsurdat when using --existing-res). Values with UNSET +# should generally be specified explicitly, but it's also acceptable to +# leave these as UNSET and use the out-of-the-box defaults. +# # Note that some other files also need to be set in lilac_in: # atm_mesh_filename and lnd_mesh_filename # ------------------------------------------------------------------------ +# lnd_domain_file always needs to be specified, whether you're using an +# existing grid or a user-defined grid lnd_domain_file = FILL_THIS_IN + +# The fsurdat (surface dataset) file defined here is only used for a +# user-defined grid (i.e., without the --existing-res argument to +# lilac's buildnml script). For an existing grid (i.e., with the +# --existing-res argument), this is ignored; however, it's still +# possible to override the default, out-of-the-box setting in the +# user_nl_ctsm file. fsurdat = FILL_THIS_IN -finidat = FILL_THIS_IN + +# The finidat (initial conditions) file does not absolutely need to be +# specified, but in most cases, you should specify your own finidat file +# rather than using one of the out-of-the-box ones. +finidat = UNSET # ------------------------------------------------------------------------ # High-level configuration options diff --git a/lilac_config/buildnml b/lilac_config/buildnml index 004961da9c..7d48d82bc6 100755 --- a/lilac_config/buildnml +++ b/lilac_config/buildnml @@ -42,25 +42,49 @@ _ENV_LILAC_TEMPLATE = """ # be filled in _PLACEHOLDER = 'FILL_THIS_IN' +# This string is used in the out-of-the-box ctsm.cfg file to denote a value that can be +# filled in, but doesn't absolutely need to be +_UNSET = 'UNSET' + ############################################################################### def parse_command_line(args, description): ############################################################################### - """Parse the command line, return rundir""" + """Parse the command line, return object holding arguments""" parser = argparse.ArgumentParser(formatter_class=argparse.RawTextHelpFormatter, description=description) parser.add_argument("--rundir", type=str, default=os.getcwd(), - help="specify the full path of the run directory") + help="Full path of the run directory") + + parser.add_argument("--existing-res", + help="Use the given out-of-the-box resolution (e.g., '4x5').\n" + "This argument should NOT be provided for a user-defined resolution.\n" + "If this argument is provided, then --existing-mask must also be provided.") + + parser.add_argument("--existing-mask", + help="Use the given out-of-the-box mask (e.g., 'gx3v7').\n" + "This argument should NOT be provided for a user-defined resolution.\n" + "If this argument is provided, then --existing-res must also be provided.") arguments = parser.parse_args(args) - # check if rundir exists + # Perform some error checking on arguments, and set derived values + if not os.path.isdir(arguments.rundir): - raise RuntimeError("rundir {} does not exist".format(arguments.rundir)) + sys.exit("rundir {} does not exist".format(arguments.rundir)) - return arguments.rundir + if arguments.existing_res and arguments.existing_mask: + arguments.use_existing_res_and_mask = True + elif arguments.existing_res and not arguments.existing_mask: + sys.exit("If --existing-res is given, then --existing-mask must also be given") + elif arguments.existing_mask and not arguments.existing_res: + sys.exit("If --existing-mask is given, then --existing-res must also be given") + else: + arguments.use_existing_res_and_mask = False + + return arguments ############################################################################### def get_config_value(config, section, item, file_path, allowed_values=None): @@ -113,10 +137,14 @@ def determine_bldnml_opts(bgc_mode, crop, vichydro): return bldnml_opts ############################################################################### -def buildnml(rundir, bldnmldir): +def buildnml(rundir, bldnmldir, use_existing_res_and_mask, existing_res=None, existing_mask=None): ############################################################################### - """Build the ctsm namelist""" + """Build the ctsm namelist + + If use_existing_res_and_mask is True, then existing_res and existing_mask should be + specified; otherwise, they are ignored. + """ # pylint: disable=too-many-locals @@ -127,7 +155,12 @@ def buildnml(rundir, bldnmldir): config.read(file_path) lnd_domain_file = get_config_value(config, 'buildnml_input', 'lnd_domain_file', file_path) - fsurdat = get_config_value(config, 'buildnml_input', 'fsurdat', file_path) + if use_existing_res_and_mask: + fsurdat = _UNSET + else: + # If we're not using an out-of-the-box grid, then require the user to explicitly + # specify the surface dataset. + fsurdat = get_config_value(config, 'buildnml_input', 'fsurdat', file_path) finidat = get_config_value(config, 'buildnml_input', 'finidat', file_path) ctsm_phys = get_config_value(config, 'buildnml_input', 'ctsm_phys', file_path, @@ -176,9 +209,9 @@ def buildnml(rundir, bldnmldir): # determine if fsurdat and/or finidat should appear in the -namelist option extra_namelist_opts = '' - if fsurdat != 'UNSET': + if fsurdat != _UNSET: extra_namelist_opts = extra_namelist_opts + " fsurdat = '{}' ".format(fsurdat) - if finidat != 'UNSET': + if finidat != _UNSET: extra_namelist_opts = extra_namelist_opts + " finidat = '{}' ".format(finidat) # call build-namelist @@ -193,7 +226,6 @@ def buildnml(rundir, bldnmldir): '-namelist', '&clm_inparm start_ymd=20000101 {} /'.format(extra_namelist_opts), '-use_case', use_case, '-ignore_ic_year', # For now, we assume ignore_ic_year, not ignore_ic_date - '-res', 'lilac', '-clm_start_type', 'default', # seems unimportant (see discussion in https://github.com/ESCOMP/CTSM/issues/876) '-configuration', configuration, '-structure', structure, @@ -205,8 +237,16 @@ def buildnml(rundir, bldnmldir): '-lnd_tuning_mode', lnd_tuning_mode, '-no-megan', # Eventually make this dynamic (see https://github.com/ESCOMP/CTSM/issues/926) '-config', os.path.join(rundir, "config_cache.xml"), - '-envxml_dir', rundir, - '-clm_usr_name', 'lilac'] + '-envxml_dir', rundir] + if use_existing_res_and_mask: + command.extend(['-res', existing_res, + '-mask', existing_mask]) + else: + # NOTE(wjs, 2020-06-16) Note that we do NOT use the -mask argument in this case; + # it's possible that we should be using it in some circumstances (I haven't looked + # into how it's used). + command.extend(['-res', 'lilac', + '-clm_usr_name', 'lilac']) command.extend(bldnml_opts.split()) subprocess.check_call(command, @@ -221,9 +261,14 @@ def buildnml(rundir, bldnmldir): def main(): """Main function""" - rundir = parse_command_line(sys.argv[1:], __doc__) + args = parse_command_line(sys.argv[1:], __doc__) bldnmldir = os.path.dirname(os.path.realpath(__file__)) - buildnml(rundir, bldnmldir) + buildnml( + rundir=args.rundir, + bldnmldir=bldnmldir, + use_existing_res_and_mask=args.use_existing_res_and_mask, + existing_res=args.existing_res, + existing_mask=args.existing_mask) ############################################################################### From 92314eca77bd892ddfb45e7a1b37b8579ba7f704 Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Wed, 17 Jun 2020 12:05:00 -0600 Subject: [PATCH 385/556] Add mapping files for ARCTIC, ARCTICGRIS, ne30np4.pg2, ne30pg3, ne120np4.pg2, ne120np4.pg3 --- bld/namelist_files/namelist_defaults_ctsm.xml | 252 ++++++++++++++++++ 1 file changed, 252 insertions(+) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index e8a3e4175c..2cba23063c 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -2958,6 +2958,258 @@ lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_h >lnd/clm2/mappingdata/maps/94x192/map_3x3min_MODISv2_to_94x192_nomask_aave_da_c190521.nc + + + + +lnd/clm2/mappingdata/maps/ARCTIC/map_3x3min_USGS_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_0.9x1.25_GRDC_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_360x720cru_cruncep_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_5x5min_ISRIC-WISE_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_0.5x0.5_AVHRR_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_3x3min_GLOBE-Gardner_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_5x5min_nomask_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_5x5min_IGBP-GSDP_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_0.5x0.5_MODIS_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_3x3min_MODISv2_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_0.25x0.25_MODIS_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_3x3min_MODIS-wCsp_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_10x10min_nomask_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_5x5min_ORNL-Soil_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_3x3min_LandScan2004_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTIC/map_10x10min_IGBPmergeICESatGIS_to_ne0np4.ARCTIC.ne30x4_nomask_aave_da_c200426.nc + + + + + + +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_5x5min_nomask_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_0.5x0.5_MODIS_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_3x3min_MODISv2_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_5x5min_ORNL-Soil_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_3x3min_MODIS-wCsp_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_0.5x0.5_AVHRR_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_3x3min_GLOBE-Gardner_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_10x10min_nomask_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_5x5min_ISRIC-WISE_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_360x720cru_cruncep_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_10x10min_IGBPmergeICESatGIS_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_5x5min_IGBP-GSDP_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_0.25x0.25_MODIS_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_3x3min_USGS_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_0.9x1.25_GRDC_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ARCTICGRIS/map_3x3min_LandScan2004_to_ne0np4.ARCTICGRIS.ne30x8_nomask_aave_da_c200426.nc + + + + + + +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_5x5min_nomask_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_3x3min_MODIS-wCsp_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_5x5min_IGBP-GSDP_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_3x3min_LandScan2004_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_360x720cru_cruncep_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_3x3min_USGS_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_0.9x1.25_GRDC_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_0.5x0.5_AVHRR_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_10x10min_IGBPmergeICESatGIS_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_0.5x0.5_MODIS_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_5x5min_ISRIC-WISE_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_3x3min_MODISv2_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_3x3min_GLOBE-Gardner_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_5x5min_ORNL-Soil_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_10x10min_nomask_to_ne30np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30np4.pg2/map_0.25x0.25_MODIS_to_ne30np4.pg2_nomask_aave_da_c200426.nc + + + + + + +lnd/clm2/mappingdata/maps/ne30pg3/map_3x3min_USGS_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_0.25x0.25_MODIS_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_5x5min_ORNL-Soil_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_3x3min_LandScan2004_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_5x5min_nomask_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_0.9x1.25_GRDC_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_3x3min_MODISv2_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_5x5min_ISRIC-WISE_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_5x5min_IGBP-GSDP_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_3x3min_MODIS-wCsp_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_3x3min_GLOBE-Gardner_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_10x10min_IGBPmergeICESatGIS_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_360x720cru_cruncep_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_10x10min_nomask_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_0.5x0.5_MODIS_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne30np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne30pg3/map_0.5x0.5_AVHRR_to_ne30np4.pg3_nomask_aave_da_c200426.nc + + + + + + +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_10x10min_nomask_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_5x5min_ISRIC-WISE_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_360x720cru_cruncep_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_5x5min_IGBP-GSDP_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_0.25x0.25_MODIS_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_5x5min_nomask_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_3x3min_USGS_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_3x3min_LandScan2004_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_0.5x0.5_MODIS_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_3x3min_MODISv2_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_10x10min_IGBPmergeICESatGIS_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_0.9x1.25_GRDC_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_0.5x0.5_AVHRR_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_5x5min_ORNL-Soil_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_3x3min_MODIS-wCsp_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_3x3min_GLOBE-Gardner_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne120np4.pg2_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg2/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne120np4.pg2_nomask_aave_da_c200426.nc + + + + + + +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_0.5x0.5_MODIS_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_5x5min_ORNL-Soil_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_10x10min_IGBPmergeICESatGIS_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_0.25x0.25_MODIS_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_10x10min_nomask_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_3x3min_MODIS-wCsp_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_360x720cru_cruncep_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_3x3min_LandScan2004_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_0.5x0.5_AVHRR_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_3x3min_USGS_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_3x3min_GLOBE-Gardner_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_0.9x1.25_GRDC_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_5x5min_IGBP-GSDP_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_5x5min_ISRIC-WISE_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_5x5min_nomask_to_ne120np4.pg3_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne120np4.pg3/map_3x3min_MODISv2_to_ne120np4.pg3_nomask_aave_da_c200426.nc + + From 7219faf7dfde251d9d6e3bdd8d2d24117db73d3a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 18 Jun 2020 13:30:22 -0600 Subject: [PATCH 386/556] Update standard list of resolutions to make Update the standard list of resolutions to make when surface datasets are created. Add a new list of SE and variable mesh grids. Remove the f05 which we don't think we need. --- tools/mksurfdata_map/Makefile.data | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tools/mksurfdata_map/Makefile.data b/tools/mksurfdata_map/Makefile.data index f7cad8415e..373ff6e63d 100644 --- a/tools/mksurfdata_map/Makefile.data +++ b/tools/mksurfdata_map/Makefile.data @@ -56,10 +56,15 @@ MKSURFDATA = $(BATCHJOBS) $(PWD)/mksurfdata.pl # f19 and f09 are standard resolutions, f10 is used for testing, f45 is used for FATES # ne30np4 is standard resolution for SE dycore in CAM, C96 is standard for fv3 dycore +# The ne30np4 series (including pg2, pg3, pg4) are standard for SE dycore +# The variable resolution grids for ARCTIC, ARCTICGRIS and CONUS are also standard STANDARD_RES_NO_CROP = 0.9x1.25,1.9x2.5,10x15 -STANDARD_RES = 0.9x1.25,1.9x2.5,10x15,4x5,ne30np4,C96 +STANDARD_RES = 0.9x1.25,1.9x2.5,10x15,4x5,ne30np4,C96,ne30pg2,ne30pg3,ne30pg4,ne120np4pg3,ne0np4ARCTICGRISne30x8,ne0np4ARCTICne30x4,ne0np4CONUSne30x8 +# For future CMIP6 scenarios: SSP-RCP's FUTURE_RES = 0.9x1.25,1.9x2.5,10x15 +# For historical transient cases (TRY TO KEEP THIS LIST AS SHORT AS POSSIBLE) +TRANS_RES = 0.9x1.25,1.9x2.5,10x15,ne30np4,ne0np4ARCTICGRISne30x8,ne0np4ARCTICne30x4,ne0np4CONUSne30x8 # ne120np4 is for high resolution SE dycore, ne16 is for testing SE dycore # T42 is for SCAM @@ -77,7 +82,6 @@ TROPICS = \ CROP = \ crop-global-present \ - crop-global-present-f05 \ crop-global-present-ne16np4 \ crop-global-present-ne120np4 \ crop-numa-present \ @@ -85,12 +89,8 @@ CROP = \ crop-smallville \ crop-smallville-historical \ crop-global-historical \ - crop-global-historical-f05 \ - crop-global-historical-ne120np4 \ - crop-global-transient-f05 \ crop-global-transient \ - crop-global-future \ - crop-global-transient-ne120np4 + crop-global-future all : standard tropics crop urban landuse-timeseries @@ -178,7 +178,7 @@ crop-global-historical-ne120np4 : FORCE $(MKSURFDATA) -glc_nec 10 -y 1850 -res ne120np4 $(BACKGROUND) crop-global-transient: FORCE - $(MKSURFDATA) -no_surfdata -glc_nec 10 -y 1850-2000 -res $(STANDARD_RES) $(BACKGROUND) + $(MKSURFDATA) -no_surfdata -glc_nec 10 -y 1850-2000 -res $(TRANS_RES) $(BACKGROUND) crop-global-transient-ne120np4 : FORCE $(MKSURFDATA) -no_surfdata -glc_nec 10 -y 1850-2000 -res ne120np4 $(BACKGROUND) From f344e65ac517cba013798ca57dda66c7f8d9f52c Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Jun 2020 12:09:10 -0600 Subject: [PATCH 387/556] Working on the documentations and adding some corrections. --- doc/source/lilac/specific-atm-models/wrf.rst | 129 ++++++++++--------- 1 file changed, 70 insertions(+), 59 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 4f4cf4e81f..0354992863 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -16,50 +16,38 @@ from earlier sections but in recipe form and with minimal detail. This section assumes use of a machine that has been ported to CIME. In this example we assume NCAR’s cheyenne computer in particular. -Preparing the CTSM -================== - -.. todo:: - - I think we don't need some of the following since too much instructions - are usually more confusing... - I tried removing incorrect or redundant information. - - For example, people who do not use cheyenne might get confused by the - following commands on scratch. +Clone CTSM Repository +------------------------- Decide where you will work, for example:: - cd /glade/scratch/$USER - mkdir git_wrf_ctsm - cd git_wrf_ctsm - -.. note:: - - Discs other than /glade/scratch may provide insufficient space for - output from simulations longer than one or two months. + mkdir git_wrf_ctsm + cd git_wrf_ctsm -Obtain CTSM by running:: +Clone CTSM repository and checkout lilac_cap branch:: - git clone https://github.com/ESCOMP/ctsm.git - cd ctsm - git checkout lilac_cap - ./manage_externals/checkout_externals -v + git clone https://github.com/ESCOMP/ctsm.git + cd ctsm + git checkout lilac_cap + ./manage_externals/checkout_externals -Build CTSM and its dependencies, for example for cheyenne:: +Build CTSM and its dependencies based on instructions from previous sections, +for example for cheyenne:: - ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne + ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne -Set environment similar to environments used for your CTSM build for bash:: +Set environment similar to environments used for your CTSM build using +ctsm_build_environment.sh for bash:: - source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh + source /ctsm_build_dir/ctsm_build_environment.sh -or Cshell:: +or ctsm_build_environment.csh for Cshell: - source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.csh +.. code-block:: Tcsh + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.csh .. note:: @@ -68,35 +56,41 @@ or Cshell:: _obtaining-and-building-ctsm. <-- CREATED LINK TO THE CORRECT SECTION? Building the WRF model with CTSM -================================ +-------------------------------- + .. todo:: - update the git address to WRF feature branch... + update the git address to WRF feature branch... Clone WRF CTSM branch into your directory:: - git clone git@github.com:billsacks/WRF.git - cd WRF - git checkout lilac_dev + git clone git@github.com:billsacks/WRF.git + cd WRF + git checkout lilac_dev -For building WRF using CTSM, we should set makefile variables from CTSM needed for +For building WRF using CTSM, we should set makefile variables from CTSM needed for WRF build by (BASH):: - export WRF_CTSM_MKFILE=/glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk + export WRF_CTSM_MKFILE=/glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk + +or (Cshell): -or:: +.. code-block:: Tcsh - setenv WRF_CTSM_MKFILE /glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk + setenv WRF_CTSM_MKFILE /glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk .. todo:: + Bill and Sam do we need the following still:? The following is needed in order to undo an undesired setting in that env_mach_specific file:: export MPI_USE_ARRAY=None -or:: +or (Cshell): + +.. code-block:: Tcsh setenv MPI_USE_ARRAY None @@ -107,7 +101,9 @@ Explicitly define which model core to build by:: export WRF_EM_CORE=1 -or:: +or (Cshell): + +.. code-block:: Tcsh setenv WRF_EM_CORE 1 @@ -115,7 +111,9 @@ Explicilty turn off data assimilation by:: export WRF_DA_CORE=0 -or:: +or (Cshell): + +.. code-block:: Tcsh setenv WRF_DA_CORE 0 @@ -157,16 +155,18 @@ Then compile em_real and save the log:: Compile WRF Preprocessing System (WPS) -================================================== +-------------------------------------- The WRF Preprocessing System (WPS) is a set of programs to prepare input to the real program for WRF real-data simulations. .. note:: + Building WPS requires that WRF be already built successfully. -Get WPS zipped tar file from: +Get WPS zipped tar file from: + http://www2.mmm.ucar.edu/wrf/users/download/get_source.html Untar WPS tar file:: @@ -174,7 +174,7 @@ Untar WPS tar file:: gzip -cd WPSV4.0.TAR.gz | tar -xf - -Then we should compile WPS similar to the way we build WRF. In summary:: +Then compile WPS similar to the way WRF was built. In summary:: cd WPS ./configure @@ -184,41 +184,45 @@ After configuring, you can check configure.wps for making sure all the libs and are set correctly. Then, compile WPS:: + ./compile >& compile.log .. note:: + If wps build is succsfully you should see geogrid.exe, ungrib.exe, and metgrid.exe. Alternatively, you can check the log for successful build message. Run WRF Preprocessing System (WPS) Steps -================================================== +----------------------------------------- Edit namelist.wps for your domain of interest, which should be the same domain as used in your WRF namelist. -Define the domain and interpolate static geographical data to the grids:: +First, use geogrid.exe to define the domain and interpolate static geographical data +to the grids:: + + ./geogrid.exe >& log.geogrid - ./geogrid.exe >& log.geogrid -Link in the input GFS data files:: +Check the geogrid log file for successful ****** +Link the GRIB data files that are going to be used:: - ./link_grib.csh $path_where_you_placed_GFS_files + ./link_grib.csh $your_GRIB_data_path Extract meteorological fields from GRIB-formatted files:: - ./ungrib.exe + ./ungrib.exe -Horizontally interpolate the metrological fields extracted by ungrib to +Horizontally interpolate the meteorological fields extracted by ungrib to the model grids defined in geogrid:: - ./metgrid.exe >& log.metgrid + ./metgrid.exe >& log.metgrid -You should now have met_em.d01* files. -Run Real program -================================================== +Run real program +---------------- Run real.exe to generate initial and boundary conditions. Follow WRF instructions for creating initial and boundary @@ -227,7 +231,9 @@ conditions. In summary, complete the following steps: Move or link WPS output files (met_em.d01* files) to your WRF/run directory. Edit namelist.input for your WRF domain and desirable configurations. -This should be the same domain as in the namelist used in WPS. +This should be the same domain as in the namelist used in WPS. + + To run WRF-CTSM, change land-surface option to 51:: sf_surface_physics = 51 @@ -237,6 +243,10 @@ To run WRF-CTSM, change land-surface option to 51:: sf_surface_physics values for running WRF-Noah and WRF-NoahMP are 2 and 4, respectively. +.. todo:: + + add the link and adding some note that nested run is not possible.... + Run real.exe (if compiled parallel submit a batch job) to generate wrfinput and wrfbdy files. @@ -315,12 +325,13 @@ Copy lilac_in, lnd_in, and lnd_modelio.nml to the WRF/run directory. Run WRF -======= +------- If real program is completed successfully, we should see wrfinput and wrfbdy files in our directory. -Next, we should run WRF via batch job. +Next, we should run WRF. + For Cheyenne, we should submit a batch job to PBS (Pro workload management system). For more instructions on running a batch job on Cheyenne, please check: https://www2.cisl.ucar.edu/resources/computational-systems/cheyenne/running-jobs/submitting-jobs-pbs From 91433578398cb2b05dd3679bf96c947f00cf5a55 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Jun 2020 14:06:12 -0600 Subject: [PATCH 388/556] Adding details on completion of WPS --- doc/source/lilac/specific-atm-models/wrf.rst | 25 ++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 0354992863..52329c6e00 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -204,6 +204,13 @@ to the grids:: ./geogrid.exe >& log.geogrid +If the geogrid step is finished successfully, you should see the following message in +the log file:: + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Successful completion of geogrid. ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + Check the geogrid log file for successful ****** Link the GRIB data files that are going to be used:: @@ -212,7 +219,18 @@ Link the GRIB data files that are going to be used:: Extract meteorological fields from GRIB-formatted files:: - ./ungrib.exe + ./ungrib.exe >& log.ungrib + +Check ungrib log for the following message showing successful completion of ungrib step:: + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Successful completion of ungrib. ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + + + Horizontally interpolate the meteorological fields extracted by ungrib to the model grids defined in geogrid:: @@ -221,6 +239,7 @@ the model grids defined in geogrid:: + Run real program ---------------- Run real.exe to generate initial and boundary conditions. @@ -337,7 +356,9 @@ For more instructions on running a batch job on Cheyenne, please check: https://www2.cisl.ucar.edu/resources/computational-systems/cheyenne/running-jobs/submitting-jobs-pbs -A sample of basic PBS job for Cheyenne:: +A sample of basic PBS job for Cheyenne: + +.. code-block:: Tcsh #!/bin/tcsh #PBS -N job_name From 2fa8a63df9b237c3c3c9683e5c881525e609262f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 19 Jun 2020 14:55:48 -0600 Subject: [PATCH 389/556] Rename buildnml to make_runtime_inputs This is per Mariana's suggestion. Also move it to sit with the other lilac stuff, rather than having a lilac_config directory that only contains this one file. --- lilac_config/buildnml => lilac/make_runtime_inputs | 0 python/ctsm/build_ctsm.py | 10 +++++----- 2 files changed, 5 insertions(+), 5 deletions(-) rename lilac_config/buildnml => lilac/make_runtime_inputs (100%) diff --git a/lilac_config/buildnml b/lilac/make_runtime_inputs similarity index 100% rename from lilac_config/buildnml rename to lilac/make_runtime_inputs diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/build_ctsm.py index e19a19a850..3727ef29d3 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/build_ctsm.py @@ -28,9 +28,9 @@ 'lilac', 'bld_templates') -_PATH_TO_BUILDNML = os.path.join(path_to_ctsm_root(), - 'lilac_config', - 'buildnml') +_PATH_TO_MAKE_RUNTIME_INPUTS = os.path.join(path_to_ctsm_root(), + 'lilac', + 'make_runtime_inputs') _MACHINE_CONFIG_DIRNAME = 'machine_configuration' _INPUTDATA_DIRNAME = 'inputdata' @@ -611,8 +611,8 @@ def _stage_runtime_inputs(build_dir): path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'lilac_in'), substitutions={'INPUTDATA':os.path.join(build_dir, _INPUTDATA_DIRNAME)}) - make_link(_PATH_TO_BUILDNML, - os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'buildnml')) + make_link(_PATH_TO_MAKE_RUNTIME_INPUTS, + os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'make_runtime_inputs')) def _build_case(build_dir): """Build the CTSM library and its dependencies From 5f727c46f8011a7c59357cc3fa4dfc091e201f00 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 19 Jun 2020 15:07:42 -0600 Subject: [PATCH 390/556] Rename build_ctsm.py to lilac_build_ctsm.py --- lilac/build_ctsm | 2 +- python/ctsm/{build_ctsm.py => lilac_build_ctsm.py} | 2 +- ...{test_sys_build_ctsm.py => test_sys_lilac_build_ctsm.py} | 6 +++--- ...est_unit_build_ctsm.py => test_unit_lilac_build_ctsm.py} | 6 +++--- 4 files changed, 8 insertions(+), 8 deletions(-) rename python/ctsm/{build_ctsm.py => lilac_build_ctsm.py} (99%) rename python/ctsm/test/{test_sys_build_ctsm.py => test_sys_lilac_build_ctsm.py} (95%) rename python/ctsm/test/{test_unit_build_ctsm.py => test_unit_lilac_build_ctsm.py} (98%) diff --git a/lilac/build_ctsm b/lilac/build_ctsm index cc3fd19f7e..62c330118d 100755 --- a/lilac/build_ctsm +++ b/lilac/build_ctsm @@ -13,7 +13,7 @@ from ctsm.path_utils import add_cime_lib_to_path cime_path = add_cime_lib_to_path() -from ctsm.build_ctsm import main +from ctsm.lilac_build_ctsm import main if __name__ == "__main__": main(cime_path=cime_path) diff --git a/python/ctsm/build_ctsm.py b/python/ctsm/lilac_build_ctsm.py similarity index 99% rename from python/ctsm/build_ctsm.py rename to python/ctsm/lilac_build_ctsm.py index 3727ef29d3..3079f8cfdf 100644 --- a/python/ctsm/build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -1,4 +1,4 @@ -"""Functions implementing build_ctsm command""" +"""Functions implementing LILAC's build_ctsm command""" import argparse import logging diff --git a/python/ctsm/test/test_sys_build_ctsm.py b/python/ctsm/test/test_sys_lilac_build_ctsm.py similarity index 95% rename from python/ctsm/test/test_sys_build_ctsm.py rename to python/ctsm/test/test_sys_lilac_build_ctsm.py index f0bc42f0ef..3730b8fed7 100755 --- a/python/ctsm/test/test_sys_build_ctsm.py +++ b/python/ctsm/test/test_sys_lilac_build_ctsm.py @@ -1,6 +1,6 @@ #!/usr/bin/env python -"""System tests for build_ctsm +"""System tests for lilac_build_ctsm These tests do a lot of work (interacting with cime, etc.), and thus take relatively long to run. @@ -13,7 +13,7 @@ from ctsm.path_utils import add_cime_lib_to_path from ctsm import unit_testing -from ctsm.build_ctsm import build_ctsm +from ctsm.lilac_build_ctsm import build_ctsm _CIME_PATH = add_cime_lib_to_path(standalone_only=True) @@ -22,7 +22,7 @@ # pylint: disable=invalid-name class TestSysBuildCtsm(unittest.TestCase): - """System tests for build_ctsm""" + """System tests for lilac_build_ctsm""" def setUp(self): self._tempdir = tempfile.mkdtemp() diff --git a/python/ctsm/test/test_unit_build_ctsm.py b/python/ctsm/test/test_unit_lilac_build_ctsm.py similarity index 98% rename from python/ctsm/test/test_unit_build_ctsm.py rename to python/ctsm/test/test_unit_lilac_build_ctsm.py index 24f00ab358..c97c9a4c41 100755 --- a/python/ctsm/test/test_unit_build_ctsm.py +++ b/python/ctsm/test/test_unit_lilac_build_ctsm.py @@ -1,6 +1,6 @@ #!/usr/bin/env python -"""Unit tests for build_ctsm +"""Unit tests for lilac_build_ctsm """ import unittest @@ -8,14 +8,14 @@ from io import StringIO from ctsm import unit_testing -from ctsm.build_ctsm import _commandline_args, _check_and_transform_os +from ctsm.lilac_build_ctsm import _commandline_args, _check_and_transform_os # Allow names that pylint doesn't like, because otherwise I find it hard # to make readable unit test names # pylint: disable=invalid-name class TestBuildCtsm(unittest.TestCase): - """Tests of build_ctsm""" + """Tests of lilac_build_ctsm""" def test_commandlineArgs_rebuild_valid(self): """Test _commandline_args with --rebuild, with a valid argument list (no disallowed args)""" From 2118a7fc7155f2f7b1277c60d69ae4adcf88c523 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Jun 2020 23:14:03 -0600 Subject: [PATCH 391/556] adding more details on *.exe logs. --- doc/source/lilac/specific-atm-models/wrf.rst | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 52329c6e00..5e39437cd9 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -207,10 +207,9 @@ to the grids:: If the geogrid step is finished successfully, you should see the following message in the log file:: - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Successful completion of geogrid. ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Successful completion of geogrid. ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Check the geogrid log file for successful ****** Link the GRIB data files that are going to be used:: @@ -239,6 +238,14 @@ the model grids defined in geogrid:: +Check the metgrid log for the following message showing successful completion of +metgrid step:: + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Successful completion of metgrid. ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + Run real program ---------------- @@ -270,6 +277,10 @@ Run real.exe (if compiled parallel submit a batch job) to generate wrfinput and wrfbdy files. +Check the last line of the real log file for the following message:: + + SUCCESS COMPLETE REAL_EM INIT + Create input namelists for CTSM and LILAC ========================================= From 2fab1860b79fde95285ea425aa23b608332a5b9d Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 22 Jun 2020 17:28:49 -0600 Subject: [PATCH 392/556] Move implementation of make_runtime_inputs into python directory This will facilitate unit testing, pylint, and using some of my general-purpose functions. --- lilac/make_runtime_inputs | 278 +---------------------- python/ctsm/lilac_make_runtime_inputs.py | 270 ++++++++++++++++++++++ 2 files changed, 278 insertions(+), 270 deletions(-) create mode 100644 python/ctsm/lilac_make_runtime_inputs.py diff --git a/lilac/make_runtime_inputs b/lilac/make_runtime_inputs index 7d48d82bc6..76082a5fec 100755 --- a/lilac/make_runtime_inputs +++ b/lilac/make_runtime_inputs @@ -1,277 +1,15 @@ -#!/usr/bin/env python3 +#!/usr/bin/env python +"""CTSM namelist creator""" -""" -CTSM namelist creator -""" - -import sys import os -import subprocess -import argparse - -from configparser import ConfigParser -from configparser import NoSectionError, NoOptionError - -_CONFIG_CACHE_TEMPLATE = """ - - - -Specifies clm physics - -""" - -# Note the following is needed in env_lilac.xml otherwise the following error appears in -# the call to build_namelist - -#err=ERROR : CLM build-namelist::CLMBuildNamelist::logical_to_fortran() : -# Unexpected value in logical_to_fortran: - -_ENV_LILAC_TEMPLATE = """ - - - - - logical - TRUE,FALSE - - - -""" - -# This string is used in the out-of-the-box ctsm.cfg file to denote a value that needs to -# be filled in -_PLACEHOLDER = 'FILL_THIS_IN' - -# This string is used in the out-of-the-box ctsm.cfg file to denote a value that can be -# filled in, but doesn't absolutely need to be -_UNSET = 'UNSET' - -############################################################################### -def parse_command_line(args, description): -############################################################################### - - """Parse the command line, return object holding arguments""" - - parser = argparse.ArgumentParser(formatter_class=argparse.RawTextHelpFormatter, - description=description) - - parser.add_argument("--rundir", type=str, default=os.getcwd(), - help="Full path of the run directory") - - parser.add_argument("--existing-res", - help="Use the given out-of-the-box resolution (e.g., '4x5').\n" - "This argument should NOT be provided for a user-defined resolution.\n" - "If this argument is provided, then --existing-mask must also be provided.") - - parser.add_argument("--existing-mask", - help="Use the given out-of-the-box mask (e.g., 'gx3v7').\n" - "This argument should NOT be provided for a user-defined resolution.\n" - "If this argument is provided, then --existing-res must also be provided.") - - arguments = parser.parse_args(args) - - # Perform some error checking on arguments, and set derived values - - if not os.path.isdir(arguments.rundir): - sys.exit("rundir {} does not exist".format(arguments.rundir)) - - if arguments.existing_res and arguments.existing_mask: - arguments.use_existing_res_and_mask = True - elif arguments.existing_res and not arguments.existing_mask: - sys.exit("If --existing-res is given, then --existing-mask must also be given") - elif arguments.existing_mask and not arguments.existing_res: - sys.exit("If --existing-mask is given, then --existing-res must also be given") - else: - arguments.use_existing_res_and_mask = False - - return arguments - -############################################################################### -def get_config_value(config, section, item, file_path, allowed_values=None): - """Get a given item from a given section of the config object - - Give a helpful error message if we can't find the given section or item - - Note that the file_path argument is only used for the sake of the error message - - If allowed_values is present, it should be a list of strings giving allowed values - """ - try: - val = config.get(section, item) - except NoSectionError: - sys.exit("ERROR: Config file {} must contain section '{}'".format(file_path, section)) - except NoOptionError: - sys.exit("ERROR: Config file {} must contain item '{}' in section '{}'".format( - file_path, item, section)) - - if val == _PLACEHOLDER: - sys.exit("Error: {} needs to be specified in config file {}".format(item, file_path)) - - if allowed_values is not None: - if val not in allowed_values: - sys.exit("Error: {} is not an allowed value for {} in config file {}\n" - "Allowed values: {}".format(val, item, file_path, allowed_values)) - - return val - -############################################################################### -def determine_bldnml_opts(bgc_mode, crop, vichydro): -############################################################################### - """Return a string giving bldnml options, given some other inputs""" - bldnml_opts = '' - bldnml_opts += ' -bgc {}'.format(bgc_mode) - if bgc_mode == 'fates': - # BUG(wjs, 2020-06-12, ESCOMP/CTSM#115) For now, FATES is incompatible with MEGAN - bldnml_opts += ' -no-megan' - - if crop == 'on': - if bgc_mode not in ['bgc', 'cn']: - sys.exit("Error: setting crop to 'on' is only compatible with bgc_mode of 'bgc' or 'cn'") - bldnml_opts += ' -crop' - - if vichydro == 'on': - if bgc_mode != 'sp': - sys.exit("Error: setting vichydro to 'on' is only compatible with bgc_mode of 'sp'") - bldnml_opts += ' -vichydro' - - return bldnml_opts - -############################################################################### -def buildnml(rundir, bldnmldir, use_existing_res_and_mask, existing_res=None, existing_mask=None): -############################################################################### - - """Build the ctsm namelist - - If use_existing_res_and_mask is True, then existing_res and existing_mask should be - specified; otherwise, they are ignored. - """ - - # pylint: disable=too-many-locals - - file_path = os.path.join(rundir, 'ctsm.cfg') - - # read the config file - config = ConfigParser() - config.read(file_path) - - lnd_domain_file = get_config_value(config, 'buildnml_input', 'lnd_domain_file', file_path) - if use_existing_res_and_mask: - fsurdat = _UNSET - else: - # If we're not using an out-of-the-box grid, then require the user to explicitly - # specify the surface dataset. - fsurdat = get_config_value(config, 'buildnml_input', 'fsurdat', file_path) - finidat = get_config_value(config, 'buildnml_input', 'finidat', file_path) - - ctsm_phys = get_config_value(config, 'buildnml_input', 'ctsm_phys', file_path, - allowed_values=['clm4_5', 'clm5_0']) - configuration = get_config_value(config, 'buildnml_input', 'configuration', file_path, - allowed_values=['nwp', 'clm']) - structure = get_config_value(config, 'buildnml_input', 'structure', file_path, - allowed_values=['fast', 'standard']) - bgc_mode = get_config_value(config, 'buildnml_input', 'bgc_mode', file_path, - allowed_values=['sp', 'bgc', 'cn', 'fates']) - crop = get_config_value(config, 'buildnml_input', 'crop', file_path, - allowed_values=['off', 'on']) - vichydro = get_config_value(config, 'buildnml_input', 'vichydro', file_path, - allowed_values=['off', 'on']) - - bldnml_opts = determine_bldnml_opts(bgc_mode=bgc_mode, - crop=crop, - vichydro=vichydro) - - co2_ppmv = get_config_value(config, 'buildnml_input', 'co2_ppmv', file_path) - use_case = get_config_value(config, 'buildnml_input', 'use_case', file_path) - lnd_tuning_mode = get_config_value(config, 'buildnml_input', 'lnd_tuning_mode', file_path) - spinup = get_config_value(config, 'buildnml_input', 'spinup', file_path, - allowed_values=['off', 'on']) - - inputdata_path = get_config_value(config, 'buildnml_input', 'inputdata_path', file_path) - - # create config_cache.xml file - # Note that build-namelist utilizes the contents of the config_cache.xml file in - # the namelist_defaults.xml file to obtain namelist variables - config_cache = os.path.join(rundir, "config_cache.xml") - config_cache_text = _CONFIG_CACHE_TEMPLATE.format(clm_phys=ctsm_phys) - with open(config_cache, 'w') as tempfile: - tempfile.write(config_cache_text) - - # create temporary env_lilac.xml - env_lilac = os.path.join(rundir, "env_lilac.xml") - env_lilac_text = _ENV_LILAC_TEMPLATE.format() - with open(env_lilac, 'w') as tempfile: - tempfile.write(env_lilac_text) - - # remove any existing clm.input_data_list file - inputdatalist_path = os.path.join(rundir, "clm.input_data_list") - if os.path.exists(inputdatalist_path): - os.remove(inputdatalist_path) - - # determine if fsurdat and/or finidat should appear in the -namelist option - extra_namelist_opts = '' - if fsurdat != _UNSET: - extra_namelist_opts = extra_namelist_opts + " fsurdat = '{}' ".format(fsurdat) - if finidat != _UNSET: - extra_namelist_opts = extra_namelist_opts + " finidat = '{}' ".format(finidat) - - # call build-namelist - cmd = os.path.abspath(os.path.join(bldnmldir, os.pardir, "bld", "build-namelist")) - command = [cmd, - '-csmdata', inputdata_path, - '-inputdata', inputdatalist_path, - # Hard-code start_ymd of year-2000. This is used to set the run type (for - # which a setting of 2000 gives 'startup', which is what we want) and pick - # the initial conditions file (which is pretty much irrelevant when running - # with lilac). - '-namelist', '&clm_inparm start_ymd=20000101 {} /'.format(extra_namelist_opts), - '-use_case', use_case, - '-ignore_ic_year', # For now, we assume ignore_ic_year, not ignore_ic_date - '-clm_start_type', 'default', # seems unimportant (see discussion in https://github.com/ESCOMP/CTSM/issues/876) - '-configuration', configuration, - '-structure', structure, - '-lnd_frac', lnd_domain_file, - '-glc_nec', str(10), - '-co2_ppmv', co2_ppmv, - '-co2_type', 'constant', - '-clm_accelerated_spinup', spinup, - '-lnd_tuning_mode', lnd_tuning_mode, - '-no-megan', # Eventually make this dynamic (see https://github.com/ESCOMP/CTSM/issues/926) - '-config', os.path.join(rundir, "config_cache.xml"), - '-envxml_dir', rundir] - if use_existing_res_and_mask: - command.extend(['-res', existing_res, - '-mask', existing_mask]) - else: - # NOTE(wjs, 2020-06-16) Note that we do NOT use the -mask argument in this case; - # it's possible that we should be using it in some circumstances (I haven't looked - # into how it's used). - command.extend(['-res', 'lilac', - '-clm_usr_name', 'lilac']) - command.extend(bldnml_opts.split()) - - subprocess.check_call(command, - universal_newlines=True) - - # remove temporary files in rundir - os.remove(os.path.join(rundir, "config_cache.xml")) - os.remove(os.path.join(rundir, "env_lilac.xml")) - os.remove(os.path.join(rundir, "drv_flds_in")) - -############################################################################### -def main(): - """Main function""" - - args = parse_command_line(sys.argv[1:], __doc__) - bldnmldir = os.path.dirname(os.path.realpath(__file__)) - buildnml( - rundir=args.rundir, - bldnmldir=bldnmldir, - use_existing_res_and_mask=args.use_existing_res_and_mask, - existing_res=args.existing_res, - existing_mask=args.existing_mask) +import sys +_CTSM_PYTHON = os.path.join(os.path.dirname(os.path.realpath(__file__)), + os.pardir, + 'python') +sys.path.insert(1, _CTSM_PYTHON) -############################################################################### +from ctsm.lilac_make_runtime_inputs import main if __name__ == "__main__": main() diff --git a/python/ctsm/lilac_make_runtime_inputs.py b/python/ctsm/lilac_make_runtime_inputs.py new file mode 100644 index 0000000000..9313cdb45a --- /dev/null +++ b/python/ctsm/lilac_make_runtime_inputs.py @@ -0,0 +1,270 @@ +"""Functions implementing LILAC's make_runtime_inputs command""" + +import sys +import os +import subprocess +import argparse + +from configparser import ConfigParser +from configparser import NoSectionError, NoOptionError + +from ctsm.path_utils import path_to_ctsm_root + +_CONFIG_CACHE_TEMPLATE = """ + + + +Specifies clm physics + +""" + +# Note the following is needed in env_lilac.xml otherwise the following error appears in +# the call to build_namelist + +#err=ERROR : CLM build-namelist::CLMBuildNamelist::logical_to_fortran() : +# Unexpected value in logical_to_fortran: + +_ENV_LILAC_TEMPLATE = """ + + + + + logical + TRUE,FALSE + + + +""" + +# This string is used in the out-of-the-box ctsm.cfg file to denote a value that needs to +# be filled in +_PLACEHOLDER = 'FILL_THIS_IN' + +# This string is used in the out-of-the-box ctsm.cfg file to denote a value that can be +# filled in, but doesn't absolutely need to be +_UNSET = 'UNSET' + +############################################################################### +def parse_command_line(args, description): +############################################################################### + + """Parse the command line, return object holding arguments""" + + parser = argparse.ArgumentParser(formatter_class=argparse.RawTextHelpFormatter, + description=description) + + parser.add_argument("--rundir", type=str, default=os.getcwd(), + help="Full path of the run directory") + + parser.add_argument("--existing-res", + help="Use the given out-of-the-box resolution (e.g., '4x5').\n" + "This argument should NOT be provided for a user-defined resolution.\n" + "If this argument is provided, then --existing-mask must also be provided.") + + parser.add_argument("--existing-mask", + help="Use the given out-of-the-box mask (e.g., 'gx3v7').\n" + "This argument should NOT be provided for a user-defined resolution.\n" + "If this argument is provided, then --existing-res must also be provided.") + + arguments = parser.parse_args(args) + + # Perform some error checking on arguments, and set derived values + + if not os.path.isdir(arguments.rundir): + sys.exit("rundir {} does not exist".format(arguments.rundir)) + + if arguments.existing_res and arguments.existing_mask: + arguments.use_existing_res_and_mask = True + elif arguments.existing_res and not arguments.existing_mask: + sys.exit("If --existing-res is given, then --existing-mask must also be given") + elif arguments.existing_mask and not arguments.existing_res: + sys.exit("If --existing-mask is given, then --existing-res must also be given") + else: + arguments.use_existing_res_and_mask = False + + return arguments + +############################################################################### +def get_config_value(config, section, item, file_path, allowed_values=None): + """Get a given item from a given section of the config object + + Give a helpful error message if we can't find the given section or item + + Note that the file_path argument is only used for the sake of the error message + + If allowed_values is present, it should be a list of strings giving allowed values + """ + try: + val = config.get(section, item) + except NoSectionError: + sys.exit("ERROR: Config file {} must contain section '{}'".format(file_path, section)) + except NoOptionError: + sys.exit("ERROR: Config file {} must contain item '{}' in section '{}'".format( + file_path, item, section)) + + if val == _PLACEHOLDER: + sys.exit("Error: {} needs to be specified in config file {}".format(item, file_path)) + + if allowed_values is not None: + if val not in allowed_values: + sys.exit("Error: {} is not an allowed value for {} in config file {}\n" + "Allowed values: {}".format(val, item, file_path, allowed_values)) + + return val + +############################################################################### +def determine_bldnml_opts(bgc_mode, crop, vichydro): +############################################################################### + """Return a string giving bldnml options, given some other inputs""" + bldnml_opts = '' + bldnml_opts += ' -bgc {}'.format(bgc_mode) + if bgc_mode == 'fates': + # BUG(wjs, 2020-06-12, ESCOMP/CTSM#115) For now, FATES is incompatible with MEGAN + bldnml_opts += ' -no-megan' + + if crop == 'on': + if bgc_mode not in ['bgc', 'cn']: + sys.exit("Error: setting crop to 'on' is only compatible with bgc_mode of 'bgc' or 'cn'") + bldnml_opts += ' -crop' + + if vichydro == 'on': + if bgc_mode != 'sp': + sys.exit("Error: setting vichydro to 'on' is only compatible with bgc_mode of 'sp'") + bldnml_opts += ' -vichydro' + + return bldnml_opts + +############################################################################### +def buildnml(rundir, use_existing_res_and_mask, existing_res=None, existing_mask=None): +############################################################################### + + """Build the ctsm namelist + + If use_existing_res_and_mask is True, then existing_res and existing_mask should be + specified; otherwise, they are ignored. + """ + + # pylint: disable=too-many-locals + + file_path = os.path.join(rundir, 'ctsm.cfg') + + # read the config file + config = ConfigParser() + config.read(file_path) + + lnd_domain_file = get_config_value(config, 'buildnml_input', 'lnd_domain_file', file_path) + if use_existing_res_and_mask: + fsurdat = _UNSET + else: + # If we're not using an out-of-the-box grid, then require the user to explicitly + # specify the surface dataset. + fsurdat = get_config_value(config, 'buildnml_input', 'fsurdat', file_path) + finidat = get_config_value(config, 'buildnml_input', 'finidat', file_path) + + ctsm_phys = get_config_value(config, 'buildnml_input', 'ctsm_phys', file_path, + allowed_values=['clm4_5', 'clm5_0']) + configuration = get_config_value(config, 'buildnml_input', 'configuration', file_path, + allowed_values=['nwp', 'clm']) + structure = get_config_value(config, 'buildnml_input', 'structure', file_path, + allowed_values=['fast', 'standard']) + bgc_mode = get_config_value(config, 'buildnml_input', 'bgc_mode', file_path, + allowed_values=['sp', 'bgc', 'cn', 'fates']) + crop = get_config_value(config, 'buildnml_input', 'crop', file_path, + allowed_values=['off', 'on']) + vichydro = get_config_value(config, 'buildnml_input', 'vichydro', file_path, + allowed_values=['off', 'on']) + + bldnml_opts = determine_bldnml_opts(bgc_mode=bgc_mode, + crop=crop, + vichydro=vichydro) + + co2_ppmv = get_config_value(config, 'buildnml_input', 'co2_ppmv', file_path) + use_case = get_config_value(config, 'buildnml_input', 'use_case', file_path) + lnd_tuning_mode = get_config_value(config, 'buildnml_input', 'lnd_tuning_mode', file_path) + spinup = get_config_value(config, 'buildnml_input', 'spinup', file_path, + allowed_values=['off', 'on']) + + inputdata_path = get_config_value(config, 'buildnml_input', 'inputdata_path', file_path) + + # create config_cache.xml file + # Note that build-namelist utilizes the contents of the config_cache.xml file in + # the namelist_defaults.xml file to obtain namelist variables + config_cache = os.path.join(rundir, "config_cache.xml") + config_cache_text = _CONFIG_CACHE_TEMPLATE.format(clm_phys=ctsm_phys) + with open(config_cache, 'w') as tempfile: + tempfile.write(config_cache_text) + + # create temporary env_lilac.xml + env_lilac = os.path.join(rundir, "env_lilac.xml") + env_lilac_text = _ENV_LILAC_TEMPLATE.format() + with open(env_lilac, 'w') as tempfile: + tempfile.write(env_lilac_text) + + # remove any existing clm.input_data_list file + inputdatalist_path = os.path.join(rundir, "clm.input_data_list") + if os.path.exists(inputdatalist_path): + os.remove(inputdatalist_path) + + # determine if fsurdat and/or finidat should appear in the -namelist option + extra_namelist_opts = '' + if fsurdat != _UNSET: + extra_namelist_opts = extra_namelist_opts + " fsurdat = '{}' ".format(fsurdat) + if finidat != _UNSET: + extra_namelist_opts = extra_namelist_opts + " finidat = '{}' ".format(finidat) + + # call build-namelist + cmd = os.path.abspath(os.path.join(path_to_ctsm_root(), "bld", "build-namelist")) + command = [cmd, + '-csmdata', inputdata_path, + '-inputdata', inputdatalist_path, + # Hard-code start_ymd of year-2000. This is used to set the run type (for + # which a setting of 2000 gives 'startup', which is what we want) and pick + # the initial conditions file (which is pretty much irrelevant when running + # with lilac). + '-namelist', '&clm_inparm start_ymd=20000101 {} /'.format(extra_namelist_opts), + '-use_case', use_case, + '-ignore_ic_year', # For now, we assume ignore_ic_year, not ignore_ic_date + '-clm_start_type', 'default', # seems unimportant (see discussion in https://github.com/ESCOMP/CTSM/issues/876) + '-configuration', configuration, + '-structure', structure, + '-lnd_frac', lnd_domain_file, + '-glc_nec', str(10), + '-co2_ppmv', co2_ppmv, + '-co2_type', 'constant', + '-clm_accelerated_spinup', spinup, + '-lnd_tuning_mode', lnd_tuning_mode, + '-no-megan', # Eventually make this dynamic (see https://github.com/ESCOMP/CTSM/issues/926) + '-config', os.path.join(rundir, "config_cache.xml"), + '-envxml_dir', rundir] + if use_existing_res_and_mask: + command.extend(['-res', existing_res, + '-mask', existing_mask]) + else: + # NOTE(wjs, 2020-06-16) Note that we do NOT use the -mask argument in this case; + # it's possible that we should be using it in some circumstances (I haven't looked + # into how it's used). + command.extend(['-res', 'lilac', + '-clm_usr_name', 'lilac']) + command.extend(bldnml_opts.split()) + + subprocess.check_call(command, + universal_newlines=True) + + # remove temporary files in rundir + os.remove(os.path.join(rundir, "config_cache.xml")) + os.remove(os.path.join(rundir, "env_lilac.xml")) + os.remove(os.path.join(rundir, "drv_flds_in")) + +############################################################################### +def main(): + """Main function""" + + args = parse_command_line(sys.argv[1:], __doc__) + buildnml( + rundir=args.rundir, + use_existing_res_and_mask=args.use_existing_res_and_mask, + existing_res=args.existing_res, + existing_mask=args.existing_mask) + + +############################################################################### From 6a124a1174a002f82c95687603147e97cb11bd9c Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 22 Jun 2020 17:46:21 -0600 Subject: [PATCH 393/556] Add some standard things (logging, etc.) in lilac_make_runtime_inputs.py --- python/ctsm/lilac_make_runtime_inputs.py | 55 ++++++++++++++++-------- 1 file changed, 38 insertions(+), 17 deletions(-) diff --git a/python/ctsm/lilac_make_runtime_inputs.py b/python/ctsm/lilac_make_runtime_inputs.py index 9313cdb45a..6a4a1997c8 100644 --- a/python/ctsm/lilac_make_runtime_inputs.py +++ b/python/ctsm/lilac_make_runtime_inputs.py @@ -1,14 +1,22 @@ """Functions implementing LILAC's make_runtime_inputs command""" -import sys import os import subprocess import argparse +import logging from configparser import ConfigParser from configparser import NoSectionError, NoOptionError +from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args from ctsm.path_utils import path_to_ctsm_root +from ctsm.utils import abort + +logger = logging.getLogger(__name__) + +# ======================================================================== +# Define some constants +# ======================================================================== _CONFIG_CACHE_TEMPLATE = """ @@ -45,11 +53,15 @@ _UNSET = 'UNSET' ############################################################################### -def parse_command_line(args, description): +def parse_command_line(): ############################################################################### """Parse the command line, return object holding arguments""" + description = """ +Script to create runtime inputs when running CTSM via LILAC +""" + parser = argparse.ArgumentParser(formatter_class=argparse.RawTextHelpFormatter, description=description) @@ -66,19 +78,21 @@ def parse_command_line(args, description): "This argument should NOT be provided for a user-defined resolution.\n" "If this argument is provided, then --existing-res must also be provided.") - arguments = parser.parse_args(args) + add_logging_args(parser) + + arguments = parser.parse_args() # Perform some error checking on arguments, and set derived values if not os.path.isdir(arguments.rundir): - sys.exit("rundir {} does not exist".format(arguments.rundir)) + abort("rundir {} does not exist".format(arguments.rundir)) if arguments.existing_res and arguments.existing_mask: arguments.use_existing_res_and_mask = True elif arguments.existing_res and not arguments.existing_mask: - sys.exit("If --existing-res is given, then --existing-mask must also be given") + abort("If --existing-res is given, then --existing-mask must also be given") elif arguments.existing_mask and not arguments.existing_res: - sys.exit("If --existing-mask is given, then --existing-res must also be given") + abort("If --existing-mask is given, then --existing-res must also be given") else: arguments.use_existing_res_and_mask = False @@ -97,18 +111,18 @@ def get_config_value(config, section, item, file_path, allowed_values=None): try: val = config.get(section, item) except NoSectionError: - sys.exit("ERROR: Config file {} must contain section '{}'".format(file_path, section)) + abort("ERROR: Config file {} must contain section '{}'".format(file_path, section)) except NoOptionError: - sys.exit("ERROR: Config file {} must contain item '{}' in section '{}'".format( + abort("ERROR: Config file {} must contain item '{}' in section '{}'".format( file_path, item, section)) if val == _PLACEHOLDER: - sys.exit("Error: {} needs to be specified in config file {}".format(item, file_path)) + abort("Error: {} needs to be specified in config file {}".format(item, file_path)) if allowed_values is not None: if val not in allowed_values: - sys.exit("Error: {} is not an allowed value for {} in config file {}\n" - "Allowed values: {}".format(val, item, file_path, allowed_values)) + abort("Error: {} is not an allowed value for {} in config file {}\n" + "Allowed values: {}".format(val, item, file_path, allowed_values)) return val @@ -124,12 +138,12 @@ def determine_bldnml_opts(bgc_mode, crop, vichydro): if crop == 'on': if bgc_mode not in ['bgc', 'cn']: - sys.exit("Error: setting crop to 'on' is only compatible with bgc_mode of 'bgc' or 'cn'") + abort("Error: setting crop to 'on' is only compatible with bgc_mode of 'bgc' or 'cn'") bldnml_opts += ' -crop' if vichydro == 'on': if bgc_mode != 'sp': - sys.exit("Error: setting vichydro to 'on' is only compatible with bgc_mode of 'sp'") + abort("Error: setting vichydro to 'on' is only compatible with bgc_mode of 'sp'") bldnml_opts += ' -vichydro' return bldnml_opts @@ -223,8 +237,11 @@ def buildnml(rundir, use_existing_res_and_mask, existing_res=None, existing_mask # with lilac). '-namelist', '&clm_inparm start_ymd=20000101 {} /'.format(extra_namelist_opts), '-use_case', use_case, - '-ignore_ic_year', # For now, we assume ignore_ic_year, not ignore_ic_date - '-clm_start_type', 'default', # seems unimportant (see discussion in https://github.com/ESCOMP/CTSM/issues/876) + # For now, we assume ignore_ic_year, not ignore_ic_date + '-ignore_ic_year', + # -clm_start_type seems unimportant (see discussion in + # https://github.com/ESCOMP/CTSM/issues/876) + '-clm_start_type', 'default', '-configuration', configuration, '-structure', structure, '-lnd_frac', lnd_domain_file, @@ -233,7 +250,9 @@ def buildnml(rundir, use_existing_res_and_mask, existing_res=None, existing_mask '-co2_type', 'constant', '-clm_accelerated_spinup', spinup, '-lnd_tuning_mode', lnd_tuning_mode, - '-no-megan', # Eventually make this dynamic (see https://github.com/ESCOMP/CTSM/issues/926) + # Eventually make -no-megan dynamic (see + # https://github.com/ESCOMP/CTSM/issues/926) + '-no-megan', '-config', os.path.join(rundir, "config_cache.xml"), '-envxml_dir', rundir] if use_existing_res_and_mask: @@ -258,8 +277,10 @@ def buildnml(rundir, use_existing_res_and_mask, existing_res=None, existing_mask ############################################################################### def main(): """Main function""" + setup_logging_pre_config() + args = parse_command_line() + process_logging_args(args) - args = parse_command_line(sys.argv[1:], __doc__) buildnml( rundir=args.rundir, use_existing_res_and_mask=args.use_existing_res_and_mask, From cde5c258a2013b9746bafa7430b85e8a6bbe08c1 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 22 Jun 2020 18:19:05 -0600 Subject: [PATCH 394/556] Add unit tests of determine_bldnml_opts --- .../test_unit_lilac_make_runtime_inputs.py | 52 +++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100755 python/ctsm/test/test_unit_lilac_make_runtime_inputs.py diff --git a/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py b/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py new file mode 100755 index 0000000000..bf28e6e265 --- /dev/null +++ b/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py @@ -0,0 +1,52 @@ +#!/usr/bin/env python + +"""Unit tests for lilac_make_runtime_inputs +""" + +import unittest + +from ctsm import unit_testing +from ctsm.lilac_make_runtime_inputs import determine_bldnml_opts + +# Allow names that pylint doesn't like, because otherwise I find it hard +# to make readable unit test names +# pylint: disable=invalid-name + +class TestMakeRuntimeInputs(unittest.TestCase): + """Tests of lilac_make_runtime_inputs""" + + def test_buildnmlOpts_bgc(self): + """Test determine_buildnml_opts with bgc_mode='bgc'""" + bldnml_opts = determine_bldnml_opts(bgc_mode='bgc', crop='off', vichydro='off') + self.assertRegex(bldnml_opts, r'^ *-bgc bgc *$') + + def test_buildnmlOpts_fates(self): + """Test determine_buildnml_opts with bgc_mode='fates'""" + bldnml_opts = determine_bldnml_opts(bgc_mode='fates', crop='off', vichydro='off') + self.assertRegex(bldnml_opts, r'^ *-bgc fates +-no-megan *$') + + def test_buildnmlOpts_bgcCrop(self): + """Test determine_buildnml_opts with bgc_mode='bgc' and crop on""" + bldnml_opts = determine_bldnml_opts(bgc_mode='bgc', crop='on', vichydro='off') + self.assertRegex(bldnml_opts, r'^ *-bgc bgc +-crop *$') + + def test_buildnmlOpts_spCrop_fails(self): + """Test determine_buildnml_opts with bgc_mode='sp' and crop on: should fail""" + with self.assertRaisesRegex(SystemExit, "setting crop to 'on' is only compatible with bgc_mode"): + _ = determine_bldnml_opts(bgc_mode='sp', crop='on', vichydro='off') + + def test_buildnmlOpts_spVic(self): + """Test determine_buildnml_opts with bgc_mode='sp' and vic on""" + bldnml_opts = determine_bldnml_opts(bgc_mode='sp', crop='off', vichydro='on') + self.assertRegex(bldnml_opts, r'^ *-bgc sp +-vichydro *$') + + def test_buildnmlOpts_bgcVic(self): + """Test determine_buildnml_opts with bgc_mode='bgc' and vic on: should fail""" + with self.assertRaisesRegex( + SystemExit, + "setting vichydro to 'on' is only compatible with bgc_mode of 'sp'"): + _ = determine_bldnml_opts(bgc_mode='bgc', crop='off', vichydro='on') + +if __name__ == '__main__': + unit_testing.setup_for_tests() + unittest.main() From a4733bbc2c1f2b32362d4c523d3a2773208301ba Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 23 Jun 2020 08:43:57 -0600 Subject: [PATCH 395/556] Support a user_nl_ctsm file in the lilac runtime input workflow --- lilac/make_runtime_inputs | 1 + python/ctsm/lilac_make_runtime_inputs.py | 60 +++++++++++++++++------- 2 files changed, 44 insertions(+), 17 deletions(-) diff --git a/lilac/make_runtime_inputs b/lilac/make_runtime_inputs index 76082a5fec..6d8db14985 100755 --- a/lilac/make_runtime_inputs +++ b/lilac/make_runtime_inputs @@ -8,6 +8,7 @@ _CTSM_PYTHON = os.path.join(os.path.dirname(os.path.realpath(__file__)), os.pardir, 'python') sys.path.insert(1, _CTSM_PYTHON) +from ctsm import add_cime_to_path from ctsm.lilac_make_runtime_inputs import main diff --git a/python/ctsm/lilac_make_runtime_inputs.py b/python/ctsm/lilac_make_runtime_inputs.py index 6a4a1997c8..a2cb94ec68 100644 --- a/python/ctsm/lilac_make_runtime_inputs.py +++ b/python/ctsm/lilac_make_runtime_inputs.py @@ -12,6 +12,8 @@ from ctsm.path_utils import path_to_ctsm_root from ctsm.utils import abort +from CIME.buildnml import create_namelist_infile + logger = logging.getLogger(__name__) # ======================================================================== @@ -52,6 +54,22 @@ # filled in, but doesn't absolutely need to be _UNSET = 'UNSET' +# ======================================================================== +# Fake case object that can be used to satisfy the interface of CIME functions that need a +# case object +# ======================================================================== + +class CaseFake: + def __init__(self): + pass + + def get_resolved_value(self, value): + """Make sure get_resolved_value doesn't get called + + (since we don't have a real case object to resolve values with) + """ + abort("Cannot resolve value with a '$' variable: {}".format(value)) + ############################################################################### def parse_command_line(): ############################################################################### @@ -66,7 +84,7 @@ def parse_command_line(): description=description) parser.add_argument("--rundir", type=str, default=os.getcwd(), - help="Full path of the run directory") + help="Full path of the run directory (containing ctsm.cfg & user_nl_ctsm)") parser.add_argument("--existing-res", help="Use the given out-of-the-box resolution (e.g., '4x5').\n" @@ -160,45 +178,51 @@ def buildnml(rundir, use_existing_res_and_mask, existing_res=None, existing_mask # pylint: disable=too-many-locals - file_path = os.path.join(rundir, 'ctsm.cfg') + ctsm_cfg_path = os.path.join(rundir, 'ctsm.cfg') # read the config file config = ConfigParser() - config.read(file_path) + config.read(ctsm_cfg_path) - lnd_domain_file = get_config_value(config, 'buildnml_input', 'lnd_domain_file', file_path) + lnd_domain_file = get_config_value(config, 'buildnml_input', 'lnd_domain_file', ctsm_cfg_path) if use_existing_res_and_mask: fsurdat = _UNSET else: # If we're not using an out-of-the-box grid, then require the user to explicitly # specify the surface dataset. - fsurdat = get_config_value(config, 'buildnml_input', 'fsurdat', file_path) - finidat = get_config_value(config, 'buildnml_input', 'finidat', file_path) + fsurdat = get_config_value(config, 'buildnml_input', 'fsurdat', ctsm_cfg_path) + finidat = get_config_value(config, 'buildnml_input', 'finidat', ctsm_cfg_path) - ctsm_phys = get_config_value(config, 'buildnml_input', 'ctsm_phys', file_path, + ctsm_phys = get_config_value(config, 'buildnml_input', 'ctsm_phys', ctsm_cfg_path, allowed_values=['clm4_5', 'clm5_0']) - configuration = get_config_value(config, 'buildnml_input', 'configuration', file_path, + configuration = get_config_value(config, 'buildnml_input', 'configuration', ctsm_cfg_path, allowed_values=['nwp', 'clm']) - structure = get_config_value(config, 'buildnml_input', 'structure', file_path, + structure = get_config_value(config, 'buildnml_input', 'structure', ctsm_cfg_path, allowed_values=['fast', 'standard']) - bgc_mode = get_config_value(config, 'buildnml_input', 'bgc_mode', file_path, + bgc_mode = get_config_value(config, 'buildnml_input', 'bgc_mode', ctsm_cfg_path, allowed_values=['sp', 'bgc', 'cn', 'fates']) - crop = get_config_value(config, 'buildnml_input', 'crop', file_path, + crop = get_config_value(config, 'buildnml_input', 'crop', ctsm_cfg_path, allowed_values=['off', 'on']) - vichydro = get_config_value(config, 'buildnml_input', 'vichydro', file_path, + vichydro = get_config_value(config, 'buildnml_input', 'vichydro', ctsm_cfg_path, allowed_values=['off', 'on']) bldnml_opts = determine_bldnml_opts(bgc_mode=bgc_mode, crop=crop, vichydro=vichydro) - co2_ppmv = get_config_value(config, 'buildnml_input', 'co2_ppmv', file_path) - use_case = get_config_value(config, 'buildnml_input', 'use_case', file_path) - lnd_tuning_mode = get_config_value(config, 'buildnml_input', 'lnd_tuning_mode', file_path) - spinup = get_config_value(config, 'buildnml_input', 'spinup', file_path, + co2_ppmv = get_config_value(config, 'buildnml_input', 'co2_ppmv', ctsm_cfg_path) + use_case = get_config_value(config, 'buildnml_input', 'use_case', ctsm_cfg_path) + lnd_tuning_mode = get_config_value(config, 'buildnml_input', 'lnd_tuning_mode', ctsm_cfg_path) + spinup = get_config_value(config, 'buildnml_input', 'spinup', ctsm_cfg_path, allowed_values=['off', 'on']) - inputdata_path = get_config_value(config, 'buildnml_input', 'inputdata_path', file_path) + inputdata_path = get_config_value(config, 'buildnml_input', 'inputdata_path', ctsm_cfg_path) + + # Parse the user_nl_ctsm file + infile = os.path.join(rundir, '.namelist') + create_namelist_infile(case=CaseFake(), + user_nl_file=os.path.join(rundir, 'user_nl_ctsm'), + namelist_infile=infile) # create config_cache.xml file # Note that build-namelist utilizes the contents of the config_cache.xml file in @@ -229,6 +253,7 @@ def buildnml(rundir, use_existing_res_and_mask, existing_res=None, existing_mask # call build-namelist cmd = os.path.abspath(os.path.join(path_to_ctsm_root(), "bld", "build-namelist")) command = [cmd, + '-infile', infile, '-csmdata', inputdata_path, '-inputdata', inputdatalist_path, # Hard-code start_ymd of year-2000. This is used to set the run type (for @@ -273,6 +298,7 @@ def buildnml(rundir, use_existing_res_and_mask, existing_res=None, existing_mask os.remove(os.path.join(rundir, "config_cache.xml")) os.remove(os.path.join(rundir, "env_lilac.xml")) os.remove(os.path.join(rundir, "drv_flds_in")) + os.remove(infile) ############################################################################### def main(): From f4971ed89c13776cd74d3613c4776ae42199a2f8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 23 Jun 2020 08:53:02 -0600 Subject: [PATCH 396/556] Stage a user_nl_ctsm file as part of build_ctsm --- lilac/bld_templates/user_nl_ctsm | 7 +++++++ python/ctsm/lilac_build_ctsm.py | 5 +++++ 2 files changed, 12 insertions(+) create mode 100644 lilac/bld_templates/user_nl_ctsm diff --git a/lilac/bld_templates/user_nl_ctsm b/lilac/bld_templates/user_nl_ctsm new file mode 100644 index 0000000000..0835ca134d --- /dev/null +++ b/lilac/bld_templates/user_nl_ctsm @@ -0,0 +1,7 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! (Exceptions are settings that are set in ctsm.cfg.) +!---------------------------------------------------------------------------------- + diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index 3079f8cfdf..0f5bdf31e7 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -3,6 +3,7 @@ import argparse import logging import os +import shutil import subprocess from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args @@ -611,6 +612,10 @@ def _stage_runtime_inputs(build_dir): path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'lilac_in'), substitutions={'INPUTDATA':os.path.join(build_dir, _INPUTDATA_DIRNAME)}) + shutil.copyfile( + src=os.path.join(_PATH_TO_TEMPLATES, 'user_nl_ctsm'), + dst=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'user_nl_ctsm')) + make_link(_PATH_TO_MAKE_RUNTIME_INPUTS, os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'make_runtime_inputs')) From 83c3c4d3bee52e7cc7e009c7fdf2e7ed794b2402 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 23 Jun 2020 08:58:05 -0600 Subject: [PATCH 397/556] Fix some pylint issues --- python/ctsm/lilac_make_runtime_inputs.py | 11 ++++++++--- .../ctsm/test/test_unit_lilac_make_runtime_inputs.py | 4 +++- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/python/ctsm/lilac_make_runtime_inputs.py b/python/ctsm/lilac_make_runtime_inputs.py index a2cb94ec68..14c327d062 100644 --- a/python/ctsm/lilac_make_runtime_inputs.py +++ b/python/ctsm/lilac_make_runtime_inputs.py @@ -12,7 +12,7 @@ from ctsm.path_utils import path_to_ctsm_root from ctsm.utils import abort -from CIME.buildnml import create_namelist_infile +from CIME.buildnml import create_namelist_infile # pylint: disable=import-error logger = logging.getLogger(__name__) @@ -55,15 +55,19 @@ _UNSET = 'UNSET' # ======================================================================== -# Fake case object that can be used to satisfy the interface of CIME functions that need a +# Fake case class that can be used to satisfy the interface of CIME functions that need a # case object # ======================================================================== class CaseFake: + """Fake case class to satisfy interface of CIME functions that need a case object""" + # pylint: disable=too-few-public-methods + def __init__(self): pass - def get_resolved_value(self, value): + @staticmethod + def get_resolved_value(value): """Make sure get_resolved_value doesn't get called (since we don't have a real case object to resolve values with) @@ -177,6 +181,7 @@ def buildnml(rundir, use_existing_res_and_mask, existing_res=None, existing_mask """ # pylint: disable=too-many-locals + # pylint: disable=too-many-statements ctsm_cfg_path = os.path.join(rundir, 'ctsm.cfg') diff --git a/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py b/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py index bf28e6e265..7c94089269 100755 --- a/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py +++ b/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py @@ -32,7 +32,9 @@ def test_buildnmlOpts_bgcCrop(self): def test_buildnmlOpts_spCrop_fails(self): """Test determine_buildnml_opts with bgc_mode='sp' and crop on: should fail""" - with self.assertRaisesRegex(SystemExit, "setting crop to 'on' is only compatible with bgc_mode"): + with self.assertRaisesRegex( + SystemExit, + "setting crop to 'on' is only compatible with bgc_mode"): _ = determine_bldnml_opts(bgc_mode='sp', crop='on', vichydro='off') def test_buildnmlOpts_spVic(self): From 5e36fdeba9d2d3b63820b949ea002bd3ed6dc67c Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 23 Jun 2020 09:02:35 -0600 Subject: [PATCH 398/556] Ensure we're using a consistent cime version in make_runtime_inputs --- lilac/make_runtime_inputs | 7 +++++-- python/ctsm/lilac_make_runtime_inputs.py | 16 +++++++++++++--- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/lilac/make_runtime_inputs b/lilac/make_runtime_inputs index 6d8db14985..93f218a9d0 100755 --- a/lilac/make_runtime_inputs +++ b/lilac/make_runtime_inputs @@ -8,9 +8,12 @@ _CTSM_PYTHON = os.path.join(os.path.dirname(os.path.realpath(__file__)), os.pardir, 'python') sys.path.insert(1, _CTSM_PYTHON) -from ctsm import add_cime_to_path + +from ctsm.path_utils import add_cime_lib_to_path + +cime_path = add_cime_lib_to_path() from ctsm.lilac_make_runtime_inputs import main if __name__ == "__main__": - main() + main(cime_path=cime_path) diff --git a/python/ctsm/lilac_make_runtime_inputs.py b/python/ctsm/lilac_make_runtime_inputs.py index 14c327d062..7d651b9dd6 100644 --- a/python/ctsm/lilac_make_runtime_inputs.py +++ b/python/ctsm/lilac_make_runtime_inputs.py @@ -171,7 +171,8 @@ def determine_bldnml_opts(bgc_mode, crop, vichydro): return bldnml_opts ############################################################################### -def buildnml(rundir, use_existing_res_and_mask, existing_res=None, existing_mask=None): +def buildnml(cime_path, rundir, use_existing_res_and_mask, + existing_res=None, existing_mask=None): ############################################################################### """Build the ctsm namelist @@ -258,6 +259,7 @@ def buildnml(rundir, use_existing_res_and_mask, existing_res=None, existing_mask # call build-namelist cmd = os.path.abspath(os.path.join(path_to_ctsm_root(), "bld", "build-namelist")) command = [cmd, + '-cimeroot', cime_path, '-infile', infile, '-csmdata', inputdata_path, '-inputdata', inputdatalist_path, @@ -306,13 +308,21 @@ def buildnml(rundir, use_existing_res_and_mask, existing_res=None, existing_mask os.remove(infile) ############################################################################### -def main(): - """Main function""" +def main(cime_path): + """Main function + + Args: + cime_path (str): path to the cime that we're using (this is passed in explicitly + rather than relying on calling path_to_cime so that we can be absolutely sure that + the scripts called here are coming from the same cime as the cime library we're + using). + """ setup_logging_pre_config() args = parse_command_line() process_logging_args(args) buildnml( + cime_path=cime_path, rundir=args.rundir, use_existing_res_and_mask=args.use_existing_res_and_mask, existing_res=args.existing_res, From 78b5ae72183e98fb99a1d3fe9cb44294103364bf Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 23 Jun 2020 09:51:02 -0600 Subject: [PATCH 399/556] Remove lilac_rof_input section from lilac_in This section (with variable rof_mesh_filename) appears to be unused currently. Removing it to avoid confusion. --- lilac/bld_templates/lilac_in_template | 3 --- 1 file changed, 3 deletions(-) diff --git a/lilac/bld_templates/lilac_in_template b/lilac/bld_templates/lilac_in_template index a10baa472b..6fa6be8967 100644 --- a/lilac/bld_templates/lilac_in_template +++ b/lilac/bld_templates/lilac_in_template @@ -11,9 +11,6 @@ &lilac_lnd_input lnd_mesh_filename = '$INPUTDATA/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' / -&lilac_rof_input - rof_mesh_filename = '$INPUTDATA/share/meshes/r05_nomask_c110308_ESMFmesh.nc' -/ &atmaero_stream stream_fldfilename='$INPUTDATA/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_WACCM.ensmean_monthly_hist_1849-2015_0.9x1.25_CMIP6_c180926.nc' stream_year_first = 2000 From 1c201ccd19e3ec4ff6233c5dc44e0d99914447c0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 23 Jun 2020 09:52:40 -0600 Subject: [PATCH 400/556] In lilac_in: set mesh filenames to 'FILL_THIS_IN' This should indicate to users that they need to replace these values --- lilac/bld_templates/lilac_in_template | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lilac/bld_templates/lilac_in_template b/lilac/bld_templates/lilac_in_template index 6fa6be8967..304191ee09 100644 --- a/lilac/bld_templates/lilac_in_template +++ b/lilac/bld_templates/lilac_in_template @@ -6,10 +6,10 @@ lilac_histfreq_n = 1 / &lilac_atmcap_input - atm_mesh_filename = '$INPUTDATA/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + atm_mesh_filename = 'FILL_THIS_IN' / &lilac_lnd_input - lnd_mesh_filename = '$INPUTDATA/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + lnd_mesh_filename = 'FILL_THIS_IN' / &atmaero_stream stream_fldfilename='$INPUTDATA/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_WACCM.ensmean_monthly_hist_1849-2015_0.9x1.25_CMIP6_c180926.nc' From 27087dbe78575c4f5ee1f141a14606eec2cad84f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 23 Jun 2020 10:29:35 -0600 Subject: [PATCH 401/556] Set up default history output in user_nl_ctsm --- lilac/bld_templates/user_nl_ctsm | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/lilac/bld_templates/user_nl_ctsm b/lilac/bld_templates/user_nl_ctsm index 0835ca134d..5ff40dbff8 100644 --- a/lilac/bld_templates/user_nl_ctsm +++ b/lilac/bld_templates/user_nl_ctsm @@ -5,3 +5,13 @@ ! (Exceptions are settings that are set in ctsm.cfg.) !---------------------------------------------------------------------------------- +! The following hist options set up three output streams from CTSM. The first (h0 files) +! is monthly and contains all of CTSM's default output variables. The second (h1 files) is +! daily, with a small list of fields given by hist_fincl2. The third (h2 files) is hourly, +! with a small list of fields given by hist_fincl3. You can change these settings however +! you'd like. +hist_mfilt = 1,1,24 +hist_nhtfrq = 0,-24,-1 +hist_fincl2 = 'SNO_LIQH2O','SNO_ICE','SNOTTOPL','SNOW_DEPTH','TSA','RAIN','SNOW','Q2M','RH2M','FSH','FCTR','FCEV','FGEV','FSDS','FSR','FIRA','BTRAN','SOILWATER_10CM','TSOI_10CM','H2OSOI','TSOI' +hist_fincl3 = 'SNO_LIQH2O','SNO_ICE','SNOTTOPL','SNOW_DEPTH','TSA','RAIN','SNOW','Q2M','RH2M','FSH','FCTR','FCEV','FGEV','FSDS','FSR','FIRA','BTRAN','SOILWATER_10CM','TSOI_10CM','H2OSOI','TSOI' + From fe509cc2c50907240f750e7fb4fd39b716b2e943 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 23 Jun 2020 11:05:47 -0600 Subject: [PATCH 402/556] Update cime to latest tag that has updated grid names, and uses PIO1 --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index 43e4b64988..b160ff1ebd 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -30,7 +30,7 @@ required = True local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -tag = branch_tags/cime5.8.24_a01 +tag = cime5.8.27 externals = ../Externals_cime.cfg required = True From b2ea3fe02e1c30573e5da11e53c1ace19b772d89 Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Tue, 23 Jun 2020 11:28:43 -0600 Subject: [PATCH 403/556] Rename ne30pg3 to ne30np4.pg3 --- bld/namelist_files/namelist_defaults_ctsm.xml | 8 ++++---- bld/namelist_files/namelist_definition_ctsm.xml | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index f578be0db0..05beb167bb 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -799,7 +799,7 @@ lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_ne16np4_hist_78pfts_CMIP6_simyr lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4_hist_78pfts_CMIP6_simyr2000_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg2_hist_78pfts_CMIP6_simyr2000_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg3_hist_78pfts_CMIP6_simyr2000_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4_hist_78pfts_CMIP6_simyr2000_c200427.nc @@ -877,7 +877,7 @@ lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1x1_brazil_hist_78pfts_CMIP6_si lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4_hist_78pfts_CMIP6_simyr1850_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg2_hist_78pfts_CMIP6_simyr1850_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg3_hist_78pfts_CMIP6_simyr1850_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4_hist_78pfts_CMIP6_simyr1850_c200427.nc @@ -937,7 +937,7 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc @@ -975,7 +975,7 @@ lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_h use_crop=".true." >lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 1da18f3722..1922748956 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1953,7 +1953,7 @@ CLM run type. + valid_values="conus_30_x8,512x1024,360x720cru,128x256,64x128,48x96,94x192,0.23x0.31,0.47x0.63,0.9x1.25,1.9x2.5,2.5x3.33,4x5,10x15,0.125nldas2,5x5_amazon,1x1_camdenNJ,1x1_vancouverCAN,1x1_mexicocityMEX,1x1_asphaltjungleNJ,1x1_brazil,1x1_urbanc_alpha,1x1_numaIA,1x1_smallvilleIA,0.1x0.1,0.25x0.25,0.5x0.5,3x3min,5x5min,10x10min,0.33x0.33,0.125x0.125,ne4np4,ne16np4,ne30np4.pg2,ne30np4.pg3,ne30np4,ne60np4,ne120np4,ne120np4.pg2,ne120np4.pg3,ne0np4CONUS.ne30x8,ne0np4.ARCTIC.ne30x4,ne0np4.ARCTICGRIS.ne30x8,ne240np4,1km-merge-10min,C24,C48,C96,C192,C384"> Horizontal resolutions Note: 0.1x0.1, 0.25x0.25, 0.5x0.5, 5x5min, 10x10min, 3x3min, 1km-merge-10min and 0.33x0.33 are only used for CLM toolsI From b949e523ff243e79c3f8ec8ac4d921063dd56d67 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 23 Jun 2020 11:41:19 -0600 Subject: [PATCH 404/556] Set pio_stride intelligently --- .../config_machines_template.xml | 6 +-- ...d_modelio.nml => lnd_modelio_template.nml} | 4 +- python/ctsm/lilac_build_ctsm.py | 40 +++++++++++++++---- python/ctsm/test/test_sys_lilac_build_ctsm.py | 2 + .../ctsm/test/test_unit_lilac_build_ctsm.py | 9 +++-- 5 files changed, 45 insertions(+), 16 deletions(-) rename lilac/bld_templates/{lnd_modelio.nml => lnd_modelio_template.nml} (64%) diff --git a/lilac/bld_templates/config_machines_template.xml b/lilac/bld_templates/config_machines_template.xml index e6e102fa53..29e2bf79f2 100644 --- a/lilac/bld_templates/config_machines_template.xml +++ b/lilac/bld_templates/config_machines_template.xml @@ -75,15 +75,13 @@ This is irrelevant for this build-only port. --> - 1 + $MAX_MPITASKS_PER_NODE - 1 + $MAX_MPITASKS_PER_NODE -lnd/clm2/paramdata/clm5_params.c200623.nc -lnd/clm2/paramdata/clm45_params.c200614.nc +lnd/clm2/paramdata/clm5_params.c200624.nc +lnd/clm2/paramdata/clm45_params.c200624.nc From 9497f008d4b80071538787e5f30796939c768657 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 24 Jun 2020 10:48:21 -0600 Subject: [PATCH 411/556] Update totvegcthresh from .1 to 1. fixing #738 --- src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 b/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 index 2bd92d2d41..3740700ab1 100644 --- a/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 @@ -43,7 +43,7 @@ subroutine SoilBiogeochemPrecisionControlInit( soilbiogeochem_carbonstate_inst, type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst ! ! !LOCAL VARIABLES: - real(r8), parameter :: totvegcthresh = 0.1_r8 ! Total vegetation carbon threshold to zero out decomposition pools + real(r8), parameter :: totvegcthresh = 1.0_r8 ! Total vegetation carbon threshold to zero out decomposition pools !----------------------------------------------------------------------- ccrit = 1.e-8_r8 ! critical carbon state value for truncation (gC/m2) ncrit = 1.e-8_r8 ! critical nitrogen state value for truncation (gN/m2) From 11aa4069dba703e0cabf01a98370ba808fe45576 Mon Sep 17 00:00:00 2001 From: negin513 Date: Wed, 24 Jun 2020 12:13:15 -0600 Subject: [PATCH 412/556] few modifications and removing the unnecessary environments... --- doc/source/lilac/specific-atm-models/wrf.rst | 56 ++++++++------------ 1 file changed, 21 insertions(+), 35 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 5e39437cd9..32aea2d4e0 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -24,7 +24,6 @@ Decide where you will work, for example:: mkdir git_wrf_ctsm cd git_wrf_ctsm - Clone CTSM repository and checkout lilac_cap branch:: git clone https://github.com/ESCOMP/ctsm.git @@ -80,19 +79,6 @@ or (Cshell): setenv WRF_CTSM_MKFILE /glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk -.. todo:: - - Bill and Sam do we need the following still:? - -The following is needed in order to undo an undesired setting in that env_mach_specific file:: - - export MPI_USE_ARRAY=None - -or (Cshell): - -.. code-block:: Tcsh - - setenv MPI_USE_ARRAY None There are also few other environmental setting that should be set for building WRF. Some of these are not required, but might help if you face any compilation errors. @@ -118,10 +104,6 @@ or (Cshell): setenv WRF_DA_CORE 0 -Make sure you set NETCDF environment variable by:: - - setenv NETCDF /usr/local/netcdf/ (or wherever you have netcdf compiled.) - Then configure and build WRF for your machine and intended compiler by:: ./clean -a @@ -153,7 +135,6 @@ Then compile em_real and save the log:: Try "man nohup" for more information. - Compile WRF Preprocessing System (WPS) -------------------------------------- @@ -165,14 +146,11 @@ input to the real program for WRF real-data simulations. Building WPS requires that WRF be already built successfully. -Get WPS zipped tar file from: - -http://www2.mmm.ucar.edu/wrf/users/download/get_source.html +Get WPS from: -Untar WPS tar file:: - - gzip -cd WPSV4.0.TAR.gz | tar -xf - +https://www2.mmm.ucar.edu/wrf/users/download/wrf-regist_or_download.php +Please note that new users must register a form in this step. Then compile WPS similar to the way WRF was built. In summary:: @@ -208,14 +186,19 @@ If the geogrid step is finished successfully, you should see the following messa the log file:: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Successful completion of geogrid. ! + ! Successful completion of geogrid. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -Check the geogrid log file for successful ****** -Link the GRIB data files that are going to be used:: + +Next, we should run ungrib to get gribbed data into usable f ormat to be ingested by WRF. + +For running ungrib.exe, firt link the GRIB data files that are going to be used:: ./link_grib.csh $your_GRIB_data_path +Based on your GRIB data type, link or copy the appropriate VTable to your WPS directory. +WRF has some prepared VTable under /ungrib/Variable_tables/ folder. + Extract meteorological fields from GRIB-formatted files:: ./ungrib.exe >& log.ungrib @@ -227,9 +210,7 @@ Check ungrib log for the following message showing successful completion of ungr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - +At this point, you should see ungrib output (intermediate files) in your WPS directory. Horizontally interpolate the meteorological fields extracted by ungrib to the model grids defined in geogrid:: @@ -237,7 +218,6 @@ the model grids defined in geogrid:: ./metgrid.exe >& log.metgrid - Check the metgrid log for the following message showing successful completion of metgrid step:: @@ -249,10 +229,11 @@ metgrid step:: Run real program ---------------- -Run real.exe to generate initial and boundary conditions. -Follow WRF instructions for creating initial and boundary -conditions. In summary, complete the following steps: +Run real.exe to generate initial and boundary conditions. + +Follow WRF instructions for creating initial and boundary conditions. +In summary, complete the following steps: Move or link WPS output files (met_em.d01* files) to your WRF/run directory. @@ -260,6 +241,11 @@ Edit namelist.input for your WRF domain and desirable configurations. This should be the same domain as in the namelist used in WPS. +.. todo:: + + update the option number of wrf namelist. + + To run WRF-CTSM, change land-surface option to 51:: sf_surface_physics = 51 From 370c311bb238e2c156b5d04c4ab1a9f23fddbc99 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 24 Jun 2020 16:25:26 -0600 Subject: [PATCH 413/556] Add script to download input data for lilac --- lilac/download_input_data | 17 +++++ python/ctsm/lilac_build_ctsm.py | 7 ++ python/ctsm/lilac_download_input_data.py | 85 ++++++++++++++++++++++++ 3 files changed, 109 insertions(+) create mode 100755 lilac/download_input_data create mode 100644 python/ctsm/lilac_download_input_data.py diff --git a/lilac/download_input_data b/lilac/download_input_data new file mode 100755 index 0000000000..70daf01a3c --- /dev/null +++ b/lilac/download_input_data @@ -0,0 +1,17 @@ +#!/usr/bin/env python +"""Download input data for running CTSM via LILAC""" + +import os +import sys + +_CTSM_PYTHON = os.path.join(os.path.dirname(os.path.realpath(__file__)), + os.pardir, + 'python') +sys.path.insert(1, _CTSM_PYTHON) + +from ctsm import add_cime_to_path + +from ctsm.lilac_download_input_data import main + +if __name__ == "__main__": + main() diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index 9672f1a275..40c176e319 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -33,6 +33,10 @@ 'lilac', 'make_runtime_inputs') +_PATH_TO_DOWNLOAD_INPUT_DATA = os.path.join(path_to_ctsm_root(), + 'lilac', + 'download_input_data') + _MACHINE_CONFIG_DIRNAME = 'machine_configuration' _INPUTDATA_DIRNAME = 'inputdata' _RUNTIME_INPUTS_DIRNAME = 'runtime_inputs' @@ -663,6 +667,9 @@ def _stage_runtime_inputs(build_dir, no_pnetcdf): make_link(_PATH_TO_MAKE_RUNTIME_INPUTS, os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'make_runtime_inputs')) + make_link(_PATH_TO_DOWNLOAD_INPUT_DATA, + os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'download_input_data')) + def _build_case(build_dir): """Build the CTSM library and its dependencies diff --git a/python/ctsm/lilac_download_input_data.py b/python/ctsm/lilac_download_input_data.py new file mode 100644 index 0000000000..be91ca1c83 --- /dev/null +++ b/python/ctsm/lilac_download_input_data.py @@ -0,0 +1,85 @@ +"""Functions implementing LILAC's download_input_data command""" + +import argparse +import logging +import os +import re + +from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args + +from CIME.case import Case + +logger = logging.getLogger(__name__) + +# ======================================================================== +# Define some constants +# ======================================================================== + +# In lilac_in, file names match this pattern: The variable name ends with 'filename', so +# that is the last thing before the equals sign on the line. +_LILAC_FILENAME = r"filename *=" + +# ======================================================================== +# Public functions +# ======================================================================== + +def main(): + """Main function called when download_input_data is run from the command-line + """ + setup_logging_pre_config() + args = _commandline_args() + process_logging_args(args) + + download_input_data(rundir=args.rundir) + +def download_input_data(rundir): + """Implementation of the download_input_data command + + Args: + rundir: str - path to directory containing input_data_list files + """ + _create_lilac_input_data_list(rundir) + case = Case(os.path.realpath(os.path.join(rundir, os.pardir, 'case'))) + case.check_all_input_data( + input_data_root=os.path.realpath(os.path.join(rundir, os.pardir, 'inputdata')), + data_list_dir=rundir, + download=True, + chksum=False) + +# ======================================================================== +# Private functions +# ======================================================================== + +def _commandline_args(): + """Parse and return command-line arguments + """ + + description = """ +Script to download any missing input data for CTSM and LILAC +""" + + parser = argparse.ArgumentParser( + description=description, + formatter_class=argparse.RawTextHelpFormatter) + + parser.add_argument("--rundir", default=os.getcwd(), + help="Full path of the run directory\n" + "(This directory should contain clm.input_data_list and lilac_in, among other files.)\n" + "(Note: it is assumed that this directory exists alongside the other directories\n" + "created by build_ctsm: 'case' and 'inputdata'.)") + + add_logging_args(parser) + + args = parser.parse_args() + + return args + +def _create_lilac_input_data_list(rundir): + with open(os.path.join(rundir, 'lilac_in')) as lilac_in: + with open(os.path.join(rundir, 'lilac.input_data_list'), 'w') as input_data_list: + for line in lilac_in: + if re.search(_LILAC_FILENAME, line): + # Remove quotes from filename, then output this line + line = line.replace('"', '') + line = line.replace("'", "") + input_data_list.write(line) From 83c6b2acc7dd078c76c83fe2714f81da81561071 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 24 Jun 2020 16:28:22 -0600 Subject: [PATCH 414/556] Do xmlchange commands before case.setup This is important for FORCE_BUILD_SMP due to https://github.com/ESMCI/cime/issues/3590. For the others, it shouldn't hurt to do the xmlchange commands earlier. --- python/ctsm/lilac_build_ctsm.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index 40c176e319..c7e47bebaf 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -600,16 +600,16 @@ def _create_case(cime_path, build_dir, compiler, run_cmd_output_on_error(create_newcase_cmd, errmsg='Problem creating CTSM case directory') - run_cmd_output_on_error([os.path.join(case_dir, 'case.setup')], - errmsg='Problem setting up CTSM case directory', - cwd=case_dir) - subprocess.check_call([xmlchange, 'LILAC_MODE=on'], cwd=case_dir) if build_debug: subprocess.check_call([xmlchange, 'DEBUG=TRUE'], cwd=case_dir) if not build_without_openmp: subprocess.check_call([xmlchange, 'FORCE_BUILD_SMP=TRUE'], cwd=case_dir) + run_cmd_output_on_error([os.path.join(case_dir, 'case.setup')], + errmsg='Problem setting up CTSM case directory', + cwd=case_dir) + make_link(os.path.join(case_dir, 'bld'), os.path.join(build_dir, 'bld')) if machine is not None: From 8f71f5d91b05111f819c529849a17bf646936bbb Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 24 Jun 2020 17:01:04 -0600 Subject: [PATCH 415/556] Overall cleanup in wrf.rst File contains these TODOs: - Remove "git checkout lilac_cap" when ready - Remove "--build-without-openmp" when ready - If the relative link works, remove the absolute link to Section 3.2 - Update git address to WRF feature branch & rm "git checkout lilac_dev" - Does "similar to" mean "same as" (<-- this one's for Negin) - Make ncl script available and, if the finidat and wrfinput files need to be consistent for this to work, we should explain how to generate a consistent finidat file. --- doc/source/lilac/specific-atm-models/wrf.rst | 157 ++++++++++--------- 1 file changed, 83 insertions(+), 74 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 32aea2d4e0..8cae475d42 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -16,33 +16,40 @@ from earlier sections but in recipe form and with minimal detail. This section assumes use of a machine that has been ported to CIME. In this example we assume NCAR’s cheyenne computer in particular. -Clone CTSM Repository -------------------------- +Clone CTSM Repository and Build CTSM +------------------------------------ -Decide where you will work, for example:: +Decide where you will work. This is also where the model will write +output, so on cheyenne you may benefit from starting in +/glade/scratch/$USER due to the larger disk space there. - mkdir git_wrf_ctsm - cd git_wrf_ctsm +Clone the CTSM repository:: -Clone CTSM repository and checkout lilac_cap branch:: - - git clone https://github.com/ESCOMP/ctsm.git - cd ctsm + mkdir your_directory_name + cd your_directory_name + git clone https://github.com/ESCOMP/CTSM.git + cd CTSM git checkout lilac_cap ./manage_externals/checkout_externals +.. todo:: + + Remove "git checkout lilac_cap" from the above when ready + Build CTSM and its dependencies based on instructions from previous sections, for example for cheyenne:: - ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne + ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne --build-without-openmp +.. todo:: + + Remove "--build-without-openmp" from the above when ready -Set environment similar to environments used for your CTSM build using -ctsm_build_environment.sh for bash:: +Source ctsm_build_environment.sh (bash environment):: - source /ctsm_build_dir/ctsm_build_environment.sh + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh -or ctsm_build_environment.csh for Cshell: +or ctsm_build_environment.csh (Cshell environment): .. code-block:: Tcsh @@ -51,8 +58,13 @@ or ctsm_build_environment.csh for Cshell: .. note:: For additional details on preparing the CTSM, including how to - recompile when making code changes to the CTSM, read section - _obtaining-and-building-ctsm. <-- CREATED LINK TO THE CORRECT SECTION? + recompile when making code changes to the CTSM, read Section 3.2: + https://escomp.github.io/ctsm-docs/versions/master/html/lilac/obtaining-building-and-running/index.html + https:../obtaining-building-and-running/index.html + +.. todo:: + + If the second (relative) link works, remove the first (absolute) link Building the WRF model with CTSM -------------------------------- @@ -60,61 +72,57 @@ Building the WRF model with CTSM .. todo:: update the git address to WRF feature branch... + and remove "git checkout lilac_dev" below -Clone WRF CTSM branch into your directory:: +Clone the WRF CTSM branch into your_directory_name:: + cd .. git clone git@github.com:billsacks/WRF.git cd WRF git checkout lilac_dev -For building WRF using CTSM, we should set makefile variables from CTSM needed for -WRF build by (BASH):: +Set makefile variables from CTSM needed for the WRF build, for bash:: export WRF_CTSM_MKFILE=/glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk -or (Cshell): +or for Cshell use the setenv command and remove the "=" (here and in +subsequent cases): .. code-block:: Tcsh setenv WRF_CTSM_MKFILE /glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk - -There are also few other environmental setting that should be set for building WRF. -Some of these are not required, but might help if you face any compilation errors. +The next two environment settings for building WRF may help if you +encounter compilation errors, but should be unnecessary for completing +the current example on cheyenne. Explicitly define which model core to build by:: export WRF_EM_CORE=1 -or (Cshell): - -.. code-block:: Tcsh - - setenv WRF_EM_CORE 1 - Explicilty turn off data assimilation by:: export WRF_DA_CORE=0 -or (Cshell): - -.. code-block:: Tcsh - - setenv WRF_DA_CORE 0 - - -Then configure and build WRF for your machine and intended compiler by:: +Now configure and build WRF for your machine and intended compiler. +The ./clean command is necessary after any modification of WRF code:: ./clean -a ./configure -Choose one of the options, similar to the compiler used for building CTSM. +At the prompt choose one of the options, similar to the compiler used +for building CTSM. The specific example has been tested successfuly by +choosing 15 here. + +.. todo:: + + Negin, by "similar to" do you mean "same as" in the above? -Next, choose one of the options for nesting. Currently nesting is not available for WRF-CTSM, -therefore we should use 1. +The next prompt requests an option for nesting. Currently nesting is not +available for WRF-CTSM so enter 1. -Then compile em_real and save the log:: +Now compile em_real and save the log:: ./compile em_real >& compile.log @@ -139,7 +147,7 @@ Compile WRF Preprocessing System (WPS) -------------------------------------- The WRF Preprocessing System (WPS) is a set of programs to prepare -input to the real program for WRF real-data simulations. +inputs to the real program executable (real.exe) for WRF real-data simulations. .. note:: @@ -150,29 +158,33 @@ Get WPS from: https://www2.mmm.ucar.edu/wrf/users/download/wrf-regist_or_download.php -Please note that new users must register a form in this step. +New users must complete a registration form in this step. Then compile WPS similar to the way WRF was built. In summary:: cd WPS ./configure -Here choose one option, for your intended compiler, similar to your WRF build. -After configuring, you can check configure.wps for making sure all the libs and paths +At the prompt choose your intended compiler, similar to your WRF build. +After configuring, check configure.wps to make sure all the libs and paths are set correctly. +.. todo:: + + Negin, by "similar to" do you mean "same as" in the above? + Then, compile WPS:: ./compile >& compile.log .. note:: - If wps build is succsfully you should see geogrid.exe, ungrib.exe, and metgrid.exe. + If wps builds succesfully you should see geogrid.exe, ungrib.exe, and metgrid.exe. Alternatively, you can check the log for successful build message. -Run WRF Preprocessing System (WPS) Steps ------------------------------------------ +Run WRF Preprocessing System (WPS) +---------------------------------- Edit namelist.wps for your domain of interest, which should be the same domain as used in your WRF namelist. @@ -182,17 +194,16 @@ to the grids:: ./geogrid.exe >& log.geogrid -If the geogrid step is finished successfully, you should see the following message in -the log file:: +If the geogrid step finishes successfully, you should see the following message in the log file:: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Successful completion of geogrid. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -Next, we should run ungrib to get gribbed data into usable f ormat to be ingested by WRF. +Next, run ungrib to get gribbed data into usable format to be ingested by WRF. -For running ungrib.exe, firt link the GRIB data files that are going to be used:: +To run ungrib.exe, first link the GRIB data files that are going to be used:: ./link_grib.csh $your_GRIB_data_path @@ -227,8 +238,8 @@ metgrid step:: -Run real program ----------------- +Run real.exe +------------ Run real.exe to generate initial and boundary conditions. @@ -270,8 +281,10 @@ Check the last line of the real log file for the following message:: Create input namelists for CTSM and LILAC ========================================= -Introduce the following diffs to ./git_wrf_ctsm/ctsm/lilac/atm_driver/ -by replacing the entries preceded by minus signs with the entries +Introduce the following diffs to +./your_directory_name/ctsm/lilac/atm_driver/ +where is atm_driver_in, ctsm.cfg, and lilac_in. +In particular, replace the entries preceded by minus signs with the entries preceded by plus signs. diff ./lilac/atm_driver/atm_driver_in ./lilac/atm_driver/atm_driver_in: @@ -321,48 +334,42 @@ Before you generate the lnd_in file, you may modify user_nl_clm in point to an alternate CTSM initial condition file. To merge WRF initial conditions from a wrfinput file into a CTSM initial condition file, type:: - module load ncl/6.6.2 - ncl transfer_wrfinput_to_ctsm_with_snow.ncl 'finidat="finidat_interp_dest.nc"' 'wrfinput="./git_wrf_ctsm/WRF/test/em_real/wrfinput_d01.noseaice"' 'merged="finidat_interp_dest_wrfinit_snow.nc"' + module load ncl + ncl transfer_wrfinput_to_ctsm_with_snow.ncl 'finidat="finidat_interp_dest.nc"' 'wrfinput="./your_directory_name/WRF/test/em_real/wrfinput_d01.noseaice"' 'merged="finidat_interp_dest_wrfinit_snow.nc"' .. todo:: - Need to make the above ncl script available. I assume that the finidat - and the wrfinput files need to be consistent for this to work. If so, - we should prob. explain how to generate a consistent finidat file. + Make the above ncl script available. If the finidat and wrfinput files + need to be consistent for this to work, we should explain how to + generate a consistent finidat file. Generate the lnd_in file by running the following from -./git_wrf_ctsm/ctsm/lilac/atm_driver:: +./your_directory_name/ctsm/lilac/atm_driver:: ../../lilac_config/buildnml Copy lilac_in, lnd_in, and lnd_modelio.nml to the WRF/run directory. - - Run WRF ------- -If real program is completed successfully, we should see wrfinput and wrfbdy files +If real program completed successfully, we should see wrfinput and wrfbdy files in our directory. -Next, we should run WRF. - -For Cheyenne, we should submit a batch job to PBS (Pro workload management system). -For more instructions on running a batch job on Cheyenne, please check: +Now run WRF-CTSM. On Cheyenne this means submitting a batch job to PBS (Pro workload management system). +For detailed instructions on running a batch job on Cheyenne, please check: https://www2.cisl.ucar.edu/resources/computational-systems/cheyenne/running-jobs/submitting-jobs-pbs - -A sample of basic PBS job for Cheyenne: +A simple PBS script to run WRF-CTSM on Cheyenne looks like this: .. code-block:: Tcsh #!/bin/tcsh - #PBS -N job_name - #PBS -A project_code + #PBS -N your_job_name + #PBS -A your_project_code #PBS -l walltime=01:00:00 #PBS -q queue_name - #PBS -j oe #PBS -k eod #PBS -m abe #PBS -M your_email_address @@ -375,4 +382,6 @@ A sample of basic PBS job for Cheyenne: ### Run the executable mpiexec_mpt ./wrf.exe +If you named this script run_wrf_ctsm.csh, then you type next:: + qsub run_wrf_ctsm.csh From cab9c2ef15a80ebdabc14049ae6cce4b952dbdfa Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 24 Jun 2020 18:59:02 -0600 Subject: [PATCH 416/556] Support an --inputdata-path argument --- python/ctsm/lilac_build_ctsm.py | 61 +++++++++++++------ python/ctsm/test/test_sys_lilac_build_ctsm.py | 26 ++++++-- 2 files changed, 63 insertions(+), 24 deletions(-) diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index c7e47bebaf..819168c12d 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -82,7 +82,8 @@ def main(cime_path): extra_cflags=args.extra_cflags, no_pnetcdf=args.no_pnetcdf, build_debug=args.build_debug, - build_without_openmp=args.build_without_openmp) + build_without_openmp=args.build_without_openmp, + inputdata_path=args.inputdata_path) def build_ctsm(cime_path, build_dir, @@ -102,7 +103,8 @@ def build_ctsm(cime_path, extra_cflags='', no_pnetcdf=False, build_debug=False, - build_without_openmp=False): + build_without_openmp=False, + inputdata_path=None): """Implementation of build_ctsm command Args: @@ -137,11 +139,16 @@ def build_ctsm(cime_path, no_pnetcdf (bool): if True, use netcdf rather than pnetcdf build_debug (bool): if True, build with flags for debugging build_without_openmp (bool): if True, build without OpenMP support + inputdata_path (str or None): path to existing inputdata directory on this machine + If None, an inputdata directory will be created for this build + (If machine is given, then we use the machine's inputdata directory by default; + but if inputdata_path is given, it overrides the machine's inputdata directory.) """ existing_machine = machine is not None + existing_inputdata = existing_machine or inputdata_path is not None _create_build_dir(build_dir=build_dir, - existing_machine=existing_machine) + existing_inputdata=existing_inputdata) if machine is None: assert os_type is not None, 'with machine absent, os_type must be given' @@ -169,16 +176,18 @@ def build_ctsm(cime_path, compiler=compiler, machine=machine, build_debug=build_debug, - build_without_openmp=build_without_openmp) - - if existing_machine: - # For a user-defined machine, we create an inputdata directory for this case. For - # an existing cime-ported machine, we still want an inputdata directory alongside - # the other directories, but now it will just be a link to the real inputdata - # space on that machine. (Note that, for a user-defined machine, it's important - # that we have created this directory before creating the case, whereas for an - # existing machine, we need to wait until after we have created the case to know - # where to make the sym link point to.) + build_without_openmp=build_without_openmp, + inputdata_path=inputdata_path) + + if existing_inputdata: + # For a user-defined machine without inputdata_path specified, we create an + # inputdata directory for this case above. For an existing cime-ported machine, or + # one where inputdata_path is specified, we still want an inputdata directory + # alongside the other directories, but now it will just be a link to the real + # inputdata space on that machine. (Note that, for a user-defined machine, it's + # important that we have created this directory before creating the case, whereas + # for an existing machine, we need to wait until after we have created the case to + # know where to make the sym link point to.) _link_to_inputdata(build_dir=build_dir) _stage_runtime_inputs(build_dir=build_dir, no_pnetcdf=no_pnetcdf) @@ -315,6 +324,16 @@ def _commandline_args(args_to_parse=None): 'This is mainly useful if your machine/compiler does not support OpenMP.') non_rebuild_optional_list.append('build-without-openmp') + non_rebuild_optional.add_argument('--inputdata-path', + help='Path to directory containing CTSM\'s NetCDF inputs.\n' + 'For a machine that has been ported to cime, the default is to\n' + 'use this machine\'s standard inputdata location; this argument\n' + 'can be used to override this default.\n' + 'For a user-defined machine, the default is to create an inputdata\n' + 'directory in the build directory; again, this argument can be\n' + 'used to override this default.') + non_rebuild_optional_list.append('inputdata-path') + non_rebuild_optional.add_argument('--no-build', action='store_true', help='Do the pre-build setup, but do not actually build CTSM\n' '(This is useful for testing, or for expert use.)') @@ -472,19 +491,18 @@ def _get_case_dir(build_dir): """Given the path to build_dir, return the path to the case directory""" return os.path.join(build_dir, 'case') -def _create_build_dir(build_dir, existing_machine): +def _create_build_dir(build_dir, existing_inputdata): """Create the given build directory and any necessary sub-directories Args: build_dir (str): path to build directory; this directory shouldn't exist yet! - existing_machine (bool): whether this build is for a machine known to cime - (as opposed to an on-the-fly machine port) + existing_inputdata (bool): whether the inputdata directory already exists on this machine """ if os.path.exists(build_dir): abort('When running without --rebuild, the build directory must not exist yet\n' '(<{}> already exists)'.format(build_dir)) os.makedirs(build_dir) - if not existing_machine: + if not existing_inputdata: os.makedirs(os.path.join(build_dir, _INPUTDATA_DIRNAME)) def _fill_out_machine_files(build_dir, @@ -556,7 +574,8 @@ def _fill_out_machine_files(build_dir, def _create_case(cime_path, build_dir, compiler, - machine=None, build_debug=False, build_without_openmp=False): + machine=None, build_debug=False, build_without_openmp=False, + inputdata_path=None): """Create a case that can later be used to build the CTSM library and its dependencies Args: @@ -568,6 +587,8 @@ def _create_case(cime_path, build_dir, compiler, Otherwise, machine should be the name of a machine known to cime build_debug (bool): if True, build with flags for debugging build_without_openmp (bool): if True, build without OpenMP support + inputdata_path (str or None): path to existing inputdata directory on this machine + If None, we use the machine's default DIN_LOC_ROOT """ # Note that, for some commands, we want to suppress output, only showing the output if # the command fails; for these we use run_cmd_output_on_error. For other commands, @@ -597,6 +618,8 @@ def _create_case(cime_path, build_dir, compiler, '--driver', 'nuopc', '--run-unsupported'] create_newcase_cmd.extend(machine_args) + if inputdata_path: + create_newcase_cmd.extend(['--input-dir', inputdata_path]) run_cmd_output_on_error(create_newcase_cmd, errmsg='Problem creating CTSM case directory') @@ -620,7 +643,7 @@ def _create_case(cime_path, build_dir, compiler, os.path.join(build_dir, 'ctsm_build_environment.{}'.format(extension))) def _link_to_inputdata(build_dir): - """For an existing machine, make a sym link to the inputdata directory + """Make a sym link to an existing inputdata directory Args: build_dir (str): path to build directory diff --git a/python/ctsm/test/test_sys_lilac_build_ctsm.py b/python/ctsm/test/test_sys_lilac_build_ctsm.py index ed9db29c1b..f8b0447fc7 100755 --- a/python/ctsm/test/test_sys_lilac_build_ctsm.py +++ b/python/ctsm/test/test_sys_lilac_build_ctsm.py @@ -39,8 +39,9 @@ def test_buildSetup_userDefinedMachine_minimalInfo(self): This version specifies a minimal amount of information """ + build_dir = os.path.join(self._tempdir, 'ctsm_build') build_ctsm(cime_path=_CIME_PATH, - build_dir=os.path.join(self._tempdir, 'ctsm_build'), + build_dir=build_dir, compiler='gnu', no_build=True, os_type='linux', @@ -50,7 +51,13 @@ def test_buildSetup_userDefinedMachine_minimalInfo(self): gmake='gmake', gmake_j=8, no_pnetcdf=True) - # no assertions: test passes as long as the command doesn't generate any errors + # the critical piece of this test is that the above command doesn't generate any + # errors; however we also do some assertions below + + # ensure that inputdata directory was created and is NOT a sym link + inputdata = os.path.join(build_dir, 'inputdata') + self.assertTrue(os.path.isdir(inputdata)) + self.assertFalse(os.path.islink(inputdata)) def test_buildSetup_userDefinedMachine_allInfo(self): """Get through the case.setup phase with a user-defined machine @@ -61,8 +68,11 @@ def test_buildSetup_userDefinedMachine_allInfo(self): This version specifies all possible information """ + build_dir = os.path.join(self._tempdir, 'ctsm_build') + inputdata_path = os.path.realpath(os.path.join(self._tempdir, 'my_inputdata')) + os.makedirs(inputdata_path) build_ctsm(cime_path=_CIME_PATH, - build_dir=os.path.join(self._tempdir, 'ctsm_build'), + build_dir=build_dir, compiler='gnu', no_build=True, os_type='linux', @@ -77,8 +87,14 @@ def test_buildSetup_userDefinedMachine_allInfo(self): extra_fflags='-foo', extra_cflags='-bar', build_debug=True, - build_without_openmp=True) - # no assertions: test passes as long as the command doesn't generate any errors + build_without_openmp=True, + inputdata_path=os.path.join(self._tempdir, 'my_inputdata')) + # the critical piece of this test is that the above command doesn't generate any + # errors; however we also do some assertions below + + # ensure that inputdata directory is a symlink pointing to the correct location + inputdata = os.path.join(build_dir, 'inputdata') + self.assertEqual(os.path.realpath(inputdata), inputdata_path) if __name__ == '__main__': unit_testing.setup_for_tests() From a3a113ec3416f253bc6e57b7a56bfee42867ce5e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 24 Jun 2020 19:00:51 -0600 Subject: [PATCH 417/556] Fix pylint issues --- python/ctsm/lilac_download_input_data.py | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/python/ctsm/lilac_download_input_data.py b/python/ctsm/lilac_download_input_data.py index be91ca1c83..feed9e8b2c 100644 --- a/python/ctsm/lilac_download_input_data.py +++ b/python/ctsm/lilac_download_input_data.py @@ -7,7 +7,7 @@ from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args -from CIME.case import Case +from CIME.case import Case # pylint: disable=import-error logger = logging.getLogger(__name__) @@ -64,9 +64,10 @@ def _commandline_args(): parser.add_argument("--rundir", default=os.getcwd(), help="Full path of the run directory\n" - "(This directory should contain clm.input_data_list and lilac_in, among other files.)\n" - "(Note: it is assumed that this directory exists alongside the other directories\n" - "created by build_ctsm: 'case' and 'inputdata'.)") + "(This directory should contain clm.input_data_list and lilac_in,\n" + "among other files.)\n" + "(Note: it is assumed that this directory exists alongside the other\n" + "directories created by build_ctsm: 'case' and 'inputdata'.)") add_logging_args(parser) From c34340a401abdb2a626a24f8f4915baa180c6e5e Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 24 Jun 2020 19:48:11 -0600 Subject: [PATCH 418/556] Revisions addressing @billsacks review --- src/biogeochem/ch4Mod.F90 | 50 ++++++++++++++++------------- src/cpl/mct/lnd_import_export.F90 | 2 +- src/cpl/nuopc/lnd_import_export.F90 | 2 +- src/main/lnd2atmMod.F90 | 9 ------ src/main/lnd2atmType.F90 | 8 ++--- 5 files changed, 33 insertions(+), 38 deletions(-) diff --git a/src/biogeochem/ch4Mod.F90 b/src/biogeochem/ch4Mod.F90 index b833ec4c76..2432b85cf4 100644 --- a/src/biogeochem/ch4Mod.F90 +++ b/src/biogeochem/ch4Mod.F90 @@ -190,7 +190,7 @@ module ch4Mod ! false. This could be a scalar, but scalars cause problems with threading, so we use ! a column-level array (column-level for convenience, because it is referenced in ! column-level loops). - logical , pointer, private :: ch4_first_time_col (:) ! col whether this is the first time step that includes ch4 + logical , pointer, private :: ch4_first_time_grc (:) ! grc whether this is the first time step that includes ch4 ! real(r8), pointer, public :: finundated_col (:) ! col fractional inundated area (excluding dedicated wetland cols) real(r8), pointer, public :: finundated_pre_snow_col (:) ! col fractional inundated area (excluding dedicated wetland cols) before snow @@ -201,7 +201,6 @@ module ch4Mod real(r8), pointer, public :: o2_decomp_depth_sat_col (:,:) ! col O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) real(r8), pointer, public :: o2_decomp_depth_unsat_col (:,:) ! col O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) real(r8), pointer, public :: ch4_surf_flux_tot_col (:) ! col CH4 surface flux (to atm) (kg C/m**2/s) - real(r8), pointer, public :: ch4_surf_flux_tot_grc (:) ! grc CH4 surface flux (to atm) (kg C/m**2/s) real(r8), pointer, public :: grnd_ch4_cond_patch (:) ! patch tracer conductance for boundary layer [m/s] real(r8), pointer, public :: grnd_ch4_cond_col (:) ! col tracer conductance for boundary layer [m/s] @@ -322,7 +321,6 @@ subroutine InitAllocate(this, bounds) allocate(this%layer_sat_lag_col (begc:endc,1:nlevgrnd)) ; this%layer_sat_lag_col (:,:) = nan allocate(this%pH_col (begc:endc)) ; this%pH_col (:) = nan allocate(this%ch4_surf_flux_tot_col (begc:endc)) ; this%ch4_surf_flux_tot_col (:) = nan - allocate(this%ch4_surf_flux_tot_grc (begg:endg)) ; this%ch4_surf_flux_tot_grc (:) = nan allocate(this%dyn_ch4bal_adjustments_col (begc:endc)) ; this%dyn_ch4bal_adjustments_col (:) = nan allocate(this%c_atm_grc (begg:endg,1:ngases)) ; this%c_atm_grc (:,:) = nan @@ -334,7 +332,7 @@ subroutine InitAllocate(this, bounds) allocate(this%annavg_agnpp_patch (begp:endp)) ; this%annavg_agnpp_patch (:) = spval ! To detect first year allocate(this%annavg_bgnpp_patch (begp:endp)) ; this%annavg_bgnpp_patch (:) = spval ! To detect first year - allocate(this%ch4_first_time_col (begc:endc)) ; this%ch4_first_time_col (:) = .true. + allocate(this%ch4_first_time_grc (begg:endg)) ; this%ch4_first_time_grc (:) = .true. allocate(this%finundated_col (begc:endc)) ; this%finundated_col (:) = nan allocate(this%finundated_pre_snow_col (begc:endc)) ; this%finundated_pre_snow_col (:) = nan @@ -1150,7 +1148,7 @@ subroutine Restart( this, bounds, ncid, flag ) ! restart file based on whether FINUNDATED is present on the restart file. We ! could use any methane variable, but FINUNDATED is a good choice because this ! "first time" variable is used in connection with FINUNDATED. - this%ch4_first_time_col(bounds%begc:bounds%endc) = .false. + this%ch4_first_time_grc(bounds%begg:bounds%endg) = .false. ! BACKWARDS_COMPATIBILITY(wjs, 2016-02-11) The following is needed for backwards ! compatibility with restart files generated from older versions of the code, where @@ -1585,12 +1583,17 @@ subroutine ch4_init_gridcell_balance_check(bounds, num_nolakec, & ! ! !LOCAL VARIABLES: + integer :: begc, endc, begg, endg + real(r8), allocatable :: totcolch4_bef_col(:) ! col total methane found in soil col, start of timestep (g C / m^2) NB: this variable appears with the same name in ch4_type but the one here is local and for temporary use character(len=*), parameter :: subname = 'ch4_init_gridcell_balance_check' !----------------------------------------------------------------------- - ! Initialize to zero for columns outside the filters because will - ! average up to gridcell - ch4_inst%totcolch4_bef_col(bounds%begc:bounds%endc) = 0._r8 + begc = bounds%begc + endc = bounds%endc + begg = bounds%begg + endg = bounds%endg + + allocate(totcolch4_bef_col(begc:endc)) ! This is only really needed for soilc and lakec, but we use nolakec rather ! than just soilc for consistency with the other call to ch4_totcolch4 @@ -1598,13 +1601,15 @@ subroutine ch4_init_gridcell_balance_check(bounds, num_nolakec, & ! purposes). call ch4_totcolch4(bounds, num_nolakec, filter_nolakec, num_lakec, & filter_lakec, ch4_inst, & - ch4_inst%totcolch4_bef_col(bounds%begc:bounds%endc)) + totcolch4_bef_col(begc:endc)) call c2g( bounds, & - ch4_inst%totcolch4_bef_col(bounds%begc:bounds%endc), & - ch4_inst%totcolch4_bef_grc(bounds%begg:bounds%endg), & + totcolch4_bef_col(begc:endc), & + ch4_inst%totcolch4_bef_grc(begg:endg), & c2l_scale_type= 'unity', l2g_scale_type='unity' ) + deallocate(totcolch4_bef_col) + end subroutine ch4_init_gridcell_balance_check !----------------------------------------------------------------------- @@ -1782,7 +1787,7 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & totcolch4_grc => ch4_inst%totcolch4_grc , & ! Output: [real(r8) (:) ] gridcell-level total methane in soil column (g C / m^2) finundated => ch4_inst%finundated_col , & ! Output: [real(r8) (:) ] fractional inundated area in soil column (excluding dedicated wetland columns) finundated_pre_snow => ch4_inst%finundated_pre_snow_col , & ! Output: [real(r8) (:) ] fractional inundated area in soil column (excluding dedicated wetland columns) before snow - ch4_first_time_col => ch4_inst%ch4_first_time_col , & ! Output: [logical (:) ] col whether this is the first time step that includes ch4 + ch4_first_time_grc => ch4_inst%ch4_first_time_grc , & ! Output: [logical (:) ] grc whether this is the first time step that includes ch4 qflx_surf_lag => ch4_inst%qflx_surf_lag_col , & ! Output: [real(r8) (:) ] time-lagged surface runoff (mm H2O /s) finundated_lag => ch4_inst%finundated_lag_col , & ! Output: [real(r8) (:) ] time-lagged fractional inundated area layer_sat_lag => ch4_inst%layer_sat_lag_col , & ! Output: [real(r8) (:,:) ] Lagged saturation status of soil layer in the unsaturated zone (1 = sat) @@ -1790,7 +1795,7 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & ch4co2f => ch4_inst%ch4co2f_grc , & ! Output: [real(r8) (:) ] gridcell CO2 production from CH4 oxidation (g C/m**2/s) ch4prodg => ch4_inst%ch4prodg_grc , & ! Output: [real(r8) (:) ] gridcell average CH4 production (g C/m^2/s) ch4_surf_flux_tot_col => ch4_inst%ch4_surf_flux_tot_col , & ! Output: [real(r8) (:) ] col CH4 flux to atm. (kg C/m**2/s) - ch4_surf_flux_tot_grc => ch4_inst%ch4_surf_flux_tot_grc , & ! Output: [real(r8) (:) ] grc CH4 flux to atm. (kg C/m**2/s) + ch4_surf_flux_tot_grc => lnd2atm_inst%ch4_surf_flux_tot_grc , & ! Output: [real(r8) (:) ] grc CH4 flux to atm. (kg C/m**2/s) nem_grc => lnd2atm_inst%nem_grc , & ! Output: [real(r8) (:) ] gridcell average net methane correction to CO2 flux (g C/m^2/s) @@ -1826,10 +1831,6 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & ! Adjustment to NEE for methane production - oxidation nem_col(begc:endc) = 0._r8 - ! Initialize to zero for columns outside the filters because will - ! average up to gridcell - totcolch4_col(begc:endc) = 0._r8 - do g= begg, endg if (ch4offline) then forc_pch4(g) = atmch4*forc_pbot(g) @@ -1908,7 +1909,8 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & ch4_dfsat_flux(c) = 0._r8 end if - if (.not. ch4_first_time_col(c)) then + g = col%gridcell(c) + if (.not. ch4_first_time_grc(g)) then if (finundated(c) > fsat_bef(c)) then !Reduce conc_ch4_sat dfsat = finundated(c) - fsat_bef(c) conc_ch4_sat(c,j) = (fsat_bef(c)*conc_ch4_sat(c,j) + dfsat*conc_ch4_unsat(c,j)) / finundated(c) @@ -2210,8 +2212,9 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & do fc = 1, num_soilc c = filter_soilc(fc) + g = col%gridcell(c) - if (.not. ch4_first_time_col(c)) then + if (.not. ch4_first_time_grc(g)) then ! Check balance errch4 = totcolch4_col(c) - totcolch4_bef_col(c) & - dtime*(ch4_prod_tot(c) - ch4_oxid_tot(c) & @@ -2219,7 +2222,6 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & if (abs(errch4) > 1.e-7_r8) then ! g C / m^2 / timestep write(iulog,*)'Column-level CH4 Conservation Error in CH4Mod driver, nstep, c, errch4 (gC /m^2.timestep)', & nstep,c,errch4 - g = col%gridcell(c) write(iulog,*)'Latdeg,Londeg,col%itype=',grc%latdeg(g),grc%londeg(g),col%itype(c) write(iulog,*)'totcolch4_col = ', totcolch4_col(c) write(iulog,*)'totcolch4_bef_col = ', totcolch4_bef_col(c) @@ -2235,8 +2237,9 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & if (allowlakeprod) then do fc = 1, num_lakec c = filter_lakec(fc) + g = col%gridcell(c) - if (.not. ch4_first_time_col(c)) then + if (.not. ch4_first_time_grc(g)) then ! Check balance errch4 = totcolch4_col(c) - totcolch4_bef_col(c) & - dtime*(ch4_prod_tot(c) - ch4_oxid_tot(c) & @@ -2244,7 +2247,6 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & if (abs(errch4) > 1.e-7_r8) then ! g C / m^2 / timestep write(iulog,*)'Column-level CH4 Conservation Error in CH4Mod driver for lake column, nstep, c, errch4 (gC/m^2.timestep)', & nstep,c,errch4 - g = col%gridcell(c) write(iulog,*)'Latdeg,Londeg=',grc%latdeg(g),grc%londeg(g) write(iulog,*)'totcolch4_col = ', totcolch4_col(c) write(iulog,*)'totcolch4_bef_col = ', totcolch4_bef_col(c) @@ -2285,6 +2287,7 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & ! Gricell level balance do g = begg, endg + if (.not. ch4_first_time_grc(g)) then ! Check balance errch4 = totcolch4_grc(g) - totcolch4_bef_grc(g) + dtime * & (nem_grc(g) + ch4_surf_flux_tot_grc(g) * 1000._r8) ! kg C --> g C @@ -2299,9 +2302,10 @@ subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, & write(iulog,*)'dtime * ch4_surf_flux_tot * 1000 =', dtime * ch4_surf_flux_tot_grc(g) * 1000._r8 call endrun(msg=' ERROR: Methane conservation error'//errMsg(sourcefile, __LINE__)) end if + end if end do - ch4_first_time_col(begc:endc) = .false. + ch4_first_time_grc(begg:endg) = .false. end associate diff --git a/src/cpl/mct/lnd_import_export.F90 b/src/cpl/mct/lnd_import_export.F90 index a3e1010730..b93379979a 100644 --- a/src/cpl/mct/lnd_import_export.F90 +++ b/src/cpl/mct/lnd_import_export.F90 @@ -378,7 +378,7 @@ subroutine lnd_export( bounds, waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst end if if (index_l2x_Fall_methane /= 0) then - l2x(index_l2x_Fall_methane,i) = -lnd2atm_inst%flux_ch4_grc(g) + l2x(index_l2x_Fall_methane,i) = -lnd2atm_inst%ch4_surf_flux_tot_grc(g) endif ! sign convention is positive downward with diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 0838b7a00a..396ecaf344 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -859,7 +859,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & minus=.true., ungridded_index=4, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_methane', bounds, input=lnd2atm_inst%flux_ch4_grc, minus=.true., rc=rc) + call state_setexport(exportState, 'Fall_methane', bounds, input=lnd2atm_inst%ch4_surf_flux_tot_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_setexport(exportState, 'Sl_ram1', bounds, input=lnd2atm_inst%ram1_grc, rc=rc) diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90 index acb0f5cfff..2fbea9433a 100644 --- a/src/main/lnd2atmMod.F90 +++ b/src/main/lnd2atmMod.F90 @@ -328,15 +328,6 @@ subroutine lnd2atm(bounds, & lnd2atm_inst%flxdst_grc (bounds%begg:bounds%endg, :), & p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') - - ! ch4 flux - if (use_lch4) then - call c2g( bounds, & - ch4_inst%ch4_surf_flux_tot_col (bounds%begc:bounds%endc), & - lnd2atm_inst%flux_ch4_grc (bounds%begg:bounds%endg), & - c2l_scale_type= 'unity', l2g_scale_type='unity' ) - end if - !---------------------------------------------------- ! lnd -> rof !---------------------------------------------------- diff --git a/src/main/lnd2atmType.F90 b/src/main/lnd2atmType.F90 index 509a8afaf2..a0e8623018 100644 --- a/src/main/lnd2atmType.F90 +++ b/src/main/lnd2atmType.F90 @@ -56,7 +56,7 @@ module lnd2atmType real(r8), pointer :: flxvoc_grc (:,:) => null() ! VOC flux (size bins) real(r8), pointer :: fireflx_grc (:,:) => null() ! Wild Fire Emissions real(r8), pointer :: fireztop_grc (:) => null() ! Wild Fire Emissions vertical distribution top - real(r8), pointer :: flux_ch4_grc (:) => null() ! net CH4 flux (kg C/m**2/s) [+ to atm] + real(r8), pointer :: ch4_surf_flux_tot_grc(:) => null() ! net CH4 flux (kg C/m**2/s) [+ to atm] ! lnd->rof contains @@ -150,7 +150,7 @@ subroutine InitAllocate(this, bounds) allocate(this%ram1_grc (begg:endg)) ; this%ram1_grc (:) =ival allocate(this%fv_grc (begg:endg)) ; this%fv_grc (:) =ival allocate(this%flxdst_grc (begg:endg,1:ndst)) ; this%flxdst_grc (:,:) =ival - allocate(this%flux_ch4_grc (begg:endg)) ; this%flux_ch4_grc (:) =ival + allocate(this%ch4_surf_flux_tot_grc(begg:endg)) ; this%ch4_surf_flux_tot_grc(:) =ival if (shr_megan_mechcomps_n>0) then allocate(this%flxvoc_grc(begg:endg,1:shr_megan_mechcomps_n)); this%flxvoc_grc(:,:)=ival @@ -269,10 +269,10 @@ subroutine InitHistory(this, bounds) default='inactive') if (use_lch4) then - this%flux_ch4_grc(begg:endg) = 0._r8 + this%ch4_surf_flux_tot_grc(begg:endg) = 0._r8 call hist_addfld1d (fname='FCH4', units='kgC/m2/s', & avgflag='A', long_name='Gridcell surface CH4 flux to atmosphere (+ to atm)', & - ptr_lnd=this%flux_ch4_grc) + ptr_lnd=this%ch4_surf_flux_tot_grc) this%nem_grc(begg:endg) = spval call hist_addfld1d (fname='NEM', units='gC/m2/s', & From 4e54ff2484f5d4c99ee3987c5b6fbd466a9f8f8d Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 25 Jun 2020 11:41:41 -0600 Subject: [PATCH 419/556] Document high-level overview of workflow for lilac runtime inputs --- .../ctsm_lilac_runtime_file_workflow.svg | 3 ++ .../obtaining-and-building-ctsm.rst | 4 +- .../setting-ctsm-runtime-options.rst | 47 ++++++++++++++++--- python/ctsm/lilac_download_input_data.py | 2 + 4 files changed, 48 insertions(+), 8 deletions(-) create mode 100644 doc/source/lilac/obtaining-building-and-running/ctsm_lilac_runtime_file_workflow.svg diff --git a/doc/source/lilac/obtaining-building-and-running/ctsm_lilac_runtime_file_workflow.svg b/doc/source/lilac/obtaining-building-and-running/ctsm_lilac_runtime_file_workflow.svg new file mode 100644 index 0000000000..8cf2328574 --- /dev/null +++ b/doc/source/lilac/obtaining-building-and-running/ctsm_lilac_runtime_file_workflow.svg @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:b2f85366f00add2d836424009cec66fb5174a5ee90b49acd4cded0a846fb8583 +size 17178 diff --git a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst index 9d12c91cb7..d627ddab1e 100644 --- a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst +++ b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst @@ -1,7 +1,7 @@ -.. _obtaining-and-building-ctsm: - .. highlight:: shell +.. _obtaining-and-building-ctsm: + ======================================= Obtaining and building CTSM and LILAC ======================================= diff --git a/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst index 6d5967f625..a663b58773 100644 --- a/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst +++ b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst @@ -1,13 +1,13 @@ -.. _setting-ctsm-runtime-options: - .. highlight:: shell +.. _setting-ctsm-runtime-options: + ============================== Setting CTSM runtime options ============================== -Overview -======== +Overview and quick start +======================== This section describes the process for creating the runtime input text files for CTSM and LILAC. These files, which are in Fortran namelist format, have hard-coded file @@ -22,7 +22,42 @@ model is run: .. note:: - There are a number of other runtime input files to both CTSM and LILAC, in NetCDF - format. The paths to these other files are specified in either ``lnd_in`` or + There are a number of other required runtime input files to both CTSM and LILAC, in + NetCDF format. The paths to these other files are specified in either ``lnd_in`` or ``lilac_in``. +The basic process for creating the necessary input files is the following; this process is +also illustrated in :numref:`Figure ctsm_lilac_runtime_file_workflow`: + +#. Run the ``build_ctsm`` script described in section + :numref:`obtaining-and-building-ctsm`. In addition to building CTSM, this also stages + the necessary files in the ``runtime_inputs`` subdirectory of your specified build + directory. Then ``cd`` to this ``runtime_inputs`` subdirectory to do the following + steps (it is fine to do these steps even while CTSM is still building). + +#. Modify the ``ctsm.cfg`` file to set high-level options to CTSM. (A few options need to + be set; most can be left at their default values or changed if desired.) Optionally, + also set specific namelist values in ``user_nl_ctsm``. + +#. Run the script, ``make_runtime_inputs``. (This creates the files ``lnd_in`` and + ``clm.input_data_list``.) + +#. Modify ``lilac_in`` as needed. (Typically you will only need to set values for + ``atm_mesh_filename`` and ``lnd_mesh_filename``; other variables can typically be kept + at their default values.) + +#. Run the script, ``download_input_data`` to download any of CTSM's standard input files + that are needed based on settings in ``lnd_in`` and ``lilac_in``. (This step may be + unnecessary if all of the needed input data already exists. However, it doesn't hurt to + run it in this case.) + +#. Copy ``lnd_in``, ``lnd_modelio.nml`` and ``lilac_in`` to the directory from which you + will be running the model. + +.. _Figure ctsm_lilac_runtime_file_workflow: + +.. figure:: ctsm_lilac_runtime_file_workflow.* + + CTSM/LILAC runtime file workflow. Files in black can be (and in some cases must be) + edited before running the next step. Files in blue should **not** be edited directly. + diff --git a/python/ctsm/lilac_download_input_data.py b/python/ctsm/lilac_download_input_data.py index feed9e8b2c..8d7482d6c6 100644 --- a/python/ctsm/lilac_download_input_data.py +++ b/python/ctsm/lilac_download_input_data.py @@ -84,3 +84,5 @@ def _create_lilac_input_data_list(rundir): line = line.replace('"', '') line = line.replace("'", "") input_data_list.write(line) + + os.remove(os.path.join(rundir, 'lilac.input_data_list')) From 87b36b53177893008b119e0d91dd6c35f2f8d046 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 11 Jun 2020 13:14:41 -0600 Subject: [PATCH 420/556] Minor rework of lilacsmoke test Get it passing on my mac (needs --build-without-openmp) and a bit of refactoring --- cime_config/SystemTests/lilacsmoke.py | 43 ++++++++++++++++++--------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index 15f9eb908b..946b439707 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -27,7 +27,6 @@ def build_phase(self, sharedlib_only=False, model_only=False): exeroot = self._case.get_value('EXEROOT') build_dir = os.path.join(caseroot, 'lilac_build') script_path = os.path.abspath(os.path.join(lndroot, 'lilac', 'build_ctsm')) - logs = [] # We only run the initial build command if the build_dir doesn't exist # yet. This is to support rebuilding the test case. (The first time through, @@ -37,6 +36,10 @@ def build_phase(self, sharedlib_only=False, model_only=False): machine = self._case.get_value('MACH') compiler = self._case.get_value('COMPILER') debug = self._case.get_value('DEBUG') + # It would be possible to do this testing via the python interface rather + # than through a separate subprocess. However, we do it through a + # subprocess in order to test the full build_ctsm script, including + # command-line parsing. cmd = '{script_path} {build_dir} --machine {machine} --compiler {compiler}'.format( script_path=script_path, build_dir=build_dir, @@ -44,12 +47,11 @@ def build_phase(self, sharedlib_only=False, model_only=False): compiler=compiler) if debug: cmd += ' --build-debug' - append_testlog(cmd) - run_cmd_no_fail(cmd, arg_stdout='build_ctsm.bldlog', combine_output=True, from_dir=exeroot) - logfile = os.path.join(exeroot, 'build_ctsm.bldlog') - logs.append(logfile) - with open(logfile) as lf: - append_testlog(lf.read()) + # For now, always build this test without threads: it doesn't need + # threads, and building unthreaded ensures that it works on a wider range + # of machines/compilers + cmd += ' --build-without-openmp' + self._run_build_cmd(cmd, exeroot, 'build_ctsm.bldlog') # We call the build script with --rebuild even for an initial build. This is # so we make sure to test the code path for --rebuild. (This is also needed if @@ -58,15 +60,28 @@ def build_phase(self, sharedlib_only=False, model_only=False): cmd = '{script_path} {build_dir} --rebuild'.format( script_path=script_path, build_dir=build_dir) - append_testlog(cmd) - run_cmd_no_fail(cmd, arg_stdout='rebuild_ctsm.bldlog', combine_output=True, from_dir=exeroot) - logfile = os.path.join(exeroot, 'rebuild_ctsm.bldlog') - logs.append(logfile) - with open(logfile) as lf: - append_testlog(lf.read()) + self._run_build_cmd(cmd, exeroot, 'rebuild_ctsm.bldlog') - post_build(self._case, logs, build_complete=True) + # Setting logs=[] implies that we don't bother gzipping any of the build log + # files; that seems fine for these purposes (and it keeps the above code + # simpler). + post_build(self._case, logs=[], build_complete=True) def run_phase(self): # FIXME(wjs, 2020-06-10) Fill this in pass + + @staticmethod + def _run_build_cmd(cmd, exeroot, logfile): + """ + Runs the given build command, with output to the given logfile + + Args: + cmd: str (command to run) + exeroot: str (path to exeroot) + logfile: str (path to logfile) + """ + append_testlog(cmd) + run_cmd_no_fail(cmd, arg_stdout=logfile, combine_output=True, from_dir=exeroot) + with open(os.path.join(exeroot, logfile)) as lf: + append_testlog(lf.read()) From 0528b5fd11990a7c73898cdb3be90fe082dd3a84 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 25 Jun 2020 12:10:21 -0600 Subject: [PATCH 421/556] Minor image tweaks --- .../ctsm_lilac_runtime_file_workflow.svg | 4 ++-- .../setting-ctsm-runtime-options.rst | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/doc/source/lilac/obtaining-building-and-running/ctsm_lilac_runtime_file_workflow.svg b/doc/source/lilac/obtaining-building-and-running/ctsm_lilac_runtime_file_workflow.svg index 8cf2328574..a0d2cf6d07 100644 --- a/doc/source/lilac/obtaining-building-and-running/ctsm_lilac_runtime_file_workflow.svg +++ b/doc/source/lilac/obtaining-building-and-running/ctsm_lilac_runtime_file_workflow.svg @@ -1,3 +1,3 @@ version https://git-lfs.github.com/spec/v1 -oid sha256:b2f85366f00add2d836424009cec66fb5174a5ee90b49acd4cded0a846fb8583 -size 17178 +oid sha256:3d86cfb661a03c99574ec626db8be97d8875884f1c3879db9cab935bd0dee7a7 +size 17275 diff --git a/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst index a663b58773..d2b3a683d0 100644 --- a/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst +++ b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst @@ -58,6 +58,7 @@ also illustrated in :numref:`Figure ctsm_lilac_runtime_file_workflow`: .. figure:: ctsm_lilac_runtime_file_workflow.* - CTSM/LILAC runtime file workflow. Files in black can be (and in some cases must be) - edited before running the next step. Files in blue should **not** be edited directly. + CTSM/LILAC runtime file workflow. Files in blue can be (and in some cases must be) + edited before running the next step. Files in purple (with italicized names) should + **not** be edited directly. From 3b1e861c2a580ae6fc145339f61ff36971137dba Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 26 Jun 2020 01:32:18 -0600 Subject: [PATCH 422/556] Update change files --- doc/ChangeLog | 132 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 133 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 0326609823..6f3183ed94 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,136 @@ =============================================================== +Tag name: ctsm1.0.dev102 +Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Fri Jun 26 01:32:04 MDT 2020 +One-line Summary: Some important fixes for LUNA in clm5_0, and small urban issue in clm5_0 + +Purpose of changes +------------------ + +Fix some important issues that were found in LUNA for the arctic. These changes were large enough +that we had to re-tune the clm5_0 parameters to give a similar simulation. Leah Birch noticed +that the formulations in the code disagreed with the paper. Correcting this caused arctic plants +to be less productive. In order to compensate parameters for leafcn, and slatop were adjusted for +broadleaf_deciduous_boreal_shrub and c3_arctic_grass for clm5_0. + +The total vegetation carbon threshold on exit_spinup (from accelerated decomposition (AD) mode) was +increased from 0.1 to 1.0. Without this change some PFT's can die out in exit spinup even when +they have significant carbon stores from the AD spinup mode. + +There is an implicit assumption in the urban building energy model that building width equals +street width. However, this assumption can/should be relaxed and building width can be derived +from the morphology dataset. + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): #738 #803 #953 #958 #1056 + Fixes #1056 -- Remove allpfts dimension + Fixes #953 -- Incorrect formula in LUNA uses day time rather than average of day/night + Fixes #958 -- LUNA day length factor missing + Fixes #738 -- Totvegc threshold increased from 0.1 to 1. + Fixes #803 -- No longer assume building width + +Known bugs introduced in this tag (include github issue ID): #1060 + #1060 -- Some code cleanup of luna bug fixes + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[x] clm5_0 + +[x] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): clm5_0 climate adjusted for arctic plants + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): none + +Changes made to namelist defaults (e.g., changed parameter values): + +Changes to the datasets (e.g., parameter, surface or initial files): New parameter files + +Substantial timing or memory changes: None + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): We + chose some bad names for variables, so we'll clean this up in a seperate step (see #1060) + +Changes to tests or testing: None + +Code reviewed by: self, olyson, bill-sacks, wweider + + +CTSM testing: regular + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - PASS (266 compare differently because of update in paramsfile and jmaxb1) + + python testing (see instructions in python/README.md; document testing done): + + cheyenne - PASS + + regular tests (aux_clm): + + cheyenne ---- PASS + izumi ------- PASS + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: Yes for clm5_0 + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: clm5_0 when Luna on as well as smaller changes for urban + - what platforms/compilers: all + - nature of change: climate changing, but tuned to respond similar to clm5.0 + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + luna changes: oleson case clm50_ctsm10d089_2deg_GSWP3V1_luna3_jmaxb1-0.17_slatopA_leafcnA_hist + + URL for LMWG diagnostics output used to validate new climate: + + urban changes: + + +http://webext.cgd.ucar.edu/I2000/clm50_ctsm10d098_1deg_GSWP3V1_CON_FIXBUILDENERGY_2000/lnd/clm50_ctsm10d098_1deg_GSWP3V1_CON_FIXBUILDENERGY_2000.1991_2010-clm50_ctsm10d098_1deg_GSWP3V1_CON_2000.1991_2010/setsIndex.html + + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): None + +Pull Requests that document the changes (include PR ids): #1034 and #962 +(https://github.com/ESCOMP/ctsm/pull) + #1034 -- Building energy fix + #962 --- Fixes for the LUNA dayl bugs + +=============================================================== +=============================================================== Tag name: ctsm1.0.dev101 Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326), oleson (Keith Oleson) Date: Wed Jun 17 23:51:22 MDT 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index 23793cf1c4..655832d263 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm1.0.dev102 erik/ole 06/26/2020 Some important fixes for LUNA in clm5_0, and small urban issue in clm5_0 ctsm1.0.dev101 ole/erik 06/17/2020 Changes from Keith to bring a list of variables to the parameter file ctsm1.0.dev100 sacks 06/09/2020 Deallocate memory after running init_interp ctsm1.0.dev099 sacks 06/08/2020 Update cime, needed for izumi machine updates From cf05a2c9554ff4adf7624634c43f5495e1d40bd1 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 26 Jun 2020 05:32:31 -0600 Subject: [PATCH 423/556] work on documentation --- .../setting-ctsm-runtime-options.rst | 164 ++++++++++++++++++ doc/source/lilac/specific-atm-models/wrf.rst | 2 + lilac/bld_templates/ctsm_template.cfg | 16 ++ 3 files changed, 182 insertions(+) diff --git a/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst index d2b3a683d0..a053976e3e 100644 --- a/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst +++ b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst @@ -62,3 +62,167 @@ also illustrated in :numref:`Figure ctsm_lilac_runtime_file_workflow`: edited before running the next step. Files in purple (with italicized names) should **not** be edited directly. +More details on these steps are given in the following subsections. + +Creating initial runtime inputs with build_ctsm +=============================================== + +The ``build_ctsm`` script, which is described in detail in section +:numref:`obtaining-and-building-ctsm`, creates initial runtime input files in addition to +building the model. This script creates a number of files in the ``runtime_inputs`` +subdirectory of the specified build directory. For a few variables in these runtime input +files, ``build_ctsm`` sets initial values based on options provided to this +script. Important options for these runtime inputs include ``--no-pnetcdf``, +``--inputdata-path`` and ``--max-mpitasks-per-node``. (Run ``build_ctsm`` with the ``-h`` +or ``--help`` option for more information.) + +Once this script creates and populates the ``runtime_inputs`` subdirectory, it is safe to +proceed with the following steps, even if CTSM has not finished building. + +For the following steps, you should ``cd`` to this ``runtime_inputs`` subdirectory. + +Modifying ctsm.cfg and user_nl_ctsm +=================================== + +CTSM has hundreds of runtime parameters. Most of these parameters can be set individually, +but in many cases it makes more sense to think in terms of high-level options. These +high-level options set groups of parameters, creating configurations that the core CTSM +developers feel are useful - and these standard configurations are generally tested both +from a scientific and software perspective. + +The two text files, ``ctsm.cfg`` and ``user_nl_ctsm``, together with CTSM's scripting +infrastructure and XML database controlled by the ``make_runtime_inputs`` script, work +together to allow you to configure CTSM's runtime parameters at both a high level and +individually. + +ctsm.cfg +-------- + +``ctsm.cfg`` controls high-level options that, in many cases, set the default values for +multiple individual runtime parameters. All of the available high-level options appear in +this file; you can change the values of variables, but cannot add or remove any variables +in this file. + +The first set of options in this file specifies key file names: + +- ``lnd_domain_file`` must be specified. This file specifies CTSM's grid and land + mask. The general process for creating this file is described in section + :numref:`creating-domain-files`. + +- ``fsurdat`` also must be specified. This file specifies a variety of spatially-varying + properties. This file is grid-specific, but can be created from grid-independent files + using CTSM's toolchain described in section :numref:`creating-surface-datasets`. + +- ``finidat`` should generally be specified, although it's not absolutely essential. This + file specifies CTSM's initial conditions. If this isn't specified, the model will use a + standard set of initial conditions, interpolated to your grid. However, particularly for + NWP / prediction applications, you will typically want a customized initial condition + file. The process for generating this file will depend on your atmosphere model and + workflow, but an example for WRF is given in section + :numref:`wrf-create-input-namelists-for-ctsm-and-lilac`. + +The remainder of this file specifies a variety of high-level options, each of which sets +the default values for a number of CTSM's runtime parameters. The default values should be +reasonable starting points, but you may want to configure these. Details on these options +and allowed values are given in comments in ``ctsm.cfg``. + +user_nl_ctsm +------------ + +This file allows you to override individual CTSM namelist variables. This includes +variables whose default values are set based on settings in ``ctsm.cfg`` and others. The +file is initially populated with some settings controlling CTSM's diagnostic (history) +file output. These pre-populated settings can be changed, and additional settings can be +added to this file. + +There is some documentation of these settings in section :numref:`customizing-a-case`, and +in the `CESM release documentation +`_, but note that +the latter is slightly out of date with respect to the latest version of CTSM. An easy way +to see the list of available variables is to run ``make_runtime_inputs`` in order to +generate an initial ``lnd_in`` file; most of the variables given in that file can be +specified in ``user_nl_ctsm``, and then ``make_runtime_inputs`` can be rerun. **As noted +below, it is better NOT to edit the** ``lnd_in`` **file directly, instead using the +workflow documented here.** + +Running make_runtime_inputs +=========================== + +Once you have made the modifications you want to ``ctsm.cfg`` and ``user_nl_ctsm``, run +the script ``make_runtime_inputs`` from the ``runtime_inputs`` directory. This takes +``ctsm.cfg`` and ``user_nl_ctsm`` as inputs, and generates two output files: ``lnd_in`` +and ``clm.input_data_list``. ``lnd_in`` will be read by CTSM. ``clm.input_data_list`` is +an automatic extraction of a subset of ``lnd_in`` specifying the paths of various other +input files that will be needed by CTSM; this is used by the ``download_input_data`` +script to automatically download the relevant files. + +It is safe to rerun ``make_runtime_inputs`` as often as you want, incrementally changing +``ctsm.cfg`` and/or ``user_nl_ctsm``. + +.. important:: + + We recommend that you do NOT modify ``lnd_in`` directly. Instead, to make changes to + the ``lnd_in`` file, you should modify ``user_nl_ctsm`` and rerun + ``make_runtime_inputs``. There are a few reasons for following this workflow: + + - Hand edits to ``lnd_in`` will be lost if you later rerun ``make_runtime_inputs``, + whereas edits to ``user_nl_ctsm`` will be maintained. + + - ``make_runtime_inputs`` performs various validations of the contents of + ``user_nl_ctsm``; these validations would be bypassed if you edited ``lnd_in`` + directly. + + - If you change any file paths, ``make_runtime_inputs`` will ensure that + ``clm.input_data_list`` remains in sync with ``lnd_in``. + +Modifying lilac_in +================== + +Unlike ``lnd_in``, the ``lilac_in`` file can be hand-edited. Most of the settings in this +file can be left at their default values, but there are two variables whose values you +must set (as indicated by their default values, ``FILL_THIS_IN``): + +- ``atm_mesh_filename``: This should specify the path to an ESMF mesh file describing the + atmosphere model's grid. + +- ``lnd_mesh_filename``: This should specify the path to an ESMF mesh file describing the + land model's grid. If the land model is running on the same grid as the atmosphere + model (which is typical), this can be the same file as ``atm_mesh_filename``. + +Other settings you may want to change are: + +- Settings in ``lilac_history_input``: ``lilac_histfreq_option`` and + ``lilac_histfreq_n``. Together, these specify the output frequency from LILAC + itself. Note that this is separate from CTSM's output: LILAC's output contains + instantaneous snapshots of the fields passed from the atmosphere to CTSM and vice + versa, whereas CTSM's output is much more extensive. For many purposes, it's fine to + leave LILAC's output turned off (as is the default). Allowable options for + ``lilac_histfreq_option`` are ``never``, ``nsteps``, ``nseconds``, ``nminutes``, + ``nhours``, ``ndays``, ``nmonths`` and ``nyears``. + +- Settings in ``atmaero_stream``: These specify a dataset containing atmospheric aerosols, + for the (typical) case where the atmosphere model is not sending these aerosols itself. + +Running download_input_data +=========================== + +CTSM requires a variety of runtime input files in NetCDF format. These files are listed in +the ``lnd_in`` file, and are consolidated in the file ``clm.input_data_list`` (which is +produced by ``make_runtime_inputs``). In addition, a few other NetCDF files are listed in +``lilac_in``, of which the file listed in ``atmaero_stream`` is typically a standard input +file (as opposed to one that you, the user, has provided). + +**Idea of inputdata directory... this can be a symlink, or it can be an actual directory, +depending on how build_ctsm was run.** + +**As a convenience, can run download_input_data.** + +**There will likely be errors about some files not being able to be obtained, particularly +for user-provided files.** + +Copying the necessary files to the model's run directory +======================================================== + +.. todo:: + + TODO: Fill this section in diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 8cae475d42..460c017f36 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -278,6 +278,8 @@ Check the last line of the real log file for the following message:: SUCCESS COMPLETE REAL_EM INIT +.. _wrf-create-input-namelists-for-ctsm-and-lilac: + Create input namelists for CTSM and LILAC ========================================= diff --git a/lilac/bld_templates/ctsm_template.cfg b/lilac/bld_templates/ctsm_template.cfg index be485c9708..dfe57e24f6 100644 --- a/lilac/bld_templates/ctsm_template.cfg +++ b/lilac/bld_templates/ctsm_template.cfg @@ -37,9 +37,25 @@ finidat = UNSET ctsm_phys = clm5_0 # configuration: 'nwp' or 'clm' +# +# This controls a number of physics options that differ between the +# standard numerical weather prediction (nwp) and climate (clm) +# configurations of CTSM. These are typically options that are +# computationally expensive. These include plant hydraulic stress and +# the MEGAN chemistry model (both of which are on by default for clm but +# off by default for nwp). configuration = nwp # structure: 'fast' or 'standard' +# +# This controls various aspects of CTSM's subgrid and vertical layer +# structure. Typically, 'fast' is used for high-resolution NWP +# applications and 'standard' is used for lower-resolution climate +# applications. Parameters changed by this variable include number of +# soil and snow layers and how much subgrid variability is allowed in +# each grid cell. This also controls the maximum number of iterations in +# some iterative solution schemes - again, trading off speed for +# accuracy. structure = fast # bgc_mode: From 86ebca65ab2c4cee9e819cd1bc874a2d04efc19c Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 26 Jun 2020 05:57:25 -0600 Subject: [PATCH 424/556] Change some shebang lines to python3 Some of the lilac-related scripts may not work with python2. It's hard to find a definitive guide on how to write the shebang line, but the recommendation seems to be to use python3 in this case. --- .../obtaining-and-building-ctsm.rst | 5 +++-- lilac/build_ctsm | 2 +- lilac/download_input_data | 2 +- lilac/make_runtime_inputs | 2 +- 4 files changed, 6 insertions(+), 5 deletions(-) diff --git a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst index d627ddab1e..4798808308 100644 --- a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst +++ b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst @@ -64,8 +64,9 @@ Building CTSM requires: - python3 - - The default version of python (when you run python without specifying 2 vs. 3) should - be python3 + - Note that some scripts in the workflow look for 'python3' and others look for + 'python'. So python should be available under both of these names (although it is okay + for ``python`` to refer to version 2.7.x). - perl version 5 diff --git a/lilac/build_ctsm b/lilac/build_ctsm index 62c330118d..b460f9b011 100755 --- a/lilac/build_ctsm +++ b/lilac/build_ctsm @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Script to build CTSM library and its dependencies using cime's build system""" import os diff --git a/lilac/download_input_data b/lilac/download_input_data index 70daf01a3c..056467bce8 100755 --- a/lilac/download_input_data +++ b/lilac/download_input_data @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Download input data for running CTSM via LILAC""" import os diff --git a/lilac/make_runtime_inputs b/lilac/make_runtime_inputs index 93f218a9d0..61e06f6adc 100755 --- a/lilac/make_runtime_inputs +++ b/lilac/make_runtime_inputs @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """CTSM namelist creator""" import os From 513299850a4721443f689f0edba5f60dce8c47e9 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 26 Jun 2020 11:27:25 -0600 Subject: [PATCH 425/556] Finish first draft of documentation on setting ctsm-lilac runtime options --- .../setting-ctsm-runtime-options.rst | 51 +++++++++++++++---- 1 file changed, 42 insertions(+), 9 deletions(-) diff --git a/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst index a053976e3e..a338324e07 100644 --- a/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst +++ b/doc/source/lilac/obtaining-building-and-running/setting-ctsm-runtime-options.rst @@ -212,17 +212,50 @@ produced by ``make_runtime_inputs``). In addition, a few other NetCDF files are ``lilac_in``, of which the file listed in ``atmaero_stream`` is typically a standard input file (as opposed to one that you, the user, has provided). -**Idea of inputdata directory... this can be a symlink, or it can be an actual directory, -depending on how build_ctsm was run.** - -**As a convenience, can run download_input_data.** - -**There will likely be errors about some files not being able to be obtained, particularly -for user-provided files.** +CTSM's standard input files are expected to be in subdirectories of an ``inputdata`` +directory. With the ``build_ctsm`` workflow, this ``inputdata`` directory can be found +under the specified build directory. Depending on the options used for ``build_ctsm``, +this may be a new directory or it may be a symbolic link to an existing directory. These +standard input files are stored on a number of publicly available servers, such as +https://svn-ccsm-inputdata.cgd.ucar.edu/trunk/inputdata/. + +As a convenience, we provide a tool to obtain all of the needed standard input files for +your configuration: **To download these files to their expected locations, simply run** +``download_input_data`` **from the** ``runtime_inputs`` **directory.** This script reads +the file names from ``clm.input_data_list`` and ``lilac_in`` to determine which files need +to be downloaded. + +You will likely get some messages like, "Cannot download file since it lives outside of +the input_data_root", possibly followed by a final message, "Could not find all inputdata +on any server". As long as these messages just refer to your custom, resolution-specific +files (and not to CTSM's standard input files), then this is nothing to worry about. Copying the necessary files to the model's run directory ======================================================== -.. todo:: +Finally, copy the following files to the directory from which you will run the model: + +- ``lnd_in``: This is the main namelist input file for CTSM + +- ``lnd_modelio.nml``: This sets CTSM's PIO (parallel i/o library) configuration settings + +- ``lilac_in``: This namelist controls the operation of LILAC + +.. note:: - TODO: Fill this section in + We have not discussed ``lnd_modelio.nml`` above. This is because, if you have run + ``build_ctsm`` with appropriate options, then you shouldn't need to make any changes to + this file. However, you may want to confirm that two settings, in particular, are set + correctly for your machine; these can be important for I/O performance: + + - ``pio_stride``: this should generally be set to the number of physical processors per + shared-memory node on your machine. This is set from the ``--max-mpitasks-per-node`` + argument for a user-defined machine; it should be set automatically for a machine + that has been ported to CIME. + + - ``pio_typename``: this should generally be set to either ``pnetcdf`` or + ``netcdf``. Using PNetCDF (Parallel NetCDF) can result in significantly better I/O + performance, but this is only possible if you have the PNetCDF library on your + machine. The default for this variable is controlled by the ``--no-pnetcdf`` argument + to ``build_ctsm``, but you can change it here if you mistakenly set or didn't set + ``--no-pnetcdf`` when running ``build_ctsm``. From 0ff4da58d67eaf66f766a2ee2b25dc6014de216d Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 26 Jun 2020 15:36:38 -0600 Subject: [PATCH 426/556] Clarifications and modifications in wrf.rst --- doc/source/lilac/specific-atm-models/wrf.rst | 175 ++++++++----------- 1 file changed, 76 insertions(+), 99 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 460c017f36..29277ac898 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -9,7 +9,7 @@ This section describes the procedure for building and running the CTSM library and its dependencies, and linking to these libraries in the WRF model's build via LILAC. As such this section repeats some information -from earlier sections but in recipe form and with minimal detail. +from earlier sections but in recipe form and with minimal explanation. .. important:: @@ -35,15 +35,17 @@ Clone the CTSM repository:: .. todo:: Remove "git checkout lilac_cap" from the above when ready + Also the clone has been giving me: + git-lfs filter-process: git-lfs: command not found + fatal: The remote end hung up unexpectedly + warning: Clone succeeded, but checkout failed. + ...until I type module load git; git lfs install + ...do we need to warn users in case they happen to be contributing to doc? -Build CTSM and its dependencies based on instructions from previous sections, -for example for cheyenne:: +Build CTSM and its dependencies. Again, this example assumes that you are +working on cheyenne:: - ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne --build-without-openmp - -.. todo:: - - Remove "--build-without-openmp" from the above when ready + ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne Source ctsm_build_environment.sh (bash environment):: @@ -57,14 +59,11 @@ or ctsm_build_environment.csh (Cshell environment): .. note:: - For additional details on preparing the CTSM, including how to + For further detail on preparing the CTSM, including how to recompile when making code changes to the CTSM, read Section 3.2: - https://escomp.github.io/ctsm-docs/versions/master/html/lilac/obtaining-building-and-running/index.html https:../obtaining-building-and-running/index.html - -.. todo:: - - If the second (relative) link works, remove the first (absolute) link + By the way, do not let Section 3.2.2 confuse you. We address that step + right after compiling the WRF model (next). Building the WRF model with CTSM -------------------------------- @@ -77,7 +76,7 @@ Building the WRF model with CTSM Clone the WRF CTSM branch into your_directory_name:: cd .. - git clone git@github.com:billsacks/WRF.git + git clone https://github.com/billsacks/WRF.git cd WRF git checkout lilac_dev @@ -112,7 +111,7 @@ The ./clean command is necessary after any modification of WRF code:: ./configure At the prompt choose one of the options, similar to the compiler used -for building CTSM. The specific example has been tested successfuly by +for building CTSM. The specific example has been tested successfully by choosing 15 here. .. todo:: @@ -129,8 +128,8 @@ Now compile em_real and save the log:: .. note:: - The ./compile step might take more than 30 minutes to complete. - + Optional: One may use tmux or nohup for configuring and compiling. + Try "man nohup" for more information. .. note:: @@ -139,15 +138,48 @@ Now compile em_real and save the log:: .. note:: - Optional: One may use tmux or nohup for configuring and compiling. - Try "man nohup" for more information. + The ./compile step may take more than 30 minutes to complete. + While you wait, follow the instructions in Section 3.2.2 (next) + +Now follow the instructions in this Section:: + + https:../obtaining-building-and-running/setting-ctsm-runtime-options.html + +In step 3 of that Section we used for this example:: + + lnd_domain_file = /glade/work/slevis/barlage_wrf_ctsm/conus/gen_domain_files/domain.lnd.wrf2ctsm_lnd_wrf2ctsm_ocn.191211.nc + fsurdat = /glade/work/slevis/git_wrf/ctsm_surf/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c191212.nc + finidat = /glade/work/slevis/git_wrf/ctsm_init/finidat_interp_dest_wrfinit_snow_ERAI_12month.nc +In step 4 of that Section we used for this example:: + + atm_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + lnd_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + +In step 6 of that Section you will copy some files to your WRF/run +directory. Then you will be ready to continue. + +.. note:: + + If you wish to merge your WRF initial conditions from a wrfinput file + into the existing CTSM initial condition file, complete the following step. + +Type:: + + module load ncl + ncl transfer_wrfinput_to_ctsm_with_snow.ncl 'finidat="the_existing_finidat_file.nc"' 'wrfinput="your_wrfinput_file"' 'merged="the_merged_finidat_file.nc"' + +.. todo:: + + Make the above ncl script available. Compile WRF Preprocessing System (WPS) -------------------------------------- The WRF Preprocessing System (WPS) is a set of programs to prepare inputs to the real program executable (real.exe) for WRF real-data simulations. +If you wish to complete the offered example with preexisting inputs, then +skip to the next section, which is titled "Run WRF." .. note:: @@ -183,8 +215,8 @@ Then, compile WPS:: Alternatively, you can check the log for successful build message. -Run WRF Preprocessing System (WPS) ----------------------------------- +Run WPS +------- Edit namelist.wps for your domain of interest, which should be the same domain as used in your WRF namelist. @@ -278,86 +310,17 @@ Check the last line of the real log file for the following message:: SUCCESS COMPLETE REAL_EM INIT -.. _wrf-create-input-namelists-for-ctsm-and-lilac: - -Create input namelists for CTSM and LILAC -========================================= - -Introduce the following diffs to -./your_directory_name/ctsm/lilac/atm_driver/ -where is atm_driver_in, ctsm.cfg, and lilac_in. -In particular, replace the entries preceded by minus signs with the entries -preceded by plus signs. - -diff ./lilac/atm_driver/atm_driver_in ./lilac/atm_driver/atm_driver_in: - -.. code-block:: diff - - - atm_mesh_file = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - - atm_global_nx = 72 - - atm_global_ny = 46 - + atm_mesh_file = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' - + atm_global_nx = 199 - + atm_global_ny = 139 - -diff ./lilac/atm_driver/ctsm.cfg ./lilac/atm_driver/ctsm.cfg: - -.. code-block:: diff - - -configuration = clm - -structure = standard - -clm_bldnml_opts = -bgc sp - -gridmask = gx3v7 - -lnd_grid = 4x5 - -lnd_domain_file = domain.lnd.fv4x5_gx3v7.091218.nc - -lnd_domain_path = /glade/p/cesmdata/cseg/inputdata/share/domains - -clm_namelist_opts = hist_nhtfrq=-24 hist_mfilt=1 hist_ndens=1 - +configuration = nwp - +structure = fast - +clm_bldnml_opts = -bgc sp -clm_usr_name wrf2ctsm - +gridmask = null - +lnd_grid = wrf2ctsm - +lnd_domain_file = domain.lnd.wrf2ctsm_lnd_wrf2ctsm_ocn.191211.nc - +lnd_domain_path = /glade/work/slevis/barlage_wrf_ctsm/conus/gen_domain_files - +clm_namelist_opts = hist_nhtfrq=1 hist_mfilt=1 hist_ndens=1 fsurdat="/glade/work/barlage/ctsm/conus/surfdata_conus/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c191212.nc" finidat="/glade/scratch/sacks/wrf_code/WRF/test/em_real/nldas_nwp_0109a.clm2.r.2000-04-01-64800.nc" use_init_interp=.true. - -diff ./lilac/atm_driver/lilac_in ./lilac/atm_driver/lilac_in: - -.. code-block:: diff - - - atm_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - + atm_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' - - - lnd_mesh_filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' - + lnd_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' - -Before you generate the lnd_in file, you may modify user_nl_clm in -/glade/scratch/$USER/ctsm_build_dir/case/. For example you may wish to -point to an alternate CTSM initial condition file. To merge WRF initial -conditions from a wrfinput file into a CTSM initial condition file, type:: - - module load ncl - ncl transfer_wrfinput_to_ctsm_with_snow.ncl 'finidat="finidat_interp_dest.nc"' 'wrfinput="./your_directory_name/WRF/test/em_real/wrfinput_d01.noseaice"' 'merged="finidat_interp_dest_wrfinit_snow.nc"' - -.. todo:: - - Make the above ncl script available. If the finidat and wrfinput files - need to be consistent for this to work, we should explain how to - generate a consistent finidat file. - -Generate the lnd_in file by running the following from -./your_directory_name/ctsm/lilac/atm_driver:: - - ../../lilac_config/buildnml - -Copy lilac_in, lnd_in, and lnd_modelio.nml to the WRF/run directory. - Run WRF ------- -If real program completed successfully, we should see wrfinput and wrfbdy files -in our directory. +If real.exe completed successfully, we should have wrfinput and wrfbdy files +in our directory. If you plan to use this example's preexisting files, copy +the following files to your WRF/run directory:: + + /glade/work/slevis/git_wrf/WRF/test/em_real/namelist.input.ctsm.2013.d01.12month + /glade/work/slevis/git_wrf/WRF/test/em_real/wrfinput_d01.ERAI.12month + /glade/work/slevis/git_wrf/WRF/test/em_real/wrfbdy_d01.ERAI.12month Now run WRF-CTSM. On Cheyenne this means submitting a batch job to PBS (Pro workload management system). For detailed instructions on running a batch job on Cheyenne, please check: @@ -372,6 +335,7 @@ A simple PBS script to run WRF-CTSM on Cheyenne looks like this: #PBS -A your_project_code #PBS -l walltime=01:00:00 #PBS -q queue_name + #PBS -j oe #PBS -k eod #PBS -m abe #PBS -M your_email_address @@ -384,6 +348,19 @@ A simple PBS script to run WRF-CTSM on Cheyenne looks like this: ### Run the executable mpiexec_mpt ./wrf.exe -If you named this script run_wrf_ctsm.csh, then you type next:: +If you named this script run_wrf_ctsm.csh, submit the job like this:: qsub run_wrf_ctsm.csh + +If your terminal windows have logged off, repeat +source ctsm_build_environment.sh (bash environment) before submitting +the job:: + + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh + +or ctsm_build_environment.csh (Cshell environment): + +.. code-block:: Tcsh + + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.csh + From 120deab626412a474c450341fafe2a71265a4416 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 26 Jun 2020 11:40:34 -0600 Subject: [PATCH 427/556] LILAC: Change setting for pio_rearr_comm_max_pend_req_comp2io See discussion in https://github.com/ESMCI/cime/pull/3594 for rationale: basically, 0 has meant something different for the last few months. --- lilac/bld_templates/lilac_in_template | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/bld_templates/lilac_in_template b/lilac/bld_templates/lilac_in_template index 304191ee09..6295929e23 100644 --- a/lilac/bld_templates/lilac_in_template +++ b/lilac/bld_templates/lilac_in_template @@ -26,7 +26,7 @@ pio_rearr_comm_enable_isend_comp2io = .false. pio_rearr_comm_enable_isend_io2comp = .true. pio_rearr_comm_fcd = "2denable" - pio_rearr_comm_max_pend_req_comp2io = 0 + pio_rearr_comm_max_pend_req_comp2io = -2 pio_rearr_comm_max_pend_req_io2comp = 64 pio_rearr_comm_type = "p2p" / From b51dcd66eb26afa195f0d4d0d14807561133c386 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 27 Jun 2020 12:52:07 -0600 Subject: [PATCH 428/556] Loosen tolerance on lat/lon consistency check The old tolerance could be violated by single-precision roundoff-level differences that we want to ignore. --- lilac/src/lilac_atmcap.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/src/lilac_atmcap.F90 b/lilac/src/lilac_atmcap.F90 index c34859df49..911bb7b55f 100644 --- a/lilac/src/lilac_atmcap.F90 +++ b/lilac/src/lilac_atmcap.F90 @@ -123,7 +123,7 @@ subroutine lilac_atmcap_init (comp, lnd2atm_state, atm2lnd_state, clock, rc) integer :: numOwnedElements real(r8), pointer :: ownedElemCoords(:) real(r8) :: mesh_lon, mesh_lat - real(r8) :: tolerance = 1.e-5_r8 + real(r8), parameter :: tolerance = 1.e-4_r8 character(len=*), parameter :: subname='(lilac_atmcap_init): ' !------------------------------------------------------------------------- From bed6890aa03f467212bcff714c0f42f6253f5247 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 29 Jun 2020 17:17:31 -0600 Subject: [PATCH 429/556] Updated ChangeLog and ChangeSum --- doc/ChangeLog | 116 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 117 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 6f3183ed94..045c26ec2f 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,120 @@ =============================================================== +Tag name: ctsm1.0.dev103 +Originator(s): slevis (Samuel Levis, SLevis Consulting LLC,303-665-1310) +Date: Mon Jun 29 17:16:29 MDT 2020 +One-line Summary: Gridcell-level balance-check for methane (CH4) + +Purpose of changes +------------------ + + Bracket the model time-step loop to calculate balance checks at the + gridcell level, as detailed in issue #315. The column-level check + remains unchanged. + + Subroutine ch4_init_balance_check is replaced with + ch4_init_column_balance_check. Subroutine + ch4_init_gridcell_balance_check is added. + + The implementation is similar to the one for carbon and nitrogen (see + tag ctsm1.0.dev096). + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): #315 + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): + None + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + None + +Changes made to namelist defaults (e.g., changed parameter values): + None + +Changes to the datasets (e.g., parameter, surface or initial files): + None + +Substantial timing or memory changes: + No + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + None + +Changes to tests or testing: + None + +Code reviewed by: + @billsacks + + +CTSM testing: + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - + + tools-tests (test/tools): + + cheyenne - + + PTCLM testing (tools/shared/PTCLM/test): + + cheyenne - + + python testing (see instructions in python/README.md; document testing done): + + (any machine) - + + regular tests (aux_clm): + + cheyenne ---- PASS + izumi ------- PASS + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: + No + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): + None + +Pull Requests that document the changes (include PR ids): + https://github.com/ESCOMP/CTSM/pull/1022 + +=============================================================== +=============================================================== Tag name: ctsm1.0.dev102 Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) Date: Fri Jun 26 01:32:04 MDT 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index 655832d263..9af125f5b9 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm1.0.dev103 slevis 06/29/2020 Gridcell-level error-check for methane (CH4) ctsm1.0.dev102 erik/ole 06/26/2020 Some important fixes for LUNA in clm5_0, and small urban issue in clm5_0 ctsm1.0.dev101 ole/erik 06/17/2020 Changes from Keith to bring a list of variables to the parameter file ctsm1.0.dev100 sacks 06/09/2020 Deallocate memory after running init_interp From d6c80e8b10814532e559354e7819a2e2b8a4af63 Mon Sep 17 00:00:00 2001 From: wwieder Date: Tue, 30 Jun 2020 11:53:26 -0600 Subject: [PATCH 430/556] Revert extra output used for testing --- src/biogeochem/CNVegCarbonFluxType.F90 | 84 ++++++++++++-------------- 1 file changed, 37 insertions(+), 47 deletions(-) diff --git a/src/biogeochem/CNVegCarbonFluxType.F90 b/src/biogeochem/CNVegCarbonFluxType.F90 index 8a5bb32abe..2c1d8ff4b7 100644 --- a/src/biogeochem/CNVegCarbonFluxType.F90 +++ b/src/biogeochem/CNVegCarbonFluxType.F90 @@ -838,16 +838,6 @@ subroutine InitHistory(this, bounds, carbon_type) ptr_patch=this%grainc_to_seed_patch) end if - this%hrv_livestemc_to_litter_patch(begp:endp) = spval - call hist_addfld1d (fname='HRV_LIVESTEMC_TO_LITTER', units='gC/m^2/s', & - avgflag='A', long_name='harvest livestem C mortality', & - ptr_patch=this%hrv_livestemc_to_litter_patch, default='active') - - this%livestemc_to_litter_patch(begp:endp) = spval - call hist_addfld1d (fname='LIVESTEMC_TO_LITTER', units='gC/m^2/s', & - avgflag='A', long_name='livestem C mortality', & - ptr_patch=this%hrv_livestemc_to_litter_patch, default='active') - this%litterc_loss_col(begc:endc) = spval call hist_addfld1d (fname='LITTERC_LOSS', units='gC/m^2/s', & avgflag='A', long_name='litter C loss', & @@ -906,12 +896,12 @@ subroutine InitHistory(this, bounds, carbon_type) this%m_livestemc_storage_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_LITTER', units='gC/m^2/s', & avgflag='A', long_name='live stem C storage mortality', & - ptr_patch=this%m_livestemc_storage_to_litter_patch, default='active') + ptr_patch=this%m_livestemc_storage_to_litter_patch, default='inactive') this%m_deadstemc_storage_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMC_STORAGE_TO_LITTER', units='gC/m^2/s', & avgflag='A', long_name='dead stem C storage mortality', & - ptr_patch=this%m_deadstemc_storage_to_litter_patch, default='active') + ptr_patch=this%m_deadstemc_storage_to_litter_patch, default='inactive') this%m_livecrootc_storage_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVECROOTC_STORAGE_TO_LITTER', units='gC/m^2/s', & @@ -936,7 +926,7 @@ subroutine InitHistory(this, bounds, carbon_type) this%m_livestemc_xfer_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_LITTER', units='gC/m^2/s', & avgflag='A', long_name='live stem C transfer mortality', & - ptr_patch=this%m_livestemc_xfer_to_litter_patch, default='active') + ptr_patch=this%m_livestemc_xfer_to_litter_patch, default='inactive') this%m_deadstemc_xfer_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMC_XFER_TO_LITTER', units='gC/m^2/s', & @@ -956,7 +946,7 @@ subroutine InitHistory(this, bounds, carbon_type) this%m_livestemc_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_TO_LITTER', units='gC/m^2/s', & avgflag='A', long_name='live stem C mortality', & - ptr_patch=this%m_livestemc_to_litter_patch, default='active') + ptr_patch=this%m_livestemc_to_litter_patch, default='inactive') this%m_deadstemc_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMC_TO_LITTER', units='gC/m^2/s', & @@ -1001,17 +991,17 @@ subroutine InitHistory(this, bounds, carbon_type) this%m_livestemc_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_TO_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C fire loss', & - ptr_patch=this%m_livestemc_to_fire_patch, default='active') + ptr_patch=this%m_livestemc_to_fire_patch, default='inactive') this%m_livestemc_storage_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C storage fire loss', & - ptr_patch=this%m_livestemc_storage_to_fire_patch, default='active') + ptr_patch=this%m_livestemc_storage_to_fire_patch, default='inactive') this%m_livestemc_xfer_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C transfer fire loss', & - ptr_patch=this%m_livestemc_xfer_to_fire_patch, default='active') + ptr_patch=this%m_livestemc_xfer_to_fire_patch, default='inactive') this%m_deadstemc_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMC_TO_FIRE', units='gC/m^2/s', & @@ -1102,22 +1092,22 @@ subroutine InitHistory(this, bounds, carbon_type) this%m_livestemc_to_litter_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_TO_LITTER_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C fire mortality to litter', & - ptr_patch=this%m_livestemc_to_litter_fire_patch, default='active') + ptr_patch=this%m_livestemc_to_litter_fire_patch, default='inactive') this%m_livestemc_storage_to_litter_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C storage fire mortality to litter', & - ptr_patch=this%m_livestemc_storage_to_litter_fire_patch, default='active') + ptr_patch=this%m_livestemc_storage_to_litter_fire_patch, default='inactive') this%m_livestemc_xfer_to_litter_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C transfer fire mortality to litter', & - ptr_patch=this%m_livestemc_xfer_to_litter_fire_patch, default='active') + ptr_patch=this%m_livestemc_xfer_to_litter_fire_patch, default='inactive') this%m_livestemc_to_deadstemc_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMC_TO_DEADSTEMC_FIRE', units='gC/m^2/s', & avgflag='A', long_name='live stem C fire mortality to dead stem C', & - ptr_patch=this%m_livestemc_to_deadstemc_fire_patch, default='active') + ptr_patch=this%m_livestemc_to_deadstemc_fire_patch, default='inactive') this%m_deadstemc_to_litter_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMC_TO_LITTER_FIRE', units='gC/m^2/s', & @@ -1208,7 +1198,7 @@ subroutine InitHistory(this, bounds, carbon_type) this%leafc_xfer_to_leafc_patch(begp:endp) = spval call hist_addfld1d (fname='LEAFC_XFER_TO_LEAFC', units='gC/m^2/s', & avgflag='A', long_name='leaf C growth from storage', & - ptr_patch=this%leafc_xfer_to_leafc_patch, default='active') + ptr_patch=this%leafc_xfer_to_leafc_patch, default='inactive') this%frootc_xfer_to_frootc_patch(begp:endp) = spval call hist_addfld1d (fname='FROOTC_XFER_TO_FROOTC', units='gC/m^2/s', & @@ -1218,12 +1208,12 @@ subroutine InitHistory(this, bounds, carbon_type) this%livestemc_xfer_to_livestemc_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMC_XFER_TO_LIVESTEMC', units='gC/m^2/s', & avgflag='A', long_name='live stem C growth from storage', & - ptr_patch=this%livestemc_xfer_to_livestemc_patch, default='active') + ptr_patch=this%livestemc_xfer_to_livestemc_patch, default='inactive') this%deadstemc_xfer_to_deadstemc_patch(begp:endp) = spval call hist_addfld1d (fname='DEADSTEMC_XFER_TO_DEADSTEMC', units='gC/m^2/s', & avgflag='A', long_name='dead stem C growth from storage', & - ptr_patch=this%deadstemc_xfer_to_deadstemc_patch, default='active') + ptr_patch=this%deadstemc_xfer_to_deadstemc_patch, default='inactive') this%livecrootc_xfer_to_livecrootc_patch(begp:endp) = spval call hist_addfld1d (fname='LIVECROOTC_XFER_TO_LIVECROOTC', units='gC/m^2/s', & @@ -1255,7 +1245,7 @@ subroutine InitHistory(this, bounds, carbon_type) this%cpool_to_resp_patch(begp:endp) = spval call hist_addfld1d (fname='EXCESSC_MR', units='gC/m^2/s', & avgflag='A', long_name='excess C maintenance respiration', & - ptr_patch=this%cpool_to_resp_patch, default='active') + ptr_patch=this%cpool_to_resp_patch, default='inactive') this%leaf_mr_patch(begp:endp) = spval call hist_addfld1d (fname='LEAF_MR', units='gC/m^2/s', & avgflag='A', long_name='leaf maintenance respiration', & @@ -1269,12 +1259,12 @@ subroutine InitHistory(this, bounds, carbon_type) this%livestem_mr_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEM_MR', units='gC/m^2/s', & avgflag='A', long_name='live stem maintenance respiration', & - ptr_patch=this%livestem_mr_patch, default='active') + ptr_patch=this%livestem_mr_patch, default='inactive') this%livecroot_mr_patch(begp:endp) = spval call hist_addfld1d (fname='LIVECROOT_MR', units='gC/m^2/s', & avgflag='A', long_name='live coarse root maintenance respiration', & - ptr_patch=this%livecroot_mr_patch, default='active') + ptr_patch=this%livecroot_mr_patch, default='inactive') this%psnsun_to_cpool_patch(begp:endp) = spval call hist_addfld1d (fname='PSNSUN_TO_CPOOL', units='gC/m^2/s', & @@ -1309,42 +1299,42 @@ subroutine InitHistory(this, bounds, carbon_type) this%cpool_to_livestemc_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_LIVESTEMC', units='gC/m^2/s', & avgflag='A', long_name='allocation to live stem C', & - ptr_patch=this%cpool_to_livestemc_patch, default='active') + ptr_patch=this%cpool_to_livestemc_patch, default='inactive') this%cpool_to_livestemc_storage_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_LIVESTEMC_STORAGE', units='gC/m^2/s', & avgflag='A', long_name='allocation to live stem C storage', & - ptr_patch=this%cpool_to_livestemc_storage_patch, default='active') + ptr_patch=this%cpool_to_livestemc_storage_patch, default='inactive') this%cpool_to_deadstemc_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_DEADSTEMC', units='gC/m^2/s', & avgflag='A', long_name='allocation to dead stem C', & - ptr_patch=this%cpool_to_deadstemc_patch, default='active') + ptr_patch=this%cpool_to_deadstemc_patch, default='inactive') this%cpool_to_deadstemc_storage_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_DEADSTEMC_STORAGE', units='gC/m^2/s', & avgflag='A', long_name='allocation to dead stem C storage', & - ptr_patch=this%cpool_to_deadstemc_storage_patch, default='active') + ptr_patch=this%cpool_to_deadstemc_storage_patch, default='inactive') this%cpool_to_livecrootc_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_LIVECROOTC', units='gC/m^2/s', & avgflag='A', long_name='allocation to live coarse root C', & - ptr_patch=this%cpool_to_livecrootc_patch, default='active') + ptr_patch=this%cpool_to_livecrootc_patch, default='inactive') this%cpool_to_livecrootc_storage_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_LIVECROOTC_STORAGE', units='gC/m^2/s', & avgflag='A', long_name='allocation to live coarse root C storage', & - ptr_patch=this%cpool_to_livecrootc_storage_patch, default='active') + ptr_patch=this%cpool_to_livecrootc_storage_patch, default='inactive') this%cpool_to_deadcrootc_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_DEADCROOTC', units='gC/m^2/s', & avgflag='A', long_name='allocation to dead coarse root C', & - ptr_patch=this%cpool_to_deadcrootc_patch, default='active') + ptr_patch=this%cpool_to_deadcrootc_patch, default='inactive') this%cpool_to_deadcrootc_storage_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_DEADCROOTC_STORAGE', units='gC/m^2/s', & avgflag='A', long_name='allocation to dead coarse root C storage', & - ptr_patch=this%cpool_to_deadcrootc_storage_patch, default='active') + ptr_patch=this%cpool_to_deadcrootc_storage_patch, default='inactive') this%cpool_to_gresp_storage_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_TO_GRESP_STORAGE', units='gC/m^2/s', & @@ -1384,42 +1374,42 @@ subroutine InitHistory(this, bounds, carbon_type) this%cpool_livestem_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_LIVESTEM_GR', units='gC/m^2/s', & avgflag='A', long_name='live stem growth respiration', & - ptr_patch=this%cpool_livestem_gr_patch, default='active') + ptr_patch=this%cpool_livestem_gr_patch, default='inactive') this%cpool_livestem_storage_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_LIVESTEM_STORAGE_GR', units='gC/m^2/s', & avgflag='A', long_name='live stem growth respiration to storage', & - ptr_patch=this%cpool_livestem_storage_gr_patch, default='active') + ptr_patch=this%cpool_livestem_storage_gr_patch, default='inactive') this%transfer_livestem_gr_patch(begp:endp) = spval call hist_addfld1d (fname='TRANSFER_LIVESTEM_GR', units='gC/m^2/s', & avgflag='A', long_name='live stem growth respiration from storage', & - ptr_patch=this%transfer_livestem_gr_patch, default='active') + ptr_patch=this%transfer_livestem_gr_patch, default='inactive') this%cpool_deadstem_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_DEADSTEM_GR', units='gC/m^2/s', & avgflag='A', long_name='dead stem growth respiration', & - ptr_patch=this%cpool_deadstem_gr_patch, default='active') + ptr_patch=this%cpool_deadstem_gr_patch, default='inactive') this%cpool_deadstem_storage_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_DEADSTEM_STORAGE_GR', units='gC/m^2/s', & avgflag='A', long_name='dead stem growth respiration to storage', & - ptr_patch=this%cpool_deadstem_storage_gr_patch, default='active') + ptr_patch=this%cpool_deadstem_storage_gr_patch, default='inactive') this%transfer_deadstem_gr_patch(begp:endp) = spval call hist_addfld1d (fname='TRANSFER_DEADSTEM_GR', units='gC/m^2/s', & avgflag='A', long_name='dead stem growth respiration from storage', & - ptr_patch=this%transfer_deadstem_gr_patch, default='active') + ptr_patch=this%transfer_deadstem_gr_patch, default='inactive') this%cpool_livecroot_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_LIVECROOT_GR', units='gC/m^2/s', & avgflag='A', long_name='live coarse root growth respiration', & - ptr_patch=this%cpool_livecroot_gr_patch, default='active') + ptr_patch=this%cpool_livecroot_gr_patch, default='inactive') this%cpool_livecroot_storage_gr_patch(begp:endp) = spval call hist_addfld1d (fname='CPOOL_LIVECROOT_STORAGE_GR', units='gC/m^2/s', & avgflag='A', long_name='live coarse root growth respiration to storage', & - ptr_patch=this%cpool_livecroot_storage_gr_patch, default='active') + ptr_patch=this%cpool_livecroot_storage_gr_patch, default='inactive') this%transfer_livecroot_gr_patch(begp:endp) = spval call hist_addfld1d (fname='TRANSFER_LIVECROOT_GR', units='gC/m^2/s', & @@ -1454,12 +1444,12 @@ subroutine InitHistory(this, bounds, carbon_type) this%livestemc_storage_to_xfer_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMC_STORAGE_TO_XFER', units='gC/m^2/s', & avgflag='A', long_name='live stem C shift storage to transfer', & - ptr_patch=this%livestemc_storage_to_xfer_patch, default='active') + ptr_patch=this%livestemc_storage_to_xfer_patch, default='inactive') this%deadstemc_storage_to_xfer_patch(begp:endp) = spval call hist_addfld1d (fname='DEADSTEMC_STORAGE_TO_XFER', units='gC/m^2/s', & avgflag='A', long_name='dead stem C shift storage to transfer', & - ptr_patch=this%deadstemc_storage_to_xfer_patch, default='active') + ptr_patch=this%deadstemc_storage_to_xfer_patch, default='inactive') this%livecrootc_storage_to_xfer_patch(begp:endp) = spval call hist_addfld1d (fname='LIVECROOTC_STORAGE_TO_XFER', units='gC/m^2/s', & @@ -1479,12 +1469,12 @@ subroutine InitHistory(this, bounds, carbon_type) this%livestemc_to_deadstemc_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMC_TO_DEADSTEMC', units='gC/m^2/s', & avgflag='A', long_name='live stem C turnover', & - ptr_patch=this%livestemc_to_deadstemc_patch, default='active') + ptr_patch=this%livestemc_to_deadstemc_patch, default='inactive') this%livecrootc_to_deadcrootc_patch(begp:endp) = spval call hist_addfld1d (fname='LIVECROOTC_TO_DEADCROOTC', units='gC/m^2/s', & avgflag='A', long_name='live coarse root C turnover', & - ptr_patch=this%livecrootc_to_deadcrootc_patch, default='active') + ptr_patch=this%livecrootc_to_deadcrootc_patch, default='inactive') this%gpp_before_downreg_patch(begp:endp) = spval call hist_addfld1d (fname='INIT_GPP', units='gC/m^2/s', & From 19f801307bdbc08889bc1400455ecc2e697b48a2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 30 Jun 2020 11:54:41 -0600 Subject: [PATCH 431/556] LILAC build: make default withOUT OpenMP support I found that on cheyenne, if you don't explicitly specify OMP_NUM_THREADS in your job, you get 36 threads per node. This is a huge problem for performance, and is something that could easily happen to a user who wasn't planning to run threaded anyway. So it feels like the safest thing to do is to build without threading by default. --- cime_config/SystemTests/lilacsmoke.py | 4 --- .../obtaining-and-building-ctsm.rst | 10 ++++++-- python/ctsm/lilac_build_ctsm.py | 25 ++++++++++--------- python/ctsm/test/test_sys_lilac_build_ctsm.py | 2 +- 4 files changed, 22 insertions(+), 19 deletions(-) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index 946b439707..1dce6bb175 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -47,10 +47,6 @@ def build_phase(self, sharedlib_only=False, model_only=False): compiler=compiler) if debug: cmd += ' --build-debug' - # For now, always build this test without threads: it doesn't need - # threads, and building unthreaded ensures that it works on a wider range - # of machines/compilers - cmd += ' --build-without-openmp' self._run_build_cmd(cmd, exeroot, 'build_ctsm.bldlog') # We call the build script with --rebuild even for an initial build. This is diff --git a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst index 4798808308..a51dcfcf25 100644 --- a/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst +++ b/doc/source/lilac/obtaining-building-and-running/obtaining-and-building-ctsm.rst @@ -170,11 +170,14 @@ Some other options to ``build_ctsm`` are supported in this case (but many are no they are only applicable to the non-CIME-supported machine workflow); run ``./lilac/build_ctsm -h`` for details. -.. note:: +.. important:: If PNetCDF (parallel NetCDF) is not available on this machine, you will need to add the option ``--no-pnetcdf``. + If you plan to run with OpenMP threading-based parallelization, or hybrid MPI/OpenMP, + then it is important to add ``--build-with-openmp``. + Besides the build files themselves, ``build_ctsm`` creates the following important files that are needed for the build of the atmosphere model: @@ -215,12 +218,15 @@ model performance. The given directory (``/PATH/TO/CTSM/BUILD``) must *not* exist. This directory is created for you by the build script. -.. note:: +.. important:: If PNetCDF (parallel NetCDF) is not available on your machine/compiler, you should use the option ``--no-pnetcdf`` instead of ``--pnetcdf-path``. You must specify exactly one of those two options. + If you plan to run with OpenMP threading-based parallelization, or hybrid MPI/OpenMP, + then it is important to add ``--build-with-openmp``. + Example usage for a Mac (a simple case) is:: ./lilac/build_ctsm ~/ctsm_build_dir --os Darwin --compiler gnu --netcdf-path /usr/local --esmf-lib-path /Users/sacks/ESMF/esmf8.0.0/lib/libO/Darwin.gfortranclang.64.mpich3.default --max-mpitasks-per-node 4 --no-pnetcdf diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index 819168c12d..34306af6f6 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -82,7 +82,7 @@ def main(cime_path): extra_cflags=args.extra_cflags, no_pnetcdf=args.no_pnetcdf, build_debug=args.build_debug, - build_without_openmp=args.build_without_openmp, + build_with_openmp=args.build_with_openmp, inputdata_path=args.inputdata_path) def build_ctsm(cime_path, @@ -103,7 +103,7 @@ def build_ctsm(cime_path, extra_cflags='', no_pnetcdf=False, build_debug=False, - build_without_openmp=False, + build_with_openmp=False, inputdata_path=None): """Implementation of build_ctsm command @@ -138,7 +138,7 @@ def build_ctsm(cime_path, Ignored if machine is given no_pnetcdf (bool): if True, use netcdf rather than pnetcdf build_debug (bool): if True, build with flags for debugging - build_without_openmp (bool): if True, build without OpenMP support + build_with_openmp (bool): if True, build with OpenMP support inputdata_path (str or None): path to existing inputdata directory on this machine If None, an inputdata directory will be created for this build (If machine is given, then we use the machine's inputdata directory by default; @@ -176,7 +176,7 @@ def build_ctsm(cime_path, compiler=compiler, machine=machine, build_debug=build_debug, - build_without_openmp=build_without_openmp, + build_with_openmp=build_with_openmp, inputdata_path=inputdata_path) if existing_inputdata: @@ -318,11 +318,12 @@ def _commandline_args(args_to_parse=None): help='Build with flags for debugging rather than production runs') non_rebuild_optional_list.append('build-debug') - non_rebuild_optional.add_argument('--build-without-openmp', action='store_true', - help='By default, CTSM is built with support for OpenMP threading;\n' - 'if this flag is set, then CTSM is built without this support.\n' - 'This is mainly useful if your machine/compiler does not support OpenMP.') - non_rebuild_optional_list.append('build-without-openmp') + non_rebuild_optional.add_argument('--build-with-openmp', action='store_true', + help='By default, CTSM is built WITHOUT support for OpenMP threading;\n' + 'if this flag is set, then CTSM is built WITH this support.\n' + 'This is important for performance if you will be running with\n' + 'OpenMP threading-based parallelization, or hybrid MPI/OpenMP.') + non_rebuild_optional_list.append('build-with-openmp') non_rebuild_optional.add_argument('--inputdata-path', help='Path to directory containing CTSM\'s NetCDF inputs.\n' @@ -574,7 +575,7 @@ def _fill_out_machine_files(build_dir, def _create_case(cime_path, build_dir, compiler, - machine=None, build_debug=False, build_without_openmp=False, + machine=None, build_debug=False, build_with_openmp=False, inputdata_path=None): """Create a case that can later be used to build the CTSM library and its dependencies @@ -586,7 +587,7 @@ def _create_case(cime_path, build_dir, compiler, If None, we assume we're using an on-the-fly machine port Otherwise, machine should be the name of a machine known to cime build_debug (bool): if True, build with flags for debugging - build_without_openmp (bool): if True, build without OpenMP support + build_with_openmp (bool): if True, build with OpenMP support inputdata_path (str or None): path to existing inputdata directory on this machine If None, we use the machine's default DIN_LOC_ROOT """ @@ -626,7 +627,7 @@ def _create_case(cime_path, build_dir, compiler, subprocess.check_call([xmlchange, 'LILAC_MODE=on'], cwd=case_dir) if build_debug: subprocess.check_call([xmlchange, 'DEBUG=TRUE'], cwd=case_dir) - if not build_without_openmp: + if build_with_openmp: subprocess.check_call([xmlchange, 'FORCE_BUILD_SMP=TRUE'], cwd=case_dir) run_cmd_output_on_error([os.path.join(case_dir, 'case.setup')], diff --git a/python/ctsm/test/test_sys_lilac_build_ctsm.py b/python/ctsm/test/test_sys_lilac_build_ctsm.py index f8b0447fc7..46158db6d3 100755 --- a/python/ctsm/test/test_sys_lilac_build_ctsm.py +++ b/python/ctsm/test/test_sys_lilac_build_ctsm.py @@ -87,7 +87,7 @@ def test_buildSetup_userDefinedMachine_allInfo(self): extra_fflags='-foo', extra_cflags='-bar', build_debug=True, - build_without_openmp=True, + build_with_openmp=True, inputdata_path=os.path.join(self._tempdir, 'my_inputdata')) # the critical piece of this test is that the above command doesn't generate any # errors; however we also do some assertions below From 7734dcb3e696c7beca62ae3e872f48ec7cc8ba06 Mon Sep 17 00:00:00 2001 From: wwieder Date: Tue, 30 Jun 2020 11:57:22 -0600 Subject: [PATCH 432/556] Remove extra VegN output used in testing --- src/biogeochem/CNVegNitrogenFluxType.F90 | 71 +++++++----------------- 1 file changed, 19 insertions(+), 52 deletions(-) diff --git a/src/biogeochem/CNVegNitrogenFluxType.F90 b/src/biogeochem/CNVegNitrogenFluxType.F90 index 212333155c..f9f2b37215 100644 --- a/src/biogeochem/CNVegNitrogenFluxType.F90 +++ b/src/biogeochem/CNVegNitrogenFluxType.F90 @@ -557,29 +557,7 @@ subroutine InitHistory(this, bounds) else vr_suffix = "" endif -! WW added these two fields - ! This may just be a crop variable - this%livestemn_to_litter_patch(begp:endp) = spval - call hist_addfld1d (fname='LIVESTEMN_TO_LITTER', units='gN/m^2/s', & - avgflag='A', long_name='livestem N mortality', & - ptr_patch=this%livestemn_to_litter_patch, default='active') - - this%hrv_livestemn_to_litter_patch(begp:endp) = spval - call hist_addfld1d (fname='HRV_LIVESTEMN_TO_LITTER', units='gN/m^2/s', & - avgflag='A', long_name='harvest livestem N mortality', & - ptr_patch=this%hrv_livestemn_to_litter_patch, default='active') - - this%m_livestemn_to_litter_fire_patch(begp:endp) = spval - call hist_addfld1d (fname='M_LIVESTEMN_TO_LITTER_FIRE', units='gN/m^2/s', & - avgflag='A', long_name='live stem N fire mortality to litter', & - ptr_patch=this%m_livestemn_to_litter_fire_patch, default='active') - - this%m_livestemn_to_deadstemn_fire_patch(begp:endp) = spval - call hist_addfld1d (fname='M_LIVESTEMN_TO_DEADSTEMN_FIRE', units='gN/m^2/s', & - avgflag='A', long_name='live stem N fire mortality to dead stem N', & - ptr_patch=this%m_livestemn_to_deadstemn_fire_patch, default='active') -! end WW additions - + this%m_leafn_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LEAFN_TO_LITTER', units='gN/m^2/s', & avgflag='A', long_name='leaf N mortality', & @@ -603,7 +581,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_storage_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_STORAGE_TO_LITTER', units='gN/m^2/s', & avgflag='A', long_name='live stem N storage mortality', & - ptr_patch=this%m_livestemn_storage_to_litter_patch, default='active') + ptr_patch=this%m_livestemn_storage_to_litter_patch, default='inactive') this%m_deadstemn_storage_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_STORAGE_TO_LITTER', units='gN/m^2/s', & @@ -633,7 +611,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_xfer_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_XFER_TO_LITTER', units='gN/m^2/s', & avgflag='A', long_name='live stem N transfer mortality', & - ptr_patch=this%m_livestemn_xfer_to_litter_patch, default='active') + ptr_patch=this%m_livestemn_xfer_to_litter_patch, default='inactive') this%m_deadstemn_xfer_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_XFER_TO_LITTER', units='gN/m^2/s', & @@ -653,7 +631,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_TO_LITTER', units='gN/m^2/s', & avgflag='A', long_name='live stem N mortality', & - ptr_patch=this%m_livestemn_to_litter_patch, default='active') + ptr_patch=this%m_livestemn_to_litter_patch, default='inactive') this%m_deadstemn_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_TO_LITTER', units='gN/m^2/s', & @@ -698,7 +676,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_storage_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_STORAGE_TO_FIRE', units='gN/m^2/s', & avgflag='A', long_name='live stem N storage fire loss', & - ptr_patch=this%m_livestemn_storage_to_fire_patch, default='active') + ptr_patch=this%m_livestemn_storage_to_fire_patch, default='inactive') this%m_deadstemn_storage_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_STORAGE_TO_FIRE', units='gN/m^2/s', & @@ -728,7 +706,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_xfer_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_XFER_TO_FIRE', units='gN/m^2/s', & avgflag='A', long_name='live stem N transfer fire loss', & - ptr_patch=this%m_livestemn_xfer_to_fire_patch, default='active') + ptr_patch=this%m_livestemn_xfer_to_fire_patch, default='inactive') this%m_deadstemn_xfer_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_XFER_TO_FIRE', units='gN/m^2/s', & @@ -748,7 +726,7 @@ subroutine InitHistory(this, bounds) this%m_livestemn_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_LIVESTEMN_TO_FIRE', units='gN/m^2/s', & avgflag='A', long_name='live stem N fire loss', & - ptr_patch=this%m_livestemn_to_fire_patch, default='active') + ptr_patch=this%m_livestemn_to_fire_patch, default='inactive') this%m_deadstemn_to_fire_patch(begp:endp) = spval call hist_addfld1d (fname='M_DEADSTEMN_TO_FIRE', units='gN/m^2/s', & @@ -783,7 +761,7 @@ subroutine InitHistory(this, bounds) this%leafn_xfer_to_leafn_patch(begp:endp) = spval call hist_addfld1d (fname='LEAFN_XFER_TO_LEAFN', units='gN/m^2/s', & avgflag='A', long_name='leaf N growth from storage', & - ptr_patch=this%leafn_xfer_to_leafn_patch, default='active') + ptr_patch=this%leafn_xfer_to_leafn_patch, default='inactive') this%frootn_xfer_to_frootn_patch(begp:endp) = spval call hist_addfld1d (fname='FROOTN_XFER_TO_FROOTN', units='gN/m^2/s', & @@ -793,7 +771,7 @@ subroutine InitHistory(this, bounds) this%livestemn_xfer_to_livestemn_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMN_XFER_TO_LIVESTEMN', units='gN/m^2/s', & avgflag='A', long_name='live stem N growth from storage', & - ptr_patch=this%livestemn_xfer_to_livestemn_patch, default='active') + ptr_patch=this%livestemn_xfer_to_livestemn_patch, default='inactive') this%deadstemn_xfer_to_deadstemn_patch(begp:endp) = spval call hist_addfld1d (fname='DEADSTEMN_XFER_TO_DEADSTEMN', units='gN/m^2/s', & @@ -818,12 +796,12 @@ subroutine InitHistory(this, bounds) this%leafn_to_retransn_patch(begp:endp) = spval call hist_addfld1d (fname='LEAFN_TO_RETRANSN', units='gN/m^2/s', & avgflag='A', long_name='leaf N to retranslocated N pool', & - ptr_patch=this%leafn_to_retransn_patch, default='active') + ptr_patch=this%leafn_to_retransn_patch, default='inactive') this%frootn_to_litter_patch(begp:endp) = spval call hist_addfld1d (fname='FROOTN_TO_LITTER', units='gN/m^2/s', & avgflag='A', long_name='fine root N litterfall', & - ptr_patch=this%frootn_to_litter_patch, default='active') + ptr_patch=this%frootn_to_litter_patch, default='inactive') this%retransn_to_npool_patch(begp:endp) = spval call hist_addfld1d (fname='RETRANSN_TO_NPOOL', units='gN/m^2/s', & @@ -863,22 +841,22 @@ subroutine InitHistory(this, bounds) this%npool_to_livestemn_patch(begp:endp) = spval call hist_addfld1d (fname='NPOOL_TO_LIVESTEMN', units='gN/m^2/s', & avgflag='A', long_name='allocation to live stem N', & - ptr_patch=this%npool_to_livestemn_patch, default='active') + ptr_patch=this%npool_to_livestemn_patch, default='inactive') this%npool_to_livestemn_storage_patch(begp:endp) = spval call hist_addfld1d (fname='NPOOL_TO_LIVESTEMN_STORAGE', units='gN/m^2/s', & avgflag='A', long_name='allocation to live stem N storage', & - ptr_patch=this%npool_to_livestemn_storage_patch, default='active') + ptr_patch=this%npool_to_livestemn_storage_patch, default='inactive') this%npool_to_deadstemn_patch(begp:endp) = spval call hist_addfld1d (fname='NPOOL_TO_DEADSTEMN', units='gN/m^2/s', & avgflag='A', long_name='allocation to dead stem N', & - ptr_patch=this%npool_to_deadstemn_patch, default='active') + ptr_patch=this%npool_to_deadstemn_patch, default='inactive') this%npool_to_deadstemn_storage_patch(begp:endp) = spval call hist_addfld1d (fname='NPOOL_TO_DEADSTEMN_STORAGE', units='gN/m^2/s', & avgflag='A', long_name='allocation to dead stem N storage', & - ptr_patch=this%npool_to_deadstemn_storage_patch, default='active') + ptr_patch=this%npool_to_deadstemn_storage_patch, default='inactive') this%npool_to_livecrootn_patch(begp:endp) = spval call hist_addfld1d (fname='NPOOL_TO_LIVECROOTN', units='gN/m^2/s', & @@ -913,7 +891,7 @@ subroutine InitHistory(this, bounds) this%livestemn_storage_to_xfer_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMN_STORAGE_TO_XFER', units='gN/m^2/s', & avgflag='A', long_name='live stem N shift storage to transfer', & - ptr_patch=this%livestemn_storage_to_xfer_patch, default='active') + ptr_patch=this%livestemn_storage_to_xfer_patch, default='inactive') this%deadstemn_storage_to_xfer_patch(begp:endp) = spval call hist_addfld1d (fname='DEADSTEMN_STORAGE_TO_XFER', units='gN/m^2/s', & @@ -933,12 +911,12 @@ subroutine InitHistory(this, bounds) this%livestemn_to_deadstemn_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMN_TO_DEADSTEMN', units='gN/m^2/s', & avgflag='A', long_name='live stem N turnover', & - ptr_patch=this%livestemn_to_deadstemn_patch, default='active') + ptr_patch=this%livestemn_to_deadstemn_patch, default='inactive') this%livestemn_to_retransn_patch(begp:endp) = spval call hist_addfld1d (fname='LIVESTEMN_TO_RETRANSN', units='gN/m^2/s', & avgflag='A', long_name='live stem N to retranslocated N pool', & - ptr_patch=this%livestemn_to_retransn_patch, default='active') + ptr_patch=this%livestemn_to_retransn_patch, default='inactive') this%livecrootn_to_deadcrootn_patch(begp:endp) = spval call hist_addfld1d (fname='LIVECROOTN_TO_DEADCROOTN', units='gN/m^2/s', & @@ -972,7 +950,7 @@ subroutine InitHistory(this, bounds) ptr_patch=this%fert_patch) end if - if (use_crop) then + if (use_crop .and. .not. use_fun) then this%soyfixn_patch(begp:endp) = spval call hist_addfld1d (fname='SOYFIXN', units='gN/m^2/s', & avgflag='A', long_name='soybean fixation', & @@ -1424,11 +1402,6 @@ subroutine Restart (this, bounds, ncid, flag ) long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%avail_retransn_patch) - call restartvar(ncid=ncid, flag=flag, varname='plant_nalloc', xtype=ncd_double, & - dim1name='pft', & - long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%plant_nalloc_patch) - if ( use_fun ) then ! set_missing_vals_to_constant for BACKWARDS_COMPATIBILITY(wrw, 2018-06-28) re. issue #426 ! special land units previously set to spval, not 0 @@ -1548,12 +1521,6 @@ subroutine Restart (this, bounds, ncid, flag ) long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%Nuptake_patch) call set_missing_vals_to_constant(this%Nuptake_patch, 0._r8) - - call restartvar(ncid=ncid, flag=flag, varname='sminn_to_plant_fun', xtype=ncd_double, & - dim1name='pft', & - long_name='Total soil N uptake of FUN', units='gN/m2/s', & - interpinic_flag='interp', readvar=readvar, data=this%sminn_to_plant_fun_patch) - call set_missing_vals_to_constant(this%sminn_to_plant_fun_patch, 0._r8) end if ! End BACKWARDS_COMPATIBILITY(wrw, 2018-06-28) re. issue #426 From cd835cb69fa375466b466da0f7e4466928e38a56 Mon Sep 17 00:00:00 2001 From: wwieder Date: Tue, 30 Jun 2020 12:04:22 -0600 Subject: [PATCH 433/556] Reverts changes used for testing purposes --- .../NutrientCompetitionFlexibleCNMod.F90 | 99 +++---------------- 1 file changed, 16 insertions(+), 83 deletions(-) diff --git a/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 b/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 index 81e33315c0..b69c666ea4 100644 --- a/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 +++ b/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 @@ -18,7 +18,6 @@ module NutrientCompetitionFlexibleCNMod ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use LandunitType , only : lun use ColumnType , only : col @@ -37,10 +36,6 @@ module NutrientCompetitionFlexibleCNMod private real(r8), pointer :: actual_leafcn(:) ! leaf CN ratio used by flexible CN real(r8), pointer :: actual_storage_leafcn(:) ! storage leaf CN ratio used by flexible CN - real(r8), pointer :: actual_livestemcn(:) ! live wood CN ratio used by flexible CN - real(r8), pointer :: actual_livestemcn_storage(:) ! storage live wood CN ratio used by flexible CN - real(r8), pointer :: npool_to_livestemn(:) ! npool to live stem n - real(r8), pointer :: npool_to_livestemn_storage(:) ! npool to live stem storage n contains ! public methocs procedure, public :: Init ! Initialization @@ -102,10 +97,6 @@ subroutine InitAllocate(this, bounds) allocate(this%actual_leafcn(bounds%begp:bounds%endp)) ; this%actual_leafcn(:) = nan allocate(this%actual_storage_leafcn(bounds%begp:bounds%endp)) ; this%actual_storage_leafcn(:) = nan - allocate(this%actual_livestemcn(bounds%begp:bounds%endp)) ; this%actual_livestemcn(:) = nan - allocate(this%actual_livestemcn_storage(bounds%begp:bounds%endp)) ; this%actual_livestemcn_storage(:) = nan - allocate(this%npool_to_livestemn(bounds%begp:bounds%endp)) ; this%npool_to_livestemn(:) = nan - allocate(this%npool_to_livestemn_storage(bounds%begp:bounds%endp)) ; this%npool_to_livestemn_storage(:) = nan end subroutine InitAllocate @@ -136,25 +127,7 @@ subroutine InitHistory(this, bounds) this%actual_storage_leafcn(begp:endp) = spval call hist_addfld1d (fname='LEAFCN_STORAGE', units='gC/gN', & avgflag='A', long_name='Storage Leaf CN ratio used for flexible CN', & - ptr_patch=this%actual_storage_leafcn, default='active') - - this%actual_livestemcn(begp:endp) = spval - call hist_addfld1d (fname='LIVESTEMCN', units='gC/gN', & - avgflag='A', long_name='Live wood CN ratio used for flexible CN', & - ptr_patch=this%actual_livestemcn ) - this%actual_livestemcn_storage(begp:endp) = spval - call hist_addfld1d (fname='LIVESTEMCN_STORAGE', units='gC/gN', & - avgflag='A', long_name='Storage Live wood CN ratio used for flexible CN', & - ptr_patch=this%actual_livestemcn_storage, default='active') - - this%npool_to_livestemn(begp:endp) = spval - call hist_addfld1d (fname='NPOOL_TO_LIVESTEM', units='gN m^-1 s^-1', & - avgflag='A', long_name='NPOOL to live stem N', & - ptr_patch=this%npool_to_livestemn ) - this%npool_to_livestemn_storage(begp:endp) = spval - call hist_addfld1d (fname='NPOOL_TO_LIVESTEM_STORAGE', units='gN m^-1 s^-1', & - avgflag='A', long_name='NPOOL to live stem N storage', & - ptr_patch=this%npool_to_livestemn_storage ) + ptr_patch=this%actual_storage_leafcn, default='inactive') end subroutine InitHistory @@ -222,7 +195,7 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & use clm_varctl , only : downreg_opt use clm_varctl , only : CN_residual_opt use clm_varctl , only : CN_partition_opt - use clm_time_manager , only : get_step_size + use clm_time_manager , only : get_step_size_real use CNVegStateType , only : cnveg_state_type use CropType , only : crop_type use CanopyStateType , only : canopystate_type @@ -324,11 +297,11 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & ! ----------------------------------------------------------------------- - SHR_ASSERT_ALL((ubound(aroot) == (/bounds%endp/)) , errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((ubound(arepr) == (/bounds%endp/)) , errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((ubound(fpg_col) == (/bounds%endc/)) , errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((ubound(this%actual_storage_leafcn) >= (/bounds%endp/)), errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((lbound(this%actual_storage_leafcn) <= (/bounds%begp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL_FL((ubound(aroot) == (/bounds%endp/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(arepr) == (/bounds%endp/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(fpg_col) == (/bounds%endc/)) , sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(this%actual_storage_leafcn) >= (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((lbound(this%actual_storage_leafcn) <= (/bounds%begp/)), sourcefile, __LINE__) associate( & fpg => fpg_col , & ! Input: [real(r8) (:) ] fraction of potential gpp (no units) @@ -427,7 +400,7 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & ) ! set time steps - dt = real( get_step_size(), r8 ) + dt = get_step_size_real() ! patch loop to distribute the available N between the competing patches ! on the basis of relative demand, and allocate C and N to new growth and storage @@ -793,9 +766,6 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (downreg_opt .eqv. .false. .AND. CN_partition_opt == 1) then - ! WW this is where demand could also be modified based on actual leaf and live wood C:N - ! allocation from npool to storage would also have to be modified? - ! computing nitrogen demand for different pools based on carbon allocated and CN ratio npool_to_leafn_demand(p) = (nlc / cnl) * fcur npool_to_leafn_storage_demand(p) = (nlc / cnl) * (1._r8 - fcur) @@ -973,9 +943,7 @@ subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & / cnveg_nitrogenstate_inst%leafn_storage_patch(p) end if end if - - !! WW none of this is done in CLM5 w/ FUN because carbon_resp_opt = 0 by default !! - !! WW remove this redundant code? + if (carbon_resp_opt == 1 .AND. laisun(p)+laisha(p) > 0.0_r8) then ! computing carbon to nitrogen ratio of different plant parts @@ -1224,7 +1192,7 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & use clm_varctl , only : use_c13, use_c14 use clm_varctl , only : nscalar_opt, plant_ndemand_opt, substrate_term_opt, temp_scalar_opt use clm_varpar , only : nlevdecomp - use clm_time_manager , only : get_step_size + use clm_time_manager , only : get_step_size_real use CanopyStateType , only : canopystate_type use PhotosynthesisMod , only : photosyns_type use CropType , only : crop_type @@ -1288,16 +1256,10 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & ! ----------------------------------------------------------------------- - SHR_ASSERT_ALL((ubound(aroot) == (/bounds%endp/)), errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((ubound(arepr) == (/bounds%endp/)), errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((ubound(this%actual_leafcn) >= (/bounds%endp/)), errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((lbound(this%actual_leafcn) <= (/bounds%begp/)), errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((ubound(this%actual_storage_leafcn) >= (/bounds%endp/)), errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((lbound(this%actual_storage_leafcn) <= (/bounds%begp/)), errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((ubound(this%actual_livestemcn) >= (/bounds%endp/)), errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((lbound(this%actual_livestemcn) <= (/bounds%begp/)), errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((ubound(this%actual_livestemcn_storage) >= (/bounds%endp/)), errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((lbound(this%actual_livestemcn_storage) <= (/bounds%begp/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL_FL((ubound(aroot) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(arepr) == (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(this%actual_leafcn) >= (/bounds%endp/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((lbound(this%actual_leafcn) <= (/bounds%begp/)), sourcefile, __LINE__) associate( & ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type @@ -1360,10 +1322,8 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & xsmrpool => cnveg_carbonstate_inst%xsmrpool_patch , & ! Input: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] - leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] - livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:) ] livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N @@ -1391,7 +1351,6 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & cpool_to_xsmrpool => cnveg_carbonflux_inst%cpool_to_xsmrpool_patch , & ! Output: [real(r8) (:) ] leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N - leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) avail_retransn => cnveg_nitrogenflux_inst%avail_retransn_patch , & ! Output: [real(r8) (:) ] N flux available from retranslocation pool (gN/m2/s) retransn_to_npool => cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) @@ -1400,7 +1359,6 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & frootn_to_retransn => cnveg_nitrogenflux_inst%frootn_to_retransn_patch , & ! Output: [real(r8) (:) ] livestemn_to_retransn => cnveg_nitrogenflux_inst%livestemn_to_retransn_patch,& ! Output: [real(r8) (:) ] livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) livestem N - livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) livestem N frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N sminn_vr => soilbiogeochem_nitrogenstate_inst%sminn_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral N btran => energyflux_inst%btran_patch , & ! Input: [real(r8) (:) ] transpiration wetness factor (0 to 1) @@ -1409,7 +1367,7 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & ) ! set time steps - dt = real( get_step_size(), r8 ) + dt = get_step_size_real() ! set number of days to recover negative cpool dayscrecover = params_inst%dayscrecover ! loop over patches to assess the total plant N demand @@ -1694,32 +1652,7 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & ! leaf CN ratio this%actual_leafcn(p) = leafc(p) / leafn(p) end if - ! WW added here to simplify diagnostics - if (leafn_storage(p) < n_min ) then - this%actual_storage_leafcn(p) = spval - else - this%actual_storage_leafcn(p) = leafc_storage(p) / leafn_storage(p) - end if - - - ! when we have "if (livestemn(p) == 0.0_r8)" below then we - ! have floating overflow (out of floating point range) - ! error in "actual_livestemcn(p) = livestemc(p) / livestemn(p)" - if (woody(ivt(p)) == 1.0_r8) then - if (livestemn(p) < n_min ) then - ! to avoid division by zero, and to set livestemcn to missing value for history files - this%actual_livestemcn(p) = spval - else - ! livestem CN ratio - this%actual_livestemcn(p) = livestemc(p) / livestemn(p) - end if - - if (livestemn_storage(p) < n_min ) then - this%actual_livestemcn_storage(p) = spval - else - this%actual_livestemcn_storage(p) = livestemc(p) / livestemn_storage(p) - end if - end if + if (nscalar_opt) then From 10c6a26c092f693b45648f5f6368a606c8767296 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 30 Jun 2020 16:52:41 -0600 Subject: [PATCH 434/556] Work on LILACSMOKE test Steps up through running make_runtime_inputs are working Note that I needed to replace tabs with spaces in a few template files --- cime_config/SystemTests/lilacsmoke.py | 98 ++++++++++++++++++- lilac/bld_templates/atm_driver_in | 22 ++--- .../config_machines_template.xml | 18 ++-- lilac/bld_templates/ctsm_template.cfg | 4 +- 4 files changed, 119 insertions(+), 23 deletions(-) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index 1dce6bb175..0fabc838df 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -6,9 +6,10 @@ """ import os +import shutil from CIME.SystemTests.system_tests_common import SystemTestsCommon -from CIME.utils import run_cmd_no_fail, append_testlog +from CIME.utils import run_cmd_no_fail, append_testlog, symlink_force from CIME.build import post_build from CIME.test_status import GENERATE_PHASE, BASELINE_PHASE, TEST_PASS_STATUS from CIME.XML.standard_module_setup import * @@ -58,11 +59,106 @@ def build_phase(self, sharedlib_only=False, model_only=False): build_dir=build_dir) self._run_build_cmd(cmd, exeroot, 'rebuild_ctsm.bldlog') + self._build_atm_driver() + + self._create_runtime_inputs() + # Setting logs=[] implies that we don't bother gzipping any of the build log # files; that seems fine for these purposes (and it keeps the above code # simpler). post_build(self._case, logs=[], build_complete=True) + def _build_atm_driver(self): + caseroot = self._case.get_value('CASEROOT') + lndroot = self._case.get_value('COMP_ROOT_DIR_LND') + blddir = os.path.join(caseroot, 'lilac_atm_driver', 'bld') + + if not os.path.exists(blddir): + os.makedirs(blddir) + symlink_force(os.path.join(lndroot, 'lilac', 'atm_driver', 'Makefile'), + os.path.join(blddir, 'Makefile')) + symlink_force(os.path.join(lndroot, 'lilac', 'atm_driver', 'atm_driver.F90'), + os.path.join(blddir, 'atm_driver.F90')) + symlink_force(os.path.join(caseroot, 'Macros.make'), + os.path.join(blddir, 'Macros.make')) + + makevars = 'COMPILER={compiler} DEBUG={debug} CTSM_MKFILE={ctsm_mkfile}'.format( + compiler=self._case.get_value('COMPILER'), + debug=str(self._case.get_value('DEBUG')).upper(), + ctsm_mkfile=os.path.join(caseroot, 'lilac_build', 'ctsm.mk')) + makecmd = 'make {makevars} atm_driver'.format(makevars=makevars) + self._run_build_cmd(makecmd, blddir, 'atm_driver.bldlog') + + def _create_runtime_inputs(self): + caseroot = self._case.get_value('CASEROOT') + lnd_domain_file = os.path.join(self._case.get_value('LND_DOMAIN_PATH'), + self._case.get_value('LND_DOMAIN_FILE')) + + # Cheat a bit here: Get the fsurdat file from the already-generated lnd_in file in + # the host test case - i.e., from the standard cime-based preview_namelists. But + # this isn't really a morally-objectionable cheat, because in the real workflow, + # we expect the user to identify fsurdat manually; in this testing situation, we + # need to come up with some way to replace this manual identification, so cheating + # feels acceptable. + self._case.create_namelists(component='lnd') + fsurdat = self._extract_var_from_namelist( + nl_filename=os.path.join(caseroot, 'CaseDocs', 'lnd_in'), + varname='fsurdat') + + self._fill_in_ctsm_cfg(lnd_domain_file=lnd_domain_file, + fsurdat=fsurdat) + + self._run_build_cmd('make_runtime_inputs --rundir {}'.format(self._runtime_inputs_dir()), + self._runtime_inputs_dir(), + 'make_runtime_inputs.log') + + def _extract_var_from_namelist(self, nl_filename, varname): + """Tries to find a variable named varname in the given file; returns its value + + If not found, aborts + """ + with open(nl_filename) as nl_file: + for line in nl_file: + match = re.search(r'^ *{} *= *[\'"]([^\'"]+)'.format(varname), line) + if match: + return match.group(1) + expect(False, '{} not found in {}'.format(varname, nl_filename)) + + def _fill_in_ctsm_cfg(self, lnd_domain_file, fsurdat): + caseroot = self._case.get_value('CASEROOT') + runtime_inputs = self._runtime_inputs_dir() + if not os.path.exists(os.path.join(runtime_inputs, 'ctsm.cfg.orig')): + shutil.copyfile(src=os.path.join(runtime_inputs, 'ctsm.cfg'), + dst=os.path.join(runtime_inputs, 'ctsm.cfg.orig')) + os.remove(os.path.join(runtime_inputs, 'ctsm.cfg')) + + with open(os.path.join(runtime_inputs, 'ctsm.cfg.orig')) as ctsm_cfg_orig: + with open(os.path.join(runtime_inputs, 'ctsm.cfg'), 'w') as ctsm_cfg: + for line_orig in ctsm_cfg_orig: + line = line_orig + line = self._fill_in_variable(line=line, + varname='lnd_domain_file', + value=lnd_domain_file) + line = self._fill_in_variable(line=line, + varname='fsurdat', + value=fsurdat) + ctsm_cfg.write(line) + + def _fill_in_variable(self, line, varname, value): + """Fill in a FILL_THIS_IN variable in a config or namelist file + + Returns the line with FILL_THIS_IN replaced with the given value if this line is + for varname; otherwise returns line unchanged. + """ + if re.search(r'^ *{} *='.format(varname), line): + newline = line.replace('FILL_THIS_IN', value) + else: + newline = line + return newline + + def _runtime_inputs_dir(self): + return os.path.join(self._case.get_value('CASEROOT'), 'lilac_build', 'runtime_inputs') + def run_phase(self): # FIXME(wjs, 2020-06-10) Fill this in pass diff --git a/lilac/bld_templates/atm_driver_in b/lilac/bld_templates/atm_driver_in index de8b9a6bd3..5289d930a9 100644 --- a/lilac/bld_templates/atm_driver_in +++ b/lilac/bld_templates/atm_driver_in @@ -1,18 +1,18 @@ &atm_driver_input caseid = 'test_lilac' - atm_mesh_file = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + atm_mesh_file = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' atm_global_nx = 72 atm_global_ny = 46 - atm_timestep = 1800 - atm_calendar = 'NOLEAP' - atm_start_year = 2000 - atm_stop_year = 2000 - atm_start_mon = 1 - atm_stop_mon = 1 - atm_start_secs = 0 - atm_stop_secs = 0 - atm_start_day = 1 - atm_stop_day = 3 + atm_timestep = 1800 + atm_calendar = 'NOLEAP' + atm_start_year = 2000 + atm_stop_year = 2000 + atm_start_mon = 1 + atm_stop_mon = 1 + atm_start_secs = 0 + atm_stop_secs = 0 + atm_start_day = 1 + atm_stop_day = 3 atm_starttype = 'startup' atm_ndays_all_segs = 2 / diff --git a/lilac/bld_templates/config_machines_template.xml b/lilac/bld_templates/config_machines_template.xml index 29e2bf79f2..a197e02dfa 100644 --- a/lilac/bld_templates/config_machines_template.xml +++ b/lilac/bld_templates/config_machines_template.xml @@ -18,14 +18,14 @@ Temporary build information for a CTSM build + compiled programs as -DVALUE recognized are LINUX, AIX, Darwin, CNL --> $OS $COMPILER + the case/bld and case/run directories are written below here --> $CIME_OUTPUT_ROOT + inputdata is downloaded automatically on a case by case basis as + long as the user has write access to this directory. --> $$CIME_OUTPUT_ROOT/inputdata + forcing data --> $$CIME_OUTPUT_ROOT/inputdata @@ -99,8 +99,8 @@ 379.0 +336.6 +340.6 379.0 388.8 397.5 @@ -503,13 +505,14 @@ attributes from the config_cache.xml file (with keys converted to upper-case). --> -75 +61 -1850,2000,2010 +1850,1982,2000,2010 .true. +.true. .true. .true. .true. @@ -580,6 +583,14 @@ attributes from the config_cache.xml file (with keys converted to upper-case). >hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 +hgrid=ne0np4.ARCTIC.ne30x4 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 + + +hgrid=ne120np4.pg3 maxpft=79 mask=tx0.1v3 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + lnd/clm2/initdata_map/clmi.I2000Clm50BgcCrop.2011-01-01.1.9x2.5_gx1v7_gl4_simyr2000_c190312.nc + +/glade/work/aherring/grids/var-res/ne0np4.ARCTIC.ne30x4/inic/FHIST_ARCTIC_ne30x4_mt12_1979bc-mg3.clm2.r.1982-01-01-00000_c200424.nc + + + +/glade/work/aherring/grids/uniform-res/ne120np4.pg3/inic/F2000climoBgcCrop_ne120pg3_ne120pg3_mt13_7680pes.clm2.r.06-01-00000_c200506.nc + + lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc +lnd/clm2/surfdata_map/landuse.timeseries_ne0np4.ARCTIC.ne30x4_hist_78pfts_CMIP6_simyr1850-2015_c191023.nc diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 1922748956..87bdc98c60 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1990,7 +1990,7 @@ If 1, turn on the MEGAN model for BVOC's (Biogenic Volitile Organic Compounds) +"PtVg,1000,850,1100,1350,1600,1850,1855,1865,1875,1885,1895,1905,1915,1925,1935,1945,1955,1965,1975,1979,1980,1982,1985,1995,2000,2005,2010,2015,2025,2035,2045,2055,2065,2075,2085,2095,2105"> Year to simulate and to provide datasets for (such as surface datasets, initial conditions, aerosol-deposition, Nitrogen deposition rates etc.) A sim_year of 1000 corresponds to data used for testing only, NOT corresponding to any real datasets. A sim_year greater than 2015 corresponds to ssp_rcp scenario data @@ -2028,8 +2028,8 @@ Attributes to use when looking for an initial condition file (finidat) if interp How close in years to use when looking for an initial condition file (finidat) if interpolation is turned on (use_init_interp is .true.) - + Simulation years you can look for in initial condition files (finidat) if interpolation is turned on (use_init_interp is .true.) From e3f0d5acd1de6d859888cf4cb3fd8992b6b1d109 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 1 Jul 2020 13:19:38 -0600 Subject: [PATCH 446/556] Increase number of tests because of increase in number of grids --- bld/unit_testers/build-namelist_test.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index c833f44d3d..ce7fb1621d 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,9 +138,9 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 842; +my $ntests = 870; if ( defined($opts{'compare'}) ) { - $ntests += 510; + $ntests += 531; } plan( tests=>$ntests ); From 8e8d557327aa5b0d943174669ba49571a4cd3fcd Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 1 Jul 2020 14:26:11 -0600 Subject: [PATCH 447/556] atm_driver Makefile: add LDFLAGS This is needed when building with a user-defined machine on my mac --- lilac/atm_driver/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lilac/atm_driver/Makefile b/lilac/atm_driver/Makefile index a3a594189b..8a50eedb0b 100644 --- a/lilac/atm_driver/Makefile +++ b/lilac/atm_driver/Makefile @@ -29,7 +29,7 @@ atm_driver.o : $(CURDIR)/atm_driver.F90 $(MPIFC) -c $(CTSM_INCLUDES) $(FFLAGS) $< atm_driver: atm_driver.o - $(MPIFC) -o $@ $^ $(CTSM_LIBS) + $(MPIFC) -o $@ $^ $(LDFLAGS) $(CTSM_LIBS) mv atm_driver atm_driver.exe # module dependencies: From a5f0f1cb78992801d626b2e6b5c6b043523c4e67 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 1 Jul 2020 16:48:03 -0600 Subject: [PATCH 448/556] Add documentation on lilac restarts --- .../obtaining-building-and-running/index.rst | 1 + .../restarting.rst | 30 +++++++++++++++++++ 2 files changed, 31 insertions(+) create mode 100644 doc/source/lilac/obtaining-building-and-running/restarting.rst diff --git a/doc/source/lilac/obtaining-building-and-running/index.rst b/doc/source/lilac/obtaining-building-and-running/index.rst index 7f18c180f7..14dc6f40be 100644 --- a/doc/source/lilac/obtaining-building-and-running/index.rst +++ b/doc/source/lilac/obtaining-building-and-running/index.rst @@ -9,3 +9,4 @@ obtaining-and-building-ctsm.rst setting-ctsm-runtime-options.rst + restarting.rst diff --git a/doc/source/lilac/obtaining-building-and-running/restarting.rst b/doc/source/lilac/obtaining-building-and-running/restarting.rst new file mode 100644 index 0000000000..e5e6c4ae1b --- /dev/null +++ b/doc/source/lilac/obtaining-building-and-running/restarting.rst @@ -0,0 +1,30 @@ +.. highlight:: shell + +.. _restarting: + +===================================== + Continuing a run from restart files +===================================== + +All of the information that CTSM and LILAC need to continue a run from restart files is +given in the restart files themselves. No namelist changes need to be made (other than +whatever is needed in the host atmosphere model), but the ``starttype_in`` argument to the +``lilac_init2`` subroutine call from the atmosphere model will need to be changed to +"continue" rather than "startup". + +CTSM and LILAC use ``rpointer`` files to indicate the specific restart files that should +be read. These files, ``rpointer.lnd`` and ``rpointer.lilac``, are one-line text files +that simply specify the name of the respective restart files. When restart files are +written (according to the ``write_restarts_now`` argument to the ``lilac_run`` +subroutine), these ``rpointer`` files are updated to point to the latest set of restarts. + +If you want to restart from the latest set of restart files, the ``rpointer`` files should +already be set up to facilitate this. However, if you want to restart from an earlier set +of restarts, you can simply edit ``rpointer.lnd`` and ``rpointer.lilac`` to point to the +appropriate restart files. + +.. important:: + + Be sure that the ``rpointer.lnd`` and ``rpointer.lilac`` files point to restart files + from the same time as each other, and from the same time as the atmosphere model's + restart time. From 4cf744e769f739ed41b53ce9d81991c31a0a7caa Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 1 Jul 2020 17:44:31 -0600 Subject: [PATCH 449/556] Point back to a master tag of mosart I'm not ready to bring the mosart branch in, and it's not needed yet because we're not yet running LILAC with MOSART. I have opened a PR for it to bring in later: https://github.com/ESCOMP/MOSART/pull/32 --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index 70a5819f5c..43e4b64988 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -23,7 +23,7 @@ required = True local_path = components/mosart protocol = git repo_url = https://github.com/ESCOMP/MOSART -hash = a108912c6b2fb2294abbfb720ad151cde76f9845 +tag = mosart1_0_36 required = True [cime] From a1b038683c0c0038a03372c81c4a2ca62c04bfd9 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 2 Jul 2020 12:08:59 -0600 Subject: [PATCH 450/556] Use a stub rof rather than mosart with lilac This change is important in the short-term, at least, because I'm not ready to bring the mosart lilac_cap branch to master, so we're pointing to a version of mosart that doesn't have the necessary changes - see https://github.com/ESCOMP/MOSART/pull/32. Once those MOSART changes are on MOSART's master branch, then we should change buildlib back to using the MOSART source code rather than stub rof. We may want to do this conditionally, depending on whether rof coupling is actually wanted in the given run. (I at first thought that we could let the cime build build mosart for us, but then realized that the current mechanism is needed because lilac depends on the mosart code; also, mosart is not built during the --sharedlib build phase.) Note: I have NOT given careful thought to the changes in lilac_mod.F90: It seems right to put this rof-related code inside a conditional, but I haven't done a careful analysis to determine if that's correct. --- cime_config/buildlib | 6 +-- lilac/src/lilac_mod.F90 | 90 ++++++++++++++++++-------------- lilac/stub_rof/rof_comp_esmf.F90 | 30 +++++++++++ 3 files changed, 83 insertions(+), 43 deletions(-) create mode 100644 lilac/stub_rof/rof_comp_esmf.F90 diff --git a/cime_config/buildlib b/cime_config/buildlib index 569ef99914..9e87bad732 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -123,9 +123,9 @@ def _main_func(): if lilac_mode == 'on': paths.append(os.path.join(lnd_root,"lilac","src")) - mosart_src = os.path.join(lnd_root,"components","mosart","src") - paths.append(os.path.join(mosart_src,"riverroute")) - paths.append(os.path.join(mosart_src,"cpl","lilac")) + # If we want to build with a real river model (e.g., MOSART), we'll need + # to use its directories in place of stub_rof + paths.append(os.path.join(lnd_root,"lilac","stub_rof")) with open(filepath_file, "w") as filepath: filepath.write("\n".join(paths)) diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 1900e1281b..b233896424 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -245,12 +245,14 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & write(logunit,*) trim(subname) // " ctsm gridded component created" end if - cname = " MOSART " - rof_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac mosart initialization') - call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) - if (mytask == 0) then - write(logunit,*) trim(subname) // " mosart gridded component created" + if (couple_to_river) then + cname = " MOSART " + rof_gcomp = ESMF_GridCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac mosart initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " mosart gridded component created" + end if end if cname = "Coupler from atmosphere to land" @@ -269,20 +271,22 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & write(logunit,*) trim(subname) // " coupler component (land to atmosphere) created" end if - cname = "Coupler from river to land" - cpl_rof2lnd_comp = ESMF_CplCompCreate(name=cname, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_r2l initialization') - call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) - if (mytask == 0) then - write(logunit,*) trim(subname) // " coupler component (atmosphere to land) created" - end if + if (couple_to_river) then + cname = "Coupler from river to land" + cpl_rof2lnd_comp = ESMF_CplCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_r2l initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler component (river to land) created" + end if - cname = "Coupler from land to river" - cpl_lnd2rof_comp = ESMF_CplCompCreate(name=cname, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_l2r initialization') - call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) - if (mytask == 0) then - write(logunit,*) trim(subname) // " coupler component (land to atmosphere) created" + cname = "Coupler from land to river" + cpl_lnd2rof_comp = ESMF_CplCompCreate(name=cname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('error lilac cpl_l2r initialization') + call ESMF_LogWrite(subname//"Created "//trim(cname)//" component", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler component (land to river) created" + end if end if !------------------------------------------------------------------------- @@ -307,13 +311,15 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & write(logunit,*) trim(subname) // " CTSM setservices finished" end if - ! Register section -- set services -- mosart - call ESMF_GridCompSetServices(rof_gcomp, userRoutine=rof_register, userRc=user_rc, rc=rc) - if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('rof_gcomp register failure') - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('rof_gcomp register failure') - call ESMF_LogWrite(subname//"MOSART SetServices finished!", ESMF_LOGMSG_INFO) - if (mytask == 0) then - write(logunit,*) trim(subname) // " CTSM setservices finished" + if (couple_to_river) then + ! Register section -- set services -- mosart + call ESMF_GridCompSetServices(rof_gcomp, userRoutine=rof_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('rof_gcomp register failure') + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('rof_gcomp register failure') + call ESMF_LogWrite(subname//"MOSART SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " CTSM setservices finished" + end if end if ! Register section -- set services -- coupler atmosphere to land @@ -325,13 +331,15 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & write(logunit,*) trim(subname) // " coupler from atmosphere to land setservices finished" end if - ! Register section -- set services -- river to land - call ESMF_CplCompSetServices(cpl_rof2lnd_comp, userRoutine=cpl_rof2lnd_register, userRc=user_rc, rc=rc) - if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_rof2lnd_comp register failure') - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_rof2lnd_comp register failure') - call ESMF_LogWrite(subname//"Coupler from river to land SetServices finished!", ESMF_LOGMSG_INFO) - if (mytask == 0) then - write(logunit,*) trim(subname) // " coupler from river to land setservices finished" + if (couple_to_river) then + ! Register section -- set services -- river to land + call ESMF_CplCompSetServices(cpl_rof2lnd_comp, userRoutine=cpl_rof2lnd_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_rof2lnd_comp register failure') + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_rof2lnd_comp register failure') + call ESMF_LogWrite(subname//"Coupler from river to land SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler from river to land setservices finished" + end if end if ! Register section -- set services -- coupler land to atmosphere @@ -343,13 +351,15 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & write(logunit,*) trim(subname) // " coupler from land to atmosphere setservices finished" end if - ! Register section -- set services -- coupler land to river - call ESMF_CplCompSetServices(cpl_lnd2rof_comp, userRoutine=cpl_lnd2rof_register, userRc=user_rc, rc=rc) - if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2rof_comp register failure') - if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2rof_comp register failure') - call ESMF_LogWrite(subname//"Coupler from land to river SetServices finished!", ESMF_LOGMSG_INFO) - if (mytask == 0) then - write(logunit,*) trim(subname) // " coupler from land to river setservices finished" + if (couple_to_river) then + ! Register section -- set services -- coupler land to river + call ESMF_CplCompSetServices(cpl_lnd2rof_comp, userRoutine=cpl_lnd2rof_register, userRc=user_rc, rc=rc) + if (chkerr(user_rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2rof_comp register failure') + if (chkerr(rc,__LINE__,u_FILE_u)) call shr_sys_abort('cpl_lnd2rof_comp register failure') + call ESMF_LogWrite(subname//"Coupler from land to river SetServices finished!", ESMF_LOGMSG_INFO) + if (mytask == 0) then + write(logunit,*) trim(subname) // " coupler from land to river setservices finished" + end if end if !------------------------------------------------------------------------- diff --git a/lilac/stub_rof/rof_comp_esmf.F90 b/lilac/stub_rof/rof_comp_esmf.F90 new file mode 100644 index 0000000000..d708818e0d --- /dev/null +++ b/lilac/stub_rof/rof_comp_esmf.F90 @@ -0,0 +1,30 @@ +module rof_comp_esmf + + ! ------------------------------------------------------------------------ + ! This is a stub version of rof_comp_esmf that can be used when we don't have a true + ! rof component, just to satisfy the necessary interfaces in LILAC. + ! ------------------------------------------------------------------------ + + use ESMF + + implicit none + private + + public :: rof_register + +!=============================================================================== +contains +!=============================================================================== + + subroutine rof_register(comp, rc) + + ! Stub rof_register routine - shouldn't ever be called! + + ! input/output argumenents + type(ESMF_GridComp) :: comp ! ROF grid component + integer, intent(out) :: rc ! return status + + rc = ESMF_RC_NOT_IMPL + end subroutine rof_register + +end module rof_comp_esmf From bfbb37b5844029ca0f0265003910aca074db5f1c Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 2 Jul 2020 14:58:20 -0600 Subject: [PATCH 451/556] Use PIO1 with LILAC for now PIO2 is the default when using the nuopc driver, which we use when building a lilac case. However, we are seeing deaths in pio sometimes (see https://github.com/ESCOMP/CTSM/issues/876#issuecomment-653189406 and following comments in that issue). So let's try PIO1 for now. --- python/ctsm/lilac_build_ctsm.py | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index 184dd614fe..90f147428d 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -624,6 +624,11 @@ def _create_case(cime_path, build_dir, compiler, run_cmd_output_on_error(create_newcase_cmd, errmsg='Problem creating CTSM case directory') + # PIO2 sometimes causes errors: see + # https://github.com/ESCOMP/CTSM/issues/876#issuecomment-653189406 and following + # comments in that issue. So use PIO1 for now. + subprocess.check_call([xmlchange, 'PIO_VERSION=1'], cwd=case_dir) + subprocess.check_call([xmlchange, 'LILAC_MODE=on'], cwd=case_dir) if build_debug: subprocess.check_call([xmlchange, 'DEBUG=TRUE'], cwd=case_dir) From 72ac4268851d6ed6e430204a8a0865dfe32e9e1a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 2 Jul 2020 16:38:16 -0600 Subject: [PATCH 452/556] Get Fortran unit tests passing Needed to remove some arguments to the time manager that no longer exist --- src/unit_test_shr/unittestTimeManagerMod.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/unit_test_shr/unittestTimeManagerMod.F90 b/src/unit_test_shr/unittestTimeManagerMod.F90 index 72ff57b9b9..b22cea2e65 100644 --- a/src/unit_test_shr/unittestTimeManagerMod.F90 +++ b/src/unit_test_shr/unittestTimeManagerMod.F90 @@ -63,7 +63,6 @@ subroutine unittest_timemgr_setup(dtime) ! Set ymd values to be year N, month 1, day 1 integer, parameter :: start_ymd = 10101 integer, parameter :: ref_ymd = start_ymd - integer, parameter :: stop_ymd = 20101 integer, parameter :: perpetual_ymd = start_ymd ! Set current time to be at the start of year 1 @@ -92,11 +91,8 @@ subroutine unittest_timemgr_setup(dtime) start_tod_in = 0, & ref_ymd_in = ref_ymd, & ref_tod_in = 0, & - stop_ymd_in = stop_ymd, & - stop_tod_in = 0, & perpetual_run_in = .false., & perpetual_ymd_in = perpetual_ymd, & - nelapse_in = 1, & dtime_in = l_dtime) call timemgr_init() From d018f7d9f5e14bb57829efcff0aa098439a1bfd5 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 2 Jul 2020 20:44:24 -0600 Subject: [PATCH 453/556] Link runtime input files into lilac atm run directory --- cime_config/SystemTests/lilacsmoke.py | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index e05450360e..855ddb0ffc 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -150,6 +150,7 @@ def _create_runtime_inputs(self): 'download_input_data.log') def _setup_atm_driver_rundir(self): + """Set up the directory from which we will actually do the run""" caseroot = self._case.get_value('CASEROOT') lndroot = self._case.get_value('COMP_ROOT_DIR_LND') rundir = os.path.join(caseroot, 'lilac_atm_driver', 'run') @@ -159,7 +160,7 @@ def _setup_atm_driver_rundir(self): shutil.copyfile(src=os.path.join(lndroot, 'lilac', 'atm_driver', 'atm_driver_in'), dst=os.path.join(rundir, 'atm_driver_in')) - # As above: assume the land variables also apply to the atmosphere + # As elsewhere: assume the land variables also apply to the atmosphere lnd_mesh = self._case.get_value('LND_DOMAIN_MESH') lnd_nx = self._case.get_value('LND_NX') lnd_ny = self._case.get_value('LND_NY') @@ -174,6 +175,10 @@ def _setup_atm_driver_rundir(self): 'atm_stop_day':str(stop_n+1), 'atm_ndays_all_segs':str(stop_n)}) + for file_to_link in ['lnd_in', 'lnd_modelio.nml', 'lilac_in']: + symlink_force(os.path.join(self._runtime_inputs_dir(), file_to_link), + os.path.join(rundir, file_to_link)) + def _extract_var_from_namelist(self, nl_filename, varname): """Tries to find a variable named varname in the given file; returns its value From 60cc7a45c30738746b4375df10135be5938cb4d3 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 2 Jul 2020 21:39:03 -0600 Subject: [PATCH 454/556] Use a compset with SATM for testing LILAC MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When the test used compset `I2000Clm50SpRsGs`, it was dying on my mac in `case.submit` because the necessary datm data were not available, and it seems that `DIN_LOC_ROOT_CLMFORC` isn't set on my mac... and I wouldn't want it to try to download all of these data anyway. It doesn't look like there's a way to bypass the downloading of input data in the test case. So I'm switching to a test compset that uses SATM: `LILACSMOKE_Vnuopc_P4x1_D.f10_f10_musgs.I2000Ctsm50NwpSpAsRsGs.bishorn_gnu.clm-lilac`. It seems best to keep the `build_ctsm` compset consistent with this – though I don't think it's actually necessary – so I'm making the change there, too. I compared the namelists (`atm_driver_in`, `lnd_in`, `lnd_modelio.nml` and `lilac_in`) between this test case and `LILACSMOKE_Vnuopc_P4x1_D.f10_f10_musgs.I2000Clm50SpRsGs.bishorn_gnu.clm-lilac`. They are identical other than differences in inputdata paths (as expected): GOOD. (This confirms, among other things, that I have set up the tuning mode correctly, and that nothing else depends on using DATM vs. SATM.) --- cime_config/config_component.xml | 4 ++++ cime_config/config_compsets.xml | 12 ++++++++++++ python/ctsm/lilac_build_ctsm.py | 4 ++-- 3 files changed, 18 insertions(+), 2 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 545c17d9c4..c09daffb8d 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -68,10 +68,14 @@ clm4_5_CRUv7 clm4_5_GSWP3v1 clm4_5_cam6.0 + + clm4_5_GSWP3v1 clm5_0_CRUv7 clm5_0_CRUv7 clm5_0_GSWP3v1 clm5_0_cam6.0 + + clm5_0_GSWP3v1 diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 6c552f8dc8..87349d0c24 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -499,6 +499,18 @@ HIST_DATM%GSWP3v1_CLM50%BGC-CROP_SICE_SOCN_MOSART_CISM2%EVOLVE_SWAV + + + I2000Ctsm50NwpSpAsRsGs + 2000_SATM_CLM50%NWP-SP_SICE_SOCN_SROF_SGLC_SWAV + + diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index 90f147428d..1824256705 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -22,8 +22,8 @@ # these are arbitrary, since we only use the case for its build, not any of the runtime # settings; they just need to be valid -_COMPSET = 'I2000Ctsm50NwpSpNldasRsGs' -_RES = 'nldas2_rnldas2_mnldas2' +_COMPSET = 'I2000Ctsm50NwpSpAsRsGs' +_RES = 'f10_f10_musgs' _PATH_TO_TEMPLATES = os.path.join(path_to_ctsm_root(), 'lilac', From 7c42be99713380b9681bda94f9e055d4fbc4f189 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 2 Jul 2020 22:41:24 -0600 Subject: [PATCH 455/556] lilacsmoke: get the run off the ground It's currently failing due to a too-long filename. I'll need to fix that next. --- cime_config/SystemTests/lilacsmoke.py | 33 ++++++++++++++++++++++----- 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index 855ddb0ffc..370e17262b 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -12,7 +12,7 @@ import shutil from CIME.SystemTests.system_tests_common import SystemTestsCommon -from CIME.utils import run_cmd_no_fail, append_testlog, symlink_force +from CIME.utils import run_cmd_no_fail, append_testlog, symlink_force, new_lid from CIME.build import post_build from CIME.test_status import GENERATE_PHASE, BASELINE_PHASE, TEST_PASS_STATUS from CIME.XML.standard_module_setup import * @@ -49,6 +49,9 @@ def build_phase(self, sharedlib_only=False, model_only=False): build_dir=build_dir, machine=machine, compiler=compiler) + # It isn't straightforward to determine if pnetcdf is available on a + # machine. To keep things simple, always run without pnetcdf. + cmd += ' --no-pnetcdf' if debug: cmd += ' --build-debug' self._run_build_cmd(cmd, exeroot, 'build_ctsm.bldlog') @@ -64,6 +67,8 @@ def build_phase(self, sharedlib_only=False, model_only=False): self._build_atm_driver() + self._create_link_to_atm_driver() + self._create_runtime_inputs() self._setup_atm_driver_rundir() @@ -94,6 +99,15 @@ def _build_atm_driver(self): makecmd = 'make {makevars} atm_driver'.format(makevars=makevars) self._run_build_cmd(makecmd, blddir, 'atm_driver.bldlog') + def _create_link_to_atm_driver(self): + caseroot = self._case.get_value('CASEROOT') + run_exe = (self._case.get_value('run_exe')).strip() + + # Make a symlink to the atm_driver executable so that the case's run command finds + # it in the expected location + symlink_force(os.path.join(caseroot, 'lilac_atm_driver', 'bld', 'atm_driver.exe'), + run_exe) + def _create_runtime_inputs(self): caseroot = self._case.get_value('CASEROOT') runtime_inputs = self._runtime_inputs_dir() @@ -151,9 +165,8 @@ def _create_runtime_inputs(self): def _setup_atm_driver_rundir(self): """Set up the directory from which we will actually do the run""" - caseroot = self._case.get_value('CASEROOT') lndroot = self._case.get_value('COMP_ROOT_DIR_LND') - rundir = os.path.join(caseroot, 'lilac_atm_driver', 'run') + rundir = self._atm_driver_rundir() if not os.path.exists(rundir): os.makedirs(rundir) @@ -261,6 +274,9 @@ def _verify_inputdata_link(self): def _runtime_inputs_dir(self): return os.path.join(self._case.get_value('CASEROOT'), 'lilac_build', 'runtime_inputs') + def _atm_driver_rundir(self): + return os.path.join(self._case.get_value('CASEROOT'), 'lilac_atm_driver', 'run') + @staticmethod def _run_build_cmd(cmd, exeroot, logfile): """ @@ -277,6 +293,11 @@ def _run_build_cmd(cmd, exeroot, logfile): append_testlog(lf.read()) def run_phase(self): - # FIXME(wjs, 2020-06-10) Fill this in - pass - + # This mimics a bit of what's done in the typical case.run. Note that + # case.get_mpirun_cmd creates a command that runs the executable given by + # case.run_exe. So it's important that (elsewhere in this test script) we create a + # link pointing from that to the atm_driver.exe executable. + lid = new_lid() + os.environ["OMP_NUM_THREADS"] = str(self._case.thread_count) + cmd = self._case.get_mpirun_cmd(allow_unresolved_envvars=False) + run_cmd_no_fail(cmd, from_dir=self._atm_driver_rundir()) From 1bab80b90cda23f596761d6525ab630e8cb8f329 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 2 Jul 2020 23:24:06 -0600 Subject: [PATCH 456/556] LILAC build_ctsm: Stop making sym link to existing inputdata directory The initial motivation for this change was that the LILAC system test was failing because the full path to the aerosol deposition file was too long (longer than 256 characters), because the path to the inputdata sym link was very long. I thought about allowing a longer name, but this would involve changes in CIME's stream code, and I didn't want to go there. So I decided to stop using this sym link and instead just use the true path to the inputdata directory. After making this change, I started feeling like this is an improvement even without the motivation of the system test: sym links can be confusing, and it seems more intuitive to just point to files in their "real" location. --- cime_config/SystemTests/lilacsmoke.py | 18 +------------ python/ctsm/lilac_build_ctsm.py | 27 +++---------------- python/ctsm/lilac_download_input_data.py | 3 --- python/ctsm/test/test_sys_lilac_build_ctsm.py | 7 +++-- 4 files changed, 7 insertions(+), 48 deletions(-) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index 370e17262b..fe05cb7045 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -149,16 +149,7 @@ def _create_runtime_inputs(self): placeholders={'lilac_histfreq_option':'never'}) # We run download_input_data partly because it may be needed and partly to test - # this script. Note, though, that some files (the surface dataset, land domain - # file, and land/atm mesh file) will not be downloaded automatically: Because of - # the way this test fills in these file paths, they end up pointing to the true - # inputdata directory on this machine rather than the sym linked one in - # lilac_build_dir (which kind of makes sense, because this simulates files that - # the user would provide themselves). Thus, these files live outside of the - # inputdata root considered by download_input_data. So if these files are missing, - # they will need to be downloaded manually (e.g., using check_input_data from the - # test case). - self._verify_inputdata_link() + # this script. self._run_build_cmd('download_input_data --rundir {}'.format(runtime_inputs), runtime_inputs, 'download_input_data.log') @@ -264,13 +255,6 @@ def _fill_in_variable(self, line, varname, value, placeholder): replacement_done = False return (newline, replacement_done) - def _verify_inputdata_link(self): - """Verify that the inputdata link has been set up correctly""" - din_loc_root = self._case.get_value('DIN_LOC_ROOT') - inputdata = os.path.join(self._case.get_value('CASEROOT'), 'lilac_build', 'inputdata') - expect(os.path.realpath(inputdata) == os.path.realpath(din_loc_root), - 'inputdata not set up with the correct link') - def _runtime_inputs_dir(self): return os.path.join(self._case.get_value('CASEROOT'), 'lilac_build', 'runtime_inputs') diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index 1824256705..967542f356 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -179,17 +179,6 @@ def build_ctsm(cime_path, build_with_openmp=build_with_openmp, inputdata_path=inputdata_path) - if existing_inputdata: - # For a user-defined machine without inputdata_path specified, we create an - # inputdata directory for this case above. For an existing cime-ported machine, or - # one where inputdata_path is specified, we still want an inputdata directory - # alongside the other directories, but now it will just be a link to the real - # inputdata space on that machine. (Note that, for a user-defined machine, it's - # important that we have created this directory before creating the case, whereas - # for an existing machine, we need to wait until after we have created the case to - # know where to make the sym link point to.) - _link_to_inputdata(build_dir=build_dir) - _stage_runtime_inputs(build_dir=build_dir, no_pnetcdf=no_pnetcdf) print('Initial setup complete; it is now safe to work with the runtime inputs in\n' @@ -648,17 +637,6 @@ def _create_case(cime_path, build_dir, compiler, make_link(os.path.join(case_dir, '.env_mach_specific.{}'.format(extension)), os.path.join(build_dir, 'ctsm_build_environment.{}'.format(extension))) -def _link_to_inputdata(build_dir): - """Make a sym link to an existing inputdata directory - - Args: - build_dir (str): path to build directory - """ - inputdata_dir = _xmlquery('DIN_LOC_ROOT', build_dir) - - make_link(inputdata_dir, - os.path.join(build_dir, _INPUTDATA_DIRNAME)) - def _stage_runtime_inputs(build_dir, no_pnetcdf): """Stage CTSM and LILAC runtime inputs @@ -668,15 +646,16 @@ def _stage_runtime_inputs(build_dir, no_pnetcdf): """ os.makedirs(os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME)) + inputdata_dir = _xmlquery('DIN_LOC_ROOT', build_dir) fill_template_file( path_to_template=os.path.join(_PATH_TO_TEMPLATES, 'ctsm_template.cfg'), path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'ctsm.cfg'), - substitutions={'INPUTDATA':os.path.join(build_dir, _INPUTDATA_DIRNAME)}) + substitutions={'INPUTDATA':inputdata_dir}) fill_template_file( path_to_template=os.path.join(_PATH_TO_TEMPLATES, 'lilac_in_template'), path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'lilac_in'), - substitutions={'INPUTDATA':os.path.join(build_dir, _INPUTDATA_DIRNAME)}) + substitutions={'INPUTDATA':inputdata_dir}) pio_stride = _xmlquery('MAX_MPITASKS_PER_NODE', build_dir) if no_pnetcdf: diff --git a/python/ctsm/lilac_download_input_data.py b/python/ctsm/lilac_download_input_data.py index cb64595d1b..1e0c240d25 100644 --- a/python/ctsm/lilac_download_input_data.py +++ b/python/ctsm/lilac_download_input_data.py @@ -41,9 +41,6 @@ def download_input_data(rundir): _create_lilac_input_data_list(rundir) case = Case(os.path.realpath(os.path.join(rundir, os.pardir, 'case'))) case.check_all_input_data( - # We deliberately do NOT use realpath in the following, since file names in - # namelists will use the inputdata symbolic link - input_data_root=os.path.abspath(os.path.join(rundir, os.pardir, 'inputdata')), data_list_dir=rundir, download=True, chksum=False) diff --git a/python/ctsm/test/test_sys_lilac_build_ctsm.py b/python/ctsm/test/test_sys_lilac_build_ctsm.py index 46158db6d3..74121ba90d 100755 --- a/python/ctsm/test/test_sys_lilac_build_ctsm.py +++ b/python/ctsm/test/test_sys_lilac_build_ctsm.py @@ -54,10 +54,9 @@ def test_buildSetup_userDefinedMachine_minimalInfo(self): # the critical piece of this test is that the above command doesn't generate any # errors; however we also do some assertions below - # ensure that inputdata directory was created and is NOT a sym link + # ensure that inputdata directory was created inputdata = os.path.join(build_dir, 'inputdata') self.assertTrue(os.path.isdir(inputdata)) - self.assertFalse(os.path.islink(inputdata)) def test_buildSetup_userDefinedMachine_allInfo(self): """Get through the case.setup phase with a user-defined machine @@ -92,9 +91,9 @@ def test_buildSetup_userDefinedMachine_allInfo(self): # the critical piece of this test is that the above command doesn't generate any # errors; however we also do some assertions below - # ensure that inputdata directory is a symlink pointing to the correct location + # ensure that inputdata directory is NOT created inputdata = os.path.join(build_dir, 'inputdata') - self.assertEqual(os.path.realpath(inputdata), inputdata_path) + self.assertFalse(os.path.exists(inputdata)) if __name__ == '__main__': unit_testing.setup_for_tests() From 8d24182dba844ad6d3e59edc361bf1e5a6530637 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 3 Jul 2020 00:08:54 -0600 Subject: [PATCH 457/556] some modifications and corrections... --- doc/source/lilac/specific-atm-models/wrf.rst | 236 ++++++++++--------- 1 file changed, 127 insertions(+), 109 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index e598d1e69d..559e4dcd2f 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -6,18 +6,28 @@ Using CTSM with WRF ===================== -This section describes the procedure for building and running the CTSM -library and its dependencies, and linking to these libraries in the WRF -model's build via LILAC. As such this section repeats some information -from earlier sections but in recipe form and with minimal explanation. +This section includes instructions on how to use WRF with CTSM using LILAC. +The procedure for building and running the CTSM library and its dependencies +repeats some information from earlier sections but with minimal explanation. .. important:: This section assumes use of a machine that has been ported to CIME. In this example we assume NCAR’s cheyenne computer in particular. -Clone CTSM Repository and Build CTSM ------------------------------------- + +Clone WRF and CTSM Repositories +------------------------------- + +Clone the WRF CTSM feature branch:: + + git clone https://github.com/billsacks/WRF.git + cd WRF + git checkout lilac_dev + +.. todo:: + + update the git address to WRF feature branch... Clone the CTSM repository:: @@ -30,133 +40,123 @@ Clone the CTSM repository:: Remove "git checkout lilac_cap" from the above when ready -Build CTSM and its dependencies based on the instructions from previous sections, -for example on Cheyenne:: - ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne +Build CTSM and its dependencies +------------------------------- -Source ctsm_build_environment.sh (bash environment):: +Build CTSM and its dependencies based on the instructions from previous sections :: - source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh + ./lilac/build_ctsm /PATH/TO/CTSM/BUILD --machine MACHINE --compiler COMPILER -or ctsm_build_environment.csh (Cshell environment): +For example on `Cheyenne:` for `Intel` compiler:: -.. code-block:: Tcsh + ./lilac/build_ctsm /glade/scratch/$USER/ctsm_build_dir --compiler intel --machine cheyenne - source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.csh .. note:: - For further detail on preparing the CTSM, including how to - recompile when making code changes to the CTSM, read Section 3.2: - https:../obtaining-building-and-running/index.html - By the way, do not let Section 3.2.2 confuse you. We address that step - right after compiling the WRF model (next). + Run ./lilac/build_ctsm -h to see all options available, + for example if you would like to run with threading support you can use `--build-with-openmp` + +.. warning:: + + The directory you provided for the build script (``/PATH/TO/CTSM/BUILD``) must *not* exist. + Alternatively, you can use ``--rebuild`` option. Building WRF with CTSM ---------------------- -.. todo:: +First, load the same modules and set the same environments as used for CTSM build by +sourcing ctsm_build_environment.sh for Bash:: - update the git address to WRF feature branch... + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh -Clone the WRF CTSM feature branch:: +or sourcing ctsm_build_environment.csh for Cshell: - git clone https://github.com/billsacks/WRF.git - cd WRF - git checkout lilac_dev +.. code-block:: Tcsh + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.csh Set makefile variables from CTSM needed for the WRF build by setting the following environment. For example for Bash:: export WRF_CTSM_MKFILE=/glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk +or for Cshell: .. code-block:: Tcsh setenv WRF_CTSM_MKFILE /glade/scratch/$USER/ctsm_build_dir/bld/ctsm.mk -The next two environment settings for building WRF may help if you -encounter compilation errors, but should be unnecessary for completing -the current example on cheyenne. -Explicitly define which model core to build by:: +There are also few other environmental setting that should be set for building WRF. +Some of these are not required, but might help if you face any compilation errors. +For more information check WRF Users' Guide. - export WRF_EM_CORE=1 -Explicilty turn off data assimilation by:: +Explicitly define which model core to build by (Bash):: - export WRF_DA_CORE=0 + export WRF_EM_CORE=1 -Now configure and build WRF for your machine and intended compiler. -The ./clean command is necessary after any modification of WRF code:: +or (Cshell): - ./clean -a - ./configure +.. code-block:: Tcsh -At the prompt choose one of the options, similar to the compiler used -for building CTSM. The specific example has been tested successfully by -choosing 15 here. + setenv WRF_EM_CORE 1 -.. todo:: - Negin, by "similar to" do you mean "same as" in the above? +Explicilty turn off data assimilation by:: -The next prompt requests an option for nesting. Currently nesting is not -available for WRF-CTSM so enter 1. + export WRF_DA_CORE=0 -Now compile em_real and save the log:: +or (Cshell): - ./compile em_real >& compile.log +.. code-block:: Tcsh + setenv WRF_DA_CORE 0 -.. note:: +Now configure and build WRF for your machine and intended compiler:: - Optional: One may use tmux or nohup for configuring and compiling. - Try "man nohup" for more information. + ./clean -a + ./configure -.. note:: - Check the bottom of your log file for a successful compilation message - or search the file for the string "Error" with a capital E. +At the prompt choose one of the options, based on the compiler used +for building CTSM. Then you should choose if you'd like to build serially or +in parallel. -.. note:: +.. tip:: - The ./compile step may take more than 30 minutes to complete. - While you wait, follow the instructions in Section 3.2.2 (next) + dmpar or distributed memory parallelization is the most highly tested and + recommended for compiling WRF. -Now follow the instructions in this Section:: +The next prompt requests an option for nesting. Currently nesting is not +available for WRF-CTSM so enter 1. - https:../obtaining-building-and-running/setting-ctsm-runtime-options.html -In step 3 of that Section we used for this example:: +Now compile em_real and save the log:: - lnd_domain_file = /glade/work/slevis/barlage_wrf_ctsm/conus/gen_domain_files/domain.lnd.wrf2ctsm_lnd_wrf2ctsm_ocn.191211.nc - fsurdat = /glade/work/slevis/git_wrf/ctsm_surf/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c191212.nc - finidat = /glade/work/slevis/git_wrf/ctsm_init/finidat_interp_dest_wrfinit_snow_ERAI_12month.nc + ./compile em_real >& compile.log -In step 4 of that Section we used for this example:: - atm_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' - lnd_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' - -In step 6 of that Section you will copy some files to your WRF/run -directory. Then you will be ready to continue. +Check the bottom of your log file for a successful compilation message +or search the file for the string "Error" with a capital E. .. note:: - If you wish to merge your WRF initial conditions from a wrfinput file - into the existing CTSM initial condition file, complete the following step. + The ./compile step may take more than 30 minutes to complete. + While you wait, follow the instructions in Section 3.2.2 (next) -Type:: +.. tip:: - module load ncl - ncl transfer_wrfinput_to_ctsm_with_snow.ncl 'finidat="the_existing_finidat_file.nc"' 'wrfinput="your_wrfinput_file"' 'merged="the_merged_finidat_file.nc"' + Optional: One may use ``tmux`` or ``nohup`` for configuring and compiling. + Try ``man nohup`` for more information. -.. todo:: +.. seealso:: - Make the above ncl script available. + For further detail on preparing the CTSM, including how to + recompile when making code changes to the CTSM, read `Section 3.2. + `__ Compile WRF Preprocessing System (WPS) -------------------------------------- @@ -166,14 +166,14 @@ inputs to the real program executable (real.exe) for WRF real-data simulations. If you wish to complete the offered example with preexisting inputs, then skip to the next section, which is titled "Run WRF." -.. note:: +.. warning:: Building WPS requires that WRF be already built successfully. -Get WPS from: +Get WPS from this website:: -https://www2.mmm.ucar.edu/wrf/users/download/wrf-regist_or_download.php + https://www2.mmm.ucar.edu/wrf/users/download/wrf-regist_or_download.php New users must complete a registration form in this step. @@ -182,13 +182,8 @@ Then compile WPS similar to the way WRF was built. In summary:: cd WPS ./configure -At the prompt choose your intended compiler, similar to your WRF build. -After configuring, check configure.wps to make sure all the libs and paths -are set correctly. - -.. todo:: - - Negin, by "similar to" do you mean "same as" in the above? +At the prompt choose your intended compiler and parallelization method, +similar to the steps in your WRF build. Then, compile WPS:: @@ -197,13 +192,13 @@ Then, compile WPS:: .. note:: If wps builds succesfully you should see geogrid.exe, ungrib.exe, and metgrid.exe. - Alternatively, you can check the log for successful build message. + Alternatively, you can check the log for successful build messages. -Run WPS -------- +Run WPS Programs +---------------- -Edit namelist.wps for your domain of interest, which should be the same +Edit ``namelist.wps`` for your domain of interest, which should be the same domain as used in your WRF namelist. First, use geogrid.exe to define the domain and interpolate static geographical data @@ -255,18 +250,19 @@ metgrid step:: + Run real.exe ------------ -Run real.exe to generate initial and boundary conditions. +Run ``real.exe`` to generate initial and boundary conditions. Follow WRF instructions for creating initial and boundary conditions. In summary, complete the following steps: -Move or link WPS output files (met_em.d01* files) to your WRF/run directory. +Move or link WPS output files (met_em.d01* files) to your WRF test directory. Edit namelist.input for your WRF domain and desirable configurations. -This should be the same domain as in the namelist used in WPS. +This should be the same domain as WPS namelist. .. todo:: @@ -274,21 +270,17 @@ This should be the same domain as in the namelist used in WPS. update the option number of wrf namelist. -To run WRF-CTSM, change land-surface option to 51:: +To run WRF-CTSM, in your namelist change land-surface option to 51:: - sf_surface_physics = 51 + sf_surface_physics = 51 -.. note:: - - sf_surface_physics values for running WRF-Noah and WRF-NoahMP are - 2 and 4, respectively. .. todo:: add the link and adding some note that nested run is not possible.... Run real.exe (if compiled parallel submit a batch job) to generate -wrfinput and wrfbdy files. +``wrfinput`` and ``wrfbdy`` files. Check the last line of the real log file for the following message:: @@ -296,11 +288,47 @@ Check the last line of the real log file for the following message:: SUCCESS COMPLETE REAL_EM INIT +Now follow the instructions in this Section:: + + https:../obtaining-building-and-running/setting-ctsm-runtime-options.html + +In step 3 of that Section we used for this example:: + + lnd_domain_file = /glade/work/slevis/barlage_wrf_ctsm/conus/gen_domain_files/domain.lnd.wrf2ctsm_lnd_wrf2ctsm_ocn.191211.nc + fsurdat = /glade/work/slevis/git_wrf/ctsm_surf/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c191212.nc + finidat = /glade/work/slevis/git_wrf/ctsm_init/finidat_interp_dest_wrfinit_snow_ERAI_12month.nc + +In step 4 of that Section we used for this example:: + + atm_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + lnd_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + +In step 6 of that Section you will copy some files to your WRF/run +directory. Then you will be ready to continue. + +.. note:: + + If you wish to merge your WRF initial conditions from a wrfinput file + into the existing CTSM initial condition file, complete the following step. + +Type:: + + module load ncl + ncl transfer_wrfinput_to_ctsm_with_snow.ncl 'finidat="the_existing_finidat_file.nc"' 'wrfinput="your_wrfinput_file"' 'merged="the_merged_finidat_file.nc"' + +.. todo:: + + Make the above ncl script available. + + + Run WRF ------- If real.exe completed successfully, we should have wrfinput and wrfbdy files -in our directory. If you plan to use this example's preexisting files, copy +in our directory. + +If you plan to use this example's preexisting files, copy the following files to your WRF/run directory:: /glade/work/slevis/git_wrf/WRF/test/em_real/namelist.input.ctsm.2013.d01.12month @@ -329,6 +357,7 @@ A simple PBS script to run WRF-CTSM on Cheyenne looks like this: ### Set TMPDIR as recommended setenv TMPDIR /glade/scratch/$USER/temp mkdir -p $TMPDIR + source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.csh ### Run the executable mpiexec_mpt ./wrf.exe @@ -337,15 +366,4 @@ If you named this script run_wrf_ctsm.csh, submit the job like this:: qsub run_wrf_ctsm.csh -If your terminal windows have logged off, repeat -source ctsm_build_environment.sh (bash environment) before submitting -the job:: - - source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.sh - -or ctsm_build_environment.csh (Cshell environment): - -.. code-block:: Tcsh - - source /glade/scratch/$USER/ctsm_build_dir/ctsm_build_environment.csh From 8ce2e09cc96e1cb6f979fd21258620bda7940ab0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 3 Jul 2020 00:16:39 -0600 Subject: [PATCH 458/556] lilacsmoke: Use full paths to some scripts This (or something like it) is needed if dot isn't in your path. --- cime_config/SystemTests/lilacsmoke.py | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index fe05cb7045..5e68838a8a 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -135,7 +135,8 @@ def _create_runtime_inputs(self): shutil.copyfile(src=os.path.join(caseroot, 'user_nl_ctsm'), dst=os.path.join(runtime_inputs, 'user_nl_ctsm')) - self._run_build_cmd('make_runtime_inputs --rundir {}'.format(runtime_inputs), + script_to_run = os.path.join(runtime_inputs, 'make_runtime_inputs') + self._run_build_cmd('{} --rundir {}'.format(script_to_run, runtime_inputs), runtime_inputs, 'make_runtime_inputs.log') @@ -150,7 +151,8 @@ def _create_runtime_inputs(self): # We run download_input_data partly because it may be needed and partly to test # this script. - self._run_build_cmd('download_input_data --rundir {}'.format(runtime_inputs), + script_to_run = os.path.join(runtime_inputs, 'download_input_data') + self._run_build_cmd('{} --rundir {}'.format(script_to_run, runtime_inputs), runtime_inputs, 'download_input_data.log') From 36c726701b2cb1377f725ca620614541024fdda8 Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 3 Jul 2020 00:45:06 -0600 Subject: [PATCH 459/556] some clean-ups... --- doc/source/lilac/specific-atm-models/wrf.rst | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 559e4dcd2f..cb590f24fc 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -220,7 +220,7 @@ To run ungrib.exe, first link the GRIB data files that are going to be used:: ./link_grib.csh $your_GRIB_data_path Based on your GRIB data type, link or copy the appropriate VTable to your WPS directory. -WRF has some prepared VTable under /ungrib/Variable_tables/ folder. +WRF has some prepared VTable under ``/ungrib/Variable_tables/`` folder. Extract meteorological fields from GRIB-formatted files:: @@ -259,7 +259,7 @@ Run ``real.exe`` to generate initial and boundary conditions. Follow WRF instructions for creating initial and boundary conditions. In summary, complete the following steps: -Move or link WPS output files (met_em.d01* files) to your WRF test directory. +Move or link WPS output files (``met_em.d01*`` files) to your WRF test directory. Edit namelist.input for your WRF domain and desirable configurations. This should be the same domain as WPS namelist. @@ -287,6 +287,8 @@ Check the last line of the real log file for the following message:: SUCCESS COMPLETE REAL_EM INIT +Set CTSM runtime options +------------------------ Now follow the instructions in this Section:: @@ -322,10 +324,10 @@ Type:: -Run WRF -------- +Run wrf.exe +----------- -If real.exe completed successfully, we should have wrfinput and wrfbdy files +If real.exe completed successfully, we should have ``wrfinput`` and ``wrfbdy`` files in our directory. If you plan to use this example's preexisting files, copy From 2401a38c8a975b713182da36a6be294d4f23bb82 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 3 Jul 2020 05:59:39 -0600 Subject: [PATCH 460/556] Add a comment --- cime_config/config_component.xml | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index c09daffb8d..2840d72354 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -68,13 +68,19 @@ clm4_5_CRUv7 clm4_5_GSWP3v1 clm4_5_cam6.0 - + clm4_5_GSWP3v1 clm5_0_CRUv7 clm5_0_CRUv7 clm5_0_GSWP3v1 clm5_0_cam6.0 - + clm5_0_GSWP3v1 From fd614ba8c807d23524a3d757c86b017452d72607 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 3 Jul 2020 14:34:44 -0600 Subject: [PATCH 461/556] lilacsmoke test: get baseline generation/comparison working This required some changes to the file naming convention of lilac's history files: I think cime assumes that the component name ('clm') appears in the output file. --- cime_config/SystemTests/lilacsmoke.py | 42 +++++++++++++++++++++++++-- cime_config/config_archive.xml | 4 +++ lilac/atm_driver/atm_driver.F90 | 2 +- lilac/atm_driver/atm_driver_in | 2 +- lilac/src/lilac_history.F90 | 2 +- 5 files changed, 46 insertions(+), 6 deletions(-) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index 5e68838a8a..ed57258339 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -6,8 +6,14 @@ driver, both for the sake of the build and for extracting some runtime settings. This test should also use the lilac testmod (or a testmod that derives from it) in order to establish the user_nl_ctsm file correctly. + +Important directories under CASEROOT are: +- lilac_build: this contains the build and the runtime inputs for the lilac run +- lilac_atm_driver: this contains the build of the test driver as well as the run + directory in which the test is actually run """ +import glob import os import shutil @@ -143,11 +149,14 @@ def _create_runtime_inputs(self): # In lilac_in, we intentionally use the land mesh file for both atm_mesh_filename # and lnd_mesh_filename lnd_mesh = self._case.get_value('LND_DOMAIN_MESH') + casename = self._case.get_value('CASE') self._fill_in_variables_in_file(filepath=os.path.join(runtime_inputs, 'lilac_in'), - replacements={'atm_mesh_filename':lnd_mesh, + replacements={'caseid':casename, + 'atm_mesh_filename':lnd_mesh, 'lnd_mesh_filename':lnd_mesh, 'lilac_histfreq_option':'ndays'}, - placeholders={'lilac_histfreq_option':'never'}) + placeholders={'caseid':'ctsm_lilac', + 'lilac_histfreq_option':'never'}) # We run download_input_data partly because it may be needed and partly to test # this script. @@ -174,8 +183,10 @@ def _setup_atm_driver_rundir(self): 'LILAC testing currently assumes STOP_OPTION of ndays, not {}'.format( self._case.get_value('STOP_OPTION'))) stop_n = self._case.get_value('STOP_N') + casename = self._case.get_value('CASE') self._fill_in_variables_in_file(filepath=os.path.join(rundir, 'atm_driver_in'), - replacements={'atm_mesh_file':lnd_mesh, + replacements={'caseid':casename, + 'atm_mesh_file':lnd_mesh, 'atm_global_nx':str(lnd_nx), 'atm_global_ny':str(lnd_ny), 'atm_stop_day':str(stop_n+1), @@ -287,3 +298,28 @@ def run_phase(self): os.environ["OMP_NUM_THREADS"] = str(self._case.thread_count) cmd = self._case.get_mpirun_cmd(allow_unresolved_envvars=False) run_cmd_no_fail(cmd, from_dir=self._atm_driver_rundir()) + + self._link_to_output_files() + + def _link_to_output_files(self): + """Make links to the output files so that they appear in the directory expected by the test case + + Note: We do the run from a different directory in order to ensure that the run + isn't using any of the files that are staged by the test case in the standard run + directory. But then we need to create these links afterwards for the sake of + baseline generation / comparison. + """ + casename = self._case.get_value('CASE') + rundir = self._case.get_value('RUNDIR') + pattern = '{}*.nc'.format(casename) + + # First remove any old files from the run directory + old_files = glob.glob(os.path.join(rundir, pattern)) + for one_file in old_files: + os.remove(one_file) + + # Now link to new files + output_files = glob.glob(os.path.join(self._atm_driver_rundir(), pattern)) + for one_file in output_files: + file_basename = os.path.basename(one_file) + symlink_force(one_file, os.path.join(rundir, file_basename)) diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index 4c2412a0e3..bc9f1d6c0a 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -3,6 +3,8 @@ r rh\d? h\d*.*\.nc$ + lilac_hi.*\.nc$ + lilac_atm_driver_h\d*.*\.nc$ e locfnh @@ -15,6 +17,8 @@ casename.clm2.r.1976-01-01-00000.nc casename.clm2.rh4.1976-01-01-00000.nc casename.clm2.h0.1976-01-01-00000.nc + casename.clm2.lilac_hi.1976-01-01-00000.nc + casename.clm2.lilac_atm_driver_h0.0001-01.nc casename.clm2.h0.1976-01-01-00000.nc.base casename.clm2_0002.e.postassim.1976-01-01-00000.nc casename.clm2_0002.e.preassim.1976-01-01-00000.nc diff --git a/lilac/atm_driver/atm_driver.F90 b/lilac/atm_driver/atm_driver.F90 index 19112f7837..a1dcfad487 100644 --- a/lilac/atm_driver/atm_driver.F90 +++ b/lilac/atm_driver/atm_driver.F90 @@ -564,7 +564,7 @@ subroutine write_lilac_to_atm_driver_fields(caseid, nlocal, atm_global_nx, & if (masterproc) then ! Use an arbitrary time rather than trying to figure out the correct time stamp. This ! works because this subroutine is only called once, at the end of the run - ierr = nf90_create(trim(caseid)//'.atm.h0.0001-01.nc', nf90_clobber, ncid) + ierr = nf90_create(trim(caseid)//'.clm2.lilac_atm_driver_h0.0001-01.nc', nf90_clobber, ncid) if (ierr /= nf90_NoErr) call shr_sys_abort(' ERROR: nf90_create atm driver output file') ierr = nf90_def_dim(ncid, 'atm_nx', atm_global_nx, dimid_x) diff --git a/lilac/atm_driver/atm_driver_in b/lilac/atm_driver/atm_driver_in index 51e8b23fa2..8391f41a34 100644 --- a/lilac/atm_driver/atm_driver_in +++ b/lilac/atm_driver/atm_driver_in @@ -1,5 +1,5 @@ &atm_driver_input - caseid = 'test_lilac' + caseid = 'FILL_THIS_IN' atm_mesh_file = 'FILL_THIS_IN' atm_global_nx = FILL_THIS_IN atm_global_ny = FILL_THIS_IN diff --git a/lilac/src/lilac_history.F90 b/lilac/src/lilac_history.F90 index d6215b2cb1..bc4967630d 100644 --- a/lilac/src/lilac_history.F90 +++ b/lilac/src/lilac_history.F90 @@ -68,7 +68,7 @@ subroutine lilac_history_init(clock, caseid, rc) end if close(fileunit) - write(histfile_prefix,"(2a)") trim(caseid),'.lilac.hi.' + write(histfile_prefix,"(2a)") trim(caseid),'.clm2.lilac_hi.' !--------------------------------------- ! Get the clock info From 58e282599e9bb5bae872d16e7270473540e24049 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 3 Jul 2020 16:18:48 -0600 Subject: [PATCH 462/556] lilacsmoke test: get namelist comparison & generation working Now namelist comparison & generation correctly use the namelists used in the atm_driver-lilac-ctsm run, rather than in the meaningless test case. --- cime_config/SystemTests/lilacsmoke.py | 51 +++++++++++++++++++++++++-- 1 file changed, 48 insertions(+), 3 deletions(-) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index ed57258339..cf46af06d7 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -18,13 +18,15 @@ import shutil from CIME.SystemTests.system_tests_common import SystemTestsCommon -from CIME.utils import run_cmd_no_fail, append_testlog, symlink_force, new_lid +from CIME.utils import run_cmd, run_cmd_no_fail, symlink_force, new_lid, safe_copy, append_testlog from CIME.build import post_build -from CIME.test_status import GENERATE_PHASE, BASELINE_PHASE, TEST_PASS_STATUS +from CIME.test_status import NAMELIST_PHASE, GENERATE_PHASE, BASELINE_PHASE, TEST_PASS_STATUS, TEST_FAIL_STATUS from CIME.XML.standard_module_setup import * logger = logging.getLogger(__name__) +_LILAC_RUNTIME_FILES = ['lnd_in', 'lnd_modelio.nml', 'lilac_in'] + class LILACSMOKE(SystemTestsCommon): def __init__(self, case): @@ -79,6 +81,8 @@ def build_phase(self, sharedlib_only=False, model_only=False): self._setup_atm_driver_rundir() + self._cmpgen_namelists() + # Setting logs=[] implies that we don't bother gzipping any of the build log # files; that seems fine for these purposes (and it keeps the above code # simpler). @@ -192,10 +196,51 @@ def _setup_atm_driver_rundir(self): 'atm_stop_day':str(stop_n+1), 'atm_ndays_all_segs':str(stop_n)}) - for file_to_link in ['lnd_in', 'lnd_modelio.nml', 'lilac_in']: + for file_to_link in _LILAC_RUNTIME_FILES: symlink_force(os.path.join(self._runtime_inputs_dir(), file_to_link), os.path.join(rundir, file_to_link)) + def _cmpgen_namelists(self): + """Redoes the namelist comparison & generation with appropriate namelists + + The standard namelist comparison & generation is done with the CaseDocs directory + from the test case. That isn't appropriate here, because those namelists aren't + actually used in this test. Instead, we want to compare & generate the namelists + used by the atm_driver-lilac-ctsm execution. Here, we do some file copies and then + re-call the namelist comparison & generation script in order to accomplish + this. This will overwrite the namelists generated earlier in the test, and will + also replace the results of the NLCOMP phase. + + Note that we expect a failure in the NLCOMP phase that is run earlier in the test, + because that one will have compared the test's standard CaseDocs with the files + generated from here - and those two sets of namelists can be quite different. + """ + caseroot = self._case.get_value('CASEROOT') + casedocs = os.path.join(caseroot, 'CaseDocs') + if os.path.exists(casedocs): + shutil.rmtree(casedocs) + os.makedirs(casedocs) + + # case_cmpgen_namelists uses the existence of drv_in to decide whether namelists + # need to be regenerated. We do NOT want it to regenerate namelists, so we give it + # the file it wants. + with open(os.path.join(casedocs, 'drv_in'), 'a') as drv_in: + pass + + for onefile in _LILAC_RUNTIME_FILES + ['atm_driver_in']: + safe_copy(os.path.join(self._atm_driver_rundir(), onefile), + os.path.join(casedocs, onefile)) + + success = self._case.case_cmpgen_namelists() + # The setting of the NLCOMP phase status in case_cmpgen_namelists doesn't work + # here (probably because the test object has a saved version of the test status + # and so, when it goes to write the status of the build phase, it ends up + # overwriting whatever was set by case_cmpgen_namelists). So we need to set it + # here. + with self._test_status: + self._test_status.set_status(NAMELIST_PHASE, TEST_PASS_STATUS if success else TEST_FAIL_STATUS, + comments="(used lilac namelists)") + def _extract_var_from_namelist(self, nl_filename, varname): """Tries to find a variable named varname in the given file; returns its value From cecc60142f25ae7536114997eedeb955a92eb0ed Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 3 Jul 2020 16:52:22 -0600 Subject: [PATCH 463/556] Add a comment --- cime_config/SystemTests/lilacsmoke.py | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cime_config/SystemTests/lilacsmoke.py b/cime_config/SystemTests/lilacsmoke.py index cf46af06d7..ed4624ff57 100644 --- a/cime_config/SystemTests/lilacsmoke.py +++ b/cime_config/SystemTests/lilacsmoke.py @@ -11,6 +11,10 @@ - lilac_build: this contains the build and the runtime inputs for the lilac run - lilac_atm_driver: this contains the build of the test driver as well as the run directory in which the test is actually run + +Note that namelists for this test are generated in the build phase; they are NOT +regenerated when the test is submitted / run. This means that, if you have made any +changes that will impact namelists, you will need to rebuild this test. """ import glob From 8edcb24a234056402e351827cb3d27f1edaa0757 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 3 Jul 2020 20:10:17 -0600 Subject: [PATCH 464/556] LILAC: implement alarms other than nsteps Code is from @mvertens. I have just tested ndays for LILAC history output so far. This has an off-by-one issue, but I suspect it's due to a different part of the code. I'll open an issue for this. --- lilac/src/lilac_time.F90 | 52 +++++++++++++++++++++++++++++++++------- 1 file changed, 44 insertions(+), 8 deletions(-) diff --git a/lilac/src/lilac_time.F90 b/lilac/src/lilac_time.F90 index 31929e8a42..e372c7dcff 100644 --- a/lilac/src/lilac_time.F90 +++ b/lilac/src/lilac_time.F90 @@ -21,7 +21,7 @@ module lilac_time ! Clock and alarm options character(len=*), private, parameter :: & - optNONE = "none" , & + optNone = "none" , & optNever = "never" , & optNSteps = "nsteps" , & optNSeconds = "nseconds" , & @@ -265,30 +265,66 @@ subroutine lilac_time_alarmInit( clock, alarm, alarmname, option, opt_n, rc) call ESMF_ClockGet(clock, calendar=cal) ! Determine inputs for call to create alarm - if (trim(option) == optNone .or. trim(option) == optNever) then + if (trim(option) /= optNone .and. trim(option) /= optNever) then + if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n - must be > 0') + end if + select case (trim(option)) + case (optNone, optNever) call ESMF_TimeIntervalSet(AlarmInterval, yy=really_big_year, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeSet( NextAlarm, yy=really_big_year, mm=12, dd=1, s=0, calendar=cal, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. - else if ( trim(option) == optNSteps .or. trim(option) == optNSeconds .or. & - trim(option) == optNMinutes .or. trim(option) == optNHours .or. trim(option) == optNDays) then - - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') + case (optNSteps) call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - else + case (optNSeconds) + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours) + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + case (optNDays) + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNYears) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case default call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return - end if + end select ! ------------------------------------------------- ! AlarmInterval and NextAlarm should be set From e41545a3d786ac64196ce8fc5979d38f6bd1cf93 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sun, 5 Jul 2020 14:49:04 -0600 Subject: [PATCH 465/556] LILAC: Disable ESMF's PET files by default Disabling these because they contain a lot of unnecessary output. Add a namelist flag that allows turning these back on. --- lilac/bld_templates/lilac_in_template | 1 + lilac/src/lilac_mod.F90 | 35 +++++++++++++++++++-------- 2 files changed, 26 insertions(+), 10 deletions(-) diff --git a/lilac/bld_templates/lilac_in_template b/lilac/bld_templates/lilac_in_template index 6295929e23..78a8ab75cf 100644 --- a/lilac/bld_templates/lilac_in_template +++ b/lilac/bld_templates/lilac_in_template @@ -1,5 +1,6 @@ &lilac_run_input caseid = 'ctsm_lilac' + create_esmf_pet_files = .false. / &lilac_history_input lilac_histfreq_option = 'never' diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index b233896424..d98e3e080c 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -130,6 +130,8 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & ! local variables character(ESMF_MAXSTR) :: caseid + logical :: create_esmf_pet_files + type(ESMF_LogKind_Flag) :: logkindflag type(ESMF_TimeInterval) :: timeStep type(ESMF_Time) :: startTime integer :: yy,mm,dd,sec @@ -155,7 +157,7 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & logical :: comp_iamin(1) = (/.true./) ! for pio init2 !------------------------------------------------------------------------ - namelist /lilac_run_input/ caseid + namelist /lilac_run_input/ caseid, create_esmf_pet_files ! Initialize return code rc = ESMF_SUCCESS @@ -165,6 +167,27 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & !------------------------------------------------------------------------- starttype = starttype_in + ! ------------------------------------------------------------------------ + ! Read main namelist + ! ------------------------------------------------------------------------ + + ! Initialize variables in case not set in namelist (but we expect them to be set) + caseid = 'UNSET' + create_esmf_pet_files = .false. + + open(newunit=fileunit, status="old", file="lilac_in") + read(fileunit, lilac_run_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(trim(subname) // 'error reading in lilac_run_input') + end if + close(fileunit) + + if (create_esmf_pet_files) then + logkindflag = ESMF_LOGKIND_MULTI + else + logkindflag = ESMF_LOGKIND_MULTI_ON_ERROR + end if + ! ------------------------------------------------------------------------ ! Complete setup of field lists started in lilac_init1, now that we know the number ! of atm points. @@ -186,7 +209,7 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & ! NOTE: the default calendar is set to GREGORIAN and is reset below in the initialization of ! the lilac clock call ESMF_Initialize(mpiCommunicator=mpicom, defaultCalKind=ESMF_CALKIND_GREGORIAN, & - logappendflag=.false., rc=rc) + logkindflag=logkindflag, logappendflag=.false., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogSet(flush=.true.) @@ -212,14 +235,6 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & call shr_pio_init2(compids, compLabels, comp_iamin, (/mpicom/), (/mytask/)) call ESMF_LogWrite(subname//"initialized shr_pio_init2 ...", ESMF_LOGMSG_INFO) - ! read in caseid - open(newunit=fileunit, status="old", file="lilac_in") - read(fileunit, lilac_run_input, iostat=ierr) - if (ierr > 0) then - call shr_sys_abort(trim(subname) // 'error reading in lilac_run_input') - end if - close(fileunit) - !------------------------------------------------------------------------- ! Initial lilac atmosphere cap module variables !------------------------------------------------------------------------- From 75c11419f7e5b440e6cc30e1d01594ab9df5dd52 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sun, 5 Jul 2020 21:09:18 -0600 Subject: [PATCH 466/556] Remove unnecessary LND_TUNING_MODE setting This config_component setting isn't actually necessary for LILAC, because LILAC takes its settings from ctsm.cfg rather than xml variables. I have confirmed that LILACSMOKE_Vnuopc_P4x1_D_Ld2.f10_f10_musgs.I2000Ctsm50NwpSpAsRsGs.bishorn_gnu.clm-lilac is bfb (and lnd_in file is identical) before and after this change. --- cime_config/config_component.xml | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 2840d72354..545c17d9c4 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -68,20 +68,10 @@ clm4_5_CRUv7 clm4_5_GSWP3v1 clm4_5_cam6.0 - - clm4_5_GSWP3v1 clm5_0_CRUv7 clm5_0_CRUv7 clm5_0_GSWP3v1 clm5_0_cam6.0 - - clm5_0_GSWP3v1 From 9c715da288a5fce3493574c0f2f5b9cf97a672a2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 6 Jul 2020 09:33:33 -0600 Subject: [PATCH 467/556] Add a LILAC test to the test suite --- cime_config/testdefs/testlist_clm.xml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index e03cbc2b3b..d1d395c2b0 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2013,6 +2013,18 @@ + + + + + + + + + + + + From cb94fb4c2a0729e9ca03f9890bbf7a3d2e321932 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 6 Jul 2020 10:13:21 -0600 Subject: [PATCH 468/556] Update ChangeLog --- doc/ChangeLog | 135 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 136 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 045c26ec2f..c08274e32e 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,139 @@ =============================================================== +Tag name: ctsm1.0.dev104 +Originator(s): sacks (Bill Sacks) +Date: Mon Jul 6 09:58:15 MDT 2020 +One-line Summary: Add LILAC + +Purpose of changes +------------------ + +Add LILAC: The Lightweight Infrastructure for Land-Atmosphere +Coupling. This infrastructure consists of two major pieces: + +(1) A lightweight coupling infrastructure built on top of ESMF that + makes it easier for atmosphere models to call CTSM directly, rather + than using the hub-and-spoke architecture that is used by CESM. + +(2) A set of python-based tools for building CTSM and creating its + runtime inputs when running in an atmosphere model via + LILAC. Although these tools are built on top of cime, details of the + create_newcase / case.setup / case.build process are hidden from the + user, because many of the aspects of this workflow don't make sense + in the LILAC context. + +So far we have used LILAC to couple CTSM to WRF. There are plans to use +the same infrastructure to couple CTSM to other regional atmosphere +models. + +Documentation of LILAC is provided in +https://escomp.github.io/ctsm-docs/versions/master/html/lilac/index.html +(though there are still some missing sections), as well as in various +presentations on the wiki +(https://github.com/ESCOMP/CTSM/wiki/Presentations). + +There have been many contributors besides myself to the development, +testing and documentation of LILAC; chief among them being Mariana +Vertenstein, Negin Sobhani, Joe Hamman, Sam Levis, Mike Barlage and Dave +Lawrence. + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): +- See issues in the Done column of https://github.com/ESCOMP/CTSM/projects/23 + +Known bugs introduced in this tag (include github issue ID): +- Although LILAC is working to first order, there is still some work to +do. See outstanding issues in https://github.com/ESCOMP/CTSM/projects/23 + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): none + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): +- dtime no longer specified on the namelist: just obtained from driver + +Changes made to namelist defaults (e.g., changed parameter values): none + +Changes to the datasets (e.g., parameter, surface or initial files): none + +Substantial timing or memory changes: none + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): none + +Changes to tests or testing: +- Added LILACSMOKE test + +Code reviewed by: self + + +CTSM testing: + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - ok + + Baseline comparisons fail as expected. One test failed, but it also + failed for me on master (https://github.com/ESCOMP/CTSM/issues/1074) + + tools-tests (test/tools): + + cheyenne - not run + + PTCLM testing (tools/shared/PTCLM/test): + + cheyenne - not run + + python testing (see instructions in python/README.md; document testing done): + + (any machine) - pass on my mac + + regular tests (aux_clm): + + cheyenne ---- pass + izumi ------- pass + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: NO + + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): none + +Pull Requests that document the changes (include PR ids): +https://github.com/ESCOMP/CTSM/pull/1068 + +=============================================================== +=============================================================== Tag name: ctsm1.0.dev103 Originator(s): slevis (Samuel Levis, SLevis Consulting LLC,303-665-1310) Date: Mon Jun 29 17:16:29 MDT 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index 9af125f5b9..c773cf9101 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm1.0.dev104 sacks 07/06/2020 Add LILAC ctsm1.0.dev103 slevis 06/29/2020 Gridcell-level error-check for methane (CH4) ctsm1.0.dev102 erik/ole 06/26/2020 Some important fixes for LUNA in clm5_0, and small urban issue in clm5_0 ctsm1.0.dev101 ole/erik 06/17/2020 Changes from Keith to bring a list of variables to the parameter file From 279ec1db6f662af66879d065300cddce73063879 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 6 Jul 2020 13:55:21 -0600 Subject: [PATCH 469/556] Remove README.lilac This file is no longer relevant, and has been superseded by: - The documentation here: https://escomp.github.io/ctsm-docs/versions/master/html/lilac/index.html - The LILACSMOKE system test, for testing via the atm_driver --- README.lilac | 110 --------------------------------------------------- 1 file changed, 110 deletions(-) delete mode 100644 README.lilac diff --git a/README.lilac b/README.lilac deleted file mode 100644 index 6a4414e6ae..0000000000 --- a/README.lilac +++ /dev/null @@ -1,110 +0,0 @@ -======================================================================== -I. Building a CTSM / LILAC library for inclusion in an atmosphere model -======================================================================== - -1) check out the code (ctsm and lilac are now bundled together) and built as one library - - > git clone https://github.com/ESCOMP/ctsm.git - > git checkout lilac_cap - > ./manage_externals/checkout_externals -v - -2) set the following environment variables - SRCROOT is where ctsm is checked out - - > export SRCROOT=`pwd` - > export CASEDIR=/glade/scratch/$USER/test_lilac - -3) build the ctsm/lilac library using a CIME case - - > cd $SRCROOT/cime/scripts - > ./create_newcase --case $CASEDIR --compset I2000Clm50SpRsGs --res f45_f45_mg37 --run-unsupported --driver nuopc - > cd $CASEDIR - > ./xmlchange LILAC_MODE=on - > ./xmlchange DEBUG=TRUE - > ./case.setup - > ./case.build --sharedlib-only - -======================================================================== -II. Building and running the test atmosphere driver -======================================================================== - -After following the above instructions for building a CTSM / LILAC -library (I), do the following: - -1) To build the atm_driver executable on cheyenne (***CTSM_MKFILE IS CRITICAL for the operation of the atm_driver makefile) - - > export CTSM_MKFILE=$CASEDIR/bld/ctsm.mk - > cd $SRCROOT/lilac/atm_driver - > $SRCROOT/cime/tools/configure --comp-interface nuopc --macros-format Makefile --clean - > make clean - > source ./.env_mach_specific.sh - > export DEBUG=TRUE - > make COMPILER=intel atm_driver - -2) to generate the input namelists - - - to customize the generated namelist - edit the file ctsm.cfg (in this directory) - - to create the ctsm namelist FROM THIS DIRECTORY: - - > $SRCROOT/lilac_config/buildnml - - - this will now create the files lnd_in and clm.input_data_list in this directory - THIS ONLY NEEDS TO BE DONE ONCE - to futher customize the lnd_in (say to adjust the ctsm history output) edit the generated lnd_in in this directory - -3) run the atm_driver on cheyenne - - > qsub cheyenne.sub - -4) compare with latest baselines - - use something like this to compare the last clm and last cpl hist files: - - > basedir=/glade/p/cgd/tss/ctsm_baselines/lilac_20191202 - > cprnc test_lilac.clm2.h0.2000-01-03-00000.nc $basedir/test_lilac.clm2.h0.2000-01-03-00000.nc | tail -30 - > cprnc test_lilac.lilac.hi.2000-01-02-81000.nc $basedir/test_lilac.lilac.hi.2000-01-02-81000.nc | tail -30 - > cprnc -m test_lilac.atm.h0.0001-01.nc $basedir/test_lilac.atm.h0.0001-01.nc | tail -30 - -5) if there are differences, and those are intentional, then create new - baselines - - copy all *.nc files, plus ctsm.cfg, lilac_in and lnd_in to the - baseline directory - -======================================================================== -III. Linking the CTSM / LILAC library into another atmosphere model -======================================================================== - -After following the above instructions for building a CTSM / LILAC -library (I), you should do the following, assuming that the atmosphere -model is built using a makefile: - -1) Set some environment variable (e.g., CTSM_MKFILE) to point to the - ctsm.mk file generated in CTSM's bld directory. - -2) Modify the atmosphere model's makefile to include the file given by - the environment variable $CTSM_MAKEFILE. - -3) In the compilation line for the atmosphere model, add - $(CTSM_INCLUDES) - -4) In the link line for the atmosphere model, add $(CTSM_LIBS) - -======================================================================== -IV. Running CTSM / LILAC from another atmosphere model -======================================================================== - -After (III), the following steps are needed to stage the inputs needed -for running the atmosphere model - -1) Generate the input namelists following the instructions given in part - (II). - -2) Copy the following files from $SRCROOT/lilac/atm_driver into the - directory from which the atmosphere model will be run: - - - lilac_in - - lnd_in - - lnd_modelio.nml - -3) Run the atmosphere model From 88e065097c414e5e70ad78b26b25038d70e7c4e6 Mon Sep 17 00:00:00 2001 From: wwieder Date: Tue, 7 Jul 2020 11:13:46 -0600 Subject: [PATCH 470/556] removed unused code & made requested corrections --- src/biogeochem/CNNStateUpdate1Mod.F90 | 4 ++-- src/biogeochem/CNPhenologyMod.F90 | 9 --------- 2 files changed, 2 insertions(+), 11 deletions(-) diff --git a/src/biogeochem/CNNStateUpdate1Mod.F90 b/src/biogeochem/CNNStateUpdate1Mod.F90 index 56e6ddbd55..7657450680 100644 --- a/src/biogeochem/CNNStateUpdate1Mod.F90 +++ b/src/biogeochem/CNNStateUpdate1Mod.F90 @@ -6,7 +6,7 @@ module CNNStateUpdate1Mod ! ! !USES: use shr_kind_mod , only: r8 => shr_kind_r8 - use clm_time_manager , only : get_step_size, get_step_size_real + use clm_time_manager , only : get_step_size_real use clm_varpar , only : nlevdecomp, ndecomp_pools, ndecomp_cascade_transitions use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd use clm_varctl , only : iulog, use_nitrif_denitrif @@ -119,7 +119,7 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ) ! set time steps - dt = real( get_step_size(), r8 ) + dt = get_step_size_real() ! soilbiogeochemistry fluxes TODO - this should be moved elsewhere diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 674c27dda5..4e60ca9eb2 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -2726,7 +2726,6 @@ subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & livestemn_to_deadstemn(p) = ctovr / deadwdcn(ivt(p)) end if - livestemn_to_deadstemn(p) = 0.5_r8 * ntovr ! assuming 50% goes to deadstemn end if livestemn_to_retransn(p) = ntovr - livestemn_to_deadstemn(p) @@ -2747,18 +2746,10 @@ subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & livecrootn_to_deadcrootn(p) = ctovr / deadwdcn(ivt(p)) end if -! livecrootn_to_deadcrootn(p) = 0.5_r8 * ntovr ! assuming 50% goes to deadstemn end if livecrootn_to_retransn(p) = ntovr - livecrootn_to_deadcrootn(p) -! Allow resorbtion with FUN -! if(use_fun)then -! !TURNED OFF FLUXES TO CORRECT N ACCUMULATION ISSUE. RF. Oct 2015. -! livecrootn_to_retransn(p) = 0.0_r8 -! livestemn_to_retransn(p) = 0.0_r8 -! endif - end if end do From 52b6566941b948b28936efded524ff727bc81f1b Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 8 Jul 2020 10:15:12 -0600 Subject: [PATCH 471/556] Add in/out to type as it's now being used for output --- src/biogeochem/CNNStateUpdate1Mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/CNNStateUpdate1Mod.F90 b/src/biogeochem/CNNStateUpdate1Mod.F90 index 7657450680..bedb4d3dc1 100644 --- a/src/biogeochem/CNNStateUpdate1Mod.F90 +++ b/src/biogeochem/CNNStateUpdate1Mod.F90 @@ -98,7 +98,7 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst ! From 9381a6b4551fdecd9c3c3f5f5fabd974a0dff9a0 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 9 Jul 2020 15:15:22 -0600 Subject: [PATCH 472/556] Get build-namelist working when multiple finidat files could match Get the build-namelist finding of finidat files working when there are more possible sim_years and more than one could match. The previous mechanism relied on the fact that only one could match. Also note that the previous mechanism used st_year to pick finidat files while it should have done that only for transient cases, rather than control cases with a fixed simulation year. This changes that. This also adds a return code for add_default, so that if you set no_fail on, you can query the return code to assess if it failed. Also make sure the namelist defaults are set up correctly for use_init_interp, init_interp_attributes and finidat. All of those need to be carefully coordinated together, otherwise the process won't work correctly. build-namelist unit test passes. A few compare differently to ctsm1.0.dev101, so looking into that. --- bld/CLMBuildNamelist.pm | 71 +++++++++++-------- bld/namelist_files/namelist_defaults_ctsm.xml | 26 +++++-- 2 files changed, 62 insertions(+), 35 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 4ee6a65eda..5be369da58 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2305,47 +2305,61 @@ sub setup_logic_initial_conditions { #} add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, "init_interp_sim_years" ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, "init_interp_how_close" ); + # + # Figure out which sim_year has a usable finidat file that is closest to the desired one + # my $close = $nl->get_value("init_interp_how_close"); - foreach my $sim_yr ( split( /,/, $nl->get_value("init_interp_sim_years") )) { + my @sim_years = split( /,/, $nl->get_value("init_interp_sim_years") ); +SIMYR: foreach my $sim_yr ( @sim_years ) { my $how_close = undef; if ( $nl_flags->{'sim_year'} eq "PtVg" ) { $how_close = abs(1850 - $sim_yr); + } elsif ( $nl_flags->{'flanduse_timeseries'} == "null" ) { + $how_close = abs($nl_flags->{'sim_year'} - $sim_yr); } else { $how_close = abs($st_year - $sim_yr); } - if ( ($how_close < $nl->get_value("init_interp_how_close")) && ($how_close < $close) ) { - $close = $how_close; - $settings{'sim_year'} = $sim_yr; + if ( ($sim_yr == $sim_years[-1]) || (($how_close < $nl->get_value("init_interp_how_close")) && ($how_close < $close)) ) { + my $group = $definition->get_group_name($useinitvar); + my $val = $nl->set_variable_value($group, $useinitvar, $use_init_interp_default ); + $settings{$useinitvar} = $defaults->get_value($useinitvar, \%settings); + if ( ! defined($settings{$useinitvar}) ) { + $settings{$useinitvar} = ".false."; + } + if ( &value_is_true($nl->get_value($useinitvar) ) ) { + + if ( ($how_close < $nl->get_value("init_interp_how_close")) && ($how_close < $close) ) { + $close = $how_close; + $settings{'sim_year'} = $sim_yr; + } + } } - } + } # SIMYR: add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $useinitvar, - 'use_cndv'=>$nl_flags->{'use_cndv'}, 'phys'=>$physv->as_string(), - 'sim_year'=>$settings{'sim_year'}, 'nofail'=>1, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, - 'use_fates'=>$nl_flags->{'use_fates'} ); - $settings{$useinitvar} = $nl->get_value($useinitvar); - if ( $try > 1 ) { - my $group = $definition->get_group_name($useinitvar); - $nl->set_variable_value($group, $useinitvar, $use_init_interp_default ); - } - if ( &value_is_true($nl->get_value($useinitvar) ) ) { - - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, "init_interp_attributes", - 'sim_year'=>$settings{'sim_year'}, 'use_cndv'=>$nl_flags->{'use_cndv'}, - 'glc_nec'=>$nl_flags->{'glc_nec'}, 'use_fates'=>$nl_flags->{'use_fates'}, - 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'},'nofail'=>1 ); - my $attributes_string = remove_leading_and_trailing_quotes($nl->get_value("init_interp_attributes")); + 'use_cndv'=>$nl_flags->{'use_cndv'}, 'phys'=>$physv->as_string(), + 'sim_year'=>$settings{'sim_year'}, 'nofail'=>1, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, + 'use_fates'=>$nl_flags->{'use_fates'} ); + if ( ! &value_is_true($nl->get_value($useinitvar) ) ) { + if ( $nl_flags->{'clm_start_type'} =~ /startup/ ) { + $log->fatal_error("clm_start_type is startup so an initial conditions ($var) file is required, but can't find one without $useinitvar being set to true"); + } + } else { + my $stat = add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, "init_interp_attributes", + 'sim_year'=>$settings{'sim_year'}, 'use_cndv'=>$nl_flags->{'use_cndv'}, + 'glc_nec'=>$nl_flags->{'glc_nec'}, 'use_fates'=>$nl_flags->{'use_fates'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, 'nofail'=>1 ); + if ( $stat ) { + $log->fatal_error("$useinitvar is NOT synchronized with init_interp_attributes"); + } + my $attributes = $nl->get_value("init_interp_attributes"); + my $attributes_string = remove_leading_and_trailing_quotes($attributes); foreach my $pair ( split( /\s/, $attributes_string) ) { - if ( $pair =~ /^([a-z_]+)=([a-z._0-9]+)$/ ) { + if ( $pair =~ /^([a-z_]+)=([a-zA-Z._0-9]+)$/ ) { $settings{$1} = $2; } else { - $log->fatal_error("Problem interpreting init_interp_attributes"); + $log->fatal_error("Problem interpreting init_interp_attributes: $pair"); } } - } else { - if ( $nl_flags->{'clm_start_type'} =~ /startup/ ) { - $log->fatal_error("clm_start_type is startup so an initial conditions ($var) file is required, but can't find one without $useinitvar being set to true"); - } - $try = $done; } } else { $try = $done @@ -3974,7 +3988,7 @@ sub add_default { } } else { - return; + return( 1 ); } } @@ -4009,6 +4023,7 @@ sub add_default { # set the value in the namelist $nl->set_variable_value($group, $var, $val); } + return( 0 ); } diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 27883ff55b..55e4c51872 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -510,13 +510,25 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 1850,1982,2000,2010 - -.true. -.true. -.true. -.true. -.true. -.false. + + + + +.true. +.true. +.true. +.true. +.false. + .true. .true. + maxpft="17" use_cn=".false." use_crop=".false." hgrid="ne0np4.ARCTIC.ne30x4" >.true. +.true. .true. .true. .false. @@ -593,9 +595,15 @@ attributes from the config_cache.xml file (with keys converted to upper-case). hgrid=ne0np4.ARCTIC.ne30x4 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 +hgrid=ne0np4.ARCTICGRIS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 + + hgrid=ne120np4.pg3 maxpft=79 mask=tx0.1v3 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 @@ -724,6 +732,14 @@ attributes from the config_cache.xml file (with keys converted to upper-case). >/glade/work/aherring/grids/var-res/ne0np4.ARCTIC.ne30x4/inic/FHIST_ARCTIC_ne30x4_mt12_1979bc-mg3.clm2.r.1982-01-01-00000_c200424.nc + +/glade/work/aherring/grids/var-res/ne0np4.ARCTICGRIS.ne30x8/inic/FHIST_ARCTICGRIS_ne30x8_mt12_1979bc-mg3.clm2.r.1982-01-01-00000_c200428.nc + + lnd/clm2/surfdata_map/landuse.timeseries_1x1_numaIA_hist_78pfts_CMIP6_simyr1850-2015_c170917.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTIC.ne30x4_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc Date: Sat, 11 Jul 2020 23:43:48 -0600 Subject: [PATCH 476/556] Make sure finidat files for clm5_cam6 get matched For lower resolutions match the previous f09 file. For higher resolution (or single point or regional) use the new finidat files. Also change the build-namelist test so that transient tests set the start_ymd so that it should find the correct file. --- bld/namelist_files/namelist_defaults_ctsm.xml | 72 ++++++++++++++++++- bld/unit_testers/build-namelist_test.pl | 31 ++++++-- 2 files changed, 93 insertions(+), 10 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 8bd496059a..8998fb97ce 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -517,10 +517,14 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .true. + .true. + maxpft="17" use_cn=".false." use_crop=".false." hgrid="ne0np4.ARCTIC.ne30x4" >.true. .true. + +.true. .true. .true. .false. @@ -590,10 +594,70 @@ attributes from the config_cache.xml file (with keys converted to upper-case). >hgrid=1.9x2.5 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + + + +hgrid=ne120np4.pg3 maxpft=79 mask=tx0.1v3 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + + + hgrid=ne0np4.ARCTIC.ne30x4 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 @@ -604,8 +668,10 @@ attributes from the config_cache.xml file (with keys converted to upper-case). >hgrid=ne0np4.ARCTICGRIS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 -hgrid=ne120np4.pg3 maxpft=79 mask=tx0.1v3 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + +hgrid=ne0np4.ARCTICGRIS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 1ed3b88618..9c88a179a0 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,7 +138,7 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 872; +my $ntests = 862; if ( defined($opts{'compare'}) ) { $ntests += 528; } @@ -335,7 +335,7 @@ sub make_config_cache { "-bgc bgc -use_case 1850-2100_SSP3-7.0_transient -namelist '&a start_ymd=20701029/'", "-bgc fates -use_case 2000_control -no-megan", "-bgc sp -use_case 2000_control -res 0.9x1.25 -namelist '&a use_soil_moisture_streams = T/'", - "-bgc cn -use_case 1850-2100_SSP5-8.5_transient -namelist '&a start_ymd=19201023/'", + "-bgc cn -use_case 1850-2100_SSP5-8.5_transient -namelist '&a start_ymd=19101023/'", "-bgc bgc -use_case 2000_control -namelist \"&a fire_method='nofire'/\" -crop", "-res 0.9x1.25 -bgc bgc -use_case 1850_noanthro_control -drydep -fire_emis -light_res 360x720", ) { @@ -1223,7 +1223,17 @@ sub make_config_cache { ); foreach my $res ( @glc_res ) { foreach my $usecase ( @usecases ) { - $options = "-bgc bgc -res $res -use_case $usecase -envxml_dir . "; + my $startymd = undef; + if ( ($usecase eq "1850_control") || ($usecase eq "20thC_transient") ) { + $startymd = 18500101; + } elsif ( $usecase eq "2000_control") { + $startymd = 20000101; + } elsif ( $usecase eq "2010_control") { + $startymd = 20100101; + } else { + $startymd = 20150101; + } + $options = "-bgc bgc -res $res -use_case $usecase -envxml_dir . -namelist '&a start_ymd=$startymd/'"; &make_env_run(); eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; is( $@, '', "$options" ); @@ -1247,7 +1257,7 @@ sub make_config_cache { my $usecase = "20thC_transient"; my $GLC_NEC = 10; foreach my $res ( @tran_res ) { - $options = "-res $res -use_case $usecase -envxml_dir . "; + $options = "-res $res -use_case $usecase -envxml_dir . -namelist '&a start_ymd=18500101/'"; &make_env_run(); eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; is( $@, '', "$options" ); @@ -1270,8 +1280,14 @@ sub make_config_cache { my @tran_res = ( "0.9x1.25", "1.9x2.5", "10x15" ); foreach my $usecase ( "1850_control", "1850-2100_SSP5-8.5_transient", "1850-2100_SSP1-2.6_transient", "1850-2100_SSP3-7.0_transient", "1850-2100_SSP2-4.5_transient" ) { + my $startymd = undef; + if ( $usecase eq "1850_control") { + $startymd = 18500101; + } else { + $startymd = 20150101; + } foreach my $res ( @tran_res ) { - $options = "-res $res -bgc bgc -crop -use_case $usecase -envxml_dir . "; + $options = "-res $res -bgc bgc -crop -use_case $usecase -envxml_dir . -namelist '&a start_ymd=$startymd/'"; &make_env_run(); eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; is( $@, '', "$options" ); @@ -1292,7 +1308,7 @@ sub make_config_cache { my $res = "0.9x1.25"; foreach my $usecase ( "1850-2100_SSP4-3.4_transient", "1850-2100_SSP5-3.4_transient", "1850-2100_SSP1-1.9_transient", "1850-2100_SSP4-6.0_transient" ) { - $options = "-res $res -bgc bgc -crop -use_case $usecase -envxml_dir . "; + $options = "-res $res -bgc bgc -crop -use_case $usecase -envxml_dir . -namelist '&a start_ymd=20150101/'"; &make_env_run(); eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; isnt( $?, 0, $usecase ); @@ -1307,7 +1323,8 @@ sub make_config_cache { my $mode = "-phys $phys"; &make_config_cache($phys); my @clmoptions = ( "-bgc bgc -envxml_dir .", "-bgc bgc -envxml_dir . -clm_accelerated_spinup=on", "-bgc bgc -envxml_dir . -light_res 360x720", - "-bgc sp -envxml_dir . -vichydro", "-bgc bgc -dynamic_vegetation -ignore_warnings", "-bgc bgc -clm_demand flanduse_timeseries -sim_year 1850-2000", + "-bgc sp -envxml_dir . -vichydro", "-bgc bgc -dynamic_vegetation -ignore_warnings", + "-bgc bgc -clm_demand flanduse_timeseries -sim_year 1850-2000 -namelist '&a start_ymd=18500101/'", "-bgc bgc -envxml_dir . -namelist '&a use_c13=.true.,use_c14=.true.,use_c14_bombspike=.true./'" ); foreach my $clmopts ( @clmoptions ) { my @clmres = ( "10x15", "0.9x1.25", "1.9x2.5" ); From 602657aa54789303ac82d3a5c5986e544bda4b1f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 12 Jul 2020 14:11:34 -0600 Subject: [PATCH 477/556] Rename the new finidat files, and add some build-namelist tests for these specific CAM cases --- bld/namelist_files/namelist_defaults_ctsm.xml | 6 ++-- bld/unit_testers/build-namelist_test.pl | 34 +++++++++++++++++-- 2 files changed, 35 insertions(+), 5 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 8998fb97ce..e7e0b67688 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -795,7 +795,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ic_ymd="19820101" use_nitrif_denitrif=".false." use_vertsoilc=".false." sim_year="1982" ic_tod="0" glc_nec="10" use_crop=".false." irrigate=".true." lnd_tuning_mode="clm5_0_cam6.0" use_init_interp=".true." ->/glade/work/aherring/grids/var-res/ne0np4.ARCTIC.ne30x4/inic/FHIST_ARCTIC_ne30x4_mt12_1979bc-mg3.clm2.r.1982-01-01-00000_c200424.nc +>lnd/clm2/initdata_map/clmi.FHISTSp.1982-01-01.ARCTIC_ne30x4_mt12_simyr1982_c200425.nc @@ -803,7 +803,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ic_ymd="19820101" use_nitrif_denitrif=".false." use_vertsoilc=".false." sim_year="1982" ic_tod="0" glc_nec="10" use_crop=".false." irrigate=".true." lnd_tuning_mode="clm5_0_cam6.0" use_init_interp=".true." ->/glade/work/aherring/grids/var-res/ne0np4.ARCTICGRIS.ne30x8/inic/FHIST_ARCTICGRIS_ne30x8_mt12_1979bc-mg3.clm2.r.1982-01-01-00000_c200428.nc +>lnd/clm2/initdata_map/clmi.FHISTSp.1982-01-01.ARCTICGRIS_ne30x8_mt12_simyr1982_c200428.nc @@ -811,7 +811,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ic_ymd="60101" use_nitrif_denitrif=".true." use_vertsoilc=".true." sim_year="2000" ic_tod="0" glc_nec="10" use_crop=".true." irrigate=".true." lnd_tuning_mode="clm5_0_cam6.0" use_init_interp=".true." ->/glade/work/aherring/grids/uniform-res/ne120np4.pg3/inic/F2000climoBgcCrop_ne120pg3_ne120pg3_mt13_7680pes.clm2.r.06-01-00000_c200506.nc +>lnd/clm2/initdata_map/clmi.F2000.2000-01-01.ne120pg3_mt13_simyr2000_c200506.nc diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 9c88a179a0..2e881ea856 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,9 +138,9 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 862; +my $ntests = 878; if ( defined($opts{'compare'}) ) { - $ntests += 528; + $ntests += 540; } plan( tests=>$ntests ); @@ -323,6 +323,36 @@ sub make_config_cache { } &cleanup(); } + +print "\n===============================================================================\n"; +print "Test some CAM specific setups for special grids \n"; +print "=================================================================================\n"; +$phys = "clm5_0"; +$mode = "-phys $phys"; +&make_config_cache($phys); +foreach my $options ( + "-res ne0np4.ARCTIC.ne30x4 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=19790101/' -lnd_tuning_mode clm5_0_cam6.0", + "-res ne0np4.ARCTICGRIS.ne30x8 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=19790101/' -lnd_tuning_mode clm5_0_cam6.0", + "-res 0.9x1.25 -bgc bgc -crop -use_case 20thC_transient -namelist '&a start_ymd=19500101/' -lnd_tuning_mode clm5_0_cam6.0", + "-res ne0np4CONUS.ne30x8 -bgc bgc -crop -use_case 20thC_transient -namelist '&a start_ymd=20130101/' -lnd_tuning_mode clm5_0_cam6.0", + ) { + &make_env_run(); + eval{ system( "$bldnml -envxml_dir . $options > $tempfile 2>&1 " ); }; + is( $@, '', "options: $options" ); + $cfiles->checkfilesexist( "$options", $mode ); + $cfiles->shownmldiff( "default", $mode ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->dodiffonfile( "lnd_in", "$options", $mode ); + $cfiles->dodiffonfile( "$real_par_file", "$options", $mode ); + $cfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); +} + print "\n==============================================================\n"; print "Test several use_cases and specific configurations for clm5_0\n"; print "==============================================================\n"; From 7d2ee8e2cad6861ccaf83038e4b88efccac2add6 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 12 Jul 2020 15:29:53 -0600 Subject: [PATCH 478/556] Add some tests for the new grids --- cime_config/testdefs/testlist_clm.xml | 54 +++++++++++++++++++ .../include_user_mods | 1 + .../shell_commands | 1 + .../include_user_mods | 1 + .../shell_commands | 1 + 5 files changed, 58 insertions(+) create mode 100644 cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_1979Start/include_user_mods create mode 100644 cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_1979Start/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_2013Start/include_user_mods create mode 100644 cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_2013Start/shell_commands diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 3420b41fce..7499b5f555 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1193,6 +1193,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_1979Start/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_1979Start/include_user_mods new file mode 100644 index 0000000000..1c3eece35d --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_1979Start/include_user_mods @@ -0,0 +1 @@ +../clm50cam6LndTuningMode diff --git a/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_1979Start/shell_commands b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_1979Start/shell_commands new file mode 100644 index 0000000000..2aafcc1186 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_1979Start/shell_commands @@ -0,0 +1 @@ +./xmlchange RUN_STARTDATE=1979-01-01 diff --git a/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_2013Start/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_2013Start/include_user_mods new file mode 100644 index 0000000000..1c3eece35d --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_2013Start/include_user_mods @@ -0,0 +1 @@ +../clm50cam6LndTuningMode diff --git a/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_2013Start/shell_commands b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_2013Start/shell_commands new file mode 100644 index 0000000000..035842f982 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode_2013Start/shell_commands @@ -0,0 +1 @@ +./xmlchange RUN_STARTDATE=2013-01-01 From 8c731f21134d4e3086601ac42ea7a56de21af17a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 12 Jul 2020 18:57:22 -0600 Subject: [PATCH 479/556] Add 2013 IC file for CONUS --- bld/namelist_files/namelist_defaults_ctsm.xml | 16 +++++++++++++++- bld/namelist_files/namelist_definition_ctsm.xml | 6 +++--- bld/unit_testers/build-namelist_test.pl | 2 +- 3 files changed, 19 insertions(+), 5 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index e7e0b67688..1484c6fa14 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -505,7 +505,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 61 -1850,1982,2000,2010 +1850,1982,2000,2010,2013 +hgrid=ne0np4CONUS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 + +lnd/clm2/initdata_map/clmi.FHISTSp.2013-01-01.ne0CONUSne30x8_mt12_simyr2013_c200705.nc + + diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index e08bb3dfbc..2acbda143e 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1985,7 +1985,7 @@ If 1, turn on the MEGAN model for BVOC's (Biogenic Volitile Organic Compounds) +"PtVg,1000,850,1100,1350,1600,1850,1855,1865,1875,1885,1895,1905,1915,1925,1935,1945,1955,1965,1975,1979,1980,1982,1985,1995,2000,2005,2010,2013,2015,2025,2035,2045,2055,2065,2075,2085,2095,2105"> Year to simulate and to provide datasets for (such as surface datasets, initial conditions, aerosol-deposition, Nitrogen deposition rates etc.) A sim_year of 1000 corresponds to data used for testing only, NOT corresponding to any real datasets. A sim_year greater than 2015 corresponds to ssp_rcp scenario data @@ -2023,8 +2023,8 @@ Attributes to use when looking for an initial condition file (finidat) if interp How close in years to use when looking for an initial condition file (finidat) if interpolation is turned on (use_init_interp is .true.) - + Simulation years you can look for in initial condition files (finidat) if interpolation is turned on (use_init_interp is .true.) diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 2e881ea856..411200f652 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -334,7 +334,7 @@ sub make_config_cache { "-res ne0np4.ARCTIC.ne30x4 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=19790101/' -lnd_tuning_mode clm5_0_cam6.0", "-res ne0np4.ARCTICGRIS.ne30x8 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=19790101/' -lnd_tuning_mode clm5_0_cam6.0", "-res 0.9x1.25 -bgc bgc -crop -use_case 20thC_transient -namelist '&a start_ymd=19500101/' -lnd_tuning_mode clm5_0_cam6.0", - "-res ne0np4CONUS.ne30x8 -bgc bgc -crop -use_case 20thC_transient -namelist '&a start_ymd=20130101/' -lnd_tuning_mode clm5_0_cam6.0", + "-res ne0np4CONUS.ne30x8 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=20130101/' -lnd_tuning_mode clm5_0_cam6.0", ) { &make_env_run(); eval{ system( "$bldnml -envxml_dir . $options > $tempfile 2>&1 " ); }; From e732fc1a7968cece94feaeb686b3254ce1038d11 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 12 Jul 2020 19:08:22 -0600 Subject: [PATCH 480/556] Use rcp landuse timeseries files for historical as well (for new SE grids), fix the SSP landuse timeseries as well they had use_crop on and the wrong sim_year range --- bld/namelist_files/namelist_defaults_ctsm.xml | 48 +++++++++---------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 1484c6fa14..f5f24e97ea 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1067,18 +1067,18 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts lnd/clm2/surfdata_map/landuse.timeseries_1x1_numaIA_hist_78pfts_CMIP6_simyr1850-2015_c170917.nc - -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc - -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc - -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc - -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc - -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTIC.ne30x4_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc - -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_hist_78pfts_CMIP6_simyr1850-2015_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTIC.ne30x4_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_C24_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200317.nc @@ -1105,18 +1105,18 @@ lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_h lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_C96_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200317.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTIC.ne30x4_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg3_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTICGRIS.ne30x8_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.ARCTIC.ne30x4_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc +lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne0np4.CONUS.ne30x8_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc Date: Mon, 13 Jul 2020 01:35:13 -0600 Subject: [PATCH 481/556] Fix test list, remove previous new grid tests use the new ones, but also correct the grid names --- cime_config/testdefs/testlist_clm.xml | 55 +++------------------------ 1 file changed, 5 insertions(+), 50 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 7499b5f555..09525e2902 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1140,51 +1140,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1193,7 +1148,7 @@ - + @@ -1202,7 +1157,7 @@ - + @@ -1211,7 +1166,7 @@ - + @@ -1229,7 +1184,7 @@ - + @@ -1238,7 +1193,7 @@ - + From 74f137f99cb0082bd5098f33bac9bd9f8a7d2328 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 13 Jul 2020 14:42:00 -0600 Subject: [PATCH 482/556] Update change files --- doc/ChangeLog | 126 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 127 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index c08274e32e..6d4e5f42c2 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,130 @@ =============================================================== +Tag name: ctsm1.0.dev105 +Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) / Chris Fischer +Date: Mon Jul 13 14:41:40 MDT 2020 +One-line Summary: Bring in some new SE grids for CAM as well as initial condition files for them + +Purpose of changes +------------------ + Add new SE (Spectral Element) grids: ne30np4.pg2, ne30np4.pg3, ne30np4, ne60np4, ne120np4, ne120np4.pg2, ne120np4.pg3, + ne0np4CONUS.ne30x8, ne0np4.ARCTIC.ne30x4, ne0np4.ARCTICGRIS.ne30x8 + Add new datasets for them, some new tests, and add support for their creation. + + Also add some new initial condition (IC) files for 1979, 2000, and 2013 for use when coupled to CAM + + The process for picking initial condition files was improved so that there can be more than one year that matches + and it will do the best to pick the best match. Also added the possibility for 1982 and 2013 simulation years. + + Also update cime to a newer version that supports these new grids. + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): #992 #994 + Fixes #992 -- New initial conditions for 1979, 2000 + Fixes #994 -- New CAM SE grids + Fixes #888 -- Add support for various "physics grids" needed by CAM +CIME Issues fixed (include issue #): #3593, #3569, #3564 + cime/#3593 -- Fix mapping files for new grids + cime/#3569 -- Fix cime regression testing + cime/#3564 -- Change alias for arctic grids + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? No +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): + Initial conditions (IC) for 1979 start date is technically 1982 + New initial condition files are ONLY for when coupled to CAM (B and F compsets) + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): Allow for new grids + User updates to cime: + - Allow a user supplied config_grids.xml file. + - Improved error message for incorrect setting of cime model. + +Changes made to namelist defaults (e.g., changed parameter values): Add IC files for 1982 and 2013 years + +Changes to the datasets (e.g., parameter, surface or initial files): New SE grid datasets + Remove conus_30_x8 grid (previous name for new ne0np4CONUS.ne30x8 grid + Add new grids: ne30np4.pg2, ne30np4.pg3, ne30np4, ne60np4, ne120np4, ne120np4.pg2, ne120np4.pg3, + ne0np4CONUS.ne30x8, ne0np4.ARCTIC.ne30x4, ne0np4.ARCTICGRIS.ne30x8 + Add new mask: tx0.1v3 + New IC files: 1982 for ARCTIC and ARCTICGRIS, ne120np4 for 2000 and 2013 for CONUS all when coupled to CAM + +Substantial timing or memory changes: None + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + Initial condition picking will pick the file it finds with the closet simulation year to the request + for the lnd_tuning_mode desired. It will pick based on year over an exact match in resolution. + You can get around this by setting use_init_interp to be specific for a resolution + +Changes to tests or testing: Added tests for new grids + +Code reviewed by: self, fischer-ncar, adamrher + + +CTSM testing: regular + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + izumi - OK (121 tests fail comparison to previous verison due to new IC files) + + tools-tests (test/tools): + + izumi - + + PTCLM testing (tools/shared/PTCLM/test): + + izumi - OK + + python testing (see instructions in python/README.md; document testing done): + + izumi -- PASS + + regular tests (aux_clm): + + cheyenne ---- + izumi ------- PASS + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: No bit-for-bit + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): cime + cime updated to cime5.8.28 (from branch_tags/cime5.8.24_a01) + +Pull Requests that document the changes (include PR ids): #1038 +(https://github.com/ESCOMP/ctsm/pull) + #1038 -- New fsufdat and landuse time series files for ne grids + +=============================================================== +=============================================================== Tag name: ctsm1.0.dev104 Originator(s): sacks (Bill Sacks) Date: Mon Jul 6 09:58:15 MDT 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index c773cf9101..e698eadba8 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm1.0.dev105 erik/fis 07/13/2020 Bring in some new SE grids for CAM as well as initial condition files for them ctsm1.0.dev104 sacks 07/06/2020 Add LILAC ctsm1.0.dev103 slevis 06/29/2020 Gridcell-level error-check for methane (CH4) ctsm1.0.dev102 erik/ole 06/26/2020 Some important fixes for LUNA in clm5_0, and small urban issue in clm5_0 From a0f1a46fb5b8a200ffffc0360acccdb0d9885686 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 13 Jul 2020 15:14:24 -0600 Subject: [PATCH 483/556] Remove conus_30_x8 in light of new name ne0np4CONUS.ne30x8 --- bld/namelist_files/namelist_definition_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 2acbda143e..e540540813 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1948,7 +1948,7 @@ CLM run type. + valid_values="512x1024,360x720cru,128x256,64x128,48x96,94x192,0.23x0.31,0.47x0.63,0.9x1.25,1.9x2.5,2.5x3.33,4x5,10x15,0.125nldas2,5x5_amazon,1x1_camdenNJ,1x1_vancouverCAN,1x1_mexicocityMEX,1x1_asphaltjungleNJ,1x1_brazil,1x1_urbanc_alpha,1x1_numaIA,1x1_smallvilleIA,0.1x0.1,0.25x0.25,0.5x0.5,3x3min,5x5min,10x10min,0.33x0.33,0.125x0.125,ne4np4,ne16np4,ne30np4.pg2,ne30np4.pg3,ne30np4,ne60np4,ne120np4,ne120np4.pg2,ne120np4.pg3,ne0np4CONUS.ne30x8,ne0np4.ARCTIC.ne30x4,ne0np4.ARCTICGRIS.ne30x8,ne240np4,1km-merge-10min,C24,C48,C96,C192,C384"> Horizontal resolutions Note: 0.1x0.1, 0.25x0.25, 0.5x0.5, 5x5min, 10x10min, 3x3min, 1km-merge-10min and 0.33x0.33 are only used for CLM toolsI From 88a733325a87d78e58099ad15a7f8d28cc493f83 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 13 Jul 2020 15:45:59 -0600 Subject: [PATCH 484/556] Change name for conus grid mapping files to ne0np4CONUS.ne30x8 and add new SCRIP grid files for all the new grids --- bld/namelist_files/namelist_defaults_ctsm.xml | 40 +++++++++---------- .../namelist_defaults_ctsm_tools.xml | 20 ++++++---- 2 files changed, 33 insertions(+), 27 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index f5f24e97ea..abd0e6f083 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -3003,47 +3003,47 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts - + -lnd/clm2/mappingdata/maps/conus_30_x8/map_5x5min_nomask_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_GLOBE-Gardner_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_LandScan2004_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_10x10min_nomask_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_0.5x0.5_MODIS_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_5x5min_ORNL-Soil_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_0.5x0.5_AVHRR_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_MODIS-wCsp_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_1km-merge-10min_HYDRO1K-merge-nomask_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_360x720cru_cruncep_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_10x10min_IGBPmergeICESatGIS_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_GLOBE-Gardner-mergeGIS_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_0.9x1.25_GRDC_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_5x5min_ISRIC-WISE_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_USGS_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_0.25x0.25_MODIS_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_MODISv2_to_conus_30_x8_nomask_aave_da_c190505.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_5x5min_IGBP-GSDP_to_conus_30_x8_nomask_aave_da_c181003.nc - + diff --git a/bld/namelist_files/namelist_defaults_ctsm_tools.xml b/bld/namelist_files/namelist_defaults_ctsm_tools.xml index de68cfca89..32b8f9bbc7 100644 --- a/bld/namelist_files/namelist_defaults_ctsm_tools.xml +++ b/bld/namelist_files/namelist_defaults_ctsm_tools.xml @@ -46,15 +46,21 @@ attributes from the config_cache.xml file (with keys converted to upper-case). atm/cam/coords/C24_SCRIP_desc.181018.nc -lnd/clm2/mappingdata/grids/SCRIPgrid_ne240np4_nomask_c091227.nc -lnd/clm2/mappingdata/grids/SCRIPgrid_ne120np4_nomask_c101123.nc -lnd/clm2/mappingdata/grids/SCRIPgrid_ne60np4_nomask_c100408.nc -lnd/clm2/mappingdata/grids/SCRIPgrid_ne30np4_nomask_c101123.nc -lnd/clm2/mappingdata/grids/SCRIPgrid_ne16np4_nomask_c110512.nc -lnd/clm2/mappingdata/grids/SCRIPgrid_ne4np4_nomask_c110808.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne240np4_nomask_c091227.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne120np4_nomask_c101123.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne60np4_nomask_c100408.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne30np4_nomask_c101123.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne16np4_nomask_c110512.nc + +atm/cam/coords/ne30pg2_scrip_c170608.nc +atm/cam/coords/ne30pg3_scrip_170604.nc +atm/cam/coords/ne120pg2_scrip_c170629.nc +atm/cam/coords/ne120pg3_scrip_c170628.nc -lnd/clm2/mappingdata/grids/SCRIPgrid_conus_30_x8_nomask_c170111.nc +atm/cam/coords/ne0CONUSne30x8_scrip_c200107.nc +atm/cam/coords/ne0ARCTICGRISne30x8_scrip_c191209.nc +atm/cam/coords/ne0ARCTICne30x4_scrip_c191212.nc Date: Mon, 13 Jul 2020 15:51:40 -0600 Subject: [PATCH 485/556] Update on testing --- doc/ChangeLog | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 6d4e5f42c2..61f3cc2e47 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm1.0.dev105 Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) / Chris Fischer -Date: Mon Jul 13 14:41:40 MDT 2020 +Date: Mon Jul 13 15:51:21 MDT 2020 One-line Summary: Bring in some new SE grids for CAM as well as initial condition files for them Purpose of changes @@ -90,7 +90,7 @@ CTSM testing: regular tools-tests (test/tools): - izumi - + izumi - OK PTCLM testing (tools/shared/PTCLM/test): From 9652d126c83a8701a1ccafee2e27bfb5d5c5c551 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 14 Jul 2020 13:55:30 -0600 Subject: [PATCH 486/556] Bring in changes from release-clm5.0.31-34 Bring in changes from release-clm5.0.31-releas-clm5.0.34 except for the documentation updates, SSP 2100-2300 extension, manage_externals update, and externals update. Changes were brought in using patch, and removing the changes that were unneeded. --- bld/CLMBuildNamelist.pm | 15 +- .../namelist_defaults_ctsm_tools.xml | 10 +- bld/unit_testers/build-namelist_test.pl | 15 +- .../cmip6_waccm_deck/shell_commands | 3 + doc/ChangeSum | 4 + test/tools/README.testnames | 15 +- test/tools/input_tests_master | 3 + test/tools/nl_files/mksrfdt_f09_PtVg | 1 + test/tools/tests_pretag_cheyenne_nompi | 1 + tools/contrib/README | 6 + tools/contrib/singlept | 6 +- tools/contrib/ssp_anomaly_forcing_smooth | 343 ++++++++++++++++++ tools/mksurfdata_map/README | 3 + tools/mksurfdata_map/mksurfdata.pl | 56 ++- 14 files changed, 442 insertions(+), 39 deletions(-) create mode 100755 cime_config/usermods_dirs/cmip6_waccm_deck/shell_commands create mode 100644 test/tools/nl_files/mksrfdt_f09_PtVg create mode 100755 tools/contrib/ssp_anomaly_forcing_smooth diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index db6fc6cb55..f460538aed 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1807,7 +1807,8 @@ sub setup_logic_co2_type { my $group = $definition->get_group_name($var); $nl->set_variable_value($group, $var, $opts->{$var}); } else { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'sim_year'=>$nl_flags->{'sim_year'} ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'sim_year'=>$nl_flags->{'sim_year'}, + 'ssp_rcp'=>$nl_flags->{'ssp_rcp'} ); } } } @@ -2177,7 +2178,7 @@ sub setup_logic_surface_dataset { $log->fatal_error( "dynamic PFT's (setting flanduse_timeseries) are incompatible with ecosystem dynamics (use_fates=.true)." ); } add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsurdat', - 'hgrid'=>$nl_flags->{'res'}, + 'hgrid'=>$nl_flags->{'res'}, 'ssp_rcp'=>$nl_flags->{'ssp_rcp'}, 'sim_year'=>$nl_flags->{'sim_year'}, 'irrigate'=>$nl_flags->{'irrigate'}, 'use_crop'=>$nl_flags->{'use_crop'}, 'glc_nec'=>$nl_flags->{'glc_nec'}); } @@ -3097,9 +3098,17 @@ sub setup_logic_nitrogen_deposition { 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, 'hgrid'=>"0.9x1.25", 'ssp_rcp'=>$nl_flags->{'ssp_rcp'}, 'nofail'=>1 ); if ( ! defined($nl->get_value('stream_fldfilename_ndep') ) ) { + # Also check at f19 resolution add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep', 'phys'=>$nl_flags->{'phys'}, 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, - 'hgrid'=>"1.9x2.5", 'ssp_rcp'=>$nl_flags->{'ssp_rcp'} ); + 'hgrid'=>"1.9x2.5", 'ssp_rcp'=>$nl_flags->{'ssp_rcp'}, 'nofail'=>1 ); + # If not found report an error + if ( ! defined($nl->get_value('stream_fldfilename_ndep') ) ) { + $log->warning("Did NOT find the Nitrogen-deposition forcing file (stream_fldfilename_ndep) for this ssp_rcp\n" . + "One way to get around this is to point to a file for another existing ssp_rcp in your user_nl_clm file.\n" . + "If you are running with CAM and WACCM chemistry Nitrogen deposition will come through the coupler.\n" . + "This file won't be used, so it doesn't matter what it points to -- but it's required to point to something.\n" ) + } } } else { # If bgc is NOT CN/CNDV then make sure none of the ndep settings are set! diff --git a/bld/namelist_files/namelist_defaults_ctsm_tools.xml b/bld/namelist_files/namelist_defaults_ctsm_tools.xml index de68cfca89..1ce6bbdc3c 100644 --- a/bld/namelist_files/namelist_defaults_ctsm_tools.xml +++ b/bld/namelist_files/namelist_defaults_ctsm_tools.xml @@ -265,6 +265,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/rawdata/mksrf_urban_0.05x0.05_simyr2000.c120621.nc +lnd/clm2/rawdata/mksrf_urban_0.05x0.05_zerourbanpct.c181014.nc + lnd/clm2/rawdata/mksrf_gdp_0.5x0.5_AVHRR_simyr2000.c130228.nc +lnd/clm2/rawdata/mksrf_gdp_0.5x0_zerogdp.c200413.nc lnd/clm2/rawdata/mksrf_peatf_0.5x0.5_AVHRR_simyr2000.c130228.nc @@ -303,6 +308,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/rawdata/mksrf_abm_0.5x0.5_AVHRR_simyr2000.c130201.nc +lnd/clm2/rawdata/mksrf_abm_0.5x0.5_missingabm.c200413.nc + lnd/clm2/rawdata/mksrf_topostats_1km-merge-10min_HYDRO1K-merge-nomask_simyr2000.c130402.nc @@ -4666,7 +4674,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index b8b7157703..70ca68e131 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,9 +138,9 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 834; +my $ntests = 897; if ( defined($opts{'compare'}) ) { - $ntests += 507; + $ntests += 552; } plan( tests=>$ntests ); @@ -1010,6 +1010,11 @@ sub make_config_cache { GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, + "missing_ndep_file" =>{ options=>"-envxml_dir . -bgc bgc -ssp_rcp SSP5-3.4", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_0", + }, "bad_megan_spec" =>{ options=>"-envxml_dir . -bgc bgc -megan", namelst=>"megan_specifier='ZZTOP=zztop'", GLC_TWO_WAY_COUPLING=>"FALSE", @@ -1211,7 +1216,7 @@ sub make_config_cache { $phys = "clm4_5"; $mode = "-phys $phys"; &make_config_cache($phys); -my @glc_res = ( "48x96", "0.9x1.25", "1.9x2.5" ); +my @glc_res = ( "0.9x1.25", "1.9x2.5" ); my @use_cases = ( "1850-2100_SSP1-2.6_transient", "1850-2100_SSP2-4.5_transient", "1850-2100_SSP3-7.0_transient", @@ -1222,7 +1227,7 @@ sub make_config_cache { "20thC_transient", ); foreach my $res ( @glc_res ) { - foreach my $usecase ( @usecases ) { + foreach my $usecase ( @use_cases ) { $options = "-bgc bgc -res $res -use_case $usecase -envxml_dir . "; &make_env_run(); eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; @@ -1243,7 +1248,7 @@ sub make_config_cache { $phys = "clm5_0"; $mode = "-phys $phys"; &make_config_cache($phys); -my @tran_res = ( "48x96", "0.9x1.25", "1.9x2.5", "ne30np4", "10x15" ); +my @tran_res = ( "0.9x1.25", "1.9x2.5", "ne30np4", "10x15" ); my $usecase = "20thC_transient"; my $GLC_NEC = 10; foreach my $res ( @tran_res ) { diff --git a/cime_config/usermods_dirs/cmip6_waccm_deck/shell_commands b/cime_config/usermods_dirs/cmip6_waccm_deck/shell_commands new file mode 100755 index 0000000000..5b872fb7bc --- /dev/null +++ b/cime_config/usermods_dirs/cmip6_waccm_deck/shell_commands @@ -0,0 +1,3 @@ +#!/bin/bash +# Turn ignore-warnings on, so won't abort on missing ndep file, as WACCM should provide it +./xmlchange --append CLM_BLDNML_OPTS="--ignore_warnings" diff --git a/doc/ChangeSum b/doc/ChangeSum index c773cf9101..097542e220 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,9 @@ Tag Who Date Summary ============================================================================================================================ +release-clm5.0.34 erik 04/20/2020 Update doc for release-clm5.0 (SKIPPED), and fix issues with no-anthro surface dataset creation +release-clm5.0.33 erik 04/07/2020 SKIPPED ON MASTER -- Turn irrigation on for 2300 SSP extensions +release-clm5.0.32 erik 04/02/2020 SKIPPED ON MASTER -- Extensions to 2300 for SSP5-8.5,SSP5-3.4, and SSP1-2.6 +release-clm5.0.31 erik 03/29/2020 Bring raw 2100-2300 extension (SKIPPED), some other misc. changes ctsm1.0.dev104 sacks 07/06/2020 Add LILAC ctsm1.0.dev103 slevis 06/29/2020 Gridcell-level error-check for methane (CH4) ctsm1.0.dev102 erik/ole 06/26/2020 Some important fixes for LUNA in clm5_0, and small urban issue in clm5_0 diff --git a/test/tools/README.testnames b/test/tools/README.testnames index 2795a14f0a..eb6d50f38c 100644 --- a/test/tools/README.testnames +++ b/test/tools/README.testnames @@ -24,16 +24,17 @@ n is the configuration type: 0 -- unused a -- unused b -- unused -c -- mkprocdata_map clm4.5 -d -- mkmapgrids clm4.5 -e -- gen_domain clm4.5 -f -- PTCLM clm4.5 -g -- mksurfdata_map clm4.5 -h -- interpinic clm4.5 -i -- tools scripts clm4.5 +c -- mkprocdata_map clm5.0 +d -- mkmapgrids clm5.0 +e -- gen_domain clm5.0 +f -- PTCLM clm5.0 +g -- mksurfdata_map clm5.0 +h -- interpinic clm5.0 +i -- tools scripts clm5.0 m is the resolution +0 -- 0.9x1.25 1 -- 48x96 5 -- 10x15 6 -- 5x5_amazon diff --git a/test/tools/input_tests_master b/test/tools/input_tests_master index 4050873b42..be6cf8f454 100644 --- a/test/tools/input_tests_master +++ b/test/tools/input_tests_master @@ -14,6 +14,9 @@ blg54 TBLtools.sh mksurfdata_map tools__s namelist smi24 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds bli24 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds +smi04 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_f09_PtVg^tools__ds +bli04 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_f09_PtVg^tools__ds + smi53 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__o bli53 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__o smi54 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__ds diff --git a/test/tools/nl_files/mksrfdt_f09_PtVg b/test/tools/nl_files/mksrfdt_f09_PtVg new file mode 100644 index 0000000000..61c2d8325e --- /dev/null +++ b/test/tools/nl_files/mksrfdt_f09_PtVg @@ -0,0 +1 @@ +-l CSMDATA -r 0.9x1.25 -no-crop -y PtVg -exedir EXEDIR diff --git a/test/tools/tests_pretag_cheyenne_nompi b/test/tools/tests_pretag_cheyenne_nompi index 1f35731f8d..b80d9a78c1 100644 --- a/test/tools/tests_pretag_cheyenne_nompi +++ b/test/tools/tests_pretag_cheyenne_nompi @@ -2,6 +2,7 @@ smc#4 blc#4 sme14 ble14 sme@4 ble@4 smg54 blg54 +smi04 bli04 smi24 bli24 smi53 bli53 smi64 bli64 diff --git a/tools/contrib/README b/tools/contrib/README index c8338a1a8e..bae1b51ca9 100644 --- a/tools/contrib/README +++ b/tools/contrib/README @@ -38,5 +38,11 @@ run_clmtowers It's based on having created surface datasets with PTCLM. v1 - Keith Oleson, 8/2015 +ssp_anomaly_forcing_smooth + This script creates anomaly forcing for CMIP6 SSP scenarios that + can be used to run CTSM in CESM with datm. + v0 -- Sean Swenson + v1 - Peter Lawrence 3/2020 + diff --git a/tools/contrib/singlept b/tools/contrib/singlept index d8c344f53e..076e67453b 100755 --- a/tools/contrib/singlept +++ b/tools/contrib/singlept @@ -116,7 +116,7 @@ datm_eyr=2014 #-- Modify landunit structure overwrite_single_pft = True dominant_pft = 7 #BETr -zero_nonveg_pfts = True +zero_nonveg_landunits= True uniform_snowpack = True no_saturation_excess = True @@ -204,7 +204,7 @@ if create_surfdata: if overwrite_single_pft: f3['PCT_NAT_PFT'][:,:,:] = 0 f3['PCT_NAT_PFT'][:,:,dominant_pft] = 100 - if zero_nonveg_pfts: + if zero_nonveg_landunits: f3['PCT_NATVEG'][:,:] = 100 f3['PCT_CROP'][:,:] = 0 f3['PCT_LAKE'][:,:] = 0. @@ -233,7 +233,7 @@ if create_surfdata: f1.to_netcdf(path='~/junk.nc', mode='w') #f1.to_netcdf(path=fsurf2, mode='w') f1.close() - if zero_nonveg_pfts: + if zero_nonveg_landunits: #f1 = xr.open_dataset(fsurf2) f1 = xr.open_dataset('~/junk.nc') f1['PCT_NATVEG'] = 100 diff --git a/tools/contrib/ssp_anomaly_forcing_smooth b/tools/contrib/ssp_anomaly_forcing_smooth new file mode 100755 index 0000000000..fa2350bcb9 --- /dev/null +++ b/tools/contrib/ssp_anomaly_forcing_smooth @@ -0,0 +1,343 @@ +#! /usr/bin/env python +# +# ssp_anomaly_forcing_smooth +# +# Create anomoly forcing datasets for SSP scenarios that can be used by CESM datm model +# +import sys +import os +import string +import subprocess +import datetime +import numpy as np +import matplotlib.pyplot as plt +import netCDF4 as netcdf4 +from scipy import interpolate + +# load proper modules first, i.e. +# cheyenne +''' +module load python/2.7.16 +ncar_pylib +#module load numpy/1.12.0 +#module load matplotlib/2.0.0 +#module load scipy/0.18.1 +#module load intel/16.0.3 +#module load ncarcompilers/0.3.5 +#module load netcdf/4.4.1.1 +#module load netcdf4-python/1.2.7 +''' + +# caldera / geyser + +''' +module load python/2.7.7 +module load numpy/1.11.0 +module load pyside/1.1.2 +module load matplotlib/1.5.1 +module load scipy/0.18.1 +module load netcdf4python/1.2.4 +''' + +#------------------------------------------------------- +""" + +This script creates CLM anomaly forcing data + +""" +#------------------------------------------------------- + +#-- end of function definitions --------------------------------- +#0 + +print( "Create anomoly forcing data that can be used by CTSM in CESM" ) +# Input and output directories make sure they exist +datapath = "/glade/p/cgd/tss/historyfiles/" # Path on cheyenne +spath = './' +if ( os.path.exists(datapath) ): + print( "Input data directory:"+datapath ) +else: + sys.exit( "Could not find input directory: "+datapath ) +if ( os.path.exists(spath) ): + print( "Output data directory:"+spath ) +else: + sys.exit( "Could not find output directory: "+spath ) + +# Settings to run with +today = datetime.date.today() +creationdate = "_c"+today.strftime( "%Y%m%d" ) +historydate = today.strftime( "%a %b %d %Y" ) +sspnum = 4 +smoothsize = 5 + +hist_case = 'b.e21.BHIST.f09_g17.CMIP6-historical.010' + +if sspnum == 1: + # SSP1-26 + ssptag = 'SSP1-2.6' + fut_case = 'b.e21.BSSP126cmip6.f09_g17.CMIP6-SSP1-2.6.001' +elif sspnum == 2: + # SSP3-70 + ssptag = 'SSP3-7.0' + fut_case = 'b.e21.BSSP370cmip6.f09_g17.CMIP6-SSP3-7.0.001' +elif sspnum == 3: + # SSP5-85 + ssptag = 'SSP5-8.5' + fut_case = 'b.e21.BSSP585cmip6.f09_g17.CMIP6-SSP5-8.5.001' +elif sspnum == 4: + # SSP2-45 + ssptag = 'SSP2-4.5' + fut_case = 'b.e21.BSSP245cmip6.f09_g17.CMIP6-SSP2-4.5.001' +else: + sys.exit( "sspnum is out of range: "+sspnum ) + +sspoutdir = 'anomaly_forcing/CMIP6-'+ssptag + +outdir = spath + sspoutdir +if ( not os.path.exists(outdir) ): + os.makedirs( outdir ) + +print( "Output specific data directory :"+outdir ) + + +hist_yrstart = 2000 +hist_yrend = 2014 +hist_nyrs = hist_yrend - hist_yrstart + 1 + +fut1_yrstart = 2015 +fut1_yrend = 2064 +fut1_nyrs = fut1_yrend - fut1_yrstart + 1 + +fut2_yrstart = 2065 +fut2_yrend = 2100 +fut2_nyrs = fut2_yrend - fut2_yrstart + 1 + +fut_yrstart = 2015 +fut_yrend = 2100 +fut_nyrs = fut_yrend - fut_yrstart + 1 + +tot_yrstart = 2000 +tot_yrend = 2100 +tot_nyrs = tot_yrend - tot_yrstart + 1 + +nmo = 12 +histnm = nmo*hist_nyrs +futnm = nmo*fut_nyrs +totnm = nmo*tot_nyrs +outnm = nmo*fut_nyrs + +dpath = datapath +dfile = '/lnd/proc/tseries/month_1/' +hdir = dpath+hist_case+dfile +fdir = dpath+fut_case+dfile + +# Check that directories exist +if ( os.path.exists(hdir) ): + print( "Data file directory:"+hdir ) +else: + sys.exit( "Could not find directory: "+hdir ) +if ( os.path.exists(fdir) ): + print( "Data file directory:"+fdir ) +else: + sys.exit( "Could not find directory: "+fdir ) + +print( "\n\n\n" ) + +# needed to use QBOT and U10, not using V and U(for sfcwind) +field_in = [ 'TBOT', 'RAIN', 'SNOW', 'FSDS', 'FLDS', 'QBOT', 'PBOT'] +field_combine = [ 0, 1, 1, 0, 0, 0, 0] +field_out = [ 'tas', 'pr', 'pr', 'rsds', 'rlds', 'huss', 'ps'] +units = [ 'K', ' ', ' ', ' ', ' ', 'kg/kg', 'Pa'] +units_disp = [ 'K', 'mm/s', 'mm/s', 'W m!U-2!N', 'W m!U-2!N', 'kg/kg', 'Pa'] +anomsf = ['anomaly','scale factor','scale factor','scale factor','scale factor','anomaly','anomaly'] + +nfields = len(field_in) + +#-- Read coordinates +landfile = hdir+hist_case+'.clm2.h0.TBOT.'+str(hist_yrstart)+'01-'+str(hist_yrend)+'12.nc' +if ( os.path.exists(landfile) ): + print( "Land File: "+landfile ) +else: + sys.exit( "Could not find land file: "+landfile ) + +f1 = netcdf4.Dataset(landfile, 'r') +landfrac=np.asfarray(f1.variables['landfrac'][:,:],np.float64) +landmask=np.asfarray(f1.variables['landmask'][:,:],np.float64) +area=np.asfarray(f1.variables['area'][:,:],np.float64) +lon = np.asfarray(f1.variables['lon'][:],np.float64) +lat = np.asfarray(f1.variables['lat'][:],np.float64) +nlat = lat.size +nlon = lon.size +f1.close() +ind=np.where(landfrac > 1.e10) +landfrac[ind]=0 + +#-- Loop over forcing fields ------------------------------------ +fieldskip = 0 +for f in range(nfields): + # read in last ten years of historical data ------------------ + + infieldname1 = field_in[f] + infieldcombine1 = field_combine[f] + if ((infieldcombine1 == 1 and fieldskip == 0) or (infieldcombine1 == 0 and fieldskip == 0)): + hvarfile1 = hdir+hist_case+'.clm2.h0.'+infieldname1+'.'+str(hist_yrstart)+'01-'+str(hist_yrend)+'12.nc' + fvarfile1 = fdir+fut_case+'.clm2.h0.'+infieldname1+'.'+str(fut1_yrstart)+'01-'+str(fut1_yrend)+'12.nc' + fvarfile2 = fdir+fut_case+'.clm2.h0.'+infieldname1+'.'+str(fut2_yrstart)+'01-'+str(fut2_yrend)+'12.nc' + hf1 = netcdf4.Dataset(hvarfile1, 'r') + ff1 = netcdf4.Dataset(fvarfile1, 'r') + ff2 = netcdf4.Dataset(fvarfile2, 'r') + hvarvalues1 = np.asfarray(hf1.variables[infieldname1][:],np.float64) + htime1 = np.asfarray(hf1.variables['time'][:],np.float64) + print( 'Reading: ' + hvarfile1 ) + fvarvalues1 = np.asfarray(ff1.variables[infieldname1][:],np.float64) + ftime1 = np.asfarray(ff1.variables['time'][:],np.float64) + long_name = ff1.variables[field_in[f]].long_name + print( 'Reading: ' + fvarfile1 ) + fvarvalues2 = np.asfarray(ff2.variables[infieldname1][:],np.float64) + ftime2 = np.asfarray(ff2.variables['time'][:],np.float64) + print( 'Reading: ' + fvarfile2 ) + hf1.close() + ff1.close() + ff2.close() + if (infieldcombine1 == 1): + infieldname2 = field_in[f+1] + infieldcombine2 = field_combine[f+1] + hvarfile2 = hdir+hist_case+'.clm2.h0.'+infieldname2+'.'+str(hist_yrstart)+'01-'+str(hist_yrend)+'12.nc' + fvarfile3 = fdir+fut_case+'.clm2.h0.'+infieldname2+'.'+str(fut1_yrstart)+'01-'+str(fut1_yrend)+'12.nc' + fvarfile4 = fdir+fut_case+'.clm2.h0.'+infieldname2+'.'+str(fut2_yrstart)+'01-'+str(fut2_yrend)+'12.nc' + hf2 = netcdf4.Dataset(hvarfile2, 'r') + ff3 = netcdf4.Dataset(fvarfile3, 'r') + ff4 = netcdf4.Dataset(fvarfile4, 'r') + hvarvalues1 = hvarvalues1 + np.asfarray(hf2.variables[infieldname2][:],np.float64) + print( 'Reading: ' + hvarfile2 ) + fvarvalues1 = fvarvalues1 + np.asfarray(ff3.variables[infieldname2][:],np.float64) + print( 'Reading: ' + fvarfile3 ) + fvarvalues2 = fvarvalues2 + np.asfarray(ff4.variables[infieldname2][:],np.float64) + print( 'Reading: ' + fvarfile4 ) + hf2.close() + ff3.close() + ff4.close() + fieldskip = 1 + + allvarvalues = np.concatenate((hvarvalues1,fvarvalues1,fvarvalues2),axis=0) + alltime = np.concatenate((htime1,ftime1,ftime2),axis=0) + ftime = np.concatenate((ftime1,ftime2),axis=0) + outtime = ftime - 16 + histavgvalues = np.zeros((nmo,nlat,nlon)) + histavgcount = np.zeros((nmo)) + runningavgvalues = np.zeros((nlat,nlon)) + runningavgcount = 0.0 + outputvarvalues = np.zeros((outnm,nlat,nlon)) + + for hmonthindex in range(histnm): + havgmonthnum = (hmonthindex) % 12 + 1 + havgmonthindex = havgmonthnum - 1 + histavgvalues[havgmonthindex,:,:] = histavgvalues[havgmonthindex,:,:] * histavgcount[havgmonthindex] + histavgvalues[havgmonthindex,:,:] = histavgvalues[havgmonthindex,:,:] + allvarvalues[hmonthindex,:,:] + histavgcount[havgmonthindex] = histavgcount[havgmonthindex] + 1.0 + histavgvalues[havgmonthindex,:,:] = histavgvalues[havgmonthindex,:,:] / histavgcount[havgmonthindex] + + for fmonthindex in range(futnm): + allmonthindex = fmonthindex + histnm + allyearindex = int(allmonthindex / nmo) + favgmonthnum = (allmonthindex) % 12 + 1 + favgmonthindex = favgmonthnum - 1 + + firstmonthindex = allmonthindex - nmo * smoothsize + if allyearindex <= (tot_nyrs - smoothsize): + lastmonthindex = allmonthindex + nmo * smoothsize + else: + lastmonthindex = allmonthindex + nmo * (tot_nyrs - allyearindex) + + runningavgvalues = 0.0 + runningavgcount = 0.0 + for smonthindex in range(firstmonthindex,lastmonthindex,nmo): + runningavgvalues = runningavgvalues * runningavgcount + runningavgvalues = runningavgvalues + allvarvalues[smonthindex,:,:] + runningavgcount = runningavgcount + 1.0 + runningavgvalues = runningavgvalues / runningavgcount + + climoavgvalues = histavgvalues[favgmonthindex,:,:] + if anomsf[f] == 'anomaly': + anomvalues = runningavgvalues - climoavgvalues + + if anomsf[f] == 'scale factor': + anomvalues = np.ones((nlat,nlon),dtype=np.float64) + + nonzeroindex = np.where(climoavgvalues != 0.0) + anomvalues[nonzeroindex] = runningavgvalues[nonzeroindex]/climoavgvalues[nonzeroindex] + + max_scale_factor = 5. + if field_in[f] == 'FSDS': + max_scale_factor = 2. + overmaxindex=np.where(anomvalues > max_scale_factor) + anomvalues[overmaxindex] = max_scale_factor + + outputvarvalues[fmonthindex,:,:] = anomvalues + + # create netcdf file --------------------------------- + + outfilename = outdir + '/'+'af.'+field_out[f]+'.cesm2.'+ssptag+'.'+str(fut_yrstart)+'-'+str(fut_yrend)+creationdate+'.nc' + print( 'Creating: ' + outfilename ) + outfile = netcdf4.Dataset(outfilename, 'w') + + outfile.source_file1 = hvarfile1 + outfile.source_file2 = fvarfile1 + outfile.source_file3 = fvarfile2 + outfile.title = 'anomaly forcing data' + outfile.note1 = 'Anomaly/scale factors calculated relative to ' \ + +str(hist_yrstart)+'-'+str(hist_yrend) \ + +' climatology from CESM2 historical simulation (case name: '+hist_case+')' + outfile.note2 = ssptag+' '+str(fut_yrstart)+'-'+str(fut_yrend) \ + +' from CESM simulations (case names: '+fut_case[0]+' and '+fut_case[1]+')' + outfile.smoothsize = str(smoothsize) + outfile.history = historydate + ": created by "+sys.argv[0] + stdout = os.popen( "git describe" ) + outfile.gitdescribe = stdout.read().rstrip() + + outfile.createDimension('lat', size=int(nlat)) + outfile.createDimension('lon', size=int(nlon)) + outfile.createDimension('time', size=None) + + wtime = outfile.createVariable('time',np.float64,('time',)) + wlat = outfile.createVariable('lat',np.float64,('lat',)) + wlon = outfile.createVariable('lon',np.float64,('lon',)) + wmask = outfile.createVariable('landmask',np.int32,('lat','lon')) + warea = outfile.createVariable('area',np.float64,('lat','lon')) + wfrac = outfile.createVariable('landfrac',np.float64,('lat','lon')) + wvar = outfile.createVariable(field_out[f],np.float64,('time','lat','lon'),fill_value=np.float64(1.e36)) + + wtime.units = 'days since ' + str(fut_yrstart) + '-01-01 00:00:00' + wlon.units = 'degrees' + wlat.units = 'degrees' + wvar.units = units[f] + warea.units = 'km2' + wfrac.units = 'unitless' + wmask.units = 'unitless' + + #wtime.long_name = 'Months since January '+str(fut_yrstart) + wtime.long_name = 'days since ' + str(fut_yrstart) + '-01-01 00:00:00' + wlon.long_name = 'Longitude' + wlat.long_name = 'Latitude' + wvar.long_name = str(long_name)+' '+anomsf[f] + warea.long_name = 'Grid cell area' + wfrac.long_name = 'Grid cell land fraction' + wmask.long_name = 'Grid cell land mask' + + wtime.calendar = 'noleap' + + # write to file -------------------------------------------- + #wtime[:] = month + wtime[:] = outtime + wlon[:] = lon + wlat[:] = lat + wmask[:,:] = landmask + wfrac[:,:] = landfrac + warea[:,:] = area + wvar[:,:,:] = outputvarvalues + + else: + fieldskip = 0 + + +print( "\n\nSuccessfully made anomoly forcing datasets\n" ) diff --git a/tools/mksurfdata_map/README b/tools/mksurfdata_map/README index 5d3a98fe08..bd324580bb 100644 --- a/tools/mksurfdata_map/README +++ b/tools/mksurfdata_map/README @@ -52,6 +52,9 @@ and generate the surface dataset: For supported model resolution () > mksurfdata.pl -res [options] + For supported model resolutions for SSP scenarios + > mksurfdata.pl -res -ssp_rcp -years 1850-2100 + For unsupported, user specified model resolutions > mksurfdata.pl -res usrspec -usr_gname -usr_gdate diff --git a/tools/mksurfdata_map/mksurfdata.pl b/tools/mksurfdata_map/mksurfdata.pl index 2106a16e32..7f4a50efaf 100755 --- a/tools/mksurfdata_map/mksurfdata.pl +++ b/tools/mksurfdata_map/mksurfdata.pl @@ -109,17 +109,20 @@ sub usage { Default: $opts{'usr_mapdir'} OPTIONS + NOTE: The three critical options are (-years, -glc_nec, and -ssp_rcp) they are marked as such. + -allownofile Allow the script to run even if one of the input files does NOT exist. -dinlc [or -l] Enter the directory location for inputdata (default $opts{'csmdata'}) -debug [or -d] Do not actually run -- just print out what would happen if ran. - -dynpft "filename" Dynamic PFT/harvesting file to use - (rather than create it on the fly) - (must be consistent with first year) + -dynpft "filename" Dynamic PFT/harvesting file to use if you have a manual list you want to use + (rather than create it on the fly, must be consistent with first year) + (Normally NOT used) -fast_maps Toggle fast mode which doesn't use the large mapping files -glc_nec "number" Number of glacier elevation classes to use (by default $opts{'glc_nec'}) + (CRITICAL OPTION) -merge_gis If you want to use the glacier dataset that merges in the Greenland Ice Sheet data that CISM uses (typically used only if consistency with CISM is important) @@ -134,7 +137,8 @@ sub usage { -no_surfdata Do not output a surface dataset This is useful if you only want a landuse_timeseries file -years [or -y] "years" Simulation year(s) to run over (by default $opts{'years'}) - (can also be a simulation year range: i.e. 1850-2000) + (can also be a simulation year range: i.e. 1850-2000 or 1850-2100 for ssp_rcp future scenarios) + (CRITICAL OPTION) -help [or -h] Display this help. -rundir "directory" Directory to run in @@ -143,6 +147,8 @@ sub usage { -ssp_rcp "scenario-name" Shared Socioeconomic Pathway and Representative Concentration Pathway Scenario name(s). "hist" for historical, otherwise in form of SSPn-m.m where n is the SSP number and m.m is the radiative forcing in W/m^2 at the peak or 2100. + (normally use thiw with -years 1850-2100) + (CRITICAL OPTION) -usrname "clm_usrdat_name" CLM user data name to find grid file with. @@ -603,7 +609,7 @@ sub write_namelist_file { my $mkcrop_on = ",crop='on'"; # - # Loop over all resolutions listed + # Loop over all resolutions and sim-years listed # foreach my $res ( @hresols ) { # @@ -627,7 +633,7 @@ sub write_namelist_file { # # Mapping files # - my %map; my %hgrd; my %lmsk; my %datfil; + my %map; my %hgrd; my %lmsk; my %datfil; my %filnm; my $hirespft = "off"; if ( defined($opts{'hirespft'}) ) { $hirespft = "on"; @@ -658,8 +664,9 @@ sub write_namelist_file { $hgrid = trim($hgrid); my $filnm = `$scrdir/../../bld/queryDefaultNamelist.pl $mopts -options type=$typ -var mksrf_filename`; $filnm = trim($filnm); - $hgrd{$typ} = $hgrid; - $lmsk{$typ} = $lmask; + $filnm{$typ} = $filnm; + $hgrd{$typ} = $hgrid; + $lmsk{$typ} = $lmask; if ( $opts{'hgrid'} eq "usrspec" ) { $map{$typ} = $opts{'usr_mapdir'}."/map_${hgrid}_${lmask}_to_${res}_nomask_aave_da_c${mapdate}\.nc"; } else { @@ -671,15 +678,6 @@ sub write_namelist_file { } if ( ! defined($opts{'allownofile'}) && ! -f $map{$typ} ) { die "ERROR: mapping file for this resolution does NOT exist ($map{$typ}).\n"; - } - my $typ_cmd = "$scrdir/../../bld/queryDefaultNamelist.pl $mkopts -options hgrid=$hgrid,lmask=$lmask,mergeGIS=$merge_gis$mkcrop -var $filnm"; - $datfil{$typ} = `$typ_cmd`; - $datfil{$typ} = trim($datfil{$typ}); - if ( $datfil{$typ} !~ /[^ ]+/ ) { - die "ERROR: could NOT find a $filnm data file for this resolution: $hgrid and type: $typ and $lmask.\n$typ_cmd\n\n"; - } - if ( ! defined($opts{'allownofile'}) && ! -f $datfil{$typ} ) { - die "ERROR: data file for this resolution does NOT exist ($datfil{$typ}).\n"; } } # @@ -711,7 +709,7 @@ sub write_namelist_file { # my $double = ".true."; # - # Loop over each sim_year + # Loop over each SSP-RCP scenario # RCP: foreach my $ssp_rcp ( @rcpaths ) { # @@ -744,16 +742,34 @@ sub write_namelist_file { $sim_yrn = $2; $transient = 1; } + # + # Find the file for each of the types + # + foreach my $typ ( @typlist ) { + my $hgrid = $hgrd{$typ}; + my $lmask = $lmsk{$typ}; + my $filnm = $filnm{$typ}; + my $typ_cmd = "$scrdir/../../bld/queryDefaultNamelist.pl $mkopts -options " . + "hgrid=$hgrid,lmask=$lmask,mergeGIS=$merge_gis$mkcrop,sim_year=$sim_yr0 -var $filnm"; + $datfil{$typ} = `$typ_cmd`; + $datfil{$typ} = trim($datfil{$typ}); + if ( $datfil{$typ} !~ /[^ ]+/ ) { + die "ERROR: could NOT find a $filnm data file for this resolution: $hgrid and type: $typ and $lmask.\n$typ_cmd\n\n"; + } + if ( ! defined($opts{'allownofile'}) && ! -f $datfil{$typ} ) { + die "ERROR: data file for this resolution does NOT exist ($datfil{$typ}).\n"; + } + } # determine simulation year to use for the surface dataset: my $sim_yr_surfdat = "$sim_yr0"; - my $cmd = "$scrdir/../../bld/queryDefaultNamelist.pl $queryfilopts $resol -options sim_year='${sim_yr_surfdat}'$mkcrop -var mksrf_fvegtyp -namelist clmexp"; + my $cmd = "$scrdir/../../bld/queryDefaultNamelist.pl $queryfilopts $resol -options sim_year='${sim_yr_surfdat}'$mkcrop,ssp_rcp=${ssp_rcp}${mkcrop} -var mksrf_fvegtyp -namelist clmexp"; my $vegtyp = `$cmd`; chomp( $vegtyp ); if ( $vegtyp eq "" ) { die "** trouble getting vegtyp file with: $cmd\n"; } - my $cmd = "$scrdir/../../bld/queryDefaultNamelist.pl $queryfilopts $resolhrv -options sim_year='${sim_yr_surfdat}'$mkcrop -var mksrf_fvegtyp -namelist clmexp"; + my $cmd = "$scrdir/../../bld/queryDefaultNamelist.pl $queryfilopts $resolhrv -options sim_year='${sim_yr_surfdat}'$mkcrop,ssp_rcp=${ssp_rcp}${mkcrop} -var mksrf_fvegtyp -namelist clmexp"; my $hrvtyp = `$cmd`; chomp( $hrvtyp ); if ( $hrvtyp eq "" ) { From 38c19d16f8a6a80665b28510b6c459d6529ceff4 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 14 Jul 2020 15:03:59 -0600 Subject: [PATCH 487/556] Add deffered interface needed --- src/main/FireMethodType.F90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/main/FireMethodType.F90 b/src/main/FireMethodType.F90 index cb4528c55d..314ee1ceca 100644 --- a/src/main/FireMethodType.F90 +++ b/src/main/FireMethodType.F90 @@ -97,6 +97,22 @@ subroutine FireInterp_interface(this, bounds) end subroutine FireInterp_interface + !----------------------------------------------------------------------- + subroutine CNFireReadParams_interface( this, ncid ) + ! + ! Read in the constant parameters from the input NetCDF parameter file + ! !USES: + use ncdio_pio , only: file_desc_t + import :: fire_method_type + ! + ! !ARGUMENTS: + implicit none + class(fire_method_type) :: this + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + !-------------------------------------------------------------------- + + end subroutine CNFireReadParams_interface + !----------------------------------------------------------------------- subroutine CNFireArea_interface (this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, & From 173287d0a5c1353063f12b04ab7b5bceaa667e3c Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 14 Jul 2020 15:13:59 -0600 Subject: [PATCH 488/556] Fix for #1004 --- bld/namelist_files/use_cases/20thC_transient.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/use_cases/20thC_transient.xml b/bld/namelist_files/use_cases/20thC_transient.xml index ff56232b8e..824f63cdc4 100644 --- a/bld/namelist_files/use_cases/20thC_transient.xml +++ b/bld/namelist_files/use_cases/20thC_transient.xml @@ -19,11 +19,11 @@ .false. 1850 -2005 +2015 1850 1850 -2005 +2015 1850 1850 From 39a99549957dc6e1db6e5c86b1fc163a86f6c7ee Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 14 Jul 2020 15:37:21 -0600 Subject: [PATCH 489/556] Fix for #1010 #1074 and make sure use_crop is set for older datasets ne30np4 and ne16np4 --- bld/namelist_files/namelist_defaults_ctsm.xml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index f5f24e97ea..e2d968234c 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -925,13 +925,13 @@ lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1x1_numaIA_hist_78pfts_CMIP6_si lnd/clm2/surfdata_map/ctsm1.0.dev094-2-g633be0eb/surfdata_1x1_smallvilleIA_hist_78pfts_CMIP6_simyr2000_c200521.nc - + lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_ne16np4_hist_78pfts_CMIP6_simyr2000_c190214.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4_hist_78pfts_CMIP6_simyr2000_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg2_hist_78pfts_CMIP6_simyr2000_c200426.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg3_hist_78pfts_CMIP6_simyr2000_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne120np4_hist_78pfts_CMIP6_simyr2000_c200427.nc @@ -1005,7 +1005,7 @@ lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1x1_numaIA_hist_78pfts_CMIP6_si lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1x1_brazil_hist_78pfts_CMIP6_simyr1850_c190214.nc - + lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4_hist_78pfts_CMIP6_simyr1850_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne30np4.pg2_hist_78pfts_CMIP6_simyr1850_c200426.nc @@ -1039,7 +1039,7 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts lnd/clm2/surfdata_map/landuse.timeseries_4x5_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc + use_crop=".false." >lnd/clm2/surfdata_map/release-clm5.0.18/landuse.timeseries_48x96_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c190214.nc lnd/clm2/surfdata_map/landuse.timeseries_1x1_brazil_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc @@ -1067,7 +1067,7 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts lnd/clm2/surfdata_map/landuse.timeseries_1x1_numaIA_hist_78pfts_CMIP6_simyr1850-2015_c170917.nc -lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc lnd/clm2/surfdata_map/release-clm5.0.30/landuse.timeseries_ne30np4.pg2_SSP5-8.5_78pfts_CMIP6_simyr1850-2100_c200426.nc From f7882107b154c2919cbf355bfaed3ba87a8cf081 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 15 Jul 2020 11:51:45 -0600 Subject: [PATCH 490/556] Change back #1004 with wrong ending year of ndep, since it has an apparant change to answers even for cases that dont' run past 2005 --- bld/namelist_files/use_cases/20thC_transient.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/use_cases/20thC_transient.xml b/bld/namelist_files/use_cases/20thC_transient.xml index 824f63cdc4..ff56232b8e 100644 --- a/bld/namelist_files/use_cases/20thC_transient.xml +++ b/bld/namelist_files/use_cases/20thC_transient.xml @@ -19,11 +19,11 @@ .false. 1850 -2015 +2005 1850 1850 -2015 +2005 1850 1850 From 4e85121b6f9448d008cd226c64a3c500bf807266 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 15 Jul 2020 13:59:16 -0600 Subject: [PATCH 491/556] Correct grid names for new tests --- cime_config/testdefs/testlist_clm.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 09525e2902..6f348c3f8a 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1175,7 +1175,7 @@ - + @@ -1184,7 +1184,7 @@ - + @@ -1193,7 +1193,7 @@ - + From 337295e3fde4c0a9f5a3707b4ae2c58f09f6fccb Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 15 Jul 2020 18:10:26 -0600 Subject: [PATCH 492/556] Add a use_fun if around the setting of free_retransn_to_npool_patch, so that clm4_5 answers can be the same --- src/biogeochem/CNNStateUpdate1Mod.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNNStateUpdate1Mod.F90 b/src/biogeochem/CNNStateUpdate1Mod.F90 index 74be1bb69a..bee931e7fc 100644 --- a/src/biogeochem/CNNStateUpdate1Mod.F90 +++ b/src/biogeochem/CNNStateUpdate1Mod.F90 @@ -88,6 +88,7 @@ end subroutine NStateUpdateDynPatch !----------------------------------------------------------------------- subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + use CNSharedParamsMod , only : use_fun ! ! !DESCRIPTION: ! On the radiation time step, update all the prognostic nitrogen state @@ -192,8 +193,10 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! WW change logic so livestem_retrans goes to npool (via free_retrans flux) ! this should likely be done more cleanly if it works, i.e. not update fluxes w/ states ! additional considerations for crop? - nf_veg%free_retransn_to_npool_patch(p) = nf_veg%free_retransn_to_npool_patch(p) + nf_veg%livestemn_to_retransn_patch(p) - nf_veg%free_retransn_to_npool_patch(p) = nf_veg%free_retransn_to_npool_patch(p) + nf_veg%livecrootn_to_retransn_patch(p) + if (use_fun ) then + nf_veg%free_retransn_to_npool_patch(p) = nf_veg%free_retransn_to_npool_patch(p) + nf_veg%livestemn_to_retransn_patch(p) + nf_veg%free_retransn_to_npool_patch(p) = nf_veg%free_retransn_to_npool_patch(p) + nf_veg%livecrootn_to_retransn_patch(p) + end if end if if (ivt(p) >= npcropmin) then ! Beth adds retrans from froot ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) - nf_veg%frootn_to_retransn_patch(p)*dt From bd9e44a600a9c7391116c6cd638fec4d82db4bcc Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 20 Jul 2020 14:16:14 -0600 Subject: [PATCH 493/556] CONUS finidat file needs to be interpolated (since we are using the crop version of fsurdat now), and remove the old conus_30x8 mapping files (will replace them with the new ones) --- bld/namelist_files/namelist_defaults_ctsm.xml | 43 +------------------ 1 file changed, 1 insertion(+), 42 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index abd0e6f083..9a0bc3e691 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -855,7 +855,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.FHISTSp.2013-01-01.ne0CONUSne30x8_mt12_simyr2013_c200705.nc @@ -3003,47 +3003,6 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts - - - -lnd/clm2/mappingdata/maps/conus_30_x8/map_5x5min_nomask_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_GLOBE-Gardner_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_LandScan2004_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_10x10min_nomask_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_0.5x0.5_MODIS_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_5x5min_ORNL-Soil_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_0.5x0.5_AVHRR_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_MODIS-wCsp_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_1km-merge-10min_HYDRO1K-merge-nomask_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_360x720cru_cruncep_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_10x10min_IGBPmergeICESatGIS_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_GLOBE-Gardner-mergeGIS_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_0.9x1.25_GRDC_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_5x5min_ISRIC-WISE_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_USGS_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_0.25x0.25_MODIS_to_conus_30_x8_nomask_aave_da_c181003.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_3x3min_MODISv2_to_conus_30_x8_nomask_aave_da_c190505.nc -lnd/clm2/mappingdata/maps/conus_30_x8/map_5x5min_IGBP-GSDP_to_conus_30_x8_nomask_aave_da_c181003.nc - - From 95437abd2f82cf07ed9100641fba97336ebe14a1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 20 Jul 2020 23:13:41 -0600 Subject: [PATCH 494/556] Fix the 48x96 landuse.timeseries file fix #1074 --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 9a0bc3e691..95b1f06a95 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1039,7 +1039,7 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts lnd/clm2/surfdata_map/landuse.timeseries_4x5_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc + use_crop=".false." >lnd/clm2/surfdata_map/release-clm5.0.18/landuse.timeseries_48x96_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c190214.nc lnd/clm2/surfdata_map/landuse.timeseries_1x1_brazil_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc From ebb841df700a861153dbddd39587d6ed505809fe Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 20 Jul 2020 23:51:18 -0600 Subject: [PATCH 495/556] Do the match based on start-year rather than sim_year, so that will match the previous 2010 case --- bld/CLMBuildNamelist.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 4834bfc854..6d7c845ca8 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2286,8 +2286,10 @@ SIMYR: foreach my $sim_yr ( @sim_years ) { my $how_close = undef; if ( $nl_flags->{'sim_year'} eq "PtVg" ) { $how_close = abs(1850 - $sim_yr); - } elsif ( $nl_flags->{'flanduse_timeseries'} eq "null" ) { - $how_close = abs($nl_flags->{'sim_year'} - $sim_yr); + # EBK 07/20/2020 -- This makes sure the sim_year matched is based on the sim-year + # rather than the start year. + #} elsif ( $nl_flags->{'flanduse_timeseries'} eq "null" ) { + # $how_close = abs($nl_flags->{'sim_year'} - $sim_yr); } else { $how_close = abs($st_year - $sim_yr); } From e4085c738b2265d20d1ccc909cbc4b765666b5f1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 21 Jul 2020 01:26:06 -0600 Subject: [PATCH 496/556] Add in the ne0np4CONUS.ne30x8 mapping files --- bld/namelist_files/namelist_defaults_ctsm.xml | 43 +++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 95b1f06a95..8a0237c1e1 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -2883,6 +2883,49 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts + + + + +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_5x5min_ORNL-Soil_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_3x3min_MODIS-wCsp_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_5x5min_ISRIC-WISE_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_0.9x1.25_GRDC_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_5x5min_nomask_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_3x3min_GLOBE-Gardner_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_3x3min_LandScan2004_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_360x720cru_cruncep_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_5x5min_IGBP-GSDP_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_3x3min_USGS_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_10x10min_nomask_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_3x3min_MODISv2_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_0.5x0.5_AVHRR_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_0.25x0.25_MODIS_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_0.5x0.5_MODIS_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc +lnd/clm2/mappingdata/maps/ne0np4CONUS.ne30x8/map_10x10min_IGBPmergeICESatGIS_to_ne0np4CONUS.ne30x8_nomask_aave_da_c200426.nc + + + lnd/clm2/mappingdata/maps/5x5_amazon/map_0.5x0.5_MODIS_to_5x5_amazon_nomask_aave_da_c110920.nc Date: Tue, 21 Jul 2020 13:28:28 -0600 Subject: [PATCH 497/556] Set st_year and ic_date if not set, so it can use reasonable assumptions --- bld/CLMBuildNamelist.pm | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 6d7c845ca8..9d7c6ebfa9 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1193,7 +1193,16 @@ sub setup_cmdl_run_type { my $val; my $var = "clm_start_type"; my $ic_date = $nl->get_value('start_ymd'); - my $st_year = int( $ic_date / 10000); + my $st_year; + if ( defined($ic_date) ) { + $st_year = int( $ic_date / 10000); + } else { + $st_year = $nl_flags->{'sim_year'}; + $ic_date = $st_year *10000 + 101; + my $date = 'start_ymd'; + my $group = $definition->get_group_name($date); + $nl->set_variable_value($group, $date, $ic_date ); + } if (defined $opts->{$var}) { if ($opts->{$var} eq "default" ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, @@ -1209,6 +1218,7 @@ sub setup_cmdl_run_type { 'sim_year'=>$st_year ); } $nl_flags->{'clm_start_type'} = $nl->get_value($var); + $nl_flags->{'st_year'} = $st_year; } #------------------------------------------------------------------------------- @@ -2218,7 +2228,7 @@ sub setup_logic_initial_conditions { if (not defined $finidat ) { my $ic_date = $nl->get_value('start_ymd'); - my $st_year = int( $ic_date / 10000); + my $st_year = $nl_flags->{'st_year'}; my $nofail = 1; my %settings; $settings{'hgrid'} = $nl_flags->{'res'}; From 93366651f63f54eab9b2ec79157ca81e19a9e785 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 22 Jul 2020 17:53:34 -0600 Subject: [PATCH 498/556] Get the build-namelist unit tests working correctly, namelist_defaults settings had to be set more carefully, and there is a dependence between two namelist_defaults files that I ran into --- bld/namelist_files/namelist_defaults_ctsm.xml | 68 +++++++++++++------ .../namelist_defaults_overall.xml | 18 +++-- bld/unit_testers/build-namelist_test.pl | 7 +- 3 files changed, 67 insertions(+), 26 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index fef2fbd60b..ec8d3ffe5d 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -512,23 +512,36 @@ attributes from the config_cache.xml file (with keys converted to upper-case). Find Initial condition files: The settings use_init_interp, init_interp_attributes and finidat MUST all be coordinated together! + NOTE: And they need to be coordinated with clm_start_type that's in namelist_defaults_overall.xml + --> .true. + .true. -.true. - + maxpft="17" use_cn=".false." use_crop=".false." hgrid="ne0np4.ARCTIC.ne30x4" >.true. .true. -.true. -.true. + maxpft="17" use_cn=".false." use_crop=".false." hgrid="ne0np4.ARCTICGRIS.ne30x8">.true. .true. + maxpft="17" use_cn=".false." use_crop=".false." hgrid="ne0np4CONUS.ne30x8" >.true. +.true. +.true. +.true. +.true. +.true. +.true. + +.true. + .false. + hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 @@ -653,7 +666,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). - + hgrid=ne120np4.pg3 maxpft=79 mask=tx0.1v3 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 @@ -670,25 +683,41 @@ attributes from the config_cache.xml file (with keys converted to upper-case). >hgrid=ne0np4.ARCTICGRIS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 - -hgrid=ne0np4.ARCTICGRIS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 - +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 - +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + + hgrid=ne0np4CONUS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 @@ -812,15 +841,15 @@ attributes from the config_cache.xml file (with keys converted to upper-case). >lnd/clm2/initdata_map/clmi.FHISTSp.1982-01-01.ARCTICGRIS_ne30x8_mt12_simyr1982_c200428.nc - + lnd/clm2/initdata_map/clmi.F2000.2000-01-01.ne120pg3_mt13_simyr2000_c200506.nc - + lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c181015.nc - - + + +arb_ic +arb_ic +arb_ic +arb_ic startup startup startup startup arb_ic arb_ic -arb_ic -arb_ic -arb_ic arb_ic cold diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 411200f652..c2c1689097 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,9 +138,9 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 878; +my $ntests = 890; if ( defined($opts{'compare'}) ) { - $ntests += 540; + $ntests += 549; } plan( tests=>$ntests ); @@ -335,6 +335,9 @@ sub make_config_cache { "-res ne0np4.ARCTICGRIS.ne30x8 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=19790101/' -lnd_tuning_mode clm5_0_cam6.0", "-res 0.9x1.25 -bgc bgc -crop -use_case 20thC_transient -namelist '&a start_ymd=19500101/' -lnd_tuning_mode clm5_0_cam6.0", "-res ne0np4CONUS.ne30x8 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=20130101/' -lnd_tuning_mode clm5_0_cam6.0", + "-res 1.9x2.5 -bgc sp -use_case 2010_control -namelist '&a start_ymd=20100101/' -lnd_tuning_mode clm5_0_cam6.0", + "-res C192 -bgc sp -use_case 2010_control -namelist '&a start_ymd=20100101/' -lnd_tuning_mode clm5_0_cam6.0", + "-res ne0np4.ARCTIC.ne30x4 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=20130101/' -lnd_tuning_mode clm5_0_cam6.0", ) { &make_env_run(); eval{ system( "$bldnml -envxml_dir . $options > $tempfile 2>&1 " ); }; From 8d8a61b93a2eb9486c22bd9ec8388f293258ecd8 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 22 Jul 2020 18:21:59 -0600 Subject: [PATCH 499/556] Ignore the standard run system test log file --- .gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index 7948b49eed..af193fa4ce 100644 --- a/.gitignore +++ b/.gitignore @@ -6,6 +6,9 @@ manage_externals.log /cime/ /components/ +# run system test log file +run_sys_test.log + # ignore svn directories **/.svn/** .svn/ From abacd3a7ee2076fa49486d0171d63937e42150a6 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 22 Jul 2020 18:22:44 -0600 Subject: [PATCH 500/556] Revert "Ignore the standard run system test log file" This reverts commit 8d8a61b93a2eb9486c22bd9ec8388f293258ecd8. --- .gitignore | 3 --- 1 file changed, 3 deletions(-) diff --git a/.gitignore b/.gitignore index af193fa4ce..7948b49eed 100644 --- a/.gitignore +++ b/.gitignore @@ -6,9 +6,6 @@ manage_externals.log /cime/ /components/ -# run system test log file -run_sys_test.log - # ignore svn directories **/.svn/** .svn/ From 8f3dd976c99125fbe1e6705ba418e5f8b6e205fe Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 22 Jul 2020 18:53:07 -0600 Subject: [PATCH 501/556] Update ChangeLog file --- doc/ChangeLog | 15 ++++++++++----- doc/ChangeSum | 2 +- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 61f3cc2e47..da6d7d7670 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm1.0.dev105 Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) / Chris Fischer -Date: Mon Jul 13 15:51:21 MDT 2020 +Date: Wed Jul 22 18:47:37 MDT 2020 One-line Summary: Bring in some new SE grids for CAM as well as initial condition files for them Purpose of changes @@ -13,7 +13,8 @@ Purpose of changes Also add some new initial condition (IC) files for 1979, 2000, and 2013 for use when coupled to CAM The process for picking initial condition files was improved so that there can be more than one year that matches - and it will do the best to pick the best match. Also added the possibility for 1982 and 2013 simulation years. + and it will do the best to pick the best match. Also added the possibility for 1982 and 2013 simulation years for + specific grid matches. Also update cime to a newer version that supports these new grids. @@ -75,6 +76,10 @@ Caveats for developers (e.g., code that is duplicated that requires double maint for the lnd_tuning_mode desired. It will pick based on year over an exact match in resolution. You can get around this by setting use_init_interp to be specific for a resolution + Also realized that there is a dependence between the namelist_defaults_ctsm.xml file and namelist_defaults_overall.xml + for the clm_start_type item. It must be coordinated with use_init_interp, init_interp_attributes and finidat + to work properly. I added a comment about this. We should probably just move them into the same file. + Changes to tests or testing: Added tests for new grids Code reviewed by: self, fischer-ncar, adamrher @@ -86,7 +91,7 @@ CTSM testing: regular build-namelist tests: - izumi - OK (121 tests fail comparison to previous verison due to new IC files) + cheyenne - OK (130 tests fail comparison to previous verison due to new IC files) tools-tests (test/tools): @@ -102,7 +107,7 @@ CTSM testing: regular regular tests (aux_clm): - cheyenne ---- + cheyenne ---- OK izumi ------- PASS If the tag used for baseline comparisons was NOT the previous tag, note that here: @@ -111,7 +116,7 @@ If the tag used for baseline comparisons was NOT the previous tag, note that her Answer changes -------------- -Changes answers relative to baseline: No bit-for-bit +Changes answers relative to baseline: No bit-for-bit (unless running with CAM because of new finidat files) Detailed list of changes ------------------------ diff --git a/doc/ChangeSum b/doc/ChangeSum index e698eadba8..db92d89ea4 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,6 +1,6 @@ Tag Who Date Summary ============================================================================================================================ - ctsm1.0.dev105 erik/fis 07/13/2020 Bring in some new SE grids for CAM as well as initial condition files for them + ctsm1.0.dev105 erik/fis 07/22/2020 Bring in some new SE grids for CAM as well as initial condition files for them ctsm1.0.dev104 sacks 07/06/2020 Add LILAC ctsm1.0.dev103 slevis 06/29/2020 Gridcell-level error-check for methane (CH4) ctsm1.0.dev102 erik/ole 06/26/2020 Some important fixes for LUNA in clm5_0, and small urban issue in clm5_0 From b75ad2a15df6e3df7cf84792aa24876dedca3f81 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 23 Jul 2020 09:11:08 -0600 Subject: [PATCH 502/556] Update externals for CMEPS to hashes from nuopc_dev branch so will run, add notes about answer changes to change files, update time for one test that ran over --- Externals_cime.cfg | 16 +++++++++++++++- cime_config/testdefs/testlist_clm.xml | 2 +- doc/ChangeLog | 15 +++++++++++---- doc/ChangeSum | 2 +- 4 files changed, 28 insertions(+), 7 deletions(-) diff --git a/Externals_cime.cfg b/Externals_cime.cfg index 46cd24b7d2..94b569d479 100644 --- a/Externals_cime.cfg +++ b/Externals_cime.cfg @@ -1,9 +1,23 @@ [cmeps] -hash = 386e1631a6a1e1900700c3a04d693df8692c9420 +hash = 9376b87 protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = src/drivers/nuopc/ required = True +[fox] +hash = 0ed59c1 +protocol = git +repo_url = https://github.com/ESMCI/fox.git +local_path = src/externals/fox +required = True + +[cdeps] +hash = 8e77759 +protocol = git +repo_url = https://github.com/ESCOMP/CDEPS.git +local_path = src/components/cdeps +required = True + [externals_description] schema_version = 1.0.0 diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 6f348c3f8a..413cdc4216 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1162,7 +1162,7 @@ - + diff --git a/doc/ChangeLog b/doc/ChangeLog index da6d7d7670..8c46437257 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm1.0.dev105 Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) / Chris Fischer -Date: Wed Jul 22 18:47:37 MDT 2020 +Date: Thu Jul 23 08:59:37 MDT 2020 One-line Summary: Bring in some new SE grids for CAM as well as initial condition files for them Purpose of changes @@ -16,7 +16,9 @@ Purpose of changes and it will do the best to pick the best match. Also added the possibility for 1982 and 2013 simulation years for specific grid matches. - Also update cime to a newer version that supports these new grids. + Also update cime to a newer version that supports these new grids. And update CMEPS (and hence add in fox, CDEPS) + to latest used on the nuopc_dev branch. Testing with nuopc wouldn't work without this update. The cime version updates + the tables for dry-deposition and changes answers for dry-deposition when it's turned on. Bugs fixed or introduced ------------------------ @@ -25,10 +27,11 @@ Issues fixed (include CTSM Issue #): #992 #994 Fixes #992 -- New initial conditions for 1979, 2000 Fixes #994 -- New CAM SE grids Fixes #888 -- Add support for various "physics grids" needed by CAM -CIME Issues fixed (include issue #): #3593, #3569, #3564 +CIME Issues fixed (include issue #): #3593, #3569, #3564, PR#3557 cime/#3593 -- Fix mapping files for new grids cime/#3569 -- Fix cime regression testing cime/#3564 -- Change alias for arctic grids + cime/#3557 -- updates to dry deposition data (PR) Significant changes to scientifically-supported configurations -------------------------------------------------------------- @@ -117,12 +120,16 @@ Answer changes -------------- Changes answers relative to baseline: No bit-for-bit (unless running with CAM because of new finidat files) + Running with nuopc changes answers because of updates to nuopc drivers + Dry-deposition changes answers when turned on (but doesn't effect anything else) Detailed list of changes ------------------------ -List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): cime +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): cime, cmeps, cdeps, fox cime updated to cime5.8.28 (from branch_tags/cime5.8.24_a01) + fox, and cdeps added in + cmeps, cdeps and fox updated to hashes used in the nuopc_dev branch of CESM Pull Requests that document the changes (include PR ids): #1038 (https://github.com/ESCOMP/ctsm/pull) diff --git a/doc/ChangeSum b/doc/ChangeSum index db92d89ea4..595b35fb19 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,6 +1,6 @@ Tag Who Date Summary ============================================================================================================================ - ctsm1.0.dev105 erik/fis 07/22/2020 Bring in some new SE grids for CAM as well as initial condition files for them + ctsm1.0.dev105 erik/fis 07/23/2020 Bring in some new SE grids for CAM as well as initial condition files for them ctsm1.0.dev104 sacks 07/06/2020 Add LILAC ctsm1.0.dev103 slevis 06/29/2020 Gridcell-level error-check for methane (CH4) ctsm1.0.dev102 erik/ole 06/26/2020 Some important fixes for LUNA in clm5_0, and small urban issue in clm5_0 From 5779704640117bace7a68df79f7514a168c0d0a4 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 29 Jul 2020 14:51:33 -0600 Subject: [PATCH 503/556] Start replacing finidat files with ones that don't need to be interpolated, add f09 and f19 clm5_0_cam6.0 1979 SP finidat files needed for CAM --- bld/namelist_files/namelist_defaults_ctsm.xml | 78 +++++++++++++------ .../namelist_definition_ctsm.xml | 2 +- 2 files changed, 54 insertions(+), 26 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index ec8d3ffe5d..b68ec11f79 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -22,7 +22,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 379.0 336.6 -340.6 379.0 388.8 397.5 @@ -505,7 +504,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 61 -1850,1982,2000,2010,2013 +1850,1979,2000,2010,2013 .true. - - +.true. +.true. +.true. -.true. .true. @@ -673,12 +676,22 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -hgrid=0.9x1.25 maxpft=17 mask=gx1v7 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 + + +hgrid=1.9x2.5 maxpft=17 mask=gx1v7 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 + + +hgrid=ne0np4.ARCTIC.ne30x4 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 -hgrid=ne0np4.ARCTICGRIS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 @@ -752,8 +765,8 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.I1850Clm50Sp.0181-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc + lnd_tuning_mode="clm5_0_GSWP3v1" +>lnd/clm2/initdata_map/clmi.I1850Clm50Sp.0181-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc @@ -768,8 +781,8 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.I1850Clm50BgcCropCru-ciso.1526-01-01.0.9x1.25_gx1v7_simyr1850_c190116.nc + lnd_tuning_mode="clm5_0_CRUv7" +>lnd/clm2/initdata_map/clmi.I1850Clm50BgcCropCru-ciso.1526-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc @@ -783,8 +796,8 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.I1850Clm50SpCru.1706-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc + lnd_tuning_mode="clm5_0_CRUv7" +>lnd/clm2/initdata_map/clmi.I1850Clm50SpCru.1706-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc @@ -825,28 +838,43 @@ attributes from the config_cache.xml file (with keys converted to upper-case). >lnd/clm2/initdata_map/clmi.I2000Clm50BgcCrop.2011-01-01.1.9x2.5_gx1v7_gl4_simyr2000_c190312.nc + +lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr1979_c200729.nc + + +lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.1.9x2.5_gx1v7_simyr1979_c200729.nc + + lnd/clm2/initdata_map/clmi.FHISTSp.1982-01-01.ARCTIC_ne30x4_mt12_simyr1982_c200425.nc + lnd_tuning_mode="clm5_0_cam6.0" +>lnd/clm2/initdata_map/clmi.FHISTSp.1979-01-01.ARCTIC_ne30x4_mt12_simyr1979_c200728.nc lnd/clm2/initdata_map/clmi.FHISTSp.1982-01-01.ARCTICGRIS_ne30x8_mt12_simyr1982_c200428.nc + lnd_tuning_mode="clm5_0_cam6.0" +>lnd/clm2/initdata_map/clmi.FHISTSp.1979-01-01.ARCTICGRIS_ne30x8_mt12_simyr1979_c200728.nc lnd/clm2/initdata_map/clmi.F2000.2000-01-01.ne120pg3_mt13_simyr2000_c200506.nc + lnd_tuning_mode="clm5_0_cam6.0" +>lnd/clm2/initdata_map/clmi.F2000.2000-01-01.ne120pg3_mt13_simyr2000_c200728.nc @@ -854,7 +882,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ic_ymd="20000101" use_nitrif_denitrif=".true." use_vertsoilc=".true." sim_year="2000" ic_tod="0" glc_nec="10" use_crop=".true." irrigate=".true." use_init_interp=".true." lnd_tuning_mode="clm4_5_cam6.0" ->lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c181015.nc +>lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c200728.nc lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c181015.nc +>lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c200728.nc @@ -883,9 +911,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.FHISTSp.2013-01-01.ne0CONUSne30x8_mt12_simyr2013_c200705.nc +>lnd/clm2/initdata_map/clmi.FHISTSp.2013-01-01.ne0CONUSne30x8_mt12_simyr2013_c200728.nc diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index e540540813..6455625ed2 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -2024,7 +2024,7 @@ How close in years to use when looking for an initial condition file (finidat) i + group="default_settings" valid_values="1850,1979,2000,2010,2013" > Simulation years you can look for in initial condition files (finidat) if interpolation is turned on (use_init_interp is .true.) From baea0d667fafbefc50a292f6a9aea5e84aaf2bc0 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 29 Jul 2020 17:34:08 -0600 Subject: [PATCH 504/556] Update I1850Clm45BgcCruGs finidat file --- bld/namelist_files/namelist_defaults_ctsm.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index b68ec11f79..c1ad048755 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -749,9 +749,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.I1850Clm45BgcCruGs.1101-01-01.0.9x1.25_gx1v7_simyr1850_c190718.nc +>lnd/clm2/initdata_map/clmi.I1850Clm45BgcCruGs.1101-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc Date: Wed, 29 Jul 2020 22:18:32 -0600 Subject: [PATCH 505/556] Replace the rest of the finidat files (all but 2010) --- bld/namelist_files/namelist_defaults_ctsm.xml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index c1ad048755..0ef8395f58 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -742,9 +742,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.I1850Clm45BgcGs.0901-01-01.0.9x1.25_gx1v7_simyr1850_c190718.nc +>lnd/clm2/initdata_map/clmi.I1850Clm45BgcGs.0901-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc lnd/clm2/initdata_map/clmi.B1850.0161-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc +>lnd/clm2/initdata_map/clmi.B1850Clm45BgcGs.0161-01-01.0.9x1.25_gx1v7_simyr1850_c200729.nc @@ -789,8 +789,8 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.B1850.0161-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc + lnd_tuning_mode="clm5_0_cam6.0" +>lnd/clm2/initdata_map/clmi.B1850Clm50BgcCrop.0161-01-01.0.9x1.25_gx1v7_simyr1850_c200729.nc lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c200728.nc @@ -895,7 +895,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c200728.nc From 2a40a564f0898ea8ad108a04e9636c844223aca1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 31 Jul 2020 01:03:18 -0600 Subject: [PATCH 506/556] Remove 2010 finidat settings, move it to inside of 2010_control just for f19 and clm5_0_cam6.0, use st_year for date for finidat file only if a transient simulation --- bld/CLMBuildNamelist.pm | 6 +-- bld/namelist_files/namelist_defaults_ctsm.xml | 50 ------------------- bld/namelist_files/use_cases/2010_control.xml | 5 ++ .../clm45cam6LndTuningMode/include_user_mods | 1 + .../clm/clm45cam6LndTuningMode/shell_commands | 4 ++ 5 files changed, 12 insertions(+), 54 deletions(-) create mode 100644 cime_config/testdefs/testmods_dirs/clm/clm45cam6LndTuningMode/include_user_mods create mode 100644 cime_config/testdefs/testmods_dirs/clm/clm45cam6LndTuningMode/shell_commands diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 9dba13935f..5c894aa2a9 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2297,10 +2297,8 @@ SIMYR: foreach my $sim_yr ( @sim_years ) { my $how_close = undef; if ( $nl_flags->{'sim_year'} eq "PtVg" ) { $how_close = abs(1850 - $sim_yr); - # EBK 07/20/2020 -- This makes sure the sim_year matched is based on the sim-year - # rather than the start year. - #} elsif ( $nl_flags->{'flanduse_timeseries'} eq "null" ) { - # $how_close = abs($nl_flags->{'sim_year'} - $sim_yr); + } elsif ( $nl_flags->{'flanduse_timeseries'} eq "null" ) { + $how_close = abs($nl_flags->{'sim_year'} - $sim_yr); } else { $how_close = abs($st_year - $sim_yr); } diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 0ef8395f58..78bd431c59 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -530,18 +530,8 @@ attributes from the config_cache.xml file (with keys converted to upper-case). maxpft="17" use_cn=".false." use_crop=".false." hgrid="ne0np4.ARCTICGRIS.ne30x8">.true. .true. -.true. -.true. -.true. -.true. .true. -.true. .true. @@ -698,36 +688,11 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 - - -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 - - -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 - - - -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 - hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 - - -lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c200728.nc - - -lnd/clm2/initdata_map/clmi.BHIST.2010-01-01.0.9x1.25_gx1v7_simyr2010_c181015.nc - - - .false. .false. +lnd/clm2/initdata_map/clmi.BHIST.2010-01-01.0.9x1.25_gx1v7_simyr2010_c181015.nc + +.true. + 2010 2010 diff --git a/cime_config/testdefs/testmods_dirs/clm/clm45cam6LndTuningMode/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/clm45cam6LndTuningMode/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/clm45cam6LndTuningMode/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/cime_config/testdefs/testmods_dirs/clm/clm45cam6LndTuningMode/shell_commands b/cime_config/testdefs/testmods_dirs/clm/clm45cam6LndTuningMode/shell_commands new file mode 100644 index 0000000000..bc72045eeb --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/clm45cam6LndTuningMode/shell_commands @@ -0,0 +1,4 @@ +#!/bin/bash + +./xmlchange LND_TUNING_MODE="clm4_5_cam6.0" + From 7aaad708108760e96461c4d0cb2b1273497b8f9d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 31 Jul 2020 14:50:57 -0600 Subject: [PATCH 507/556] Change so st_year is used in place of sim_year for transient case for finidat file selection and that hgrid is used in settings for it as well as for use_init_interp, also fix number of tests --- bld/CLMBuildNamelist.pm | 6 +++--- bld/unit_testers/build-namelist_test.pl | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 5c894aa2a9..7297ffa448 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2245,11 +2245,11 @@ sub setup_logic_initial_conditions { $settings{'sim_year'} = $nl_flags->{'sim_year'}; $opts->{'ignore_ic_year'} = 1; } else { - delete( $settings{'sim_year'} ); + $settings{'sim_year'} = $st_year; } foreach my $item ( "mask", "maxpft", "irrigate", "glc_nec", "use_crop", "use_cn", "use_cndv", "use_nitrif_denitrif", "use_vertsoilc", "use_century_decomp", "use_fates", - "lnd_tuning_mode" + "lnd_tuning_mode", "hgrid", ) { $settings{$item} = $nl_flags->{$item}; } @@ -2320,7 +2320,7 @@ SIMYR: foreach my $sim_yr ( @sim_years ) { } # SIMYR: $settings{'sim_year'} = $closest_sim_year; add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $useinitvar, - 'use_cndv'=>$nl_flags->{'use_cndv'}, 'phys'=>$physv->as_string(), + 'use_cndv'=>$nl_flags->{'use_cndv'}, 'phys'=>$physv->as_string(), 'hgrid'=>$nl_flags->{'res'}, 'sim_year'=>$settings{'sim_year'}, 'nofail'=>1, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, 'use_fates'=>$nl_flags->{'use_fates'} ); $settings{$useinitvar} = $nl->get_value($useinitvar); diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index b1e306aab4..bde36e8c58 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,9 +138,9 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 897; +my $ntests = 889; if ( defined($opts{'compare'}) ) { - $ntests += 552; + $ntests += 546; } plan( tests=>$ntests ); From 7364ad035c63b3594f9b945a22a80fffeb4c7244 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 31 Jul 2020 15:28:13 -0600 Subject: [PATCH 508/556] Get rid of 2010 finidat file settings --- bld/namelist_files/namelist_defaults_ctsm.xml | 21 ++----------------- 1 file changed, 2 insertions(+), 19 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 78bd431c59..5bea3819a3 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -504,7 +504,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 61 -1850,1979,2000,2010,2013 +1850,1979,2000,2013 .true. @@ -686,13 +684,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). >hgrid=ne0np4.ARCTICGRIS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 - - -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 - - lnd/clm2/initdata_map/clmi.F2000.2000-01-01.ne120pg3_mt13_simyr2000_c200728.nc - + lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c200728.nc - -lnd/clm2/initdata_map/clmi.BHIST.2010-01-01.0.9x1.25_gx1v7_simyr2010_c181015.nc - - Date: Fri, 31 Jul 2020 16:16:24 -0600 Subject: [PATCH 509/556] This part was an error, because hgrid was already set and hgrid is set to the value of res, hence this overwrote the correct value with the wrong one --- bld/CLMBuildNamelist.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 7297ffa448..054db5e8f4 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2249,7 +2249,7 @@ sub setup_logic_initial_conditions { } foreach my $item ( "mask", "maxpft", "irrigate", "glc_nec", "use_crop", "use_cn", "use_cndv", "use_nitrif_denitrif", "use_vertsoilc", "use_century_decomp", "use_fates", - "lnd_tuning_mode", "hgrid", + "lnd_tuning_mode", ) { $settings{$item} = $nl_flags->{$item}; } From 91a6745b7dcec06ca7fc10dda491c33cac6ec94f Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 4 Aug 2020 08:40:17 -0600 Subject: [PATCH 510/556] mod for pio2 functionality --- src/main/ncdio_pio.F90.in | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/main/ncdio_pio.F90.in b/src/main/ncdio_pio.F90.in index ff7320bc70..3c41be9ac1 100644 --- a/src/main/ncdio_pio.F90.in +++ b/src/main/ncdio_pio.F90.in @@ -1541,11 +1541,11 @@ contains call ncd_inqvid (ncid, varname, varid, vardesc) #if ({DIMS}==0) + start(1) = 1 ; count(1) = len(data) if (present(nt)) then do m = 1,len(data) tmpString(m:m) = data(m:m) end do - start(1) = 1 ; count(1) = len(data) start(2) = nt; count(2) = 1 if ( count(1) > size(tmpString) )then call shr_sys_abort( subname//' ERROR: input string size is too large:'//& @@ -1556,23 +1556,23 @@ contains status = pio_put_var(ncid, varid, data ) end if #elif ({DIMS}==1) + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data) if (present(nt)) then - start(1) = 1 ; count(1) = len(data) - start(2) = 1 ; count(2) = size(data) start(3) = nt; count(3) = 1 status = pio_put_var(ncid, varid, start, count, data) else - status = pio_put_var(ncid, varid, data) + status = pio_put_var(ncid, varid, start, count, data) end if #elif ({DIMS}==2) + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data,dim=1) + start(3) = 1 ; count(3) = size(data,dim=2) if (present(nt)) then - start(1) = 1 ; count(1) = len(data) - start(2) = 1 ; count(2) = size(data,dim=1) - start(3) = 1 ; count(3) = size(data,dim=2) start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start, count, data) else - status = pio_put_var(ncid, varid, data) + status = pio_put_var(ncid, varid, start, count, data) end if #endif From 22c0009e7612a26bdac7dbf7131e0c4d130c9f5d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 4 Aug 2020 09:36:46 -0600 Subject: [PATCH 511/556] update for compatibility with cime master --- .config_files.xml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/.config_files.xml b/.config_files.xml index 8e4868b94f..5c88ec4051 100644 --- a/.config_files.xml +++ b/.config_files.xml @@ -18,9 +18,10 @@ unset $SRCROOT - $CIMEROOT/src/components/data_comps/dlnd - $CIMEROOT/src/components/stub_comps/slnd - $CIMEROOT/src/components/xcpl_comps/xlnd + $CIMEROOT/src/components/data_comps_mct/dlnd + $CIMEROOT/src/components/cdeps/dlnd + $CIMEROOT/src/components/stub_comps_$COMP_INTERFACE/slnd + $CIMEROOT/src/components/xcpl_comps_$COMP_INTERFACE/xlnd case_comps env_case.xml From d4ec38d30d6b832e1a33978ca4cf0e968b180b10 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 4 Aug 2020 16:18:34 -0600 Subject: [PATCH 512/556] missed a change --- src/main/ncdio_pio.F90.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/ncdio_pio.F90.in b/src/main/ncdio_pio.F90.in index 3c41be9ac1..c53e760364 100644 --- a/src/main/ncdio_pio.F90.in +++ b/src/main/ncdio_pio.F90.in @@ -1553,7 +1553,7 @@ contains end if status = pio_put_var(ncid, varid, start, count, ival=tmpString(1:count(1))) else - status = pio_put_var(ncid, varid, data ) + status = pio_put_var(ncid, varid, start, count, data ) end if #elif ({DIMS}==1) start(1) = 1 ; count(1) = len(data) From 68e360a69378adb84478cdeb748ba66577ff97d0 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 4 Aug 2020 23:18:07 -0600 Subject: [PATCH 513/556] Go back to ctsm1.0.dev105 version of namelist_defaults_ctsm using the previous finidat files, since using updated files changes answers for some cases when it gets interpolated another time --- bld/namelist_files/namelist_defaults_ctsm.xml | 163 +++++++++++------- 1 file changed, 101 insertions(+), 62 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 5bea3819a3..ec8d3ffe5d 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -22,6 +22,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 379.0 336.6 +340.6 379.0 388.8 397.5 @@ -504,7 +505,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 61 -1850,1979,2000,2013 +1850,1982,2000,2010,2013 .true. - -.true. -.true. - +.true. -.true. .true. +.true. +.true. +.true. +.true. +.true. +.true. .true. @@ -664,26 +673,48 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -hgrid=0.9x1.25 maxpft=17 mask=gx1v7 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 - - -hgrid=1.9x2.5 maxpft=17 mask=gx1v7 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 - - -hgrid=ne0np4.ARCTIC.ne30x4 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 -hgrid=ne0np4.ARCTICGRIS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + +hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 + + lnd/clm2/initdata_map/clmi.I1850Clm45BgcGs.0901-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc +>lnd/clm2/initdata_map/clmi.I1850Clm45BgcGs.0901-01-01.0.9x1.25_gx1v7_simyr1850_c190718.nc lnd/clm2/initdata_map/clmi.I1850Clm45BgcCruGs.1101-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc +>lnd/clm2/initdata_map/clmi.I1850Clm45BgcCruGs.1101-01-01.0.9x1.25_gx1v7_simyr1850_c190718.nc lnd/clm2/initdata_map/clmi.B1850Clm45BgcGs.0161-01-01.0.9x1.25_gx1v7_simyr1850_c200729.nc +>lnd/clm2/initdata_map/clmi.B1850.0161-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc lnd/clm2/initdata_map/clmi.I1850Clm50Sp.0181-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc + lnd_tuning_mode="clm5_0_GSWP3v1" use_init_interp=".true." +>lnd/clm2/initdata_map/clmi.I1850Clm50Sp.0181-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc @@ -737,23 +768,23 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.I1850Clm50BgcCropCru-ciso.1526-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc + lnd_tuning_mode="clm5_0_CRUv7" use_init_interp=".true." +>lnd/clm2/initdata_map/clmi.I1850Clm50BgcCropCru-ciso.1526-01-01.0.9x1.25_gx1v7_simyr1850_c190116.nc lnd/clm2/initdata_map/clmi.B1850Clm50BgcCrop.0161-01-01.0.9x1.25_gx1v7_simyr1850_c200729.nc + lnd_tuning_mode="clm5_0_cam6.0" use_init_interp=".true." +>lnd/clm2/initdata_map/clmi.B1850.0161-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc lnd/clm2/initdata_map/clmi.I1850Clm50SpCru.1706-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc + lnd_tuning_mode="clm5_0_CRUv7" use_init_interp=".true." +>lnd/clm2/initdata_map/clmi.I1850Clm50SpCru.1706-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc @@ -794,59 +825,67 @@ attributes from the config_cache.xml file (with keys converted to upper-case). >lnd/clm2/initdata_map/clmi.I2000Clm50BgcCrop.2011-01-01.1.9x2.5_gx1v7_gl4_simyr2000_c190312.nc - -lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr1979_c200729.nc - - -lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.1.9x2.5_gx1v7_simyr1979_c200729.nc - - lnd/clm2/initdata_map/clmi.FHISTSp.1979-01-01.ARCTIC_ne30x4_mt12_simyr1979_c200728.nc + lnd_tuning_mode="clm5_0_cam6.0" use_init_interp=".true." +>lnd/clm2/initdata_map/clmi.FHISTSp.1982-01-01.ARCTIC_ne30x4_mt12_simyr1982_c200425.nc lnd/clm2/initdata_map/clmi.FHISTSp.1979-01-01.ARCTICGRIS_ne30x8_mt12_simyr1979_c200728.nc + lnd_tuning_mode="clm5_0_cam6.0" use_init_interp=".true." +>lnd/clm2/initdata_map/clmi.FHISTSp.1982-01-01.ARCTICGRIS_ne30x8_mt12_simyr1982_c200428.nc lnd/clm2/initdata_map/clmi.F2000.2000-01-01.ne120pg3_mt13_simyr2000_c200728.nc + lnd_tuning_mode="clm5_0_cam6.0" use_init_interp=".true." +>lnd/clm2/initdata_map/clmi.F2000.2000-01-01.ne120pg3_mt13_simyr2000_c200506.nc - + lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c181015.nc + + +lnd/clm2/initdata_map/clmi.BHIST.2010-01-01.0.9x1.25_gx1v7_simyr2010_c181015.nc + + + +lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c200728.nc +>lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c181015.nc + + + +lnd/clm2/initdata_map/clmi.BHIST.2010-01-01.0.9x1.25_gx1v7_simyr2010_c181015.nc lnd/clm2/initdata_map/clmi.FHISTSp.2013-01-01.ne0CONUSne30x8_mt12_simyr2013_c200728.nc +>lnd/clm2/initdata_map/clmi.FHISTSp.2013-01-01.ne0CONUSne30x8_mt12_simyr2013_c200705.nc From f438a48d3a05747375794fdafec541dea732280a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 5 Aug 2020 10:42:05 -0600 Subject: [PATCH 514/556] fix interface issue --- src/main/ncdio_pio.F90.in | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/main/ncdio_pio.F90.in b/src/main/ncdio_pio.F90.in index c53e760364..5f0fbb6ea1 100644 --- a/src/main/ncdio_pio.F90.in +++ b/src/main/ncdio_pio.F90.in @@ -1542,19 +1542,17 @@ contains #if ({DIMS}==0) start(1) = 1 ; count(1) = len(data) + do m = 1,len(data) + tmpString(m:m) = data(m:m) + end do if (present(nt)) then - do m = 1,len(data) - tmpString(m:m) = data(m:m) - end do start(2) = nt; count(2) = 1 if ( count(1) > size(tmpString) )then call shr_sys_abort( subname//' ERROR: input string size is too large:'//& errMsg(sourcefile, __LINE__)) end if - status = pio_put_var(ncid, varid, start, count, ival=tmpString(1:count(1))) - else - status = pio_put_var(ncid, varid, start, count, data ) end if + status = pio_put_var(ncid, varid, start, count, ival=tmpString(1:count(1))) #elif ({DIMS}==1) start(1) = 1 ; count(1) = len(data) start(2) = 1 ; count(2) = size(data) From ccba4b214274ca744467bbe09bc800b98f8957db Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 5 Aug 2020 13:06:46 -0600 Subject: [PATCH 515/556] Increase walltime for a couple tests fixing #1096 --- cime_config/testdefs/testlist_clm.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 413cdc4216..ee8abf53e3 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1171,7 +1171,7 @@ - + @@ -1189,7 +1189,7 @@ - + @@ -1198,7 +1198,7 @@ - + From 7ea80e15bd8a72da7d6a1aa068d24752c2391706 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 5 Aug 2020 17:02:06 -0600 Subject: [PATCH 516/556] add fill value settings --- src/main/histFileMod.F90 | 269 +++++++++++++++++++-------------------- 1 file changed, 134 insertions(+), 135 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 7405e6166b..a0dd4eeb9b 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -13,14 +13,14 @@ module histFileMod use spmdMod , only : masterproc use abortutils , only : endrun use clm_varctl , only : iulog, use_vertsoilc, use_fates - use clm_varcon , only : spval, ispval, dzsoi_decomp + use clm_varcon , only : spval, ispval, dzsoi_decomp use clm_varcon , only : grlnd, nameg, namel, namec, namep, nameCohort use decompMod , only : get_proc_bounds, get_proc_global, bounds_type use GetGlobalValuesMod , only : GetGlobalIndexArray - use GridcellType , only : grc - use LandunitType , only : lun - use ColumnType , only : col - use PatchType , only : patch + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch use EDTypesMod , only : nclmax use EDTypesMod , only : nlevleaf use FatesInterfaceMod , only : nlevsclass, nlevage @@ -29,7 +29,7 @@ module histFileMod use FatesLitterMod , only : ncwd use EDTypesMod , only : num_elements_fates => num_elements use FatesInterfaceMod , only : maxveg_fates => numpft - use ncdio_pio + use ncdio_pio ! implicit none @@ -163,7 +163,7 @@ module histFileMod private :: hfields_write ! Write a variable to a history tape private :: hfields_1dinfo ! Define/output 1d subgrid info if appropriate private :: hist_update_hbuf_field_1d ! Updates history buffer for specific field and tape - private :: hist_update_hbuf_field_2d ! Updates history buffer for specific field and tape + private :: hist_update_hbuf_field_2d ! Updates history buffer for specific field and tape private :: hist_set_snow_field_2d ! Set values in history field dimensioned by levsno private :: list_index ! Find index of field in exclude list private :: set_hist_filename ! Determine history dataset filenames @@ -202,7 +202,7 @@ module histFileMod ! for 2D arrays, where the second dimension is allowed ! to be 1 integer :: num2d ! size of hbuf second dimension (e.g. number of vertical levels) - integer :: hpindex ! history pointer index + integer :: hpindex ! history pointer index character(len=scale_type_strlen) :: p2c_scale_type ! scale factor when averaging patch to column character(len=scale_type_strlen) :: c2l_scale_type ! scale factor when averaging column to landunit character(len=scale_type_strlen) :: l2g_scale_type ! scale factor when averaging landunit to gridcell @@ -359,7 +359,7 @@ subroutine masterlist_addfld (fname, numdims, type1d, type1d_out, & integer :: numl ! total number of landunits across all processors integer :: numc ! total number of columns across all processors integer :: nump ! total number of pfts across all processors - type(bounds_type) :: bounds + type(bounds_type) :: bounds character(len=*),parameter :: subname = 'masterlist_addfld' !------------------------------------------------------------------------ @@ -681,7 +681,7 @@ subroutine htapes_fieldlist() fexcl(:,8) = hist_fexcl8(:) fexcl(:,9) = hist_fexcl9(:) fexcl(:,10) = hist_fexcl10(:) - + ! First ensure contents of fincl and fexcl are valid names @@ -861,7 +861,7 @@ end subroutine htapes_fieldlist logical function is_mapping_upto_subgrid( type1d, type1d_out ) result ( mapping) ! ! !DESCRIPTION: - ! + ! ! Return true if this field will be mapped into a higher subgrid level ! If false it will be output on it's native grid ! @@ -917,7 +917,7 @@ subroutine htape_addfld (t, f, avgflag) integer :: beg1d_out,end1d_out ! history output per-proc 1d beginning and ending indices integer :: beg1d,end1d ! beginning and ending indices for this field (assume already set) integer :: num1d_out ! history output 1d size - type(bounds_type) :: bounds + type(bounds_type) :: bounds character(len=*),parameter :: subname = 'htape_addfld' !----------------------------------------------------------------------- @@ -1020,7 +1020,7 @@ subroutine htape_addfld (t, f, avgflag) ! Fields native bounds beg1d = masterlist(f)%field%beg1d end1d = masterlist(f)%field%end1d - + ! Alloccate and initialize history buffer and related info num2d = tape(t)%hlist(n)%field%num2d @@ -1058,7 +1058,7 @@ subroutine hist_update_hbuf(bounds) ! into its history buffer for appropriate tapes. ! ! !ARGUMENTS: - type(bounds_type), intent(in) :: bounds + type(bounds_type), intent(in) :: bounds ! ! !LOCAL VARIABLES: integer :: t ! tape index @@ -1073,8 +1073,8 @@ subroutine hist_update_hbuf(bounds) !$OMP PARALLEL DO PRIVATE (f, num2d, numdims) do f = 1,tape(t)%nflds numdims = tape(t)%hlist(f)%field%numdims - - if ( numdims == 1) then + + if ( numdims == 1) then call hist_update_hbuf_field_1d (t, f, bounds) else num2d = tape(t)%hlist(f)%field%num2d @@ -1103,7 +1103,7 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) ! !ARGUMENTS: integer, intent(in) :: t ! tape index integer, intent(in) :: f ! field index - type(bounds_type), intent(in) :: bounds + type(bounds_type), intent(in) :: bounds ! ! !LOCAL VARIABLES: integer :: hpindex ! history pointer index @@ -1317,7 +1317,7 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) if ( end1d .eq. ubound(field,1) ) then k_offset = 0 else - k_offset = 1 - beg1d + k_offset = 1 - beg1d endif do k = beg1d,end1d valid = .true. @@ -1397,7 +1397,7 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) ! !ARGUMENTS: integer, intent(in) :: t ! tape index integer, intent(in) :: f ! field index - type(bounds_type), intent(in) :: bounds + type(bounds_type), intent(in) :: bounds integer, intent(in) :: num2d ! size of second dimension ! ! !LOCAL VARIABLES: @@ -1420,7 +1420,7 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) integer , pointer :: nacs(:,:) ! accumulation counter real(r8), pointer :: field(:,:) ! clm 2d pointer field logical :: field_allocated! whether 'field' was allocated here - logical , pointer :: active(:) ! flag saying whether each point is active (used for type1d = landunit/column/pft) + logical , pointer :: active(:) ! flag saying whether each point is active (used for type1d = landunit/column/pft) !(this refers to a point being active, NOT a history field being active) real(r8), allocatable :: field_gcell(:,:) ! gridcell level field (used if mapping to gridcell is done) character(len=*),parameter :: subname = 'hist_update_hbuf_field_2d' @@ -1720,7 +1720,7 @@ end subroutine hist_update_hbuf_field_2d subroutine hist_set_snow_field_2d (field_out, field_in, no_snow_behavior, type1d, beg1d, end1d) ! ! !DESCRIPTION: - ! Set values in history field dimensioned by levsno. + ! Set values in history field dimensioned by levsno. ! ! This routine handles what to do when a given snow layer doesn't exist for a given ! point, based on the no_snow_behavior argument. Options are: @@ -1790,7 +1790,7 @@ subroutine hist_set_snow_field_2d (field_out, field_in, no_snow_behavior, type1d num_snow_layers = abs(snl(c)) num_nonexistent_layers = num_levels - num_snow_layers - + ! Fill output field appropriately for each layer ! When only a subset of snow layers exist, it is the LAST num_snow_layers that exist ! Levels are rearranged such that the top snow layer (surface layer) becomes level 1, etc. @@ -1801,7 +1801,7 @@ subroutine hist_set_snow_field_2d (field_out, field_in, no_snow_behavior, type1d do level = (num_levels-num_nonexistent_layers), 1, -1 field_out(point, level) = field_in(point, level+num_nonexistent_layers) end do - + end do end associate @@ -1953,7 +1953,7 @@ subroutine htape_create (t, histrest) else lnfid => nfid(t) endif - + ! BUG(wjs, 2014-10-20, bugz 1730) Workaround for ! http://bugs.cgd.ucar.edu/show_bug.cgi?id=1730 ! - 1-d hist files have problems with pnetcdf. A better workaround in terms of @@ -2066,7 +2066,7 @@ subroutine htape_create (t, histrest) call ncd_defdim(lnfid, 'string_length', hist_dim_name_length, strlen_dimid) call ncd_defdim(lnfid, 'scale_type_string_length', scale_type_strlen, dimid) call ncd_defdim( lnfid, 'levdcmp', nlevdecomp_full, dimid) - + if(use_fates)then call ncd_defdim(lnfid, 'fates_levscag', nlevsclass * nlevage, dimid) call ncd_defdim(lnfid, 'fates_levscagpf', nlevsclass * nlevage * maxveg_fates, dimid) @@ -2124,7 +2124,7 @@ subroutine htape_add_ltype_metadata(lnfid) character(len=*), parameter :: subname = 'htape_add_ltype_metadata' !----------------------------------------------------------------------- - + do ltype = 1, max_lunit attname = att_prefix // landunit_names(ltype) call ncd_putatt(lnfid, ncd_global, attname, ltype) @@ -2175,7 +2175,7 @@ subroutine htape_add_natpft_metadata(lnfid) character(len=*), parameter :: subname = 'htape_add_natpft_metadata' !----------------------------------------------------------------------- - + do ptype = natpft_lb, natpft_ub ptype_1_indexing = ptype + (1 - natpft_lb) attname = att_prefix // pftname(ptype) @@ -2205,7 +2205,7 @@ subroutine htape_add_cft_metadata(lnfid) character(len=*), parameter :: subname = 'htape_add_cft_metadata' !----------------------------------------------------------------------- - + do ptype = cft_lb, cft_ub ptype_1_indexing = ptype + (1 - cft_lb) attname = att_prefix // pftname(ptype) @@ -2233,11 +2233,11 @@ subroutine htape_timeconst3D(t, & ! ! !ARGUMENTS: integer , intent(in) :: t ! tape index - type(bounds_type) , intent(in) :: bounds - real(r8) , intent(in) :: watsat_col( bounds%begc:,1: ) - real(r8) , intent(in) :: sucsat_col( bounds%begc:,1: ) - real(r8) , intent(in) :: bsw_col( bounds%begc:,1: ) - real(r8) , intent(in) :: hksat_col( bounds%begc:,1: ) + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: watsat_col( bounds%begc:,1: ) + real(r8) , intent(in) :: sucsat_col( bounds%begc:,1: ) + real(r8) , intent(in) :: bsw_col( bounds%begc:,1: ) + real(r8) , intent(in) :: hksat_col( bounds%begc:,1: ) character(len=*) , intent(in) :: mode ! 'define' or 'write' ! ! !LOCAL VARIABLES: @@ -2453,7 +2453,7 @@ subroutine htape_timeconst3D(t, & l = col%landunit(c) if (lun%lakpoi(l)) then ! Field indices MUST match varnamesl array order above! - if (ifld ==1) histil(c,lev) = col%z_lake(c,lev) + if (ifld ==1) histil(c,lev) = col%z_lake(c,lev) if (ifld ==2) histil(c,lev) = col%dz_lake(c,lev) end if end do @@ -2579,9 +2579,9 @@ subroutine htape_timeconst(t, mode) long_name='coordinate lake levels', units='m', ncid=nfid(t)) call ncd_defvar(varname='levdcmp', xtype=tape(t)%ncprec, dim1name='levdcmp', & long_name='coordinate soil levels', units='m', ncid=nfid(t)) - + if(use_fates)then - + call ncd_defvar(varname='fates_levscls', xtype=tape(t)%ncprec, dim1name='fates_levscls', & long_name='FATES diameter size class lower bound', units='cm', ncid=nfid(t)) call ncd_defvar(varname='fates_scmap_levscag', xtype=ncd_int, dim1name='fates_levscag', & @@ -2684,7 +2684,7 @@ subroutine htape_timeconst(t, mode) dim1id(1) = time_dimid str = 'days since ' // basedate // " " // basesec call ncd_defvar(nfid(t), 'time', tape(t)%ncprec, 1, dim1id, varid, & - long_name='time',units=str) + long_name='time',units=str) cal = get_calendar() if ( trim(cal) == NO_LEAP_C )then caldesc = "noleap" @@ -2705,7 +2705,7 @@ subroutine htape_timeconst(t, mode) else sec_hist_nhtfrq = hist_nhtfrq(t) end if - + dtime = get_step_size() if (sec_hist_nhtfrq == 0) then !month time_period_freq = 'month_1' @@ -3075,7 +3075,7 @@ subroutine hfields_1dinfo(t, mode) integer , pointer :: ilarr(:) ! temporary integer , pointer :: iparr(:) ! temporary type(file_desc_t), pointer :: ncid ! netcdf file - type(bounds_type) :: bounds + type(bounds_type) :: bounds character(len=*),parameter :: subname = 'hfields_1dinfo' !----------------------------------------------------------------------- @@ -3088,124 +3088,124 @@ subroutine hfields_1dinfo(t, mode) ! Define gridcell info call ncd_defvar(varname='grid1d_lon', xtype=ncd_double, dim1name=nameg, & - long_name='gridcell longitude', units='degrees_east', ncid=ncid) + long_name='gridcell longitude', units='degrees_east', fill_value=spval, ncid=ncid) call ncd_defvar(varname='grid1d_lat', xtype=ncd_double, dim1name=nameg, & - long_name='gridcell latitude', units='degrees_north', ncid=ncid) + long_name='gridcell latitude', units='degrees_north', fill_value=spval, ncid=ncid) call ncd_defvar(varname='grid1d_ixy', xtype=ncd_int, dim1name=nameg, & - long_name='2d longitude index of corresponding gridcell', ncid=ncid) + long_name='2d longitude index of corresponding gridcell', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='grid1d_jxy', xtype=ncd_int, dim1name=nameg, & - long_name='2d latitude index of corresponding gridcell', ncid=ncid) + long_name='2d latitude index of corresponding gridcell', ifill_value=ispval, ncid=ncid) ! Define landunit info call ncd_defvar(varname='land1d_lon', xtype=ncd_double, dim1name=namel, & - long_name='landunit longitude', units='degrees_east', ncid=ncid) + long_name='landunit longitude', units='degrees_east', fill_value=spval, ncid=ncid) call ncd_defvar(varname='land1d_lat', xtype=ncd_double, dim1name=namel, & - long_name='landunit latitude', units='degrees_north', ncid=ncid) + long_name='landunit latitude', units='degrees_north', fill_value=spval, ncid=ncid) call ncd_defvar(varname='land1d_ixy', xtype=ncd_int, dim1name=namel, & - long_name='2d longitude index of corresponding landunit', ncid=ncid) + long_name='2d longitude index of corresponding landunit', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='land1d_jxy', xtype=ncd_int, dim1name=namel, & - long_name='2d latitude index of corresponding landunit', ncid=ncid) + long_name='2d latitude index of corresponding landunit', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='land1d_gi', xtype=ncd_int, dim1name=namel, & - long_name='1d grid index of corresponding landunit', ncid=ncid) + long_name='1d grid index of corresponding landunit', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='land1d_wtgcell', xtype=ncd_double, dim1name=namel, & - long_name='landunit weight relative to corresponding gridcell', ncid=ncid) + long_name='landunit weight relative to corresponding gridcell', fill_value=spval, ncid=ncid) call ncd_defvar(varname='land1d_ityplunit', xtype=ncd_int, dim1name=namel, & long_name='landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', & - ncid=ncid) + ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='land1d_active', xtype=ncd_log, dim1name=namel, & - long_name='true => do computations on this landunit', ncid=ncid) + long_name='true => do computations on this landunit', ifill_value=0, ncid=ncid) ! Define column info call ncd_defvar(varname='cols1d_lon', xtype=ncd_double, dim1name=namec, & - long_name='column longitude', units='degrees_east', ncid=ncid) + long_name='column longitude', units='degrees_east', fill_value=spval, ncid=ncid) call ncd_defvar(varname='cols1d_lat', xtype=ncd_double, dim1name=namec, & - long_name='column latitude', units='degrees_north', ncid=ncid) + long_name='column latitude', units='degrees_north', fill_value=spval, ncid=ncid) call ncd_defvar(varname='cols1d_ixy', xtype=ncd_int, dim1name=namec, & - long_name='2d longitude index of corresponding column', ncid=ncid) + long_name='2d longitude index of corresponding column', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='cols1d_jxy', xtype=ncd_int, dim1name=namec, & - long_name='2d latitude index of corresponding column', ncid=ncid) + long_name='2d latitude index of corresponding column', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='cols1d_gi', xtype=ncd_int, dim1name=namec, & - long_name='1d grid index of corresponding column', ncid=ncid) + long_name='1d grid index of corresponding column', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='cols1d_li', xtype=ncd_int, dim1name=namec, & - long_name='1d landunit index of corresponding column', ncid=ncid) + long_name='1d landunit index of corresponding column', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='cols1d_wtgcell', xtype=ncd_double, dim1name=namec, & - long_name='column weight relative to corresponding gridcell', ncid=ncid) + long_name='column weight relative to corresponding gridcell', fill_value=spval, ncid=ncid) call ncd_defvar(varname='cols1d_wtlunit', xtype=ncd_double, dim1name=namec, & - long_name='column weight relative to corresponding landunit', ncid=ncid) + long_name='column weight relative to corresponding landunit', fill_value=spval, ncid=ncid) call ncd_defvar(varname='cols1d_itype_col', xtype=ncd_int, dim1name=namec, & - long_name='column type (see global attributes)', ncid=ncid) + long_name='column type (see global attributes)', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='cols1d_itype_lunit', xtype=ncd_int, dim1name=namec, & long_name='column landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', & - ncid=ncid) + ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='cols1d_active', xtype=ncd_log, dim1name=namec, & - long_name='true => do computations on this column', ncid=ncid) + long_name='true => do computations on this column', ifill_value=0, ncid=ncid) ! Define patch info call ncd_defvar(varname='pfts1d_lon', xtype=ncd_double, dim1name=namep, & - long_name='pft longitude', units='degrees_east', ncid=ncid) + long_name='pft longitude', units='degrees_east', fill_value=spval, ncid=ncid) call ncd_defvar(varname='pfts1d_lat', xtype=ncd_double, dim1name=namep, & - long_name='pft latitude', units='degrees_north', ncid=ncid) + long_name='pft latitude', units='degrees_north', fill_value=spval, ncid=ncid) call ncd_defvar(varname='pfts1d_ixy', xtype=ncd_int, dim1name=namep, & - long_name='2d longitude index of corresponding pft', ncid=ncid) + long_name='2d longitude index of corresponding pft', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='pfts1d_jxy', xtype=ncd_int, dim1name=namep, & - long_name='2d latitude index of corresponding pft', ncid=ncid) + long_name='2d latitude index of corresponding pft', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='pfts1d_gi', xtype=ncd_int, dim1name=namep, & - long_name='1d grid index of corresponding pft', ncid=ncid) + long_name='1d grid index of corresponding pft', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='pfts1d_li', xtype=ncd_int, dim1name=namep, & - long_name='1d landunit index of corresponding pft', ncid=ncid) + long_name='1d landunit index of corresponding pft', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='pfts1d_ci', xtype=ncd_int, dim1name=namep, & - long_name='1d column index of corresponding pft', ncid=ncid) + long_name='1d column index of corresponding pft', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='pfts1d_wtgcell', xtype=ncd_double, dim1name=namep, & - long_name='pft weight relative to corresponding gridcell', ncid=ncid) + long_name='pft weight relative to corresponding gridcell', fill_value=spval, ncid=ncid) call ncd_defvar(varname='pfts1d_wtlunit', xtype=ncd_double, dim1name=namep, & - long_name='pft weight relative to corresponding landunit', ncid=ncid) + long_name='pft weight relative to corresponding landunit', fill_value=spval, ncid=ncid) call ncd_defvar(varname='pfts1d_wtcol', xtype=ncd_double, dim1name=namep, & - long_name='pft weight relative to corresponding column', ncid=ncid) + long_name='pft weight relative to corresponding column', fill_value=spval, ncid=ncid) call ncd_defvar(varname='pfts1d_itype_veg', xtype=ncd_int, dim1name=namep, & - long_name='pft vegetation type', ncid=ncid) + long_name='pft vegetation type', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='pfts1d_itype_col', xtype=ncd_int, dim1name=namep, & - long_name='pft column type (see global attributes)', ncid=ncid) + long_name='pft column type (see global attributes)', ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='pfts1d_itype_lunit', xtype=ncd_int, dim1name=namep, & long_name='pft landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', & - ncid=ncid) + ifill_value=ispval, ncid=ncid) call ncd_defvar(varname='pfts1d_active', xtype=ncd_log, dim1name=namep, & - long_name='true => do computations on this pft', ncid=ncid) + ifill_value=0, long_name='true => do computations on this pft', ncid=ncid) else if (mode == 'write') then @@ -3384,11 +3384,11 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! !ARGUMENTS: logical, intent(in) :: rstwr ! true => write restart file this step logical, intent(in) :: nlend ! true => end of run on this step - type(bounds_type) , intent(in) :: bounds - real(r8) , intent(in) :: watsat_col( bounds%begc:,1: ) - real(r8) , intent(in) :: sucsat_col( bounds%begc:,1: ) - real(r8) , intent(in) :: bsw_col( bounds%begc:,1: ) - real(r8) , intent(in) :: hksat_col( bounds%begc:,1: ) + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: watsat_col( bounds%begc:,1: ) + real(r8) , intent(in) :: sucsat_col( bounds%begc:,1: ) + real(r8) , intent(in) :: bsw_col( bounds%begc:,1: ) + real(r8) , intent(in) :: hksat_col( bounds%begc:,1: ) ! ! !LOCAL VARIABLES: integer :: t ! tape index @@ -3572,8 +3572,8 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & endif end do - ! Reset number of time samples to zero if file is full - + ! Reset number of time samples to zero if file is full + do t = 1, ntapes if (.not. history_tape_in_use(t)) then cycle @@ -3583,7 +3583,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & tape(t)%ntimes = 0 end if end do - + end subroutine hist_htapes_wrapup !----------------------------------------------------------------------- @@ -3605,7 +3605,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) use pio ! ! !ARGUMENTS: - type(bounds_type), intent(in) :: bounds + type(bounds_type), intent(in) :: bounds type(file_desc_t), intent(inout) :: ncid ! netcdf file character(len=*) , intent(in) :: flag !'read' or 'write' character(len=*) , intent(in), optional :: rdate ! restart file time stamp for name @@ -3735,7 +3735,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) ! max_nflds is the maximum number of fields on any tape - ! max_flds is the maximum number possible number of fields + ! max_flds is the maximum number possible number of fields max_nflds = max_nFields() @@ -3768,7 +3768,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) num2d = tape(t)%hlist(f)%field%num2d nacs => tape(t)%hlist(f)%nacs hbuf => tape(t)%hlist(f)%hbuf - + if (type1d_out == grlnd) then if (ldomain%isgrid2d) then dim1name = 'lon' ; dim2name = 'lat' @@ -3778,10 +3778,10 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) else dim1name = type1d_out ; dim2name = 'undefined' endif - + if (dim2name == 'undefined') then if (num2d == 1) then - call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & dim1name=dim1name, & long_name=trim(long_name), units=trim(units)) call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & @@ -3823,9 +3823,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_defdim( ncid_hist(t), 'avgflag_len' , avgflag_strlen, dimid) call ncd_defdim( ncid_hist(t), 'scalar' , 1 , dimid) call ncd_defdim( ncid_hist(t), 'max_chars' , max_chars , dimid) - call ncd_defdim( ncid_hist(t), 'max_nflds' , max_nflds , dimid) - call ncd_defdim( ncid_hist(t), 'max_flds' , max_flds , dimid) - + call ncd_defdim( ncid_hist(t), 'max_nflds' , max_nflds , dimid) + call ncd_defdim( ncid_hist(t), 'max_flds' , max_flds , dimid) + call ncd_defvar(ncid=ncid_hist(t), varname='nhtfrq', xtype=ncd_int, & long_name="Frequency of history writes", & comment="Namelist item", & @@ -3865,7 +3865,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_defvar(ncid=ncid_hist(t), varname='begtime', xtype=ncd_double, & long_name="Beginning time", units="time units", & dim1name='scalar') - + call ncd_defvar(ncid=ncid_hist(t), varname='num2d', xtype=ncd_int, & long_name="Size of second dimension", units="unitless", & dim1name='max_nflds' ) @@ -3907,7 +3907,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_enddef(ncid_hist(t)) - end do ! end of ntapes loop + end do ! end of ntapes loop RETURN @@ -3931,7 +3931,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_io('locfnh', my_locfnh, 'write', ncid, nt=t) call ncd_io('locfnhr', my_locfnhr, 'write', ncid, nt=t) end do - + fincl(:,1) = hist_fincl1(:) fincl(:,2) = hist_fincl2(:) fincl(:,3) = hist_fincl3(:) @@ -3980,7 +3980,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) itemp(:) = 0 do f=1,tape(t)%nflds itemp(f) = tape(t)%hlist(f)%field%num2d - end do + end do call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t), flag='write') itemp(:) = 0 @@ -4023,7 +4023,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_io('l2g_scale_type', l2g_scale_type, 'write', ncid_hist(t)) deallocate(tname,tlongname,tunits,tmpstr,tavgflag) deallocate(p2c_scale_type, c2l_scale_type, l2g_scale_type) - enddo + enddo deallocate(itemp) ! @@ -4077,7 +4077,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end if ! Determine necessary indices - the following is needed if model decomposition is different on restart - + start(1)=1 if ( is_restart() )then @@ -4092,7 +4092,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) if ( t == 1 )then call ncd_inqdlen(ncid_hist(1),dimid,max_nflds,name='max_nflds') - + allocate(itemp(max_nflds)) end if @@ -4275,7 +4275,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) hist_fexcl10(:) = fexcl(:,10) end if - + if ( allocated(itemp) ) deallocate(itemp) end if @@ -4286,8 +4286,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) ! so that subsequent time samples are added until the file is full. ! A new history file is used on a branch run. !====================================================================== - - if (flag == 'write') then + + if (flag == 'write') then do t = 1,ntapes if (.not. history_tape_in_use(t)) then @@ -4314,7 +4314,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) write(iulog,*) trim(subname),' ERROR: allocation' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + hbuf1d(beg1d_out:end1d_out) = hbuf(beg1d_out:end1d_out,1) nacs1d(beg1d_out:end1d_out) = nacs(beg1d_out:end1d_out,1) @@ -4338,9 +4338,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) call ncd_pio_closefile(ncid_hist(t)) - end do ! end of ntapes loop + end do ! end of ntapes loop - else if (flag == 'read') then + else if (flag == 'read') then ! Read history restart information if history files are not full @@ -4361,7 +4361,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end1d_out = tape(t)%hlist(f)%field%end1d_out nacs => tape(t)%hlist(f)%nacs hbuf => tape(t)%hlist(f)%hbuf - + if (num2d == 1) then allocate(hbuf1d(beg1d_out:end1d_out), & nacs1d(beg1d_out:end1d_out), stat=status) @@ -4369,15 +4369,15 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) write(iulog,*) trim(subname),' ERROR: allocation' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & dim1name=type1d_out, data=hbuf1d) call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & dim1name=type1d_out, data=nacs1d) - + hbuf(beg1d_out:end1d_out,1) = hbuf1d(beg1d_out:end1d_out) nacs(beg1d_out:end1d_out,1) = nacs1d(beg1d_out:end1d_out) - + deallocate(hbuf1d) deallocate(nacs1d) else @@ -4389,13 +4389,13 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) end do end if - + call ncd_pio_closefile(ncid_hist(t)) - + end do - + end if - + end subroutine hist_restart_ncd !----------------------------------------------------------------------- @@ -4417,7 +4417,7 @@ integer function max_nFields() end do return end function max_nFields - + !----------------------------------------------------------------------- character(len=max_namlen) function getname (inname) ! @@ -4614,7 +4614,7 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells - type(bounds_type):: bounds ! boudns + type(bounds_type):: bounds ! boudns character(len=16):: l_default ! local version of 'default' character(len=*),parameter :: subname = 'hist_addfld1d' !------------------------------------------------------------------------ @@ -4768,10 +4768,10 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & ! Add field to masterlist - call masterlist_addfld (fname=trim(fname), numdims=1, type1d=l_type1d, & + call masterlist_addfld (fname=trim(fname), numdims=1, type1d=l_type1d, & type1d_out=l_type1d_out, type2d='unset', num2d=1, & units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, & - p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, & + p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, & l2g_scale_type=scale_type_l2g) l_default = 'active' @@ -4841,13 +4841,13 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells - type(bounds_type):: bounds + type(bounds_type):: bounds character(len=16):: l_default ! local version of 'default' character(len=*),parameter :: subname = 'hist_addfld2d' !------------------------------------------------------------------------ call get_proc_bounds(bounds) - + ! Error-check no_snow_behavior optional argument: It should be present if and only if ! type2d is 'levsno', and its value should be one of the public no_snow_* parameters ! defined above. @@ -4940,7 +4940,7 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, case ('levsno') num2d = nlevsno case ('nlevcan') - num2d = nlevcan + num2d = nlevcan case ('nvegwcs') num2d = nvegwcs case default @@ -5084,12 +5084,12 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, ! Add field to masterlist - call masterlist_addfld (fname=trim(fname), numdims=2, type1d=l_type1d, & + call masterlist_addfld (fname=trim(fname), numdims=2, type1d=l_type1d, & type1d_out=l_type1d_out, type2d=type2d, num2d=num2d, & units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, & - p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, & + p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, & l2g_scale_type=scale_type_l2g, no_snow_behavior=no_snow_behavior) - + l_default = 'active' if (present(default)) then l_default = default @@ -5241,12 +5241,12 @@ end subroutine hist_add_subscript subroutine strip_null(str) character(len=*), intent(inout) :: str - integer :: i + integer :: i do i=1,len(str) if(ichar(str(i:i))==0) str(i:i)=' ' end do end subroutine strip_null - + !------------------------------------------------------------------------ subroutine hist_do_disp (ntapes, hist_ntimes, hist_mfilt, if_stop, if_disphist, rstwr, nlend) ! @@ -5263,7 +5263,7 @@ subroutine hist_do_disp (ntapes, hist_ntimes, hist_mfilt, if_stop, if_disphist, logical, intent(out) :: if_stop !true => last time step of run logical, intent(out) :: if_disphist(ntapes) !true => save and dispose history file logical, intent(in) :: rstwr - logical, intent(in) :: nlend + logical, intent(in) :: nlend ! ! !LOCAL VARIABLES: integer :: t ! history tape index @@ -5273,26 +5273,26 @@ subroutine hist_do_disp (ntapes, hist_ntimes, hist_mfilt, if_stop, if_disphist, rest_now = .false. stop_now = .false. - + if (nlend) stop_now = .true. if (rstwr) rest_now = .true. - + if_stop = stop_now - + if (stop_now) then ! End of run - dispose all history files - + if_disphist(1:ntapes) = .true. - + else if (rest_now) then ! Restart - dispose all history files - + do t = 1,ntapes if_disphist(t) = .true. end do else ! Dispose - + if_disphist(1:ntapes) = .false. do t = 1,ntapes if (hist_ntimes(t) == hist_mfilt(t)) then @@ -5300,7 +5300,7 @@ subroutine hist_do_disp (ntapes, hist_ntimes, hist_mfilt, if_stop, if_disphist, endif end do endif - + end subroutine hist_do_disp !----------------------------------------------------------------------- @@ -5340,4 +5340,3 @@ end function avgflag_valid end module histFileMod - From 925cf20cd168754ee4e2c17ce5485c44e5dc35c5 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 6 Aug 2020 14:21:35 -0600 Subject: [PATCH 517/556] Update RTM and MOSART, and give more wallclock to the ARCTICGRIS test --- Externals.cfg | 4 ++-- cime_config/testdefs/testlist_clm.xml | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index cbca877fd5..c5e31d48f4 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -16,14 +16,14 @@ required = True local_path = components/rtm protocol = git repo_url = https://github.com/ESCOMP/RTM -tag = rtm1_0_71 +tag = rtm1_0_72 required = True [mosart] local_path = components/mosart protocol = git repo_url = https://github.com/ESCOMP/MOSART -tag = mosart1_0_36 +tag = mosart1_0_37 required = True [cime] diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index ee8abf53e3..8afd0086e5 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1162,7 +1162,7 @@ - + From 3707d957eb5c29ccd5f8099a52fee6dc9e7ea6a2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 6 Aug 2020 14:46:00 -0600 Subject: [PATCH 518/556] Update ChangeLog files --- doc/ChangeLog | 107 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 108 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 8c46437257..8225123657 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,111 @@ =============================================================== +Tag name: ctsm1.0.dev106 +Originator(s): erik (Erik Kluzek) +Date: Thu Aug 6 14:29:10 MDT 2020 +One-line Summary: Bit-for-bit updates for the CESM2.2.0 release + +Purpose of changes +------------------ + +Fix some bit-for-bit things needed for the CESM2.2.0 release +Bring changes needed from release-clm5.0.31-34 to trunk. ndep change. +Do some refactoring of Fire class so that it makes sense for FATES to use the base class. +Update RTM and MOSART with NUOPC changes and an update of a NetCDF-4 file to NetCDF-5 +needed for the cesm2.2.0 release. + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): + Fixes #1087 -- wrong finidat file + Fixes #1096 -- failing tests + Fixes #1036 -- ne30 case fails + Fixes #946 --- better error message + Fixes #983 --- Fire method renames + Fixes #938 --- mscripgrid issue + +Known bugs found since the previous tag (include github issue ID): + #1098 -- ARCTICGRIS PE-layout is very slow... + #1097 -- xsmrpool_loss should only be written to the restart file if use_crop is true + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? No +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + +Changes made to namelist defaults (e.g., changed parameter values): + +Changes to the datasets (e.g., parameter, surface or initial files): + +Substantial timing or memory changes: None + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + +Changes to tests or testing: + +Code reviewed by: self + + +CTSM testing: regular + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - PASS + + python testing (see instructions in python/README.md; document testing done): + + cheyenne -= PASS + + regular tests (aux_clm): + + cheyenne ---- PASS + izumi ------- PASS + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: No (bit-for-bit) + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): rtm, mosart + RTM to rtm1_0_72 + MOSART to mosart1_0_37 + +Pull Requests that document the changes (include PR ids): #1079 +(https://github.com/ESCOMP/ctsm/pull) + #1079 -- Bit-for-bit updates for the CESM2.2.0 release + +=============================================================== +=============================================================== Tag name: ctsm1.0.dev105 Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) / Chris Fischer Date: Thu Jul 23 08:59:37 MDT 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index 48f8abbc81..d7fd19ea56 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm1.0.dev106 erik 08/06/2020 Bit-for-bit updates for the CESM2.2.0 release release-clm5.0.34 erik 04/20/2020 Update doc for release-clm5.0 (SKIPPED), and fix issues with no-anthro surface dataset creation release-clm5.0.33 erik 04/07/2020 SKIPPED ON MASTER -- Turn irrigation on for 2300 SSP extensions release-clm5.0.32 erik 04/02/2020 SKIPPED ON MASTER -- Extensions to 2300 for SSP5-8.5,SSP5-3.4, and SSP1-2.6 From df1bd72787899ff175dee3e75ca7ba45b7754309 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 6 Aug 2020 15:35:57 -0600 Subject: [PATCH 519/556] Update change files --- doc/ChangeLog | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 8225123657..7637a14f2f 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm1.0.dev106 Originator(s): erik (Erik Kluzek) -Date: Thu Aug 6 14:29:10 MDT 2020 +Date: Thu Aug 6 15:35:47 MDT 2020 One-line Summary: Bit-for-bit updates for the CESM2.2.0 release Purpose of changes @@ -9,10 +9,14 @@ Purpose of changes Fix some bit-for-bit things needed for the CESM2.2.0 release Bring changes needed from release-clm5.0.31-34 to trunk. ndep change. +Brings in some changes for PtVg datasets for no-anthro compset. Do some refactoring of Fire class so that it makes sense for FATES to use the base class. Update RTM and MOSART with NUOPC changes and an update of a NetCDF-4 file to NetCDF-5 needed for the cesm2.2.0 release. +The 2010 finidat file is now set in the 2010_control use-case rather than relying on the +finidat dataset matching. + Bugs fixed or introduced ------------------------ @@ -50,6 +54,12 @@ Notes of particular relevance for users Caveats for users (e.g., need to interpolate initial conditions): Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + if ndep file isn't found die with a warning rather than fatal error. + The warning allows you to override with CLM_BLDNML_OPTS="-ignore_warnings" + + finidat file matching will now use the sim_year rather than start-year + for a control case (transient cases used the start-year) + Add 2010 f09 finidat file for clm5_0_cam6.0 Changes made to namelist defaults (e.g., changed parameter values): @@ -64,6 +74,8 @@ NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the Caveats for developers (e.g., code that is duplicated that requires double maintenance): Changes to tests or testing: + Add clm45cam6LndTuningMode testmod + Some tests needed more wallclock Code reviewed by: self @@ -74,7 +86,7 @@ CTSM testing: regular build-namelist tests: - cheyenne - PASS + cheyenne - PASS (one test is different than ctsm1.0.dev105) python testing (see instructions in python/README.md; document testing done): From d1013218c495ce63ab372a3b6a54b1c1b4c81084 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 6 Aug 2020 16:09:15 -0600 Subject: [PATCH 520/556] Revert "Go back to ctsm1.0.dev105 version of namelist_defaults_ctsm using the previous finidat files, since using updated files changes answers for some cases when it gets interpolated another time" This reverts commit 68e360a69378adb84478cdeb748ba66577ff97d0. --- bld/namelist_files/namelist_defaults_ctsm.xml | 163 +++++++----------- 1 file changed, 62 insertions(+), 101 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index ec8d3ffe5d..5bea3819a3 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -22,7 +22,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 379.0 336.6 -340.6 379.0 388.8 397.5 @@ -505,7 +504,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 61 -1850,1982,2000,2010,2013 +1850,1979,2000,2013 .true. - - +.true. +.true. +.true. -.true. .true. -.true. -.true. -.true. -.true. -.true. -.true. .true. @@ -673,46 +664,24 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -hgrid=ne0np4.ARCTIC.ne30x4 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 - - -hgrid=ne0np4.ARCTICGRIS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 - - - - -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 - - -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 +hgrid=0.9x1.25 maxpft=17 mask=gx1v7 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 +hgrid=1.9x2.5 maxpft=17 mask=gx1v7 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 - -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 - -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 +hgrid=ne0np4.ARCTIC.ne30x4 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 -hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10 +hgrid=ne0np4.ARCTICGRIS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 @@ -729,31 +698,31 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.I1850Clm45BgcGs.0901-01-01.0.9x1.25_gx1v7_simyr1850_c190718.nc +>lnd/clm2/initdata_map/clmi.I1850Clm45BgcGs.0901-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc lnd/clm2/initdata_map/clmi.I1850Clm45BgcCruGs.1101-01-01.0.9x1.25_gx1v7_simyr1850_c190718.nc +>lnd/clm2/initdata_map/clmi.I1850Clm45BgcCruGs.1101-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc lnd/clm2/initdata_map/clmi.B1850.0161-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc +>lnd/clm2/initdata_map/clmi.B1850Clm45BgcGs.0161-01-01.0.9x1.25_gx1v7_simyr1850_c200729.nc lnd/clm2/initdata_map/clmi.I1850Clm50Sp.0181-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc + lnd_tuning_mode="clm5_0_GSWP3v1" +>lnd/clm2/initdata_map/clmi.I1850Clm50Sp.0181-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc @@ -768,23 +737,23 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/initdata_map/clmi.I1850Clm50BgcCropCru-ciso.1526-01-01.0.9x1.25_gx1v7_simyr1850_c190116.nc + lnd_tuning_mode="clm5_0_CRUv7" +>lnd/clm2/initdata_map/clmi.I1850Clm50BgcCropCru-ciso.1526-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc lnd/clm2/initdata_map/clmi.B1850.0161-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc + lnd_tuning_mode="clm5_0_cam6.0" +>lnd/clm2/initdata_map/clmi.B1850Clm50BgcCrop.0161-01-01.0.9x1.25_gx1v7_simyr1850_c200729.nc lnd/clm2/initdata_map/clmi.I1850Clm50SpCru.1706-01-01.0.9x1.25_gx1v7_simyr1850_c190111.nc + lnd_tuning_mode="clm5_0_CRUv7" +>lnd/clm2/initdata_map/clmi.I1850Clm50SpCru.1706-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc @@ -825,67 +794,59 @@ attributes from the config_cache.xml file (with keys converted to upper-case). >lnd/clm2/initdata_map/clmi.I2000Clm50BgcCrop.2011-01-01.1.9x2.5_gx1v7_gl4_simyr2000_c190312.nc + +lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr1979_c200729.nc + + +lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.1.9x2.5_gx1v7_simyr1979_c200729.nc + + lnd/clm2/initdata_map/clmi.FHISTSp.1982-01-01.ARCTIC_ne30x4_mt12_simyr1982_c200425.nc + lnd_tuning_mode="clm5_0_cam6.0" +>lnd/clm2/initdata_map/clmi.FHISTSp.1979-01-01.ARCTIC_ne30x4_mt12_simyr1979_c200728.nc lnd/clm2/initdata_map/clmi.FHISTSp.1982-01-01.ARCTICGRIS_ne30x8_mt12_simyr1982_c200428.nc + lnd_tuning_mode="clm5_0_cam6.0" +>lnd/clm2/initdata_map/clmi.FHISTSp.1979-01-01.ARCTICGRIS_ne30x8_mt12_simyr1979_c200728.nc lnd/clm2/initdata_map/clmi.F2000.2000-01-01.ne120pg3_mt13_simyr2000_c200506.nc - - - -lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c181015.nc - - -lnd/clm2/initdata_map/clmi.BHIST.2010-01-01.0.9x1.25_gx1v7_simyr2010_c181015.nc - - - -lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c181015.nc +>lnd/clm2/initdata_map/clmi.F2000.2000-01-01.ne120pg3_mt13_simyr2000_c200728.nc - + lnd/clm2/initdata_map/clmi.BHIST.2010-01-01.0.9x1.25_gx1v7_simyr2010_c181015.nc +>lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c200728.nc lnd/clm2/initdata_map/clmi.FHISTSp.2013-01-01.ne0CONUSne30x8_mt12_simyr2013_c200705.nc +>lnd/clm2/initdata_map/clmi.FHISTSp.2013-01-01.ne0CONUSne30x8_mt12_simyr2013_c200728.nc From c472cbe0a447d200910f7f4ed14ba4ae572f5182 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 6 Aug 2020 16:09:45 -0600 Subject: [PATCH 521/556] Revert "Change back #1004 with wrong ending year of ndep, since it has an apparant change to answers even for cases that dont' run past 2005" This reverts commit f7882107b154c2919cbf355bfaed3ba87a8cf081. --- bld/namelist_files/use_cases/20thC_transient.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/use_cases/20thC_transient.xml b/bld/namelist_files/use_cases/20thC_transient.xml index ff56232b8e..824f63cdc4 100644 --- a/bld/namelist_files/use_cases/20thC_transient.xml +++ b/bld/namelist_files/use_cases/20thC_transient.xml @@ -19,11 +19,11 @@ .false. 1850 -2005 +2015 1850 1850 -2005 +2015 1850 1850 From a6063521315e47c3b400b2df6b131ae3d6de1565 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 6 Aug 2020 16:11:24 -0600 Subject: [PATCH 522/556] Let 2010_control usecase use finidat matching rather than hardcoding a 2010 finidat in the use case --- bld/namelist_files/use_cases/2010_control.xml | 5 ----- 1 file changed, 5 deletions(-) diff --git a/bld/namelist_files/use_cases/2010_control.xml b/bld/namelist_files/use_cases/2010_control.xml index 5c63fa8224..244009df02 100644 --- a/bld/namelist_files/use_cases/2010_control.xml +++ b/bld/namelist_files/use_cases/2010_control.xml @@ -12,11 +12,6 @@ .false. .false. -lnd/clm2/initdata_map/clmi.BHIST.2010-01-01.0.9x1.25_gx1v7_simyr2010_c181015.nc - -.true. - 2010 2010 From 39234063b2f94825f75b92f1a477746ea130e3d8 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 6 Aug 2020 16:27:14 -0600 Subject: [PATCH 523/556] SEt ROF_NCPL,LND_TUNING_MODE, and turn on megan and drydep to waccmx_offline test --- .../testdefs/testmods_dirs/clm/waccmx_offline/shell_commands | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands index 09dc866921..e51937d668 100755 --- a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands @@ -1,2 +1,3 @@ -./xmlchange USE_ESMF_LIB=TRUE,ATM_NCPL=288,CALENDAR=GREGORIAN +./xmlchange USE_ESMF_LIB=TRUE,ATM_NCPL=288,CALENDAR=GREGORIAN,ROF_NCPL='$ATM_NCPL',LND_TUNING_MODE="clm5_0_cam6.0" +./xmlchange CLM_NAMELIST_OPTS="-megan -drydep" --append From 442dfe732edb43f1f4aed163837b71dadbb460ee Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 6 Aug 2020 16:48:00 -0600 Subject: [PATCH 524/556] Add a transient waccmx_offline test, shorten some of the tests for CAM grids, add some comments --- cime_config/testdefs/testlist_clm.xml | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 8afd0086e5..55ea066a89 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -50,6 +50,7 @@ + @@ -135,6 +136,16 @@ + + + + + + + + + + @@ -1148,7 +1159,7 @@ - + @@ -1157,7 +1168,7 @@ - + @@ -1166,7 +1177,7 @@ - + @@ -1175,7 +1186,7 @@ - + @@ -1184,7 +1195,7 @@ - + @@ -1193,7 +1204,7 @@ - + From 03196510bbf4fb9d2299418e31404a1bd7809d31 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 6 Aug 2020 18:36:51 -0600 Subject: [PATCH 525/556] Don't write out xsmrpool_loss if NOT use_crop -- part of the fix for #1097 --- src/biogeochem/CNVegCarbonStateType.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index d4aea5a37f..0a8ea2e03c 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -1205,11 +1205,13 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, dim1name='pft', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%xsmrpool_patch) - call restartvar(ncid=ncid, flag=flag, varname='xsmrpool_loss', xtype=ncd_double, & - dim1name='pft', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%xsmrpool_loss_patch) - if (flag == 'read' .and. (.not. readvar) ) then - this%xsmrpool_loss_patch(bounds%begp:bounds%endp) = 0._r8 + if (use_crop) then + call restartvar(ncid=ncid, flag=flag, varname='xsmrpool_loss', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%xsmrpool_loss_patch) + if (flag == 'read' .and. (.not. readvar) ) then + this%xsmrpool_loss_patch(bounds%begp:bounds%endp) = 0._r8 + end if end if call restartvar(ncid=ncid, flag=flag, varname='pft_ctrunc', xtype=ncd_double, & From 5481b0512f8cc2889f73129d5cd04495d16aa728 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 7 Aug 2020 00:28:48 -0600 Subject: [PATCH 526/556] Update finidat files for non-crop with the xsmrpool_loss term removed from them (see issue #1097) --- bld/namelist_files/namelist_defaults_ctsm.xml | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 5bea3819a3..161ff5c74b 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -700,21 +700,21 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ic_ymd="18500101" use_nitrif_denitrif=".true." use_vertsoilc=".true." sim_year="1850" ic_tod="0" glc_nec="10" use_crop=".false." irrigate=".true." lnd_tuning_mode="clm4_5_GSWP3v1" ->lnd/clm2/initdata_map/clmi.I1850Clm45BgcGs.0901-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc +>lnd/clm2/initdata_map/clmi.I1850Clm45BgcGs.0901-01-01.0.9x1.25_gx1v7_simyr1850_c200806.nc lnd/clm2/initdata_map/clmi.I1850Clm45BgcCruGs.1101-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc +>lnd/clm2/initdata_map/clmi.I1850Clm45BgcCruGs.1101-01-01.0.9x1.25_gx1v7_simyr1850_c200806.nc lnd/clm2/initdata_map/clmi.B1850Clm45BgcGs.0161-01-01.0.9x1.25_gx1v7_simyr1850_c200729.nc +>lnd/clm2/initdata_map/clmi.B1850Clm45BgcGs.0161-01-01.0.9x1.25_gx1v7_simyr1850_c200806.nc @@ -722,7 +722,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ic_ymd="18500101" use_nitrif_denitrif=".false." use_vertsoilc=".false." sim_year="1850" ic_tod="0" glc_nec="10" use_crop=".false." irrigate=".true." lnd_tuning_mode="clm5_0_GSWP3v1" ->lnd/clm2/initdata_map/clmi.I1850Clm50Sp.0181-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc +>lnd/clm2/initdata_map/clmi.I1850Clm50Sp.0181-01-01.0.9x1.25_gx1v7_simyr1850_c200806.nc @@ -753,7 +753,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ic_ymd="18500101" use_nitrif_denitrif=".false." use_vertsoilc=".false." sim_year="1850" ic_tod="0" glc_nec="10" use_crop=".false." irrigate=".true." lnd_tuning_mode="clm5_0_CRUv7" ->lnd/clm2/initdata_map/clmi.I1850Clm50SpCru.1706-01-01.0.9x1.25_gx1v7_simyr1850_c200728.nc +>lnd/clm2/initdata_map/clmi.I1850Clm50SpCru.1706-01-01.0.9x1.25_gx1v7_simyr1850_c200806.nc @@ -799,14 +799,14 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ic_ymd="19790101" use_nitrif_denitrif=".false." use_vertsoilc=".false." sim_year="1979" ic_tod="0" glc_nec="10" use_crop=".false." irrigate=".true." lnd_tuning_mode="clm5_0_cam6.0" ->lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr1979_c200729.nc +>lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr1979_c200806.nc lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.1.9x2.5_gx1v7_simyr1979_c200729.nc +>lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.1.9x2.5_gx1v7_simyr1979_c200806.nc @@ -814,7 +814,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ic_ymd="19790101" use_nitrif_denitrif=".false." use_vertsoilc=".false." sim_year="1979" ic_tod="0" glc_nec="10" use_crop=".false." irrigate=".true." lnd_tuning_mode="clm5_0_cam6.0" ->lnd/clm2/initdata_map/clmi.FHISTSp.1979-01-01.ARCTIC_ne30x4_mt12_simyr1979_c200728.nc +>lnd/clm2/initdata_map/clmi.FHISTSp.1979-01-01.ARCTIC_ne30x4_mt12_simyr1979_c200806.nc @@ -822,7 +822,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ic_ymd="19790101" use_nitrif_denitrif=".false." use_vertsoilc=".false." sim_year="1979" ic_tod="0" glc_nec="10" use_crop=".false." irrigate=".true." lnd_tuning_mode="clm5_0_cam6.0" ->lnd/clm2/initdata_map/clmi.FHISTSp.1979-01-01.ARCTICGRIS_ne30x8_mt12_simyr1979_c200728.nc +>lnd/clm2/initdata_map/clmi.FHISTSp.1979-01-01.ARCTICGRIS_ne30x8_mt12_simyr1979_c200806.nc @@ -846,7 +846,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ic_ymd="20130101" use_nitrif_denitrif=".false." use_vertsoilc=".false." sim_year="2013" ic_tod="0" glc_nec="10" use_crop=".false." irrigate=".true." lnd_tuning_mode="clm5_0_cam6.0" ->lnd/clm2/initdata_map/clmi.FHISTSp.2013-01-01.ne0CONUSne30x8_mt12_simyr2013_c200728.nc +>lnd/clm2/initdata_map/clmi.FHISTSp.2013-01-01.ne0CONUSne30x8_mt12_simyr2013_c200806.nc From 6e667960388d1a866e4f92f094c24fea904582f7 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 8 Aug 2020 00:37:53 -0600 Subject: [PATCH 527/556] levurb and string_len dimensions are no longer needed on the restart files fixing #1101 --- src/main/restFileMod.F90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/main/restFileMod.F90 b/src/main/restFileMod.F90 index 91967c5ed3..83be13835b 100644 --- a/src/main/restFileMod.F90 +++ b/src/main/restFileMod.F90 @@ -485,7 +485,7 @@ subroutine restFile_dimset( ncid ) use clm_varctl , only : caseid, ctitle, version, username, hostname, fsurdat use clm_varctl , only : conventions, source use dynSubgridControlMod , only : get_flanduse_timeseries - use clm_varpar , only : numrad, nlevlak, nlevsno, nlevgrnd, nlevurb, nlevcan + use clm_varpar , only : numrad, nlevlak, nlevsno, nlevgrnd, nlevcan use clm_varpar , only : maxpatch_glcmec, nvegwcs use decompMod , only : get_proc_global ! @@ -518,7 +518,6 @@ subroutine restFile_dimset( ncid ) call ncd_defdim(ncid , nameCohort , numCohort , dimid) call ncd_defdim(ncid , 'levgrnd' , nlevgrnd , dimid) - call ncd_defdim(ncid , 'levurb' , nlevurb , dimid) call ncd_defdim(ncid , 'levlak' , nlevlak , dimid) call ncd_defdim(ncid , 'levsno' , nlevsno , dimid) call ncd_defdim(ncid , 'levsno1' , nlevsno+1 , dimid) @@ -528,7 +527,6 @@ subroutine restFile_dimset( ncid ) if ( use_hydrstress ) then call ncd_defdim(ncid , 'vegwcs' , nvegwcs , dimid) end if - call ncd_defdim(ncid , 'string_length', 64 , dimid) call ncd_defdim(ncid , 'glc_nec', maxpatch_glcmec, dimid) call ncd_defdim(ncid , 'glc_nec1', maxpatch_glcmec+1, dimid) @@ -680,7 +678,7 @@ subroutine restFile_dimcheck( ncid ) ! ! !USES: use decompMod, only : get_proc_global - use clm_varpar, only : nlevsno, nlevlak, nlevgrnd, nlevurb + use clm_varpar, only : nlevsno, nlevlak, nlevgrnd use clm_varctl, only : single_column, nsrest, nsrStartup ! ! !ARGUMENTS: @@ -719,7 +717,6 @@ subroutine restFile_dimcheck( ncid ) 'use_init_interp = .true. in user_nl_clm' call check_dim(ncid, 'levsno' , nlevsno, msg=msg) call check_dim(ncid, 'levgrnd' , nlevgrnd, msg=msg) - call check_dim(ncid, 'levurb' , nlevurb) call check_dim(ncid, 'levlak' , nlevlak) end subroutine restFile_dimcheck From 12cc622622c1a5cba1fb7ddf228216a1a6a3a71d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 8 Aug 2020 00:39:08 -0600 Subject: [PATCH 528/556] Fix CLM xml variable name --- .../testdefs/testmods_dirs/clm/waccmx_offline/shell_commands | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands index e51937d668..28442e910b 100755 --- a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands @@ -1,3 +1,3 @@ ./xmlchange USE_ESMF_LIB=TRUE,ATM_NCPL=288,CALENDAR=GREGORIAN,ROF_NCPL='$ATM_NCPL',LND_TUNING_MODE="clm5_0_cam6.0" -./xmlchange CLM_NAMELIST_OPTS="-megan -drydep" --append +./xmlchange CLM_BLDNML_OPTS="-megan -drydep" --append From 2c6606c87aca78092ea67992e910ad91ab341647 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 8 Aug 2020 00:44:10 -0600 Subject: [PATCH 529/556] Add a IHistClm50SpGs that doesn't include CISM, because CISM can't use GREGORIAN calendar and use it for the waccmx test that sets to GREGORIAN --- cime_config/config_compsets.xml | 6 ++++++ cime_config/testdefs/testlist_clm.xml | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 87349d0c24..dbcdf4a049 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -232,6 +232,12 @@ + + IHistClm50SpGs + HIST_DATM%GSWP3v1_CLM50%SP_SICE_SOCN_MOSART_SGLC_SWAV + + + IHistClm50SpCru HIST_DATM%CRUv7_CLM50%SP_SICE_SOCN_MOSART_CISM2%NOEVOLVE_SWAV diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 55ea066a89..0bd8b24b5e 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -139,7 +139,7 @@ - + From f30d6d5bc47894b7121cf44b90bf468163b53cd0 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 9 Aug 2020 23:43:26 -0600 Subject: [PATCH 530/556] Add a 2003 f19 finidat file that can be used by the FXHIST test and will work for #1089 --- bld/namelist_files/namelist_defaults_ctsm.xml | 22 ++++++++++++++++++- .../namelist_definition_ctsm.xml | 2 +- 2 files changed, 22 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 161ff5c74b..16d65964ef 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -504,7 +504,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 61 -1850,1979,2000,2013 +1850,1979,2000,2003,2013 +.true. + + .true. @@ -683,6 +688,12 @@ attributes from the config_cache.xml file (with keys converted to upper-case). hgrid="ne0np4.ARCTICGRIS.ne30x8" use_cn=".false." maxpft="17" >hgrid=ne0np4.ARCTICGRIS.ne30x8 maxpft=17 mask=tx0.1v2 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 +p + +hgrid=1.9x2.5 maxpft=17 mask=gx1v7 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10 + lnd/clm2/initdata_map/clmi.BHIST.2000-01-01.0.9x1.25_gx1v7_simyr2000_c200728.nc + +lnd/clm2/initdata_map/clmi.BHISTSp.2000-01-01.1.9x2.5_gx1v7_simyr2003_c200807.nc + + + + group="default_settings" valid_values="1850,1979,2000,2003,2010,2013" > Simulation years you can look for in initial condition files (finidat) if interpolation is turned on (use_init_interp is .true.) From b2b82d884da783a6b8f1dfa0f6c84e3b2c1e2800 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 10 Aug 2020 01:04:30 -0600 Subject: [PATCH 531/556] add a namelist test for a 2003 start, adjust the waccm_offline tests make one of them for a 2005 start --- bld/unit_testers/build-namelist_test.pl | 5 +++-- cime_config/testdefs/testlist_clm.xml | 6 +++--- .../clm/waccmx_offline2005Start/include_user_mods | 1 + .../clm/waccmx_offline2005Start/shell_commands | 1 + 4 files changed, 8 insertions(+), 5 deletions(-) create mode 100644 cime_config/testdefs/testmods_dirs/clm/waccmx_offline2005Start/include_user_mods create mode 100755 cime_config/testdefs/testmods_dirs/clm/waccmx_offline2005Start/shell_commands diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index bde36e8c58..ed57cdcc92 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,9 +138,9 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 889; +my $ntests = 893; if ( defined($opts{'compare'}) ) { - $ntests += 546; + $ntests += 549; } plan( tests=>$ntests ); @@ -335,6 +335,7 @@ sub make_config_cache { "-res ne0np4.ARCTICGRIS.ne30x8 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=19790101/' -lnd_tuning_mode clm5_0_cam6.0", "-res 0.9x1.25 -bgc bgc -crop -use_case 20thC_transient -namelist '&a start_ymd=19500101/' -lnd_tuning_mode clm5_0_cam6.0", "-res ne0np4CONUS.ne30x8 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=20130101/' -lnd_tuning_mode clm5_0_cam6.0", + "-res 1.9x2.5 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=20030101/' -lnd_tuning_mode clm5_0_cam6.0", "-res 1.9x2.5 -bgc sp -use_case 2010_control -namelist '&a start_ymd=20100101/' -lnd_tuning_mode clm5_0_cam6.0", "-res C192 -bgc sp -use_case 2010_control -namelist '&a start_ymd=20100101/' -lnd_tuning_mode clm5_0_cam6.0", "-res ne0np4.ARCTIC.ne30x4 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=20130101/' -lnd_tuning_mode clm5_0_cam6.0", diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 0bd8b24b5e..a0f0e6e2d6 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -130,16 +130,16 @@ - + - + - + diff --git a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline2005Start/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline2005Start/include_user_mods new file mode 100644 index 0000000000..e46fc10b2e --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline2005Start/include_user_mods @@ -0,0 +1 @@ +../waccmx_offline diff --git a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline2005Start/shell_commands b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline2005Start/shell_commands new file mode 100755 index 0000000000..b926b0dbb1 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline2005Start/shell_commands @@ -0,0 +1 @@ +./xmlchange RUN_STARTDATE=2005-01-01 From a5d808d7c6a7e8f67fce97818366a13c31848d23 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 10 Aug 2020 02:21:21 -0600 Subject: [PATCH 532/556] Update change files --- doc/ChangeLog | 129 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 130 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 7637a14f2f..759c005192 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,133 @@ =============================================================== +Tag name: ctsm1.0.dev107 +Originator(s): erik (Erik Kluzek) +Date: Mon Aug 10 02:21:12 MDT 2020 +One-line Summary: Answer changes needed for CESM2.2.0 + +Purpose of changes +------------------ + +A list of small answer changes needed for CESM2.2.0. Nitrogen deposition file now properly +ends in 2015 rather than 2005. Have 2010_control compset match the 2000 IOC file rather than 2010. +Modify the waccmx_offline tests to more closely match the CAM tests. + +Interpolate IC files for an exact match. Answers are identical for an exact match, but different +when used for other resolutions. + +Two small bit-for-bit changes remove levurb and string_len dimensions on restart files. +Remove xsmrpool_loss when use_crop is NOT true. + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): [If none, remove this line] + Answer changing fixes: + Fixes #1004 -- stream_year_last_ndep is set to 2005 instead of 2015 for historical with ctsm1.0.dev093 + Fixes #1012 -- Help prevent problems with WACCM-X testing by modifying our waccmx_offline test + Fixes #1090 -- Have 2010_control compset match 2000 simulation-year rather than 2010 + Fixes #1089 -- Failure in FXHIST test when running with CAM + Fixes #1037 -- Interpolate out-of-the-box initial conditions files for CESM2.2 release + (only changes answers for resolutions other than IC file resolution) + + Bit-for-bit changes: + Fixes #1101 -- levurb and string_len dimensions no longer needed on the restart files + Fixes #1097 -- xsmrpool_loss should only be written to the restart file if use_crop is true + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? No +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): None + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + 2010_control doesn't match 2010 finidat file + +Changes made to namelist defaults (e.g., changed parameter values): None + +Changes to the datasets (e.g., parameter, surface or initial files): Interpolated IC files + Add f19 2003 IC file, f09 and 19 1979 IC file + Remove 2010 IC file + +Substantial timing or memory changes: None + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): None + +Changes to tests or testing: waccm_offline test changed to more closely match the FXHIST CAM test + +Code reviewed by: self + + +CTSM testing: regular + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - PASS (115 tests are different than before) + + python testing (see instructions in python/README.md; document testing done): + + cheyenne - PASS + + regular tests (aux_clm): + + cheyenne ---- PASS + izumi ------- PASS + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: Yes! + + Hist and SSP BGC compsets change answers because of the correction of the end year for ndep. + You wouldn't think this would matter until you get to the end of the time-sequence -- but it + does for the first time-step. + + The 2010 compset changes answers because of using the 2000 finidat file rather than 2010 + + Some finidat files interpolated to the resolution they are designed for. This causes an apparent + change of answers when these datasets are used for other resolutions (even though it does NOT for + the resolution it's interpolated to) + + waccm_offline tests are also changed in order to more closely match the FXHIST tests in CAM. + + Summarize any changes to answers, i.e., + - what code configurations: Hist, SSP, 2010 compsets, Clm45 and some f10, 1x1 because of IC files + - what platforms/compilers: All + - nature of change: same climate + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): None + +Pull Requests that document the changes (include PR ids): #1100 +(https://github.com/ESCOMP/ctsm/pull) + #1100 -- Answer changes needed for CESM2.2.0 + +=============================================================== +=============================================================== Tag name: ctsm1.0.dev106 Originator(s): erik (Erik Kluzek) Date: Thu Aug 6 15:35:47 MDT 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index d7fd19ea56..2d511da10a 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm1.0.dev107 erik 08/10/2020 Answer changes needed for CESM2.2.0 ctsm1.0.dev106 erik 08/06/2020 Bit-for-bit updates for the CESM2.2.0 release release-clm5.0.34 erik 04/20/2020 Update doc for release-clm5.0 (SKIPPED), and fix issues with no-anthro surface dataset creation release-clm5.0.33 erik 04/07/2020 SKIPPED ON MASTER -- Turn irrigation on for 2300 SSP extensions From 1852e8f11b09d341476b357e20732f95cb21f50b Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 14 Aug 2020 16:09:26 -0600 Subject: [PATCH 533/556] Add PE layouts for any machine for the new grids, and also set the previous one for cheyenne, for ARCTIC,ARCTICGRIS, and CONUS increase number of nodes to 150 on cheyenne --- cime_config/config_pes.xml | 272 +++++++++++++++++++++++++++++++++---- 1 file changed, 247 insertions(+), 25 deletions(-) diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index 0d1559791d..efe40a579f 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -414,14 +414,14 @@ none - -8 - -8 - -8 - -8 - -8 - -8 - -8 - -8 + -12 + -12 + -12 + -12 + -12 + -12 + -12 + -12 1 @@ -446,19 +446,56 @@ + + + + none + + -1 + -150 + -150 + -150 + -150 + -150 + -150 + -150 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + none - -8 - -8 - -8 - -8 - -8 - -8 - -8 - -8 + -12 + -12 + -12 + -12 + -12 + -12 + -12 + -12 1 @@ -483,19 +520,56 @@ + + + + none + + -1 + -150 + -150 + -150 + -150 + -150 + -150 + -150 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + none - -8 - -8 - -8 - -8 - -8 - -8 - -8 - -8 + -12 + -12 + -12 + -12 + -12 + -12 + -12 + -12 1 @@ -520,6 +594,43 @@ + + + + none + + -1 + -150 + -150 + -150 + -150 + -150 + -150 + -150 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + @@ -596,6 +707,43 @@ + + none + + -12 + -12 + -12 + -12 + -12 + -12 + -12 + -12 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + none @@ -631,6 +779,43 @@ + + + + none + + -24 + -24 + -24 + -24 + -24 + -24 + -24 + -24 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + @@ -668,8 +853,45 @@ - + + + none + + -48 + -48 + -48 + -48 + -48 + -48 + -48 + -48 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + none From e4f9e3c8deeb164cee23ea9c0972d9d2f6ca8cc2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 14 Aug 2020 16:09:39 -0600 Subject: [PATCH 534/556] Update cime and cism externals --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index c5e31d48f4..f1b8d8056b 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -8,7 +8,7 @@ required = True local_path = components/cism protocol = git repo_url = https://github.com/ESCOMP/CISM-wrapper -tag = cism2_1_68 +tag = cism2_1_69 externals = Externals_CISM.cfg required = True @@ -30,7 +30,7 @@ required = True local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -tag = cime5.8.28 +tag = cime5.8.30 externals = ../Externals_cime.cfg required = True From fd9fd7f9889f3bcb2a0c3e8f3fc9e59f64f5a162 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 14 Aug 2020 17:41:45 -0600 Subject: [PATCH 535/556] Test for f09 and f19 1979 files, helping #1103 --- bld/unit_testers/build-namelist_test.pl | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index ed57cdcc92..f2839d22f8 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,9 +138,9 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 893; +my $ntests = 901; if ( defined($opts{'compare'}) ) { - $ntests += 549; + $ntests += 555; } plan( tests=>$ntests ); @@ -333,6 +333,8 @@ sub make_config_cache { foreach my $options ( "-res ne0np4.ARCTIC.ne30x4 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=19790101/' -lnd_tuning_mode clm5_0_cam6.0", "-res ne0np4.ARCTICGRIS.ne30x8 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=19790101/' -lnd_tuning_mode clm5_0_cam6.0", + "-res 1.9x2.5 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=19790101/' -lnd_tuning_mode clm5_0_cam6.0", + "-res 0.9x1.25 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=19790101/' -lnd_tuning_mode clm5_0_cam6.0", "-res 0.9x1.25 -bgc bgc -crop -use_case 20thC_transient -namelist '&a start_ymd=19500101/' -lnd_tuning_mode clm5_0_cam6.0", "-res ne0np4CONUS.ne30x8 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=20130101/' -lnd_tuning_mode clm5_0_cam6.0", "-res 1.9x2.5 -bgc sp -use_case 20thC_transient -namelist '&a start_ymd=20030101/' -lnd_tuning_mode clm5_0_cam6.0", From 86e78f4af88f36add5e648d2b1f1bafc23fb9994 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 14 Aug 2020 17:42:21 -0600 Subject: [PATCH 536/556] Chagne start date for waccmx test to 1979 to help #1103 --- .../testdefs/testmods_dirs/clm/waccmx_offline/shell_commands | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands index 28442e910b..e7d88b5afa 100755 --- a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands @@ -1,3 +1,4 @@ ./xmlchange USE_ESMF_LIB=TRUE,ATM_NCPL=288,CALENDAR=GREGORIAN,ROF_NCPL='$ATM_NCPL',LND_TUNING_MODE="clm5_0_cam6.0" ./xmlchange CLM_BLDNML_OPTS="-megan -drydep" --append +./xmlchange RUN_STARTDATE=1979-01-01 From aa36c77fe939a41ac9f1933080e2aeac80a1aab0 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 14 Aug 2020 18:02:48 -0600 Subject: [PATCH 537/556] Change tests with g16 to g17 --- cime_config/testdefs/testlist_clm.xml | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index a0f0e6e2d6..735b0a9253 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -53,7 +53,7 @@ - + @@ -223,7 +223,7 @@ - + @@ -1105,7 +1105,7 @@ - + @@ -1327,7 +1327,7 @@ - + @@ -1874,7 +1874,7 @@ - + @@ -1882,7 +1882,7 @@ - + @@ -1890,7 +1890,7 @@ - + @@ -1907,7 +1907,7 @@ - + @@ -1915,7 +1915,7 @@ - + @@ -1923,7 +1923,7 @@ - + @@ -1940,7 +1940,7 @@ - + From 1e4f8b85fc6f62241c22e5f81cc43071867eedeb Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 17 Aug 2020 13:16:04 -0600 Subject: [PATCH 538/556] Change number of nodes on cheyenne to 70 from 150 as that seems to run better for the ARCTIC, CONUS and ARCTICGRIS grids from testing ARCTICGRIS --- cime_config/config_pes.xml | 42 +++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index efe40a579f..efbaa063e8 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -452,13 +452,13 @@ none -1 - -150 - -150 - -150 - -150 - -150 - -150 - -150 + -70 + -70 + -70 + -70 + -70 + -70 + -70 1 @@ -526,13 +526,13 @@ none -1 - -150 - -150 - -150 - -150 - -150 - -150 - -150 + -70 + -70 + -70 + -70 + -70 + -70 + -70 1 @@ -600,13 +600,13 @@ none -1 - -150 - -150 - -150 - -150 - -150 - -150 - -150 + -70 + -70 + -70 + -70 + -70 + -70 + -70 1 From cfcb2e58113af926302acde9d09075ceb1853abe Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 17 Aug 2020 15:23:32 -0600 Subject: [PATCH 539/556] FV3 high resolution grids were setup for fully coupled PE layouts, change them to more standard I compset type layouts on cheyenne, keeping them the same size --- cime_config/config_pes.xml | 124 ++++++++++++++++++------------------- 1 file changed, 62 insertions(+), 62 deletions(-) diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index efbaa063e8..ba8585f570 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -747,34 +747,34 @@ none - 1152 - 864 - 864 - 288 - 256 - 1152 - 32 - 1152 + -1 + -48 + -48 + -48 + -48 + -48 + -48 + -48 - 3 - 3 - 3 - 3 - 3 - 3 - 3 - 3 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 0 - 0 - 0 - 864 - 1152 - 0 - 1408 - 0 + -1 + -1 + -1 + -1 + -1 + -1 + -1 @@ -817,38 +817,38 @@ - + none - 1152 - 864 - 864 - 288 - 256 - 1152 - 32 - 1152 + -1 + -48 + -48 + -48 + -48 + -48 + -48 + -48 - 3 - 3 - 3 - 3 - 3 - 3 - 3 - 3 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 0 - 0 - 0 - 864 - 1152 - 0 - 1408 - 0 + -1 + -1 + -1 + -1 + -1 + -1 + -1 @@ -895,14 +895,14 @@ none - 3456 - 3456 - 3456 - 3456 - 3456 - 3456 - 3456 - 3456 + -1 + -96 + -96 + -96 + -96 + -96 + -96 + -96 1 @@ -916,13 +916,13 @@ 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 + -1 + -1 + -1 + -1 + -1 + -1 + -1 From 4cff6af143d8fc3a93c77ba02250604cd0b89ec9 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 17 Aug 2020 15:25:54 -0600 Subject: [PATCH 540/556] Remove the x8 x4 ending for ARCTIC and ARTCICGRIS grids to make the match more general in case new grids are added later --- cime_config/config_pes.xml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index ba8585f570..d391f2b9d1 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -483,7 +483,7 @@ - + none @@ -520,7 +520,7 @@ - + none @@ -557,7 +557,7 @@ - + none @@ -594,7 +594,7 @@ - + none From 1e930be4f66c961a3e455c1060736af298e93115 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 17 Aug 2020 16:48:08 -0600 Subject: [PATCH 541/556] Change single point tests/compsets to run with stub ROF, add new compset with stub-ROF for I2000Clm50BgcCruGs IHistClm50BgcQianGs --- cime_config/config_compsets.xml | 38 +++++++++++++++++---------- cime_config/testdefs/testlist_clm.xml | 36 ++++++++++++------------- 2 files changed, 42 insertions(+), 32 deletions(-) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index dbcdf4a049..598aa7bb2e 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -154,8 +154,8 @@ particularly relevant for single-point cases (where datm dominates the runtime) --> - I2000Clm50BgcCropQianGs - 2000_DATM%QIA_CLM50%BGC-CROP_SICE_SOCN_MOSART_SGLC_SWAV + I2000Clm50BgcCropQianRsGs + 2000_DATM%QIA_CLM50%BGC-CROP_SICE_SOCN_SROF_SGLC_SWAV I2000Clm50SpRtmFl @@ -194,8 +199,8 @@ - I2000Clm50FatesGs - 2000_DATM%GSWP3v1_CLM50%FATES_SICE_SOCN_MOSART_SGLC_SWAV + I2000Clm50FatesRsGs + 2000_DATM%GSWP3v1_CLM50%FATES_SICE_SOCN_SROF_SGLC_SWAV @@ -259,6 +264,11 @@ HIST_DATM%QIA_CLM50%BGC_SICE_SOCN_MOSART_SGLC_SWAV + + IHistClm50BgcQianRsGs + HIST_DATM%QIA_CLM50%BGC_SICE_SOCN_SROF_SGLC_SWAV + + ISSP585Clm50BgcCrop @@ -306,14 +316,14 @@ particularly relevant for single-point cases (where datm dominates the runtime) --> - IHistClm50BgcCropQianGs - HIST_DATM%QIA_CLM50%BGC-CROP_SICE_SOCN_MOSART_SGLC_SWAV + IHistClm50BgcCropQianRsGs + HIST_DATM%QIA_CLM50%BGC-CROP_SICE_SOCN_SROF_SGLC_SWAV - IHistClm50BgcCropGs - HIST_DATM%GSWP3v1_CLM50%BGC-CROP_SICE_SOCN_MOSART_SGLC_SWAV + IHistClm50BgcCropRsGs + HIST_DATM%GSWP3v1_CLM50%BGC-CROP_SICE_SOCN_SROF_SGLC_SWAV @@ -326,8 +336,8 @@ faster datm throughput, which is particularly relevant for single-point cases (where datm dominates the runtime) --> - I2000Clm50BgcDvCropQianGs - 2000_DATM%QIA_CLM50%BGCDV-CROP_SICE_SOCN_MOSART_SGLC_SWAV + I2000Clm50BgcDvCropQianRsGs + 2000_DATM%QIA_CLM50%BGCDV-CROP_SICE_SOCN_SROF_SGLC_SWAV @@ -388,8 +398,8 @@ faster datm throughput, which is particularly relevant for single-point cases (where datm dominates the runtime) --> - IHistClm45BgcCropQianGs - HIST_DATM%QIA_CLM45%BGC-CROP_SICE_SOCN_RTM_SGLC_SWAV + IHistClm45BgcCropQianRsGs + HIST_DATM%QIA_CLM45%BGC-CROP_SICE_SOCN_SROF_SGLC_SWAV @@ -414,8 +424,8 @@ - I2000Clm45FatesGs - 2000_DATM%GSWP3v1_CLM45%FATES_SICE_SOCN_RTM_SGLC_SWAV + I2000Clm45FatesRsGs + 2000_DATM%GSWP3v1_CLM45%FATES_SICE_SOCN_SROF_SGLC_SWAV diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 735b0a9253..00f84ccd44 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -17,7 +17,7 @@ - + @@ -916,7 +916,7 @@ - + @@ -950,7 +950,7 @@ - + @@ -959,7 +959,7 @@ - + @@ -968,7 +968,7 @@ - + @@ -977,7 +977,7 @@ - + @@ -986,7 +986,7 @@ - + @@ -1005,7 +1005,7 @@ - + @@ -1023,7 +1023,7 @@ - + @@ -1049,7 +1049,7 @@ - + @@ -1382,7 +1382,7 @@ - + @@ -1566,7 +1566,7 @@ - + @@ -1575,7 +1575,7 @@ - + @@ -1664,7 +1664,7 @@ - + @@ -1681,7 +1681,7 @@ - + @@ -1931,7 +1931,7 @@ - + @@ -1998,7 +1998,7 @@ - + @@ -2038,7 +2038,7 @@ - + From 2e788711e15920ff7f502a781554f1690e735f03 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 18 Aug 2020 11:58:29 -0600 Subject: [PATCH 542/556] Use compset with stub ROF for 5x5_amazon tests as well --- cime_config/testdefs/testlist_clm.xml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 00f84ccd44..ad0bf6f6f9 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1618,7 +1618,7 @@ - + @@ -1627,7 +1627,7 @@ - + @@ -1673,7 +1673,7 @@ - + @@ -1691,7 +1691,7 @@ - + From 75345c5b21d803b2e851a764c2a213f672893f90 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 18 Aug 2020 13:01:57 -0600 Subject: [PATCH 543/556] Update externals for nuopc to ones in nuopc_dev branch --- Externals_cime.cfg | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/Externals_cime.cfg b/Externals_cime.cfg index 94b569d479..0e00152795 100644 --- a/Externals_cime.cfg +++ b/Externals_cime.cfg @@ -1,19 +1,12 @@ [cmeps] -hash = 9376b87 +hash = cab9030 protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = src/drivers/nuopc/ required = True -[fox] -hash = 0ed59c1 -protocol = git -repo_url = https://github.com/ESMCI/fox.git -local_path = src/externals/fox -required = True - [cdeps] -hash = 8e77759 +hash = cfc5345 protocol = git repo_url = https://github.com/ESCOMP/CDEPS.git local_path = src/components/cdeps From c1baf34c26f70adb8a936de768b716f587b4f930 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 18 Aug 2020 23:25:23 -0600 Subject: [PATCH 544/556] Add fox back in as it's currently required by this version of cime for the build --- Externals_cime.cfg | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Externals_cime.cfg b/Externals_cime.cfg index 0e00152795..90a80b92ea 100644 --- a/Externals_cime.cfg +++ b/Externals_cime.cfg @@ -5,6 +5,13 @@ repo_url = https://github.com/ESCOMP/CMEPS.git local_path = src/drivers/nuopc/ required = True +[fox] +hash = 0ed59c1 +protocol = git +repo_url = https://github.com/ESMCI/fox.git +local_path = src/externals/fox +required = True + [cdeps] hash = cfc5345 protocol = git From 9a6037defae534ad44cca854209b31ab608a2a64 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 19 Aug 2020 13:52:16 -0600 Subject: [PATCH 545/556] Move CDEPS version back one commit as it was requiring level dimension in the streams file --- Externals_cime.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_cime.cfg b/Externals_cime.cfg index 90a80b92ea..a9df9d0698 100644 --- a/Externals_cime.cfg +++ b/Externals_cime.cfg @@ -13,7 +13,7 @@ local_path = src/externals/fox required = True [cdeps] -hash = cfc5345 +hash = d7b8a4c8e1b7cbff88da5bdb782ab715de62468a protocol = git repo_url = https://github.com/ESCOMP/CDEPS.git local_path = src/components/cdeps From 3bfc5250cf373dd210532670f4dd19e465e71958 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 19 Aug 2020 16:15:26 -0600 Subject: [PATCH 546/556] Use a compset with stub GLC for a sub-day restart test --- cime_config/testdefs/testlist_clm.xml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index ad0bf6f6f9..1d6552493f 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1159,13 +1159,14 @@ - + - + From 7049b7124f58c2b4ce79c79ad790f0f2b4e7f1d8 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 19 Aug 2020 17:24:00 -0600 Subject: [PATCH 547/556] Update changeLog --- doc/ChangeLog | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 115 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 759c005192..e33c0abe88 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,118 @@ =============================================================== +Tag name: ctsm1.0.dev108 +Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Wed Aug 19 17:23:47 MDT 2020 +One-line Summary: Update default PE layouts for new SE/FV3 grids + +Purpose of changes +------------------ + +Change PE layouts for new high resolution SE/FV3 grids. Have a version for cheyenne and a default one +as well. + +Update externals: cime, cism, CMEPS, CDEPS +Change single point tests to use stub ROF +Change tests to use gx1v7 rather than gx1v6 +Update waccmx_offline to use START=1979 + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): + Fixes #1108 Change single point tests to use stub ROF + Fixes #1098 ARCTICGRIS PE layout is very slow + Fixes #1105 Default new FV3/SE grid PE layouts are problematic + Fixes #1103 Some changes to prevent missing file for WACCMX testing + Fixes #1113 ARCTIC test is failing + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? No +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): None + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): None + +Changes made to namelist defaults (e.g., changed parameter values): None + +Changes to the datasets (e.g., parameter, surface or initial files): None + +Substantial timing or memory changes: None + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + Some tests were chagned to use stub ROF and one to stub GLC. @billsacks suggest we should also change + other tests in this same way. + +Changes to tests or testing: Yes + +Code reviewed by: self + + +CTSM testing: regular, tools + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - PASS + + tools-tests (test/tools): + + cheyenne - PASS + + PTCLM testing (tools/shared/PTCLM/test): + + cheyenne - OK + + python testing (see instructions in python/README.md; document testing done): + + cheyenne -- PASS + + regular tests (aux_clm): + + cheyenne ---- PASS + izumi ------- PASS + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: No (except for waccmx_offline test) + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): cime, cism, CDEPS, CMEPS + cism to cism2_1_69 + cime to cime5.8.30 + Update hash for CDEPS and CMEPS (so that nuopc test will run) + +Pull Requests that document the changes (include PR ids): #1111 +(https://github.com/ESCOMP/ctsm/pull) + + #1111 -- Adjust FV3/SE PE layouts + +=============================================================== +=============================================================== Tag name: ctsm1.0.dev107 Originator(s): erik (Erik Kluzek) Date: Mon Aug 10 02:21:12 MDT 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index 2d511da10a..cfabe8bb5b 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm1.0.dev108 erik 08/19/2020 Update default PE layouts for new SE/FV3 grids ctsm1.0.dev107 erik 08/10/2020 Answer changes needed for CESM2.2.0 ctsm1.0.dev106 erik 08/06/2020 Bit-for-bit updates for the CESM2.2.0 release release-clm5.0.34 erik 04/20/2020 Update doc for release-clm5.0 (SKIPPED), and fix issues with no-anthro surface dataset creation From 6d430b4c749382e7a8a24af2fa6ca5370fd6d631 Mon Sep 17 00:00:00 2001 From: Negin Sobhani Date: Thu, 20 Aug 2020 13:05:11 -0600 Subject: [PATCH 548/556] update the changelog --- doc/ChangeLog | 115 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 116 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index e33c0abe88..e912c45a75 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,119 @@ =============================================================== +Tag name: ctsm1.0.dev109 +Originator(s): negins (Negin Sobhani,UCAR/TSS,303-497-1224) +Date: Thu Aug 20 11:40:07 MDT 2020 +One-line Summary: Allow for resorbtion in transition from live to dead wood N + +Purpose of changes +------------------ + +This PR allows for resorbtion in transition from live to dead wood N, which also move +to NPOOL for free. + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): Issue #443 + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): None + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist +variables): None + +Changes made to namelist defaults (e.g., changed parameter values): None + +Changes to the datasets (e.g., parameter, surface or initial files): None + +Substantial timing or memory changes: [For timing changes, can check PFS test(s) in the test suite] + +Notes of particular relevance for developers: None +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + +Changes to tests or testing: + +Code reviewed by: + + +CTSM testing: + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - + + tools-tests (test/tools): + + cheyenne - + + PTCLM testing (tools/shared/PTCLM/test): + + cheyenne - + + python testing (see instructions in python/README.md; document testing done): + + (any machine) - + + regular tests (aux_clm): + + cheyenne ---- PASS + izumi ------- PASS + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: + + URL for LMWG diagnostics output used to validate new climate: + + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): + +Pull Requests that document the changes (include PR ids): +(https://github.com/ESCOMP/ctsm/pull) + +=============================================================== +=============================================================== Tag name: ctsm1.0.dev108 Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) Date: Wed Aug 19 17:23:47 MDT 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index cfabe8bb5b..9073311c62 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm1.0.dev109 negins 08/20/2020 Allow for resorbtion in transition from live to dead wood N ctsm1.0.dev108 erik 08/19/2020 Update default PE layouts for new SE/FV3 grids ctsm1.0.dev107 erik 08/10/2020 Answer changes needed for CESM2.2.0 ctsm1.0.dev106 erik 08/06/2020 Bit-for-bit updates for the CESM2.2.0 release From efea885663bd21d999198be58e7ac1d814dc66ac Mon Sep 17 00:00:00 2001 From: Negin Sobhani Date: Thu, 20 Aug 2020 13:25:22 -0600 Subject: [PATCH 549/556] filling in more fields in changelog. --- doc/ChangeLog | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index e912c45a75..6e77e31f6c 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -22,9 +22,9 @@ Significant changes to scientifically-supported configurations Does this tag change answers significantly for any of the following physics configurations? (Details of any changes will be given in the "Answer changes" section below.) -[ ] clm5_0 +[x] clm5_0 -[ ] ctsm5_0-nwp +[x] ctsm5_0-nwp [ ] clm4_5 @@ -48,9 +48,9 @@ NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the Caveats for developers (e.g., code that is duplicated that requires double maintenance): -Changes to tests or testing: +Changes to tests or testing: None -Code reviewed by: +Code reviewed by: Erik Kluzek CTSM testing: @@ -59,19 +59,19 @@ CTSM testing: build-namelist tests: - cheyenne - + cheyenne - not run tools-tests (test/tools): - cheyenne - + cheyenne - not run PTCLM testing (tools/shared/PTCLM/test): - cheyenne - + cheyenne - not run python testing (see instructions in python/README.md; document testing done): - (any machine) - + (any machine) - not run regular tests (aux_clm): @@ -86,6 +86,8 @@ Answer changes Changes answers relative to baseline: + + If a tag changes answers relative to baseline comparison the following should be filled in (otherwise remove this section): From 906959f121f54b41aade26325ac401f307849ca2 Mon Sep 17 00:00:00 2001 From: Negin Sobhani Date: Thu, 20 Aug 2020 13:34:09 -0600 Subject: [PATCH 550/556] updating fields in ChangeLog... --- doc/ChangeLog | 158 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 153 insertions(+), 5 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 6e77e31f6c..2e0a8c1aa7 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -84,7 +84,7 @@ If the tag used for baseline comparisons was NOT the previous tag, note that her Answer changes -------------- -Changes answers relative to baseline: +Changes answers relative to baseline: YES @@ -92,9 +92,10 @@ Changes answers relative to baseline: following should be filled in (otherwise remove this section): Summarize any changes to answers, i.e., - - what code configurations: - - what platforms/compilers: - - nature of change (roundoff; larger than roundoff/same climate; new climate): + - what code configurations: ??? + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new + climate): larger than roundoff/same climate??? If bitwise differences were observed, how did you show they were no worse than roundoff? @@ -103,7 +104,154 @@ Changes answers relative to baseline: climate (put details of the simulations in the experiment database) - casename: - URL for LMWG diagnostics output used to validate new climate: + Answer changes appeared for the following tests on Cheyenne: + 0819-233327ch_gnu: 46 tests + FAIL ERI_D_Ld9.f10_f10_musgs.I1850Clm50Bgc.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERI_D_Ld9.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERI_Ld9.f10_f10_musgs.I1850Clm50Bgc.cheyenne_gnu.clm-drydepnomegan BASELINE ctsm1.0.dev108: DIFF + FAIL ERI_Ld9.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D.f10_f10_musgs.IHistClm50Bgc.cheyenne_gnu.clm-decStart BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld3_P36x2.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld5.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-ciso_flexCN_FUN BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-snowveg_norad BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld5.f10_f10_musgs.I1850Clm50Bgc.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P36x2_D_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_gnu.clm-extra_outputs BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P36x2_D_Ld5.f10_f10_musgs.I2000Clm50Cn.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P36x2_Lm13.f10_f10_musgs.IHistClm50Bgc.cheyenne_gnu.clm-monthly BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_D_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_D_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_Lm40_Mmpi-serial.1x1_numaIA.I2000Clm50BgcCropQianRsGs.cheyenne_gnu.clm-monthly BASELINE ctsm1.0.dev108: DIFF + FAIL LWISO_Ld10.f10_f10_musgs.I2000Clm50BgcCropGs.cheyenne_gnu.clm-coldStart BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ld5.f10_f10_musgs.ISSP245Clm50BgcCrop.cheyenne_gnu.clm-ciso_dec2050Start BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ld5.f10_f10_musgs.ISSP370Clm50BgcCrop.cheyenne_gnu.clm-ciso_dec2050Start BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Lm1.f10_f10_musgs.I1850Clm50BgcCropCmip6waccm.cheyenne_gnu.clm-basic BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ly1_Mmpi-serial.1x1_brazil.IHistClm50BgcQianRsGs.cheyenne_gnu.clm-output_bgc_highfreq BASELINE ctsm1.0.dev108: DIFF + + + 0819-233327ch_int: 163 tests + FAIL DAE_N2_D_Lh12.f10_f10_musgs.I2000Clm50BgcCropGs.cheyenne_intel.clm-DA_multidrv BASELINE ctsm1.0.dev108: DIFF + FAIL ERI_D_Ld9.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERI_D_Ld9.ne30_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-vrtlay BASELINE ctsm1.0.dev108: DIFF + FAIL ERI_Ld9.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERI_Ld9.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-drydepnomegan BASELINE ctsm1.0.dev108: DIFF + FAIL ERI_Ld9.f45_g37.I2000Clm50BgcCruGs.cheyenne_intel.clm-nofire BASELINE ctsm1.0.dev108: DIFF + FAIL ERI_N2_Ld9.f19_g17.I2000Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D.f10_f10_musgs.IHistClm50Bgc.cheyenne_intel.clm-decStart BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld10_P36x2.f10_f10_musgs.IHistClm50BgcCrop.cheyenne_intel.clm-ciso_decStart BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld3_P36x2.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld5.C96_C96_mg17.IHistClm50BgcCrop.cheyenne_intel.clm-allActive BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld5.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-NoVSNoNI BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld5.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-rootlit BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld5.f10_f10_musgs.IHistClm50BgcCrop.cheyenne_intel.clm-allActive BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld5.f19_g17_gl4.I1850Clm50BgcCrop.cheyenne_intel.clm-glcMEC_changeFlags BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld5.f19_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld5.f19_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-fire_emis BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld9.f19_g17.I2000Clm50Cn.cheyenne_intel.clm-drydepnomegan BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld30.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-coldStart BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-cn_conly BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-flexCN_FUN BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-luna BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-noFUN_flexCN BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld5.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-irrig_spunup BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P36x2_Ld5.f10_f10_musgs.I2000Clm50BgcCropRtm.cheyenne_intel.clm-irrig_spunup BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld3.f09_g17.I1850Clm50BgcCropCru.cheyenne_intel.clm-ciso BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld5.f10_f10_musgs.I1850Clm50Bgc.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld5.f10_f10_musgs.I1850Clm50Bgc.cheyenne_intel.clm-drydepnomegan BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld5.f19_g17.I1850Clm50Bgc.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld5.f19_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ly3_P72x2.f10_f10_musgs.IHistClm50BgcCrop.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P180x2_D_Ld5.f19_g17_gl4.I1850Clm50BgcCropG.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P180x2_D_Ld5.f19_g17_gl4.I1850Clm50BgcCropG.cheyenne_intel.clm-glcMEC_increase BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P36x2_D_Ld5.f10_f10_musgs.I1850Clm50Bgc.cheyenne_intel.clm-ciso BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P36x2_D_Ld5.f10_f10_musgs.I2000Clm50Cn.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P36x2_D_Ld5.f10_f10_musgs.I2000Ctsm50NwpBgcCropGswpGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P36x2_Lm13.f10_f10_musgs.IHistClm50Bgc.cheyenne_intel.clm-monthly BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P72x2_Lm25.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-monthly BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P72x2_Lm36.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-clm50cropIrrigMonth_interp BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P72x2_Lm7.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-irrig_alternate_monthly BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_P72x2_Ly3.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-irrig_o3_reduceOutput BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_D.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-reseedresetsnow BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_D_Ld12.f10_f10_musgs.I1850Clm50BgcCropG.cheyenne_intel.clm-glcMEC_spunup_inc_dec_bgc BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_D_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_D_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-deepsoil_bedrock BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_D_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_D_Ld3.f19_g17_gl4.I1850Clm50BgcCrop.cheyenne_intel.clm-clm50dynroots BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_D_Ld5.f10_f10_musgs.I2000Clm50BgcCropRtm.cheyenne_intel.rtm-rtmOnFloodOnEffvelOn BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_D_Ld5.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_D_Ld5.f10_f10_musgs.IHistClm50BgcQianGs.cheyenne_intel.clm-ciso_bombspike1963DecStart BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_Ld3.f09_g17.I1850Clm50BgcCrop.cheyenne_intel.clm-rad_hrly_light_res_half BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_Lm54_Mmpi-serial.1x1_numaIA.I2000Clm50BgcCropQianRsGs.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_Ln9.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.IHistClm50SpGs.cheyenne_intel.clm-clm50cam6LndTuningMode_1979Start COMPARE_base_rest + FAIL ERS_Ly20_Mmpi-serial.1x1_numaIA.I2000Clm50BgcCropQianRsGs.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_Ly3.f10_f10_musgs.I1850Clm50BgcCropCmip6.cheyenne_intel.clm-basic BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_Ly3_P72x2.f10_f10_musgs.IHistClm50BgcCropG.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_Ly5_P144x1.f10_f10_musgs.IHistClm50BgcCrop.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF + FAIL LCISO_Lm13.f10_f10_musgs.IHistClm50BgcCrop.cheyenne_intel.clm-ciso_monthly BASELINE ctsm1.0.dev108: DIFF + FAIL LII2FINIDATAREAS_D_P360x2_Ld1.f09_g17.I1850Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL LII_D_Ld3.f19_g17_gl4.I2000Clm50BgcCrop.cheyenne_intel.clm-glcMEC_spunup_1way BASELINE ctsm1.0.dev108: DIFF + FAIL LVG_Ld5_D.f10_f10_musgs.I1850Clm50Bgc.cheyenne_intel.clm-no_vector_output BASELINE ctsm1.0.dev108: DIFF + FAIL PEM_D_Ld5.ne30_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL PET_P36x2_D.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D_Ld1.f09_g17.I1850Clm50BgcSpinup.cheyenne_intel.clm-cplhist BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D_Ld5_Vnuopc.f10_f10_musgs.I2000Clm50BgcCropGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D_Ld9.f09_g17_gl4.I1850Clm50BgcNoAnthro.cheyenne_intel.clm-decStart1851_noinitial BASELINE ctsm1.0.dev108: DIFF + FAIL SMS.f19_g17.I2000Clm50Cn.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ld1.f09_g17.I1850Clm50Bgc.cheyenne_intel.clm-drydepnomegan BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ld1.f09_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-af_bias_v7 BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ld2_D.f09_g17.I1850Clm50BgcCropCmip6.cheyenne_intel.clm-basic_interp BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ld5.f10_f10_musgs.ISSP585Clm50BgcCrop.cheyenne_intel.clm-ciso_dec2050Start BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ld5.f19_g17.IHistClm50Bgc.cheyenne_intel.clm-decStart BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Lm13.f19_g17.I2000Clm50BgcCrop.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Lm1_D.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-output_crop_highfreq BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Lm1_D.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-snowlayers_3_monthly BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Lm1.f19_g17_gl4.I1850Clm50Bgc.cheyenne_intel.clm-clm50dynroots BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Lm1.f19_g17.I1850Clm50BgcCropCmip6waccm.cheyenne_intel.clm-basic BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ln9.ne0ARCTICGRISne30x8_ne0ARCTICGRISne30x8_mt12.ISSP585Clm50BgcCrop.cheyenne_intel.clm-clm50cam6LndTuningMode BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ln9.ne30pg2_ne30pg2_mg17.I2000Clm50BgcCrop.cheyenne_intel.clm-clm50cam6LndTuningMode BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ly3_Mmpi-serial.1x1_numaIA.I2000Clm50BgcCropQianRsGs.cheyenne_intel.clm-clm50dynroots BASELINE ctsm1.0.dev108: DIFF + FAIL SOILSTRUCTUD_Ld5.f10_f10_musgs.I2000Clm50BgcCropGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL SSP_D_Ld10.f19_g17.I1850Clm50Bgc.cheyenne_intel.clm-rtmColdSSP BASELINE ctsm1.0.dev108: DIFF + FAIL SSP_D_Ld4.f09_g17.I1850Clm50BgcCrop.cheyenne_intel.clm-ciso_rtmColdSSP BASELINE ctsm1.0.dev108: DIFF + FAIL SSP_Ld10.f19_g17.I1850Clm50Bgc.cheyenne_intel.clm-rtmColdSSP BASELINE ctsm1.0.dev108: DIFF + + Answer changes appeared for the following tests on Izumi: + + FAIL SMS_D.f10_f10_musgs.I2000Clm50BgcCrop.izumi_gnu.clm-crop BASELINE ctsm1.0.dev108: DIFF + FAIL SMS.f10_f10_musgs.I2000Clm50BgcCrop.izumi_gnu.clm-crop BASELINE ctsm1.0.dev108: DIFF + FAIL PEM_Ld1.f10_f10_musgs.I2000Clm50BgcCropGs.izumi_intel.clm-crop BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D.f10_f10_musgs.I2000Clm50BgcCrop.izumi_intel.clm-crop BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D_Ld10.f10_f10_musgs.I2000Clm50BgcCropGs.izumi_intel.clm-tracer_consistency BASELINE ctsm1.0.dev108: DIFF + FAIL SMS.f10_f10_musgs.I2000Clm50BgcCrop.izumi_intel.clm-crop BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld5_P48x1.f10_f10_musgs.I1850Clm50Bgc.izumi_nag.clm-ciso BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_Ld5_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-reduceOutput BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_D_P48x1.f10_f10_musgs.IHistClm50Bgc.izumi_nag.clm-decStart BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld5_P48x1.f10_f10_musgs.I1850Clm50Bgc.izumi_nag.clm-ciso BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld5_P48x1.f10_f10_musgs.I1850Clm50Bgc.izumi_nag.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld5_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-flexCN_FUN BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld5_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-luna BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld5_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-noFUN_flexCN BASELINE ctsm1.0.dev108: DIFF + FAIL ERP_Ld5_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-reduceOutput BASELINE ctsm1.0.dev108: DIFF + FAIL ERS_Ly5_Mmpi-serial.1x1_numaIA.I2000Clm50BgcCropQianRsGs.izumi_nag.clm-monthly BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D_Ld1_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-af_bias_v7 BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D_Ld5.f10_f10_musgs.I2000Clm50BgcCrop.izumi_nag.clm-irrig_alternate BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D_P48x1_Ld5.f10_f10_musgs.I2000Clm50BgcCrop.izumi_nag.clm-irrig_spunup BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ld5_D_P48x1.f10_f10_musgs.IHistClm50Bgc.izumi_nag.clm-decStart BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_Ld5_D_P48x1.f10_f10_musgs.IHistClm50Bgc.izumi_nag.clm-monthly BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_P48x1_D_Ld5.f10_f10_musgs.I2000Clm50Cn.izumi_nag.clm-default BASELINE ctsm1.0.dev108: DIFF + FAIL SMS_D.f10_f10_musgs.I2000Clm50BgcCrop.izumi_pgi.clm-crop BASELINE ctsm1.0.dev108: DIFF + FAIL SMS.f10_f10_musgs.I2000Clm50BgcCrop.izumi_pgi.clm-crop BASELINE ctsm1.0.dev108: DIFF + + + + URL for LMWG diagnostics output used to validate new climate: ??? Detailed list of changes From 45d493df654e38ac356d4921798ea114f8ca2eb4 Mon Sep 17 00:00:00 2001 From: Negin Sobhani Date: Thu, 20 Aug 2020 14:30:25 -0600 Subject: [PATCH 551/556] update to changelog based on Bill's comments... --- doc/ChangeLog | 149 +------------------------------------------------- 1 file changed, 1 insertion(+), 148 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 2e0a8c1aa7..abc137a8fd 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -87,12 +87,11 @@ Answer changes Changes answers relative to baseline: YES - If a tag changes answers relative to baseline comparison the following should be filled in (otherwise remove this section): Summarize any changes to answers, i.e., - - what code configurations: ??? + - what code configurations: Clm50 with Bgc or Cn - what platforms/compilers: all - nature of change (roundoff; larger than roundoff/same climate; new climate): larger than roundoff/same climate??? @@ -104,152 +103,6 @@ Changes answers relative to baseline: YES climate (put details of the simulations in the experiment database) - casename: - Answer changes appeared for the following tests on Cheyenne: - 0819-233327ch_gnu: 46 tests - FAIL ERI_D_Ld9.f10_f10_musgs.I1850Clm50Bgc.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERI_D_Ld9.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERI_Ld9.f10_f10_musgs.I1850Clm50Bgc.cheyenne_gnu.clm-drydepnomegan BASELINE ctsm1.0.dev108: DIFF - FAIL ERI_Ld9.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D.f10_f10_musgs.IHistClm50Bgc.cheyenne_gnu.clm-decStart BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld3_P36x2.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld5.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-ciso_flexCN_FUN BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-snowveg_norad BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld5.f10_f10_musgs.I1850Clm50Bgc.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P36x2_D_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_gnu.clm-extra_outputs BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P36x2_D_Ld5.f10_f10_musgs.I2000Clm50Cn.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P36x2_Lm13.f10_f10_musgs.IHistClm50Bgc.cheyenne_gnu.clm-monthly BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_D_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_D_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_Lm40_Mmpi-serial.1x1_numaIA.I2000Clm50BgcCropQianRsGs.cheyenne_gnu.clm-monthly BASELINE ctsm1.0.dev108: DIFF - FAIL LWISO_Ld10.f10_f10_musgs.I2000Clm50BgcCropGs.cheyenne_gnu.clm-coldStart BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_gnu.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ld5.f10_f10_musgs.ISSP245Clm50BgcCrop.cheyenne_gnu.clm-ciso_dec2050Start BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ld5.f10_f10_musgs.ISSP370Clm50BgcCrop.cheyenne_gnu.clm-ciso_dec2050Start BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Lm1.f10_f10_musgs.I1850Clm50BgcCropCmip6waccm.cheyenne_gnu.clm-basic BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ly1_Mmpi-serial.1x1_brazil.IHistClm50BgcQianRsGs.cheyenne_gnu.clm-output_bgc_highfreq BASELINE ctsm1.0.dev108: DIFF - - - 0819-233327ch_int: 163 tests - FAIL DAE_N2_D_Lh12.f10_f10_musgs.I2000Clm50BgcCropGs.cheyenne_intel.clm-DA_multidrv BASELINE ctsm1.0.dev108: DIFF - FAIL ERI_D_Ld9.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERI_D_Ld9.ne30_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-vrtlay BASELINE ctsm1.0.dev108: DIFF - FAIL ERI_Ld9.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERI_Ld9.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-drydepnomegan BASELINE ctsm1.0.dev108: DIFF - FAIL ERI_Ld9.f45_g37.I2000Clm50BgcCruGs.cheyenne_intel.clm-nofire BASELINE ctsm1.0.dev108: DIFF - FAIL ERI_N2_Ld9.f19_g17.I2000Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D.f10_f10_musgs.IHistClm50Bgc.cheyenne_intel.clm-decStart BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld10_P36x2.f10_f10_musgs.IHistClm50BgcCrop.cheyenne_intel.clm-ciso_decStart BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld3_P36x2.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld5.C96_C96_mg17.IHistClm50BgcCrop.cheyenne_intel.clm-allActive BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld5.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-NoVSNoNI BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld5.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-rootlit BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld5.f10_f10_musgs.IHistClm50BgcCrop.cheyenne_intel.clm-allActive BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld5.f19_g17_gl4.I1850Clm50BgcCrop.cheyenne_intel.clm-glcMEC_changeFlags BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld5.f19_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld5.f19_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-fire_emis BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld9.f19_g17.I2000Clm50Cn.cheyenne_intel.clm-drydepnomegan BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld30.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-coldStart BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-cn_conly BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-flexCN_FUN BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-luna BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-noFUN_flexCN BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld5.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-irrig_spunup BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P36x2_Ld5.f10_f10_musgs.I2000Clm50BgcCropRtm.cheyenne_intel.clm-irrig_spunup BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld3.f09_g17.I1850Clm50BgcCropCru.cheyenne_intel.clm-ciso BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld5.f10_f10_musgs.I1850Clm50Bgc.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld5.f10_f10_musgs.I1850Clm50Bgc.cheyenne_intel.clm-drydepnomegan BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld5.f19_g17.I1850Clm50Bgc.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld5.f19_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ly3_P72x2.f10_f10_musgs.IHistClm50BgcCrop.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P180x2_D_Ld5.f19_g17_gl4.I1850Clm50BgcCropG.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P180x2_D_Ld5.f19_g17_gl4.I1850Clm50BgcCropG.cheyenne_intel.clm-glcMEC_increase BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P36x2_D_Ld5.f10_f10_musgs.I1850Clm50Bgc.cheyenne_intel.clm-ciso BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P36x2_D_Ld5.f10_f10_musgs.I2000Clm50Cn.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P36x2_D_Ld5.f10_f10_musgs.I2000Ctsm50NwpBgcCropGswpGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P36x2_Lm13.f10_f10_musgs.IHistClm50Bgc.cheyenne_intel.clm-monthly BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P72x2_Lm25.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-monthly BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P72x2_Lm36.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-clm50cropIrrigMonth_interp BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P72x2_Lm7.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-irrig_alternate_monthly BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_P72x2_Ly3.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-irrig_o3_reduceOutput BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_D.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-reseedresetsnow BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_D_Ld12.f10_f10_musgs.I1850Clm50BgcCropG.cheyenne_intel.clm-glcMEC_spunup_inc_dec_bgc BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_D_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_D_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-deepsoil_bedrock BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_D_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_D_Ld3.f19_g17_gl4.I1850Clm50BgcCrop.cheyenne_intel.clm-clm50dynroots BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_D_Ld5.f10_f10_musgs.I2000Clm50BgcCropRtm.cheyenne_intel.rtm-rtmOnFloodOnEffvelOn BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_D_Ld5.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_D_Ld5.f10_f10_musgs.IHistClm50BgcQianGs.cheyenne_intel.clm-ciso_bombspike1963DecStart BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_Ld3.f09_g17.I1850Clm50BgcCrop.cheyenne_intel.clm-rad_hrly_light_res_half BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_Lm54_Mmpi-serial.1x1_numaIA.I2000Clm50BgcCropQianRsGs.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_Ln9.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.IHistClm50SpGs.cheyenne_intel.clm-clm50cam6LndTuningMode_1979Start COMPARE_base_rest - FAIL ERS_Ly20_Mmpi-serial.1x1_numaIA.I2000Clm50BgcCropQianRsGs.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_Ly3.f10_f10_musgs.I1850Clm50BgcCropCmip6.cheyenne_intel.clm-basic BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_Ly3_P72x2.f10_f10_musgs.IHistClm50BgcCropG.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_Ly5_P144x1.f10_f10_musgs.IHistClm50BgcCrop.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF - FAIL LCISO_Lm13.f10_f10_musgs.IHistClm50BgcCrop.cheyenne_intel.clm-ciso_monthly BASELINE ctsm1.0.dev108: DIFF - FAIL LII2FINIDATAREAS_D_P360x2_Ld1.f09_g17.I1850Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL LII_D_Ld3.f19_g17_gl4.I2000Clm50BgcCrop.cheyenne_intel.clm-glcMEC_spunup_1way BASELINE ctsm1.0.dev108: DIFF - FAIL LVG_Ld5_D.f10_f10_musgs.I1850Clm50Bgc.cheyenne_intel.clm-no_vector_output BASELINE ctsm1.0.dev108: DIFF - FAIL PEM_D_Ld5.ne30_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL PET_P36x2_D.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D_Ld1.f09_g17.I1850Clm50BgcSpinup.cheyenne_intel.clm-cplhist BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D_Ld3.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D_Ld3.f10_f10_musgs.I2000Clm50BgcCruGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D_Ld5_Vnuopc.f10_f10_musgs.I2000Clm50BgcCropGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D_Ld9.f09_g17_gl4.I1850Clm50BgcNoAnthro.cheyenne_intel.clm-decStart1851_noinitial BASELINE ctsm1.0.dev108: DIFF - FAIL SMS.f19_g17.I2000Clm50Cn.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ld1.f09_g17.I1850Clm50Bgc.cheyenne_intel.clm-drydepnomegan BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ld1.f09_g17.I2000Clm50BgcCruGs.cheyenne_intel.clm-af_bias_v7 BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ld2_D.f09_g17.I1850Clm50BgcCropCmip6.cheyenne_intel.clm-basic_interp BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ld5.f10_f10_musgs.ISSP585Clm50BgcCrop.cheyenne_intel.clm-ciso_dec2050Start BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ld5.f19_g17.IHistClm50Bgc.cheyenne_intel.clm-decStart BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Lm13.f19_g17.I2000Clm50BgcCrop.cheyenne_intel.clm-cropMonthOutput BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Lm1_D.f10_f10_musgs.I1850Clm50BgcCrop.cheyenne_intel.clm-output_crop_highfreq BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Lm1_D.f10_f10_musgs.I2000Clm50BgcCrop.cheyenne_intel.clm-snowlayers_3_monthly BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Lm1.f19_g17_gl4.I1850Clm50Bgc.cheyenne_intel.clm-clm50dynroots BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Lm1.f19_g17.I1850Clm50BgcCropCmip6waccm.cheyenne_intel.clm-basic BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ln9.ne0ARCTICGRISne30x8_ne0ARCTICGRISne30x8_mt12.ISSP585Clm50BgcCrop.cheyenne_intel.clm-clm50cam6LndTuningMode BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ln9.ne30pg2_ne30pg2_mg17.I2000Clm50BgcCrop.cheyenne_intel.clm-clm50cam6LndTuningMode BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ly3_Mmpi-serial.1x1_numaIA.I2000Clm50BgcCropQianRsGs.cheyenne_intel.clm-clm50dynroots BASELINE ctsm1.0.dev108: DIFF - FAIL SOILSTRUCTUD_Ld5.f10_f10_musgs.I2000Clm50BgcCropGs.cheyenne_intel.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL SSP_D_Ld10.f19_g17.I1850Clm50Bgc.cheyenne_intel.clm-rtmColdSSP BASELINE ctsm1.0.dev108: DIFF - FAIL SSP_D_Ld4.f09_g17.I1850Clm50BgcCrop.cheyenne_intel.clm-ciso_rtmColdSSP BASELINE ctsm1.0.dev108: DIFF - FAIL SSP_Ld10.f19_g17.I1850Clm50Bgc.cheyenne_intel.clm-rtmColdSSP BASELINE ctsm1.0.dev108: DIFF - - Answer changes appeared for the following tests on Izumi: - - FAIL SMS_D.f10_f10_musgs.I2000Clm50BgcCrop.izumi_gnu.clm-crop BASELINE ctsm1.0.dev108: DIFF - FAIL SMS.f10_f10_musgs.I2000Clm50BgcCrop.izumi_gnu.clm-crop BASELINE ctsm1.0.dev108: DIFF - FAIL PEM_Ld1.f10_f10_musgs.I2000Clm50BgcCropGs.izumi_intel.clm-crop BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D.f10_f10_musgs.I2000Clm50BgcCrop.izumi_intel.clm-crop BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D_Ld10.f10_f10_musgs.I2000Clm50BgcCropGs.izumi_intel.clm-tracer_consistency BASELINE ctsm1.0.dev108: DIFF - FAIL SMS.f10_f10_musgs.I2000Clm50BgcCrop.izumi_intel.clm-crop BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld5_P48x1.f10_f10_musgs.I1850Clm50Bgc.izumi_nag.clm-ciso BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_Ld5_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-reduceOutput BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_D_P48x1.f10_f10_musgs.IHistClm50Bgc.izumi_nag.clm-decStart BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld5_P48x1.f10_f10_musgs.I1850Clm50Bgc.izumi_nag.clm-ciso BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld5_P48x1.f10_f10_musgs.I1850Clm50Bgc.izumi_nag.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld5_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-flexCN_FUN BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld5_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-luna BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld5_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-noFUN_flexCN BASELINE ctsm1.0.dev108: DIFF - FAIL ERP_Ld5_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-reduceOutput BASELINE ctsm1.0.dev108: DIFF - FAIL ERS_Ly5_Mmpi-serial.1x1_numaIA.I2000Clm50BgcCropQianRsGs.izumi_nag.clm-monthly BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D_Ld1_P48x1.f10_f10_musgs.I2000Clm50BgcCruGs.izumi_nag.clm-af_bias_v7 BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D_Ld5.f10_f10_musgs.I2000Clm50BgcCrop.izumi_nag.clm-irrig_alternate BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D_P48x1_Ld5.f10_f10_musgs.I2000Clm50BgcCrop.izumi_nag.clm-irrig_spunup BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ld5_D_P48x1.f10_f10_musgs.IHistClm50Bgc.izumi_nag.clm-decStart BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_Ld5_D_P48x1.f10_f10_musgs.IHistClm50Bgc.izumi_nag.clm-monthly BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_P48x1_D_Ld5.f10_f10_musgs.I2000Clm50Cn.izumi_nag.clm-default BASELINE ctsm1.0.dev108: DIFF - FAIL SMS_D.f10_f10_musgs.I2000Clm50BgcCrop.izumi_pgi.clm-crop BASELINE ctsm1.0.dev108: DIFF - FAIL SMS.f10_f10_musgs.I2000Clm50BgcCrop.izumi_pgi.clm-crop BASELINE ctsm1.0.dev108: DIFF - - URL for LMWG diagnostics output used to validate new climate: ??? From 11f607591f02d1920d06f5f7ac1ab98bdb99a275 Mon Sep 17 00:00:00 2001 From: Negin Sobhani Date: Thu, 20 Aug 2020 14:59:40 -0600 Subject: [PATCH 552/556] adding expected fail #1117 to the expectedtestfails file. --- cime_config/testdefs/ExpectedTestFails.xml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 938b10be53..08527c0788 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -123,4 +123,11 @@ + + + FAIL + CTSM/#1117 + + + From 8f9591237974ad8ca34517b5c06ece27578d743c Mon Sep 17 00:00:00 2001 From: Negin Sobhani Date: Thu, 20 Aug 2020 15:06:15 -0600 Subject: [PATCH 553/556] updating ChangeLog based on Erik's comments. --- doc/ChangeLog | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index abc137a8fd..1bafc5b7b5 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -94,17 +94,20 @@ Changes answers relative to baseline: YES - what code configurations: Clm50 with Bgc or Cn - what platforms/compilers: all - nature of change (roundoff; larger than roundoff/same climate; new - climate): larger than roundoff/same climate??? + climate): larger than roundoff/same climate If bitwise differences were observed, how did you show they were no worse than roundoff? If this tag changes climate describe the run(s) done to evaluate the new climate (put details of the simulations in the experiment database) - - casename: + + Will Wieder thought the changes were small enough that we didn't need to do + a long simulation. Erik Kluzek thinks the changes were verified with single + point simulations. - URL for LMWG diagnostics output used to validate new climate: ??? + URL for LMWG diagnostics output used to validate new climate: Detailed list of changes From 14bc28946ba5e9e00e19dc8fd58a4930a7424e30 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 20 Aug 2020 15:40:57 -0600 Subject: [PATCH 554/556] Move expected failure to correct location --- cime_config/testdefs/ExpectedTestFails.xml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 08527c0788..362265479c 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -37,6 +37,13 @@ + + + FAIL + #1117 + + + @@ -123,11 +130,4 @@ - - - FAIL - CTSM/#1117 - - - From 70c0f2929bfc14baf61be29177f1220a382a6e59 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 21 Aug 2020 10:47:05 -0600 Subject: [PATCH 555/556] Remove test from expected fails list that is no longer in the test suite It looks like the test ERS_Lm20_Mmpi-serial.1x1_smallvilleIA.I2000Clm50BgcCropQianGs.cheyenne_gnu.clm-monthly has been replaced by ERS_Lm20_Mmpi-serial.1x1_smallvilleIA.I2000Clm50BgcCropQianRsGs.cheyenne_gnu.clm-monthly_noinitial, which is now passing. --- cime_config/testdefs/ExpectedTestFails.xml | 7 ------- 1 file changed, 7 deletions(-) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 362265479c..55bab4c483 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -30,13 +30,6 @@ - - - FAIL - #203 - - - FAIL From 552f131d48dc08329d018cc45037fa1ba4bc1558 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 21 Aug 2020 10:58:40 -0600 Subject: [PATCH 556/556] Update ChangeLog --- doc/ChangeLog | 115 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 116 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 1bafc5b7b5..18ec683d77 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,119 @@ =============================================================== +Tag name: ctsm1.0.dev110 +Originator(s): jedwards (Jim Edwards) +Date: Fri Aug 21 10:49:08 MDT 2020 +One-line Summary: Fixes needed for PIO2 + +Purpose of changes +------------------ + +Fixes needed for CTSM to work with PIO2. There is an additional fix +needed in PIO2 itself; this is available in a later version of cime that +we will bring in soon. + +Note that this PR also includes a change in config_files.xml that is +needed for a newer version of cime when running compsets with dlnd, slnd +or xlnd; this may be incompatible with the current version of the cime +external, but this does not impact compsets with CTSM. + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): +The changes in this tag, together with a cime update that will be coming +in soon, resolve the following issues (I'm not sure off-hand which +issues are resolved by the changes here alone and which ones require the +cime update): +- Resolves ESCOMP/CTSM#1029 (FATES tests fail with PIO2) +- Resolves ESCOMP/CTSM#1030 (mpi-serial nag case fails with pio2 when + defining h1 history restart file) + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): +- May not be able to run configurations with dlnd, slnd or xlnd from this tag + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): none + +Changes made to namelist defaults (e.g., changed parameter values): none + +Changes to the datasets (e.g., parameter, surface or initial files): none + +Substantial timing or memory changes: Not investigated, but almost definitely not + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): none + +Changes to tests or testing: none + +Code reviewed by: Bill Sacks + + +CTSM testing: + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - not run + + tools-tests (test/tools): + + cheyenne - not run + + PTCLM testing (tools/shared/PTCLM/test): + + cheyenne - not run + + python testing (see instructions in python/README.md; document testing done): + + (any machine) - not run + + regular tests (aux_clm): + + cheyenne ---- PASS + izumi ------- PASS + + Note: Standard testing was done using PIO1 (as this is still the + default), but separate testing was also done using PIO2 (using an + updated cime) and tests were found to pass. + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: NO + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): none + +Pull Requests that document the changes (include PR ids): +https://github.com/ESCOMP/CTSM/pull/1095 + +=============================================================== +=============================================================== Tag name: ctsm1.0.dev109 Originator(s): negins (Negin Sobhani,UCAR/TSS,303-497-1224) Date: Thu Aug 20 11:40:07 MDT 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index 9073311c62..c217c6f13c 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm1.0.dev110 jedwards 08/21/2020 Fixes needed for PIO2 ctsm1.0.dev109 negins 08/20/2020 Allow for resorbtion in transition from live to dead wood N ctsm1.0.dev108 erik 08/19/2020 Update default PE layouts for new SE/FV3 grids ctsm1.0.dev107 erik 08/10/2020 Answer changes needed for CESM2.2.0