wrfv2_fire/dyn_exp/module_initialize_exp.F

   1 !IDEAL:MODEL_LAYER:INITIALIZATION
   2 !
   3
   4 !  This MODULE holds the routines which are used to perform various initializations
   5 !  for the individual domains.
   6
   7 !  This MODULE CONTAINS the following routines:
   8
   9 !  initialize_field_test - 1. Set different fields to different constant
  10 !                             values.  This is only a test.  If the correct
  11 !                             domain is not found (based upon the "id")
  12 !                             then a fatal error is issued.
  13
  14 MODULE module_initialize
  15
  16    USE module_domain
  17    USE module_state_description
  18    USE module_model_constants
  19    USE module_timing
  20    USE module_configure
  21
  22
  23 CONTAINS
  24
  25    SUBROUTINE init_domain_exp ( grid &
  26 !
  27 # include <exp_dummy_args.inc>
  28 !
  29 )
  30    IMPLICIT NONE
  31
  32    !  Input data.
  33    TYPE (domain), POINTER :: grid
  34
  35 # include <exp_dummy_decl.inc>
  36
  37    TYPE (grid_config_rec_type)              :: config_flags
  38
  39    !  Local data
  40    INTEGER                             ::                       &
  41                                   ids, ide, jds, jde, kds, kde, &
  42                                   ims, ime, jms, jme, kms, kme, &
  43                                   its, ite, jts, jte, kts, kte, &
  44                                   i, j, k
  45
  46 #define COPY_IN
  47 #include <exp_scalar_derefs.inc>
  48
  49    SELECT CASE ( model_data_order )
  50          CASE ( DATA_ORDER_ZXY )
  51    kds = grid%sd31 ; kde = grid%ed31 ;
  52    ids = grid%sd32 ; ide = grid%ed32 ;
  53    jds = grid%sd33 ; jde = grid%ed33 ;
  54
  55    kms = grid%sm31 ; kme = grid%em31 ;
  56    ims = grid%sm32 ; ime = grid%em32 ;
  57    jms = grid%sm33 ; jme = grid%em33 ;
  58
  59    kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
  60    its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
  61    jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
  62          CASE ( DATA_ORDER_XYZ )
  63    ids = grid%sd31 ; ide = grid%ed31 ;
  64    jds = grid%sd32 ; jde = grid%ed32 ;
  65    kds = grid%sd33 ; kde = grid%ed33 ;
  66
  67    ims = grid%sm31 ; ime = grid%em31 ;
  68    jms = grid%sm32 ; jme = grid%em32 ;
  69    kms = grid%sm33 ; kme = grid%em33 ;
  70
  71    its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
  72    jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
  73    kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
  74          CASE ( DATA_ORDER_XZY )
  75    ids = grid%sd31 ; ide = grid%ed31 ;
  76    kds = grid%sd32 ; kde = grid%ed32 ;
  77    jds = grid%sd33 ; jde = grid%ed33 ;
  78
  79    ims = grid%sm31 ; ime = grid%em31 ;
  80    kms = grid%sm32 ; kme = grid%em32 ;
  81    jms = grid%sm33 ; jme = grid%em33 ;
  82
  83    its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
  84    kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
  85    jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
  86
  87    END SELECT
  88
  89
  90    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
  91
  92 ! set the boundaries of the X array
  93     DO j = jts, jte
  94       DO k = kts, kte
  95         DO i = its, ite
  96           IF ( i == ids .OR. i == ide-1 .OR. j == jds .OR. j == jde-1 ) THEN
  97             x_1(i,k,j) = 1.
  98             x_2(i,k,j) = 1.
  99           ELSE
 100             x_1(i,k,j) = 0.
 101             x_2(i,k,j) = 0.
 102           ENDIF
 103         ENDDO
 104       ENDDO
 105     ENDDO
 106
 107 #define COPY_OUT
 108 #include <exp_scalar_derefs.inc>
 109
 110    RETURN
 111
 112    END SUBROUTINE init_domain_exp
 113
 114 !-------------------------------------------------------------------
 115 ! this is a wrapper for the solver-specific init_domain routines.
 116 ! Also dereferences the grid variables and passes them down as arguments.
 117 ! This is crucial, since the lower level routines may do message passing
 118 ! and this will get fouled up on machines that insist on passing down
 119 ! copies of assumed-shape arrays (by passing down as arguments, the
 120 ! data are treated as assumed-size -- ie. f77 -- arrays and the copying
 121 ! business is avoided).  Fie on the F90 designers.  Fie and a pox.
 122
 123    SUBROUTINE init_domain ( grid )
 124
 125    IMPLICIT NONE
 126
 127    !  Input data.
 128    TYPE (domain), POINTER :: grid
 129    !  Local data.
 130    INTEGER :: idum1, idum2
 131
 132 #ifdef DEREF_KLUDGE
 133 !  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
 134    INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
 135    INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
 136    INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
 137 #endif
 138
 139 #include "deref_kludge.h"
 140
 141    CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
 142
 143      CALL init_domain_exp( grid &
 144 !
 145 #include <actual_args.inc>
 146 !
 147                         )
 148
 149    END SUBROUTINE init_domain
 150
 151    SUBROUTINE init_module_initialize
 152    END SUBROUTINE init_module_initialize
 153
 154
 155 END MODULE module_initialize