|
XBeach
|
00001 module introspection_module 00002 use iso_c_binding, only: c_int, c_loc, c_ptr, c_double, c_f_pointer, c_char, C_NULL_CHAR 00003 use iso_c_utils, only: MAXSTRINGLEN, char_array_to_string, string_to_char_array 00004 use mnemmodule, only: arraytype, chartoindex 00005 use spaceparams, only: indextos 00006 use libxbeach_module, only:par,s,tpar 00007 00008 implicit none 00009 private 00010 public getdoubleparameter 00011 save 00012 00013 interface getnparameter 00014 module procedure getnparameter_fortran 00015 end interface getnparameter 00016 00017 interface getparametername 00018 module procedure getparametername_fortran 00019 end interface getparametername 00020 00021 interface getparametertype 00022 module procedure getparametertype_fortran 00023 end interface getparametertype 00024 00025 interface getdoubleparameter 00026 module procedure getdoubleparameter_fortran 00027 end interface getdoubleparameter 00028 00029 interface setdoubleparameter 00030 module procedure setdoubleparameter_fortran 00031 end interface setdoubleparameter 00032 00033 interface getintparameter 00034 module procedure getintparameter_fortran 00035 end interface getintparameter 00036 00037 interface getnarray 00038 module procedure getnarray_fortran 00039 end interface getnarray 00040 00041 interface getarraytype 00042 module procedure getarraytype_fortran 00043 end interface getarraytype 00044 00045 interface getarrayrank 00046 module procedure getarrayrank_fortran 00047 end interface getarrayrank 00048 00049 interface getarrayname 00050 module procedure getarrayname_fortran 00051 end interface getarrayname 00052 00053 interface get0ddoublearray 00054 module procedure get0ddoublearray_fortran 00055 end interface get0ddoublearray 00056 00057 interface get1ddoublearray 00058 module procedure get1ddoublearray_fortran 00059 end interface get1ddoublearray 00060 00061 interface get2ddoublearray 00062 module procedure get2ddoublearray_fortran 00063 end interface get2ddoublearray 00064 00065 interface get3ddoublearray 00066 module procedure get3ddoublearray_fortran 00067 end interface get3ddoublearray 00068 00069 interface get4ddoublearray 00070 module procedure get4ddoublearray_fortran 00071 end interface get4ddoublearray 00072 00073 interface get0dintarray 00074 module procedure get0dintarray_fortran 00075 end interface get0dintarray 00076 00077 interface get1dintarray 00078 module procedure get1dintarray_fortran 00079 end interface get1dintarray 00080 00081 interface get2dintarray 00082 module procedure get2dintarray_fortran 00083 end interface get2dintarray 00084 00085 interface set0dintarray 00086 module procedure set0dintarray_fortran 00087 end interface set0dintarray 00088 00089 interface set1dintarray 00090 module procedure set1dintarray_fortran 00091 end interface set1dintarray 00092 00093 interface set0ddoublearray 00094 module procedure set0ddoublearray_fortran 00095 end interface set0ddoublearray 00096 00097 interface set1ddoublearray 00098 module procedure set1ddoublearray_fortran 00099 end interface set1ddoublearray 00100 00101 interface set2ddoublearray 00102 module procedure set2ddoublearray_fortran 00103 end interface set2ddoublearray 00104 00105 interface set3ddoublearray 00106 module procedure set3ddoublearray_fortran 00107 end interface set3ddoublearray 00108 00109 interface set4ddoublearray 00110 module procedure set4ddoublearray_fortran 00111 end interface set4ddoublearray 00112 contains 00113 ! No C for this one, no chars to mess up... 00114 integer(c_int) function getnparameter_fortran(n) bind(C, name="getnparameter") 00115 use typesandkinds, only: slen 00116 use getkey_module, only: getkeys 00117 integer(c_int), intent(inout) :: n 00118 character(len=slen), allocatable :: keys(:) 00119 getnparameter_fortran = -1 00120 call getkeys(par, keys) 00121 n = size(keys,1) 00122 getnparameter_fortran = 0 00123 end function getnparameter_fortran 00124 00125 integer(c_int) function getparametertype_fortran(name, typecode) 00126 use iso_c_utils, only: string_to_char_array 00127 character(kind=c_char,len=*),intent(in) :: name 00128 character(kind=c_char, len=1), intent(out) :: typecode 00129 00130 integer(c_int) :: length 00131 character(1), dimension(len(name)) :: cname 00132 length = len(name) 00133 cname = string_to_char_array(name) 00134 00135 getparametertype_fortran = getparametertype_c(cname, typecode, length) 00136 end function getparametertype_fortran 00137 00138 integer(c_int) function getparametertype_c(name, typecode, length) bind(C,name="getparametertype") 00139 use getkey_module, only: getkey_indextype 00140 character(kind=c_char,len=1),intent(in) :: name(length) 00141 character(kind=c_char, len=1), intent(out) :: typecode 00142 integer(c_int) :: length 00143 character(len=length) :: key 00144 integer :: index 00145 00146 ! wwvv added: 00147 getparametertype_c = 0 00148 key = char_array_to_string(name) 00149 call getkey_indextype(par, key, index, typecode) 00150 end function getparametertype_c 00151 00152 integer(c_int) function getparametername_fortran(index, name) 00153 use typesandkinds, only: slen 00154 integer(c_int), intent(in) :: index 00155 character(kind=c_char, len=*), intent(out) :: name 00156 character(kind=c_char, len=1) :: cname(slen) 00157 integer :: length 00158 00159 getparametername_fortran = getparametername_c(index, cname, length) 00160 name = char_array_to_string(cname) 00161 00162 end function getparametername_fortran 00163 00164 00165 integer(c_int) function getparametername_c(index, name, length) bind(C,name="getparametername") 00166 use typesandkinds, only: slen 00167 use getkey_module, only: getkeys 00168 integer(c_int), intent(in) :: index 00169 integer(c_int), intent(out) :: length 00170 character(kind=c_char, len=1), intent(out) :: name(slen) 00171 00172 character(len=slen), allocatable :: keys(:) 00173 character(kind=c_char,len=slen) :: key 00174 getparametername_c = -1 00175 ! These are the keys in fortran format. 00176 call getkeys(par, keys) 00177 ! We need to convert them to C format (char1's) 00178 key = keys(index) 00179 length = len_trim(key) 00180 name = string_to_char_array(key) 00181 getparametername_c = 0 00182 end function getparametername_c 00183 00184 integer(c_int) function getdoubleparameter_fortran(name,value) 00185 USE iso_c_binding 00186 ! use inout otherwise things break 00187 real(c_double), intent(inout) :: value 00188 00189 ! String 00190 character(kind=c_char,len=*),intent(in) :: name 00191 00192 ! Transform name to a fortran character... 00193 ! and add a 0 at the end... 00194 character(1), dimension(len(name)+1) :: cname 00195 integer :: i 00196 do i = 1,len_trim(name) 00197 cname(i) = name(i:i) 00198 enddo 00199 cname(len_trim(name)+1) = C_NULL_CHAR 00200 getdoubleparameter_fortran = getdoubleparameter_c(cname,value,len(name)) 00201 end function getdoubleparameter_fortran 00202 00203 00204 integer(c_int) function getdoubleparameter_c(name,value, length) bind(C,name="getdoubleparameter") 00205 !DEC$ ATTRIBUTES DLLEXPORT::getdoubleparameter_c 00206 USE iso_c_binding 00207 use getkey_module, only: getkey, parameter 00208 ! use inout otherwise things break 00209 real(c_double), intent(inout) :: value 00210 ! and we need the string length .... 00211 integer(c_int),value ,intent(in) :: length 00212 ! String 00213 character(kind=c_char),intent(in) :: name(length) 00214 00215 ! Transform name to a fortran character... 00216 type(parameter) :: myparam 00217 character(length) :: myname 00218 ! Return -1 for invalid parameters 00219 getdoubleparameter_c = -1 00220 myname = char_array_to_string(name) 00221 getdoubleparameter_c = getkey(par, myname, myparam) 00222 if (getdoubleparameter_c .eq. -1) return 00223 value = myparam%r0 00224 getdoubleparameter_c = 0 00225 end function getdoubleparameter_c 00226 00227 00228 integer(c_int) function setdoubleparameter_fortran(name,value) 00229 USE iso_c_binding 00230 ! use inout otherwise things break 00231 real(c_double), intent(inout) :: value 00232 00233 ! String 00234 character(kind=c_char,len=*),intent(in) :: name 00235 00236 ! Transform name to a fortran character... 00237 character(1), dimension(len(name)+1) :: myname 00238 integer :: i 00239 do i = 1,len_trim(name) 00240 myname(i) = name(i:i) 00241 enddo 00242 myname(len_trim(name)+1) = C_NULL_CHAR 00243 setdoubleparameter_fortran = setdoubleparameter_c(myname,value,len(name)) 00244 end function setdoubleparameter_fortran 00245 00246 integer(c_int) function setdoubleparameter_c(name,value, length) bind(C,name="setdoubleparameter") 00247 !DEC$ ATTRIBUTES DLLEXPORT::setdoubleparameter_c 00248 USE iso_c_binding 00249 ! use inout otherwise things break 00250 real(c_double), intent(in) :: value 00251 ! and we need the string length .... 00252 integer(c_int), value ,intent(in) :: length 00253 ! String 00254 character(kind=c_char),intent(in) :: name(length) 00255 00256 ! Transform name to a fortran character... 00257 character(length) :: myname 00258 myname = char_array_to_string(name) 00259 select case (myname) 00260 case ('t') 00261 par%t = value 00262 case ('tstop') 00263 par%tstop = value 00264 case ('tnext') 00265 tpar%tnext = value 00266 case default 00267 setdoubleparameter_c = -1 00268 return 00269 end select 00270 setdoubleparameter_c = 0 00271 end function setdoubleparameter_c 00272 00273 integer(c_int) function getintparameter_fortran(name,value) 00274 USE iso_c_binding 00275 ! use inout otherwise things break 00276 integer(c_int), intent(inout) :: value 00277 00278 ! String 00279 character(kind=c_char,len=*),intent(in) :: name 00280 00281 ! Transform name to a fortran character... 00282 character(1), dimension(len(name)+1) :: myname 00283 integer :: i 00284 do i = 1,len(name) 00285 myname(i) = name(i:i) 00286 enddo 00287 myname(len(name)+1) = C_NULL_CHAR 00288 getintparameter_fortran = getintparameter_c(myname,value,len(name)) 00289 end function getintparameter_fortran 00290 00291 integer(c_int) function getintparameter_c(name,value, length) bind(C,name="getintparameter") 00292 use getkey_module, only: getkey, parameter 00293 !DEC$ ATTRIBUTES DLLEXPORT::getintparameter_c 00294 00295 USE iso_c_binding 00296 use getkey_module 00297 ! use inout otherwise things break 00298 integer(c_int), intent(inout) :: value 00299 ! and we need the string length .... 00300 integer(c_int),value ,intent(in) :: length 00301 ! String 00302 character(kind=c_char),intent(in) :: name(length) 00303 00304 ! Transform name to a fortran character... 00305 character(length) :: myname 00306 type(parameter) :: myparam 00307 myname = char_array_to_string(name) 00308 ! Lookup the parameter by name 00309 getintparameter_c = getkey(par, myname, myparam) 00310 if (getintparameter_c .eq. -1) return 00311 value = myparam%i0 00312 getintparameter_c = 0 00313 end function getintparameter_c 00314 00315 00316 00317 integer(c_int) function getcharparameter_c(name,value, namelength, valuelength) bind(C,name="getcharparameter") 00318 !DEC$ ATTRIBUTES DLLEXPORT::getcharparameter_c 00319 00320 use typesandkinds, only: slen 00321 use getkey_module, only: parameter,getkey 00322 ! String 00323 character(kind=c_char),intent(in) :: name(namelength) 00324 character(kind=c_char,len=1), intent(out) :: value(slen) 00325 integer(c_int), intent(in) :: namelength 00326 integer(c_int), intent(out) :: valuelength 00327 00328 ! Transform name to a fortran character... 00329 character(namelength) :: fname 00330 type(parameter) :: myparam 00331 fname = char_array_to_string(name) 00332 ! Lookup the parameter by name 00333 getcharparameter_c = getkey(par, fname, myparam) 00334 if (getcharparameter_c .eq. -1) return 00335 valuelength = len_trim(myparam%c0) 00336 value = string_to_char_array(trim(myparam%c0)) 00337 getcharparameter_c = 0 00338 end function getcharparameter_c 00339 00340 integer(c_int) function getnarray_fortran(n) bind(C, name="getnarray") 00341 use mnemmodule, only: numvars 00342 integer(c_int), intent(inout) :: n 00343 getnarray_fortran = -1 00344 n = numvars 00345 getnarray_fortran = 0 00346 end function getnarray_fortran 00347 00348 00349 integer(c_int) function getarrayname_fortran(index, name) 00350 integer(c_int), intent(in) :: index 00351 character(kind=c_char, len=*), intent(out) :: name 00352 character(kind=c_char, len=1) :: cname(MAXSTRINGLEN) 00353 integer :: length 00354 00355 getarrayname_fortran = getarrayname_c(index, cname, length) 00356 name = char_array_to_string(cname) 00357 end function getarrayname_fortran 00358 00359 00360 integer(c_int) function getarrayname_c(index, name, length) bind(C,name="getarrayname") 00361 use typesandkinds, only: slen 00362 integer(c_int), intent(in) :: index 00363 integer(c_int), intent(out) :: length 00364 character(kind=c_char, len=1), intent(out) :: name(slen) 00365 00366 00367 character(kind=c_char,len=slen) :: key 00368 type(arraytype) :: array 00369 00370 getarrayname_c = -1 00371 ! This is the index in fortran format 00372 call indextos(s,index,array) 00373 ! We need to conver them to C format (char1's) 00374 key = array%name 00375 length = len_trim(key) 00376 name = string_to_char_array(key) 00377 getarrayname_c = 0 00378 end function getarrayname_c 00379 00380 integer(c_int) function getarraytype_fortran(name, typecode) 00381 !DEC$ ATTRIBUTES DLLEXPORT::getarray_type 00382 character(kind=c_char,len=*),intent(in) :: name 00383 character(kind=c_char, len=1), intent(out) :: typecode 00384 00385 ! and we need the string length .... 00386 integer(c_int) :: length 00387 character(1), dimension(len(name)+1) :: cname 00388 length = len(name) 00389 cname = string_to_char_array(name) 00390 getarraytype_fortran = getarraytype_c(cname, typecode, length) 00391 end function getarraytype_fortran 00392 00393 integer(c_int) function getarraytype_c(name, typecode, length) bind(C,name="getarraytype") 00394 character(kind=c_char,len=1),intent(in) :: name(length) 00395 character(kind=c_char, len=1), intent(out) :: typecode 00396 integer(c_int) :: length 00397 00398 character(len=length) :: key 00399 integer :: index 00400 type(arraytype) :: array 00401 key = char_array_to_string(name) 00402 getarraytype_c = -1 00403 index = chartoindex(key) 00404 if (index .eq. -1) return 00405 getarraytype_c = 0 00406 call indextos(s,index,array) 00407 typecode = array%type 00408 end function getarraytype_c 00409 00410 integer(c_int) function getarrayrank_fortran(name, rank) 00411 !DEC$ ATTRIBUTES DLLEXPORT::getarray_rank 00412 character(kind=c_char,len=*),intent(in) :: name 00413 integer(c_int), intent(out) :: rank 00414 00415 ! and we need the string length .... 00416 integer(c_int) :: length 00417 character(1), dimension(len(name)) :: cname 00418 length = len(name) 00419 cname = string_to_char_array(name) 00420 getarrayrank_fortran = getarrayrank_c(cname, rank, length) 00421 end function getarrayrank_fortran 00422 00423 integer(c_int) function getarrayrank_c(name, rank, length) bind(C,name="getarrayrank") 00424 character(kind=c_char,len=1),intent(in) :: name(length) 00425 integer(c_int), intent(out) :: rank 00426 integer(c_int) :: length 00427 00428 character(len=length) :: key 00429 integer :: index 00430 type(arraytype) :: array 00431 key = char_array_to_string(name) 00432 getarrayrank_c = -1 00433 index = chartoindex(key) 00434 if (index .eq. -1) return 00435 call indextos(s,index,array) 00436 rank = array%rank 00437 getarrayrank_c = 0 00438 end function getarrayrank_c 00439 00440 00441 integer(c_int) function getarraydimsize_fortran(name, dim, size) 00442 !DEC$ ATTRIBUTES DLLEXPORT::getarray_dimsize 00443 character(kind=c_char,len=*),intent(in) :: name 00444 integer(c_int), intent(in) :: dim ! dimension number 00445 integer(c_int), intent(out) :: size 00446 00447 ! and we need the string length .... 00448 integer(c_int) :: length 00449 character(1), dimension(len(name)) :: cname 00450 length = len(name) 00451 cname = string_to_char_array(name) 00452 getarraydimsize_fortran = getarraydimsize_c(cname, dim, size, length) 00453 end function getarraydimsize_fortran 00454 00455 integer(c_int) function getarraydimsize_c(name, dim, dimsize, length) bind(C,name="getarraydimsize") 00456 character(kind=c_char,len=1),intent(in) :: name(length) 00457 integer(c_int), intent(in) :: dim ! dimension number 00458 integer(c_int), intent(out) :: dimsize 00459 integer(c_int), intent(in) :: length 00460 00461 character(len=length) :: key 00462 integer :: index 00463 type(arraytype) :: array 00464 key = char_array_to_string(name) 00465 getarraydimsize_c = -1 00466 index = chartoindex(key) 00467 if (index .eq. -1) return 00468 call indextos(s,index,array) 00469 if (array%rank < dim) return 00470 if (array%rank == 0) then 00471 dimsize = 0 00472 elseif (array%rank == 1) then 00473 if (array%type == 'i') dimsize = size(array%i1) 00474 if (array%type == 'r') dimsize = size(array%r1) 00475 elseif (array%rank == 2) then 00476 if (array%type == 'i') dimsize = size(array%i2, dim) 00477 if (array%type == 'r') dimsize = size(array%r2, dim) 00478 elseif (array%rank == 3) then 00479 if (array%type == 'i') dimsize = size(array%i3, dim) 00480 if (array%type == 'r') dimsize = size(array%r3, dim) 00481 elseif (array%rank == 4) then 00482 if (array%type == 'i') dimsize = size(array%i4, dim) 00483 if (array%type == 'r') dimsize = size(array%r4, dim) 00484 endif 00485 end function getarraydimsize_c 00486 00487 integer(c_int) function getarray(name, x, length) bind(C, name="getarray") 00488 !DEC$ ATTRIBUTES DLLEXPORT::getarray 00489 use mnemiso_module, only:carraytype, arrayf2c 00490 00491 ! use inout otherwise things break 00492 type(carraytype), intent(inout) :: x 00493 ! and we need the string length .... 00494 integer(c_int),value ,intent(in) :: length 00495 ! String 00496 character(kind=c_char),intent(inout) :: name(length) 00497 00498 character(length) :: myname 00499 integer :: index 00500 type(arraytype) :: array 00501 getarray = -1 00502 myname = char_array_to_string(name) 00503 index = chartoindex(myname) 00504 if (index .eq. -1) return 00505 call indextos(s,index,array) 00506 x = arrayf2c(array) 00507 getarray = 0 00508 end function getarray 00509 00510 00511 integer(c_int) function get0ddoublearray_fortran(name,x) 00512 USE iso_c_binding 00513 ! String 00514 character(kind=c_char,len=*),intent(in) :: name 00515 ! use inout otherwise things break 00516 real(c_double), intent(inout) :: x 00517 00518 type(arraytype) :: array 00519 integer :: index 00520 00521 get0ddoublearray_fortran = -1 00522 index = chartoindex(trim(name)) 00523 if (index .eq. -1) return 00524 call indextos(s,index,array) 00525 x = array%r0 00526 get0ddoublearray_fortran = 0 00527 end function get0ddoublearray_fortran 00528 00529 00530 integer(c_int) function get0ddoublearray_c(name, x, length) bind(C, name="get0ddoublearray") 00531 !DEC$ ATTRIBUTES DLLEXPORT::get0ddoublearray_c 00532 00533 ! use inout otherwise things break 00534 type(c_ptr), intent(inout) :: x 00535 ! and we need the string length .... 00536 integer(c_int),value ,intent(in) :: length 00537 ! String 00538 character(kind=c_char),intent(in) :: name(length) 00539 00540 character(length) :: myname 00541 integer :: index 00542 type(arraytype) :: array 00543 real(c_double), target :: r0 00544 00545 get0ddoublearray_c = -1 00546 myname = char_array_to_string(name) 00547 index = chartoindex(myname) 00548 if (index .eq. -1) return 00549 call indextos(s,index,array) 00550 r0 = array%r0 00551 x = c_loc(r0) 00552 get0ddoublearray_c = 0 00553 end function get0ddoublearray_c 00554 00555 00556 integer(c_int) function get1ddoublearray_fortran(name,x) 00557 USE iso_c_binding 00558 ! String 00559 character(kind=c_char,len=*),intent(in) :: name 00560 ! use inout otherwise things break 00561 real(c_double), intent(inout) :: x(:) 00562 00563 type(arraytype) :: array 00564 integer :: index 00565 00566 get1ddoublearray_fortran = -1 00567 index = chartoindex(trim(name)) 00568 if (index .eq. -1) return 00569 call indextos(s,index,array) 00570 x = array%r1 00571 get1ddoublearray_fortran = 0 00572 end function get1ddoublearray_fortran 00573 00574 00575 integer(c_int) function get1ddoublearray_c(name, x, length) bind(C, name="get1ddoublearray") 00576 !DEC$ ATTRIBUTES DLLEXPORT::get1ddoublearray_c 00577 00578 ! use inout otherwise things break 00579 type(c_ptr), intent(inout) :: x 00580 ! and we need the string length .... 00581 integer(c_int),value ,intent(in) :: length 00582 ! String 00583 character(kind=c_char),intent(in) :: name(length) 00584 00585 character(length) :: myname 00586 integer :: index 00587 type(arraytype) :: array 00588 real(c_double), target, allocatable, save, dimension(:) :: r1 00589 00590 get1ddoublearray_c = -1 00591 myname = char_array_to_string(name) 00592 index = chartoindex(myname) 00593 if (index .eq. -1) return 00594 call indextos(s,index,array) 00595 00596 if (allocated (r1)) deallocate (r1) 00597 allocate(r1(size(array%r1,1))) 00598 r1(:) = array%r1(:) 00599 00600 x = c_loc(r1) 00601 get1ddoublearray_c = 0 00602 end function get1ddoublearray_c 00603 00604 integer(c_int) function get2ddoublearray_fortran(name,x) 00605 USE iso_c_binding 00606 ! String 00607 character(kind=c_char,len=*),intent(in) :: name 00608 ! use inout otherwise things break 00609 real(c_double), intent(inout) :: x(:,:) 00610 00611 type(arraytype) :: array 00612 integer :: index 00613 00614 get2ddoublearray_fortran = -1 00615 index = chartoindex(trim(name)) 00616 if (index .eq. -1) return 00617 call indextos(s,index,array) 00618 x = array%r2 00619 get2ddoublearray_fortran = 0 00620 end function get2ddoublearray_fortran 00621 00622 00623 integer(c_int) function get2ddoublearray_c(name, x, length) bind(C, name="get2ddoublearray") 00624 !DEC$ ATTRIBUTES DLLEXPORT::get2ddoublearray_c 00625 00626 ! use inout otherwise things break 00627 type(c_ptr), intent(inout) :: x 00628 ! and we need the string length .... 00629 integer(c_int),value ,intent(in) :: length 00630 ! String 00631 character(kind=c_char),intent(in) :: name(length) 00632 00633 character(length) :: myname 00634 integer :: index 00635 type(arraytype) :: array 00636 real(c_double), target, allocatable, save, dimension(:,:) :: r2 00637 00638 get2ddoublearray_c = -1 00639 myname = char_array_to_string(name) 00640 index = chartoindex(myname) 00641 if (index .eq. -1) return 00642 call indextos(s,index,array) 00643 if (allocated (r2)) deallocate (r2) 00644 allocate(r2(size(array%r2,1), size(array%r2,2))) 00645 r2(:,:) = array%r2(:,:) 00646 ! array%r2 => r2 00647 x = c_loc(r2) 00648 get2ddoublearray_c = 0 00649 end function get2ddoublearray_c 00650 00651 integer(c_int) function get3ddoublearray_fortran(name,x) 00652 USE iso_c_binding 00653 ! String 00654 character(kind=c_char,len=*),intent(in) :: name 00655 ! use inout otherwise things break 00656 real(c_double), intent(inout) :: x(:,:,:) 00657 00658 type(arraytype) :: array 00659 integer :: index 00660 00661 get3ddoublearray_fortran = -1 00662 index = chartoindex(trim(name)) 00663 if (index .eq. -1) return 00664 call indextos(s,index,array) 00665 x = array%r3 00666 get3ddoublearray_fortran = 0 00667 end function get3ddoublearray_fortran 00668 00669 00670 integer(c_int) function get3ddoublearray_c(name, x, length) bind(C, name="get3ddoublearray") 00671 !DEC$ ATTRIBUTES DLLEXPORT::get3ddoublearray_c 00672 00673 ! use inout otherwise things break 00674 type(c_ptr), intent(inout) :: x 00675 ! and we need the string length .... 00676 integer(c_int),value ,intent(in) :: length 00677 ! String 00678 character(kind=c_char),intent(in) :: name(length) 00679 00680 character(length) :: myname 00681 integer :: index 00682 type(arraytype) :: array 00683 real(c_double), target, allocatable, save, dimension(:,:,:) :: r3 00684 00685 get3ddoublearray_c = -1 00686 myname = char_array_to_string(name) 00687 index = chartoindex(myname) 00688 if (index .eq. -1) return 00689 call indextos(s,index,array) 00690 if (allocated (r3)) deallocate (r3) 00691 allocate(r3(size(array%r3,1), size(array%r3,2), size(array%r3,3))) 00692 r3(:,:,:) = array%r3(:,:,:) 00693 ! array%r3 => r3 00694 x = c_loc(r3) 00695 get3ddoublearray_c = 0 00696 end function get3ddoublearray_c 00697 00698 00699 integer(c_int) function get4ddoublearray_fortran(name,x) 00700 USE iso_c_binding 00701 ! String 00702 character(kind=c_char,len=*),intent(in) :: name 00703 ! use inout otherwise things break 00704 real(c_double), intent(inout) :: x(:,:,:,:) 00705 00706 type(arraytype) :: array 00707 integer :: index 00708 00709 get4ddoublearray_fortran = -1 00710 index = chartoindex(trim(name)) 00711 if (index .eq. -1) return 00712 call indextos(s,index,array) 00713 x = array%r4 00714 get4ddoublearray_fortran = 0 00715 end function get4ddoublearray_fortran 00716 00717 00718 integer(c_int) function get4ddoublearray_c(name, x, length) bind(C, name="get4ddoublearray") 00719 !DEC$ ATTRIBUTES DLLEXPORT::get4ddoublearray_c 00720 00721 ! use inout otherwise things break 00722 type(c_ptr), intent(inout) :: x 00723 ! and we need the string length .... 00724 integer(c_int),value ,intent(in) :: length 00725 ! String 00726 character(kind=c_char),intent(in) :: name(length) 00727 00728 character(length) :: myname 00729 integer :: index 00730 type(arraytype) :: array 00731 real(c_double), target, allocatable, save, dimension(:,:,:,:) :: r4 00732 00733 get4ddoublearray_c = -1 00734 myname = char_array_to_string(name) 00735 index = chartoindex(myname) 00736 if (index .eq. -1) return 00737 call indextos(s,index,array) 00738 if (allocated (r4)) deallocate (r4) 00739 allocate(r4(size(array%r4,1), size(array%r4,2), size(array%r4,3), size(array%r4,4))) 00740 r4(:,:,:,:) = array%r4(:,:,:,:) 00741 ! array%r4 => r4 00742 x = c_loc(r4) 00743 get4ddoublearray_c = 0 00744 end function get4ddoublearray_c 00745 00746 00747 integer(c_int) function get0dintarray_fortran(name,x) 00748 USE iso_c_binding 00749 ! String 00750 character(kind=c_char,len=*),intent(in) :: name 00751 ! use inout otherwise things break 00752 integer(c_int), intent(inout) :: x 00753 00754 type(arraytype) :: array 00755 integer :: index 00756 00757 get0dintarray_fortran = -1 00758 index = chartoindex(trim(name)) 00759 if (index .eq. -1) return 00760 call indextos(s,index,array) 00761 x = array%i0 00762 get0dintarray_fortran = 0 00763 end function get0dintarray_fortran 00764 00765 integer(c_int) function get0dintarray_c(name, x, length) bind(C, name="get0dintarray") 00766 !DEC$ ATTRIBUTES DLLEXPORT::get0dintarray_c 00767 00768 ! use inout otherwise things break 00769 type (c_ptr), intent(inout) :: x 00770 ! and we need the string length .... 00771 integer(c_int),value ,intent(in) :: length 00772 ! String 00773 character(kind=c_char),intent(in) :: name(length) 00774 00775 character(length) :: myname 00776 integer :: index 00777 type(arraytype) :: array 00778 integer(c_int), target :: i0 00779 00780 get0dintarray_c = -1 00781 myname = char_array_to_string(name) 00782 index = chartoindex(myname) 00783 if (index .eq. -1) return 00784 call indextos(s,index,array) 00785 i0 = array%i0 00786 x = c_loc(i0) 00787 get0dintarray_c = 0 00788 end function get0dintarray_c 00789 00790 integer(c_int) function get1dintarray_fortran(name,x) 00791 USE iso_c_binding 00792 ! String 00793 character(kind=c_char,len=*),intent(in) :: name 00794 ! use inout otherwise things break 00795 integer(c_int), intent(inout) :: x(:) 00796 00797 type(arraytype) :: array 00798 integer :: index 00799 00800 get1dintarray_fortran = -1 00801 index = chartoindex(trim(name)) 00802 if (index .eq. -1) return 00803 call indextos(s,index,array) 00804 x = array%i1 00805 get1dintarray_fortran = 0 00806 end function get1dintarray_fortran 00807 00808 integer(c_int) function get1dintarray_c(name, x, length) bind(C, name="get1dintarray") 00809 !DEC$ ATTRIBUTES DLLEXPORT::get1dintarray_c 00810 00811 ! use inout otherwise things break 00812 type (c_ptr), intent(inout) :: x 00813 ! and we need the string length .... 00814 integer(c_int),value ,intent(in) :: length 00815 ! String 00816 character(kind=c_char),intent(in) :: name(length) 00817 00818 character(length) :: myname 00819 integer :: index 00820 type(arraytype) :: array 00821 integer(c_int), target, allocatable, save, dimension(:) :: i1 00822 00823 get1dintarray_c = -1 00824 myname = char_array_to_string(name) 00825 index = chartoindex(myname) 00826 if (index .eq. -1) return 00827 call indextos(s,index,array) 00828 if (allocated (i1)) deallocate (i1) 00829 allocate(i1(size(array%i1,1))) 00830 i1(:) = array%i1(:) 00831 ! array%r2 => r2 00832 x = c_loc(i1) 00833 get1dintarray_c = 0 00834 end function get1dintarray_c 00835 00836 00837 00838 integer(c_int) function get2dintarray_fortran(name,x) 00839 USE iso_c_binding 00840 ! String 00841 character(kind=c_char,len=*),intent(in) :: name 00842 ! use inout otherwise things break 00843 integer(c_int), intent(inout) :: x(:,:) 00844 00845 type(arraytype) :: array 00846 integer :: index 00847 00848 get2dintarray_fortran = -1 00849 index = chartoindex(trim(name)) 00850 if (index .eq. -1) return 00851 call indextos(s,index,array) 00852 x = array%i2 00853 get2dintarray_fortran = 0 00854 end function get2dintarray_fortran 00855 00856 integer(c_int) function get2dintarray_c(name, x, length) bind(C, name="get2dintarray") 00857 !DEC$ ATTRIBUTES DLLEXPORT::get2dintarray_c 00858 00859 ! use inout otherwise things break 00860 type (c_ptr), intent(inout) :: x 00861 ! and we need the string length .... 00862 integer(c_int),value ,intent(in) :: length 00863 ! String 00864 character(kind=c_char),intent(in) :: name(length) 00865 00866 character(length) :: myname 00867 integer :: index 00868 type(arraytype) :: array 00869 integer(c_int), target, allocatable, save, dimension(:,:) :: i2 00870 00871 get2dintarray_c = -1 00872 myname = char_array_to_string(name) 00873 index = chartoindex(myname) 00874 if (index .eq. -1) return 00875 call indextos(s,index,array) 00876 if (allocated (i2)) deallocate (i2) 00877 allocate(i2(size(array%i2,1), size(array%i2,2))) 00878 i2(:,:) = array%i2(:,:) 00879 ! array%r2 => r2 00880 x = c_loc(i2) 00881 get2dintarray_c = 0 00882 end function get2dintarray_c 00883 00884 00885 integer(c_int) function set0dintarray_fortran(name,x) 00886 USE iso_c_binding 00887 ! String 00888 character(kind=c_char,len=*),intent(in) :: name 00889 ! use inout otherwise things break 00890 integer(c_int), intent(inout) :: x 00891 00892 integer :: index 00893 type(arraytype) :: array 00894 00895 set0dintarray_fortran = -1 00896 index = chartoindex(trim(name)) 00897 if (index .eq. -1) return 00898 call indextos(s,index,array) 00899 array%i0 = x 00900 set0dintarray_fortran = 0 00901 end function set0dintarray_fortran 00902 00903 integer(c_int) function set0dintarray_c(name, x, length) bind(C, name="set0dintarray") 00904 !DEC$ ATTRIBUTES DLLEXPORT::set0dintarray_c 00905 00906 ! use inout otherwise things break 00907 type (c_ptr), intent(inout) :: x 00908 ! and we need the string length .... 00909 integer(c_int),value ,intent(in) :: length 00910 ! String 00911 character(kind=c_char),intent(in) :: name(length) 00912 00913 character(length) :: myname 00914 integer :: index 00915 type(arraytype) :: array 00916 integer(c_int), pointer :: i0 00917 00918 set0dintarray_c = -1 00919 00920 myname = char_array_to_string(name) 00921 index = chartoindex(myname) 00922 if (index .eq. -1) return 00923 call indextos(s,index,array) 00924 ! Transform the c pointer into a fortran pointer 00925 call c_f_pointer(x, i0) 00926 ! Copy the values, or the pointer... not sure. 00927 array%i0 = i0 00928 00929 set0dintarray_c = 0 00930 end function set0dintarray_c 00931 00932 integer(c_int) function set1dintarray_fortran(name,x) 00933 USE iso_c_binding 00934 ! String 00935 character(kind=c_char,len=*),intent(in) :: name 00936 ! use inout otherwise things break 00937 integer(c_int), intent(inout) :: x(:) 00938 00939 integer :: index 00940 type(arraytype) :: array 00941 00942 set1dintarray_fortran = -1 00943 index = chartoindex(trim(name)) 00944 if (index .eq. -1) return 00945 call indextos(s,index,array) 00946 array%i1 = x 00947 set1dintarray_fortran = 0 00948 end function set1dintarray_fortran 00949 00950 integer(c_int) function set1dintarray_c(name, x, length) bind(C, name="set1dintarray") 00951 !DEC$ ATTRIBUTES DLLEXPORT::set1dintarray_c 00952 00953 ! use inout otherwise things break 00954 type (c_ptr), intent(inout) :: x 00955 ! and we need the string length .... 00956 integer(c_int),value ,intent(in) :: length 00957 ! String 00958 character(kind=c_char),intent(in) :: name(length) 00959 00960 character(length) :: myname 00961 integer :: index 00962 type(arraytype) :: array 00963 integer(c_int), pointer, dimension(:) :: i1 00964 00965 set1dintarray_c = -1 00966 00967 myname = char_array_to_string(name) 00968 index = chartoindex(myname) 00969 if (index .eq. -1) return 00970 call indextos(s,index,array) 00971 ! Transform the c pointer into a fortran pointer 00972 call c_f_pointer(x, i1, shape(array%i1)) 00973 ! Copy the values, or the pointer... not sure. 00974 array%i1 = i1 00975 00976 set1dintarray_c = 0 00977 end function set1dintarray_c 00978 00979 integer(c_int) function set2dintarray_fortran(name,x) 00980 USE iso_c_binding 00981 ! String 00982 character(kind=c_char,len=*),intent(in) :: name 00983 ! use inout otherwise things break 00984 integer(c_int), intent(inout) :: x(:,:) 00985 00986 integer :: index 00987 type(arraytype) :: array 00988 00989 set2dintarray_fortran = -1 00990 index = chartoindex(trim(name)) 00991 if (index .eq. -1) return 00992 call indextos(s,index,array) 00993 array%i2 = x 00994 set2dintarray_fortran = 0 00995 end function set2dintarray_fortran 00996 00997 integer(c_int) function set2dintarray_c(name, x, length) bind(C, name="set2dintarray") 00998 !DEC$ ATTRIBUTES DLLEXPORT::set2dintarray_c 00999 01000 ! use inout otherwise things break 01001 type (c_ptr), intent(inout) :: x 01002 ! and we need the string length .... 01003 integer(c_int),value ,intent(in) :: length 01004 ! String 01005 character(kind=c_char),intent(in) :: name(length) 01006 01007 character(length) :: myname 01008 integer :: index 01009 type(arraytype) :: array 01010 integer(c_int), pointer, dimension(:,:) :: i2 01011 01012 set2dintarray_c = -1 01013 01014 myname = char_array_to_string(name) 01015 index = chartoindex(myname) 01016 if (index .eq. -1) return 01017 call indextos(s,index,array) 01018 ! Transform the c pointer into a fortran pointer 01019 call c_f_pointer(x, i2, shape(array%i2)) 01020 ! Copy the values, or the pointer... not sure. 01021 array%i2 = i2 01022 01023 set2dintarray_c = 0 01024 end function set2dintarray_c 01025 01026 integer(c_int) function set0ddoublearray_fortran(name,x) 01027 USE iso_c_binding 01028 ! String 01029 character(kind=c_char,len=*),intent(in) :: name 01030 ! use inout otherwise things break 01031 real(c_double), intent(inout) :: x 01032 01033 integer :: index 01034 type(arraytype) :: array 01035 01036 set0ddoublearray_fortran = -1 01037 index = chartoindex(trim(name)) 01038 if (index .eq. -1) return 01039 call indextos(s,index,array) 01040 array%r0 = x 01041 set0ddoublearray_fortran = 0 01042 end function set0ddoublearray_fortran 01043 01044 integer(c_int) function set0ddoublearray_c(name, x, length) bind(C, name="set0ddoublearray") 01045 !DEC$ ATTRIBUTES DLLEXPORT::set0ddoublearray_c 01046 01047 ! use inout otherwise things break 01048 type (c_ptr), intent(inout) :: x 01049 ! and we need the string length .... 01050 integer(c_int),value ,intent(in) :: length 01051 ! String 01052 character(kind=c_char),intent(in) :: name(length) 01053 01054 character(length) :: myname 01055 integer :: index 01056 type(arraytype) :: array 01057 real(c_double), pointer :: r0 01058 01059 set0ddoublearray_c = -1 01060 01061 myname = char_array_to_string(name) 01062 index = chartoindex(myname) 01063 if (index .eq. -1) return 01064 call indextos(s,index,array) 01065 ! Transform the c pointer into a fortran pointer 01066 call c_f_pointer(x, r0) 01067 ! Copy the values, or the pointer... not sure. 01068 array%r0 = r0 01069 01070 set0ddoublearray_c = 0 01071 end function set0ddoublearray_c 01072 01073 integer(c_int) function set1ddoublearray_fortran(name,x) 01074 USE iso_c_binding 01075 ! String 01076 character(kind=c_char,len=*),intent(in) :: name 01077 ! use inout otherwise things break 01078 real(c_double), intent(inout) :: x(:) 01079 01080 integer :: index 01081 type(arraytype) :: array 01082 01083 set1ddoublearray_fortran = -1 01084 index = chartoindex(trim(name)) 01085 if (index .eq. -1) return 01086 call indextos(s,index,array) 01087 array%r1 = x 01088 set1ddoublearray_fortran = 0 01089 end function set1ddoublearray_fortran 01090 01091 integer(c_int) function set1ddoublearray_c(name, x, length) bind(C, name="set1ddoublearray") 01092 !DEC$ ATTRIBUTES DLLEXPORT::set1ddoublearray_c 01093 01094 ! use inout otherwise things break 01095 type (c_ptr), intent(inout) :: x 01096 ! and we need the string length .... 01097 integer(c_int),value ,intent(in) :: length 01098 ! String 01099 character(kind=c_char),intent(in) :: name(length) 01100 01101 character(length) :: myname 01102 integer :: index 01103 type(arraytype) :: array 01104 real(c_double), pointer, dimension(:) :: r1 01105 01106 set1ddoublearray_c = -1 01107 01108 myname = char_array_to_string(name) 01109 index = chartoindex(myname) 01110 if (index .eq. -1) return 01111 call indextos(s,index,array) 01112 ! Transform the c pointer into a fortran pointer 01113 call c_f_pointer(x, r1, shape(array%r1)) 01114 ! Copy the values, or the pointer... not sure. 01115 array%r1 = r1 01116 01117 set1ddoublearray_c = 0 01118 end function set1ddoublearray_c 01119 01120 01121 integer(c_int) function set2ddoublearray_fortran(name,x) 01122 USE iso_c_binding 01123 ! String 01124 character(kind=c_char,len=*),intent(in) :: name 01125 ! use inout otherwise things break 01126 real(c_double), intent(inout) :: x(:,:) 01127 01128 integer :: index 01129 type(arraytype) :: array 01130 01131 set2ddoublearray_fortran = -1 01132 index = chartoindex(trim(name)) 01133 if (index .eq. -1) return 01134 call indextos(s,index,array) 01135 array%r2 = x 01136 set2ddoublearray_fortran = 0 01137 end function set2ddoublearray_fortran 01138 01139 integer(c_int) function set2ddoublearray_c(name, x, length) bind(C, name="set2ddoublearray") 01140 !DEC$ ATTRIBUTES DLLEXPORT::set2ddoublearray_c 01141 01142 ! use inout otherwise things break 01143 type (c_ptr), intent(inout) :: x 01144 ! and we need the string length .... 01145 integer(c_int),value ,intent(in) :: length 01146 ! String 01147 character(kind=c_char),intent(in) :: name(length) 01148 01149 character(length) :: myname 01150 integer :: index 01151 type(arraytype) :: array 01152 real(c_double), pointer, dimension(:,:) :: r2 01153 01154 set2ddoublearray_c = -1 01155 01156 myname = char_array_to_string(name) 01157 index = chartoindex(myname) 01158 if (index .eq. -1) return 01159 call indextos(s,index,array) 01160 ! Transform the c pointer into a fortran pointer 01161 call c_f_pointer(x, r2, shape(array%r2)) 01162 ! Copy the values, or the pointer... not sure. 01163 array%r2 = r2 01164 01165 set2ddoublearray_c = 0 01166 end function set2ddoublearray_c 01167 01168 01169 integer(c_int) function set3ddoublearray_fortran(name,x) 01170 USE iso_c_binding 01171 ! String 01172 character(kind=c_char,len=*),intent(in) :: name 01173 ! use inout otherwise things break 01174 real(c_double), intent(inout) :: x(:,:,:) 01175 01176 integer :: index 01177 type(arraytype) :: array 01178 01179 set3ddoublearray_fortran = -1 01180 index = chartoindex(trim(name)) 01181 if (index .eq. -1) return 01182 call indextos(s,index,array) 01183 array%r3 = x 01184 set3ddoublearray_fortran = 0 01185 end function set3ddoublearray_fortran 01186 01187 integer(c_int) function set3ddoublearray_c(name, x, length) bind(C, name="set3ddoublearray") 01188 !DEC$ ATTRIBUTES DLLEXPORT::set3ddoublearray_c 01189 01190 ! use inout otherwise things break 01191 type (c_ptr), intent(inout) :: x 01192 ! and we need the string length .... 01193 integer(c_int),value ,intent(in) :: length 01194 ! String 01195 character(kind=c_char),intent(in) :: name(length) 01196 01197 character(length) :: myname 01198 integer :: index 01199 type(arraytype) :: array 01200 real(c_double), pointer, dimension(:,:,:) :: r3 01201 01202 set3ddoublearray_c = -1 01203 01204 myname = char_array_to_string(name) 01205 index = chartoindex(myname) 01206 if (index .eq. -1) return 01207 call indextos(s,index,array) 01208 ! Transform the c pointer into a fortran pointer 01209 call c_f_pointer(x, r3, shape(array%r3)) 01210 ! Copy the values, or the pointer... not sure. 01211 array%r3 = r3 01212 01213 set3ddoublearray_c = 0 01214 end function set3ddoublearray_c 01215 01216 01217 integer(c_int) function set4ddoublearray_fortran(name,x) 01218 USE iso_c_binding 01219 ! String 01220 character(kind=c_char,len=*),intent(in) :: name 01221 ! use inout otherwise things break 01222 real(c_double), intent(inout) :: x(:,:,:,:) 01223 01224 integer :: index 01225 type(arraytype) :: array 01226 01227 set4ddoublearray_fortran = -1 01228 index = chartoindex(trim(name)) 01229 if (index .eq. -1) return 01230 call indextos(s,index,array) 01231 array%r4 = x 01232 set4ddoublearray_fortran = 0 01233 end function set4ddoublearray_fortran 01234 01235 integer(c_int) function set4ddoublearray_c(name, x, length) bind(C, name="set4ddoublearray") 01236 !DEC$ ATTRIBUTES DLLEXPORT::set4ddoublearray_c 01237 01238 ! use inout otherwise things break 01239 type (c_ptr), intent(inout) :: x 01240 ! and we need the string length .... 01241 integer(c_int),value ,intent(in) :: length 01242 ! String 01243 character(kind=c_char),intent(in) :: name(length) 01244 01245 character(length) :: myname 01246 integer :: index 01247 type(arraytype) :: array 01248 real(c_double), pointer, dimension(:,:,:,:) :: r4 01249 01250 set4ddoublearray_c = -1 01251 01252 myname = char_array_to_string(name) 01253 index = chartoindex(myname) 01254 if (index .eq. -1) return 01255 call indextos(s,index,array) 01256 ! Transform the c pointer into a fortran pointer 01257 call c_f_pointer(x, r4, shape(array%r4)) 01258 ! Copy the values, or the pointer... not sure. 01259 array%r4 = r4 01260 01261 set4ddoublearray_c = 0 01262 end function set4ddoublearray_c 01263 01264 end module introspection_module
1.7.6.1
