wrfv2_fire/share/wrf_ext_write_field.F

   1 !WRF:MEDIATION:IO
   2   SUBROUTINE wrf_ext_write_field_arr(DataHandle,DateStr,Var       &
   3                                 ,Field                            &
   4                                 ,idx4, idx5, idx6, idx7           &
   5                                 ,nx4 , nx5 , nx6                  &
   6                                 ,TypeSizeInBytes                  &
   7                                 ,FieldType,Comm,IOComm            &
   8                                 ,DomainDesc                       &
   9                                 ,bdy_mask                         &
  10                                 ,dryrun                           &
  11                                 ,MemoryOrder                      &
  12                                 ,Stagger                          &
  13                                 ,Dimname1, Dimname2, Dimname3     &
  14                                 ,Desc, Units                      &
  15                                 ,debug_message                                &
  16                                 ,ds1, de1, ds2, de2, ds3, de3                 &
  17                                 ,ms1, me1, ms2, me2, ms3, me3                 &
  18                                 ,ps1, pe1, ps2, pe2, ps3, pe3, Status          )
  19     USE module_io
  20     USE module_wrf_error
  21     USE module_state_description
  22     USE module_timing
  23     IMPLICIT NONE
  24
  25     INTEGER, INTENT(IN)       :: idx4, idx5, idx6, idx7
  26     INTEGER, INTENT(IN)       :: nx4 , nx5 , nx6
  27     INTEGER, INTENT(IN)       :: TypeSizeInBytes
  28     INTEGER               ,INTENT(IN   )         :: DataHandle
  29     CHARACTER*(*)         ,INTENT(IN   )         :: DateStr
  30     CHARACTER*(*)         ,INTENT(IN   )         :: Var
  31     INTEGER               ,INTENT(IN   )         :: Field(*)
  32     INTEGER               ,INTENT(IN   )         :: FieldType
  33     INTEGER               ,INTENT(IN   )         :: Comm
  34     INTEGER               ,INTENT(IN   )         :: IOComm
  35     INTEGER               ,INTENT(IN   )         :: DomainDesc
  36     LOGICAL               ,INTENT(IN   )         :: dryrun
  37     CHARACTER*(*)         ,INTENT(IN   )         :: MemoryOrder
  38     LOGICAL, DIMENSION(4) ,INTENT(IN   )         :: bdy_mask
  39     CHARACTER*(*)         ,INTENT(IN   )         :: Stagger
  40     CHARACTER*(*)         ,INTENT(IN   )         :: Dimname1, Dimname2, Dimname3
  41     CHARACTER*(*)         ,INTENT(IN   )         :: Desc, Units
  42     CHARACTER*(*)         ,INTENT(IN   )         :: debug_message
  43
  44     INTEGER ,       INTENT(IN   ) :: ds1, de1, ds2, de2, ds3, de3, &
  45                                      ms1, me1, ms2, me2, ms3, me3, &
  46                                      ps1, pe1, ps2, pe2, ps3, pe3
  47     INTEGER ,       INTENT(INOUT) :: Status
  48 ! Local
  49     INTEGER  tsfac  ! Type size factor
  50     CHARACTER*256 mess
  51
  52     tsfac = TypeSizeInBytes / IWORDSIZE
  53
  54     IF ( tsfac .LE. 0 ) THEN
  55       CALL wrf_message('wrf_ext_write_field_arr')
  56       WRITE(mess,*)'Internal error: email this message to wrfhelp@ucar.edu ',TypeSizeInBytes,IWORDSIZE
  57       CALL wrf_error_fatal(mess)
  58     ENDIF
  59
  60     CALL wrf_ext_write_field(    DataHandle,DateStr,Var           &
  61                                 ,Field(1                                                            &
  62                                       +tsfac*(0                                                     &
  63                                       +(idx4-1)*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)                 &
  64                                       +(idx5-1)*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)             &
  65                                       +(idx6-1)*nx5*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)         &
  66                                       +(idx7-1)*nx6*nx5*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)))   &
  67                                 ,FieldType,Comm,IOComm            &
  68                                 ,DomainDesc                       &
  69                                 ,bdy_mask                         &
  70                                 ,dryrun                           &
  71                                 ,MemoryOrder                      &
  72                                 ,Stagger                          &
  73                                 ,Dimname1, Dimname2, Dimname3     &
  74                                 ,Desc, Units                      &
  75                                 ,debug_message                                &
  76                                 ,ds1, de1, ds2, de2, ds3, de3                 &
  77                                 ,ms1, me1, ms2, me2, ms3, me3                 &
  78                                 ,ps1, pe1, ps2, pe2, ps3, pe3, Status          )
  79
  80   END SUBROUTINE wrf_ext_write_field_arr
  81
  82
  83   SUBROUTINE wrf_ext_write_field(DataHandle,DateStr,Var,Field,FieldType,Comm,IOComm, &
  84                                  DomainDesc,                      &
  85                                  bdy_mask   ,                     &
  86                                  dryrun        ,                  &
  87                                  MemoryOrder,                     &
  88                                  Stagger,                         &
  89                                  Dimname1, Dimname2, Dimname3 ,   &
  90                                  Desc, Units,                     &
  91                                  debug_message ,                              &
  92                                  ds1, de1, ds2, de2, ds3, de3,                &
  93                                  ms1, me1, ms2, me2, ms3, me3,                &
  94                                  ps1, pe1, ps2, pe2, ps3, pe3, Status          )
  95     USE module_io
  96     USE module_wrf_error
  97     USE module_state_description
  98     USE module_timing
  99     IMPLICIT NONE
 100
 101     INTEGER               ,INTENT(IN   )         :: DataHandle
 102     CHARACTER*(*)         ,INTENT(IN   )         :: DateStr
 103     CHARACTER*(*)         ,INTENT(IN   )         :: Var
 104     INTEGER               ,INTENT(IN   )         :: Field(*)
 105     INTEGER               ,INTENT(IN   )         :: FieldType
 106     INTEGER               ,INTENT(IN   )         :: Comm
 107     INTEGER               ,INTENT(IN   )         :: IOComm
 108     INTEGER               ,INTENT(IN   )         :: DomainDesc
 109     LOGICAL               ,INTENT(IN   )         :: dryrun
 110     CHARACTER*(*)         ,INTENT(IN   )         :: MemoryOrder
 111     LOGICAL, DIMENSION(4) ,INTENT(IN   )         :: bdy_mask
 112     CHARACTER*(*)         ,INTENT(IN   )         :: Stagger
 113     CHARACTER*(*)         ,INTENT(IN   )         :: Dimname1, Dimname2, Dimname3
 114     CHARACTER*(*)         ,INTENT(IN   )         :: Desc, Units
 115     CHARACTER*(*)         ,INTENT(IN   )         :: debug_message
 116
 117     INTEGER ,       INTENT(IN   ) :: ds1, de1, ds2, de2, ds3, de3, &
 118                                      ms1, me1, ms2, me2, ms3, me3, &
 119                                      ps1, pe1, ps2, pe2, ps3, pe3
 120
 121 ! Local
 122     INTEGER , DIMENSION(3) :: domain_start , domain_end
 123     INTEGER , DIMENSION(3) :: memory_start , memory_end
 124     INTEGER , DIMENSION(3) :: patch_start , patch_end
 125     CHARACTER*80 , DIMENSION(3) :: dimnames
 126
 127     integer                       ,intent(inout)   :: Status
 128     LOGICAL for_out, horiz_stagger
 129     INTEGER Hndl, io_form
 130     LOGICAL, EXTERNAL :: has_char
 131     INTEGER, EXTERNAL :: use_package
 132
 133     IF ( wrf_at_debug_level( 500 ) ) THEN
 134       call start_timing
 135     ENDIF
 136     domain_start(1) = ds1 ; domain_end(1) = de1 ;
 137     patch_start(1)  = ps1 ; patch_end(1)  = pe1 ;
 138     memory_start(1) = ms1 ; memory_end(1) = me1 ;
 139     domain_start(2) = ds2 ; domain_end(2) = de2 ;
 140     patch_start(2)  = ps2 ; patch_end(2)  = pe2 ;
 141     memory_start(2) = ms2 ; memory_end(2) = me2 ;
 142     domain_start(3) = ds3 ; domain_end(3) = de3 ;
 143     patch_start(3)  = ps3 ; patch_end(3)  = pe3 ;
 144     memory_start(3) = ms3 ; memory_end(3) = me3 ;
 145
 146     dimnames(1) = Dimname1
 147     dimnames(2) = Dimname2
 148     dimnames(3) = Dimname3
 149
 150     CALL debug_io_wrf ( debug_message,DateStr,                          &
 151                         domain_start,domain_end,patch_start,patch_end,  &
 152                         memory_start,memory_end                          )
 153 #if 0
 154     Status = 1
 155     if ( de1 - ds1 < 0 ) return
 156     if ( de2 - ds2 < 0 ) return
 157     if ( de3 - ds3 < 0 ) return
 158     if ( pe1 - ps1 < 0 ) return
 159     if ( pe2 - ps2 < 0 ) return
 160     if ( pe3 - ps3 < 0 ) return
 161     if ( me1 - ms1 < 0 ) return
 162     if ( me2 - ms2 < 0 ) return
 163     if ( me3 - ms3 < 0 ) return
 164 #endif
 165     Status = 0
 166
 167
 168     CALL wrf_write_field (   &
 169                        DataHandle                 &  ! DataHandle
 170                       ,DateStr                    &  ! DateStr
 171                       ,Var                        &  ! Data Name
 172                       ,Field                      &  ! Field
 173                       ,FieldType                  &  ! FieldType
 174                       ,Comm                       &  ! Comm
 175                       ,IOComm                     &  ! IOComm
 176                       ,DomainDesc                 &  ! DomainDesc
 177                       ,bdy_mask                   &  ! bdy_mask
 178                       ,MemoryOrder                &  ! MemoryOrder
 179                       ,Stagger                    &  ! JMMODS 010620
 180                       ,dimnames                   &  ! JMMODS 001109
 181                       ,domain_start               &  ! DomainStart
 182                       ,domain_end                 &  ! DomainEnd
 183                       ,memory_start               &  ! MemoryStart
 184                       ,memory_end                 &  ! MemoryEnd
 185                       ,patch_start                &  ! PatchStart
 186                       ,patch_end                  &  ! PatchEnd
 187                       ,Status )
 188
 189     CALL get_handle ( Hndl, io_form , for_out, DataHandle )
 190
 191     IF ( ( dryrun .AND. ( use_package(io_form) .EQ. IO_NETCDF .OR. &
 192                           use_package(io_form) .EQ. IO_PNETCDF ) ) .OR. &
 193                         ( use_package(io_form) .EQ. IO_PHDF5  )   ) THEN
 194
 195       CALL wrf_put_var_ti_char( &
 196                        DataHandle                 &  ! DataHandle
 197                       ,"description"              &  ! Element
 198                       ,Var                        &  ! Data Name
 199                       ,Desc                       &  ! Data
 200                       ,Status )
 201       CALL wrf_put_var_ti_char( &
 202                        DataHandle                 &  ! DataHandle
 203                       ,"units"                    &  ! Element
 204                       ,Var                        &  ! Data Name
 205                       ,Units                      &  ! Data
 206                       ,Status )
 207       CALL wrf_put_var_ti_char( &
 208                        DataHandle                 &  ! DataHandle
 209                       ,"stagger"                  &  ! Element
 210                       ,Var                        &  ! Data Name
 211                       ,Stagger                    &  ! Data
 212                       ,Status )
 213 #if (EM_CORE == 1)
 214 ! TBH:  Added "coordinates" metadata for GIS folks in RAL.  It is a step
 215 ! TBH:  towards CF.  This change was requested by Jennifer Boehnert based
 216 ! TBH:  upon a suggestion from Nawajish Noman.
 217 ! TBH:  TODO:  This code depends upon longitude and latitude arrays being
 218 ! TBH:         named "XLONG", "XLAT", "XLONG_U", "XLAT_U", "XLONG_V", and
 219 ! TBH:         "XLAT_V" for EM_CORE.  We need a more general way to handle
 220 ! TBH:         this, possibly via the Registry.
 221 ! TBH:  TODO:  Leave this on all the time or make it namelist-selectable?
 222 ! TBH:  TODO:  Use dimnames(*) == south_north || west_east instead of
 223 ! TBH:         MemoryOrder and Stagger?  It would also work for both ARW
 224 ! TBH:         and NMM and be easier to handle via Registry...
 225 !      IF ( ( ( MemoryOrder(1:2) == 'XY' ) .OR. &
 226 !             ( MemoryOrder(1:3) == 'XZY' ) ) .AND. &
 227 !           ( Var(1:5) /= 'XLONG' ) .AND. &
 228 !           ( Var(1:4) /= 'XLAT'  ) ) THEN
 229 ! JM used trim instead, to avoid spurious errors when bounds checking on
 230       IF ( ( ( TRIM(MemoryOrder) == 'XY' ) .OR. &
 231              ( TRIM(MemoryOrder) == 'XZY' ) .OR. &
 232              ( TRIM(MemoryOrder) == 'XYZ' ) ) .AND. &
 233            ( TRIM(Var) /= 'XLONG' ) .AND. &
 234            ( TRIM(Var) /= 'XLAT'  ) ) THEN
 235         horiz_stagger = .FALSE.
 236         IF ( LEN_TRIM(Stagger) == 1 ) THEN
 237           IF ( has_char( Stagger, 'x' ) ) THEN
 238             horiz_stagger = .TRUE.
 239             CALL wrf_put_var_ti_char( &
 240                              DataHandle                 &  ! DataHandle
 241                             ,"coordinates"              &  ! Element
 242                             ,Var                        &  ! Data Name
 243                             ,"XLONG_U XLAT_U"           &  ! Data
 244                             ,Status )
 245           ELSE IF ( has_char( Stagger, 'y' ) ) THEN
 246             horiz_stagger = .TRUE.
 247             CALL wrf_put_var_ti_char( &
 248                              DataHandle                 &  ! DataHandle
 249                             ,"coordinates"              &  ! Element
 250                             ,Var                        &  ! Data Name
 251                             ,"XLONG_V XLAT_V"           &  ! Data
 252                             ,Status )
 253           ENDIF
 254         ENDIF
 255         IF ( .NOT. horiz_stagger ) THEN
 256           CALL wrf_put_var_ti_char( &
 257                            DataHandle                 &  ! DataHandle
 258                           ,"coordinates"              &  ! Element
 259                           ,Var                        &  ! Data Name
 260                           ,"XLONG XLAT"               &  ! Data
 261                           ,Status )
 262         ENDIF
 263       ENDIF
 264 #endif
 265     ENDIF
 266
 267     IF ( wrf_at_debug_level(300) ) THEN
 268       WRITE(wrf_err_message,*) debug_message,' Status = ',Status
 269       CALL wrf_message ( TRIM(wrf_err_message) )
 270     ENDIF
 271
 272     IF ( wrf_at_debug_level( 500 ) ) THEN
 273       CALL end_timing('wrf_ext_write_field')
 274     ENDIF
 275
 276   END SUBROUTINE wrf_ext_write_field