wrf svn trunk commit r4103
[wrffire.git] / wrfv2_fire / share / wrf_ext_read_field.F
blob500e722175cb0e618aa61cf0747b8cc14890ce4b
1 !WRF:MEDIATION:IO
3   SUBROUTINE wrf_ext_read_field_arr(DataHandle,DateStr,Var       &
4                                 ,Field                            &
5                                 ,idx4, idx5, idx6, idx7           &
6                                 ,nx4 , nx5 , nx6                  &
7                                 ,TypeSizeInBytes                  &
8                                 ,FieldType,Comm,IOComm            &
9                                 ,DomainDesc                       &
10                                 ,bdy_mask                         &
11                                 ,MemoryOrder                      &
12                                 ,Stagger                          &
13                                 ,debug_message                                &
14                                 ,ds1, de1, ds2, de2, ds3, de3                 &
15                                 ,ms1, me1, ms2, me2, ms3, me3                 &
16                                 ,ps1, pe1, ps2, pe2, ps3, pe3, Status          )
17     USE module_io
18     USE module_wrf_error
19     USE module_state_description
20     USE module_timing
21     IMPLICIT NONE
23     INTEGER, INTENT(IN)       :: idx4, idx5, idx6, idx7
24     INTEGER, INTENT(IN)       :: nx4 , nx5 , nx6
25     INTEGER, INTENT(IN)       :: TypeSizeInBytes
26     INTEGER               ,INTENT(IN   )         :: DataHandle
27     CHARACTER*(*)         ,INTENT(IN   )         :: DateStr
28     CHARACTER*(*)         ,INTENT(IN   )         :: Var
29     INTEGER               ,INTENT(INOUT)         :: Field(*)
30     INTEGER               ,INTENT(IN   )         :: FieldType
31     INTEGER               ,INTENT(IN   )         :: Comm
32     INTEGER               ,INTENT(IN   )         :: IOComm
33     INTEGER               ,INTENT(IN   )         :: DomainDesc
34     CHARACTER*(*)         ,INTENT(IN   )         :: MemoryOrder
35     LOGICAL, DIMENSION(4) ,INTENT(IN   )         :: bdy_mask
36     CHARACTER*(*)         ,INTENT(IN   )         :: Stagger
37     CHARACTER*(*)         ,INTENT(IN   )         :: debug_message
39     INTEGER ,       INTENT(IN   ) :: ds1, de1, ds2, de2, ds3, de3, &
40                                      ms1, me1, ms2, me2, ms3, me3, &
41                                      ps1, pe1, ps2, pe2, ps3, pe3
42     INTEGER ,       INTENT(INOUT) :: Status
43 ! Local
44     INTEGER  tsfac  ! Type size factor
45     CHARACTER*256 mess
47     tsfac = TypeSizeInBytes / IWORDSIZE
49     IF ( tsfac .LE. 0 ) THEN
50       CALL wrf_message('wrf_ext_read_field_arr')
51       WRITE(mess,*)'Internal error: email this message to wrfhelp@ucar.edu ',TypeSizeInBytes,IWORDSIZE
52       CALL wrf_error_fatal(mess)
53     ENDIF
55     CALL wrf_ext_read_field(    DataHandle,DateStr,Var           &
56                                 ,Field(1                                                            &
57                                       +tsfac*(0                                                     &
58                                       +(idx4-1)*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)                 &                              
59                                       +(idx5-1)*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)             &                              
60                                       +(idx6-1)*nx5*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)         &                              
61                                       +(idx7-1)*nx6*nx5*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)))   &                              
62                                 ,FieldType,Comm,IOComm            &
63                                 ,DomainDesc                       &
64                                 ,bdy_mask                         &
65                                 ,MemoryOrder                      &
66                                 ,Stagger                          &
67                                 ,debug_message                                &
68                                 ,ds1, de1, ds2, de2, ds3, de3                 &
69                                 ,ms1, me1, ms2, me2, ms3, me3                 &
70                                 ,ps1, pe1, ps2, pe2, ps3, pe3, Status          )
71     
72   END SUBROUTINE wrf_ext_read_field_arr
74   SUBROUTINE wrf_ext_read_field( DataHandle,DateStr,Var,Field,FieldType,Comm,IOComm, &
75                                  DomainDesc, bdy_mask, MemoryOrder,Stagger,             &
76                                  debug_message ,                              &
77                                  ds1, de1, ds2, de2, ds3, de3,                &
78                                  ms1, me1, ms2, me2, ms3, me3,                &
79                                  ps1, pe1, ps2, pe2, ps3, pe3, Status          )
80     USE module_io
81     USE module_wrf_error
82     IMPLICIT NONE
84     integer                                      :: DataHandle
85     character*(*)                                :: DateStr
86     character*(*)                                :: Var
87     integer                                      :: Field(*)
88     integer                                      :: FieldType
89     integer                                      :: Comm
90     integer                                      :: IOComm
91     integer                                      :: DomainDesc
92     logical, dimension(4)                        :: bdy_mask
93     character*(*)                                :: MemoryOrder
94     character*(*)                                :: Stagger
95     character*(*)                                :: debug_message
97     INTEGER ,       INTENT(IN   ) :: ds1, de1, ds2, de2, ds3, de3, &
98                                      ms1, me1, ms2, me2, ms3, me3, &
99                                      ps1, pe1, ps2, pe2, ps3, pe3
101     INTEGER       itrace
102     INTEGER , DIMENSION(3) :: domain_start , domain_end
103     INTEGER , DIMENSION(3) :: memory_start , memory_end
104     INTEGER , DIMENSION(3) :: patch_start , patch_end
105     CHARACTER*80 , DIMENSION(3) :: dimnames
107     integer                       ,intent(inout)   :: Status
109     domain_start(1) = ds1 ; domain_end(1) = de1 ;
110     patch_start(1)  = ps1 ; patch_end(1)  = pe1 ;
111     memory_start(1) = ms1 ; memory_end(1) = me1 ;
112     domain_start(2) = ds2 ; domain_end(2) = de2 ;
113     patch_start(2)  = ps2 ; patch_end(2)  = pe2 ;
114     memory_start(2) = ms2 ; memory_end(2) = me2 ;
115     domain_start(3) = ds3 ; domain_end(3) = de3 ;
116     patch_start(3)  = ps3 ; patch_end(3)  = pe3 ;
117     memory_start(3) = ms3 ; memory_end(3) = me3 ;
119     CALL debug_io_wrf ( debug_message,DateStr,                          &
120                         domain_start,domain_end,patch_start,patch_end,  &
121                         memory_start,memory_end                          )
123 #if 0
124     Status = 1
125     if ( de1 - ds1 < 0 ) return
126     if ( de2 - ds2 < 0 ) return
127     if ( de3 - ds3 < 0 ) return
128     if ( pe1 - ps1 < 0 ) return
129     if ( pe2 - ps2 < 0 ) return
130     if ( pe3 - ps3 < 0 ) return
131     if ( me1 - ms1 < 0 ) return
132     if ( me2 - ms2 < 0 ) return
133     if ( me3 - ms3 < 0 ) return
134 #endif
135     Status = 0
137     CALL wrf_read_field (   &
138                        DataHandle                 &  ! DataHandle
139                       ,DateStr                    &  ! DateStr
140                       ,Var                        &  ! Data Name
141                       ,Field                      &  ! Field
142                       ,FieldType                  &  ! FieldType
143                       ,Comm                       &  ! Comm
144                       ,IOComm                     &  ! IOComm
145                       ,DomainDesc                 &  ! DomainDesc
146                       ,bdy_mask                   &  ! bdy_mask
147                       ,MemoryOrder                &  ! MemoryOrder
148                       ,Stagger                    &  ! Stagger
149                       ,dimnames                   &  ! JMMOD 1109
150                       ,domain_start               &  ! DomainStart
151                       ,domain_end                 &  ! DomainEnd
152                       ,memory_start               &  ! MemoryStart
153                       ,memory_end                 &  ! MemoryEnd
154                       ,patch_start                &  ! PatchStart
155                       ,patch_end                  &  ! PatchEnd
156                       ,Status )
157     IF ( wrf_at_debug_level(300) ) THEN
158       WRITE(wrf_err_message,*) debug_message,' Status = ',Status
159       CALL wrf_message ( TRIM(wrf_err_message) )
160     ENDIF
162   END SUBROUTINE wrf_ext_read_field