wrf_ext_read_field.F
References to this file elsewhere.
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