share/wrf_ext_read_field.F

   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, grid                  &
   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     USE module_domain
  22     IMPLICIT NONE
  23
  24     INTEGER, INTENT(IN)       :: idx4, idx5, idx6, idx7
  25     INTEGER, INTENT(IN)       :: nx4 , nx5 , nx6
  26     INTEGER, INTENT(IN)       :: TypeSizeInBytes
  27     INTEGER               ,INTENT(IN   )         :: DataHandle
  28     CHARACTER*(*)         ,INTENT(IN   )         :: DateStr
  29     CHARACTER*(*)         ,INTENT(IN   )         :: Var
  30     INTEGER               ,INTENT(INOUT)         :: Field(*)
  31     INTEGER               ,INTENT(IN   )         :: FieldType
  32     TYPE(domain)                                 :: grid
  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, grid                  &
  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,grid, &
  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     USE module_domain
  83
  84     IMPLICIT NONE
  85
  86     integer                                      :: DataHandle
  87     character*(*)                                :: DateStr
  88     character*(*)                                :: Var
  89     integer                                      :: Field(*)
  90     integer                                      :: FieldType
  91     TYPE(domain)                                 :: grid
  92     integer                                      :: DomainDesc
  93     logical, dimension(4)                        :: bdy_mask
  94     character*(*)                                :: MemoryOrder
  95     character*(*)                                :: Stagger
  96     character*(*)                                :: debug_message
  97
  98     INTEGER ,       INTENT(IN   ) :: ds1, de1, ds2, de2, ds3, de3, &
  99                                      ms1, me1, ms2, me2, ms3, me3, &
 100                                      ps1, pe1, ps2, pe2, ps3, pe3
 101
 102     INTEGER       itrace
 103     INTEGER , DIMENSION(3) :: domain_start , domain_end
 104     INTEGER , DIMENSION(3) :: memory_start , memory_end
 105     INTEGER , DIMENSION(3) :: patch_start , patch_end
 106     CHARACTER*80 , DIMENSION(3) :: dimnames
 107
 108     integer                       ,intent(inout)   :: Status
 109
 110     domain_start(1) = ds1 ; domain_end(1) = de1 ;
 111     patch_start(1)  = ps1 ; patch_end(1)  = pe1 ;
 112     memory_start(1) = ms1 ; memory_end(1) = me1 ;
 113     domain_start(2) = ds2 ; domain_end(2) = de2 ;
 114     patch_start(2)  = ps2 ; patch_end(2)  = pe2 ;
 115     memory_start(2) = ms2 ; memory_end(2) = me2 ;
 116     domain_start(3) = ds3 ; domain_end(3) = de3 ;
 117     patch_start(3)  = ps3 ; patch_end(3)  = pe3 ;
 118     memory_start(3) = ms3 ; memory_end(3) = me3 ;
 119
 120     CALL debug_io_wrf ( debug_message,DateStr,                          &
 121                         domain_start,domain_end,patch_start,patch_end,  &
 122                         memory_start,memory_end                          )
 123
 124 #if 0
 125     Status = 1
 126     if ( de1 - ds1 < 0 ) return
 127     if ( de2 - ds2 < 0 ) return
 128     if ( de3 - ds3 < 0 ) return
 129     if ( pe1 - ps1 < 0 ) return
 130     if ( pe2 - ps2 < 0 ) return
 131     if ( pe3 - ps3 < 0 ) return
 132     if ( me1 - ms1 < 0 ) return
 133     if ( me2 - ms2 < 0 ) return
 134     if ( me3 - ms3 < 0 ) return
 135 #endif
 136     Status = 0
 137
 138     CALL wrf_read_field (   &
 139                        DataHandle                 &  ! DataHandle
 140                       ,DateStr                    &  ! DateStr
 141                       ,Var                        &  ! Data Name
 142                       ,Field                      &  ! Field
 143                       ,FieldType                  &  ! FieldType
 144                       ,grid                       &  ! domain grid
 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