wrfv2_fire/share/module_io_domain.F

   1 !WRF:MEDIATION_LAYER:IO
   2 !
   3
   4 MODULE module_io_domain
   5 USE module_io
   6 USE module_io_wrf
   7 USE module_wrf_error
   8 USE module_date_time
   9 USE module_configure
  10 USE module_domain
  11
  12 CONTAINS
  13
  14   SUBROUTINE open_r_dataset ( id , fname , grid , config_flags , sysdepinfo, ierr )
  15    TYPE (domain)             :: grid
  16    CHARACTER*(*) :: fname
  17    CHARACTER*(*) :: sysdepinfo
  18    INTEGER      , INTENT(INOUT) :: id , ierr
  19    LOGICAL , EXTERNAL :: wrf_dm_on_monitor
  20    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  21    CHARACTER*128             :: DataSet
  22    LOGICAL                   :: anyway
  23    CALL wrf_open_for_read ( fname ,                     &
  24                             grid%communicator ,         &
  25                             grid%iocommunicator ,       &
  26                             sysdepinfo ,                &
  27                             id ,                        &
  28                             ierr )
  29    RETURN
  30   END SUBROUTINE open_r_dataset
  31
  32   SUBROUTINE open_w_dataset ( id , fname , grid , config_flags , outsub , sysdepinfo, ierr )
  33    TYPE (domain)             :: grid
  34    CHARACTER*(*) :: fname
  35    CHARACTER*(*) :: sysdepinfo
  36    INTEGER      , INTENT(INOUT) :: id , ierr
  37    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  38    LOGICAL , EXTERNAL :: wrf_dm_on_monitor
  39    EXTERNAL outsub
  40    CHARACTER*128             :: DataSet
  41    LOGICAL                   :: anyway
  42    CALL wrf_debug ( 100 , 'calling wrf_open_for_write_begin in open_w_dataset' )
  43    CALL wrf_open_for_write_begin ( fname ,     &
  44                                    grid%communicator ,         &
  45                                    grid%iocommunicator ,       &
  46                                    sysdepinfo ,                &
  47                                    id ,                        &
  48                                    ierr )
  49    IF ( ierr .LE. 0 ) THEN
  50      CALL wrf_debug ( 100 , 'calling outsub in open_w_dataset' )
  51      CALL outsub( id , grid , config_flags , ierr )
  52      CALL wrf_debug ( 100 , 'back from outsub in open_w_dataset' )
  53    ENDIF
  54    IF ( ierr .LE. 0 ) THEN
  55      CALL wrf_debug ( 100 , 'calling wrf_open_for_write_commit in open_w_dataset' )
  56      CALL wrf_open_for_write_commit ( id ,                        &
  57                                       ierr )
  58      CALL wrf_debug ( 100 , 'back from wrf_open_for_write_commit in open_w_dataset' )
  59    ENDIF
  60   END SUBROUTINE open_w_dataset
  61
  62   SUBROUTINE open_u_dataset ( id , fname , grid , config_flags , insub , sysdepinfo, ierr )
  63    TYPE (domain)             :: grid
  64    CHARACTER*(*) :: fname
  65    CHARACTER*(*) :: sysdepinfo
  66    INTEGER      , INTENT(INOUT) :: id , ierr
  67    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  68    LOGICAL , EXTERNAL :: wrf_dm_on_monitor
  69    EXTERNAL insub
  70    CHARACTER*128             :: DataSet
  71    LOGICAL                   :: anyway
  72    CALL wrf_debug ( 100 , 'calling wrf_open_for_read_begin in open_u_dataset' )
  73    CALL wrf_open_for_read_begin ( fname ,     &
  74                                    grid%communicator ,         &
  75                                    grid%iocommunicator ,       &
  76                                    sysdepinfo ,                &
  77                                    id ,                        &
  78                                    ierr )
  79    IF ( ierr .LE. 0 ) THEN
  80      CALL wrf_debug ( 100 , 'calling insub in open_u_dataset' )
  81      CALL insub( id , grid , config_flags , ierr )
  82    ENDIF
  83    IF ( ierr .LE. 0 ) THEN
  84      CALL wrf_debug ( 100 , 'calling wrf_open_for_read_commit in open_u_dataset' )
  85      CALL wrf_open_for_read_commit ( id ,                        &
  86                                        ierr )
  87      CALL wrf_debug ( 100 , 'back from wrf_open_for_read_commit in open_u_dataset' )
  88    ENDIF
  89   END SUBROUTINE open_u_dataset
  90
  91   SUBROUTINE close_dataset( id , config_flags, sysdepinfo )
  92    IMPLICIT NONE
  93    INTEGER id , ierr
  94    LOGICAL , EXTERNAL :: wrf_dm_on_monitor
  95    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  96    CHARACTER*(*) :: sysdepinfo
  97    CHARACTER*128             :: DataSet
  98    LOGICAL                   :: anyway
  99    CALL wrf_ioclose( id , ierr )
 100   END SUBROUTINE close_dataset
 101
 102
 103 ! ------------  Output model input data sets
 104
 105   SUBROUTINE output_model_input ( fid , grid , config_flags , ierr )
 106     IMPLICIT NONE
 107     TYPE(domain) :: grid
 108     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 109     INTEGER, INTENT(IN) :: fid
 110     INTEGER, INTENT(INOUT) :: ierr
 111     IF ( config_flags%io_form_input .GT. 0 ) THEN
 112       CALL output_wrf ( fid , grid , config_flags , model_input_only , ierr )
 113     ENDIF
 114     RETURN
 115   END SUBROUTINE output_model_input
 116
 117   SUBROUTINE output_aux_model_input1 ( fid , grid , config_flags , ierr )
 118     IMPLICIT NONE
 119     TYPE(domain) :: grid
 120     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 121     INTEGER, INTENT(IN) :: fid
 122     INTEGER, INTENT(INOUT) :: ierr
 123     IF ( config_flags%io_form_auxinput1 .GT. 0 ) THEN
 124       CALL output_wrf ( fid , grid , config_flags , aux_model_input1_only , ierr )
 125     ENDIF
 126     RETURN
 127   END SUBROUTINE output_aux_model_input1
 128
 129   SUBROUTINE output_aux_model_input2 ( fid , grid , config_flags , ierr )
 130     IMPLICIT NONE
 131     TYPE(domain) :: grid
 132     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 133     INTEGER, INTENT(IN) :: fid
 134     INTEGER, INTENT(INOUT) :: ierr
 135     IF ( config_flags%io_form_auxinput2 .GT. 0 ) THEN
 136       CALL output_wrf ( fid , grid , config_flags , aux_model_input2_only , ierr )
 137     ENDIF
 138     RETURN
 139   END SUBROUTINE output_aux_model_input2
 140
 141   SUBROUTINE output_aux_model_input3 ( fid , grid , config_flags , ierr )
 142     IMPLICIT NONE
 143     TYPE(domain) :: grid
 144     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 145     INTEGER, INTENT(IN) :: fid
 146     INTEGER, INTENT(INOUT) :: ierr
 147     IF ( config_flags%io_form_auxinput3 .GT. 0 ) THEN
 148       CALL output_wrf ( fid , grid , config_flags , aux_model_input3_only , ierr )
 149     ENDIF
 150     RETURN
 151   END SUBROUTINE output_aux_model_input3
 152
 153   SUBROUTINE output_aux_model_input4 ( fid , grid , config_flags , ierr )
 154     IMPLICIT NONE
 155     TYPE(domain) :: grid
 156     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 157     INTEGER, INTENT(IN) :: fid
 158     INTEGER, INTENT(INOUT) :: ierr
 159     IF ( config_flags%io_form_auxinput4 .GT. 0 ) THEN
 160       CALL output_wrf ( fid , grid , config_flags , aux_model_input4_only , ierr )
 161     ENDIF
 162     RETURN
 163   END SUBROUTINE output_aux_model_input4
 164
 165   SUBROUTINE output_aux_model_input5 ( fid , grid , config_flags , ierr )
 166     IMPLICIT NONE
 167     TYPE(domain) :: grid
 168     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 169     INTEGER, INTENT(IN) :: fid
 170     INTEGER, INTENT(INOUT) :: ierr
 171     IF ( config_flags%io_form_auxinput5 .GT. 0 ) THEN
 172       CALL output_wrf ( fid , grid , config_flags , aux_model_input5_only , ierr )
 173     ENDIF
 174     RETURN
 175   END SUBROUTINE output_aux_model_input5
 176
 177   SUBROUTINE output_aux_model_input6 ( fid , grid , config_flags , ierr )
 178     IMPLICIT NONE
 179     TYPE(domain) :: grid
 180     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 181     INTEGER, INTENT(IN) :: fid
 182     INTEGER, INTENT(INOUT) :: ierr
 183     IF ( config_flags%io_form_auxinput6 .GT. 0 ) THEN
 184       CALL output_wrf ( fid , grid , config_flags , aux_model_input6_only , ierr )
 185     ENDIF
 186     RETURN
 187   END SUBROUTINE output_aux_model_input6
 188
 189   SUBROUTINE output_aux_model_input7 ( fid , grid , config_flags , ierr )
 190     IMPLICIT NONE
 191     TYPE(domain) :: grid
 192     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 193     INTEGER, INTENT(IN) :: fid
 194     INTEGER, INTENT(INOUT) :: ierr
 195     IF ( config_flags%io_form_auxinput7 .GT. 0 ) THEN
 196       CALL output_wrf ( fid , grid , config_flags , aux_model_input7_only , ierr )
 197     ENDIF
 198     RETURN
 199   END SUBROUTINE output_aux_model_input7
 200
 201   SUBROUTINE output_aux_model_input8 ( fid , grid , config_flags , ierr )
 202     IMPLICIT NONE
 203     TYPE(domain) :: grid
 204     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 205     INTEGER, INTENT(IN) :: fid
 206     INTEGER, INTENT(INOUT) :: ierr
 207     IF ( config_flags%io_form_auxinput8 .GT. 0 ) THEN
 208       CALL output_wrf ( fid , grid , config_flags , aux_model_input8_only , ierr )
 209     ENDIF
 210     RETURN
 211   END SUBROUTINE output_aux_model_input8
 212
 213   SUBROUTINE output_aux_model_input9 ( fid , grid , config_flags , ierr )
 214     IMPLICIT NONE
 215     TYPE(domain) :: grid
 216     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 217     INTEGER, INTENT(IN) :: fid
 218     INTEGER, INTENT(INOUT) :: ierr
 219     IF ( config_flags%io_form_auxinput9 .GT. 0 ) THEN
 220       CALL output_wrf ( fid , grid , config_flags , aux_model_input9_only , ierr )
 221     ENDIF
 222     RETURN
 223   END SUBROUTINE output_aux_model_input9
 224
 225   SUBROUTINE output_aux_model_input10 ( fid , grid , config_flags , ierr )
 226     IMPLICIT NONE
 227     TYPE(domain) :: grid
 228     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 229     INTEGER, INTENT(IN) :: fid
 230     INTEGER, INTENT(INOUT) :: ierr
 231     IF ( config_flags%io_form_gfdda .GT. 0 ) THEN
 232       CALL output_wrf ( fid , grid , config_flags , aux_model_input10_only , ierr )
 233     ENDIF
 234     RETURN
 235   END SUBROUTINE output_aux_model_input10
 236
 237   SUBROUTINE output_aux_model_input11 ( fid , grid , config_flags , ierr )
 238     IMPLICIT NONE
 239     TYPE(domain) :: grid
 240     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 241     INTEGER, INTENT(IN) :: fid
 242     INTEGER, INTENT(INOUT) :: ierr
 243     IF ( config_flags%io_form_auxinput11 .GT. 0 ) THEN
 244       CALL output_wrf ( fid , grid , config_flags , aux_model_input11_only , ierr )
 245     ENDIF
 246     RETURN
 247   END SUBROUTINE output_aux_model_input11
 248
 249 !  ------------ Output model history data sets
 250
 251   SUBROUTINE output_history ( fid , grid , config_flags , ierr )
 252     IMPLICIT NONE
 253     TYPE(domain) :: grid
 254     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 255     INTEGER, INTENT(IN) :: fid
 256     INTEGER, INTENT(INOUT) :: ierr
 257     IF ( config_flags%io_form_history .GT. 0 ) THEN
 258       CALL output_wrf ( fid , grid , config_flags , history_only , ierr )
 259     ENDIF
 260     RETURN
 261   END SUBROUTINE output_history
 262
 263   SUBROUTINE output_aux_hist1 ( fid , grid , config_flags , ierr )
 264     IMPLICIT NONE
 265     TYPE(domain) :: grid
 266     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 267     INTEGER, INTENT(IN) :: fid
 268     INTEGER, INTENT(INOUT) :: ierr
 269     IF ( config_flags%io_form_auxhist1 .GT. 0 ) THEN
 270       CALL output_wrf ( fid , grid , config_flags , aux_hist1_only , ierr )
 271     ENDIF
 272     RETURN
 273   END SUBROUTINE output_aux_hist1
 274
 275   SUBROUTINE output_aux_hist2 ( fid , grid , config_flags , ierr )
 276     IMPLICIT NONE
 277     TYPE(domain) :: grid
 278     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 279     INTEGER, INTENT(IN) :: fid
 280     INTEGER, INTENT(INOUT) :: ierr
 281     IF ( config_flags%io_form_auxhist2 .GT. 0 ) THEN
 282       CALL output_wrf ( fid , grid , config_flags , aux_hist2_only , ierr )
 283     ENDIF
 284     RETURN
 285   END SUBROUTINE output_aux_hist2
 286
 287   SUBROUTINE output_aux_hist3 ( fid , grid , config_flags , ierr )
 288     IMPLICIT NONE
 289     TYPE(domain) :: grid
 290     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 291     INTEGER, INTENT(IN) :: fid
 292     INTEGER, INTENT(INOUT) :: ierr
 293     IF ( config_flags%io_form_auxhist3 .GT. 0 ) THEN
 294       CALL output_wrf ( fid , grid , config_flags , aux_hist3_only , ierr )
 295     ENDIF
 296     RETURN
 297   END SUBROUTINE output_aux_hist3
 298
 299   SUBROUTINE output_aux_hist4 ( fid , grid , config_flags , ierr )
 300     IMPLICIT NONE
 301     TYPE(domain) :: grid
 302     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 303     INTEGER, INTENT(IN) :: fid
 304     INTEGER, INTENT(INOUT) :: ierr
 305     IF ( config_flags%io_form_auxhist4 .GT. 0 ) THEN
 306       CALL output_wrf ( fid , grid , config_flags , aux_hist4_only , ierr )
 307     ENDIF
 308     RETURN
 309   END SUBROUTINE output_aux_hist4
 310
 311   SUBROUTINE output_aux_hist5 ( fid , grid , config_flags , ierr )
 312     IMPLICIT NONE
 313     TYPE(domain) :: grid
 314     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 315     INTEGER, INTENT(IN) :: fid
 316     INTEGER, INTENT(INOUT) :: ierr
 317     IF ( config_flags%io_form_auxhist5 .GT. 0 ) THEN
 318       CALL output_wrf ( fid , grid , config_flags , aux_hist5_only , ierr )
 319     ENDIF
 320     RETURN
 321   END SUBROUTINE output_aux_hist5
 322
 323   SUBROUTINE output_aux_hist6 ( fid , grid , config_flags , ierr )
 324     IMPLICIT NONE
 325     TYPE(domain) :: grid
 326     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 327     INTEGER, INTENT(IN) :: fid
 328     INTEGER, INTENT(INOUT) :: ierr
 329     IF ( config_flags%io_form_auxhist6 .GT. 0 ) THEN
 330       CALL output_wrf ( fid , grid , config_flags , aux_hist6_only , ierr )
 331     ENDIF
 332     RETURN
 333   END SUBROUTINE output_aux_hist6
 334
 335   SUBROUTINE output_aux_hist7 ( fid , grid , config_flags , ierr )
 336     IMPLICIT NONE
 337     TYPE(domain) :: grid
 338     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 339     INTEGER, INTENT(IN) :: fid
 340     INTEGER, INTENT(INOUT) :: ierr
 341     IF ( config_flags%io_form_auxhist7 .GT. 0 ) THEN
 342       CALL output_wrf ( fid , grid , config_flags , aux_hist7_only , ierr )
 343     ENDIF
 344     RETURN
 345   END SUBROUTINE output_aux_hist7
 346
 347   SUBROUTINE output_aux_hist8 ( fid , grid , config_flags , ierr )
 348     IMPLICIT NONE
 349     TYPE(domain) :: grid
 350     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 351     INTEGER, INTENT(IN) :: fid
 352     INTEGER, INTENT(INOUT) :: ierr
 353     IF ( config_flags%io_form_auxhist8 .GT. 0 ) THEN
 354       CALL output_wrf ( fid , grid , config_flags , aux_hist8_only , ierr )
 355     ENDIF
 356     RETURN
 357   END SUBROUTINE output_aux_hist8
 358
 359   SUBROUTINE output_aux_hist9 ( fid , grid , config_flags , ierr )
 360     IMPLICIT NONE
 361     TYPE(domain) :: grid
 362     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 363     INTEGER, INTENT(IN) :: fid
 364     INTEGER, INTENT(INOUT) :: ierr
 365     IF ( config_flags%io_form_auxhist9 .GT. 0 ) THEN
 366       CALL output_wrf ( fid , grid , config_flags , aux_hist9_only , ierr )
 367     ENDIF
 368     RETURN
 369   END SUBROUTINE output_aux_hist9
 370
 371   SUBROUTINE output_aux_hist10 ( fid , grid , config_flags , ierr )
 372     IMPLICIT NONE
 373     TYPE(domain) :: grid
 374     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 375     INTEGER, INTENT(IN) :: fid
 376     INTEGER, INTENT(INOUT) :: ierr
 377     IF ( config_flags%io_form_auxhist10 .GT. 0 ) THEN
 378       CALL output_wrf ( fid , grid , config_flags , aux_hist10_only , ierr )
 379     ENDIF
 380     RETURN
 381   END SUBROUTINE output_aux_hist10
 382
 383   SUBROUTINE output_aux_hist11 ( fid , grid , config_flags , ierr )
 384     IMPLICIT NONE
 385     TYPE(domain) :: grid
 386     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 387     INTEGER, INTENT(IN) :: fid
 388     INTEGER, INTENT(INOUT) :: ierr
 389     IF ( config_flags%io_form_auxhist11 .GT. 0 ) THEN
 390       CALL output_wrf ( fid , grid , config_flags , aux_hist11_only , ierr )
 391     ENDIF
 392     RETURN
 393   END SUBROUTINE output_aux_hist11
 394
 395 !  ------------ Output model restart data sets
 396
 397   SUBROUTINE output_restart ( fid , grid , config_flags , ierr )
 398     IMPLICIT NONE
 399     TYPE(domain) :: grid
 400     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 401     INTEGER, INTENT(IN) :: fid
 402     INTEGER, INTENT(INOUT) :: ierr
 403     IF ( config_flags%io_form_restart .GT. 0 ) THEN
 404       CALL output_wrf ( fid , grid , config_flags , restart_only , ierr )
 405     ENDIF
 406     RETURN
 407   END SUBROUTINE output_restart
 408
 409 !  ------------ Output model boundary data sets
 410
 411   SUBROUTINE output_boundary ( fid , grid , config_flags , ierr )
 412     IMPLICIT NONE
 413     TYPE(domain) :: grid
 414     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 415     INTEGER, INTENT(IN) :: fid
 416     INTEGER, INTENT(INOUT) :: ierr
 417     IF ( config_flags%io_form_boundary .GT. 0 ) THEN
 418       CALL output_wrf ( fid , grid , config_flags , boundary_only , ierr )
 419     ENDIF
 420     RETURN
 421   END SUBROUTINE output_boundary
 422
 423 !  ------------ Input model input data sets
 424
 425   SUBROUTINE input_model_input ( fid , grid , config_flags , ierr )
 426     IMPLICIT NONE
 427     TYPE(domain) :: grid
 428     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 429     INTEGER, INTENT(IN) :: fid
 430     INTEGER, INTENT(INOUT) :: ierr
 431     IF ( config_flags%io_form_input .GT. 0 ) THEN
 432       CALL input_wrf ( fid , grid , config_flags , model_input_only , ierr )
 433     ENDIF
 434     RETURN
 435   END SUBROUTINE input_model_input
 436
 437   SUBROUTINE input_aux_model_input1 ( fid , grid , config_flags , ierr )
 438     IMPLICIT NONE
 439     TYPE(domain) :: grid
 440     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 441     INTEGER, INTENT(IN) :: fid
 442     INTEGER, INTENT(INOUT) :: ierr
 443     IF ( config_flags%io_form_auxinput1 .GT. 0 ) THEN
 444       CALL input_wrf ( fid , grid , config_flags , aux_model_input1_only , ierr )
 445     ENDIF
 446     RETURN
 447   END SUBROUTINE input_aux_model_input1
 448
 449   SUBROUTINE input_aux_model_input2 ( fid , grid , config_flags , ierr )
 450     IMPLICIT NONE
 451     TYPE(domain) :: grid
 452     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 453     INTEGER, INTENT(IN) :: fid
 454     INTEGER, INTENT(INOUT) :: ierr
 455     IF ( config_flags%io_form_auxinput2 .GT. 0 ) THEN
 456       CALL input_wrf ( fid , grid , config_flags , aux_model_input2_only , ierr )
 457     ENDIF
 458     RETURN
 459   END SUBROUTINE input_aux_model_input2
 460
 461   SUBROUTINE input_aux_model_input3 ( fid , grid , config_flags , ierr )
 462     IMPLICIT NONE
 463     TYPE(domain) :: grid
 464     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 465     INTEGER, INTENT(IN) :: fid
 466     INTEGER, INTENT(INOUT) :: ierr
 467     IF ( config_flags%io_form_auxinput3 .GT. 0 ) THEN
 468       CALL input_wrf ( fid , grid , config_flags , aux_model_input3_only , ierr )
 469     ENDIF
 470     RETURN
 471   END SUBROUTINE input_aux_model_input3
 472
 473   SUBROUTINE input_aux_model_input4 ( fid , grid , config_flags , ierr )
 474     IMPLICIT NONE
 475     TYPE(domain) :: grid
 476     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 477     INTEGER, INTENT(IN) :: fid
 478     INTEGER, INTENT(INOUT) :: ierr
 479     IF ( config_flags%io_form_auxinput4 .GT. 0 ) THEN
 480       CALL input_wrf ( fid , grid , config_flags , aux_model_input4_only , ierr )
 481     ENDIF
 482     RETURN
 483   END SUBROUTINE input_aux_model_input4
 484
 485   SUBROUTINE input_aux_model_input5 ( fid , grid , config_flags , ierr )
 486     IMPLICIT NONE
 487     TYPE(domain) :: grid
 488     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 489     INTEGER, INTENT(IN) :: fid
 490     INTEGER, INTENT(INOUT) :: ierr
 491     IF ( config_flags%io_form_auxinput5 .GT. 0 ) THEN
 492       CALL input_wrf ( fid , grid , config_flags , aux_model_input5_only , ierr )
 493     ENDIF
 494     RETURN
 495   END SUBROUTINE input_aux_model_input5
 496
 497   SUBROUTINE input_aux_model_input6 ( fid , grid , config_flags , ierr )
 498     IMPLICIT NONE
 499     TYPE(domain) :: grid
 500     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 501     INTEGER, INTENT(IN) :: fid
 502     INTEGER, INTENT(INOUT) :: ierr
 503     IF ( config_flags%io_form_auxinput6 .GT. 0 ) THEN
 504       CALL input_wrf ( fid , grid , config_flags , aux_model_input6_only , ierr )
 505     ENDIF
 506     RETURN
 507   END SUBROUTINE input_aux_model_input6
 508   SUBROUTINE input_aux_model_input7 ( fid , grid , config_flags , ierr )
 509     IMPLICIT NONE
 510     TYPE(domain) :: grid
 511     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 512     INTEGER, INTENT(IN) :: fid
 513     INTEGER, INTENT(INOUT) :: ierr
 514     IF ( config_flags%io_form_auxinput7 .GT. 0 ) THEN
 515       CALL input_wrf ( fid , grid , config_flags , aux_model_input7_only , ierr )
 516     ENDIF
 517     RETURN
 518   END SUBROUTINE input_aux_model_input7
 519   SUBROUTINE input_aux_model_input8 ( fid , grid , config_flags , ierr )
 520     IMPLICIT NONE
 521     TYPE(domain) :: grid
 522     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 523     INTEGER, INTENT(IN) :: fid
 524     INTEGER, INTENT(INOUT) :: ierr
 525     IF ( config_flags%io_form_auxinput8 .GT. 0 ) THEN
 526       CALL input_wrf ( fid , grid , config_flags , aux_model_input8_only , ierr )
 527     ENDIF
 528     RETURN
 529   END SUBROUTINE input_aux_model_input8
 530   SUBROUTINE input_aux_model_input9 ( fid , grid , config_flags , ierr )
 531     IMPLICIT NONE
 532     TYPE(domain) :: grid
 533     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 534     INTEGER, INTENT(IN) :: fid
 535     INTEGER, INTENT(INOUT) :: ierr
 536     IF ( config_flags%io_form_auxinput9 .GT. 0 ) THEN
 537       CALL input_wrf ( fid , grid , config_flags , aux_model_input9_only , ierr )
 538     ENDIF
 539     RETURN
 540   END SUBROUTINE input_aux_model_input9
 541   SUBROUTINE input_aux_model_input10 ( fid , grid , config_flags , ierr )
 542     IMPLICIT NONE
 543     TYPE(domain) :: grid
 544     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 545     INTEGER, INTENT(IN) :: fid
 546     INTEGER, INTENT(INOUT) :: ierr
 547     IF ( config_flags%io_form_gfdda .GT. 0 ) THEN
 548       CALL input_wrf ( fid , grid , config_flags , aux_model_input10_only , ierr )
 549     ENDIF
 550     RETURN
 551   END SUBROUTINE input_aux_model_input10
 552   SUBROUTINE input_aux_model_input11 ( fid , grid , config_flags , ierr )
 553     IMPLICIT NONE
 554     TYPE(domain) :: grid
 555     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 556     INTEGER, INTENT(IN) :: fid
 557     INTEGER, INTENT(INOUT) :: ierr
 558     IF ( config_flags%io_form_auxinput11 .GT. 0 ) THEN
 559       CALL input_wrf ( fid , grid , config_flags , aux_model_input11_only , ierr )
 560     ENDIF
 561     RETURN
 562   END SUBROUTINE input_aux_model_input11
 563
 564 !  ------------ Input model history data sets
 565
 566   SUBROUTINE input_history ( fid , grid , config_flags , ierr )
 567     IMPLICIT NONE
 568     TYPE(domain) :: grid
 569     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 570     INTEGER, INTENT(IN) :: fid
 571     INTEGER, INTENT(INOUT) :: ierr
 572     IF ( config_flags%io_form_history .GT. 0 ) THEN
 573       CALL input_wrf ( fid , grid , config_flags , history_only , ierr )
 574     ENDIF
 575     RETURN
 576   END SUBROUTINE input_history
 577
 578   SUBROUTINE input_aux_hist1 ( fid , grid , config_flags , ierr )
 579     IMPLICIT NONE
 580     TYPE(domain) :: grid
 581     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 582     INTEGER, INTENT(IN) :: fid
 583     INTEGER, INTENT(INOUT) :: ierr
 584     IF ( config_flags%io_form_auxhist1 .GT. 0 ) THEN
 585       CALL input_wrf ( fid , grid , config_flags , aux_hist1_only , ierr )
 586     ENDIF
 587     RETURN
 588   END SUBROUTINE input_aux_hist1
 589
 590   SUBROUTINE input_aux_hist2 ( fid , grid , config_flags , ierr )
 591     IMPLICIT NONE
 592     TYPE(domain) :: grid
 593     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 594     INTEGER, INTENT(IN) :: fid
 595     INTEGER, INTENT(INOUT) :: ierr
 596     IF ( config_flags%io_form_auxhist2 .GT. 0 ) THEN
 597       CALL input_wrf ( fid , grid , config_flags , aux_hist2_only , ierr )
 598     ENDIF
 599     RETURN
 600   END SUBROUTINE input_aux_hist2
 601
 602   SUBROUTINE input_aux_hist3 ( fid , grid , config_flags , ierr )
 603     IMPLICIT NONE
 604     TYPE(domain) :: grid
 605     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 606     INTEGER, INTENT(IN) :: fid
 607     INTEGER, INTENT(INOUT) :: ierr
 608     IF ( config_flags%io_form_auxhist3 .GT. 0 ) THEN
 609       CALL input_wrf ( fid , grid , config_flags , aux_hist3_only , ierr )
 610     ENDIF
 611     RETURN
 612   END SUBROUTINE input_aux_hist3
 613
 614   SUBROUTINE input_aux_hist4 ( fid , grid , config_flags , ierr )
 615     IMPLICIT NONE
 616     TYPE(domain) :: grid
 617     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 618     INTEGER, INTENT(IN) :: fid
 619     INTEGER, INTENT(INOUT) :: ierr
 620     IF ( config_flags%io_form_auxhist4 .GT. 0 ) THEN
 621       CALL input_wrf ( fid , grid , config_flags , aux_hist4_only , ierr )
 622     ENDIF
 623     RETURN
 624   END SUBROUTINE input_aux_hist4
 625
 626   SUBROUTINE input_aux_hist5 ( fid , grid , config_flags , ierr )
 627     IMPLICIT NONE
 628     TYPE(domain) :: grid
 629     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 630     INTEGER, INTENT(IN) :: fid
 631     INTEGER, INTENT(INOUT) :: ierr
 632     IF ( config_flags%io_form_auxhist5 .GT. 0 ) THEN
 633       CALL input_wrf ( fid , grid , config_flags , aux_hist5_only , ierr )
 634     ENDIF
 635     RETURN
 636   END SUBROUTINE input_aux_hist5
 637
 638   SUBROUTINE input_aux_hist6 ( fid , grid , config_flags , ierr )
 639     IMPLICIT NONE
 640     TYPE(domain) :: grid
 641     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 642     INTEGER, INTENT(IN) :: fid
 643     INTEGER, INTENT(INOUT) :: ierr
 644     IF ( config_flags%io_form_auxhist6 .GT. 0 ) THEN
 645       CALL input_wrf ( fid , grid , config_flags , aux_hist6_only , ierr )
 646     ENDIF
 647     RETURN
 648   END SUBROUTINE input_aux_hist6
 649   SUBROUTINE input_aux_hist7 ( fid , grid , config_flags , ierr )
 650     IMPLICIT NONE
 651     TYPE(domain) :: grid
 652     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 653     INTEGER, INTENT(IN) :: fid
 654     INTEGER, INTENT(INOUT) :: ierr
 655     IF ( config_flags%io_form_auxhist7 .GT. 0 ) THEN
 656       CALL input_wrf ( fid , grid , config_flags , aux_hist7_only , ierr )
 657     ENDIF
 658     RETURN
 659   END SUBROUTINE input_aux_hist7
 660   SUBROUTINE input_aux_hist8 ( fid , grid , config_flags , ierr )
 661     IMPLICIT NONE
 662     TYPE(domain) :: grid
 663     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 664     INTEGER, INTENT(IN) :: fid
 665     INTEGER, INTENT(INOUT) :: ierr
 666     IF ( config_flags%io_form_auxhist8 .GT. 0 ) THEN
 667       CALL input_wrf ( fid , grid , config_flags , aux_hist8_only , ierr )
 668     ENDIF
 669     RETURN
 670   END SUBROUTINE input_aux_hist8
 671   SUBROUTINE input_aux_hist9 ( fid , grid , config_flags , ierr )
 672     IMPLICIT NONE
 673     TYPE(domain) :: grid
 674     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 675     INTEGER, INTENT(IN) :: fid
 676     INTEGER, INTENT(INOUT) :: ierr
 677     IF ( config_flags%io_form_auxhist9 .GT. 0 ) THEN
 678       CALL input_wrf ( fid , grid , config_flags , aux_hist9_only , ierr )
 679     ENDIF
 680     RETURN
 681   END SUBROUTINE input_aux_hist9
 682   SUBROUTINE input_aux_hist10 ( fid , grid , config_flags , ierr )
 683     IMPLICIT NONE
 684     TYPE(domain) :: grid
 685     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 686     INTEGER, INTENT(IN) :: fid
 687     INTEGER, INTENT(INOUT) :: ierr
 688     IF ( config_flags%io_form_auxhist10 .GT. 0 ) THEN
 689       CALL input_wrf ( fid , grid , config_flags , aux_hist10_only , ierr )
 690     ENDIF
 691     RETURN
 692   END SUBROUTINE input_aux_hist10
 693   SUBROUTINE input_aux_hist11 ( fid , grid , config_flags , ierr )
 694     IMPLICIT NONE
 695     TYPE(domain) :: grid
 696     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 697     INTEGER, INTENT(IN) :: fid
 698     INTEGER, INTENT(INOUT) :: ierr
 699     IF ( config_flags%io_form_auxhist11 .GT. 0 ) THEN
 700       CALL input_wrf ( fid , grid , config_flags , aux_hist11_only , ierr )
 701     ENDIF
 702     RETURN
 703   END SUBROUTINE input_aux_hist11
 704
 705 !  ------------ Input model restart data sets
 706
 707   SUBROUTINE input_restart ( fid , grid , config_flags , ierr )
 708     IMPLICIT NONE
 709     TYPE(domain) :: grid
 710     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 711     INTEGER, INTENT(IN) :: fid
 712     INTEGER, INTENT(INOUT) :: ierr
 713     IF ( config_flags%io_form_restart .GT. 0 ) THEN
 714       CALL input_wrf ( fid , grid , config_flags , restart_only , ierr )
 715     ENDIF
 716     RETURN
 717   END SUBROUTINE input_restart
 718
 719 !  ------------ Input model boundary data sets
 720
 721   SUBROUTINE input_boundary ( fid , grid , config_flags , ierr )
 722     IMPLICIT NONE
 723     TYPE(domain) :: grid
 724     TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 725     INTEGER, INTENT(IN) :: fid
 726     INTEGER, INTENT(INOUT) :: ierr
 727     IF ( config_flags%io_form_boundary .GT. 0 ) THEN
 728       CALL input_wrf ( fid , grid , config_flags , boundary_only , ierr )
 729     ENDIF
 730     RETURN
 731   END SUBROUTINE input_boundary
 732
 733 END MODULE module_io_domain
 734
 735 ! move outside module so callable without USE of module
 736 SUBROUTINE construct_filename1( result , basename , fld1 , len1 )
 737   IMPLICIT NONE
 738   CHARACTER*(*) :: result
 739   CHARACTER*(*) :: basename
 740   INTEGER , INTENT(IN) :: fld1 , len1
 741   CHARACTER*64         :: t1, zeros
 742
 743   CALL zero_pad ( t1 , fld1 , len1 )
 744   result = TRIM(basename) // "_d" // TRIM(t1)
 745   CALL maybe_remove_colons(result)
 746   RETURN
 747 END SUBROUTINE construct_filename1
 748
 749 SUBROUTINE construct_filename2( result , basename , fld1 , len1 , date_char )
 750   IMPLICIT NONE
 751   CHARACTER*(*) :: result
 752   CHARACTER*(*) :: basename
 753   CHARACTER*(*) :: date_char
 754
 755   INTEGER , INTENT(IN) :: fld1 , len1
 756   CHARACTER*64         :: t1, zeros
 757   CALL zero_pad ( t1 , fld1 , len1 )
 758   result = TRIM(basename) // ".d" // TRIM(t1) // "." // TRIM(date_char)
 759   CALL maybe_remove_colons(result)
 760   RETURN
 761 END SUBROUTINE construct_filename2
 762
 763 ! this version looks for <date> and <domain> in the basename and replaces with the arguments
 764
 765 SUBROUTINE construct_filename2a( result , basename , fld1 , len1 , date_char )
 766   IMPLICIT NONE
 767   CHARACTER*(*) :: result
 768   CHARACTER*(*) :: basename
 769   CHARACTER*(*) :: date_char
 770
 771   INTEGER , INTENT(IN) :: fld1 , len1
 772   CHARACTER*64         :: t1, zeros
 773   INTEGER   i, j, l
 774   result=basename
 775   CALL zero_pad ( t1 , fld1 , len1 )
 776   i = index( basename , '<domain>' )
 777   l = len(trim(basename))
 778   IF ( i .GT. 0 ) THEN
 779     result = basename(1:i-1) // TRIM(t1) // basename(i+8:l)
 780   ENDIF
 781   i = index( result , '<date>' )
 782   l = len(trim(result))
 783   IF ( i .GT. 0 ) THEN
 784     result = result(1:i-1) // TRIM(date_char) // result(i+6:l)
 785   ENDIF
 786   CALL maybe_remove_colons(result)
 787   RETURN
 788 END SUBROUTINE construct_filename2a
 789
 790 SUBROUTINE construct_filename ( result , basename , fld1 , len1 , fld2 , len2 )
 791   IMPLICIT NONE
 792   CHARACTER*(*) :: result
 793   CHARACTER*(*) :: basename
 794   INTEGER , INTENT(IN) :: fld1 , len1 , fld2 , len2
 795   CHARACTER*64         :: t1, t2, zeros
 796
 797   CALL zero_pad ( t1 , fld1 , len1 )
 798   CALL zero_pad ( t2 , fld2 , len2 )
 799   result = TRIM(basename) // "_d" // TRIM(t1) // "_" // TRIM(t2)
 800   CALL maybe_remove_colons(result)
 801   RETURN
 802 END SUBROUTINE construct_filename
 803
 804 SUBROUTINE construct_filename3 ( result , basename , fld1 , len1 , fld2 , len2, fld3, len3 )
 805   IMPLICIT NONE
 806   CHARACTER*(*) :: result
 807   CHARACTER*(*) :: basename
 808   INTEGER , INTENT(IN) :: fld1 , len1 , fld2 , len2, fld3, len3
 809   CHARACTER*64         :: t1, t2, t3, zeros
 810
 811   CALL zero_pad ( t1 , fld1 , len1 )
 812   CALL zero_pad ( t2 , fld2 , len2 )
 813   CALL zero_pad ( t3 , fld3 , len3 )
 814   result = TRIM(basename) // "_d" // TRIM(t1) // "_" // TRIM(t2) // "_" // TRIM(t3)
 815   CALL maybe_remove_colons(result)
 816   RETURN
 817 END SUBROUTINE construct_filename3
 818
 819 SUBROUTINE construct_filename4( result , basename , fld1 , len1 , date_char , io_form )
 820   USE module_state_description
 821   IMPLICIT NONE
 822   CHARACTER*(*) :: result
 823   CHARACTER*(*) :: basename
 824   CHARACTER*(*) :: date_char
 825
 826   INTEGER, EXTERNAL :: use_package
 827   INTEGER , INTENT(IN) :: fld1 , len1 , io_form
 828   CHARACTER*64         :: t1, zeros
 829   CHARACTER*4          :: ext
 830   CALL zero_pad ( t1 , fld1 , len1 )
 831   IF      ( use_package(io_form) .EQ. IO_INTIO ) THEN
 832      ext = '.int'
 833   ELSE IF ( use_package(io_form) .EQ. IO_NETCDF ) THEN
 834      ext = '.nc '
 835   ELSE IF ( use_package(io_form) .EQ. IO_PNETCDF ) THEN
 836     ext = '.nc '
 837   ELSE IF ( use_package(io_form) .EQ. IO_GRIB1 ) THEN
 838      ext = '.gb '
 839   ELSE
 840      CALL wrf_error_fatal ('improper io_form')
 841   END IF
 842   result = TRIM(basename) // ".d" // TRIM(t1) // "." // TRIM(date_char) // TRIM(ext)
 843   CALL maybe_remove_colons(result)
 844   RETURN
 845 END SUBROUTINE construct_filename4
 846
 847 ! this version looks for <date> and <domain> in the basename and replaces with the arguments
 848
 849 SUBROUTINE construct_filename4a( result , basename , fld1 , len1 , date_char , io_form )
 850   USE module_state_description
 851   IMPLICIT NONE
 852   CHARACTER*(*) :: result
 853   CHARACTER*(*) :: basename
 854   CHARACTER*(*) :: date_char
 855
 856   INTEGER, EXTERNAL :: use_package
 857   INTEGER , INTENT(IN) :: fld1 , len1 , io_form
 858   CHARACTER*64         :: t1, zeros
 859   CHARACTER*4          :: ext
 860   INTEGER   i, j, l
 861   result=basename
 862   CALL zero_pad ( t1 , fld1 , len1 )
 863   IF      ( use_package(io_form) .EQ. IO_INTIO ) THEN
 864      ext = '.int'
 865   ELSE IF ( use_package(io_form) .EQ. IO_NETCDF ) THEN
 866      ext = '.nc '
 867   ELSE IF ( use_package(io_form) .EQ. IO_PNETCDF ) THEN
 868     ext = '.nc '
 869   ELSE IF ( use_package(io_form) .EQ. IO_GRIB1 ) THEN
 870      ext = '.gb '
 871   ELSE
 872      CALL wrf_error_fatal ('improper io_form')
 873   END IF
 874   l = len(trim(basename))
 875   result = basename(1:l) // TRIM(ext)
 876   i = index( result , '<domain>' )
 877   l = len(trim(result))
 878   IF ( i .GT. 0 ) THEN
 879     result = result(1:i-1) // TRIM(t1) // result(i+8:l)
 880   ENDIF
 881   i = index( result , '<date>' )
 882   l = len(trim(result))
 883   IF ( i .GT. 0 ) THEN
 884     result = result(1:i-1) // TRIM(date_char) // result(i+6:l)
 885   ENDIF
 886   CALL maybe_remove_colons(result)
 887   RETURN
 888 END SUBROUTINE construct_filename4a
 889
 890 SUBROUTINE append_to_filename ( result , basename , fld1 , len1 )
 891   IMPLICIT NONE
 892   CHARACTER*(*) :: result
 893   CHARACTER*(*) :: basename
 894   INTEGER , INTENT(IN) :: fld1 , len1
 895   CHARACTER*64         :: t1, zeros
 896
 897   CALL zero_pad ( t1 , fld1 , len1 )
 898   result = TRIM(basename) // "_" // TRIM(t1)
 899   CALL maybe_remove_colons(result)
 900   RETURN
 901 END SUBROUTINE append_to_filename
 902
 903 SUBROUTINE zero_pad ( result , fld1 , len1 )
 904   IMPLICIT NONE
 905   CHARACTER*(*) :: result
 906   INTEGER , INTENT (IN)      :: fld1 , len1
 907   INTEGER                    :: d , x
 908   CHARACTER*64         :: t2, zeros
 909   x = fld1 ; d = 0
 910   DO WHILE ( x > 0 )
 911     x = x / 10
 912     d = d + 1
 913   END DO
 914   write(t2,'(I9)')fld1
 915   zeros = '0000000000000000000000000000000'
 916   result = zeros(1:len1-d) // t2(9-d+1:9)
 917   RETURN
 918 END SUBROUTINE zero_pad
 919
 920 SUBROUTINE init_wrfio
 921    USE module_io
 922    IMPLICIT NONE
 923    INTEGER ierr
 924    CALL wrf_ioinit(ierr)
 925 END SUBROUTINE init_wrfio
 926
 927 !<DESCRIPTION>
 928 ! This routine figures out the nearest previous time instant
 929 ! that corresponds to a multiple of the input time interval.
 930 ! Example use is to give the time instant that corresponds to
 931 ! an I/O interval, even when the current time is a little bit
 932 ! past that time when, for example, the number of model time
 933 ! steps does not evenly divide the I/O interval. JM 20051013
 934 !</DESCRIPTION>
 935 !
 936 SUBROUTINE adjust_io_timestr ( TI, CT, ST, timestr )
 937    USE module_io_domain
 938    IMPLICIT NONE
 939 ! Args
 940    TYPE(WRFU_Time), INTENT(IN)            :: ST,CT    ! domain start and current time
 941    TYPE(WRFU_TimeInterval), INTENT(IN)    :: TI       ! interval
 942    CHARACTER*(*), INTENT(INOUT)           :: timestr  ! returned string
 943 ! Local
 944    TYPE(WRFU_Time)                        :: OT
 945    TYPE(WRFU_TimeInterval)                :: IOI
 946    INTEGER                                :: n
 947
 948    IOI = CT-ST                               ! length of time since starting
 949    n = WRFU_TimeIntervalDIVQuot( IOI , TI )  ! number of whole time intervals
 950    IOI = TI * n                              ! amount of time since starting in whole time intervals
 951    OT = ST + IOI                             ! previous nearest time instant
 952    CALL wrf_timetoa( OT, timestr )           ! generate string
 953    RETURN
 954 END SUBROUTINE adjust_io_timestr
 955
 956 ! Modify the filename to remove things like ':' from the file name
 957 ! unless it is a drive number. Convert to '_' instead.
 958
 959 SUBROUTINE maybe_remove_colons( FileName )
 960   USE module_configure
 961   CHARACTER*(*) FileName
 962   CHARACTER c, d
 963   INTEGER i, l
 964   LOGICAL nocolons
 965   l = LEN(TRIM(FileName))
 966 ! do not change first two characters (naive way of dealing with
 967 ! possiblity of drive name in a microsoft path
 968   CALL nl_get_nocolons(1,nocolons)
 969   IF ( nocolons ) THEN
 970     DO i = 3, l
 971       IF ( FileName(i:i) .EQ. ':' ) THEN
 972         FileName(i:i) = '_'
 973       ENDIF
 974     ENDDO
 975   ENDIF
 976   RETURN
 977 END
 978
 979
 980