PageRenderTime 53ms CodeModel.GetById 15ms RepoModel.GetById 1ms app.codeStats 0ms

/wrfv2_fire/main/wrf_SST_ESMF.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 1967 lines | 926 code | 214 blank | 827 comment | 3 complexity | 922ed801948ecd1aebca9fa5803ec498 MD5 | raw file
Possible License(s): AGPL-1.0

Large files files are truncated, but you can click here to view the full file

  1. !WRF:DRIVER_LAYER:MAIN
  2. !
  3. !<DESCRIPTION>
  4. ! ESMF Application Wrapper for coupling WRF with a "dummy" component
  5. ! that simply reads SSTs from a file, sends to WRF, receives SST from
  6. ! WRF (two-way coupling). and checks that the SSTs match.
  7. !
  8. ! This file contains the main program and associated modules for the
  9. ! SST "dummy" component and a simple coupler. It creates ESMF Gridded
  10. ! and Coupler Components.
  11. !
  12. ! This source file is only built when ESMF coupling is used.
  13. !
  14. !</DESCRIPTION>
  15. !<DESCRIPTION>
  16. ! Modules module_sst_component_top and module_sst_setservices define the
  17. ! "SST" dummy component.
  18. !</DESCRIPTION>
  19. MODULE module_sst_component_top
  20. !<DESCRIPTION>
  21. ! This module defines sst_component_init1(), sst_component_init2(),
  22. ! sst_component_run1(), sst_component_run2(), and sst_component_finalize()
  23. ! routines that are called when SST is run as an ESMF component.
  24. !</DESCRIPTION>
  25. ! Updated for ESMF 5.2.0r -- see:
  26. ! http://www.earthsystemmodeling.org/esmf_releases/public/ESMF_5_2_0r/InterfaceChanges520to520r.pdf
  27. ! USE ESMF_Mod
  28. USE ESMF
  29. USE module_esmf_extensions
  30. USE module_metadatautils, ONLY: AttachTimesToState
  31. IMPLICIT NONE
  32. ! everything is private by default
  33. PRIVATE
  34. ! Public entry points
  35. PUBLIC sst_component_init1
  36. PUBLIC sst_component_init2
  37. PUBLIC sst_component_run1
  38. PUBLIC sst_component_run2
  39. PUBLIC sst_component_finalize
  40. ! private stuff
  41. TYPE(ESMF_Grid), SAVE :: esmfgrid ! grid used in fields
  42. CHARACTER (4096) :: str
  43. INTEGER, SAVE :: fid ! file handle
  44. ! decomposition information
  45. INTEGER, SAVE :: ids, ide, jds, jde, kds, kde
  46. INTEGER, SAVE :: ims, ime, jms, jme, kms, kme
  47. INTEGER, SAVE :: ips, ipe, jps, jpe, kps, kpe
  48. REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_out_sst(:,:)
  49. REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_out_landmask(:,:)
  50. REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_in_sst(:,:)
  51. REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_in_landmask(:,:)
  52. INTEGER, SAVE :: domdesc
  53. LOGICAL, SAVE :: bdy_mask(4)
  54. ! MPI communicator, if needed
  55. INTEGER, SAVE :: mpicom
  56. ! field data
  57. REAL, POINTER, SAVE :: file_landmask_data(:,:), file_sst_data(:,:)
  58. ! input data file name
  59. CHARACTER ( ESMF_MAXSTR ), SAVE :: sstinfilename
  60. ! field names
  61. INTEGER, PARAMETER :: datacount = 2
  62. INTEGER, PARAMETER :: SST_INDX = 1
  63. INTEGER, PARAMETER :: LANDMASK_INDX = 2
  64. CHARACTER(LEN=ESMF_MAXSTR), SAVE :: datanames(datacount)
  65. TYPE real2d
  66. REAL, POINTER :: r2d(:,:)
  67. END TYPE real2d
  68. TYPE(real2d) :: this_data(datacount)
  69. CONTAINS
  70. ! First-phase "init" reads "SST" data file and returns "time" metadata in
  71. ! exportState.
  72. SUBROUTINE sst_component_init1( gcomp, importState, exportState, clock, rc )
  73. USE module_io
  74. TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
  75. TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState
  76. TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState
  77. TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
  78. INTEGER, INTENT( OUT) :: rc
  79. !<DESCRIPTION>
  80. ! SST component init routine, phase 1.
  81. !
  82. ! The arguments are:
  83. ! gcomp Component
  84. ! importState Importstate
  85. ! exportState Exportstate
  86. ! clock External clock
  87. ! rc Return code; equals ESMF_SUCCESS if there are no errors,
  88. ! otherwise ESMF_FAILURE.
  89. !</DESCRIPTION>
  90. #ifdef DM_PARALLEL
  91. INCLUDE 'mpif.h'
  92. #endif
  93. ! Local variables
  94. CHARACTER (LEN=19) :: date_string
  95. #ifdef DM_PARALLEL
  96. TYPE(ESMF_VM) :: vm
  97. INTEGER :: mpicomtmp
  98. #endif
  99. TYPE(ESMF_Time) :: startTime, stopTime, currentTime, dataTime
  100. TYPE(ESMF_TimeInterval) :: timeStep
  101. INTEGER :: ierr, num_steps, time_loop_max
  102. INTEGER :: status_next_var
  103. !TODO: For now, sstinfilename is hard-coded
  104. !TODO: Upgrade to use a variant of construct_filename() via startTime
  105. !TODO: extracted from clock.
  106. sstinfilename = 'sstin_d01_000000'
  107. ! get MPI communicator out of current VM and duplicate (if needed)
  108. #ifdef DM_PARALLEL
  109. CALL ESMF_VMGetCurrent(vm, rc=rc)
  110. IF ( rc /= ESMF_SUCCESS ) THEN
  111. CALL wrf_error_fatal ( 'sst_component_init1: ESMF_VMGetCurrent failed' )
  112. ENDIF
  113. CALL ESMF_VMGet(vm, mpiCommunicator=mpicomtmp, rc=rc)
  114. IF ( rc /= ESMF_SUCCESS ) THEN
  115. CALL wrf_error_fatal ( 'sst_component_init1: ESMF_VMGet failed' )
  116. ENDIF
  117. CALL MPI_Comm_dup( mpicomtmp, mpicom, ierr )
  118. #else
  119. mpicom = 0
  120. #endif
  121. ! Open the "SST" input data file for reading.
  122. write(str,'(A,A)') 'Subroutine sst_component_init1: Opening data file ', &
  123. TRIM(sstinfilename)
  124. CALL wrf_message ( TRIM(str) )
  125. CALL wrf_open_for_read ( TRIM(sstinfilename) , &
  126. mpicom , &
  127. mpicom , &
  128. "DATASET=INPUT" , &
  129. fid , &
  130. ierr )
  131. IF ( ierr .NE. 0 ) THEN
  132. WRITE( str , FMT='(A,A,A,I8)' ) &
  133. 'subroutine sst_component_init1: error opening ', &
  134. TRIM(sstinfilename),' for reading ierr=',ierr
  135. CALL wrf_error_fatal ( TRIM(str) )
  136. ENDIF
  137. WRITE( str , FMT='(A,A,A,I8)' ) &
  138. 'subroutine sst_component_init1: opened file ', &
  139. TRIM(sstinfilename),' for reading fid=',fid
  140. CALL wrf_debug ( 100, TRIM(str) )
  141. ! How many data time levels are in the SST input file?
  142. num_steps = -1
  143. time_loop_max = 0
  144. CALL wrf_debug ( 100, 'subroutine sst_component_init1: find time_loop_max' )
  145. ! compute SST start time, time step, and end time here
  146. get_the_right_time : DO
  147. CALL wrf_get_next_time ( fid, date_string, status_next_var )
  148. write(str,'(A,A)') 'Subroutine sst_component_init1: SST data startTime: ', &
  149. date_string
  150. CALL wrf_debug ( 100 , TRIM(str) )
  151. IF ( status_next_var == 0 ) THEN
  152. IF ( time_loop_max == 0 ) THEN
  153. CALL wrf_atotime( date_string, startTime )
  154. ELSEIF ( time_loop_max == 1 ) THEN
  155. ! assumes fixed time step!
  156. CALL wrf_atotime( date_string, dataTime )
  157. timeStep = dataTime - startTime
  158. ENDIF
  159. time_loop_max = time_loop_max + 1
  160. CALL wrf_atotime( date_string, stopTime )
  161. ELSE
  162. EXIT get_the_right_time
  163. ENDIF
  164. END DO get_the_right_time
  165. CALL wrf_timetoa ( stopTime, date_string )
  166. write(str,'(A,A)') 'Subroutine sst_component_init1: SST data stopTime: ', &
  167. date_string
  168. CALL wrf_debug ( 100 , TRIM(str) )
  169. ! attach times to exportState for use by driver
  170. CALL AttachTimesToState( exportState, startTime, stopTime, timeStep )
  171. ! There should be a more elegant way to get to the beginning of the
  172. ! file, but this will do.
  173. CALL wrf_ioclose( fid , ierr )
  174. IF ( ierr .NE. 0 ) THEN
  175. CALL wrf_error_fatal ( 'sst_component_init1: wrf_ioclose failed' )
  176. ENDIF
  177. WRITE( str , FMT='(A,I8)' ) &
  178. 'subroutine sst_component_init1: closed file fid=',fid
  179. CALL wrf_debug ( 100, TRIM(str) )
  180. ! set up field names
  181. !TODO: use CF conventions for "standard_name" once WRF Registry supports them
  182. !TODO: datanames(SST_INDX) = "sea_surface_temperature"
  183. !TODO: datanames(LANDMASK_INDX) = "land_binary_mask"
  184. datanames(SST_INDX) = "SST"
  185. datanames(LANDMASK_INDX) = "LANDMASK"
  186. rc = ESMF_SUCCESS
  187. END SUBROUTINE sst_component_init1
  188. SUBROUTINE read_data( exportState, clock )
  189. USE module_io
  190. TYPE(ESMF_State), INTENT(INOUT) :: exportState
  191. TYPE(ESMF_Clock), INTENT(IN ) :: clock
  192. !<DESCRIPTION>
  193. ! Reads data from file and stores. Then
  194. ! stuffs the file data into the SST exportState.
  195. !</DESCRIPTION>
  196. #include <wrf_status_codes.h>
  197. #include <wrf_io_flags.h>
  198. ! Local variables
  199. CHARACTER (LEN=19) :: date_string
  200. TYPE(ESMF_Time) :: currentTime, dataTime
  201. REAL(ESMF_KIND_R4), POINTER :: out_sst_ptr(:,:), out_landmask_ptr(:,:)
  202. TYPE(ESMF_Field) :: out_sst_field, out_landmask_field
  203. TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
  204. INTEGER :: i, j
  205. CHARACTER(LEN=ESMF_MAXSTR) :: fieldname, debugmsg, errormsg, timestr
  206. INTEGER :: ierr
  207. INTEGER :: rc
  208. ! This call to wrf_get_next_time will position the dataset over the next
  209. ! time-frame in the file and return the date_string, which is used as an
  210. ! argument to the read_field routines in the blocks of code included
  211. ! below.
  212. CALL wrf_get_next_time( fid, date_string , ierr )
  213. WRITE(str,'(A,A)') 'Subroutine read_data: SST data time: ', &
  214. date_string
  215. CALL wrf_debug ( 100 , TRIM(str) )
  216. IF ( ierr .NE. 0 .AND. ierr .NE. WRF_WARN_NOTSUPPORTED .AND. &
  217. ierr .NE. WRF_WARN_DRYRUN_READ ) THEN
  218. CALL wrf_error_fatal ( "... May have run out of valid SST data ..." )
  219. ELSE IF ( ierr .NE. WRF_WARN_NOTSUPPORTED .AND. &
  220. ierr .NE. WRF_WARN_DRYRUN_READ) THEN
  221. ! check input time against current time (which will be start time at
  222. ! beginning)
  223. CALL wrf_atotime( date_string, dataTime )
  224. CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc )
  225. IF (rc /= ESMF_SUCCESS) THEN
  226. CALL wrf_error_fatal ( 'read_data: ESMF_ClockGet() failed' )
  227. ENDIF
  228. CALL wrf_clockprint(150, clock, &
  229. 'DEBUG read_data(): get currentTime from clock,')
  230. IF ( dataTime .NE. currentTime ) THEN
  231. CALL wrf_timetoa ( dataTime, timestr )
  232. WRITE( errormsg , * )'Time in file: ',trim( timestr )
  233. CALL wrf_message ( trim(errormsg) )
  234. CALL wrf_timetoa ( currentTime, timestr )
  235. WRITE( errormsg , * )'Time on domain: ',trim( timestr )
  236. CALL wrf_message ( trim(errormsg) )
  237. CALL wrf_error_fatal( &
  238. "**ERROR** Time in input file not equal to time on domain **ERROR**" )
  239. ENDIF
  240. ENDIF
  241. ! doing this in a loop only works if staggering is the same for all fields
  242. this_data(SST_INDX)%r2d => file_sst_data
  243. this_data(LANDMASK_INDX)%r2d => file_landmask_data
  244. DO i=1, datacount
  245. fieldname = TRIM(datanames(i))
  246. debugmsg = 'ext_read_field '//TRIM(fieldname)//' memorder XY'
  247. errormsg = 'could not read '//TRIM(fieldname)//' data from file'
  248. CALL wrf_ext_read_field ( &
  249. fid , & ! DataHandle
  250. date_string , & ! DateStr
  251. TRIM(fieldname) , & ! Data Name
  252. this_data(i)%r2d , & ! Field
  253. WRF_REAL , & ! FieldType
  254. mpicom , & ! Comm
  255. mpicom , & ! I/O Comm
  256. domdesc , & ! Domain descriptor
  257. bdy_mask , & ! bdy_mask
  258. 'XY' , & ! MemoryOrder
  259. '' , & ! Stagger
  260. TRIM(debugmsg) , & ! Debug message
  261. #if 1
  262. ids , (ide-1) , jds , (jde-1) , 1 , 1 , &
  263. ims , ime , jms , jme , 1 , 1 , &
  264. ips , MIN( (ide-1), ipe ) , jps , MIN( (jde-1), jpe ) , 1 , 1 , &
  265. #else
  266. !jm the dimensions have already been reduced to the non-staggered WRF grid when
  267. ! they were stored in this module.. Just use as is.
  268. ids , ide , jds , jde , 1 , 1 , &
  269. ims , ime , jms , jme , 1 , 1 , &
  270. ips , ipe , jps , jpe , 1 , 1 , &
  271. #endif
  272. ierr )
  273. IF (ierr /= 0) THEN
  274. CALL wrf_error_fatal ( TRIM(errormsg) )
  275. ENDIF
  276. ENDDO
  277. ! stuff fields into exportState
  278. !TODO: change this to Bundles, eventually
  279. CALL ESMF_StateGet( exportState, TRIM(datanames(SST_INDX)), &
  280. out_sst_field, rc=rc )
  281. IF (rc /= ESMF_SUCCESS) THEN
  282. CALL wrf_error_fatal ( &
  283. 'could not find sea_surface_temperature field in exportState' )
  284. ENDIF
  285. CALL ESMF_StateGet( exportState, TRIM(datanames(LANDMASK_INDX)), &
  286. out_landmask_field, rc=rc )
  287. IF (rc /= ESMF_SUCCESS) THEN
  288. CALL wrf_error_fatal ( &
  289. 'could not find land_binary_mask field in exportState' )
  290. ENDIF
  291. ! CALL ESMF_FieldGetDataPointer( out_sst_field, out_sst_ptr, rc=rc )
  292. CALL ESMF_FieldGet( out_sst_field, 0, out_sst_ptr, rc=rc )
  293. IF (rc /= ESMF_SUCCESS) THEN
  294. CALL wrf_error_fatal ( &
  295. 'could not find sea_surface_temperature data in sea_surface_temperature field' )
  296. ENDIF
  297. ! CALL ESMF_FieldGetDataPointer( out_landmask_field, out_landmask_ptr, rc=rc )
  298. CALL ESMF_FieldGet( out_landmask_field, 0, out_landmask_ptr, rc=rc )
  299. IF (rc /= ESMF_SUCCESS) THEN
  300. CALL wrf_error_fatal ( &
  301. 'could not find land_binary_mask data in land_binary_mask field' )
  302. ENDIF
  303. ! staggered starts/ends
  304. DO j= jps , jpe
  305. DO i= ips , ipe
  306. out_sst_ptr(i,j) = file_sst_data(i,j)
  307. out_landmask_ptr(i,j) = file_landmask_data(i,j)
  308. ENDDO
  309. ENDDO
  310. END SUBROUTINE read_data
  311. SUBROUTINE compare_data( importState, clock )
  312. TYPE(ESMF_State), INTENT(INOUT) :: importState
  313. !TODO: remove clock after debugging is finished
  314. TYPE(ESMF_Clock), INTENT(INOUT) :: clock
  315. !<DESCRIPTION>
  316. ! Gets data from coupler via importState
  317. ! and compares with data read from file and
  318. ! error-exits if they differ.
  319. !
  320. ! The arguments are:
  321. ! importState Importstate
  322. !</DESCRIPTION>
  323. ! Local variables
  324. TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
  325. REAL(ESMF_KIND_R4), POINTER :: in_sst_ptr(:,:), in_landmask_ptr(:,:)
  326. REAL, POINTER :: in_sst_ptr_real(:,:), in_landmask_ptr_real(:,:)
  327. INTEGER :: i, j
  328. INTEGER :: rc
  329. LOGICAL :: landmask_ok, sst_ok
  330. ! use these for debug prints
  331. TYPE(ESMF_Time) :: currentTime
  332. INTEGER, SAVE :: numtimes=0 ! track number of calls
  333. CHARACTER(LEN=256) :: timestamp
  334. ! count calls for debug prints...
  335. CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc )
  336. IF (rc /= ESMF_SUCCESS) THEN
  337. CALL wrf_error_fatal ( 'compare_data: ESMF_ClockGet() failed' )
  338. ENDIF
  339. CALL wrf_timetoa ( currentTime, timestamp )
  340. numtimes = numtimes + 1
  341. WRITE(str,*) 'SST compare_data: begin, numtimes = ',numtimes,' time = ',TRIM(timestamp)
  342. CALL wrf_debug ( 100 , TRIM(str) )
  343. ! extract data from the importState and compare with data from file
  344. !TODO: change this to Bundles, eventually
  345. CALL ESMF_StateGet( importState, TRIM(datanames(SST_INDX)), &
  346. in_sst_field, rc=rc )
  347. IF (rc /= ESMF_SUCCESS) THEN
  348. CALL wrf_error_fatal ( &
  349. 'could not extract sea_surface_temperature field from importState' )
  350. ENDIF
  351. CALL ESMF_StateGet( importState, TRIM(datanames(LANDMASK_INDX)), &
  352. in_landmask_field, rc=rc )
  353. IF (rc /= ESMF_SUCCESS) THEN
  354. CALL wrf_error_fatal ( &
  355. 'could not extract land_binary_mask field from importState' )
  356. ENDIF
  357. ! CALL ESMF_FieldGetDataPointer( in_sst_field, in_sst_ptr, rc=rc )
  358. CALL ESMF_FieldGet( in_sst_field, 0, in_sst_ptr, rc=rc )
  359. IF (rc /= ESMF_SUCCESS) THEN
  360. CALL wrf_error_fatal ( &
  361. 'could not extract sea_surface_temperature data from sea_surface_temperature field' )
  362. ENDIF
  363. ALLOCATE( in_sst_ptr_real(ims:ime,jms:jme) )
  364. WRITE( str,* ) 'compare_data, ips:ipe,jps:jpe = ', &
  365. ips,':',ipe,',',jps,':',jpe, &
  366. ', in_sst_ptr(BOUNDS) = ', &
  367. LBOUND(in_sst_ptr,1),':',UBOUND(in_sst_ptr,1),',', &
  368. LBOUND(in_sst_ptr,2),':',UBOUND(in_sst_ptr,2)
  369. CALL wrf_debug ( 100 , TRIM(str) )
  370. DO j= jms, jme
  371. DO i= ims, ime
  372. in_sst_ptr_real(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
  373. ENDDO
  374. ENDDO
  375. in_sst_ptr_real(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) = &
  376. in_sst_ptr(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe))
  377. ! CALL ESMF_FieldGetDataPointer( in_landmask_field, in_landmask_ptr, rc=rc )
  378. CALL ESMF_FieldGet( in_landmask_field, 0, in_landmask_ptr, rc=rc )
  379. IF (rc /= ESMF_SUCCESS) THEN
  380. CALL wrf_error_fatal ( &
  381. 'could not extract land_binary_mask data from land_binary_mask field' )
  382. ENDIF
  383. ALLOCATE( in_landmask_ptr_real(ims:ime,jms:jme) )
  384. WRITE( str,* ) 'compare_data, ips:ipe,jps:jpe = ', &
  385. ips,':',ipe,',',jps,':',jpe, &
  386. ', in_landmask_ptr(BOUNDS) = ', &
  387. LBOUND(in_landmask_ptr,1),':',UBOUND(in_landmask_ptr,1),',', &
  388. LBOUND(in_landmask_ptr,2),':',UBOUND(in_landmask_ptr,2)
  389. CALL wrf_debug ( 100 , TRIM(str) )
  390. DO j= jms, jme
  391. DO i= ims, ime
  392. in_landmask_ptr_real(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
  393. ENDDO
  394. ENDDO
  395. in_landmask_ptr_real(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) = &
  396. in_landmask_ptr(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe))
  397. ! compare LANDMASK...
  398. landmask_ok = .TRUE.
  399. ! staggered starts/ends
  400. LANDMASK_COMPARE : DO j= jps , MIN( (jde-1), jpe )
  401. DO i= ips , MIN( (ide-1), ipe )
  402. IF ( file_landmask_data(i,j) /= in_landmask_ptr_real(i,j) ) THEN
  403. landmask_ok = .FALSE.
  404. WRITE( str , * ) 'error landmask mismatch at (i,j) = (',i,',',j, &
  405. '), values are',file_landmask_data(i,j),' and ', &
  406. in_landmask_ptr_real(i,j)
  407. EXIT LANDMASK_COMPARE
  408. ENDIF
  409. ENDDO
  410. ENDDO LANDMASK_COMPARE
  411. IF ( landmask_ok ) THEN
  412. WRITE(str,*) 'TESTING data returned from WRF through ESMF: LANDMASK compares OK'
  413. CALL wrf_debug ( 0 , TRIM(str) )
  414. ELSE
  415. CALL wrf_error_fatal ( TRIM(str) )
  416. ENDIF
  417. ! compare SST...
  418. sst_ok = .TRUE.
  419. ! staggered starts/ends
  420. SST_COMPARE : DO j= jps , MIN( (jde-1), jpe )
  421. DO i= ips , MIN( (ide-1), ipe )
  422. IF ( file_sst_data(i,j) /= in_sst_ptr_real(i,j) ) THEN
  423. sst_ok = .FALSE.
  424. WRITE( str , * ) 'error sst mismatch at (i,j) = (',i,',',j, &
  425. '), values are',file_sst_data(i,j),' and ', &
  426. in_sst_ptr_real(i,j)
  427. EXIT SST_COMPARE
  428. ENDIF
  429. ENDDO
  430. ENDDO SST_COMPARE
  431. IF ( sst_ok ) THEN
  432. WRITE(str,*) 'TESTING data returned from WRF through ESMF: SST compares OK'
  433. CALL wrf_debug ( 0 , TRIM(str) )
  434. ELSE
  435. CALL wrf_error_fatal ( TRIM(str) )
  436. ENDIF
  437. DEALLOCATE( in_sst_ptr_real, in_landmask_ptr_real )
  438. WRITE(str,*) 'compare_data: end, numtimes = ',numtimes
  439. CALL wrf_debug ( 100 , TRIM(str) )
  440. END SUBROUTINE compare_data
  441. ! Second-phase "init" gets decomposition information from
  442. ! importState.
  443. SUBROUTINE sst_component_init2( gcomp, importState, exportState, clock, rc )
  444. USE module_metadatautils, ONLY: GetDecompFromState
  445. USE module_io
  446. TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
  447. TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState
  448. TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState
  449. TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
  450. INTEGER, INTENT( OUT) :: rc
  451. !<DESCRIPTION>
  452. ! SST component init routine, phase 2.
  453. !
  454. ! The arguments are:
  455. ! gcomp Component
  456. ! importState Importstate
  457. ! exportState Exportstate
  458. ! clock External clock
  459. ! rc Return code; equals ESMF_SUCCESS if there are no errors,
  460. ! otherwise ESMF_FAILURE.
  461. !</DESCRIPTION>
  462. ! Local variables
  463. TYPE(ESMF_Field) :: out_sst_field, out_landmask_field
  464. TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
  465. INTEGER, PARAMETER :: NUMDIMS=2
  466. INTEGER :: DomainStart(NUMDIMS)
  467. INTEGER :: DomainEnd(NUMDIMS)
  468. INTEGER :: MemoryStart(NUMDIMS)
  469. INTEGER :: MemoryEnd(NUMDIMS)
  470. INTEGER :: PatchStart(NUMDIMS)
  471. INTEGER :: PatchEnd(NUMDIMS)
  472. INTEGER :: rc, i, j
  473. INTEGER :: ierr
  474. ! Get decomposition information from importState. Note that index
  475. ! values are for staggered dimensions, following the WRF convention.
  476. !TODO: Note that this will only work for SPMD serial operation. For
  477. !TODO: concurrent operation (SPMD or MPMD), we will need to create a new
  478. !TODO: "domdesc" suitable for the task layout of the SST component. For
  479. !TODO: MPMD serial operation, we will need to extract serialized domdesc
  480. !TODO: from export state metadata and de-serialize it. Similar arguments
  481. !TODO: apply to [ij][mp][se] and bdy_mask.
  482. write(str,*) 'sst_component_init2: calling GetDecompFromState'
  483. CALL wrf_debug ( 100 , TRIM(str) )
  484. CALL GetDecompFromState( importState, &
  485. ids, ide, jds, jde, kds, kde, &
  486. ims, ime, jms, jme, kms, kme, &
  487. ips, ipe, jps, jpe, kps, kpe, &
  488. domdesc, bdy_mask )
  489. write(str,*) 'sst_component_init2: back from GetDecompFromState'
  490. CALL wrf_debug ( 100 , TRIM(str) )
  491. write(str,*) 'sst_component_init2: ids, ide, jds, jde, kds, kde = ', ids, ide, jds, jde, kds, kde
  492. CALL wrf_debug ( 100 , TRIM(str) )
  493. write(str,*) 'sst_component_init2: ims, ime, jms, jme, kms, kme = ', ims, ime, jms, jme, kms, kme
  494. CALL wrf_debug ( 100 , TRIM(str) )
  495. write(str,*) 'sst_component_init2: ips, ipe, jps, jpe, kps, kpe = ', ips, ipe, jps, jpe, kps, kpe
  496. CALL wrf_debug ( 100 , TRIM(str) )
  497. ! allocate space for data read from disk
  498. ALLOCATE( file_sst_data (ims:ime,jms:jme) )
  499. DO j= jms, jme
  500. DO i= ims, ime
  501. file_sst_data(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
  502. ENDDO
  503. ENDDO
  504. !TODO: Hmmm... really need to load these pointers here? Check...
  505. this_data(SST_INDX)%r2d => file_sst_data
  506. ALLOCATE( file_landmask_data(ims:ime,jms:jme) )
  507. DO j= jms, jme
  508. DO i= ims, ime
  509. file_landmask_data(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
  510. ENDDO
  511. ENDDO
  512. this_data(LANDMASK_INDX)%r2d => file_landmask_data
  513. ! Create ESMF_Fields in importState and exportState
  514. ! Create ESMF_Grid. Use exactly the same method as WRF so WRFIO will
  515. ! work.
  516. DomainStart(1) = ids; DomainEnd(1) = ide;
  517. DomainStart(2) = jds; DomainEnd(2) = jde;
  518. MemoryStart(1) = ims; MemoryEnd(1) = ime;
  519. MemoryStart(2) = jms; MemoryEnd(2) = jme;
  520. PatchStart(1) = ips; PatchEnd(1) = ipe;
  521. PatchStart(2) = jps; PatchEnd(2) = jpe
  522. !write(0,*)__FILE__,__LINE__,'DomainStart ',DomainStart(1:2)
  523. !write(0,*)__FILE__,__LINE__,'DomainEnd ',DomainEnd(1:2)
  524. !write(0,*)__FILE__,__LINE__,'MemoryStart ',MemoryStart(1:2)
  525. !write(0,*)__FILE__,__LINE__,'MemoryEnd ',MemoryEnd(1:2)
  526. !write(0,*)__FILE__,__LINE__,'PatchStart ',PatchStart(1:2)
  527. !write(0,*)__FILE__,__LINE__,'PatchEnd ',PatchEnd(1:2)
  528. CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: Calling ioesmf_create_grid_int()' )
  529. CALL ioesmf_create_grid_int( esmfgrid, NUMDIMS, &
  530. DomainStart, DomainEnd, &
  531. MemoryStart, MemoryEnd, &
  532. PatchStart, PatchEnd )
  533. !write(0,*)__FILE__,__LINE__
  534. CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: back from ioesmf_create_grid_int()' )
  535. ! create ESMF_Fields
  536. ! Note use of patch dimension for POINTERs allocated by ESMF.
  537. CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: Calling ESMF_GridValidate(esmfgrid)' )
  538. CALL ESMF_GridValidate( esmfgrid, rc=rc )
  539. !write(0,*)__FILE__,__LINE__
  540. IF ( rc /= ESMF_SUCCESS ) THEN
  541. WRITE( str,* ) 'Error in ESMF_GridValidate ', &
  542. __FILE__ , &
  543. ', line ', &
  544. __LINE__ , &
  545. ', error code = ',rc
  546. CALL wrf_error_fatal ( TRIM(str) )
  547. ENDIF
  548. CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: back OK from ESMF_GridValidate(esmfgrid)' )
  549. !TODO: Once new ESMF 3.0 interfaces have settled down, eliminate "tmp_data_"
  550. !TODO: arrays and let ESMF allocate/deallocate them. Assuming of course that
  551. !TODO: we can convince ESMF to deallocate safely...
  552. !write(0,*)__FILE__,__LINE__
  553. ALLOCATE( tmp_data_out_sst(ips:ipe,jps:jpe) )
  554. !write(0,*)__FILE__,__LINE__
  555. write(str,*) 'sst_component_init2: tmp_data_out_sst(', &
  556. LBOUND(tmp_data_out_sst,1),':',UBOUND(tmp_data_out_sst,1),',',LBOUND(tmp_data_out_sst,2),':',UBOUND(tmp_data_out_sst,2),')'
  557. CALL wrf_debug ( 100 , TRIM(str) )
  558. CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(out_sst_field)' )
  559. !write(0,*)__FILE__,__LINE__,trim(datanames(sst_indx))
  560. !write(0,*)__FILE__,__LINE__,ips,jps,ipe,jpe
  561. out_sst_field = ESMF_FieldCreate( &
  562. esmfgrid, tmp_data_out_sst, &
  563. datacopyflag=ESMF_DATACOPY_REFERENCE, &
  564. staggerloc=ESMF_STAGGERLOC_CENTER, &
  565. name=TRIM(datanames(SST_INDX)), &
  566. rc=rc )
  567. !write(0,*)__FILE__,__LINE__,'Creating out_sst_field for exportState of SST component name ',TRIM(datanames(SST_INDX))
  568. IF ( rc /= ESMF_SUCCESS ) THEN
  569. WRITE( str,* ) 'ESMF_FieldCreate(out_sst_field) failed ', &
  570. __FILE__ , &
  571. ', line ', &
  572. __LINE__ , &
  573. ', error code = ',rc
  574. CALL wrf_error_fatal ( TRIM(str) )
  575. ENDIF
  576. CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(out_sst_field)' )
  577. write(str,*) 'sst_component_init2: ips:ipe,jps:jpe = ', &
  578. ips,':',ipe,',',jps,':',jpe
  579. CALL wrf_debug ( 100 , TRIM(str) )
  580. !TODO: This bit will be useful once ESMF handles allocation/deallocation.
  581. ! validate ESMF allocation
  582. IF ( ( ips /= LBOUND(tmp_data_out_sst,1) ) .OR. ( ipe /= UBOUND(tmp_data_out_sst,1) ) .OR. &
  583. ( jps /= LBOUND(tmp_data_out_sst,2) ) .OR. ( jpe /= UBOUND(tmp_data_out_sst,2) ) ) THEN
  584. WRITE( str,* ) 'ESMF_FieldCreate(out_sst_field) allocation failed ', &
  585. __FILE__ , &
  586. ', line ', &
  587. __LINE__ , &
  588. ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
  589. ', tmp_data_out_sst(BOUNDS) = ',LBOUND(tmp_data_out_sst,1),':',UBOUND(tmp_data_out_sst,1),',', &
  590. LBOUND(tmp_data_out_sst,2),':',UBOUND(tmp_data_out_sst,2)
  591. CALL wrf_error_fatal ( TRIM(str) )
  592. ENDIF
  593. ALLOCATE( tmp_data_out_landmask(ips:ipe,jps:jpe) )
  594. write(str,*) 'sst_component_init2: tmp_data_out_landmask(', &
  595. LBOUND(tmp_data_out_landmask,1),':',UBOUND(tmp_data_out_landmask,1),',',LBOUND(tmp_data_out_landmask,2),':',UBOUND(tmp_data_out_landmask,2),')'
  596. CALL wrf_debug ( 100 , TRIM(str) )
  597. CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(out_landmask_field)' )
  598. out_landmask_field = ESMF_FieldCreate( &
  599. esmfgrid, tmp_data_out_landmask, &
  600. datacopyflag=ESMF_DATACOPY_REFERENCE, &
  601. staggerloc=ESMF_STAGGERLOC_CENTER, &
  602. name=TRIM(datanames(LANDMASK_INDX)), &
  603. ! lbounds=(/ips,jps/), &
  604. ! ubounds=(/ipe,jpe/), &
  605. rc=rc )
  606. IF ( rc /= ESMF_SUCCESS ) THEN
  607. CALL wrf_error_fatal ( 'ESMF_FieldCreate(out_landmask_field) failed' )
  608. ENDIF
  609. CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(out_landmask_field)' )
  610. !TODO: This bit will be useful once ESMF handles allocation/deallocation.
  611. ! validate ESMF allocation
  612. IF ( ( ips /= LBOUND(tmp_data_out_landmask,1) ) .OR. ( ipe /= UBOUND(tmp_data_out_landmask,1) ) .OR. &
  613. ( jps /= LBOUND(tmp_data_out_landmask,2) ) .OR. ( jpe /= UBOUND(tmp_data_out_landmask,2) ) ) THEN
  614. WRITE( str,* ) 'ESMF_FieldCreate(out_landmask_field) allocation failed ', &
  615. __FILE__ , &
  616. ', line ', &
  617. __LINE__ , &
  618. ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
  619. ', tmp_data_out_landmask(BOUNDS) = ',LBOUND(tmp_data_out_landmask,1),':',UBOUND(tmp_data_out_landmask,1),',', &
  620. LBOUND(tmp_data_out_landmask,2),':',UBOUND(tmp_data_out_landmask,2)
  621. CALL wrf_error_fatal ( TRIM(str) )
  622. ENDIF
  623. ALLOCATE( tmp_data_in_sst(ips:ipe,jps:jpe) )
  624. write(str,*) 'sst_component_init2: tmp_data_in_sst(', &
  625. LBOUND(tmp_data_in_sst,1),':',UBOUND(tmp_data_in_sst,1),',',LBOUND(tmp_data_in_sst,2),':',UBOUND(tmp_data_in_sst,2),')'
  626. CALL wrf_debug ( 100 , TRIM(str) )
  627. CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(in_sst_field)' )
  628. in_sst_field = ESMF_FieldCreate( &
  629. esmfgrid, tmp_data_in_sst, &
  630. datacopyflag=ESMF_DATACOPY_REFERENCE, &
  631. staggerloc=ESMF_STAGGERLOC_CENTER, &
  632. name=TRIM(datanames(SST_INDX)), &
  633. ! lbounds=(/ips,jps/), &
  634. ! ubounds=(/ipe,jpe/), &
  635. rc=rc )
  636. IF ( rc /= ESMF_SUCCESS ) THEN
  637. CALL wrf_error_fatal ( 'ESMF_FieldCreate(in_sst_field) failed' )
  638. ENDIF
  639. CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(in_sst_field)' )
  640. !TODO: This bit will be useful once ESMF handles allocation/deallocation.
  641. ! validate ESMF allocation
  642. IF ( ( ips /= LBOUND(tmp_data_in_sst,1) ) .OR. ( ipe /= UBOUND(tmp_data_in_sst,1) ) .OR. &
  643. ( jps /= LBOUND(tmp_data_in_sst,2) ) .OR. ( jpe /= UBOUND(tmp_data_in_sst,2) ) ) THEN
  644. WRITE( str,* ) 'ESMF_FieldCreate(in_sst_field) allocation failed ', &
  645. __FILE__ , &
  646. ', line ', &
  647. __LINE__ , &
  648. ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
  649. ', tmp_data_in_sst(BOUNDS) = ',LBOUND(tmp_data_in_sst,1),':',UBOUND(tmp_data_in_sst,1),',', &
  650. LBOUND(tmp_data_in_sst,2),':',UBOUND(tmp_data_in_sst,2)
  651. CALL wrf_error_fatal ( TRIM(str) )
  652. ENDIF
  653. ALLOCATE( tmp_data_in_landmask(ips:ipe,jps:jpe) )
  654. write(str,*) 'sst_component_init2: tmp_data_in_landmask(', &
  655. LBOUND(tmp_data_in_landmask,1),':',UBOUND(tmp_data_in_landmask,1),',',LBOUND(tmp_data_in_landmask,2),':',UBOUND(tmp_data_in_landmask,2),')'
  656. CALL wrf_debug ( 100 , TRIM(str) )
  657. CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(in_landmask_field)' )
  658. in_landmask_field = ESMF_FieldCreate( &
  659. esmfgrid, tmp_data_in_landmask, &
  660. datacopyflag=ESMF_DATACOPY_REFERENCE, &
  661. staggerloc=ESMF_STAGGERLOC_CENTER, &
  662. name=TRIM(datanames(LANDMASK_INDX)), &
  663. ! lbounds=(/ips,jps/), &
  664. ! ubounds=(/ipe,jpe/), &
  665. rc=rc )
  666. IF ( rc /= ESMF_SUCCESS ) THEN
  667. CALL wrf_error_fatal ( 'ESMF_FieldCreate(in_landmask_field) failed' )
  668. ENDIF
  669. CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(in_landmask_field)' )
  670. !TODO: This bit will be useful once ESMF handles allocation/deallocation.
  671. ! validate ESMF allocation
  672. IF ( ( ips /= LBOUND(tmp_data_in_landmask,1) ) .OR. ( ipe /= UBOUND(tmp_data_in_landmask,1) ) .OR. &
  673. ( jps /= LBOUND(tmp_data_in_landmask,2) ) .OR. ( jpe /= UBOUND(tmp_data_in_landmask,2) ) ) THEN
  674. WRITE( str,* ) 'ESMF_FieldCreate(in_landmask_field) allocation failed ', &
  675. __FILE__ , &
  676. ', line ', &
  677. __LINE__ , &
  678. ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
  679. ', tmp_data_in_landmask(BOUNDS) = ',LBOUND(tmp_data_in_landmask,1),':',UBOUND(tmp_data_in_landmask,1),',', &
  680. LBOUND(tmp_data_in_landmask,2),':',UBOUND(tmp_data_in_landmask,2)
  681. CALL wrf_error_fatal ( TRIM(str) )
  682. ENDIF
  683. ! attach ESMF_Field to importState
  684. CALL ESMF_StateAdd( importState, fieldList=(/in_sst_field/), rc=rc )
  685. IF ( rc /= ESMF_SUCCESS ) THEN
  686. CALL wrf_error_fatal ( 'ESMF_StateAdd(in_sst_field) failed' )
  687. ENDIF
  688. CALL ESMF_StateAdd( importState, fieldList=(/in_landmask_field/), rc=rc )
  689. IF ( rc /= ESMF_SUCCESS ) THEN
  690. CALL wrf_error_fatal ( 'ESMF_StateAdd(in_landmask_field) failed' )
  691. ENDIF
  692. ! attach ESMF_Field to exportState
  693. CALL ESMF_StateAdd( exportState, fieldList=(/out_sst_field/), rc=rc )
  694. IF ( rc /= ESMF_SUCCESS ) THEN
  695. CALL wrf_error_fatal ( 'ESMF_StateAdd(out_sst_field) failed' )
  696. ENDIF
  697. CALL ESMF_StateAdd( exportState, fieldList=(/out_landmask_field/), rc=rc )
  698. IF ( rc /= ESMF_SUCCESS ) THEN
  699. CALL wrf_error_fatal ( 'ESMF_StateAdd(out_landmask_field) failed' )
  700. ENDIF
  701. ! Open the "SST" input data file for reading.
  702. write(str,'(A,A)') 'sst_component_init2: Opening data file ', &
  703. TRIM(sstinfilename)
  704. CALL wrf_message ( TRIM(str) )
  705. CALL wrf_open_for_read ( TRIM(sstinfilename) , &
  706. mpicom , &
  707. mpicom , &
  708. "DATASET=INPUT" , &
  709. fid , &
  710. ierr )
  711. IF ( ierr .NE. 0 ) THEN
  712. WRITE( str , FMT='(A,A,A,I8)' ) &
  713. 'sst_component_init2: error opening ', &
  714. TRIM(sstinfilename),' for reading ierr=',ierr
  715. CALL wrf_error_fatal ( TRIM(str) )
  716. ENDIF
  717. WRITE( str , FMT='(A,A,A,I8)' ) &
  718. 'subroutine sst_component_init2: opened file ', &
  719. TRIM(sstinfilename),' for reading fid=',fid
  720. CALL wrf_debug ( 100, TRIM(str) )
  721. write(str,'(A)') 'sst_component_init2: returning rc=ESMF_SUCCESS'
  722. CALL wrf_debug ( 100 , TRIM(str) )
  723. rc = ESMF_SUCCESS
  724. END SUBROUTINE sst_component_init2
  725. SUBROUTINE sst_component_run1( gcomp, importState, exportState, clock, rc )
  726. TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
  727. TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
  728. TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
  729. INTEGER, INTENT( OUT) :: rc
  730. !<DESCRIPTION>
  731. ! SST component run routine, phase 1.
  732. ! Read "SST" data from file and stuff into exportState.
  733. !
  734. ! The arguments are:
  735. ! gcomp Component
  736. ! importState Importstate
  737. ! exportState Exportstate
  738. ! clock External clock
  739. ! rc Return code; equals ESMF_SUCCESS if there are no errors,
  740. ! otherwise ESMF_FAILURE.
  741. !</DESCRIPTION>
  742. rc = ESMF_SUCCESS
  743. ! Get "SST" data from file and stuff it into exportState.
  744. CALL read_data( exportState, clock )
  745. END SUBROUTINE sst_component_run1
  746. SUBROUTINE sst_component_run2( gcomp, importState, exportState, clock, rc )
  747. TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
  748. TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
  749. TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
  750. INTEGER, INTENT( OUT) :: rc
  751. !<DESCRIPTION>
  752. ! SST component run routine, phase 2.
  753. ! Get from importState, compare with file data, and error-exit
  754. ! if they differ... If they are the same, then
  755. ! stuff the file data into the exportState.
  756. !
  757. ! The arguments are:
  758. ! gcomp Component
  759. ! importState Importstate
  760. ! exportState Exportstate
  761. ! clock External clock
  762. ! rc Return code; equals ESMF_SUCCESS if there are no errors,
  763. ! otherwise ESMF_FAILURE.
  764. !</DESCRIPTION>
  765. rc = ESMF_SUCCESS
  766. ! Get from importState, compare with file data, and error_exit
  767. ! if they differ...
  768. !TODO: change this once WRF can load exportState after integrating
  769. ! This works because WRF loads its exportState BEFORE integrating.
  770. CALL wrf_clockprint ( 50, clock, 'sst_component_run2: clock before call to compare_data()' )
  771. CALL compare_data( importState, clock )
  772. CALL wrf_clockprint ( 50, clock, 'sst_component_run2: clock after call to compare_data()' )
  773. END SUBROUTINE sst_component_run2
  774. SUBROUTINE sst_component_finalize( gcomp, importState, exportState, clock, rc )
  775. USE module_io
  776. TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
  777. TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
  778. TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
  779. INTEGER, INTENT( OUT) :: rc
  780. !<DESCRIPTION>
  781. ! SST component finalize routine.
  782. !
  783. ! The arguments are:
  784. ! gcomp Component
  785. ! importState Importstate
  786. ! exportState Exportstate
  787. ! clock External clock
  788. ! rc Return code; equals ESMF_SUCCESS if there are no errors,
  789. ! otherwise ESMF_FAILURE.
  790. !</DESCRIPTION>
  791. ! Local variables
  792. TYPE(ESMF_Field) :: tmp_field
  793. INTEGER :: i, ierr
  794. rc = ESMF_SUCCESS
  795. ! destroy ESMF_Fields and other "deep" objects created by this component
  796. ! note that this component relied on ESMF to allocate data pointers during
  797. ! calls to ESMF_FieldCreate() so it also expects ESMF to free these pointers
  798. DO i=1, datacount
  799. ! destroy field in importState
  800. CALL ESMF_StateGet( importState, TRIM(datanames(i)), tmp_field, &
  801. rc=rc )
  802. IF (rc /= ESMF_SUCCESS) THEN
  803. WRITE( str , * ) &
  804. 'sst_component_finalize: ESMF_StateGet( importState,', &
  805. TRIM(datanames(i)),') failed'
  806. CALL wrf_error_fatal ( TRIM(str) )
  807. ENDIF
  808. CALL ESMF_FieldDestroy( tmp_field, rc=rc )
  809. IF (rc /= ESMF_SUCCESS) THEN
  810. WRITE( str , * ) &
  811. 'sst_component_finalize: ESMF_FieldDestroy( importState,', &
  812. TRIM(datanames(i)),') failed'
  813. CALL wrf_error_fatal ( TRIM(str) )
  814. ENDIF
  815. ! destroy field in exportState
  816. CALL ESMF_StateGet( exportState, TRIM(datanames(i)), tmp_field, &
  817. rc=rc )
  818. IF (rc /= ESMF_SUCCESS) THEN
  819. WRITE( str , * ) &
  820. 'sst_component_finalize: ESMF_StateGet( exportState,', &
  821. TRIM(datanames(i)),') failed'
  822. CALL wrf_error_fatal ( TRIM(str) )
  823. ENDIF
  824. CALL ESMF_FieldDestroy( tmp_field, rc=rc )
  825. IF (rc /= ESMF_SUCCESS) THEN
  826. WRITE( str , * ) &
  827. 'sst_component_finalize: ESMF_FieldDestroy( exportState,', &
  828. TRIM(datanames(i)),') failed'
  829. CALL wrf_error_fatal ( TRIM(str) )
  830. ENDIF
  831. ENDDO
  832. ! deallocate space for data read from disk
  833. DEALLOCATE( file_sst_data, file_landmask_data )
  834. ! close SST data file
  835. WRITE( str , FMT='(A,I8)' ) &
  836. 'subroutine sst_component_finalize: closing file fid=',fid
  837. CALL wrf_debug ( 100, TRIM(str) )
  838. CALL wrf_ioclose( fid , ierr )
  839. IF ( ierr .NE. 0 ) THEN
  840. CALL wrf_error_fatal ( 'sst_component_finalize: wrf_ioclose failed' )
  841. ENDIF
  842. END SUBROUTINE sst_component_finalize
  843. END MODULE module_sst_component_top
  844. MODULE module_sst_setservices
  845. !<DESCRIPTION>
  846. ! This module defines SST "Set Services" method sst_register()
  847. ! used for ESMF coupling.
  848. !</DESCRIPTION>
  849. USE module_sst_component_top, ONLY: sst_component_init1, &
  850. sst_component_init2, &
  851. sst_component_run1, &
  852. sst_component_run2, &
  853. sst_component_finalize
  854. ! Updated for ESMF 5.2.0r
  855. ! USE ESMF_Mod
  856. USE ESMF
  857. IMPLICIT NONE
  858. ! everything is private by default
  859. PRIVATE
  860. ! Public entry point for ESMF_GridCompSetServices()
  861. PUBLIC SST_register
  862. ! private stuff
  863. CHARACTER (ESMF_MAXSTR) :: str
  864. CONTAINS
  865. SUBROUTINE sst_register(gcomp, rc)
  866. TYPE(ESMF_GridComp), INTENT(INOUT) :: gcomp
  867. INTEGER, INTENT(OUT) :: rc
  868. INTEGER :: finalrc
  869. !
  870. !<DESCRIPTION>
  871. ! SST_register - Externally visible registration routine
  872. !
  873. ! User-supplied SetServices routine.
  874. ! The Register routine sets the subroutines to be called
  875. ! as the init, run, and finalize routines. Note that these are
  876. ! private to the module.
  877. !
  878. ! The arguments are:
  879. ! gcomp Component
  880. ! rc Return code; equals ESMF_SUCCESS if there are no errors,
  881. ! otherwise ESMF_FAILURE.
  882. !</DESCRIPTION>
  883. finalrc = ESMF_SUCCESS
  884. ! Register the callback routines.
  885. call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
  886. sst_component_init1, phase=1, rc=rc)
  887. IF ( rc /= ESMF_SUCCESS) THEN
  888. WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_init1) failed with rc = ', rc
  889. CALL wrf_error_fatal ( TRIM(str) )
  890. ENDIF
  891. call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
  892. sst_component_init2, phase=2, rc=rc)
  893. IF ( rc /= ESMF_SUCCESS) THEN
  894. WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_init2) failed with rc = ', rc
  895. CALL wrf_error_fatal ( TRIM(str) )
  896. ENDIF
  897. call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_RUN, &
  898. sst_component_run1, phase=1, rc=rc)
  899. IF ( rc /= ESMF_SUCCESS) THEN
  900. WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_run1) failed with rc = ', rc
  901. CALL wrf_error_fatal ( TRIM(str) )
  902. ENDIF
  903. call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_RUN, &
  904. sst_component_run2, phase=2, rc=rc)
  905. IF ( rc /= ESMF_SUCCESS) THEN
  906. WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_run2) failed with rc = ', rc
  907. CALL wrf_error_fatal ( TRIM(str) )
  908. ENDIF
  909. call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_FINALIZE, &
  910. sst_component_finalize, rc=rc)
  911. IF ( rc /= ESMF_SUCCESS) THEN
  912. WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_finalize) failed with rc = ', rc
  913. CALL wrf_error_fatal ( TRIM(str) )
  914. ENDIF
  915. PRINT *,'SST: Registered Initialize, Run, and Finalize routines'
  916. rc = finalrc
  917. END SUBROUTINE sst_register
  918. END MODULE module_sst_setservices
  919. !<DESCRIPTION>
  920. ! Module module_wrfsst_coupler defines the
  921. ! "WRF-SST" coupler component. It provides two-way coupling between
  922. ! the "SST" and "WRF" components.
  923. ! In its run routine it transfers data directly from the
  924. ! SST Component's export state to the WRF Component's import state.
  925. ! It also transfers data directly from the
  926. ! WRF Component's export state to the SST Component's import state.
  927. !
  928. ! This is derived from src/demo/coupled_flow/src/CouplerMod.F90
  929. ! created by Nancy Collins and others on the ESMF Core Team.
  930. !
  931. !</DESCRIPTION>
  932. MODULE module_wrfsst_coupler
  933. ! Updated for ESMF 5.2.0r
  934. ! USE ESMF_Mod
  935. USE ESMF
  936. IMPLICIT NONE
  937. ! everything is private by default
  938. PRIVATE
  939. ! Public entry point
  940. PUBLIC WRFSSTCpl_register
  941. ! private data members
  942. ! route handles and flags
  943. TYPE(ESMF_RouteHandle), SAVE :: fromWRF_rh, fromSST_rh
  944. LOGICAL, SAVE :: fromWRF_rh_ready = .FALSE.
  945. LOGICAL, SAVE :: fromSST_rh_ready = .FALSE.
  946. ! field names
  947. INTEGER, PARAMETER :: datacount = 2
  948. INTEGER, PARAMETER :: SST_INDX = 1
  949. INTEGER, PARAMETER :: LANDMASK_INDX = 2
  950. CHARACTER(LEN=ESMF_MAXSTR), SAVE :: datanames(datacount)
  951. CHARACTER(LEN=ESMF_MAXSTR) :: str
  952. CONTAINS
  953. SUBROUTINE WRFSSTCpl_register(comp, rc)
  954. TYPE(ESMF_CplComp), INTENT(INOUT) :: comp
  955. INTEGER, INTENT(OUT) :: rc
  956. !
  957. !<DESCRIPTION>
  958. ! WRFSSTCpl_register - Externally visible registration routine
  959. !
  960. ! User-supplied SetServices routine.
  961. ! The Register routine sets the subroutines to be called
  962. ! as the init, run, and finalize routines. Note that these are
  963. ! private to the module.
  964. !
  965. ! The arguments are:
  966. ! comp Component
  967. ! rc Return code; equals ESMF_SUCCESS if there are no errors,
  968. ! otherwise ESMF_FAILURE.
  969. !</DESCRIPTION>
  970. ! guilty until proven innocent
  971. rc = ESMF_FAILURE
  972. ! Register the callback routines.
  973. call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, WRFSSTCpl_init, &
  974. rc=rc)
  975. IF ( rc /= ESMF_SUCCESS ) THEN
  976. CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_init) failed' )
  977. ENDIF
  978. call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, WRFSSTCpl_run, &
  979. rc=rc)
  980. IF ( rc /= ESMF_SUCCESS ) THEN
  981. CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_run) failed' )
  982. ENDIF
  983. call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, WRFSSTCpl_final, &
  984. rc=rc)
  985. IF ( rc /= ESMF_SUCCESS ) THEN
  986. CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_final) failed' )
  987. ENDIF
  988. print *, "module_wrfsst_coupler: Registered Initialize, Run, and Finalize routines"
  989. END SUBROUTINE WRFSSTCpl_register
  990. SUBROUTINE WRFSSTCpl_init(comp, importState, exportState, clock, rc)
  991. USE module_metadatautils, ONLY: AttachDecompToState, GetDecompFromState
  992. TYPE(ESMF_CplComp), INTENT(INOUT) :: comp
  993. TYPE(ESMF_State), INTENT(INOUT) :: importState, exportState
  994. TYPE(ESMF_Clock), INTENT(INOUT) :: clock
  995. INTEGER, INTENT(OUT) :: rc
  996. !<DESCRIPTION>
  997. ! WRF-SST coupler component init routine. This simply passes needed
  998. ! metadata from WRF to SST. Initialization of ESMF_RouteHandle objects
  999. ! is handled later via lazy evaluation.
  1000. !
  1001. ! The arguments are:
  1002. ! comp Component
  1003. ! importState Importstate
  1004. ! exportState Exportstate
  1005. ! clock External clock
  1006. ! rc Return code; equals ESMF_SUCCESS if there are no errors,
  1007. ! otherwise ESMF_FAILURE.
  1008. !</DESCRIPTION>
  1009. ! Local variables
  1010. CHARACTER(ESMF_MAXSTR) :: importstatename
  1011. ! decomposition information
  1012. INTEGER :: ids, ide, jds, jde, kds, kde
  1013. INTEGER :: ims, ime, jms, jme, kms, kme
  1014. INTEGER :: ips, ipe, jps, jpe, kps, kpe
  1015. INTEGER :: domdesc
  1016. LOGICAL :: bdy_mask(4)
  1017. PRINT *, "DEBUG: Coupler Init starting"
  1018. ! guilty until proven innocent
  1019. rc = ESMF_FAILURE
  1020. CALL ESMF_StateGet(importState, name=importstatename, rc=rc)
  1021. IF ( rc /= ESMF_SUCCESS ) THEN
  1022. CALL wrf_error_fatal ( 'WRFSSTCpl_init: ESMF_StateGet failed' )
  1023. ENDIF
  1024. IF ( TRIM(importstatename) .EQ. "WRF Export State" ) THEN
  1025. ! get metadata from WRF export state
  1026. CALL GetDecompFromState( importState, &
  1027. ids, ide, jds, jde, kds, kde, &
  1028. ims, ime, jms, jme, kms, kme, &
  1029. ips, ipe, jps, jpe, kps, kpe, &
  1030. domdesc, bdy_mask )
  1031. ! put metadata from in SST import state
  1032. CALL AttachDecompToState( exportState, &
  1033. ids, ide, jds, jde, kds, kde, &
  1034. ims, ime, jms, jme, kms, kme, &
  1035. ips, ipe, jps, jpe, kps, kpe, &
  1036. domdesc, bdy_mask )
  1037. ELSE
  1038. WRITE(str,*)'WRFSSTCpl_init: invalid importState name: ',TRIM(importstatename)
  1039. CALL wrf_error_fatal ( TRIM(str) )
  1040. ENDIF
  1041. ! set up field names
  1042. !TODO: use CF conventions for "standard_name" once WRF Registry supports them
  1043. !TODO: datanames(SST_INDX) = "sea_surface_temperature"
  1044. !TODO: datanames(LANDMASK_INDX) = "land_binary_mask"
  1045. datanames(SST_INDX) = "SST"
  1046. datanames(LANDMASK_INDX) = "LANDMASK"
  1047. PRINT *, "DEBUG: Coupler Init returning"
  1048. END SUBROUTINE WRFSSTCpl_init
  1049. SUBROUTINE WRFSSTCpl_run(comp, importState, exportState, clock, rc)
  1050. USE ESMF
  1051. TYPE(ESMF

Large files files are truncated, but you can click here to view the full file