standalone/wrf_fakes.F

   1 ! wrf_fakes.F
   2 ! things that would be normally done in WRF
   3
   4 module module_model_constants
   5 ! The model may not define any physical constants, all must be done here.
   6 ! copied what needed from WRFV3/share/module_model_constants.F
   7    REAL   , PARAMETER :: r_d          = 287.
   8    REAL   , PARAMETER :: cp           = 7.*r_d/2.   ! specific heat of the atmosphere
   9    REAL   , PARAMETER :: xlv          = 2.5E6       ! latent heat
  10    REAL   , PARAMETER ::  pi2=2.*3.1415926          ! 2*pi
  11    REAL   , PARAMETER :: reradius     = 1./6370.0e03 ! 1/earth radius
  12    REAL   , PARAMETER :: g            = 9.81        ! gravity acceleration
  13 end module module_model_constants
  14
  15 module module_state_description
  16    integer, parameter:: num_tracer=1
  17    integer ::             p_tr17_1=1
  18    integer ::             p_tr17_2=1
  19    integer ::             p_tr17_3=1
  20    integer ::             p_tr17_4=1
  21    integer ::             p_tr17_5=1
  22    integer ::             p_tr17_6=1
  23    integer ::             p_tr17_7=1
  24    integer ::             p_tr17_8=1
  25 end module module_state_description
  26
  27 !
  28 !***
  29 !
  30
  31 module module_wrf_error
  32 implicit none
  33 contains
  34
  35 ! mock-up of various wrf utility functions
  36
  37 subroutine wrf_error_fatal(s)
  38 !*** purpose: abort with a message
  39 implicit none
  40 character(len=*), intent(in)::s
  41 call latch ! food for debugger so you can say "stop at latch" and not worry about module name
  42 write(6,*)s
  43 call abort()
  44 end subroutine wrf_error_fatal
  45
  46 !
  47 !***
  48 !
  49
  50 subroutine wrf_debug(level,s)
  51 !*** purpose: print a message
  52
  53 implicit none
  54 character(len=*), intent(in)::s
  55 integer, intent(in):: level
  56 write(6,*)s
  57 end subroutine wrf_debug
  58
  59 !
  60 !***
  61 !
  62
  63 subroutine wrf_message(s)
  64 character(len=*), intent(in)::s
  65 integer i
  66 do i=len(s),2,-1
  67     select case(s(i:i))
  68     case(' ')
  69     case default
  70         goto 1
  71     end select
  72 enddo
  73 1 write(6,'(a)')s(1:i)
  74 end subroutine wrf_message
  75
  76 end module module_wrf_error
  77
  78 !
  79 !***
  80 !
  81
  82 ! just for testing
  83 subroutine latch
  84 end
  85
  86 subroutine wrf_error_fatal(s)
  87 ! ESMF has this subroutine outside the module for some reason
  88 use module_wrf_error, ONLY : wrf_error_fatal_mod => wrf_error_fatal
  89 implicit none
  90 character(len=*),intent(in)::s
  91 call wrf_error_fatal_mod(s)
  92 end subroutine wrf_error_fatal
  93
  94 !
  95 !*** various stubs, mostly doing nothing
  96 !
  97
  98 module module_dm
  99 use module_wrf_error
 100 implicit none
 101 contains
 102 subroutine wrf_get_nproc (nprocs)
 103 integer nprocs
 104 nprocs=1
 105 end subroutine wrf_get_nproc
 106
 107 !
 108 !***
 109 !
 110
 111 subroutine wrf_get_myproc( myproc )
 112 integer myproc
 113 myproc=1
 114 end subroutine wrf_get_myproc
 115
 116 !
 117 !***
 118 !
 119
 120 subroutine wrf_dm_maxval_integer( val, idex, jdex )
 121 integer::val
 122 integer::idex,jdex
 123 call wrf_error_fatal('wrf_dm_maxval_integer:not implemented')
 124 end subroutine wrf_dm_maxval_integer
 125
 126 subroutine wrf_dm_sum_reals(t,s)
 127 real, intent(in)::t(:)
 128 real, intent(out)::s(:)
 129 s=t
 130 end subroutine wrf_dm_sum_reals
 131
 132 end module module_dm
 133
 134 !
 135 !*** external stubs
 136 !
 137
 138
 139 SUBROUTINE wrf_dm_bcast_real( BUF, N1 )
 140    IMPLICIT NONE
 141    INTEGER n1
 142    REAL  buf(*)
 143    RETURN
 144 END SUBROUTINE wrf_dm_bcast_real
 145
 146 !
 147 !***
 148 !
 149
 150 LOGICAL FUNCTION wrf_dm_on_monitor()
 151   wrf_dm_on_monitor = .true.
 152 END FUNCTION wrf_dm_on_monitor
 153
 154 !
 155 !***
 156 !
 157
 158 SUBROUTINE wrf_dm_bcast_integer( BUF, N1 )
 159    IMPLICIT NONE
 160    INTEGER n1
 161    INTEGER  buf(*)
 162    RETURN
 163 END SUBROUTINE wrf_dm_bcast_integer
 164
 165
 166 !WRF:DRIVER_LAYER:UTIL
 167 !
 168
 169 MODULE module_timing
 170    use module_wrf_error
 171
 172    INTEGER, PARAMETER, PRIVATE :: cnmax = 30
 173    INTEGER, PRIVATE, DIMENSION(cnmax) :: count_int1 , count_rate_int1 , count_max_int1
 174    INTEGER, PRIVATE, DIMENSION(cnmax) :: count_int2 , count_rate_int2 , count_max_int2
 175    INTEGER, PRIVATE :: cn = 0
 176    REAL, PRIVATE    :: elapsed_seconds , elapsed_seconds_total = 0
 177    REAL, PRIVATE    :: cpu_1 , cpu_2 , cpu_seconds , cpu_seconds_total = 0
 178
 179 CONTAINS
 180
 181    SUBROUTINE init_module_timing
 182       cn = 0
 183    END SUBROUTINE init_module_timing
 184
 185
 186    SUBROUTINE start_timing
 187
 188       IMPLICIT NONE
 189
 190       cn = cn + 1
 191       IF ( cn .gt. cnmax ) THEN
 192         CALL  wrf_error_fatal( 'module_timing: clock nesting error (too many nests)' )
 193         RETURN
 194       ENDIF
 195       CALL SYSTEM_CLOCK ( count_int1(cn) , count_rate_int1(cn) , count_max_int1(cn) )
 196 !     CALL CPU_TIME ( cpu_1 )
 197
 198    END SUBROUTINE start_timing
 199
 200
 201    SUBROUTINE end_timing ( string )
 202
 203       IMPLICIT NONE
 204
 205       CHARACTER *(*) :: string
 206
 207       IF ( cn .lt. 1 ) THEN
 208         CALL  wrf_error_fatal( 'module_timing: clock nesting error, cn<1' )
 209       ELSE IF ( cn .gt. cnmax ) THEN
 210         CALL  wrf_error_fatal( 'module_timing: clock nesting error, cn>cnmax' )
 211       ENDIF
 212
 213       CALL SYSTEM_CLOCK ( count_int2(cn) , count_rate_int2(cn) , count_max_int2(cn) )
 214 !     CALL CPU_TIME ( cpu_2 )
 215
 216       IF ( count_int2(cn) < count_int1(cn) ) THEN
 217          count_int2(cn) = count_int2(cn) + count_max_int2(cn)
 218       ENDIF
 219
 220       count_int2(cn) = count_int2(cn) - count_int1(cn)
 221       elapsed_seconds = REAL(count_int2(cn)) / REAL(count_rate_int2(cn))
 222       elapsed_seconds_total = elapsed_seconds_total + elapsed_seconds
 223
 224       WRITE(6,'(A,A,A,F10.5,A)') 'Timing for ',TRIM(string),': ',elapsed_seconds,' elapsed seconds.'
 225 #if defined(DM_PARALLEL) && ! defined(STUBMPI)
 226       WRITE(0,'(A,A,A,F10.5,A)') 'Timing for ',TRIM(string),': ',elapsed_seconds,' elapsed seconds.'
 227 #endif
 228
 229 !     cpu_seconds = cpu_2 - cpu_1
 230 !     cpu_seconds_total = cpu_seconds_total + cpu_seconds
 231 !     PRINT '(A,A,A,F10.5,A)' ,'Timing for ',TRIM(string),': ',cpu_seconds,' cpu seconds.'
 232
 233       cn = cn - 1
 234
 235    END SUBROUTINE end_timing
 236
 237 END MODULE module_timing
 238