source: lmdz_wrf/trunk/WRFV3/share/wrf_ext_read_field.F @ 2271

Last change on this file since 2271 was 1, checked in by lfita, 11 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 8.1 KB
Line 
1!WRF:MEDIATION:IO
2
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
22
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
38
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
46
47    tsfac = TypeSizeInBytes / IWORDSIZE
48
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
54
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
73
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
83
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
96
97    INTEGER ,       INTENT(IN   ) :: ds1, de1, ds2, de2, ds3, de3, &
98                                     ms1, me1, ms2, me2, ms3, me3, &
99                                     ps1, pe1, ps2, pe2, ps3, pe3
100
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
106
107    integer                       ,intent(inout)   :: Status
108
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 ;
118
119    CALL debug_io_wrf ( debug_message,DateStr,                          &
120                        domain_start,domain_end,patch_start,patch_end,  &
121                        memory_start,memory_end                          )
122
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
136
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
161
162  END SUBROUTINE wrf_ext_read_field
163
Note: See TracBrowser for help on using the repository browser.