| 1 | |
|---|
| 2 | !> OASIS variable data and methods |
|---|
| 3 | |
|---|
| 4 | MODULE mod_oasis_var |
|---|
| 5 | |
|---|
| 6 | USE mod_oasis_kinds |
|---|
| 7 | USE mod_oasis_data |
|---|
| 8 | USE mod_oasis_parameters |
|---|
| 9 | USE mod_oasis_sys |
|---|
| 10 | USE mod_oasis_mpi |
|---|
| 11 | USE mod_oasis_timer |
|---|
| 12 | USE mod_oasis_part |
|---|
| 13 | |
|---|
| 14 | IMPLICIT none |
|---|
| 15 | |
|---|
| 16 | private |
|---|
| 17 | |
|---|
| 18 | !--- interfaces --- |
|---|
| 19 | public oasis_def_var |
|---|
| 20 | public oasis_var_setup |
|---|
| 21 | |
|---|
| 22 | !> Overloaded interface into oasis_def_var to support old and new interface |
|---|
| 23 | interface oasis_def_var ; module procedure & |
|---|
| 24 | oasis_def_var_v1, & |
|---|
| 25 | oasis_def_var_v2 |
|---|
| 26 | end interface |
|---|
| 27 | |
|---|
| 28 | !--- datatypes --- |
|---|
| 29 | |
|---|
| 30 | integer(ip_intwp_p),public :: maxvar !< number of potential variables, derived from namcouple input |
|---|
| 31 | integer(kind=ip_i4_p),parameter,public :: mvarcpl = 10 !< max namcouples per variable |
|---|
| 32 | |
|---|
| 33 | !> Model variable data for model coupling |
|---|
| 34 | type prism_var_type |
|---|
| 35 | character(len=ic_lvar):: name !< variable name |
|---|
| 36 | integer(kind=ip_i4_p) :: part !< variable partition |
|---|
| 37 | integer(kind=ip_i4_p) :: ndim !< rank of variable |
|---|
| 38 | integer(kind=ip_i4_p) :: num !< size of variable |
|---|
| 39 | integer(kind=ip_i4_p) :: ops !< input or output |
|---|
| 40 | integer(kind=ip_i4_p) :: type !< type kind of variable |
|---|
| 41 | integer(kind=ip_i4_p) :: size !< total size of field |
|---|
| 42 | integer(kind=ip_i4_p) :: ncpl !< number of namcouple couplers |
|---|
| 43 | integer(kind=ip_i4_p) :: cpl(mvarcpl) !< list of namcouple couplers |
|---|
| 44 | end type prism_var_type |
|---|
| 45 | |
|---|
| 46 | integer(kind=ip_intwp_p),public :: prism_nvar = 0 !< number of variables defined |
|---|
| 47 | TYPE(prism_var_type),POINTER,public :: prism_var(:) !< list of defined variables |
|---|
| 48 | |
|---|
| 49 | CONTAINS |
|---|
| 50 | |
|---|
| 51 | !--------------------------------------------------------------- |
|---|
| 52 | |
|---|
| 53 | !> The original OASIS user interface to define variables |
|---|
| 54 | !> Called via oasis_def_var |
|---|
| 55 | |
|---|
| 56 | SUBROUTINE oasis_def_var_v1(id_nports, cdport, id_part, & |
|---|
| 57 | id_var_nodims, kinout, id_var_shape, ktype, kinfo) |
|---|
| 58 | !--------------------------------------------------------------- |
|---|
| 59 | INTEGER(kind=ip_i4_p),intent(out) :: id_nports !< coupling field ID |
|---|
| 60 | CHARACTER(len=*) ,intent(in) :: cdport !< field name as in namcouple |
|---|
| 61 | INTEGER(kind=ip_i4_p),intent(in) :: id_part !< partition ID |
|---|
| 62 | INTEGER(kind=ip_i4_p),intent(in) :: id_var_nodims(2) !< rank and number of bundles |
|---|
| 63 | INTEGER(kind=ip_i4_p),intent(in) :: kinout !< input or output flag |
|---|
| 64 | INTEGER(kind=ip_i4_p),intent(in) :: id_var_shape(2*id_var_nodims(1)) !< size of field (no longer used) |
|---|
| 65 | INTEGER(kind=ip_i4_p),intent(in) :: ktype !< type of coupling field |
|---|
| 66 | INTEGER(kind=ip_i4_p),intent(out),optional :: kinfo !< return code |
|---|
| 67 | !--------------------------------------------------------------- |
|---|
| 68 | character(len=*),parameter :: subname = '(oasis_def_var_v1)' |
|---|
| 69 | !--------------------------------------------------------------- |
|---|
| 70 | |
|---|
| 71 | call oasis_debug_enter(subname) |
|---|
| 72 | |
|---|
| 73 | if (present(kinfo)) then |
|---|
| 74 | call oasis_def_var_v2(id_nports, cdport, id_part, & |
|---|
| 75 | id_var_nodims, kinout, ktype, kinfo) |
|---|
| 76 | else |
|---|
| 77 | call oasis_def_var_v2(id_nports, cdport, id_part, & |
|---|
| 78 | id_var_nodims, kinout, ktype) |
|---|
| 79 | endif |
|---|
| 80 | |
|---|
| 81 | call oasis_debug_exit(subname) |
|---|
| 82 | |
|---|
| 83 | END SUBROUTINE oasis_def_var_v1 |
|---|
| 84 | |
|---|
| 85 | !--------------------------------------------------------------- |
|---|
| 86 | |
|---|
| 87 | !> The updated OASIS user interface to define variables |
|---|
| 88 | !> Called via oasis_def_var |
|---|
| 89 | |
|---|
| 90 | SUBROUTINE oasis_def_var_v2(id_nports, cdport, id_part, & |
|---|
| 91 | id_var_nodims, kinout, ktype, kinfo) |
|---|
| 92 | !--------------------------------------------------------------- |
|---|
| 93 | INTEGER(kind=ip_i4_p),intent(out) :: id_nports !< coupling field ID |
|---|
| 94 | CHARACTER(len=*) ,intent(in) :: cdport !< field name as in namcouple |
|---|
| 95 | INTEGER(kind=ip_i4_p),intent(in) :: id_part !< partition ID |
|---|
| 96 | INTEGER(kind=ip_i4_p),intent(in) :: id_var_nodims(2) !< rank and number of bundles |
|---|
| 97 | INTEGER(kind=ip_i4_p),intent(in) :: kinout !< input or output flag |
|---|
| 98 | INTEGER(kind=ip_i4_p),intent(in) :: ktype !< type of coupling field |
|---|
| 99 | INTEGER(kind=ip_i4_p),intent(out),optional :: kinfo !< return code |
|---|
| 100 | !--------------------------------------------------------------- |
|---|
| 101 | INTEGER(kind=ip_i4_p) :: il_var_nodims_temp(2) !< rank and number of bundles temporary |
|---|
| 102 | INTEGER(kind=ip_i4_p) :: n |
|---|
| 103 | CHARACTER(len=ic_lvar) :: trimmed_cdport ! Trimmed version of cdport |
|---|
| 104 | character(len=*),parameter :: subname = '(oasis_def_var_v2)' |
|---|
| 105 | character(len=*),parameter :: subnamei = '(oasis_def_var)' |
|---|
| 106 | LOGICAL :: l_field_in_namcouple |
|---|
| 107 | !--------------------------------------------------------------- |
|---|
| 108 | |
|---|
| 109 | call oasis_debug_enter(subname) |
|---|
| 110 | if (.not. oasis_coupled) then |
|---|
| 111 | call oasis_debug_exit(subname) |
|---|
| 112 | return |
|---|
| 113 | endif |
|---|
| 114 | |
|---|
| 115 | !------------------------------------------------- |
|---|
| 116 | !> * Check len of incoming variable name |
|---|
| 117 | ! Trim incoming name once to avoid multiple trim operations |
|---|
| 118 | ! in subsequent loops |
|---|
| 119 | !------------------------------------------------- |
|---|
| 120 | |
|---|
| 121 | if (len_trim(cdport) > ic_lvar) then |
|---|
| 122 | WRITE(nulprt,*) subnamei,estr,'variable too long = ',trim(cdport) |
|---|
| 123 | WRITE(nulprt,*) subnamei,estr,'max variable length (ic_lvar) = ',ic_lvar |
|---|
| 124 | call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 125 | endif |
|---|
| 126 | trimmed_cdport = trim(cdport) |
|---|
| 127 | |
|---|
| 128 | if (present(kinfo)) kinfo = OASIS_Ok |
|---|
| 129 | |
|---|
| 130 | l_field_in_namcouple = .FALSE. |
|---|
| 131 | n = 0 |
|---|
| 132 | |
|---|
| 133 | !------------------------------------------------- |
|---|
| 134 | !> * Search for field in namcouple field lists |
|---|
| 135 | !------------------------------------------------- |
|---|
| 136 | |
|---|
| 137 | ! If either condition ceases to be true then bail out of the loop |
|---|
| 138 | DO WHILE (n < size_namfld .AND. (.NOT.l_field_in_namcouple)) |
|---|
| 139 | n = n+1 |
|---|
| 140 | IF ( (trimmed_cdport == total_namsrcfld(n)).OR. & |
|---|
| 141 | (trimmed_cdport == total_namdstfld(n)) ) THEN |
|---|
| 142 | l_field_in_namcouple = .TRUE. |
|---|
| 143 | ENDIF |
|---|
| 144 | enddo |
|---|
| 145 | |
|---|
| 146 | !------------------------------------------------- |
|---|
| 147 | !> * Return if field not found in namcouple |
|---|
| 148 | !------------------------------------------------- |
|---|
| 149 | |
|---|
| 150 | if (.not. l_field_in_namcouple) then |
|---|
| 151 | id_nports = OASIS_Var_Uncpl |
|---|
| 152 | if (OASIS_debug >= 2) then |
|---|
| 153 | write(nulprt,*) subnamei,' variable not in namcouple return ',trimmed_cdport |
|---|
| 154 | call oasis_flush(nulprt) |
|---|
| 155 | endif |
|---|
| 156 | call oasis_debug_exit(subname) |
|---|
| 157 | return |
|---|
| 158 | endif |
|---|
| 159 | |
|---|
| 160 | !------------------------------------------------- |
|---|
| 161 | !> * Abort if field already defined |
|---|
| 162 | !------------------------------------------------- |
|---|
| 163 | |
|---|
| 164 | do n = 1,prism_nvar |
|---|
| 165 | if (trimmed_cdport == prism_var(n)%name) then |
|---|
| 166 | write(nulprt,*) subnamei,estr,'variable already defined with def_var = ',trimmed_cdport |
|---|
| 167 | write(nulprt,*) subnamei,estr,'check oasis_def_var calls in your model' |
|---|
| 168 | call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 169 | endif |
|---|
| 170 | enddo |
|---|
| 171 | |
|---|
| 172 | ! tcraig, this is due to i3.3 in the 2d->1d field bundle renaming |
|---|
| 173 | il_var_nodims_temp(:)=id_var_nodims(:) |
|---|
| 174 | IF (il_var_nodims_temp(2) > 999) THEN |
|---|
| 175 | write(nulprt,*) subnamei,estr,'variable id_var_nodims(2) too large. limit is 999 ',il_var_nodims_temp(2) |
|---|
| 176 | write(nulprt,*) subnamei,estr,'check oasis_def_var calls in your model' |
|---|
| 177 | call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 178 | ENDIF |
|---|
| 179 | |
|---|
| 180 | IF (il_var_nodims_temp(2) <= 0) THEN |
|---|
| 181 | il_var_nodims_temp(2)=1 |
|---|
| 182 | WRITE(nulprt,*) subnamei,'WARNING id_var_nodim(2) cannot be negative or 0 ; put to 1' |
|---|
| 183 | call oasis_flush(nulprt) |
|---|
| 184 | ENDIF |
|---|
| 185 | |
|---|
| 186 | !------------------------------------------------- |
|---|
| 187 | !> * Increment the variable and store the values |
|---|
| 188 | !------------------------------------------------- |
|---|
| 189 | |
|---|
| 190 | prism_nvar = prism_nvar + 1 |
|---|
| 191 | id_nports = prism_nvar |
|---|
| 192 | |
|---|
| 193 | if (prism_nvar > maxvar) then |
|---|
| 194 | write(nulprt,*) subnamei,estr,'prism_nvar too large = ',prism_nvar,maxvar |
|---|
| 195 | write(nulprt,*) subnamei,estr,'check maxvar set in oasis_init_comp' |
|---|
| 196 | call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 197 | endif |
|---|
| 198 | |
|---|
| 199 | call oasis_var_zero(prism_var(prism_nvar)) |
|---|
| 200 | prism_var(prism_nvar)%name = trimmed_cdport |
|---|
| 201 | prism_var(prism_nvar)%part = id_part |
|---|
| 202 | prism_var(prism_nvar)%num = il_var_nodims_temp(2) |
|---|
| 203 | prism_var(prism_nvar)%ops = kinout |
|---|
| 204 | prism_var(prism_nvar)%type = ktype |
|---|
| 205 | prism_var(prism_nvar)%size = 1 |
|---|
| 206 | prism_var(prism_nvar)%ncpl = 0 |
|---|
| 207 | prism_var(prism_nvar)%cpl = 0 |
|---|
| 208 | |
|---|
| 209 | !---------------------------------- |
|---|
| 210 | !> * Write some diagnostics |
|---|
| 211 | !---------------------------------- |
|---|
| 212 | |
|---|
| 213 | if (OASIS_debug >= 2) then |
|---|
| 214 | write(nulprt,*) ' ' |
|---|
| 215 | write(nulprt,*) subnamei,' prism_nvar = ',prism_nvar |
|---|
| 216 | write(nulprt,*) subnamei,' varname = ',prism_nvar,trim(prism_var(prism_nvar)%name) |
|---|
| 217 | write(nulprt,*) subnamei,' varpart = ',prism_nvar,prism_var(prism_nvar)%part |
|---|
| 218 | write(nulprt,*) subnamei,' varnum = ',prism_nvar,prism_var(prism_nvar)%num |
|---|
| 219 | write(nulprt,*) subnamei,' varops = ',prism_nvar,prism_var(prism_nvar)%ops |
|---|
| 220 | write(nulprt,*) subnamei,' vartype = ',prism_nvar,prism_var(prism_nvar)%type |
|---|
| 221 | write(nulprt,*) ' ' |
|---|
| 222 | CALL oasis_flush(nulprt) |
|---|
| 223 | endif |
|---|
| 224 | |
|---|
| 225 | call oasis_debug_exit(subname) |
|---|
| 226 | |
|---|
| 227 | END SUBROUTINE oasis_def_var_v2 |
|---|
| 228 | |
|---|
| 229 | !--------------------------------------------------------------- |
|---|
| 230 | |
|---|
| 231 | !> Synchronize variables across all tasks, called at oasis enddef. |
|---|
| 232 | |
|---|
| 233 | SUBROUTINE oasis_var_setup() |
|---|
| 234 | IMPLICIT NONE |
|---|
| 235 | |
|---|
| 236 | !-------------------------------------------------------- |
|---|
| 237 | integer(kind=ip_intwp_p) :: m,n,p,v |
|---|
| 238 | INTEGER(kind=ip_intwp_p) :: ierr, taskid |
|---|
| 239 | integer(kind=ip_intwp_p) :: vcnt |
|---|
| 240 | logical :: found, fastcheckout |
|---|
| 241 | character(len=ic_lvar) ,allocatable :: vname0(:),vname(:) |
|---|
| 242 | character(len=ic_lvar2) ,allocatable :: pname0(:),pname(:) |
|---|
| 243 | integer(kind=ip_intwp_p),allocatable :: inout0(:),inout(:) |
|---|
| 244 | integer(kind=ip_intwp_p),allocatable :: vanum0(:),vanum(:) |
|---|
| 245 | logical, parameter :: local_timers_on = .false. |
|---|
| 246 | character(len=*),parameter :: subname = '(oasis_var_setup)' |
|---|
| 247 | !-------------------------------------------------------- |
|---|
| 248 | |
|---|
| 249 | call oasis_debug_enter(subname) |
|---|
| 250 | |
|---|
| 251 | IF (local_timers_on) call oasis_timer_start('var_setup') |
|---|
| 252 | |
|---|
| 253 | IF (local_timers_on) call oasis_timer_start('var_setup_reducelists') |
|---|
| 254 | allocate(vname0(prism_nvar)) |
|---|
| 255 | allocate(pname0(prism_nvar)) |
|---|
| 256 | allocate(inout0(prism_nvar)) |
|---|
| 257 | allocate(vanum0(prism_nvar)) |
|---|
| 258 | do n = 1,prism_nvar |
|---|
| 259 | vname0(n) = prism_var(n)%name |
|---|
| 260 | inout0(n) = prism_var(n)%ops |
|---|
| 261 | vanum0(n) = prism_var(n)%num |
|---|
| 262 | pname0(n) = prism_part(prism_var(n)%part)%partname |
|---|
| 263 | enddo |
|---|
| 264 | |
|---|
| 265 | call oasis_mpi_reducelists(vname0,mpi_comm_local,vcnt,vname,'var_setup', & |
|---|
| 266 | fastcheck=.true.,fastcheckout=fastcheckout, & |
|---|
| 267 | linp2=pname0,lout2=pname,linp3=inout0,lout3=inout,linp4=vanum0,lout4=vanum) |
|---|
| 268 | |
|---|
| 269 | deallocate(vname0) |
|---|
| 270 | deallocate(pname0) |
|---|
| 271 | deallocate(inout0) |
|---|
| 272 | deallocate(vanum0) |
|---|
| 273 | IF (local_timers_on) call oasis_timer_stop('var_setup_reducelists') |
|---|
| 274 | |
|---|
| 275 | !------------------------------------------------- |
|---|
| 276 | !> * Initialize variables on tasks where they are not previously defined. |
|---|
| 277 | ! if fastcheck worked, then don't need to do this extra work to add undefined vars |
|---|
| 278 | !------------------------------------------------- |
|---|
| 279 | |
|---|
| 280 | if (.not. fastcheckout) then |
|---|
| 281 | |
|---|
| 282 | if (local_timers_on) call oasis_timer_start('var_setup_initvar') |
|---|
| 283 | do v = 1,vcnt |
|---|
| 284 | |
|---|
| 285 | !--- either a prism_var that already exists |
|---|
| 286 | found = .false. |
|---|
| 287 | n = 0 |
|---|
| 288 | do while (n < prism_nvar .and. .not.found) |
|---|
| 289 | n = n + 1 |
|---|
| 290 | if (prism_var(n)%name == vname(v)) then |
|---|
| 291 | found = .true. |
|---|
| 292 | endif |
|---|
| 293 | enddo |
|---|
| 294 | |
|---|
| 295 | !--- or a new prism_var that must be instantiated |
|---|
| 296 | if (.not.found) then |
|---|
| 297 | prism_nvar = prism_nvar + 1 |
|---|
| 298 | |
|---|
| 299 | call oasis_var_zero(prism_var(prism_nvar)) |
|---|
| 300 | prism_var(prism_nvar)%name = vname(v) |
|---|
| 301 | prism_var(prism_nvar)%ops = inout(v) |
|---|
| 302 | prism_var(prism_nvar)%num = vanum(v) |
|---|
| 303 | prism_var(prism_nvar)%ncpl = 0 |
|---|
| 304 | !--- figure out the local part id for the part name |
|---|
| 305 | p = 0 |
|---|
| 306 | found = .false. |
|---|
| 307 | do while (p < prism_npart .and. .not.found) |
|---|
| 308 | p = p + 1 |
|---|
| 309 | if (prism_part(p)%partname == pname(v)) then |
|---|
| 310 | found = .true. |
|---|
| 311 | endif |
|---|
| 312 | enddo |
|---|
| 313 | if (found) then |
|---|
| 314 | prism_var(prism_nvar)%part = p |
|---|
| 315 | if (OASIS_debug >= 15) then |
|---|
| 316 | write(nulprt,*) subname,' found part match ',trim(vname(v)),trim(pname(v)),p |
|---|
| 317 | endif |
|---|
| 318 | else |
|---|
| 319 | write(nulprt,*) subname,estr,'prism part not found part = ',trim(pname(v)),' var = ',trim(vname(v)) |
|---|
| 320 | call oasis_abort(file=__FILE__,line=__LINE__) |
|---|
| 321 | endif |
|---|
| 322 | |
|---|
| 323 | if (OASIS_debug >= 2) then |
|---|
| 324 | write(nulprt,*) ' ' |
|---|
| 325 | write(nulprt,*) subname,' add var = ',prism_nvar,trim(prism_var(prism_nvar)%name),& |
|---|
| 326 | prism_var(prism_nvar)%part,& |
|---|
| 327 | trim(prism_part(prism_var(prism_nvar)%part)%partname),prism_var(prism_nvar)%ops |
|---|
| 328 | CALL oasis_flush(nulprt) |
|---|
| 329 | ENDIF |
|---|
| 330 | endif |
|---|
| 331 | |
|---|
| 332 | enddo ! v = 1,vcnt |
|---|
| 333 | if (local_timers_on) call oasis_timer_stop ('var_setup_initvar') |
|---|
| 334 | |
|---|
| 335 | endif ! fastcheckout |
|---|
| 336 | |
|---|
| 337 | deallocate(vname,pname,inout,vanum) |
|---|
| 338 | |
|---|
| 339 | IF (local_timers_on) call oasis_timer_stop('var_setup') |
|---|
| 340 | |
|---|
| 341 | call oasis_debug_exit(subname) |
|---|
| 342 | |
|---|
| 343 | END SUBROUTINE oasis_var_setup |
|---|
| 344 | |
|---|
| 345 | !--------------------------------------------------------------- |
|---|
| 346 | |
|---|
| 347 | !> Zero variable information |
|---|
| 348 | |
|---|
| 349 | SUBROUTINE oasis_var_zero(prism_var) |
|---|
| 350 | IMPLICIT NONE |
|---|
| 351 | |
|---|
| 352 | !-------------------------------------------------------- |
|---|
| 353 | type(prism_var_type),intent(inout) :: prism_var |
|---|
| 354 | character(len=*),parameter :: subname = '(oasis_var_zero)' |
|---|
| 355 | !-------------------------------------------------------- |
|---|
| 356 | |
|---|
| 357 | call oasis_debug_enter(subname) |
|---|
| 358 | |
|---|
| 359 | prism_var%name = 'oasis_var_name_unset' |
|---|
| 360 | prism_var%part = -1 |
|---|
| 361 | prism_var%ndim = -1 |
|---|
| 362 | prism_var%num = -1 |
|---|
| 363 | prism_var%ops = -1 |
|---|
| 364 | prism_var%type = -1 |
|---|
| 365 | prism_var%size = -1 |
|---|
| 366 | prism_var%ncpl = 0 |
|---|
| 367 | prism_var%cpl = -1 |
|---|
| 368 | |
|---|
| 369 | call oasis_debug_exit(subname) |
|---|
| 370 | |
|---|
| 371 | END SUBROUTINE oasis_var_zero |
|---|
| 372 | |
|---|
| 373 | !--------------------------------------------------------------- |
|---|
| 374 | END MODULE mod_oasis_var |
|---|
| 375 | |
|---|
