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 !
  16 !***
  17 !
  18
  19 module module_wrf_error
  20 implicit none
  21 contains
  22
  23 ! mock-up of various wrf utility functions
  24
  25 subroutine wrf_error_fatal(s)
  26 !*** purpose: abort with a message
  27 implicit none
  28 character(len=*), intent(in)::s
  29 call latch ! food for debugger so you can say "stop at latch" and not worry about module name
  30 write(6,*)s
  31 call abort()
  32 end subroutine wrf_error_fatal
  33
  34 !
  35 !***
  36 !
  37
  38 subroutine wrf_debug(level,s)
  39 !*** purpose: print a message
  40
  41 implicit none
  42 character(len=*), intent(in)::s
  43 integer, intent(in):: level
  44 write(6,*)s
  45 end subroutine wrf_debug
  46
  47 !
  48 !***
  49 !
  50
  51 subroutine wrf_message(s)
  52 character(len=*), intent(in)::s
  53 integer i
  54 do i=len(s),2,-1
  55     select case(s(i:i))
  56     case(' ')
  57     case default
  58         goto 1
  59     end select
  60 enddo
  61 1 write(6,'(a)')s(1:i)
  62 end subroutine wrf_message
  63
  64 end module module_wrf_error
  65
  66 !
  67 !***
  68 !
  69
  70 ! just for testing
  71 subroutine latch
  72 end
  73
  74 !
  75 !*** various stubs, mostly doing nothing
  76 !
  77
  78 module module_dm
  79 use module_wrf_error
  80 implicit none
  81 contains
  82 subroutine wrf_get_nproc (nprocs)
  83 integer nprocs
  84 nprocs=1
  85 end subroutine wrf_get_nproc
  86
  87 !
  88 !***
  89 !
  90
  91 subroutine wrf_get_myproc( myproc )
  92 integer myproc
  93 myproc=1
  94 end subroutine wrf_get_myproc
  95
  96 !
  97 !***
  98 !
  99
 100 subroutine wrf_dm_maxval_integer( val, idex, jdex )
 101 integer::val
 102 integer::idex,jdex
 103 call wrf_error_fatal('wrf_dm_maxval_integer:not implemented')
 104 end subroutine wrf_dm_maxval_integer
 105
 106 end module module_dm
 107
 108 !
 109 !*** external stubs
 110 !
 111
 112
 113 SUBROUTINE wrf_dm_bcast_real( BUF, N1 )
 114    IMPLICIT NONE
 115    INTEGER n1
 116    REAL  buf(*)
 117    RETURN
 118 END SUBROUTINE wrf_dm_bcast_real
 119
 120 !
 121 !***
 122 !
 123
 124 LOGICAL FUNCTION wrf_dm_on_monitor()
 125   wrf_dm_on_monitor = .true.
 126 END FUNCTION wrf_dm_on_monitor
 127
 128 !
 129 !***
 130 !
 131
 132 SUBROUTINE wrf_dm_bcast_integer( BUF, N1 )
 133    IMPLICIT NONE
 134    INTEGER n1
 135    INTEGER  buf(*)
 136    RETURN
 137 END SUBROUTINE wrf_dm_bcast_integer
 138
 139
 140 !WRF:DRIVER_LAYER:UTIL
 141 !
 142
 143 MODULE module_timing
 144    use module_wrf_error
 145
 146    INTEGER, PARAMETER, PRIVATE :: cnmax = 30
 147    INTEGER, PRIVATE, DIMENSION(cnmax) :: count_int1 , count_rate_int1 , count_max_int1
 148    INTEGER, PRIVATE, DIMENSION(cnmax) :: count_int2 , count_rate_int2 , count_max_int2
 149    INTEGER, PRIVATE :: cn = 0
 150    REAL, PRIVATE    :: elapsed_seconds , elapsed_seconds_total = 0
 151    REAL, PRIVATE    :: cpu_1 , cpu_2 , cpu_seconds , cpu_seconds_total = 0
 152    data cn /0/
 153
 154 CONTAINS
 155
 156    SUBROUTINE init_module_timing
 157       cn = 0
 158    END SUBROUTINE init_module_timing
 159
 160
 161    SUBROUTINE start_timing
 162
 163       IMPLICIT NONE
 164
 165       cn = cn + 1
 166       IF ( cn .gt. cnmax ) THEN
 167         CALL  wrf_error_fatal( 'module_timing: clock nesting error (too many nests)' )
 168         RETURN
 169       ENDIF
 170       CALL SYSTEM_CLOCK ( count_int1(cn) , count_rate_int1(cn) , count_max_int1(cn) )
 171 !     CALL CPU_TIME ( cpu_1 )
 172
 173    END SUBROUTINE start_timing
 174
 175
 176    SUBROUTINE end_timing ( string )
 177
 178       IMPLICIT NONE
 179
 180       CHARACTER *(*) :: string
 181
 182       IF ( cn .lt. 1 ) THEN
 183         CALL  wrf_error_fatal( 'module_timing: clock nesting error, cn<1' )
 184       ELSE IF ( cn .gt. cnmax ) THEN
 185         CALL  wrf_error_fatal( 'module_timing: clock nesting error, cn>cnmax' )
 186       ENDIF
 187
 188       CALL SYSTEM_CLOCK ( count_int2(cn) , count_rate_int2(cn) , count_max_int2(cn) )
 189 !     CALL CPU_TIME ( cpu_2 )
 190
 191       IF ( count_int2(cn) < count_int1(cn) ) THEN
 192          count_int2(cn) = count_int2(cn) + count_max_int2(cn)
 193       ENDIF
 194
 195       count_int2(cn) = count_int2(cn) - count_int1(cn)
 196       elapsed_seconds = REAL(count_int2(cn)) / REAL(count_rate_int2(cn))
 197       elapsed_seconds_total = elapsed_seconds_total + elapsed_seconds
 198
 199       WRITE(6,'(A,A,A,F10.5,A)') 'Timing for ',TRIM(string),': ',elapsed_seconds,' elapsed seconds.'
 200 #if defined(DM_PARALLEL) && ! defined(STUBMPI)
 201       WRITE(0,'(A,A,A,F10.5,A)') 'Timing for ',TRIM(string),': ',elapsed_seconds,' elapsed seconds.'
 202 #endif
 203
 204 !     cpu_seconds = cpu_2 - cpu_1
 205 !     cpu_seconds_total = cpu_seconds_total + cpu_seconds
 206 !     PRINT '(A,A,A,F10.5,A)' ,'Timing for ',TRIM(string),': ',cpu_seconds,' cpu seconds.'
 207
 208       cn = cn - 1
 209
 210    END SUBROUTINE end_timing
 211
 212 END MODULE module_timing
 213