| 1 | !WRF:MEDIATION:IO |
|---|
| 2 | SUBROUTINE wrf_ext_read_field( DataHandle,DateStr,Var,Field,FieldType,Comm,IOComm, & |
|---|
| 3 | DomainDesc, bdy_mask, MemoryOrder,Stagger, & |
|---|
| 4 | debug_message , & |
|---|
| 5 | ds1, de1, ds2, de2, ds3, de3, & |
|---|
| 6 | ms1, me1, ms2, me2, ms3, me3, & |
|---|
| 7 | ps1, pe1, ps2, pe2, ps3, pe3, Status ) |
|---|
| 8 | USE module_io |
|---|
| 9 | USE module_wrf_error |
|---|
| 10 | IMPLICIT NONE |
|---|
| 11 | |
|---|
| 12 | integer :: DataHandle |
|---|
| 13 | character*(*) :: DateStr |
|---|
| 14 | character*(*) :: Var |
|---|
| 15 | integer :: Field(*) |
|---|
| 16 | integer :: FieldType |
|---|
| 17 | integer :: Comm |
|---|
| 18 | integer :: IOComm |
|---|
| 19 | integer :: DomainDesc |
|---|
| 20 | logical, dimension(4) :: bdy_mask |
|---|
| 21 | character*(*) :: MemoryOrder |
|---|
| 22 | character*(*) :: Stagger |
|---|
| 23 | character*(*) :: debug_message |
|---|
| 24 | |
|---|
| 25 | INTEGER , INTENT(IN ) :: ds1, de1, ds2, de2, ds3, de3, & |
|---|
| 26 | ms1, me1, ms2, me2, ms3, me3, & |
|---|
| 27 | ps1, pe1, ps2, pe2, ps3, pe3 |
|---|
| 28 | |
|---|
| 29 | INTEGER itrace |
|---|
| 30 | INTEGER , DIMENSION(3) :: domain_start , domain_end |
|---|
| 31 | INTEGER , DIMENSION(3) :: memory_start , memory_end |
|---|
| 32 | INTEGER , DIMENSION(3) :: patch_start , patch_end |
|---|
| 33 | CHARACTER*80 , DIMENSION(3) :: dimnames |
|---|
| 34 | |
|---|
| 35 | integer ,intent(inout) :: Status |
|---|
| 36 | |
|---|
| 37 | domain_start(1) = ds1 ; domain_end(1) = de1 ; |
|---|
| 38 | patch_start(1) = ps1 ; patch_end(1) = pe1 ; |
|---|
| 39 | memory_start(1) = ms1 ; memory_end(1) = me1 ; |
|---|
| 40 | domain_start(2) = ds2 ; domain_end(2) = de2 ; |
|---|
| 41 | patch_start(2) = ps2 ; patch_end(2) = pe2 ; |
|---|
| 42 | memory_start(2) = ms2 ; memory_end(2) = me2 ; |
|---|
| 43 | domain_start(3) = ds3 ; domain_end(3) = de3 ; |
|---|
| 44 | patch_start(3) = ps3 ; patch_end(3) = pe3 ; |
|---|
| 45 | memory_start(3) = ms3 ; memory_end(3) = me3 ; |
|---|
| 46 | |
|---|
| 47 | CALL debug_io_wrf ( debug_message,DateStr, & |
|---|
| 48 | domain_start,domain_end,patch_start,patch_end, & |
|---|
| 49 | memory_start,memory_end ) |
|---|
| 50 | |
|---|
| 51 | Status = 1 |
|---|
| 52 | if ( de1 - ds1 < 0 ) return |
|---|
| 53 | if ( de2 - ds2 < 0 ) return |
|---|
| 54 | if ( de3 - ds3 < 0 ) return |
|---|
| 55 | if ( pe1 - ps1 < 0 ) return |
|---|
| 56 | if ( pe2 - ps2 < 0 ) return |
|---|
| 57 | if ( pe3 - ps3 < 0 ) return |
|---|
| 58 | if ( me1 - ms1 < 0 ) return |
|---|
| 59 | if ( me2 - ms2 < 0 ) return |
|---|
| 60 | if ( me3 - ms3 < 0 ) return |
|---|
| 61 | Status = 0 |
|---|
| 62 | |
|---|
| 63 | CALL wrf_read_field ( & |
|---|
| 64 | DataHandle & ! DataHandle |
|---|
| 65 | ,DateStr & ! DateStr |
|---|
| 66 | ,Var & ! Data Name |
|---|
| 67 | ,Field & ! Field |
|---|
| 68 | ,FieldType & ! FieldType |
|---|
| 69 | ,Comm & ! Comm |
|---|
| 70 | ,IOComm & ! IOComm |
|---|
| 71 | ,DomainDesc & ! DomainDesc |
|---|
| 72 | ,bdy_mask & ! bdy_mask |
|---|
| 73 | ,MemoryOrder & ! MemoryOrder |
|---|
| 74 | ,Stagger & ! Stagger |
|---|
| 75 | ,dimnames & ! JMMOD 1109 |
|---|
| 76 | ,domain_start & ! DomainStart |
|---|
| 77 | ,domain_end & ! DomainEnd |
|---|
| 78 | ,memory_start & ! MemoryStart |
|---|
| 79 | ,memory_end & ! MemoryEnd |
|---|
| 80 | ,patch_start & ! PatchStart |
|---|
| 81 | ,patch_end & ! PatchEnd |
|---|
| 82 | ,Status ) |
|---|
| 83 | IF ( wrf_at_debug_level(300) ) THEN |
|---|
| 84 | WRITE(wrf_err_message,*) debug_message,' Status = ',Status |
|---|
| 85 | CALL wrf_message ( TRIM(wrf_err_message) ) |
|---|
| 86 | ENDIF |
|---|
| 87 | |
|---|
| 88 | END SUBROUTINE wrf_ext_read_field |
|---|
| 89 | |
|---|
