[6328] | 1 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 2 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 3 | !----------------------------------------------------------------------- |
---|
| 4 | ! CVS $Id$ |
---|
| 5 | ! CVS $Name$ |
---|
| 6 | !BOP ------------------------------------------------------------------- |
---|
| 7 | ! |
---|
| 8 | ! !MODULE: m_String - The String Datatype |
---|
| 9 | ! |
---|
| 10 | ! !DESCRIPTION: |
---|
| 11 | ! The {\tt String} datatype is an encapsulated pointer to a one-dimensional |
---|
| 12 | ! array of single characters. This allows one to define variable-length |
---|
| 13 | ! strings, and arrays of variable-length strings. |
---|
| 14 | ! |
---|
| 15 | ! !INTERFACE: |
---|
| 16 | |
---|
| 17 | module m_String |
---|
| 18 | |
---|
| 19 | ! !USES: |
---|
| 20 | ! No external modules are used in the declaration section of this module. |
---|
| 21 | |
---|
| 22 | implicit none |
---|
| 23 | |
---|
| 24 | private ! except |
---|
| 25 | |
---|
| 26 | ! !PUBLIC TYPES: |
---|
| 27 | |
---|
| 28 | public :: String ! The class data structure |
---|
| 29 | |
---|
| 30 | Type String |
---|
| 31 | #ifdef SEQUENCE |
---|
| 32 | sequence |
---|
| 33 | #endif |
---|
| 34 | character(len=1),dimension(:),pointer :: c |
---|
| 35 | End Type String |
---|
| 36 | |
---|
| 37 | ! !PUBLIC MEMBER FUNCTIONS: |
---|
| 38 | |
---|
| 39 | public :: toChar |
---|
| 40 | public :: char ! convert to a CHARACTER(*) |
---|
| 41 | |
---|
| 42 | public :: String_init |
---|
| 43 | public :: init ! set a CHARACTER(*) type to a String |
---|
| 44 | |
---|
| 45 | public :: String_clean |
---|
| 46 | public :: clean ! Deallocate memory occupied by a String |
---|
| 47 | |
---|
| 48 | public :: String_len |
---|
| 49 | public :: len ! length of a String |
---|
| 50 | |
---|
| 51 | public :: String_bcast |
---|
| 52 | public :: bcast ! Broadcast a String |
---|
| 53 | |
---|
| 54 | public :: String_mci ! Track memory used to store a String |
---|
| 55 | public :: String_mco |
---|
| 56 | |
---|
| 57 | public :: ptr_chars ! Assign a pointer to a String's |
---|
| 58 | ! character buffer |
---|
| 59 | |
---|
| 60 | interface char; module procedure & |
---|
| 61 | str2ch0_, & |
---|
| 62 | ch12ch0_ |
---|
| 63 | end interface |
---|
| 64 | |
---|
| 65 | interface toChar; module procedure & |
---|
| 66 | str2ch0_, & |
---|
| 67 | ch12ch0_ |
---|
| 68 | end interface |
---|
| 69 | |
---|
| 70 | interface String_init; module procedure & |
---|
| 71 | initc_, & |
---|
| 72 | initc1_, & |
---|
| 73 | inits_ |
---|
| 74 | end interface |
---|
| 75 | |
---|
| 76 | interface init; module procedure & |
---|
| 77 | initc_, & |
---|
| 78 | initc1_, & |
---|
| 79 | inits_ |
---|
| 80 | end interface |
---|
| 81 | |
---|
| 82 | interface String_clean; module procedure clean_; end interface |
---|
| 83 | interface clean; module procedure clean_; end interface |
---|
| 84 | interface String_len; module procedure len_; end interface |
---|
| 85 | interface len; module procedure len_; end interface |
---|
| 86 | interface String_bcast; module procedure bcast_; end interface |
---|
| 87 | interface bcast; module procedure bcast_; end interface |
---|
| 88 | |
---|
| 89 | interface String_mci; module procedure & |
---|
| 90 | mci0_, & |
---|
| 91 | mci1_, & |
---|
| 92 | mci2_, & |
---|
| 93 | mci3_ |
---|
| 94 | end interface |
---|
| 95 | |
---|
| 96 | interface String_mco; module procedure & |
---|
| 97 | mco0_, & |
---|
| 98 | mco1_, & |
---|
| 99 | mco2_, & |
---|
| 100 | mco3_ |
---|
| 101 | end interface |
---|
| 102 | |
---|
| 103 | interface ptr_chars; module procedure & |
---|
| 104 | ptr_chars_ |
---|
| 105 | end interface |
---|
| 106 | |
---|
| 107 | ! !REVISION HISTORY: |
---|
| 108 | ! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 109 | !EOP ___________________________________________________________________ |
---|
| 110 | |
---|
| 111 | character(len=*),parameter :: myname='MCT(MPEU)::m_String' |
---|
| 112 | |
---|
| 113 | contains |
---|
| 114 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 115 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 116 | !BOP ------------------------------------------------------------------- |
---|
| 117 | ! |
---|
| 118 | ! !IROUTINE: str2ch0_ - Convert a String to a CHARACTER |
---|
| 119 | ! |
---|
| 120 | ! !DESCRIPTION: |
---|
| 121 | ! This function returns the contents of the character buffer of the |
---|
| 122 | ! input {\tt String} argument {\tt str} as a {\tt CHARCTER} suitable |
---|
| 123 | ! for printing. |
---|
| 124 | ! |
---|
| 125 | ! !INTERFACE: |
---|
| 126 | |
---|
| 127 | function str2ch0_(str) |
---|
| 128 | |
---|
| 129 | ! !USES: |
---|
| 130 | ! |
---|
| 131 | ! No external modules are used by this function. |
---|
| 132 | |
---|
| 133 | implicit none |
---|
| 134 | |
---|
| 135 | ! !INPUT PARAMETERS: |
---|
| 136 | ! |
---|
| 137 | type(String), intent(in) :: str |
---|
| 138 | |
---|
| 139 | ! !OUTPUT PARAMETERS: |
---|
| 140 | ! |
---|
| 141 | character(len=size(str%c,1)) :: str2ch0_ |
---|
| 142 | |
---|
| 143 | ! !REVISION HISTORY: |
---|
| 144 | ! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 145 | !EOP ___________________________________________________________________ |
---|
| 146 | |
---|
| 147 | character(len=*),parameter :: myname_=myname//'::str2ch0_' |
---|
| 148 | integer :: i |
---|
| 149 | |
---|
| 150 | do i=1,size(str%c) |
---|
| 151 | str2ch0_(i:i)=str%c(i) |
---|
| 152 | end do |
---|
| 153 | |
---|
| 154 | end function str2ch0_ |
---|
| 155 | |
---|
| 156 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 157 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 158 | !BOP ------------------------------------------------------------------- |
---|
| 159 | ! |
---|
| 160 | ! !IROUTINE: ch12ch0_ - Convert a CHARACTER(:) to a CHARACTER(*) |
---|
| 161 | ! |
---|
| 162 | ! !DESCRIPTION: |
---|
| 163 | ! This function takes an input one-dimensional array of single characters |
---|
| 164 | ! and returns a single character string. |
---|
| 165 | ! |
---|
| 166 | ! !INTERFACE: |
---|
| 167 | |
---|
| 168 | function ch12ch0_(ch1) |
---|
| 169 | |
---|
| 170 | ! !USES: |
---|
| 171 | ! |
---|
| 172 | ! No external modules are used by this function. |
---|
| 173 | |
---|
| 174 | implicit none |
---|
| 175 | |
---|
| 176 | ! !INPUT PARAMETERS: |
---|
| 177 | ! |
---|
| 178 | character(len=1), dimension(:), intent(in) :: ch1 |
---|
| 179 | |
---|
| 180 | ! !OUTPUT PARAMETERS: |
---|
| 181 | ! |
---|
| 182 | character(len=size(ch1,1)) :: ch12ch0_ |
---|
| 183 | |
---|
| 184 | ! !REVISION HISTORY: |
---|
| 185 | ! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 186 | !EOP ___________________________________________________________________ |
---|
| 187 | |
---|
| 188 | character(len=*),parameter :: myname_=myname//'::ch12ch0_' |
---|
| 189 | integer :: i |
---|
| 190 | |
---|
| 191 | do i=1,size(ch1) |
---|
| 192 | ch12ch0_(i:i)=ch1(i) |
---|
| 193 | end do |
---|
| 194 | |
---|
| 195 | end function ch12ch0_ |
---|
| 196 | |
---|
| 197 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 198 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 199 | !BOP ------------------------------------------------------------------- |
---|
| 200 | ! |
---|
| 201 | ! !IROUTINE: initc_ - Create a String using a CHARACTER |
---|
| 202 | ! |
---|
| 203 | ! !DESCRIPTION: |
---|
| 204 | ! This routine takes an input scalar {\tt CHARACTER} argument {\tt chr}, |
---|
| 205 | ! and uses it to create the output {\tt String} argument {\tt str}. |
---|
| 206 | ! |
---|
| 207 | ! !INTERFACE: |
---|
| 208 | |
---|
| 209 | subroutine initc_(str, chr) |
---|
| 210 | |
---|
| 211 | ! !USES: |
---|
| 212 | ! |
---|
| 213 | use m_die, only : die,perr |
---|
| 214 | use m_mall,only : mall_mci,mall_ison |
---|
| 215 | |
---|
| 216 | implicit none |
---|
| 217 | |
---|
| 218 | ! !INPUT PARAMETERS: |
---|
| 219 | ! |
---|
| 220 | character(len=*), intent(in) :: chr |
---|
| 221 | |
---|
| 222 | ! !OUTPUT PARAMETERS: |
---|
| 223 | ! |
---|
| 224 | type(String), intent(out) :: str |
---|
| 225 | |
---|
| 226 | ! !REVISION HISTORY: |
---|
| 227 | ! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 228 | !EOP ___________________________________________________________________ |
---|
| 229 | |
---|
| 230 | character(len=*),parameter :: myname_=myname//'::initc_' |
---|
| 231 | integer :: ln,ier,i |
---|
| 232 | |
---|
| 233 | ln=len(chr) |
---|
| 234 | allocate(str%c(ln),stat=ier) |
---|
| 235 | if(ier /= 0) then |
---|
| 236 | call perr(myname_,'allocate()',ier) |
---|
| 237 | call die(myname_) |
---|
| 238 | endif |
---|
| 239 | |
---|
| 240 | if(mall_ison()) call mall_mci(str%c,myname) |
---|
| 241 | |
---|
| 242 | do i=1,ln |
---|
| 243 | str%c(i)=chr(i:i) |
---|
| 244 | end do |
---|
| 245 | |
---|
| 246 | end subroutine initc_ |
---|
| 247 | |
---|
| 248 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 249 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
| 250 | !BOP ------------------------------------------------------------------- |
---|
| 251 | ! |
---|
| 252 | ! !IROUTINE: initc1_ - Create a String using a CHARACTER array |
---|
| 253 | ! |
---|
| 254 | ! !DESCRIPTION: |
---|
| 255 | ! This routine takes an input {\tt CHARACTER(:)} argument {\tt chr}, |
---|
| 256 | ! and uses it to create the output {\tt String} argument {\tt str}. |
---|
| 257 | ! |
---|
| 258 | ! !INTERFACE: |
---|
| 259 | |
---|
| 260 | subroutine initc1_(str, chr) |
---|
| 261 | |
---|
| 262 | ! !USES: |
---|
| 263 | ! |
---|
| 264 | use m_die, only : die,perr |
---|
| 265 | use m_mall,only : mall_mci,mall_ison |
---|
| 266 | |
---|
| 267 | implicit none |
---|
| 268 | |
---|
| 269 | ! !INPUT PARAMETERS: |
---|
| 270 | ! |
---|
| 271 | character, dimension(:), intent(in) :: chr |
---|
| 272 | |
---|
| 273 | ! !OUTPUT PARAMETERS: |
---|
| 274 | ! |
---|
| 275 | type(String), intent(out) :: str |
---|
| 276 | |
---|
| 277 | ! !REVISION HISTORY: |
---|
| 278 | ! 2Aug02 - J. Larson <larson@mcs.anl.gov> - initial prototype |
---|
| 279 | !EOP ___________________________________________________________________ |
---|
| 280 | |
---|
| 281 | character(len=*),parameter :: myname_=myname//'::initc1_' |
---|
| 282 | integer :: ln,ier,i |
---|
| 283 | |
---|
| 284 | ln=size(chr) |
---|
| 285 | allocate(str%c(ln),stat=ier) |
---|
| 286 | if(ier /= 0) then |
---|
| 287 | call perr(myname_,'allocate()',ier) |
---|
| 288 | call die(myname_) |
---|
| 289 | endif |
---|
| 290 | |
---|
| 291 | if(mall_ison()) call mall_mci(str%c,myname) |
---|
| 292 | |
---|
| 293 | do i=1,ln |
---|
| 294 | str%c(i)=chr(i) |
---|
| 295 | end do |
---|
| 296 | |
---|
| 297 | end subroutine initc1_ |
---|
| 298 | |
---|
| 299 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 300 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 301 | !BOP ------------------------------------------------------------------- |
---|
| 302 | ! |
---|
| 303 | ! !IROUTINE: inits_ - Initialization of a String from another String |
---|
| 304 | ! |
---|
| 305 | ! !DESCRIPTION: |
---|
| 306 | ! This routine takes an input {\tt String} argument {\tt iStr} and |
---|
| 307 | ! creates an output {\tt String} argument {\tt oStr}. In other words, |
---|
| 308 | ! it copies {\tt iStr} to {\tt oStr}. |
---|
| 309 | ! |
---|
| 310 | ! !INTERFACE: |
---|
| 311 | |
---|
| 312 | subroutine inits_(oStr, iStr) |
---|
| 313 | |
---|
| 314 | ! !USES: |
---|
| 315 | ! |
---|
| 316 | use m_die, only : die |
---|
| 317 | use m_mall,only : mall_mci,mall_ison |
---|
| 318 | |
---|
| 319 | implicit none |
---|
| 320 | |
---|
| 321 | ! !INPUT PARAMETERS: |
---|
| 322 | ! |
---|
| 323 | type(String), intent(in) :: iStr |
---|
| 324 | |
---|
| 325 | ! !OUTPUT PARAMETERS: |
---|
| 326 | ! |
---|
| 327 | type(String), intent(out) :: oStr |
---|
| 328 | |
---|
| 329 | ! !REVISION HISTORY: |
---|
| 330 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
| 331 | ! - initial prototype/prolog/code |
---|
| 332 | !EOP ___________________________________________________________________ |
---|
| 333 | |
---|
| 334 | character(len=*),parameter :: myname_=myname//'::inits_' |
---|
| 335 | integer :: ln,ier,i |
---|
| 336 | |
---|
| 337 | ln=size(iStr%c) |
---|
| 338 | |
---|
| 339 | allocate(oStr%c(ln),stat=ier) |
---|
| 340 | if(ier /= 0) call die(myname_,'allocate()',ier) |
---|
| 341 | |
---|
| 342 | if(mall_ison()) call mall_mci(oStr%c,myname) |
---|
| 343 | |
---|
| 344 | do i=1,ln |
---|
| 345 | oStr%c(i)=iStr%c(i) |
---|
| 346 | end do |
---|
| 347 | |
---|
| 348 | end subroutine inits_ |
---|
| 349 | |
---|
| 350 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 351 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 352 | !BOP ------------------------------------------------------------------- |
---|
| 353 | ! |
---|
| 354 | ! !IROUTINE: clean_ - Deallocate Memory Occupied by a String |
---|
| 355 | ! |
---|
| 356 | ! !DESCRIPTION: |
---|
| 357 | ! This routine deallocates memory associated with the input/output |
---|
| 358 | ! {\tt String} argument {\tt str}. This amounts to deallocating |
---|
| 359 | ! {\tt str\%c}. |
---|
| 360 | ! |
---|
| 361 | ! !INTERFACE: |
---|
| 362 | |
---|
| 363 | subroutine clean_(str) |
---|
| 364 | |
---|
| 365 | ! !USES: |
---|
| 366 | ! |
---|
| 367 | use m_die, only : die,perr |
---|
| 368 | use m_mall,only : mall_mco,mall_ison |
---|
| 369 | |
---|
| 370 | implicit none |
---|
| 371 | |
---|
| 372 | ! !INPUT/OUTPUT PARAMETERS: |
---|
| 373 | ! |
---|
| 374 | type(String), intent(inout) :: str |
---|
| 375 | |
---|
| 376 | ! !REVISION HISTORY: |
---|
| 377 | ! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 378 | !EOP ___________________________________________________________________ |
---|
| 379 | |
---|
| 380 | character(len=*),parameter :: myname_=myname//'::clean_' |
---|
| 381 | integer :: ier |
---|
| 382 | |
---|
| 383 | if(mall_ison()) call mall_mco(str%c,myname) |
---|
| 384 | |
---|
| 385 | deallocate(str%c,stat=ier) |
---|
| 386 | if(ier /= 0) then |
---|
| 387 | call perr(myname_,'deallocate()',ier) |
---|
| 388 | call die(myname_) |
---|
| 389 | endif |
---|
| 390 | |
---|
| 391 | end subroutine clean_ |
---|
| 392 | |
---|
| 393 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 394 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 395 | !BOP ------------------------------------------------------------------- |
---|
| 396 | ! |
---|
| 397 | ! !IROUTINE: bcast_ - MPI Broadcast of a rank-0 String |
---|
| 398 | ! |
---|
| 399 | ! !DESCRIPTION: |
---|
| 400 | ! This routine performs an MPI broadcast of the input/output {\tt String} |
---|
| 401 | ! argument {\tt Str} on a communicator associated with the Fortran integer |
---|
| 402 | ! handle {\tt comm}. The broadcast originates from the process with rank |
---|
| 403 | ! given by {\tt root} on {\tt comm}. The {\tt String} argument {\tt Str} |
---|
| 404 | ! is on entry valid only on the {\tt root} process, and is valid on exit |
---|
| 405 | ! on all processes on the communicator {\tt comm}. The success (failure) |
---|
| 406 | ! is signified by a zero (non-zero) value of the optional {\tt INTEGER} |
---|
| 407 | ! output argument {\tt stat}. |
---|
| 408 | ! |
---|
| 409 | ! !INTERFACE: |
---|
| 410 | |
---|
| 411 | subroutine bcast_(Str, root, comm, stat) |
---|
| 412 | |
---|
| 413 | ! !USES: |
---|
| 414 | ! |
---|
| 415 | use m_mpif90 |
---|
| 416 | use m_die, only : perr,die |
---|
| 417 | use m_mall,only : mall_mci,mall_ison |
---|
| 418 | |
---|
| 419 | implicit none |
---|
| 420 | |
---|
| 421 | ! !INPUT PARAMETERS: |
---|
| 422 | ! |
---|
| 423 | integer, intent(in) :: root |
---|
| 424 | integer, intent(in) :: comm |
---|
| 425 | |
---|
| 426 | ! !INPUT/OUTPUT PARAMETERS: |
---|
| 427 | ! |
---|
| 428 | type(String), intent(inout) :: Str ! (IN) on the root, |
---|
| 429 | ! (OUT) elsewhere |
---|
| 430 | |
---|
| 431 | ! !OUTPUT PARAMETERS: |
---|
| 432 | ! |
---|
| 433 | integer, optional, intent(out) :: stat |
---|
| 434 | |
---|
| 435 | ! !REVISION HISTORY: |
---|
| 436 | ! 27Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 437 | !EOP ___________________________________________________________________ |
---|
| 438 | |
---|
| 439 | character(len=*),parameter :: myname_=myname//'::bcast_' |
---|
| 440 | integer :: ln,ier,myID |
---|
| 441 | |
---|
| 442 | if(present(stat)) stat=0 |
---|
| 443 | |
---|
| 444 | call MP_comm_rank(comm,myID,ier) |
---|
| 445 | if(ier /= 0) then |
---|
| 446 | call MP_perr(myname_,'MP_comm_rank()',ier) |
---|
| 447 | if(.not.present(stat)) call die(myname_) |
---|
| 448 | stat=ier |
---|
| 449 | return |
---|
| 450 | endif |
---|
| 451 | |
---|
| 452 | if(myID==root) then |
---|
| 453 | ln=size(Str%c) |
---|
| 454 | if(ln<=0) call die(myname_,'size(Str%c) <= 0') |
---|
| 455 | endif |
---|
| 456 | |
---|
| 457 | call MPI_bcast(ln,1,MP_INTEGER,root,comm,ier) |
---|
| 458 | if(ier/=0) then |
---|
| 459 | call MP_perr(myname_,'MPI_bcast(ln)',ier) |
---|
| 460 | if(.not.present(stat)) call die(myname_) |
---|
| 461 | stat=ier |
---|
| 462 | return |
---|
| 463 | endif |
---|
| 464 | |
---|
| 465 | if(myID /= root) then |
---|
| 466 | |
---|
| 467 | allocate(Str%c(ln),stat=ier) |
---|
| 468 | if(ier /= 0) then |
---|
| 469 | call perr(myname_,'allocate()',ier) |
---|
| 470 | if(.not.present(stat)) call die(myname_) |
---|
| 471 | stat=ier |
---|
| 472 | return |
---|
| 473 | endif |
---|
| 474 | |
---|
| 475 | if(mall_ison()) call mall_mci(Str%c,myname) |
---|
| 476 | endif |
---|
| 477 | |
---|
| 478 | call MPI_bcast(Str%c(1),ln,MP_CHARACTER,root,comm,ier) |
---|
| 479 | if(ier/=0) then |
---|
| 480 | call MP_perr(myname_,'MPI_bcast(Str%c)',ier) |
---|
| 481 | if(.not.present(stat)) call die(myname_) |
---|
| 482 | stat=ier |
---|
| 483 | return |
---|
| 484 | endif |
---|
| 485 | |
---|
| 486 | end subroutine bcast_ |
---|
| 487 | |
---|
| 488 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 489 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 490 | !BOP ------------------------------------------------------------------- |
---|
| 491 | ! |
---|
| 492 | ! !IROUTINE: mci0_ - checking in a String scalar |
---|
| 493 | ! |
---|
| 494 | ! !DESCRIPTION: |
---|
| 495 | ! |
---|
| 496 | ! !INTERFACE: |
---|
| 497 | |
---|
| 498 | subroutine mci0_(marg,thread) |
---|
| 499 | |
---|
| 500 | ! !USES: |
---|
| 501 | ! |
---|
| 502 | use m_mall, only : mall_ci |
---|
| 503 | |
---|
| 504 | implicit none |
---|
| 505 | |
---|
| 506 | ! !INPUT PARAMETERS: |
---|
| 507 | ! |
---|
| 508 | type(String), intent(in) :: marg |
---|
| 509 | character(len=*), intent(in) :: thread |
---|
| 510 | |
---|
| 511 | ! !REVISION HISTORY: |
---|
| 512 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
| 513 | ! - initial prototype/prolog/code |
---|
| 514 | !EOP ___________________________________________________________________ |
---|
| 515 | |
---|
| 516 | character(len=*),parameter :: myname_=myname//'::mci0_' |
---|
| 517 | |
---|
| 518 | call mall_ci(1,thread) |
---|
| 519 | |
---|
| 520 | end subroutine mci0_ |
---|
| 521 | |
---|
| 522 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 523 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 524 | !BOP ------------------------------------------------------------------- |
---|
| 525 | ! |
---|
| 526 | ! !IROUTINE: mco0_ - checking out a String scalar |
---|
| 527 | ! |
---|
| 528 | ! !DESCRIPTION: |
---|
| 529 | ! |
---|
| 530 | ! !INTERFACE: |
---|
| 531 | |
---|
| 532 | subroutine mco0_(marg,thread) |
---|
| 533 | |
---|
| 534 | ! !USES: |
---|
| 535 | ! |
---|
| 536 | use m_mall, only : mall_co |
---|
| 537 | |
---|
| 538 | implicit none |
---|
| 539 | |
---|
| 540 | type(String), intent(in) :: marg |
---|
| 541 | character(len=*),intent(in) :: thread |
---|
| 542 | |
---|
| 543 | ! !REVISION HISTORY: |
---|
| 544 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
| 545 | ! - initial prototype/prolog/code |
---|
| 546 | !EOP ___________________________________________________________________ |
---|
| 547 | |
---|
| 548 | character(len=*),parameter :: myname_=myname//'::mco0_' |
---|
| 549 | |
---|
| 550 | call mall_co(1,thread) |
---|
| 551 | |
---|
| 552 | end subroutine mco0_ |
---|
| 553 | |
---|
| 554 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 555 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 556 | !BOP ------------------------------------------------------------------- |
---|
| 557 | ! |
---|
| 558 | ! !IROUTINE: mci1_ - checking in a String scalar |
---|
| 559 | ! |
---|
| 560 | ! !DESCRIPTION: |
---|
| 561 | ! |
---|
| 562 | ! !INTERFACE: |
---|
| 563 | |
---|
| 564 | subroutine mci1_(marg,thread) |
---|
| 565 | |
---|
| 566 | ! !USES: |
---|
| 567 | ! |
---|
| 568 | use m_mall, only : mall_ci |
---|
| 569 | |
---|
| 570 | implicit none |
---|
| 571 | |
---|
| 572 | ! !INPUT PARAMETERS: |
---|
| 573 | ! |
---|
| 574 | type(String), dimension(:), intent(in) :: marg |
---|
| 575 | character(len=*), intent(in) :: thread |
---|
| 576 | |
---|
| 577 | ! !REVISION HISTORY: |
---|
| 578 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
| 579 | ! - initial prototype/prolog/code |
---|
| 580 | !EOP ___________________________________________________________________ |
---|
| 581 | |
---|
| 582 | character(len=*),parameter :: myname_=myname//'::mci1_' |
---|
| 583 | |
---|
| 584 | call mall_ci(size(marg),thread) |
---|
| 585 | |
---|
| 586 | end subroutine mci1_ |
---|
| 587 | |
---|
| 588 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 589 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 590 | !BOP ------------------------------------------------------------------- |
---|
| 591 | ! |
---|
| 592 | ! !IROUTINE: mco1_ - checking out a String scalar |
---|
| 593 | ! |
---|
| 594 | ! !DESCRIPTION: |
---|
| 595 | ! |
---|
| 596 | ! !INTERFACE: |
---|
| 597 | |
---|
| 598 | subroutine mco1_(marg,thread) |
---|
| 599 | |
---|
| 600 | ! !USES: |
---|
| 601 | ! |
---|
| 602 | use m_mall, only : mall_co |
---|
| 603 | |
---|
| 604 | implicit none |
---|
| 605 | |
---|
| 606 | ! !INPUT PARAMETERS: |
---|
| 607 | ! |
---|
| 608 | type(String), dimension(:), intent(in) :: marg |
---|
| 609 | character(len=*), intent(in) :: thread |
---|
| 610 | |
---|
| 611 | ! !REVISION HISTORY: |
---|
| 612 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
| 613 | ! - initial prototype/prolog/code |
---|
| 614 | !EOP ___________________________________________________________________ |
---|
| 615 | |
---|
| 616 | character(len=*),parameter :: myname_=myname//'::mco1_' |
---|
| 617 | |
---|
| 618 | call mall_co(size(marg),thread) |
---|
| 619 | |
---|
| 620 | end subroutine mco1_ |
---|
| 621 | |
---|
| 622 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 623 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 624 | !BOP ------------------------------------------------------------------- |
---|
| 625 | ! |
---|
| 626 | ! !IROUTINE: mci2_ - checking in a String scalar |
---|
| 627 | ! |
---|
| 628 | ! !DESCRIPTION: |
---|
| 629 | ! |
---|
| 630 | ! !INTERFACE: |
---|
| 631 | |
---|
| 632 | subroutine mci2_(marg, thread) |
---|
| 633 | |
---|
| 634 | ! !USES: |
---|
| 635 | ! |
---|
| 636 | use m_mall, only : mall_ci |
---|
| 637 | |
---|
| 638 | implicit none |
---|
| 639 | |
---|
| 640 | ! !INPUT PARAMETERS: |
---|
| 641 | ! |
---|
| 642 | type(String), dimension(:,:), intent(in) :: marg |
---|
| 643 | character(len=*), intent(in) :: thread |
---|
| 644 | |
---|
| 645 | ! !REVISION HISTORY: |
---|
| 646 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
| 647 | ! - initial prototype/prolog/code |
---|
| 648 | !EOP ___________________________________________________________________ |
---|
| 649 | |
---|
| 650 | character(len=*),parameter :: myname_=myname//'::mci2_' |
---|
| 651 | |
---|
| 652 | call mall_ci(size(marg),thread) |
---|
| 653 | |
---|
| 654 | end subroutine mci2_ |
---|
| 655 | |
---|
| 656 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 657 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 658 | !BOP ------------------------------------------------------------------- |
---|
| 659 | ! |
---|
| 660 | ! !IROUTINE: mco2_ - checking out a String scalar |
---|
| 661 | ! |
---|
| 662 | ! !DESCRIPTION: |
---|
| 663 | ! |
---|
| 664 | ! !INTERFACE: |
---|
| 665 | |
---|
| 666 | subroutine mco2_(marg,thread) |
---|
| 667 | |
---|
| 668 | ! !USES: |
---|
| 669 | ! |
---|
| 670 | use m_mall, only : mall_co |
---|
| 671 | |
---|
| 672 | implicit none |
---|
| 673 | |
---|
| 674 | ! !INPUT PARAMETERS: |
---|
| 675 | ! |
---|
| 676 | type(String), dimension(:,:), intent(in) :: marg |
---|
| 677 | character(len=*), intent(in) :: thread |
---|
| 678 | |
---|
| 679 | ! !REVISION HISTORY: |
---|
| 680 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
| 681 | ! - initial prototype/prolog/code |
---|
| 682 | !EOP ___________________________________________________________________ |
---|
| 683 | |
---|
| 684 | character(len=*),parameter :: myname_=myname//'::mco2_' |
---|
| 685 | |
---|
| 686 | call mall_co(size(marg),thread) |
---|
| 687 | |
---|
| 688 | end subroutine mco2_ |
---|
| 689 | |
---|
| 690 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 691 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 692 | !BOP ------------------------------------------------------------------- |
---|
| 693 | ! |
---|
| 694 | ! !IROUTINE: mci3_ - checking in a String scalar |
---|
| 695 | ! |
---|
| 696 | ! !DESCRIPTION: |
---|
| 697 | ! |
---|
| 698 | ! !INTERFACE: |
---|
| 699 | |
---|
| 700 | subroutine mci3_(marg,thread) |
---|
| 701 | |
---|
| 702 | ! !USES: |
---|
| 703 | ! |
---|
| 704 | use m_mall, only : mall_ci |
---|
| 705 | |
---|
| 706 | implicit none |
---|
| 707 | |
---|
| 708 | ! !INPUT PARAMETERS: |
---|
| 709 | ! |
---|
| 710 | type(String), dimension(:,:,:), intent(in) :: marg |
---|
| 711 | character(len=*), intent(in) :: thread |
---|
| 712 | |
---|
| 713 | ! !REVISION HISTORY: |
---|
| 714 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
| 715 | ! - initial prototype/prolog/code |
---|
| 716 | !EOP ___________________________________________________________________ |
---|
| 717 | |
---|
| 718 | character(len=*),parameter :: myname_=myname//'::mci3_' |
---|
| 719 | |
---|
| 720 | call mall_ci(size(marg),thread) |
---|
| 721 | |
---|
| 722 | end subroutine mci3_ |
---|
| 723 | |
---|
| 724 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 725 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 726 | !BOP ------------------------------------------------------------------- |
---|
| 727 | ! |
---|
| 728 | ! !IROUTINE: mco3_ - checking out a String scalar |
---|
| 729 | ! |
---|
| 730 | ! !DESCRIPTION: |
---|
| 731 | ! |
---|
| 732 | ! !INTERFACE: |
---|
| 733 | |
---|
| 734 | subroutine mco3_(marg,thread) |
---|
| 735 | |
---|
| 736 | ! !USES: |
---|
| 737 | ! |
---|
| 738 | use m_mall, only : mall_co |
---|
| 739 | |
---|
| 740 | implicit none |
---|
| 741 | |
---|
| 742 | ! !INPUT PARAMETERS: |
---|
| 743 | ! |
---|
| 744 | type(String), dimension(:,:,:), intent(in) :: marg |
---|
| 745 | character(len=*), intent(in) :: thread |
---|
| 746 | |
---|
| 747 | ! !REVISION HISTORY: |
---|
| 748 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
| 749 | ! - initial prototype/prolog/code |
---|
| 750 | !EOP ___________________________________________________________________ |
---|
| 751 | |
---|
| 752 | character(len=*),parameter :: myname_=myname//'::mco3_' |
---|
| 753 | |
---|
| 754 | call mall_co(size(marg),thread) |
---|
| 755 | |
---|
| 756 | end subroutine mco3_ |
---|
| 757 | |
---|
| 758 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 759 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 760 | !BOP ------------------------------------------------------------------- |
---|
| 761 | ! |
---|
| 762 | ! !IROUTINE: len_ = len of a String |
---|
| 763 | ! |
---|
| 764 | ! !DESCRIPTION: |
---|
| 765 | ! |
---|
| 766 | ! !INTERFACE: |
---|
| 767 | |
---|
| 768 | integer function len_(str) |
---|
| 769 | |
---|
| 770 | ! !USES: |
---|
| 771 | ! |
---|
| 772 | ! No external modules are used by this function. |
---|
| 773 | |
---|
| 774 | implicit none |
---|
| 775 | |
---|
| 776 | ! !INPUT PARAMETERS: |
---|
| 777 | ! |
---|
| 778 | type(String),intent(in) :: str |
---|
| 779 | |
---|
| 780 | ! !REVISION HISTORY: |
---|
| 781 | ! 10Apr00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
| 782 | ! - initial prototype/prolog/code |
---|
| 783 | !EOP ___________________________________________________________________ |
---|
| 784 | |
---|
| 785 | character(len=*),parameter :: myname_=myname//'::len_' |
---|
| 786 | |
---|
| 787 | len_=size(str%c) |
---|
| 788 | |
---|
| 789 | end function len_ |
---|
| 790 | |
---|
| 791 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 792 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
| 793 | !BOP ------------------------------------------------------------------- |
---|
| 794 | ! |
---|
| 795 | ! !IROUTINE: ptr_chars_ - direct |
---|
| 796 | ! |
---|
| 797 | ! !DESCRIPTION: |
---|
| 798 | ! This pointer-valued function provides a direct interface to the |
---|
| 799 | ! character buffer in the input {\tt String} argument {\tt str}. That |
---|
| 800 | ! is, {\tt ptr\_chars\_ => str\%c}. |
---|
| 801 | ! |
---|
| 802 | ! !INTERFACE: |
---|
| 803 | |
---|
| 804 | function ptr_chars_(str) |
---|
| 805 | |
---|
| 806 | ! !USES: |
---|
| 807 | ! |
---|
| 808 | ! No external modules are used by this function. |
---|
| 809 | |
---|
| 810 | implicit none |
---|
| 811 | |
---|
| 812 | ! !INPUT PARAMETERS: |
---|
| 813 | ! |
---|
| 814 | type(String), intent(in) :: str |
---|
| 815 | |
---|
| 816 | ! !OUTPUT PARAMETERS: |
---|
| 817 | ! |
---|
| 818 | character(len=1), dimension(:), pointer :: ptr_chars_ |
---|
| 819 | |
---|
| 820 | ! !REVISION HISTORY: |
---|
| 821 | ! 10Apr00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
| 822 | ! - initial prototype/prolog/code |
---|
| 823 | !EOP ___________________________________________________________________ |
---|
| 824 | |
---|
| 825 | character(len=*),parameter :: myname_=myname//'::ptr_chars_' |
---|
| 826 | |
---|
| 827 | ptr_chars_ => str%c |
---|
| 828 | |
---|
| 829 | end function ptr_chars_ |
---|
| 830 | |
---|
| 831 | end module m_String |
---|