|
| 1 | +module med_field_info_mod |
| 2 | + |
| 3 | + !----------------------------------------------------------------------------- |
| 4 | + ! Defines a type and related operations for storing metadata about fields that can be |
| 5 | + ! used to create an ESMF FieldBundle. |
| 6 | + !----------------------------------------------------------------------------- |
| 7 | + |
| 8 | + use ESMF , only : ESMF_MAXSTR, ESMF_SUCCESS |
| 9 | + use ESMF , only : ESMF_Field, ESMF_State, ESMF_AttributeGet, ESMF_StateGet |
| 10 | + use med_utils_mod , only : ChkErr => med_utils_ChkErr |
| 11 | + use shr_log_mod , only : shr_log_error |
| 12 | + use wtracers_mod , only : wtracers_is_wtracer_field |
| 13 | + |
| 14 | + implicit none |
| 15 | + private |
| 16 | + |
| 17 | + !----------------------------------------------- |
| 18 | + ! Public methods |
| 19 | + !----------------------------------------------- |
| 20 | + |
| 21 | + ! Create a single field |
| 22 | + public :: med_field_info_create |
| 23 | + |
| 24 | + ! Create an array of field_info objects based on an array of names, where water tracers |
| 25 | + ! are treated specially (being given an ungridded dimension) |
| 26 | + public :: med_field_info_array_from_names_wtracers |
| 27 | + |
| 28 | + ! Create an array of field_info objects based on the fields in an ESMF State |
| 29 | + public :: med_field_info_array_from_state |
| 30 | + |
| 31 | + !----------------------------------------------- |
| 32 | + ! Types |
| 33 | + !----------------------------------------------- |
| 34 | + |
| 35 | + type, public :: med_field_info_type |
| 36 | + character(ESMF_MAXSTR) :: name |
| 37 | + integer :: n_ungridded ! number of ungridded dimensions |
| 38 | + |
| 39 | + ! These arrays will be allocated to be of size ungridded_count |
| 40 | + integer, allocatable :: ungridded_lbound(:) |
| 41 | + integer, allocatable :: ungridded_ubound(:) |
| 42 | + end type med_field_info_type |
| 43 | + |
| 44 | + character(len=*),parameter :: u_FILE_u = & |
| 45 | + __FILE__ |
| 46 | + |
| 47 | +!================================================================================ |
| 48 | +contains |
| 49 | +!================================================================================ |
| 50 | + |
| 51 | + function med_field_info_create(name, ungridded_lbound, ungridded_ubound, rc) result(field_info) |
| 52 | + ! Create a single field |
| 53 | + |
| 54 | + ! input/output variables |
| 55 | + character(len=*), intent(in) :: name |
| 56 | + |
| 57 | + ! ungridded_lbound and ungridded_ubound must either both be present or both be absent; |
| 58 | + ! if present, they must be the same size |
| 59 | + integer, intent(in), optional :: ungridded_lbound(:) |
| 60 | + integer, intent(in), optional :: ungridded_ubound(:) |
| 61 | + |
| 62 | + integer, intent(out) :: rc |
| 63 | + type(med_field_info_type) :: field_info ! function result |
| 64 | + |
| 65 | + ! local variables |
| 66 | + integer :: n_ungridded |
| 67 | + character(len=*), parameter :: subname = '(med_field_info_create)' |
| 68 | + ! ---------------------------------------------- |
| 69 | + |
| 70 | + rc = ESMF_SUCCESS |
| 71 | + |
| 72 | + if (present(ungridded_lbound) .neqv. present(ungridded_ubound)) then |
| 73 | + call shr_log_error( & |
| 74 | + subname//": ERROR: ungridded_lbound and ungridded_ubound must both be present or both absent.", & |
| 75 | + line=__LINE__, file=u_FILE_u, rc=rc) |
| 76 | + return |
| 77 | + end if |
| 78 | + |
| 79 | + field_info%name = name |
| 80 | + |
| 81 | + if (present(ungridded_lbound)) then |
| 82 | + n_ungridded = size(ungridded_lbound) |
| 83 | + if (size(ungridded_ubound) /= n_ungridded) then |
| 84 | + call shr_log_error( & |
| 85 | + subname//": ERROR: ungridded_lbound and ungridded_ubound must have the same size.", & |
| 86 | + line=__LINE__, file=u_FILE_u, rc=rc) |
| 87 | + return |
| 88 | + end if |
| 89 | + field_info%n_ungridded = n_ungridded |
| 90 | + allocate(field_info%ungridded_lbound(n_ungridded)) |
| 91 | + allocate(field_info%ungridded_ubound(n_ungridded)) |
| 92 | + field_info%ungridded_lbound = ungridded_lbound |
| 93 | + field_info%ungridded_ubound = ungridded_ubound |
| 94 | + else |
| 95 | + field_info%n_ungridded = 0 |
| 96 | + end if |
| 97 | + |
| 98 | + end function med_field_info_create |
| 99 | + |
| 100 | + !----------------------------------------------------------------------------- |
| 101 | + |
| 102 | + subroutine med_field_info_array_from_names_wtracers(field_names, field_info_array, rc) |
| 103 | + ! Create an array of field_info objects based on an array of names, where water |
| 104 | + ! tracers are treated specially (being given an ungridded dimension). |
| 105 | + ! |
| 106 | + ! It is assumed that fields generally have no ungridded dimensions. However, for |
| 107 | + ! fields ending with the water tracer suffix, it is instead assumed that they have a |
| 108 | + ! single ungridded dimension of size given by shr_wtracers_get_num_tracers. |
| 109 | + ! |
| 110 | + ! field_info_array is allocated here (and, since it has intent(out), it is |
| 111 | + ! automatically deallocated if it is already allocated on entry to this subroutine) |
| 112 | + |
| 113 | + ! input/output variables |
| 114 | + character(len=*), intent(in) :: field_names(:) |
| 115 | + type(med_field_info_type), allocatable, intent(out) :: field_info_array(:) |
| 116 | + integer, intent(out) :: rc |
| 117 | + |
| 118 | + ! local variables |
| 119 | + integer :: i, n_fields |
| 120 | + logical :: is_tracer |
| 121 | + integer :: n_tracers |
| 122 | + character(len=*), parameter :: subname = '(med_field_info_array_from_names_wtracers)' |
| 123 | + ! ---------------------------------------------- |
| 124 | + |
| 125 | + rc = ESMF_SUCCESS |
| 126 | + |
| 127 | + n_fields = size(field_names) |
| 128 | + allocate(field_info_array(n_fields)) |
| 129 | + ! For now, hard-code n_tracers, since we haven't set up the tracer information; we'll |
| 130 | + ! fix this in an upcoming set of changes |
| 131 | + n_tracers = 0 |
| 132 | + |
| 133 | + do i = 1, n_fields |
| 134 | + is_tracer = wtracers_is_wtracer_field(field_names(i)) |
| 135 | + if (is_tracer) then |
| 136 | + ! Field is a water tracer; assume a single ungridded dimension |
| 137 | + field_info_array(i) = med_field_info_create( & |
| 138 | + name=field_names(i), & |
| 139 | + ungridded_lbound=[1], & |
| 140 | + ungridded_ubound=[n_tracers], & |
| 141 | + rc=rc) |
| 142 | + if (chkerr(rc,__LINE__,u_FILE_u)) return |
| 143 | + else |
| 144 | + ! Not a water tracer; assume no ungridded dimensions |
| 145 | + field_info_array(i) = med_field_info_create( & |
| 146 | + name=field_names(i), & |
| 147 | + rc=rc) |
| 148 | + if (chkerr(rc,__LINE__,u_FILE_u)) return |
| 149 | + end if |
| 150 | + end do |
| 151 | + |
| 152 | + end subroutine med_field_info_array_from_names_wtracers |
| 153 | + |
| 154 | + !----------------------------------------------------------------------------- |
| 155 | + |
| 156 | + subroutine med_field_info_array_from_state(state, field_info_array, rc) |
| 157 | + ! Create an array of field_info objects based on the Fields in an ESMF State |
| 158 | + ! |
| 159 | + ! field_info_array is allocated here (and, since it has intent(out), it is |
| 160 | + ! automatically deallocated if it is already allocated on entry to this subroutine) |
| 161 | + |
| 162 | + ! input/output variables |
| 163 | + type(ESMF_State), intent(in) :: state |
| 164 | + type(med_field_info_type), allocatable, intent(out) :: field_info_array(:) |
| 165 | + integer, intent(out) :: rc |
| 166 | + |
| 167 | + ! local variables |
| 168 | + integer :: i, n_fields |
| 169 | + character(ESMF_MAXSTR), allocatable :: field_names(:) |
| 170 | + type(ESMF_Field) :: field |
| 171 | + logical :: is_present |
| 172 | + integer :: n_ungridded |
| 173 | + integer, allocatable :: ungridded_lbound(:) |
| 174 | + integer, allocatable :: ungridded_ubound(:) |
| 175 | + character(len=*), parameter :: subname = '(med_field_info_array_from_state)' |
| 176 | + ! ---------------------------------------------- |
| 177 | + |
| 178 | + rc = ESMF_SUCCESS |
| 179 | + |
| 180 | + call ESMF_StateGet(state, itemCount=n_fields, rc=rc) |
| 181 | + if (chkerr(rc,__LINE__,u_FILE_u)) return |
| 182 | + allocate(field_names(n_fields)) |
| 183 | + allocate(field_info_array(n_fields)) |
| 184 | + call ESMF_StateGet(state, itemNameList=field_names, rc=rc) |
| 185 | + if (chkerr(rc,__LINE__,u_FILE_u)) return |
| 186 | + |
| 187 | + do i = 1, n_fields |
| 188 | + call ESMF_StateGet(state, itemName=trim(field_names(i)), field=field, rc=rc) |
| 189 | + if (chkerr(rc,__LINE__,u_FILE_u)) return |
| 190 | + |
| 191 | + call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & |
| 192 | + purpose="Instance", itemCount=n_ungridded, isPresent=is_present, rc=rc) |
| 193 | + if (chkerr(rc,__LINE__,u_FILE_u)) return |
| 194 | + if (.not. is_present) then |
| 195 | + n_ungridded = 0 |
| 196 | + end if |
| 197 | + |
| 198 | + if (n_ungridded == 0) then |
| 199 | + field_info_array(i) = med_field_info_create( & |
| 200 | + name=field_names(i), & |
| 201 | + rc=rc) |
| 202 | + if (chkerr(rc,__LINE__,u_FILE_u)) return |
| 203 | + else |
| 204 | + allocate(ungridded_lbound(n_ungridded)) |
| 205 | + allocate(ungridded_ubound(n_ungridded)) |
| 206 | + call ESMF_AttributeGet(field, name="UngriddedLBound", convention="NUOPC", & |
| 207 | + purpose="Instance", valueList=ungridded_lbound, rc=rc) |
| 208 | + if (chkerr(rc,__LINE__,u_FILE_u)) return |
| 209 | + call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & |
| 210 | + purpose="Instance", valueList=ungridded_ubound, rc=rc) |
| 211 | + if (chkerr(rc,__LINE__,u_FILE_u)) return |
| 212 | + field_info_array(i) = med_field_info_create( & |
| 213 | + name=field_names(i), & |
| 214 | + ungridded_lbound=ungridded_lbound, & |
| 215 | + ungridded_ubound=ungridded_ubound, & |
| 216 | + rc=rc) |
| 217 | + if (chkerr(rc,__LINE__,u_FILE_u)) return |
| 218 | + deallocate(ungridded_lbound) |
| 219 | + deallocate(ungridded_ubound) |
| 220 | + end if |
| 221 | + end do |
| 222 | + |
| 223 | + end subroutine med_field_info_array_from_state |
| 224 | + |
| 225 | +end module med_field_info_mod |
0 commit comments