Skip to content

Commit 36635bd

Browse files
jedwards4bjedwards4b
authored
Merge pull request #290 from NickSzapiro-NOAA/escomp_dice_cplhist
Create cplhist mode for dice
2 parents 4c50216 + 3eba3ea commit 36635bd

7 files changed

+308
-20
lines changed

‎dice/CMakeLists.txt

+1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
project(dice Fortran)
22
set(SRCFILES ice_comp_nuopc.F90
33
dice_datamode_ssmi_mod.F90
4+
dice_datamode_cplhist_mod.F90
45
dice_flux_atmice_mod.F90)
56

67
foreach(FILE ${SRCFILES})

‎dice/dice_datamode_cplhist_mod.F90

+202
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,202 @@
1+
module dice_datamode_cplhist_mod
2+
3+
use ESMF , only : ESMF_State, ESMF_LOGMSG_INFO, ESMF_LogWrite, ESMF_SUCCESS
4+
use NUOPC , only : NUOPC_Advertise
5+
use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs
6+
use shr_const_mod , only : shr_const_TkFrzsw
7+
use shr_sys_mod , only : shr_sys_abort
8+
use dshr_methods_mod , only : dshr_state_getfldptr, dshr_fldbun_getfldptr, chkerr
9+
use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add
10+
use dshr_mod , only : dshr_restart_read, dshr_restart_write
11+
use dshr_strdata_mod , only : shr_strdata_type
12+
13+
implicit none
14+
private ! except
15+
16+
public :: dice_datamode_cplhist_advertise
17+
public :: dice_datamode_cplhist_init_pointers
18+
public :: dice_datamode_cplhist_advance
19+
public :: dice_datamode_cplhist_restart_read
20+
public :: dice_datamode_cplhist_restart_write
21+
22+
! export fields
23+
! ice to atm in CMEPS/mediator/esmFldsExchange_ufs_mod.F90
24+
real(r8), pointer :: Si_ifrac(:) => null()
25+
real(r8), pointer :: Si_imask(:) => null()
26+
real(r8), pointer :: Faii_taux(:) => null()
27+
real(r8), pointer :: Faii_tauy(:) => null()
28+
real(r8), pointer :: Faii_lat(:) => null()
29+
real(r8), pointer :: Faii_sen(:) => null()
30+
real(r8), pointer :: Faii_lwup(:) => null()
31+
real(r8), pointer :: Faii_evap(:) => null()
32+
real(r8), pointer :: Si_vice(:) => null()
33+
real(r8), pointer :: Si_vsno(:) => null()
34+
real(r8), pointer :: Si_t(:) => null()
35+
real(r8), pointer :: Si_avsdr(:) => null()
36+
real(r8), pointer :: Si_avsdf(:) => null()
37+
real(r8), pointer :: Si_anidr(:) => null()
38+
real(r8), pointer :: Si_anidf(:) => null()
39+
40+
character(*) , parameter :: u_FILE_u = &
41+
__FILE__
42+
43+
!===============================================================================
44+
contains
45+
!===============================================================================
46+
47+
subroutine dice_datamode_cplhist_advertise(exportState, fldsexport, flds_scalar_name, rc)
48+
49+
! input/output variables
50+
type(esmf_State) , intent(inout) :: exportState
51+
type(fldlist_type) , pointer :: fldsexport
52+
character(len=*) , intent(in) :: flds_scalar_name
53+
integer , intent(out) :: rc
54+
55+
! local variables
56+
type(fldlist_type), pointer :: fldList
57+
!-------------------------------------------------------------------------------
58+
59+
rc = ESMF_SUCCESS
60+
61+
! Advertise export fields
62+
call dshr_fldList_add(fldsExport, trim(flds_scalar_name))
63+
call dshr_fldList_add(fldsExport, 'Si_ifrac' )
64+
call dshr_fldList_add(fldsExport, 'Si_imask' )
65+
call dshr_fldList_add(fldsExport, 'Faii_taux' )
66+
call dshr_fldList_add(fldsExport, 'Faii_tauy' )
67+
call dshr_fldList_add(fldsExport, 'Faii_lat' )
68+
call dshr_fldList_add(fldsExport, 'Faii_sen' )
69+
call dshr_fldList_add(fldsExport, 'Faii_lwup' )
70+
call dshr_fldList_add(fldsExport, 'Faii_evap' )
71+
call dshr_fldList_add(fldsExport, 'Si_vice' )
72+
call dshr_fldList_add(fldsExport, 'Si_vsno' )
73+
call dshr_fldList_add(fldsExport, 'Si_t' )
74+
call dshr_fldList_add(fldsExport, 'Si_avsdr' )
75+
call dshr_fldList_add(fldsExport, 'Si_avsdf' )
76+
call dshr_fldList_add(fldsExport, 'Si_anidr' )
77+
call dshr_fldList_add(fldsExport, 'Si_anidf' )
78+
79+
fldlist => fldsExport ! the head of the linked list
80+
do while (associated(fldlist))
81+
call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc)
82+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
83+
call ESMF_LogWrite('(dice_comp_advertise): Fr_ice'//trim(fldList%stdname), ESMF_LOGMSG_INFO)
84+
fldList => fldList%next
85+
enddo
86+
87+
end subroutine dice_datamode_cplhist_advertise
88+
89+
!===============================================================================
90+
subroutine dice_datamode_cplhist_init_pointers(importState, exportState,sdat,rc)
91+
92+
! input/output variables
93+
type(ESMF_State) , intent(inout) :: importState
94+
type(ESMF_State) , intent(inout) :: exportState
95+
type(shr_strdata_type) , intent(in) :: sdat
96+
integer , intent(out) :: rc
97+
98+
! local variables
99+
character(len=*), parameter :: subname='(dice_init_pointers): '
100+
!-------------------------------------------------------------------------------
101+
102+
rc = ESMF_SUCCESS
103+
104+
! initialize pointers to export fields
105+
call dshr_state_getfldptr(exportState, 'Si_ifrac' , fldptr1=Si_ifrac , rc=rc)
106+
if (chkerr(rc,__LINE__,u_FILE_u)) return
107+
call dshr_state_getfldptr(exportState, 'Si_imask' , fldptr1=Si_imask , rc=rc)
108+
if (chkerr(rc,__LINE__,u_FILE_u)) return
109+
call dshr_state_getfldptr(exportState, 'Faii_taux' , fldptr1=Faii_taux , allowNullReturn=.true., rc=rc)
110+
if (chkerr(rc,__LINE__,u_FILE_u)) return
111+
call dshr_state_getfldptr(exportState, 'Faii_tauy' , fldptr1=Faii_tauy , allowNullReturn=.true., rc=rc)
112+
if (chkerr(rc,__LINE__,u_FILE_u)) return
113+
call dshr_state_getfldptr(exportState, 'Faii_lat' , fldptr1=Faii_lat , allowNullReturn=.true., rc=rc)
114+
if (chkerr(rc,__LINE__,u_FILE_u)) return
115+
call dshr_state_getfldptr(exportState, 'Faii_sen', fldptr1=Faii_sen, allowNullReturn=.true., rc=rc)
116+
if (chkerr(rc,__LINE__,u_FILE_u)) return
117+
call dshr_state_getfldptr(exportState, 'Faii_lwup', fldptr1=Faii_lwup, allowNullReturn=.true., rc=rc)
118+
if (chkerr(rc,__LINE__,u_FILE_u)) return
119+
call dshr_state_getfldptr(exportState, 'Faii_evap', fldptr1=Faii_evap, allowNullReturn=.true., rc=rc)
120+
if (chkerr(rc,__LINE__,u_FILE_u)) return
121+
call dshr_state_getfldptr(exportState, 'Si_vice', fldptr1=Si_vice, allowNullReturn=.true., rc=rc)
122+
if (chkerr(rc,__LINE__,u_FILE_u)) return
123+
call dshr_state_getfldptr(exportState, 'Si_vsno', fldptr1=Si_vsno, allowNullReturn=.true., rc=rc)
124+
if (chkerr(rc,__LINE__,u_FILE_u)) return
125+
call dshr_state_getfldptr(exportState, 'Si_t', fldptr1=Si_t, allowNullReturn=.true., rc=rc)
126+
if (chkerr(rc,__LINE__,u_FILE_u)) return
127+
call dshr_state_getfldptr(exportState, 'Si_avsdr', fldptr1=Si_avsdr, allowNullReturn=.true., rc=rc)
128+
if (chkerr(rc,__LINE__,u_FILE_u)) return
129+
call dshr_state_getfldptr(exportState, 'Si_avsdf', fldptr1=Si_avsdf, allowNullReturn=.true., rc=rc)
130+
if (chkerr(rc,__LINE__,u_FILE_u)) return
131+
call dshr_state_getfldptr(exportState, 'Si_anidr', fldptr1=Si_anidr, allowNullReturn=.true., rc=rc)
132+
if (chkerr(rc,__LINE__,u_FILE_u)) return
133+
call dshr_state_getfldptr(exportState, 'Si_anidf', fldptr1=Si_anidf, allowNullReturn=.true., rc=rc)
134+
if (chkerr(rc,__LINE__,u_FILE_u)) return
135+
136+
!Initialize (e.g., =0)?
137+
138+
end subroutine dice_datamode_cplhist_init_pointers
139+
140+
!===============================================================================
141+
subroutine dice_datamode_cplhist_advance(rc)
142+
143+
! input/output variables
144+
integer, intent(out) :: rc
145+
146+
! local variables
147+
character(len=*), parameter :: subname='(dice_datamode_cplhist_advance): '
148+
!-------------------------------------------------------------------------------
149+
150+
rc = ESMF_SUCCESS
151+
152+
!Unit conversions, calculations,....
153+
!Where aice=0, Si_t=0K (as missing value). Interpolation in time between ice that comes or goes then has issues
154+
where(Si_t .LT. 10) Si_t = shr_const_TkFrzsw
155+
156+
end subroutine dice_datamode_cplhist_advance
157+
158+
!===============================================================================
159+
subroutine dice_datamode_cplhist_restart_write(rpfile, case_name, inst_suffix, ymd, tod, &
160+
logunit, my_task, sdat)
161+
162+
! input/output variables
163+
character(len=*) , intent(in) :: rpfile
164+
character(len=*) , intent(in) :: case_name
165+
character(len=*) , intent(in) :: inst_suffix
166+
integer , intent(in) :: ymd ! model date
167+
integer , intent(in) :: tod ! model sec into model date
168+
integer , intent(in) :: logunit
169+
integer , intent(in) :: my_task
170+
type(shr_strdata_type) , intent(inout) :: sdat
171+
172+
! local variables
173+
integer :: rc
174+
!-------------------------------------------------------------------------------
175+
176+
call dshr_restart_write(rpfile, case_name, 'dice', inst_suffix, ymd, tod, &
177+
logunit, my_task, sdat, rc)
178+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
179+
180+
end subroutine dice_datamode_cplhist_restart_write
181+
182+
!===============================================================================
183+
subroutine dice_datamode_cplhist_restart_read(rest_filem, rpfile, logunit, my_task, mpicom, sdat)
184+
185+
! input/output arguments
186+
character(len=*) , intent(inout) :: rest_filem
187+
character(len=*) , intent(inout) :: rpfile
188+
integer , intent(in) :: logunit
189+
integer , intent(in) :: my_task
190+
integer , intent(in) :: mpicom
191+
type(shr_strdata_type) , intent(inout) :: sdat
192+
193+
! local variables
194+
integer :: rc
195+
!-------------------------------------------------------------------------------
196+
197+
call dshr_restart_read(rest_filem, rpfile, logunit, my_task, mpicom, sdat, rc)
198+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
199+
200+
end subroutine dice_datamode_cplhist_restart_read
201+
202+
end module dice_datamode_cplhist_mod

‎dice/dice_datamode_ssmi_mod.F90

+1-2
Original file line numberDiff line numberDiff line change
@@ -586,10 +586,9 @@ subroutine dice_datamode_ssmi_restart_write(rpfile, case_name, inst_suffix, ymd,
586586
end subroutine dice_datamode_ssmi_restart_write
587587

588588
!===============================================================================
589-
subroutine dice_datamode_ssmi_restart_read(gcomp, rest_filem, rpfile, logunit, my_task, mpicom, sdat)
589+
subroutine dice_datamode_ssmi_restart_read(rest_filem, rpfile, logunit, my_task, mpicom, sdat)
590590

591591
! input/output arguments
592-
type(ESMF_GridComp) , intent(in) :: gcomp
593592
character(len=*) , intent(inout) :: rest_filem
594593
character(len=*) , intent(in) :: rpfile
595594
integer , intent(in) :: logunit

‎dice/ice_comp_nuopc.F90

+79-11
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ module cdeps_dice_comp
1616
use ESMF , only : ESMF_AlarmIsRinging, ESMF_METHOD_INITIALIZE
1717
use ESMF , only : ESMF_ClockGet, ESMF_TimeGet, ESMF_MethodRemove, ESMF_MethodAdd
1818
use ESMF , only : ESMF_GridCompSetEntryPoint, operator(+), ESMF_AlarmRingerOff
19-
use ESMF , only : ESMF_ClockGetAlarm, ESMF_StateGet, ESMF_Field, ESMF_FieldGet
19+
use ESMF , only : ESMF_ClockGetAlarm, ESMF_StateGet, ESMF_Field, ESMF_FieldGet, ESMF_MAXSTR
2020
use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize
2121
use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise
2222
use NUOPC_Model , only : model_routine_SS => SetServices
@@ -40,6 +40,12 @@ module cdeps_dice_comp
4040
use dice_datamode_ssmi_mod , only : dice_datamode_ssmi_advance
4141
use dice_datamode_ssmi_mod , only : dice_datamode_ssmi_restart_read
4242
use dice_datamode_ssmi_mod , only : dice_datamode_ssmi_restart_write
43+
!
44+
use dice_datamode_cplhist_mod , only : dice_datamode_cplhist_advertise
45+
use dice_datamode_cplhist_mod , only : dice_datamode_cplhist_init_pointers
46+
use dice_datamode_cplhist_mod , only : dice_datamode_cplhist_advance
47+
use dice_datamode_cplhist_mod , only : dice_datamode_cplhist_restart_read
48+
use dice_datamode_cplhist_mod , only : dice_datamode_cplhist_restart_write
4349

4450
implicit none
4551
private ! except
@@ -265,23 +271,29 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
265271
flux_Qacc0 = rbcasttmp(3)
266272

267273
! Validate datamode
268-
if ( trim(datamode) == 'ssmi' .or. trim(datamode) == 'ssmi_iaf') then
274+
if ( trim(datamode) == 'ssmi' .or. trim(datamode) == 'ssmi_iaf' .or. trim(datamode) == 'cplhist') then
269275
if (my_task == main_task) write(logunit,*) ' dice datamode = ',trim(datamode)
270276
else
271277
call shr_log_error(' ERROR illegal dice datamode = '//trim(datamode), rc=rc)
272278
return
273279
endif
274280

275281
! Advertise import and export fields
276-
call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc)
277-
if (ChkErr(rc,__LINE__,u_FILE_u)) return
278-
read(cvalue,*) flds_i2o_per_cat ! module variable
282+
if ( trim(datamode) == 'ssmi' .or. trim(datamode) == 'ssmi_iaf') then
283+
call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc)
284+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
285+
read(cvalue,*) flds_i2o_per_cat ! module variable
286+
endif
279287

288+
!datamode already validated
280289
select case (trim(datamode))
281-
case('ssmi', 'ssmi_iaf')
290+
case('ssmi','ssmi_iaf')
282291
call dice_datamode_ssmi_advertise(importState, exportState, fldsimport, fldsexport, &
283292
flds_scalar_name, flds_i2o_per_cat, rc)
284293
if (ChkErr(rc,__LINE__,u_FILE_u)) return
294+
case('cplhist')
295+
call dice_datamode_cplhist_advertise(exportState, fldsexport, flds_scalar_name, rc)
296+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
285297
end select
286298

287299
end subroutine InitializeAdvertise
@@ -491,16 +503,25 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod
491503

492504
if (first_time) then
493505

494-
! Initialize dfields with export state data that has corresponding stream field
495-
call dshr_dfield_add(dfields, sdat, state_fld='Si_ifrac', strm_fld='Si_ifrac', &
506+
! Initialize dfields with export state data that has corresponding stream fieldi
507+
select case (trim(datamode))
508+
case('ssmi','ssmi_iaf')
509+
call dshr_dfield_add(dfields, sdat, state_fld='Si_ifrac', strm_fld='Si_ifrac', &
496510
state=exportState, logunit=logunit, mainproc=mainproc, rc=rc)
497-
if (chkerr(rc,__LINE__,u_FILE_u)) return
511+
if (chkerr(rc,__LINE__,u_FILE_u)) return
512+
case('cplhist')
513+
call dice_init_dfields(importState, exportState, rc)
514+
if (chkerr(rc,__LINE__,u_FILE_u)) return
515+
end select
498516

499517
! Initialize datamode module ponters
500518
select case (trim(datamode))
501519
case('ssmi', 'ssmi_iaf')
502520
call dice_datamode_ssmi_init_pointers(importState, exportState, sdat, flds_i2o_per_cat, rc)
503521
if (chkerr(rc,__LINE__,u_FILE_u)) return
522+
case('cplhist')
523+
call dice_datamode_cplhist_init_pointers(importState,exportState,sdat,rc)
524+
if (chkerr(rc,__LINE__,u_FILE_u)) return
504525
end select
505526

506527
! read restart if needed
@@ -509,7 +530,9 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod
509530
if (ChkErr(rc,__LINE__,u_FILE_u)) return
510531
select case (trim(datamode))
511532
case('ssmi', 'ssmi_iaf')
512-
call dice_datamode_ssmi_restart_read(gcomp, restfilm, rpfile, logunit, my_task, mpicom, sdat)
533+
call dice_datamode_ssmi_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat)
534+
case('cplhist')
535+
call dice_datamode_cplhist_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat)
513536
end select
514537
end if
515538

@@ -550,6 +573,9 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod
550573
call dice_datamode_ssmi_advance(exportState, importState, cosarg, flds_i2o_per_cat, &
551574
flux_swpf, flux_Qmin, flux_Qacc, flux_Qacc0, dt, logunit, restart_read, rc)
552575
if (ChkErr(rc,__LINE__,u_FILE_u)) return
576+
case ('cplhist')
577+
call dice_datamode_cplhist_advance(rc)
578+
if (ChkErr(rc,__LINE__,u_FILE_u)) return
553579
end select
554580

555581
! Write restarts if needed
@@ -560,7 +586,9 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod
560586
case('ssmi', 'ssmi_iaf')
561587
call dice_datamode_ssmi_restart_write(rpfile, case_name, inst_suffix, target_ymd, target_tod, &
562588
logunit, my_task, sdat)
563-
if (ChkErr(rc,__LINE__,u_FILE_u)) return
589+
case ('cplhist')
590+
call dice_datamode_cplhist_restart_write(rpfile, case_name, inst_suffix, target_ymd, target_tod, &
591+
logunit, my_task, sdat)
564592
end select
565593
end if
566594

@@ -573,6 +601,46 @@ subroutine dice_comp_run(gcomp, importstate, exportstate, target_ymd, target_tod
573601
call ESMF_TraceRegionExit('dice_datamode')
574602
call ESMF_TraceRegionExit('DICE_RUN')
575603

604+
contains
605+
subroutine dice_init_dfields(importState, exportState, rc)
606+
! -----------------------------
607+
! Initialize dfields arrays
608+
! -----------------------------
609+
610+
! input/output variables
611+
type(ESMF_State) , intent(inout) :: importState
612+
type(ESMF_State) , intent(inout) :: exportState
613+
integer , intent(out) :: rc
614+
615+
! local variables
616+
integer :: n
617+
integer :: fieldcount
618+
type(ESMF_Field) :: lfield
619+
character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:)
620+
character(*), parameter :: subName = "(dice_init_dfields) "
621+
!-------------------------------------------------------------------------------
622+
623+
rc = ESMF_SUCCESS
624+
625+
! Initialize dfields data type (to map streams to export state fields)
626+
! Create dfields linked list - used for copying stream fields to export
627+
! state fields
628+
call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc)
629+
if (chkerr(rc,__LINE__,u_FILE_u)) return
630+
allocate(lfieldnamelist(fieldCount))
631+
call ESMF_StateGet(exportState, itemNameList=lfieldnamelist, rc=rc)
632+
if (chkerr(rc,__LINE__,u_FILE_u)) return
633+
do n = 1, fieldCount
634+
call ESMF_StateGet(exportState, itemName=trim(lfieldNameList(n)), field=lfield, rc=rc)
635+
if (chkerr(rc,__LINE__,u_FILE_u)) return
636+
if (trim(lfieldnamelist(n)) /= flds_scalar_name) then
637+
call dshr_dfield_add( dfields, sdat, trim(lfieldnamelist(n)), trim(lfieldnamelist(n)), exportState, &
638+
logunit, mainproc, rc)
639+
if (chkerr(rc,__LINE__,u_FILE_u)) return
640+
end if
641+
end do
642+
end subroutine dice_init_dfields
643+
576644
end subroutine dice_comp_run
577645

578646
!===============================================================================

‎doc/source/dice.rst

+3
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,9 @@ ssmi (``dice_datamode_ssmi_mod.F90``)
2727
ssmi_iaf (``dice_datamode_ssmi_mod.F90``)
2828
- `ssmi_iaf` is the interannually varying version of `ssmi`.
2929

30+
cplhist (``dice_datamode_cplhist_mod.F90``)
31+
- It provides mediator history variables from ice component of previous simulation.
32+
3033
.. _dice-cime-vars:
3134

3235
---------------------------------------

0 commit comments

Comments
 (0)