| 1 | !WRF:DRIVER_LAYER:MAIN |
|---|
| 2 | ! |
|---|
| 3 | |
|---|
| 4 | !<DESCRIPTION> |
|---|
| 5 | ! ESMF Application Wrapper for coupling WRF with a "dummy" component |
|---|
| 6 | ! that simply reads SSTs from a file, sends to WRF, receives SST from |
|---|
| 7 | ! WRF (two-way coupling). and checks that the SSTs match. |
|---|
| 8 | ! |
|---|
| 9 | ! This file contains the main program and associated modules for the |
|---|
| 10 | ! SST "dummy" component and a simple coupler. It creates ESMF Gridded |
|---|
| 11 | ! and Coupler Components. |
|---|
| 12 | ! |
|---|
| 13 | ! This source file is only built when ESMF coupling is used. |
|---|
| 14 | ! |
|---|
| 15 | !</DESCRIPTION> |
|---|
| 16 | |
|---|
| 17 | |
|---|
| 18 | |
|---|
| 19 | !<DESCRIPTION> |
|---|
| 20 | ! Modules module_sst_component_top and module_sst_setservices define the |
|---|
| 21 | ! "SST" dummy component. |
|---|
| 22 | !</DESCRIPTION> |
|---|
| 23 | |
|---|
| 24 | MODULE module_sst_component_top |
|---|
| 25 | !<DESCRIPTION> |
|---|
| 26 | ! This module defines sst_component_init1(), sst_component_init2(), |
|---|
| 27 | ! sst_component_run1(), sst_component_run2(), and sst_component_finalize() |
|---|
| 28 | ! routines that are called when SST is run as an ESMF component. |
|---|
| 29 | !</DESCRIPTION> |
|---|
| 30 | |
|---|
| 31 | USE ESMF_Mod |
|---|
| 32 | USE module_esmf_extensions |
|---|
| 33 | USE module_metadatautils, ONLY: AttachTimesToState |
|---|
| 34 | |
|---|
| 35 | |
|---|
| 36 | IMPLICIT NONE |
|---|
| 37 | |
|---|
| 38 | ! everything is private by default |
|---|
| 39 | PRIVATE |
|---|
| 40 | |
|---|
| 41 | ! Public entry points |
|---|
| 42 | PUBLIC sst_component_init1 |
|---|
| 43 | PUBLIC sst_component_init2 |
|---|
| 44 | PUBLIC sst_component_run1 |
|---|
| 45 | PUBLIC sst_component_run2 |
|---|
| 46 | PUBLIC sst_component_finalize |
|---|
| 47 | |
|---|
| 48 | ! private stuff |
|---|
| 49 | TYPE(ESMF_Grid), SAVE :: esmfgrid ! grid used in fields |
|---|
| 50 | CHARACTER (4096) :: str |
|---|
| 51 | INTEGER, SAVE :: fid ! file handle |
|---|
| 52 | ! decomposition information |
|---|
| 53 | INTEGER, SAVE :: ids, ide, jds, jde, kds, kde |
|---|
| 54 | INTEGER, SAVE :: ims, ime, jms, jme, kms, kme |
|---|
| 55 | INTEGER, SAVE :: ips, ipe, jps, jpe, kps, kpe |
|---|
| 56 | REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_out_sst(:,:) |
|---|
| 57 | REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_out_landmask(:,:) |
|---|
| 58 | REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_in_sst(:,:) |
|---|
| 59 | REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_in_landmask(:,:) |
|---|
| 60 | INTEGER, SAVE :: domdesc |
|---|
| 61 | LOGICAL, SAVE :: bdy_mask(4) |
|---|
| 62 | ! MPI communicator, if needed |
|---|
| 63 | INTEGER, SAVE :: mpicom |
|---|
| 64 | ! field data |
|---|
| 65 | REAL, POINTER, SAVE :: file_landmask_data(:,:), file_sst_data(:,:) |
|---|
| 66 | ! input data file name |
|---|
| 67 | CHARACTER ( ESMF_MAXSTR ), SAVE :: sstinfilename |
|---|
| 68 | ! field names |
|---|
| 69 | INTEGER, PARAMETER :: datacount = 2 |
|---|
| 70 | INTEGER, PARAMETER :: SST_INDX = 1 |
|---|
| 71 | INTEGER, PARAMETER :: LANDMASK_INDX = 2 |
|---|
| 72 | CHARACTER(LEN=ESMF_MAXSTR), SAVE :: datanames(datacount) |
|---|
| 73 | TYPE real2d |
|---|
| 74 | REAL, POINTER :: r2d(:,:) |
|---|
| 75 | END TYPE real2d |
|---|
| 76 | TYPE(real2d) :: this_data(datacount) |
|---|
| 77 | |
|---|
| 78 | |
|---|
| 79 | CONTAINS |
|---|
| 80 | |
|---|
| 81 | |
|---|
| 82 | |
|---|
| 83 | ! First-phase "init" reads "SST" data file and returns "time" metadata in |
|---|
| 84 | ! exportState. |
|---|
| 85 | SUBROUTINE sst_component_init1( gcomp, importState, exportState, clock, rc ) |
|---|
| 86 | USE module_io |
|---|
| 87 | TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp |
|---|
| 88 | TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState |
|---|
| 89 | TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState |
|---|
| 90 | TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock |
|---|
| 91 | INTEGER, INTENT( OUT) :: rc |
|---|
| 92 | !<DESCRIPTION> |
|---|
| 93 | ! SST component init routine, phase 1. |
|---|
| 94 | ! |
|---|
| 95 | ! The arguments are: |
|---|
| 96 | ! gcomp Component |
|---|
| 97 | ! importState Importstate |
|---|
| 98 | ! exportState Exportstate |
|---|
| 99 | ! clock External clock |
|---|
| 100 | ! rc Return code; equals ESMF_SUCCESS if there are no errors, |
|---|
| 101 | ! otherwise ESMF_FAILURE. |
|---|
| 102 | !</DESCRIPTION> |
|---|
| 103 | |
|---|
| 104 | #ifdef DM_PARALLEL |
|---|
| 105 | INCLUDE 'mpif.h' |
|---|
| 106 | #endif |
|---|
| 107 | |
|---|
| 108 | ! Local variables |
|---|
| 109 | CHARACTER (LEN=19) :: date_string |
|---|
| 110 | #ifdef DM_PARALLEL |
|---|
| 111 | TYPE(ESMF_VM) :: vm |
|---|
| 112 | INTEGER :: mpicomtmp |
|---|
| 113 | #endif |
|---|
| 114 | TYPE(ESMF_Time) :: startTime, stopTime, currentTime, dataTime |
|---|
| 115 | TYPE(ESMF_TimeInterval) :: timeStep |
|---|
| 116 | INTEGER :: ierr, num_steps, time_loop_max |
|---|
| 117 | INTEGER :: status_next_var |
|---|
| 118 | |
|---|
| 119 | !TODO: For now, sstinfilename is hard-coded |
|---|
| 120 | !TODO: Upgrade to use a variant of construct_filename() via startTime |
|---|
| 121 | !TODO: extracted from clock. |
|---|
| 122 | sstinfilename = 'sstin_d01_000000' |
|---|
| 123 | |
|---|
| 124 | ! get MPI communicator out of current VM and duplicate (if needed) |
|---|
| 125 | #ifdef DM_PARALLEL |
|---|
| 126 | CALL ESMF_VMGetCurrent(vm, rc=rc) |
|---|
| 127 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 128 | CALL wrf_error_fatal ( 'sst_component_init1: ESMF_VMGetCurrent failed' ) |
|---|
| 129 | ENDIF |
|---|
| 130 | CALL ESMF_VMGet(vm, mpiCommunicator=mpicomtmp, rc=rc) |
|---|
| 131 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 132 | CALL wrf_error_fatal ( 'sst_component_init1: ESMF_VMGet failed' ) |
|---|
| 133 | ENDIF |
|---|
| 134 | CALL MPI_Comm_dup( mpicomtmp, mpicom, ierr ) |
|---|
| 135 | #else |
|---|
| 136 | mpicom = 0 |
|---|
| 137 | #endif |
|---|
| 138 | ! Open the "SST" input data file for reading. |
|---|
| 139 | write(str,'(A,A)') 'Subroutine sst_component_init1: Opening data file ', & |
|---|
| 140 | TRIM(sstinfilename) |
|---|
| 141 | CALL wrf_message ( TRIM(str) ) |
|---|
| 142 | CALL wrf_open_for_read ( TRIM(sstinfilename) , & |
|---|
| 143 | mpicom , & |
|---|
| 144 | mpicom , & |
|---|
| 145 | "DATASET=INPUT" , & |
|---|
| 146 | fid , & |
|---|
| 147 | ierr ) |
|---|
| 148 | IF ( ierr .NE. 0 ) THEN |
|---|
| 149 | WRITE( str , FMT='(A,A,A,I8)' ) & |
|---|
| 150 | 'subroutine sst_component_init1: error opening ', & |
|---|
| 151 | TRIM(sstinfilename),' for reading ierr=',ierr |
|---|
| 152 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 153 | ENDIF |
|---|
| 154 | WRITE( str , FMT='(A,A,A,I8)' ) & |
|---|
| 155 | 'subroutine sst_component_init1: opened file ', & |
|---|
| 156 | TRIM(sstinfilename),' for reading fid=',fid |
|---|
| 157 | CALL wrf_debug ( 100, TRIM(str) ) |
|---|
| 158 | |
|---|
| 159 | ! How many data time levels are in the SST input file? |
|---|
| 160 | num_steps = -1 |
|---|
| 161 | time_loop_max = 0 |
|---|
| 162 | CALL wrf_debug ( 100, 'subroutine sst_component_init1: find time_loop_max' ) |
|---|
| 163 | ! compute SST start time, time step, and end time here |
|---|
| 164 | get_the_right_time : DO |
|---|
| 165 | CALL wrf_get_next_time ( fid, date_string, status_next_var ) |
|---|
| 166 | write(str,'(A,A)') 'Subroutine sst_component_init1: SST data startTime: ', & |
|---|
| 167 | date_string |
|---|
| 168 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 169 | IF ( status_next_var == 0 ) THEN |
|---|
| 170 | IF ( time_loop_max == 0 ) THEN |
|---|
| 171 | CALL wrf_atotime( date_string, startTime ) |
|---|
| 172 | ELSEIF ( time_loop_max == 1 ) THEN |
|---|
| 173 | ! assumes fixed time step! |
|---|
| 174 | CALL wrf_atotime( date_string, dataTime ) |
|---|
| 175 | timeStep = dataTime - startTime |
|---|
| 176 | ENDIF |
|---|
| 177 | time_loop_max = time_loop_max + 1 |
|---|
| 178 | CALL wrf_atotime( date_string, stopTime ) |
|---|
| 179 | ELSE |
|---|
| 180 | EXIT get_the_right_time |
|---|
| 181 | ENDIF |
|---|
| 182 | END DO get_the_right_time |
|---|
| 183 | CALL wrf_timetoa ( stopTime, date_string ) |
|---|
| 184 | write(str,'(A,A)') 'Subroutine sst_component_init1: SST data stopTime: ', & |
|---|
| 185 | date_string |
|---|
| 186 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 187 | ! attach times to exportState for use by driver |
|---|
| 188 | CALL AttachTimesToState( exportState, startTime, stopTime, timeStep ) |
|---|
| 189 | |
|---|
| 190 | ! There should be a more elegant way to get to the beginning of the |
|---|
| 191 | ! file, but this will do. |
|---|
| 192 | CALL wrf_ioclose( fid , ierr ) |
|---|
| 193 | IF ( ierr .NE. 0 ) THEN |
|---|
| 194 | CALL wrf_error_fatal ( 'sst_component_init1: wrf_ioclose failed' ) |
|---|
| 195 | ENDIF |
|---|
| 196 | WRITE( str , FMT='(A,I8)' ) & |
|---|
| 197 | 'subroutine sst_component_init1: closed file fid=',fid |
|---|
| 198 | CALL wrf_debug ( 100, TRIM(str) ) |
|---|
| 199 | |
|---|
| 200 | ! set up field names |
|---|
| 201 | !TODO: use CF conventions for "standard_name" once WRF Registry supports them |
|---|
| 202 | !TODO: datanames(SST_INDX) = "sea_surface_temperature" |
|---|
| 203 | !TODO: datanames(LANDMASK_INDX) = "land_binary_mask" |
|---|
| 204 | datanames(SST_INDX) = "SST" |
|---|
| 205 | datanames(LANDMASK_INDX) = "LANDMASK" |
|---|
| 206 | |
|---|
| 207 | rc = ESMF_SUCCESS |
|---|
| 208 | |
|---|
| 209 | END SUBROUTINE sst_component_init1 |
|---|
| 210 | |
|---|
| 211 | |
|---|
| 212 | |
|---|
| 213 | SUBROUTINE read_data( exportState, clock ) |
|---|
| 214 | USE module_io |
|---|
| 215 | TYPE(ESMF_State), INTENT(INOUT) :: exportState |
|---|
| 216 | TYPE(ESMF_Clock), INTENT(IN ) :: clock |
|---|
| 217 | !<DESCRIPTION> |
|---|
| 218 | ! Reads data from file and stores. Then |
|---|
| 219 | ! stuffs the file data into the SST exportState. |
|---|
| 220 | !</DESCRIPTION> |
|---|
| 221 | |
|---|
| 222 | #include <wrf_status_codes.h> |
|---|
| 223 | #include <wrf_io_flags.h> |
|---|
| 224 | |
|---|
| 225 | ! Local variables |
|---|
| 226 | CHARACTER (LEN=19) :: date_string |
|---|
| 227 | TYPE(ESMF_Time) :: currentTime, dataTime |
|---|
| 228 | REAL(ESMF_KIND_R4), POINTER :: out_sst_ptr(:,:), out_landmask_ptr(:,:) |
|---|
| 229 | TYPE(ESMF_Field) :: out_sst_field, out_landmask_field |
|---|
| 230 | TYPE(ESMF_Field) :: in_sst_field, in_landmask_field |
|---|
| 231 | INTEGER :: i, j |
|---|
| 232 | CHARACTER(LEN=ESMF_MAXSTR) :: fieldname, debugmsg, errormsg, timestr |
|---|
| 233 | INTEGER :: ierr |
|---|
| 234 | INTEGER :: rc |
|---|
| 235 | |
|---|
| 236 | ! This call to wrf_get_next_time will position the dataset over the next |
|---|
| 237 | ! time-frame in the file and return the date_string, which is used as an |
|---|
| 238 | ! argument to the read_field routines in the blocks of code included |
|---|
| 239 | ! below. |
|---|
| 240 | |
|---|
| 241 | CALL wrf_get_next_time( fid, date_string , ierr ) |
|---|
| 242 | WRITE(str,'(A,A)') 'Subroutine read_data: SST data time: ', & |
|---|
| 243 | date_string |
|---|
| 244 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 245 | IF ( ierr .NE. 0 .AND. ierr .NE. WRF_WARN_NOTSUPPORTED .AND. & |
|---|
| 246 | ierr .NE. WRF_WARN_DRYRUN_READ ) THEN |
|---|
| 247 | CALL wrf_error_fatal ( "... May have run out of valid SST data ..." ) |
|---|
| 248 | ELSE IF ( ierr .NE. WRF_WARN_NOTSUPPORTED .AND. & |
|---|
| 249 | ierr .NE. WRF_WARN_DRYRUN_READ) THEN |
|---|
| 250 | ! check input time against current time (which will be start time at |
|---|
| 251 | ! beginning) |
|---|
| 252 | CALL wrf_atotime( date_string, dataTime ) |
|---|
| 253 | CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc ) |
|---|
| 254 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 255 | CALL wrf_error_fatal ( 'read_data: ESMF_ClockGet() failed' ) |
|---|
| 256 | ENDIF |
|---|
| 257 | CALL wrf_clockprint(150, clock, & |
|---|
| 258 | 'DEBUG read_data(): get currentTime from clock,') |
|---|
| 259 | IF ( dataTime .NE. currentTime ) THEN |
|---|
| 260 | CALL wrf_timetoa ( dataTime, timestr ) |
|---|
| 261 | WRITE( errormsg , * )'Time in file: ',trim( timestr ) |
|---|
| 262 | CALL wrf_message ( trim(errormsg) ) |
|---|
| 263 | CALL wrf_timetoa ( currentTime, timestr ) |
|---|
| 264 | WRITE( errormsg , * )'Time on domain: ',trim( timestr ) |
|---|
| 265 | CALL wrf_message ( trim(errormsg) ) |
|---|
| 266 | CALL wrf_error_fatal( & |
|---|
| 267 | "**ERROR** Time in input file not equal to time on domain **ERROR**" ) |
|---|
| 268 | ENDIF |
|---|
| 269 | ENDIF |
|---|
| 270 | |
|---|
| 271 | ! doing this in a loop only works if staggering is the same for all fields |
|---|
| 272 | this_data(SST_INDX)%r2d => file_sst_data |
|---|
| 273 | this_data(LANDMASK_INDX)%r2d => file_landmask_data |
|---|
| 274 | DO i=1, datacount |
|---|
| 275 | fieldname = TRIM(datanames(i)) |
|---|
| 276 | debugmsg = 'ext_read_field '//TRIM(fieldname)//' memorder XY' |
|---|
| 277 | errormsg = 'could not read '//TRIM(fieldname)//' data from file' |
|---|
| 278 | CALL wrf_ext_read_field ( & |
|---|
| 279 | fid , & ! DataHandle |
|---|
| 280 | date_string , & ! DateStr |
|---|
| 281 | TRIM(fieldname) , & ! Data Name |
|---|
| 282 | this_data(i)%r2d , & ! Field |
|---|
| 283 | WRF_REAL , & ! FieldType |
|---|
| 284 | mpicom , & ! Comm |
|---|
| 285 | mpicom , & ! I/O Comm |
|---|
| 286 | domdesc , & ! Domain descriptor |
|---|
| 287 | bdy_mask , & ! bdy_mask |
|---|
| 288 | 'XY' , & ! MemoryOrder |
|---|
| 289 | '' , & ! Stagger |
|---|
| 290 | TRIM(debugmsg) , & ! Debug message |
|---|
| 291 | #if 1 |
|---|
| 292 | ids , (ide-1) , jds , (jde-1) , 1 , 1 , & |
|---|
| 293 | ims , ime , jms , jme , 1 , 1 , & |
|---|
| 294 | ips , MIN( (ide-1), ipe ) , jps , MIN( (jde-1), jpe ) , 1 , 1 , & |
|---|
| 295 | #else |
|---|
| 296 | !jm the dimensions have already been reduced to the non-staggered WRF grid when |
|---|
| 297 | ! they were stored in this module.. Just use as is. |
|---|
| 298 | ids , ide , jds , jde , 1 , 1 , & |
|---|
| 299 | ims , ime , jms , jme , 1 , 1 , & |
|---|
| 300 | ips , ipe , jps , jpe , 1 , 1 , & |
|---|
| 301 | #endif |
|---|
| 302 | ierr ) |
|---|
| 303 | IF (ierr /= 0) THEN |
|---|
| 304 | CALL wrf_error_fatal ( TRIM(errormsg) ) |
|---|
| 305 | ENDIF |
|---|
| 306 | ENDDO |
|---|
| 307 | |
|---|
| 308 | ! stuff fields into exportState |
|---|
| 309 | !TODO: change this to Bundles, eventually |
|---|
| 310 | CALL ESMF_StateGet( exportState, TRIM(datanames(SST_INDX)), & |
|---|
| 311 | out_sst_field, rc=rc ) |
|---|
| 312 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 313 | CALL wrf_error_fatal ( & |
|---|
| 314 | 'could not find sea_surface_temperature field in exportState' ) |
|---|
| 315 | ENDIF |
|---|
| 316 | CALL ESMF_StateGet( exportState, TRIM(datanames(LANDMASK_INDX)), & |
|---|
| 317 | out_landmask_field, rc=rc ) |
|---|
| 318 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 319 | CALL wrf_error_fatal ( & |
|---|
| 320 | 'could not find land_binary_mask field in exportState' ) |
|---|
| 321 | ENDIF |
|---|
| 322 | ! CALL ESMF_FieldGetDataPointer( out_sst_field, out_sst_ptr, rc=rc ) |
|---|
| 323 | CALL ESMF_FieldGet( out_sst_field, 0, out_sst_ptr, rc=rc ) |
|---|
| 324 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 325 | CALL wrf_error_fatal ( & |
|---|
| 326 | 'could not find sea_surface_temperature data in sea_surface_temperature field' ) |
|---|
| 327 | ENDIF |
|---|
| 328 | ! CALL ESMF_FieldGetDataPointer( out_landmask_field, out_landmask_ptr, rc=rc ) |
|---|
| 329 | CALL ESMF_FieldGet( out_landmask_field, 0, out_landmask_ptr, rc=rc ) |
|---|
| 330 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 331 | CALL wrf_error_fatal ( & |
|---|
| 332 | 'could not find land_binary_mask data in land_binary_mask field' ) |
|---|
| 333 | ENDIF |
|---|
| 334 | ! staggered starts/ends |
|---|
| 335 | DO j= jps , jpe |
|---|
| 336 | DO i= ips , ipe |
|---|
| 337 | out_sst_ptr(i,j) = file_sst_data(i,j) |
|---|
| 338 | out_landmask_ptr(i,j) = file_landmask_data(i,j) |
|---|
| 339 | ENDDO |
|---|
| 340 | ENDDO |
|---|
| 341 | |
|---|
| 342 | END SUBROUTINE read_data |
|---|
| 343 | |
|---|
| 344 | |
|---|
| 345 | |
|---|
| 346 | |
|---|
| 347 | SUBROUTINE compare_data( importState, clock ) |
|---|
| 348 | TYPE(ESMF_State), INTENT(INOUT) :: importState |
|---|
| 349 | !TODO: remove clock after debugging is finished |
|---|
| 350 | TYPE(ESMF_Clock), INTENT(INOUT) :: clock |
|---|
| 351 | !<DESCRIPTION> |
|---|
| 352 | ! Gets data from coupler via importState |
|---|
| 353 | ! and compares with data read from file and |
|---|
| 354 | ! error-exits if they differ. |
|---|
| 355 | ! |
|---|
| 356 | ! The arguments are: |
|---|
| 357 | ! importState Importstate |
|---|
| 358 | !</DESCRIPTION> |
|---|
| 359 | |
|---|
| 360 | ! Local variables |
|---|
| 361 | TYPE(ESMF_Field) :: in_sst_field, in_landmask_field |
|---|
| 362 | REAL(ESMF_KIND_R4), POINTER :: in_sst_ptr(:,:), in_landmask_ptr(:,:) |
|---|
| 363 | REAL, POINTER :: in_sst_ptr_real(:,:), in_landmask_ptr_real(:,:) |
|---|
| 364 | INTEGER :: i, j |
|---|
| 365 | INTEGER :: rc |
|---|
| 366 | LOGICAL :: landmask_ok, sst_ok |
|---|
| 367 | ! use these for debug prints |
|---|
| 368 | TYPE(ESMF_Time) :: currentTime |
|---|
| 369 | INTEGER, SAVE :: numtimes=0 ! track number of calls |
|---|
| 370 | CHARACTER(LEN=256) :: timestamp |
|---|
| 371 | |
|---|
| 372 | ! count calls for debug prints... |
|---|
| 373 | CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc ) |
|---|
| 374 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 375 | CALL wrf_error_fatal ( 'compare_data: ESMF_ClockGet() failed' ) |
|---|
| 376 | ENDIF |
|---|
| 377 | CALL wrf_timetoa ( currentTime, timestamp ) |
|---|
| 378 | numtimes = numtimes + 1 |
|---|
| 379 | WRITE(str,*) 'SST compare_data: begin, numtimes = ',numtimes,' time = ',TRIM(timestamp) |
|---|
| 380 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 381 | |
|---|
| 382 | ! extract data from the importState and compare with data from file |
|---|
| 383 | !TODO: change this to Bundles, eventually |
|---|
| 384 | CALL ESMF_StateGet( importState, TRIM(datanames(SST_INDX)), & |
|---|
| 385 | in_sst_field, rc=rc ) |
|---|
| 386 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 387 | CALL wrf_error_fatal ( & |
|---|
| 388 | 'could not extract sea_surface_temperature field from importState' ) |
|---|
| 389 | ENDIF |
|---|
| 390 | CALL ESMF_StateGet( importState, TRIM(datanames(LANDMASK_INDX)), & |
|---|
| 391 | in_landmask_field, rc=rc ) |
|---|
| 392 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 393 | CALL wrf_error_fatal ( & |
|---|
| 394 | 'could not extract land_binary_mask field from importState' ) |
|---|
| 395 | ENDIF |
|---|
| 396 | ! CALL ESMF_FieldGetDataPointer( in_sst_field, in_sst_ptr, rc=rc ) |
|---|
| 397 | CALL ESMF_FieldGet( in_sst_field, 0, in_sst_ptr, rc=rc ) |
|---|
| 398 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 399 | CALL wrf_error_fatal ( & |
|---|
| 400 | 'could not extract sea_surface_temperature data from sea_surface_temperature field' ) |
|---|
| 401 | ENDIF |
|---|
| 402 | ALLOCATE( in_sst_ptr_real(ims:ime,jms:jme) ) |
|---|
| 403 | WRITE( str,* ) 'compare_data, ips:ipe,jps:jpe = ', & |
|---|
| 404 | ips,':',ipe,',',jps,':',jpe, & |
|---|
| 405 | ', in_sst_ptr(BOUNDS) = ', & |
|---|
| 406 | LBOUND(in_sst_ptr,1),':',UBOUND(in_sst_ptr,1),',', & |
|---|
| 407 | LBOUND(in_sst_ptr,2),':',UBOUND(in_sst_ptr,2) |
|---|
| 408 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 409 | DO j= jms, jme |
|---|
| 410 | DO i= ims, ime |
|---|
| 411 | in_sst_ptr_real(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging |
|---|
| 412 | ENDDO |
|---|
| 413 | ENDDO |
|---|
| 414 | in_sst_ptr_real(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) = & |
|---|
| 415 | in_sst_ptr(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) |
|---|
| 416 | ! CALL ESMF_FieldGetDataPointer( in_landmask_field, in_landmask_ptr, rc=rc ) |
|---|
| 417 | CALL ESMF_FieldGet( in_landmask_field, 0, in_landmask_ptr, rc=rc ) |
|---|
| 418 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 419 | CALL wrf_error_fatal ( & |
|---|
| 420 | 'could not extract land_binary_mask data from land_binary_mask field' ) |
|---|
| 421 | ENDIF |
|---|
| 422 | ALLOCATE( in_landmask_ptr_real(ims:ime,jms:jme) ) |
|---|
| 423 | WRITE( str,* ) 'compare_data, ips:ipe,jps:jpe = ', & |
|---|
| 424 | ips,':',ipe,',',jps,':',jpe, & |
|---|
| 425 | ', in_landmask_ptr(BOUNDS) = ', & |
|---|
| 426 | LBOUND(in_landmask_ptr,1),':',UBOUND(in_landmask_ptr,1),',', & |
|---|
| 427 | LBOUND(in_landmask_ptr,2),':',UBOUND(in_landmask_ptr,2) |
|---|
| 428 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 429 | DO j= jms, jme |
|---|
| 430 | DO i= ims, ime |
|---|
| 431 | in_landmask_ptr_real(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging |
|---|
| 432 | ENDDO |
|---|
| 433 | ENDDO |
|---|
| 434 | in_landmask_ptr_real(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) = & |
|---|
| 435 | in_landmask_ptr(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) |
|---|
| 436 | |
|---|
| 437 | ! compare LANDMASK... |
|---|
| 438 | landmask_ok = .TRUE. |
|---|
| 439 | ! staggered starts/ends |
|---|
| 440 | LANDMASK_COMPARE : DO j= jps , MIN( (jde-1), jpe ) |
|---|
| 441 | DO i= ips , MIN( (ide-1), ipe ) |
|---|
| 442 | IF ( file_landmask_data(i,j) /= in_landmask_ptr_real(i,j) ) THEN |
|---|
| 443 | landmask_ok = .FALSE. |
|---|
| 444 | WRITE( str , * ) 'error landmask mismatch at (i,j) = (',i,',',j, & |
|---|
| 445 | '), values are',file_landmask_data(i,j),' and ', & |
|---|
| 446 | in_landmask_ptr_real(i,j) |
|---|
| 447 | EXIT LANDMASK_COMPARE |
|---|
| 448 | ENDIF |
|---|
| 449 | ENDDO |
|---|
| 450 | ENDDO LANDMASK_COMPARE |
|---|
| 451 | IF ( landmask_ok ) THEN |
|---|
| 452 | WRITE(str,*) 'compare_data: LANDMASK compares OK' |
|---|
| 453 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 454 | ELSE |
|---|
| 455 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 456 | ENDIF |
|---|
| 457 | |
|---|
| 458 | ! compare SST... |
|---|
| 459 | sst_ok = .TRUE. |
|---|
| 460 | ! staggered starts/ends |
|---|
| 461 | SST_COMPARE : DO j= jps , MIN( (jde-1), jpe ) |
|---|
| 462 | DO i= ips , MIN( (ide-1), ipe ) |
|---|
| 463 | IF ( file_sst_data(i,j) /= in_sst_ptr_real(i,j) ) THEN |
|---|
| 464 | sst_ok = .FALSE. |
|---|
| 465 | WRITE( str , * ) 'error sst mismatch at (i,j) = (',i,',',j, & |
|---|
| 466 | '), values are',file_sst_data(i,j),' and ', & |
|---|
| 467 | in_sst_ptr_real(i,j) |
|---|
| 468 | EXIT SST_COMPARE |
|---|
| 469 | ENDIF |
|---|
| 470 | ENDDO |
|---|
| 471 | ENDDO SST_COMPARE |
|---|
| 472 | IF ( sst_ok ) THEN |
|---|
| 473 | WRITE(str,*) 'compare_data: SST compares OK' |
|---|
| 474 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 475 | ELSE |
|---|
| 476 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 477 | ENDIF |
|---|
| 478 | |
|---|
| 479 | DEALLOCATE( in_sst_ptr_real, in_landmask_ptr_real ) |
|---|
| 480 | |
|---|
| 481 | WRITE(str,*) 'compare_data: end, numtimes = ',numtimes |
|---|
| 482 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 483 | |
|---|
| 484 | END SUBROUTINE compare_data |
|---|
| 485 | |
|---|
| 486 | ! Second-phase "init" gets decomposition information from |
|---|
| 487 | ! importState. |
|---|
| 488 | SUBROUTINE sst_component_init2( gcomp, importState, exportState, clock, rc ) |
|---|
| 489 | USE module_metadatautils, ONLY: GetDecompFromState |
|---|
| 490 | USE module_io |
|---|
| 491 | TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp |
|---|
| 492 | TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState |
|---|
| 493 | TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState |
|---|
| 494 | TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock |
|---|
| 495 | INTEGER, INTENT( OUT) :: rc |
|---|
| 496 | !<DESCRIPTION> |
|---|
| 497 | ! SST component init routine, phase 2. |
|---|
| 498 | ! |
|---|
| 499 | ! The arguments are: |
|---|
| 500 | ! gcomp Component |
|---|
| 501 | ! importState Importstate |
|---|
| 502 | ! exportState Exportstate |
|---|
| 503 | ! clock External clock |
|---|
| 504 | ! rc Return code; equals ESMF_SUCCESS if there are no errors, |
|---|
| 505 | ! otherwise ESMF_FAILURE. |
|---|
| 506 | !</DESCRIPTION> |
|---|
| 507 | |
|---|
| 508 | ! Local variables |
|---|
| 509 | TYPE(ESMF_Field) :: out_sst_field, out_landmask_field |
|---|
| 510 | TYPE(ESMF_Field) :: in_sst_field, in_landmask_field |
|---|
| 511 | INTEGER, PARAMETER :: NUMDIMS=2 |
|---|
| 512 | INTEGER :: DomainStart(NUMDIMS) |
|---|
| 513 | INTEGER :: DomainEnd(NUMDIMS) |
|---|
| 514 | INTEGER :: MemoryStart(NUMDIMS) |
|---|
| 515 | INTEGER :: MemoryEnd(NUMDIMS) |
|---|
| 516 | INTEGER :: PatchStart(NUMDIMS) |
|---|
| 517 | INTEGER :: PatchEnd(NUMDIMS) |
|---|
| 518 | INTEGER :: rc, i, j |
|---|
| 519 | INTEGER :: ierr |
|---|
| 520 | |
|---|
| 521 | ! Get decomposition information from importState. Note that index |
|---|
| 522 | ! values are for staggered dimensions, following the WRF convention. |
|---|
| 523 | !TODO: Note that this will only work for SPMD serial operation. For |
|---|
| 524 | !TODO: concurrent operation (SPMD or MPMD), we will need to create a new |
|---|
| 525 | !TODO: "domdesc" suitable for the task layout of the SST component. For |
|---|
| 526 | !TODO: MPMD serial operation, we will need to extract serialized domdesc |
|---|
| 527 | !TODO: from export state metadata and de-serialize it. Similar arguments |
|---|
| 528 | !TODO: apply to [ij][mp][se] and bdy_mask. |
|---|
| 529 | write(str,*) 'sst_component_init2: calling GetDecompFromState' |
|---|
| 530 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 531 | CALL GetDecompFromState( importState, & |
|---|
| 532 | ids, ide, jds, jde, kds, kde, & |
|---|
| 533 | ims, ime, jms, jme, kms, kme, & |
|---|
| 534 | ips, ipe, jps, jpe, kps, kpe, & |
|---|
| 535 | domdesc, bdy_mask ) |
|---|
| 536 | write(str,*) 'sst_component_init2: back from GetDecompFromState' |
|---|
| 537 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 538 | write(str,*) 'sst_component_init2: ids, ide, jds, jde, kds, kde = ', ids, ide, jds, jde, kds, kde |
|---|
| 539 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 540 | write(str,*) 'sst_component_init2: ims, ime, jms, jme, kms, kme = ', ims, ime, jms, jme, kms, kme |
|---|
| 541 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 542 | write(str,*) 'sst_component_init2: ips, ipe, jps, jpe, kps, kpe = ', ips, ipe, jps, jpe, kps, kpe |
|---|
| 543 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 544 | |
|---|
| 545 | ! allocate space for data read from disk |
|---|
| 546 | ALLOCATE( file_sst_data (ims:ime,jms:jme) ) |
|---|
| 547 | DO j= jms, jme |
|---|
| 548 | DO i= ims, ime |
|---|
| 549 | file_sst_data(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging |
|---|
| 550 | ENDDO |
|---|
| 551 | ENDDO |
|---|
| 552 | !TODO: Hmmm... really need to load these pointers here? Check... |
|---|
| 553 | this_data(SST_INDX)%r2d => file_sst_data |
|---|
| 554 | ALLOCATE( file_landmask_data(ims:ime,jms:jme) ) |
|---|
| 555 | DO j= jms, jme |
|---|
| 556 | DO i= ims, ime |
|---|
| 557 | file_landmask_data(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging |
|---|
| 558 | ENDDO |
|---|
| 559 | ENDDO |
|---|
| 560 | this_data(LANDMASK_INDX)%r2d => file_landmask_data |
|---|
| 561 | |
|---|
| 562 | ! Create ESMF_Fields in importState and exportState |
|---|
| 563 | ! Create ESMF_Grid. Use exactly the same method as WRF so WRFIO will |
|---|
| 564 | ! work. |
|---|
| 565 | DomainStart(1) = ids; DomainEnd(1) = ide; |
|---|
| 566 | DomainStart(2) = jds; DomainEnd(2) = jde; |
|---|
| 567 | MemoryStart(1) = ims; MemoryEnd(1) = ime; |
|---|
| 568 | MemoryStart(2) = jms; MemoryEnd(2) = jme; |
|---|
| 569 | PatchStart(1) = ips; PatchEnd(1) = ipe; |
|---|
| 570 | PatchStart(2) = jps; PatchEnd(2) = jpe |
|---|
| 571 | !write(0,*)__FILE__,__LINE__,'DomainStart ',DomainStart(1:2) |
|---|
| 572 | !write(0,*)__FILE__,__LINE__,'DomainEnd ',DomainEnd(1:2) |
|---|
| 573 | !write(0,*)__FILE__,__LINE__,'MemoryStart ',MemoryStart(1:2) |
|---|
| 574 | !write(0,*)__FILE__,__LINE__,'MemoryEnd ',MemoryEnd(1:2) |
|---|
| 575 | !write(0,*)__FILE__,__LINE__,'PatchStart ',PatchStart(1:2) |
|---|
| 576 | !write(0,*)__FILE__,__LINE__,'PatchEnd ',PatchEnd(1:2) |
|---|
| 577 | CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: Calling ioesmf_create_grid_int()' ) |
|---|
| 578 | CALL ioesmf_create_grid_int( esmfgrid, NUMDIMS, & |
|---|
| 579 | DomainStart, DomainEnd, & |
|---|
| 580 | MemoryStart, MemoryEnd, & |
|---|
| 581 | PatchStart, PatchEnd ) |
|---|
| 582 | !write(0,*)__FILE__,__LINE__ |
|---|
| 583 | CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: back from ioesmf_create_grid_int()' ) |
|---|
| 584 | ! create ESMF_Fields |
|---|
| 585 | ! Note use of patch dimension for POINTERs allocated by ESMF. |
|---|
| 586 | CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: Calling ESMF_GridValidate(esmfgrid)' ) |
|---|
| 587 | CALL ESMF_GridValidate( esmfgrid, rc=rc ) |
|---|
| 588 | !write(0,*)__FILE__,__LINE__ |
|---|
| 589 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 590 | WRITE( str,* ) 'Error in ESMF_GridValidate ', & |
|---|
| 591 | __FILE__ , & |
|---|
| 592 | ', line ', & |
|---|
| 593 | __LINE__ , & |
|---|
| 594 | ', error code = ',rc |
|---|
| 595 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 596 | ENDIF |
|---|
| 597 | CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: back OK from ESMF_GridValidate(esmfgrid)' ) |
|---|
| 598 | !TODO: Once new ESMF 3.0 interfaces have settled down, eliminate "tmp_data_" |
|---|
| 599 | !TODO: arrays and let ESMF allocate/deallocate them. Assuming of course that |
|---|
| 600 | !TODO: we can convince ESMF to deallocate safely... |
|---|
| 601 | !write(0,*)__FILE__,__LINE__ |
|---|
| 602 | ALLOCATE( tmp_data_out_sst(ips:ipe,jps:jpe) ) |
|---|
| 603 | !write(0,*)__FILE__,__LINE__ |
|---|
| 604 | write(str,*) 'sst_component_init2: tmp_data_out_sst(', & |
|---|
| 605 | LBOUND(tmp_data_out_sst,1),':',UBOUND(tmp_data_out_sst,1),',',LBOUND(tmp_data_out_sst,2),':',UBOUND(tmp_data_out_sst,2),')' |
|---|
| 606 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 607 | CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(out_sst_field)' ) |
|---|
| 608 | !write(0,*)__FILE__,__LINE__,trim(datanames(sst_indx)) |
|---|
| 609 | !write(0,*)__FILE__,__LINE__,ips,jps,ipe,jpe |
|---|
| 610 | out_sst_field = ESMF_FieldCreate( & |
|---|
| 611 | esmfgrid, tmp_data_out_sst, & |
|---|
| 612 | copyflag=ESMF_DATA_REF, & |
|---|
| 613 | staggerloc=ESMF_STAGGERLOC_CENTER, & |
|---|
| 614 | name=TRIM(datanames(SST_INDX)), & |
|---|
| 615 | rc=rc ) |
|---|
| 616 | !write(0,*)__FILE__,__LINE__,'Creating out_sst_field for exportState of SST component name ',TRIM(datanames(SST_INDX)) |
|---|
| 617 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 618 | WRITE( str,* ) 'ESMF_FieldCreate(out_sst_field) failed ', & |
|---|
| 619 | __FILE__ , & |
|---|
| 620 | ', line ', & |
|---|
| 621 | __LINE__ , & |
|---|
| 622 | ', error code = ',rc |
|---|
| 623 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 624 | ENDIF |
|---|
| 625 | CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(out_sst_field)' ) |
|---|
| 626 | write(str,*) 'sst_component_init2: ips:ipe,jps:jpe = ', & |
|---|
| 627 | ips,':',ipe,',',jps,':',jpe |
|---|
| 628 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 629 | !TODO: This bit will be useful once ESMF handles allocation/deallocation. |
|---|
| 630 | ! validate ESMF allocation |
|---|
| 631 | IF ( ( ips /= LBOUND(tmp_data_out_sst,1) ) .OR. ( ipe /= UBOUND(tmp_data_out_sst,1) ) .OR. & |
|---|
| 632 | ( jps /= LBOUND(tmp_data_out_sst,2) ) .OR. ( jpe /= UBOUND(tmp_data_out_sst,2) ) ) THEN |
|---|
| 633 | WRITE( str,* ) 'ESMF_FieldCreate(out_sst_field) allocation failed ', & |
|---|
| 634 | __FILE__ , & |
|---|
| 635 | ', line ', & |
|---|
| 636 | __LINE__ , & |
|---|
| 637 | ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, & |
|---|
| 638 | ', tmp_data_out_sst(BOUNDS) = ',LBOUND(tmp_data_out_sst,1),':',UBOUND(tmp_data_out_sst,1),',', & |
|---|
| 639 | LBOUND(tmp_data_out_sst,2),':',UBOUND(tmp_data_out_sst,2) |
|---|
| 640 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 641 | ENDIF |
|---|
| 642 | ALLOCATE( tmp_data_out_landmask(ips:ipe,jps:jpe) ) |
|---|
| 643 | write(str,*) 'sst_component_init2: tmp_data_out_landmask(', & |
|---|
| 644 | LBOUND(tmp_data_out_landmask,1),':',UBOUND(tmp_data_out_landmask,1),',',LBOUND(tmp_data_out_landmask,2),':',UBOUND(tmp_data_out_landmask,2),')' |
|---|
| 645 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 646 | CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(out_landmask_field)' ) |
|---|
| 647 | out_landmask_field = ESMF_FieldCreate( & |
|---|
| 648 | esmfgrid, tmp_data_out_landmask, & |
|---|
| 649 | copyflag=ESMF_DATA_REF, & |
|---|
| 650 | staggerloc=ESMF_STAGGERLOC_CENTER, & |
|---|
| 651 | name=TRIM(datanames(LANDMASK_INDX)), & |
|---|
| 652 | ! lbounds=(/ips,jps/), & |
|---|
| 653 | ! ubounds=(/ipe,jpe/), & |
|---|
| 654 | rc=rc ) |
|---|
| 655 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 656 | CALL wrf_error_fatal ( 'ESMF_FieldCreate(out_landmask_field) failed' ) |
|---|
| 657 | ENDIF |
|---|
| 658 | CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(out_landmask_field)' ) |
|---|
| 659 | !TODO: This bit will be useful once ESMF handles allocation/deallocation. |
|---|
| 660 | ! validate ESMF allocation |
|---|
| 661 | IF ( ( ips /= LBOUND(tmp_data_out_landmask,1) ) .OR. ( ipe /= UBOUND(tmp_data_out_landmask,1) ) .OR. & |
|---|
| 662 | ( jps /= LBOUND(tmp_data_out_landmask,2) ) .OR. ( jpe /= UBOUND(tmp_data_out_landmask,2) ) ) THEN |
|---|
| 663 | WRITE( str,* ) 'ESMF_FieldCreate(out_landmask_field) allocation failed ', & |
|---|
| 664 | __FILE__ , & |
|---|
| 665 | ', line ', & |
|---|
| 666 | __LINE__ , & |
|---|
| 667 | ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, & |
|---|
| 668 | ', tmp_data_out_landmask(BOUNDS) = ',LBOUND(tmp_data_out_landmask,1),':',UBOUND(tmp_data_out_landmask,1),',', & |
|---|
| 669 | LBOUND(tmp_data_out_landmask,2),':',UBOUND(tmp_data_out_landmask,2) |
|---|
| 670 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 671 | ENDIF |
|---|
| 672 | ALLOCATE( tmp_data_in_sst(ips:ipe,jps:jpe) ) |
|---|
| 673 | write(str,*) 'sst_component_init2: tmp_data_in_sst(', & |
|---|
| 674 | LBOUND(tmp_data_in_sst,1),':',UBOUND(tmp_data_in_sst,1),',',LBOUND(tmp_data_in_sst,2),':',UBOUND(tmp_data_in_sst,2),')' |
|---|
| 675 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 676 | CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(in_sst_field)' ) |
|---|
| 677 | in_sst_field = ESMF_FieldCreate( & |
|---|
| 678 | esmfgrid, tmp_data_in_sst, & |
|---|
| 679 | copyflag=ESMF_DATA_REF, & |
|---|
| 680 | staggerloc=ESMF_STAGGERLOC_CENTER, & |
|---|
| 681 | name=TRIM(datanames(SST_INDX)), & |
|---|
| 682 | ! lbounds=(/ips,jps/), & |
|---|
| 683 | ! ubounds=(/ipe,jpe/), & |
|---|
| 684 | rc=rc ) |
|---|
| 685 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 686 | CALL wrf_error_fatal ( 'ESMF_FieldCreate(in_sst_field) failed' ) |
|---|
| 687 | ENDIF |
|---|
| 688 | CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(in_sst_field)' ) |
|---|
| 689 | !TODO: This bit will be useful once ESMF handles allocation/deallocation. |
|---|
| 690 | ! validate ESMF allocation |
|---|
| 691 | IF ( ( ips /= LBOUND(tmp_data_in_sst,1) ) .OR. ( ipe /= UBOUND(tmp_data_in_sst,1) ) .OR. & |
|---|
| 692 | ( jps /= LBOUND(tmp_data_in_sst,2) ) .OR. ( jpe /= UBOUND(tmp_data_in_sst,2) ) ) THEN |
|---|
| 693 | WRITE( str,* ) 'ESMF_FieldCreate(in_sst_field) allocation failed ', & |
|---|
| 694 | __FILE__ , & |
|---|
| 695 | ', line ', & |
|---|
| 696 | __LINE__ , & |
|---|
| 697 | ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, & |
|---|
| 698 | ', tmp_data_in_sst(BOUNDS) = ',LBOUND(tmp_data_in_sst,1),':',UBOUND(tmp_data_in_sst,1),',', & |
|---|
| 699 | LBOUND(tmp_data_in_sst,2),':',UBOUND(tmp_data_in_sst,2) |
|---|
| 700 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 701 | ENDIF |
|---|
| 702 | ALLOCATE( tmp_data_in_landmask(ips:ipe,jps:jpe) ) |
|---|
| 703 | write(str,*) 'sst_component_init2: tmp_data_in_landmask(', & |
|---|
| 704 | LBOUND(tmp_data_in_landmask,1),':',UBOUND(tmp_data_in_landmask,1),',',LBOUND(tmp_data_in_landmask,2),':',UBOUND(tmp_data_in_landmask,2),')' |
|---|
| 705 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 706 | CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(in_landmask_field)' ) |
|---|
| 707 | in_landmask_field = ESMF_FieldCreate( & |
|---|
| 708 | esmfgrid, tmp_data_in_landmask, & |
|---|
| 709 | copyflag=ESMF_DATA_REF, & |
|---|
| 710 | staggerloc=ESMF_STAGGERLOC_CENTER, & |
|---|
| 711 | name=TRIM(datanames(LANDMASK_INDX)), & |
|---|
| 712 | ! lbounds=(/ips,jps/), & |
|---|
| 713 | ! ubounds=(/ipe,jpe/), & |
|---|
| 714 | rc=rc ) |
|---|
| 715 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 716 | CALL wrf_error_fatal ( 'ESMF_FieldCreate(in_landmask_field) failed' ) |
|---|
| 717 | ENDIF |
|---|
| 718 | CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(in_landmask_field)' ) |
|---|
| 719 | !TODO: This bit will be useful once ESMF handles allocation/deallocation. |
|---|
| 720 | ! validate ESMF allocation |
|---|
| 721 | IF ( ( ips /= LBOUND(tmp_data_in_landmask,1) ) .OR. ( ipe /= UBOUND(tmp_data_in_landmask,1) ) .OR. & |
|---|
| 722 | ( jps /= LBOUND(tmp_data_in_landmask,2) ) .OR. ( jpe /= UBOUND(tmp_data_in_landmask,2) ) ) THEN |
|---|
| 723 | WRITE( str,* ) 'ESMF_FieldCreate(in_landmask_field) allocation failed ', & |
|---|
| 724 | __FILE__ , & |
|---|
| 725 | ', line ', & |
|---|
| 726 | __LINE__ , & |
|---|
| 727 | ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, & |
|---|
| 728 | ', tmp_data_in_landmask(BOUNDS) = ',LBOUND(tmp_data_in_landmask,1),':',UBOUND(tmp_data_in_landmask,1),',', & |
|---|
| 729 | LBOUND(tmp_data_in_landmask,2),':',UBOUND(tmp_data_in_landmask,2) |
|---|
| 730 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 731 | ENDIF |
|---|
| 732 | |
|---|
| 733 | ! attach ESMF_Field to importState |
|---|
| 734 | CALL ESMF_StateAdd( importState, in_sst_field, rc=rc ) |
|---|
| 735 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 736 | CALL wrf_error_fatal ( 'ESMF_StateAdd(in_sst_field) failed' ) |
|---|
| 737 | ENDIF |
|---|
| 738 | CALL ESMF_StateAdd( importState, in_landmask_field, rc=rc ) |
|---|
| 739 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 740 | CALL wrf_error_fatal ( 'ESMF_StateAdd(in_landmask_field) failed' ) |
|---|
| 741 | ENDIF |
|---|
| 742 | ! attach ESMF_Field to exportState |
|---|
| 743 | CALL ESMF_StateAdd( exportState, out_sst_field, rc=rc ) |
|---|
| 744 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 745 | CALL wrf_error_fatal ( 'ESMF_StateAdd(out_sst_field) failed' ) |
|---|
| 746 | ENDIF |
|---|
| 747 | CALL ESMF_StateAdd( exportState, out_landmask_field, rc=rc ) |
|---|
| 748 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 749 | CALL wrf_error_fatal ( 'ESMF_StateAdd(out_landmask_field) failed' ) |
|---|
| 750 | ENDIF |
|---|
| 751 | |
|---|
| 752 | ! Open the "SST" input data file for reading. |
|---|
| 753 | write(str,'(A,A)') 'sst_component_init2: Opening data file ', & |
|---|
| 754 | TRIM(sstinfilename) |
|---|
| 755 | CALL wrf_message ( TRIM(str) ) |
|---|
| 756 | CALL wrf_open_for_read ( TRIM(sstinfilename) , & |
|---|
| 757 | mpicom , & |
|---|
| 758 | mpicom , & |
|---|
| 759 | "DATASET=INPUT" , & |
|---|
| 760 | fid , & |
|---|
| 761 | ierr ) |
|---|
| 762 | IF ( ierr .NE. 0 ) THEN |
|---|
| 763 | WRITE( str , FMT='(A,A,A,I8)' ) & |
|---|
| 764 | 'sst_component_init2: error opening ', & |
|---|
| 765 | TRIM(sstinfilename),' for reading ierr=',ierr |
|---|
| 766 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 767 | ENDIF |
|---|
| 768 | WRITE( str , FMT='(A,A,A,I8)' ) & |
|---|
| 769 | 'subroutine sst_component_init2: opened file ', & |
|---|
| 770 | TRIM(sstinfilename),' for reading fid=',fid |
|---|
| 771 | CALL wrf_debug ( 100, TRIM(str) ) |
|---|
| 772 | |
|---|
| 773 | write(str,'(A)') 'sst_component_init2: returning rc=ESMF_SUCCESS' |
|---|
| 774 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 775 | |
|---|
| 776 | rc = ESMF_SUCCESS |
|---|
| 777 | |
|---|
| 778 | END SUBROUTINE sst_component_init2 |
|---|
| 779 | |
|---|
| 780 | |
|---|
| 781 | |
|---|
| 782 | SUBROUTINE sst_component_run1( gcomp, importState, exportState, clock, rc ) |
|---|
| 783 | TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp |
|---|
| 784 | TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState |
|---|
| 785 | TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock |
|---|
| 786 | INTEGER, INTENT( OUT) :: rc |
|---|
| 787 | !<DESCRIPTION> |
|---|
| 788 | ! SST component run routine, phase 1. |
|---|
| 789 | ! Read "SST" data from file and stuff into exportState. |
|---|
| 790 | ! |
|---|
| 791 | ! The arguments are: |
|---|
| 792 | ! gcomp Component |
|---|
| 793 | ! importState Importstate |
|---|
| 794 | ! exportState Exportstate |
|---|
| 795 | ! clock External clock |
|---|
| 796 | ! rc Return code; equals ESMF_SUCCESS if there are no errors, |
|---|
| 797 | ! otherwise ESMF_FAILURE. |
|---|
| 798 | !</DESCRIPTION> |
|---|
| 799 | |
|---|
| 800 | rc = ESMF_SUCCESS |
|---|
| 801 | |
|---|
| 802 | ! Get "SST" data from file and stuff it into exportState. |
|---|
| 803 | CALL read_data( exportState, clock ) |
|---|
| 804 | |
|---|
| 805 | END SUBROUTINE sst_component_run1 |
|---|
| 806 | |
|---|
| 807 | |
|---|
| 808 | |
|---|
| 809 | SUBROUTINE sst_component_run2( gcomp, importState, exportState, clock, rc ) |
|---|
| 810 | TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp |
|---|
| 811 | TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState |
|---|
| 812 | TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock |
|---|
| 813 | INTEGER, INTENT( OUT) :: rc |
|---|
| 814 | !<DESCRIPTION> |
|---|
| 815 | ! SST component run routine, phase 2. |
|---|
| 816 | ! Get from importState, compare with file data, and error-exit |
|---|
| 817 | ! if they differ... If they are the same, then |
|---|
| 818 | ! stuff the file data into the exportState. |
|---|
| 819 | ! |
|---|
| 820 | ! The arguments are: |
|---|
| 821 | ! gcomp Component |
|---|
| 822 | ! importState Importstate |
|---|
| 823 | ! exportState Exportstate |
|---|
| 824 | ! clock External clock |
|---|
| 825 | ! rc Return code; equals ESMF_SUCCESS if there are no errors, |
|---|
| 826 | ! otherwise ESMF_FAILURE. |
|---|
| 827 | !</DESCRIPTION> |
|---|
| 828 | |
|---|
| 829 | rc = ESMF_SUCCESS |
|---|
| 830 | |
|---|
| 831 | ! Get from importState, compare with file data, and error_exit |
|---|
| 832 | ! if they differ... |
|---|
| 833 | !TODO: change this once WRF can load exportState after integrating |
|---|
| 834 | ! This works because WRF loads its exportState BEFORE integrating. |
|---|
| 835 | CALL wrf_clockprint ( 50, clock, 'sst_component_run2: clock before call to compare_data()' ) |
|---|
| 836 | CALL compare_data( importState, clock ) |
|---|
| 837 | CALL wrf_clockprint ( 50, clock, 'sst_component_run2: clock after call to compare_data()' ) |
|---|
| 838 | |
|---|
| 839 | END SUBROUTINE sst_component_run2 |
|---|
| 840 | |
|---|
| 841 | |
|---|
| 842 | |
|---|
| 843 | SUBROUTINE sst_component_finalize( gcomp, importState, exportState, clock, rc ) |
|---|
| 844 | USE module_io |
|---|
| 845 | TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp |
|---|
| 846 | TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState |
|---|
| 847 | TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock |
|---|
| 848 | INTEGER, INTENT( OUT) :: rc |
|---|
| 849 | !<DESCRIPTION> |
|---|
| 850 | ! SST component finalize routine. |
|---|
| 851 | ! |
|---|
| 852 | ! The arguments are: |
|---|
| 853 | ! gcomp Component |
|---|
| 854 | ! importState Importstate |
|---|
| 855 | ! exportState Exportstate |
|---|
| 856 | ! clock External clock |
|---|
| 857 | ! rc Return code; equals ESMF_SUCCESS if there are no errors, |
|---|
| 858 | ! otherwise ESMF_FAILURE. |
|---|
| 859 | !</DESCRIPTION> |
|---|
| 860 | |
|---|
| 861 | ! Local variables |
|---|
| 862 | TYPE(ESMF_Field) :: tmp_field |
|---|
| 863 | INTEGER :: i, ierr |
|---|
| 864 | |
|---|
| 865 | rc = ESMF_SUCCESS |
|---|
| 866 | |
|---|
| 867 | ! destroy ESMF_Fields and other "deep" objects created by this component |
|---|
| 868 | ! note that this component relied on ESMF to allocate data pointers during |
|---|
| 869 | ! calls to ESMF_FieldCreate() so it also expects ESMF to free these pointers |
|---|
| 870 | DO i=1, datacount |
|---|
| 871 | ! destroy field in importState |
|---|
| 872 | CALL ESMF_StateGet( importState, TRIM(datanames(i)), tmp_field, & |
|---|
| 873 | rc=rc ) |
|---|
| 874 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 875 | WRITE( str , * ) & |
|---|
| 876 | 'sst_component_finalize: ESMF_StateGet( importState,', & |
|---|
| 877 | TRIM(datanames(i)),') failed' |
|---|
| 878 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 879 | ENDIF |
|---|
| 880 | CALL ESMF_FieldDestroy( tmp_field, rc=rc ) |
|---|
| 881 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 882 | WRITE( str , * ) & |
|---|
| 883 | 'sst_component_finalize: ESMF_FieldDestroy( importState,', & |
|---|
| 884 | TRIM(datanames(i)),') failed' |
|---|
| 885 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 886 | ENDIF |
|---|
| 887 | ! destroy field in exportState |
|---|
| 888 | CALL ESMF_StateGet( exportState, TRIM(datanames(i)), tmp_field, & |
|---|
| 889 | rc=rc ) |
|---|
| 890 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 891 | WRITE( str , * ) & |
|---|
| 892 | 'sst_component_finalize: ESMF_StateGet( exportState,', & |
|---|
| 893 | TRIM(datanames(i)),') failed' |
|---|
| 894 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 895 | ENDIF |
|---|
| 896 | CALL ESMF_FieldDestroy( tmp_field, rc=rc ) |
|---|
| 897 | IF (rc /= ESMF_SUCCESS) THEN |
|---|
| 898 | WRITE( str , * ) & |
|---|
| 899 | 'sst_component_finalize: ESMF_FieldDestroy( exportState,', & |
|---|
| 900 | TRIM(datanames(i)),') failed' |
|---|
| 901 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 902 | ENDIF |
|---|
| 903 | ENDDO |
|---|
| 904 | |
|---|
| 905 | ! deallocate space for data read from disk |
|---|
| 906 | DEALLOCATE( file_sst_data, file_landmask_data ) |
|---|
| 907 | |
|---|
| 908 | ! close SST data file |
|---|
| 909 | WRITE( str , FMT='(A,I8)' ) & |
|---|
| 910 | 'subroutine sst_component_finalize: closing file fid=',fid |
|---|
| 911 | CALL wrf_debug ( 100, TRIM(str) ) |
|---|
| 912 | CALL wrf_ioclose( fid , ierr ) |
|---|
| 913 | IF ( ierr .NE. 0 ) THEN |
|---|
| 914 | CALL wrf_error_fatal ( 'sst_component_finalize: wrf_ioclose failed' ) |
|---|
| 915 | ENDIF |
|---|
| 916 | |
|---|
| 917 | END SUBROUTINE sst_component_finalize |
|---|
| 918 | |
|---|
| 919 | |
|---|
| 920 | END MODULE module_sst_component_top |
|---|
| 921 | |
|---|
| 922 | |
|---|
| 923 | |
|---|
| 924 | |
|---|
| 925 | MODULE module_sst_setservices |
|---|
| 926 | !<DESCRIPTION> |
|---|
| 927 | ! This module defines SST "Set Services" method sst_register() |
|---|
| 928 | ! used for ESMF coupling. |
|---|
| 929 | !</DESCRIPTION> |
|---|
| 930 | |
|---|
| 931 | USE module_sst_component_top, ONLY: sst_component_init1, & |
|---|
| 932 | sst_component_init2, & |
|---|
| 933 | sst_component_run1, & |
|---|
| 934 | sst_component_run2, & |
|---|
| 935 | sst_component_finalize |
|---|
| 936 | USE ESMF_Mod |
|---|
| 937 | |
|---|
| 938 | IMPLICIT NONE |
|---|
| 939 | |
|---|
| 940 | ! everything is private by default |
|---|
| 941 | PRIVATE |
|---|
| 942 | |
|---|
| 943 | ! Public entry point for ESMF_GridCompSetServices() |
|---|
| 944 | PUBLIC SST_register |
|---|
| 945 | |
|---|
| 946 | ! private stuff |
|---|
| 947 | CHARACTER (ESMF_MAXSTR) :: str |
|---|
| 948 | |
|---|
| 949 | CONTAINS |
|---|
| 950 | |
|---|
| 951 | |
|---|
| 952 | SUBROUTINE sst_register(gcomp, rc) |
|---|
| 953 | TYPE(ESMF_GridComp), INTENT(INOUT) :: gcomp |
|---|
| 954 | INTEGER, INTENT(OUT) :: rc |
|---|
| 955 | INTEGER :: finalrc |
|---|
| 956 | ! |
|---|
| 957 | !<DESCRIPTION> |
|---|
| 958 | ! SST_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 | ! gcomp Component |
|---|
| 967 | ! rc Return code; equals ESMF_SUCCESS if there are no errors, |
|---|
| 968 | ! otherwise ESMF_FAILURE. |
|---|
| 969 | !</DESCRIPTION> |
|---|
| 970 | |
|---|
| 971 | finalrc = ESMF_SUCCESS |
|---|
| 972 | ! Register the callback routines. |
|---|
| 973 | call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, & |
|---|
| 974 | sst_component_init1, 1, rc) |
|---|
| 975 | IF ( rc /= ESMF_SUCCESS) THEN |
|---|
| 976 | WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_init1) failed with rc = ', rc |
|---|
| 977 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 978 | ENDIF |
|---|
| 979 | call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, & |
|---|
| 980 | sst_component_init2, 2, rc) |
|---|
| 981 | IF ( rc /= ESMF_SUCCESS) THEN |
|---|
| 982 | WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_init2) failed with rc = ', rc |
|---|
| 983 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 984 | ENDIF |
|---|
| 985 | call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETRUN, & |
|---|
| 986 | sst_component_run1, 1, rc) |
|---|
| 987 | IF ( rc /= ESMF_SUCCESS) THEN |
|---|
| 988 | WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_run1) failed with rc = ', rc |
|---|
| 989 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 990 | ENDIF |
|---|
| 991 | call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETRUN, & |
|---|
| 992 | sst_component_run2, 2, rc) |
|---|
| 993 | IF ( rc /= ESMF_SUCCESS) THEN |
|---|
| 994 | WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_run2) failed with rc = ', rc |
|---|
| 995 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 996 | ENDIF |
|---|
| 997 | call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETFINAL, & |
|---|
| 998 | sst_component_finalize, ESMF_SINGLEPHASE, rc) |
|---|
| 999 | IF ( rc /= ESMF_SUCCESS) THEN |
|---|
| 1000 | WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_finalize) failed with rc = ', rc |
|---|
| 1001 | CALL wrf_error_fatal ( TRIM(str) ) |
|---|
| 1002 | ENDIF |
|---|
| 1003 | |
|---|
| 1004 | PRINT *,'SST: Registered Initialize, Run, and Finalize routines' |
|---|
| 1005 | |
|---|
| 1006 | rc = finalrc |
|---|
| 1007 | |
|---|
| 1008 | END SUBROUTINE sst_register |
|---|
| 1009 | |
|---|
| 1010 | END MODULE module_sst_setservices |
|---|
| 1011 | |
|---|
| 1012 | |
|---|
| 1013 | |
|---|
| 1014 | !<DESCRIPTION> |
|---|
| 1015 | ! Module module_wrfsst_coupler defines the |
|---|
| 1016 | ! "WRF-SST" coupler component. It provides two-way coupling between |
|---|
| 1017 | ! the "SST" and "WRF" components. |
|---|
| 1018 | ! In its run routine it transfers data directly from the |
|---|
| 1019 | ! SST Component's export state to the WRF Component's import state. |
|---|
| 1020 | ! It also transfers data directly from the |
|---|
| 1021 | ! WRF Component's export state to the SST Component's import state. |
|---|
| 1022 | ! |
|---|
| 1023 | ! This is derived from src/demo/coupled_flow/src/CouplerMod.F90 |
|---|
| 1024 | ! created by Nancy Collins and others on the ESMF Core Team. |
|---|
| 1025 | ! |
|---|
| 1026 | !</DESCRIPTION> |
|---|
| 1027 | |
|---|
| 1028 | MODULE module_wrfsst_coupler |
|---|
| 1029 | |
|---|
| 1030 | USE ESMF_Mod |
|---|
| 1031 | |
|---|
| 1032 | IMPLICIT NONE |
|---|
| 1033 | |
|---|
| 1034 | ! everything is private by default |
|---|
| 1035 | PRIVATE |
|---|
| 1036 | |
|---|
| 1037 | ! Public entry point |
|---|
| 1038 | PUBLIC WRFSSTCpl_register |
|---|
| 1039 | |
|---|
| 1040 | ! private data members |
|---|
| 1041 | ! route handles and flags |
|---|
| 1042 | TYPE(ESMF_RouteHandle), SAVE :: fromWRF_rh, fromSST_rh |
|---|
| 1043 | LOGICAL, SAVE :: fromWRF_rh_ready = .FALSE. |
|---|
| 1044 | LOGICAL, SAVE :: fromSST_rh_ready = .FALSE. |
|---|
| 1045 | ! field names |
|---|
| 1046 | INTEGER, PARAMETER :: datacount = 2 |
|---|
| 1047 | INTEGER, PARAMETER :: SST_INDX = 1 |
|---|
| 1048 | INTEGER, PARAMETER :: LANDMASK_INDX = 2 |
|---|
| 1049 | CHARACTER(LEN=ESMF_MAXSTR), SAVE :: datanames(datacount) |
|---|
| 1050 | CHARACTER(LEN=ESMF_MAXSTR) :: str |
|---|
| 1051 | |
|---|
| 1052 | |
|---|
| 1053 | CONTAINS |
|---|
| 1054 | |
|---|
| 1055 | |
|---|
| 1056 | SUBROUTINE WRFSSTCpl_register(comp, rc) |
|---|
| 1057 | TYPE(ESMF_CplComp), INTENT(INOUT) :: comp |
|---|
| 1058 | INTEGER, INTENT(OUT) :: rc |
|---|
| 1059 | ! |
|---|
| 1060 | !<DESCRIPTION> |
|---|
| 1061 | ! WRFSSTCpl_register - Externally visible registration routine |
|---|
| 1062 | ! |
|---|
| 1063 | ! User-supplied SetServices routine. |
|---|
| 1064 | ! The Register routine sets the subroutines to be called |
|---|
| 1065 | ! as the init, run, and finalize routines. Note that these are |
|---|
| 1066 | ! private to the module. |
|---|
| 1067 | ! |
|---|
| 1068 | ! The arguments are: |
|---|
| 1069 | ! comp Component |
|---|
| 1070 | ! rc Return code; equals ESMF_SUCCESS if there are no errors, |
|---|
| 1071 | ! otherwise ESMF_FAILURE. |
|---|
| 1072 | !</DESCRIPTION> |
|---|
| 1073 | |
|---|
| 1074 | ! guilty until proven innocent |
|---|
| 1075 | rc = ESMF_FAILURE |
|---|
| 1076 | |
|---|
| 1077 | ! Register the callback routines. |
|---|
| 1078 | |
|---|
| 1079 | call ESMF_CplCompSetEntryPoint(comp, ESMF_SETINIT, WRFSSTCpl_init, & |
|---|
| 1080 | ESMF_SINGLEPHASE, rc) |
|---|
| 1081 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1082 | CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_init) failed' ) |
|---|
| 1083 | ENDIF |
|---|
| 1084 | call ESMF_CplCompSetEntryPoint(comp, ESMF_SETRUN, WRFSSTCpl_run, & |
|---|
| 1085 | ESMF_SINGLEPHASE, rc) |
|---|
| 1086 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1087 | CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_run) failed' ) |
|---|
| 1088 | ENDIF |
|---|
| 1089 | call ESMF_CplCompSetEntryPoint(comp, ESMF_SETFINAL, WRFSSTCpl_final, & |
|---|
| 1090 | ESMF_SINGLEPHASE, rc) |
|---|
| 1091 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1092 | CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_final) failed' ) |
|---|
| 1093 | ENDIF |
|---|
| 1094 | |
|---|
| 1095 | print *, "module_wrfsst_coupler: Registered Initialize, Run, and Finalize routines" |
|---|
| 1096 | |
|---|
| 1097 | END SUBROUTINE WRFSSTCpl_register |
|---|
| 1098 | |
|---|
| 1099 | |
|---|
| 1100 | SUBROUTINE WRFSSTCpl_init(comp, importState, exportState, clock, rc) |
|---|
| 1101 | USE module_metadatautils, ONLY: AttachDecompToState, GetDecompFromState |
|---|
| 1102 | TYPE(ESMF_CplComp), INTENT(INOUT) :: comp |
|---|
| 1103 | TYPE(ESMF_State), INTENT(INOUT) :: importState, exportState |
|---|
| 1104 | TYPE(ESMF_Clock), INTENT(INOUT) :: clock |
|---|
| 1105 | INTEGER, INTENT(OUT) :: rc |
|---|
| 1106 | !<DESCRIPTION> |
|---|
| 1107 | ! WRF-SST coupler component init routine. This simply passes needed |
|---|
| 1108 | ! metadata from WRF to SST. Initialization of ESMF_RouteHandle objects |
|---|
| 1109 | ! is handled later via lazy evaluation. |
|---|
| 1110 | ! |
|---|
| 1111 | ! The arguments are: |
|---|
| 1112 | ! comp Component |
|---|
| 1113 | ! importState Importstate |
|---|
| 1114 | ! exportState Exportstate |
|---|
| 1115 | ! clock External clock |
|---|
| 1116 | ! rc Return code; equals ESMF_SUCCESS if there are no errors, |
|---|
| 1117 | ! otherwise ESMF_FAILURE. |
|---|
| 1118 | !</DESCRIPTION> |
|---|
| 1119 | |
|---|
| 1120 | ! Local variables |
|---|
| 1121 | CHARACTER(ESMF_MAXSTR) :: importstatename |
|---|
| 1122 | ! decomposition information |
|---|
| 1123 | INTEGER :: ids, ide, jds, jde, kds, kde |
|---|
| 1124 | INTEGER :: ims, ime, jms, jme, kms, kme |
|---|
| 1125 | INTEGER :: ips, ipe, jps, jpe, kps, kpe |
|---|
| 1126 | INTEGER :: domdesc |
|---|
| 1127 | LOGICAL :: bdy_mask(4) |
|---|
| 1128 | |
|---|
| 1129 | PRINT *, "DEBUG: Coupler Init starting" |
|---|
| 1130 | |
|---|
| 1131 | ! guilty until proven innocent |
|---|
| 1132 | rc = ESMF_FAILURE |
|---|
| 1133 | |
|---|
| 1134 | CALL ESMF_StateGet(importState, name=importstatename, rc=rc) |
|---|
| 1135 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1136 | CALL wrf_error_fatal ( 'WRFSSTCpl_init: ESMF_StateGet failed' ) |
|---|
| 1137 | ENDIF |
|---|
| 1138 | |
|---|
| 1139 | IF ( TRIM(importstatename) .EQ. "WRF Export State" ) THEN |
|---|
| 1140 | ! get metadata from WRF export state |
|---|
| 1141 | CALL GetDecompFromState( importState, & |
|---|
| 1142 | ids, ide, jds, jde, kds, kde, & |
|---|
| 1143 | ims, ime, jms, jme, kms, kme, & |
|---|
| 1144 | ips, ipe, jps, jpe, kps, kpe, & |
|---|
| 1145 | domdesc, bdy_mask ) |
|---|
| 1146 | ! put metadata from in SST import state |
|---|
| 1147 | CALL AttachDecompToState( exportState, & |
|---|
| 1148 | ids, ide, jds, jde, kds, kde, & |
|---|
| 1149 | ims, ime, jms, jme, kms, kme, & |
|---|
| 1150 | ips, ipe, jps, jpe, kps, kpe, & |
|---|
| 1151 | domdesc, bdy_mask ) |
|---|
| 1152 | |
|---|
| 1153 | |
|---|
| 1154 | ELSE |
|---|
| 1155 | CALL wrf_error_fatal ( 'WRFSSTCpl_init: invalid importState name' ) |
|---|
| 1156 | ENDIF |
|---|
| 1157 | |
|---|
| 1158 | ! set up field names |
|---|
| 1159 | !TODO: use CF conventions for "standard_name" once WRF Registry supports them |
|---|
| 1160 | !TODO: datanames(SST_INDX) = "sea_surface_temperature" |
|---|
| 1161 | !TODO: datanames(LANDMASK_INDX) = "land_binary_mask" |
|---|
| 1162 | datanames(SST_INDX) = "SST" |
|---|
| 1163 | datanames(LANDMASK_INDX) = "LANDMASK" |
|---|
| 1164 | |
|---|
| 1165 | PRINT *, "DEBUG: Coupler Init returning" |
|---|
| 1166 | |
|---|
| 1167 | END SUBROUTINE WRFSSTCpl_init |
|---|
| 1168 | |
|---|
| 1169 | |
|---|
| 1170 | |
|---|
| 1171 | SUBROUTINE WRFSSTCpl_run(comp, importState, exportState, clock, rc) |
|---|
| 1172 | TYPE(ESMF_CplComp), INTENT(INOUT) :: comp |
|---|
| 1173 | TYPE(ESMF_State), INTENT(INOUT) :: importState, exportState |
|---|
| 1174 | TYPE(ESMF_Clock), INTENT(INOUT) :: clock |
|---|
| 1175 | INTEGER, INTENT(OUT) :: rc |
|---|
| 1176 | !<DESCRIPTION> |
|---|
| 1177 | ! WRF-SST coupler component run routine. |
|---|
| 1178 | ! |
|---|
| 1179 | ! The arguments are: |
|---|
| 1180 | ! comp Component |
|---|
| 1181 | ! importState Importstate |
|---|
| 1182 | ! exportState Exportstate |
|---|
| 1183 | ! clock External clock |
|---|
| 1184 | ! rc Return code; equals ESMF_SUCCESS if there are no errors, |
|---|
| 1185 | ! otherwise ESMF_FAILURE. |
|---|
| 1186 | !</DESCRIPTION> |
|---|
| 1187 | |
|---|
| 1188 | ! Note that comments in this code are preserved from the sample coupler |
|---|
| 1189 | ! provided by the ESMF core team. |
|---|
| 1190 | |
|---|
| 1191 | ! Local variables |
|---|
| 1192 | character*256 :: mename |
|---|
| 1193 | character*256 :: melist(100) |
|---|
| 1194 | integer :: mecount |
|---|
| 1195 | TYPE(ESMF_StateItemType) :: metypelist(100) |
|---|
| 1196 | TYPE(ESMF_Field) :: src_field, dst_field |
|---|
| 1197 | TYPE(ESMF_Array) :: src_array, dst_array |
|---|
| 1198 | TYPE(ESMF_RouteHandle) :: routehandle |
|---|
| 1199 | TYPE(ESMF_VM) :: vm |
|---|
| 1200 | LOGICAL :: build_fromWRF_rh, build_fromSST_rh, fromWRF |
|---|
| 1201 | CHARACTER(LEN=ESMF_MAXSTR) :: importStatename |
|---|
| 1202 | CHARACTER(LEN=ESMF_MAXSTR) :: SST_exportStatename, WRF_exportStatename |
|---|
| 1203 | INTEGER :: i |
|---|
| 1204 | CHARACTER(LEN=256) :: directionString |
|---|
| 1205 | |
|---|
| 1206 | WRITE(str,*) 'WRFSSTCpl_run: begin' |
|---|
| 1207 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1208 | |
|---|
| 1209 | ! guilty until proven innocent |
|---|
| 1210 | rc = ESMF_FAILURE |
|---|
| 1211 | |
|---|
| 1212 | ! Which way is this coupling going? |
|---|
| 1213 | WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_StateGet(importState,name,...)' |
|---|
| 1214 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1215 | CALL ESMF_StateGet( importState, name=importStatename, rc=rc ) |
|---|
| 1216 | WRITE(str,*) 'WRFSSTCpl_run: importStatename ', trim(importStatename), 'rc = ', rc |
|---|
| 1217 | CALL wrf_debug ( 100, TRIM(str) ) |
|---|
| 1218 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1219 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_StateGet(importState,name,...) failed' ) |
|---|
| 1220 | ENDIF |
|---|
| 1221 | WRITE(str,*) 'WRFSSTCpl_run: back from ESMF_StateGet, importStatename = <',TRIM(importStatename),'>' |
|---|
| 1222 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1223 | |
|---|
| 1224 | ! first time through in each direction: create route handle and |
|---|
| 1225 | ! associated objects |
|---|
| 1226 | WRF_exportStatename = "WRF Export State" |
|---|
| 1227 | SST_exportStatename = "SST Export State" |
|---|
| 1228 | IF ( TRIM(importStatename) .EQ. TRIM(WRF_exportStatename) ) THEN |
|---|
| 1229 | fromWRF = .TRUE. |
|---|
| 1230 | directionString = 'WRFtoSST' |
|---|
| 1231 | ELSE IF ( TRIM(importStatename) .EQ. TRIM(SST_exportStatename) ) THEN |
|---|
| 1232 | fromWRF = .FALSE. |
|---|
| 1233 | directionString = 'SSTtoWRF' |
|---|
| 1234 | ELSE |
|---|
| 1235 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: invalid importState name' ) |
|---|
| 1236 | ENDIF |
|---|
| 1237 | WRITE(str,*) 'WRFSSTCpl_run: fromWRF = ',fromWRF |
|---|
| 1238 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1239 | build_fromWRF_rh = fromWRF .AND. ( .NOT. fromWRF_rh_ready ) |
|---|
| 1240 | build_fromSST_rh = ( .NOT. fromWRF ) .AND. ( .NOT. fromSST_rh_ready ) |
|---|
| 1241 | WRITE(str,*) 'WRFSSTCpl_run: build_fromWRF_rh = ',build_fromWRF_rh |
|---|
| 1242 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1243 | WRITE(str,*) 'WRFSSTCpl_run: build_fromSST_rh = ',build_fromSST_rh |
|---|
| 1244 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1245 | IF ( build_fromWRF_rh .OR. build_fromSST_rh ) THEN |
|---|
| 1246 | CALL ESMF_CplCompGet( comp, vm=vm, rc=rc ) |
|---|
| 1247 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1248 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_CplCompGet failed' ) |
|---|
| 1249 | ENDIF |
|---|
| 1250 | ! The use of literal index "1" here indicates that we don't care which |
|---|
| 1251 | ! ESMF_Field we get so we might as well get the first one. |
|---|
| 1252 | WRITE(str,*) 'WRFSSTCpl_run: grabbing first field <',TRIM(datanames(1)), & |
|---|
| 1253 | '> from import state' |
|---|
| 1254 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1255 | |
|---|
| 1256 | !CALL ESMF_StateGet( importState, name=mename, itemCount=mecount, itemNameList=melist, stateitemtypelist=metypelist, rc=rc ) |
|---|
| 1257 | !write(0,*)'importState mename ',trim(mename) |
|---|
| 1258 | !write(0,*)'importState mecount ',mecount |
|---|
| 1259 | !do i = 1,mecount |
|---|
| 1260 | !write(0,*)i,trim(melist(i)) |
|---|
| 1261 | !enddo |
|---|
| 1262 | !do i = 1,mecount |
|---|
| 1263 | !write(0,*)i,metypelist(i) |
|---|
| 1264 | !enddo |
|---|
| 1265 | |
|---|
| 1266 | CALL ESMF_StateGet( importState, TRIM(datanames(1)), src_field, & |
|---|
| 1267 | rc=rc ) |
|---|
| 1268 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1269 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_StateGet(importState) failed' ) |
|---|
| 1270 | ENDIF |
|---|
| 1271 | |
|---|
| 1272 | CALL ESMF_FieldGet( src_field, array=src_array, rc=rc ) |
|---|
| 1273 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1274 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_FieldGet src_array failed' ) |
|---|
| 1275 | ENDIF |
|---|
| 1276 | WRITE(str,*) 'WRFSSTCpl_run: grabbing first field <',TRIM(datanames(1)), & |
|---|
| 1277 | '> from export state' |
|---|
| 1278 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1279 | |
|---|
| 1280 | !CALL ESMF_StateGet( exportState, name=mename, itemCount=mecount, itemNameList=melist, stateitemtypelist=metypelist, rc=rc ) |
|---|
| 1281 | !write(0,*)'Exportstate mename ',trim(mename) |
|---|
| 1282 | !write(0,*)'Exportstate mecount ',mecount |
|---|
| 1283 | !do i = 1,mecount |
|---|
| 1284 | !write(0,*)i,trim(melist(i)) |
|---|
| 1285 | !enddo |
|---|
| 1286 | !do i = 1,mecount |
|---|
| 1287 | !write(0,*)i,metypelist(i) |
|---|
| 1288 | !enddo |
|---|
| 1289 | |
|---|
| 1290 | CALL ESMF_StateGet( exportState, TRIM(datanames(1)), dst_field, & |
|---|
| 1291 | rc=rc ) |
|---|
| 1292 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1293 | WRITE(str,*)'WRFSSTCpl_run: datanames(1) ',TRIM(datanames(1)),' rc ',rc |
|---|
| 1294 | CALL wrf_message(TRIM(str)) |
|---|
| 1295 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_StateGet(exportState) failed' ) |
|---|
| 1296 | ENDIF |
|---|
| 1297 | CALL ESMF_FieldGet( dst_field, array=dst_array, & |
|---|
| 1298 | rc=rc ) |
|---|
| 1299 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1300 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_FieldGet dst_array failed' ) |
|---|
| 1301 | ENDIF |
|---|
| 1302 | |
|---|
| 1303 | |
|---|
| 1304 | IF ( build_fromWRF_rh ) THEN |
|---|
| 1305 | WRITE(str,*) 'WRFSSTCpl_run: creating fromWRF_rh' |
|---|
| 1306 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1307 | fromWRF_rh = ESMF_RouteHandleCreate( rc ) |
|---|
| 1308 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1309 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_RouteHandleCreate(fromWRF_rh) failed' ) |
|---|
| 1310 | ENDIF |
|---|
| 1311 | WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_FieldRedistStore(fromWRF_rh)' |
|---|
| 1312 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1313 | CALL ESMF_ArrayRedistStore( src_array, dst_array, & |
|---|
| 1314 | routehandle=fromWRF_rh, rc=rc ) |
|---|
| 1315 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1316 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_FieldRedistStore(fromWRF_rh) failed' ) |
|---|
| 1317 | ENDIF |
|---|
| 1318 | fromWRF_rh_ready = .TRUE. |
|---|
| 1319 | ENDIF |
|---|
| 1320 | IF ( build_fromSST_rh ) THEN |
|---|
| 1321 | WRITE(str,*) 'WRFSSTCpl_run: creating fromSST_rh' |
|---|
| 1322 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1323 | fromSST_rh = ESMF_RouteHandleCreate( rc ) |
|---|
| 1324 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1325 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_RouteHandleCreate(fromSST_rh) failed' ) |
|---|
| 1326 | ENDIF |
|---|
| 1327 | WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_FieldRedistStore(fromSST_rh)' |
|---|
| 1328 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1329 | CALL ESMF_ArrayRedistStore( src_array, dst_array, & |
|---|
| 1330 | routehandle=fromSST_rh, rc=rc ) |
|---|
| 1331 | !write(0,*)__FILE__,__LINE__,'rc = ',rc |
|---|
| 1332 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1333 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_FieldRedistStore(fromSST_rh) failed' ) |
|---|
| 1334 | ENDIF |
|---|
| 1335 | fromSST_rh_ready = .TRUE. |
|---|
| 1336 | ENDIF |
|---|
| 1337 | DO i=1, datacount |
|---|
| 1338 | WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_StateSetNeeded(importState, ',TRIM(datanames(i)),')' |
|---|
| 1339 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1340 | CALL ESMF_StateSetNeeded( importState, TRIM(datanames(i)), & |
|---|
| 1341 | ESMF_NEEDED, rc=rc ) |
|---|
| 1342 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1343 | WRITE(str,*) 'WRFSSTCpl_run: ESMF_StateSetNeeded(',TRIM(datanames(i)),') failed' |
|---|
| 1344 | CALL wrf_error_fatal ( str ) |
|---|
| 1345 | ENDIF |
|---|
| 1346 | ENDDO |
|---|
| 1347 | ENDIF |
|---|
| 1348 | |
|---|
| 1349 | ! In this case, the coupling is symmetric - you call redist going |
|---|
| 1350 | ! both ways - so we only care about the coupling direction in order |
|---|
| 1351 | ! to get the right routehandle selected. |
|---|
| 1352 | IF ( fromWRF ) THEN |
|---|
| 1353 | WRITE(str,*) 'WRFSSTCpl_run: routehandle = fromWRF_rh' |
|---|
| 1354 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1355 | routehandle = fromWRF_rh |
|---|
| 1356 | ELSE |
|---|
| 1357 | WRITE(str,*) 'WRFSSTCpl_run: routehandle = fromSST_rh' |
|---|
| 1358 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1359 | routehandle = fromSST_rh |
|---|
| 1360 | ENDIF |
|---|
| 1361 | |
|---|
| 1362 | DO i=1, datacount |
|---|
| 1363 | WRITE(str,*) 'WRFSSTCpl_run: grabbing field <',TRIM(datanames(i)),'>' |
|---|
| 1364 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1365 | ! check isneeded flag here |
|---|
| 1366 | IF ( .NOT. ESMF_StateIsNeeded( importState, TRIM(datanames(i)), rc=rc ) ) THEN |
|---|
| 1367 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1368 | WRITE(str,*) 'WRFSSTCpl_run: ESMF_StateIsNeeded(',TRIM(datanames(i)),') failed' |
|---|
| 1369 | CALL wrf_error_fatal ( str ) |
|---|
| 1370 | ENDIF |
|---|
| 1371 | WRITE(str,*) 'WRFSSTCpl_run: skipping field <',TRIM(datanames(i)),'>' |
|---|
| 1372 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1373 | CYCLE |
|---|
| 1374 | ENDIF |
|---|
| 1375 | |
|---|
| 1376 | WRITE(str,*) 'WRFSSTCpl_run: processing field <',TRIM(datanames(i)),'>' |
|---|
| 1377 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1378 | |
|---|
| 1379 | ! The following piece of code provides an example of calling the data |
|---|
| 1380 | ! redistribution routine between two Fields in the Coupler Component. |
|---|
| 1381 | ! Unlike regrid, which translates between |
|---|
| 1382 | ! different Grids, redist translates between different DELayouts on |
|---|
| 1383 | ! the same Grid. The first two lines get the Fields from the |
|---|
| 1384 | ! States, each corresponding to a different subcomponent. One is |
|---|
| 1385 | ! an Export State and the other is an Import State. |
|---|
| 1386 | ! |
|---|
| 1387 | WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_StateGet(importState,', & |
|---|
| 1388 | TRIM(datanames(i)),')...' |
|---|
| 1389 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1390 | CALL ESMF_StateGet( importState, TRIM(datanames(i)), src_field, & |
|---|
| 1391 | rc=rc ) |
|---|
| 1392 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1393 | WRITE(str,*) 'WRFSSTCpl_run: ESMF_StateGet(importState,', & |
|---|
| 1394 | TRIM(datanames(i)),') failed' |
|---|
| 1395 | CALL wrf_error_fatal ( str ) |
|---|
| 1396 | ENDIF |
|---|
| 1397 | CALL ESMF_FieldGet( src_field, array=src_array, rc=rc ) |
|---|
| 1398 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1399 | WRITE(str,*) 'WRFSSTCpl_run: ESMF_FieldGet(src_field,src_array,rc) failed' |
|---|
| 1400 | CALL wrf_error_fatal ( str ) |
|---|
| 1401 | ENDIF |
|---|
| 1402 | |
|---|
| 1403 | WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_StateGet(exportState,', & |
|---|
| 1404 | TRIM(datanames(i)),')...' |
|---|
| 1405 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1406 | CALL ESMF_StateGet( exportState, TRIM(datanames(i)), dst_field, & |
|---|
| 1407 | rc=rc ) |
|---|
| 1408 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1409 | WRITE(str,*) 'WRFSSTCpl_run: ESMF_StateGet(exportState,', & |
|---|
| 1410 | TRIM(datanames(i)),') failed' |
|---|
| 1411 | CALL wrf_error_fatal ( str ) |
|---|
| 1412 | ENDIF |
|---|
| 1413 | CALL ESMF_FieldGet( dst_field, array=dst_array, rc=rc ) |
|---|
| 1414 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1415 | WRITE(str,*) 'WRFSSTCpl_run: ESMF_FieldGet(dst_field,dst_array,rc) failed' |
|---|
| 1416 | CALL wrf_error_fatal ( str ) |
|---|
| 1417 | ENDIF |
|---|
| 1418 | |
|---|
| 1419 | ! The redist routine uses information contained in the Fields and the |
|---|
| 1420 | ! Coupler VM object to call the communication routines to move the data. |
|---|
| 1421 | ! Because many Fields may share the same Grid association, the same |
|---|
| 1422 | ! routing information may be needed repeatedly. Route information is |
|---|
| 1423 | ! saved so the precomputed information can be retained. The following |
|---|
| 1424 | ! is an example of a Field redist call: |
|---|
| 1425 | WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_FieldRedist for <', & |
|---|
| 1426 | TRIM(datanames(i)),'>...' |
|---|
| 1427 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1428 | CALL ESMF_ArrayRedist( src_array, dst_array, routehandle, rc=rc ) |
|---|
| 1429 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1430 | CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_FieldRedist failed' ) |
|---|
| 1431 | ENDIF |
|---|
| 1432 | WRITE(str,*) 'WRFSSTCpl_run: back from ESMF_FieldRedist for <', & |
|---|
| 1433 | TRIM(datanames(i)),'>...' |
|---|
| 1434 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1435 | |
|---|
| 1436 | ENDDO |
|---|
| 1437 | |
|---|
| 1438 | WRITE(str,*) 'WRFSSTCpl_run: end' |
|---|
| 1439 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1440 | |
|---|
| 1441 | END SUBROUTINE WRFSSTCpl_run |
|---|
| 1442 | |
|---|
| 1443 | |
|---|
| 1444 | |
|---|
| 1445 | SUBROUTINE WRFSSTCpl_final(comp, importState, exportState, clock, rc) |
|---|
| 1446 | TYPE(ESMF_CplComp) :: comp |
|---|
| 1447 | TYPE(ESMF_State), INTENT(INOUT) :: importState, exportState |
|---|
| 1448 | TYPE(ESMF_Clock), INTENT(INOUT) :: clock |
|---|
| 1449 | INTEGER, INTENT(OUT) :: rc |
|---|
| 1450 | !<DESCRIPTION> |
|---|
| 1451 | ! WRF-SST coupler component finalize routine. |
|---|
| 1452 | ! |
|---|
| 1453 | ! The arguments are: |
|---|
| 1454 | ! comp Component |
|---|
| 1455 | ! importState Importstate |
|---|
| 1456 | ! exportState Exportstate |
|---|
| 1457 | ! clock External clock |
|---|
| 1458 | ! rc Return code; equals ESMF_SUCCESS if there are no errors, |
|---|
| 1459 | ! otherwise ESMF_FAILURE. |
|---|
| 1460 | !</DESCRIPTION> |
|---|
| 1461 | |
|---|
| 1462 | PRINT *, "DEBUG: Coupler Final starting" |
|---|
| 1463 | |
|---|
| 1464 | ! guilty until proven innocent |
|---|
| 1465 | rc = ESMF_FAILURE |
|---|
| 1466 | |
|---|
| 1467 | ! Only thing to do here is release redist and route handles |
|---|
| 1468 | IF ( fromWRF_rh_ready ) THEN |
|---|
| 1469 | CALL ESMF_RouteHandleDestroy(fromWRF_rh, rc) |
|---|
| 1470 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1471 | CALL wrf_error_fatal ( 'WRFSSTCpl_final: ESMF_RouteHandleDestroy(fromWRF_rh) failed' ) |
|---|
| 1472 | ENDIF |
|---|
| 1473 | ENDIF |
|---|
| 1474 | IF ( fromSST_rh_ready ) THEN |
|---|
| 1475 | CALL ESMF_RouteHandleDestroy(fromSST_rh, rc) |
|---|
| 1476 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1477 | CALL wrf_error_fatal ( 'WRFSSTCpl_final: ESMF_RouteHandleDestroy(fromSST_rh) failed' ) |
|---|
| 1478 | ENDIF |
|---|
| 1479 | ENDIF |
|---|
| 1480 | |
|---|
| 1481 | PRINT *, "DEBUG: Coupler Final returning" |
|---|
| 1482 | |
|---|
| 1483 | END SUBROUTINE WRFSSTCpl_final |
|---|
| 1484 | |
|---|
| 1485 | |
|---|
| 1486 | END MODULE module_wrfsst_coupler |
|---|
| 1487 | |
|---|
| 1488 | |
|---|
| 1489 | |
|---|
| 1490 | |
|---|
| 1491 | PROGRAM wrf_SST_ESMF |
|---|
| 1492 | |
|---|
| 1493 | !<DESCRIPTION> |
|---|
| 1494 | ! ESMF Application Wrapper for coupling WRF with a "dummy" component |
|---|
| 1495 | ! that simply reads SSTs from a file and sends them to WRF (one-way |
|---|
| 1496 | ! coupling). Fields are returned from WRF to SST via the coupler for |
|---|
| 1497 | ! self-test only. |
|---|
| 1498 | ! |
|---|
| 1499 | ! Note that, like other WRF coupling methods (MCEL, MCT), ESMF coupling is |
|---|
| 1500 | ! supported only via auxiliary input and history streams. |
|---|
| 1501 | ! |
|---|
| 1502 | ! This is the main program that creates the ESMF Gridded and Coupler |
|---|
| 1503 | ! Component. |
|---|
| 1504 | ! |
|---|
| 1505 | ! "init" looks like this: |
|---|
| 1506 | ! 1. Init phase 1 for WRF, sets WRF exportState metadata for "time" |
|---|
| 1507 | ! and "domain" information needed by WRF IOAPI (which is called from |
|---|
| 1508 | ! the SST component). It also sets up all WRF and WSF modules. Note |
|---|
| 1509 | ! that this must be called before SST phase-1 init because SST uses |
|---|
| 1510 | ! WRF IOAPI. |
|---|
| 1511 | ! 2. Init phase 1 for SST, sets "time" metadata in SST exportState. |
|---|
| 1512 | ! 3. Initialize coupler, passing decomposition metadata from WRF exportState |
|---|
| 1513 | ! to SST importState. |
|---|
| 1514 | ! 4. Resolve any "time" metadata inconsistencies and create top-level clock. |
|---|
| 1515 | ! 5. Init phase 2 for SST, gets "domain" information from importState, |
|---|
| 1516 | ! creates an ESMF_Grid based on "domain" information using the exact same |
|---|
| 1517 | ! method as WRF (so WRF IOAPI calls will work), and sets up SST |
|---|
| 1518 | ! importState and exportState. |
|---|
| 1519 | ! 6. Init phase 2 for WRF, runs up to the end of the head_grid I/O "training" |
|---|
| 1520 | ! phase (done in med_before_solve_io()). This initializes WRF |
|---|
| 1521 | ! importState and exportState prior to the first coupling step during the |
|---|
| 1522 | ! "run" loop. Note that this only works for head_grid at present because |
|---|
| 1523 | ! recursion in WRF traversal of subdomains is not dealt with yet and |
|---|
| 1524 | ! because the code that populates the WRF importState and exportState is |
|---|
| 1525 | ! not yet sophisticated enough to handle creating and destroying nested |
|---|
| 1526 | ! domains at any time during the model run. |
|---|
| 1527 | !TODO: ESMF auxio must begin at the start of the run. Remove this |
|---|
| 1528 | !TODO: restriction later, if needed. |
|---|
| 1529 | ! |
|---|
| 1530 | !TODO: Note that coupling is currently limited to one auxin plus one auxout |
|---|
| 1531 | !TODO: streams. Extension to multiple pairs of auxio streams requires |
|---|
| 1532 | !TODO: nested states (one for each auxio stream pair). |
|---|
| 1533 | !TODO: For now, only support one input and/or one output stream via |
|---|
| 1534 | !TODO: io_esmf. This condition is asserted in |
|---|
| 1535 | !TODO: ext_esmf_open_for_read_begin() and |
|---|
| 1536 | !TODO: ext_esmf_open_for_write_begin(). |
|---|
| 1537 | ! |
|---|
| 1538 | ! "run" loop looks like this: |
|---|
| 1539 | ! 1. Run SST phase 1, reads SST from file and writes it to SST exportState |
|---|
| 1540 | ! for coupling to WRF. |
|---|
| 1541 | ! 2. Couple SST exportState -> WRF importState. First iteration: set up |
|---|
| 1542 | ! SST->WRF routeHandle via lazy evaluation. |
|---|
| 1543 | ! 3. Run WRF. First iteration: head_grid resumes after I/O "training" |
|---|
| 1544 | ! phase. Other iterations and domains: run normally. |
|---|
| 1545 | ! Read WRF importState and write WRF exportState (via med_before_solve_io()). |
|---|
| 1546 | ! Note that WRF assigns sst -> tsk for sea points in |
|---|
| 1547 | ! share/module_soil_pre.F. |
|---|
| 1548 | ! 4. Couple WRF exportState -> SST importState. First iteration: set up |
|---|
| 1549 | ! WRF->SST routeHandle via lazy evaluation. |
|---|
| 1550 | ! 5. Run SST phase 2, compare SST from file with SST from WRF (via |
|---|
| 1551 | ! SST importState) and error-exit if they differ. |
|---|
| 1552 | ! 6. Advance clock and goto step 1 |
|---|
| 1553 | ! |
|---|
| 1554 | ! "finalize" is trivial, except for destruction of ESMF objects which is |
|---|
| 1555 | ! quite non-trivial at the moment. |
|---|
| 1556 | ! |
|---|
| 1557 | !</DESCRIPTION> |
|---|
| 1558 | |
|---|
| 1559 | ! WRF registration routine |
|---|
| 1560 | USE module_wrf_setservices, ONLY: WRF_register |
|---|
| 1561 | ! SST registration routine |
|---|
| 1562 | USE module_sst_setservices, ONLY: SST_register |
|---|
| 1563 | ! WRF-SST coupler registration routine |
|---|
| 1564 | USE module_wrfsst_coupler, ONLY: WRFSSTCpl_register |
|---|
| 1565 | ! ESMF module, defines all ESMF data types and procedures |
|---|
| 1566 | USE ESMF_Mod |
|---|
| 1567 | ! Not-yet-implemented ESMF features |
|---|
| 1568 | USE module_esmf_extensions |
|---|
| 1569 | ! Component-independent utilities |
|---|
| 1570 | USE module_metadatautils, ONLY: GetTimesFromStates |
|---|
| 1571 | |
|---|
| 1572 | IMPLICIT NONE |
|---|
| 1573 | |
|---|
| 1574 | ! Local variables |
|---|
| 1575 | |
|---|
| 1576 | ! Components |
|---|
| 1577 | TYPE(ESMF_GridComp) :: compGriddedWRF ! WRF |
|---|
| 1578 | TYPE(ESMF_GridComp) :: compGriddedSST ! SST reader |
|---|
| 1579 | TYPE(ESMF_CplComp) :: compCplWRFSST ! WRF-SST coupler |
|---|
| 1580 | |
|---|
| 1581 | ! State, Virtual Machine, and DELayout |
|---|
| 1582 | TYPE(ESMF_VM) :: vm |
|---|
| 1583 | TYPE(ESMF_State) :: importStateWRF, exportStateWRF |
|---|
| 1584 | TYPE(ESMF_State) :: importStateSST, exportStateSST |
|---|
| 1585 | |
|---|
| 1586 | ! A clock, some times, and a time step |
|---|
| 1587 | TYPE(ESMF_Clock) :: driverClock |
|---|
| 1588 | TYPE(ESMF_Time) :: startTime |
|---|
| 1589 | TYPE(ESMF_Time) :: stopTime |
|---|
| 1590 | TYPE(ESMF_TimeInterval) :: couplingInterval |
|---|
| 1591 | |
|---|
| 1592 | ! other misc stuff |
|---|
| 1593 | TYPE(ESMF_State) :: tmpState |
|---|
| 1594 | INTEGER :: timestepdebug |
|---|
| 1595 | INTEGER :: thecount ! ah ah ah |
|---|
| 1596 | |
|---|
| 1597 | ! Return codes for error checks |
|---|
| 1598 | INTEGER :: rc |
|---|
| 1599 | CHARACTER (ESMF_MAXSTR) :: str |
|---|
| 1600 | |
|---|
| 1601 | ! debugging |
|---|
| 1602 | CHARACTER(LEN=256) :: couplingIntervalString |
|---|
| 1603 | integer(ESMF_KIND_I4) :: timevals(6) |
|---|
| 1604 | |
|---|
| 1605 | |
|---|
| 1606 | ! Warn users that this is not yet ready for general use. |
|---|
| 1607 | PRINT *, ' W A R N I N G ' |
|---|
| 1608 | PRINT *, ' ESMF COUPLING CAPABILITY IS EXPERIMENTAL AND UNSUPPORTED ' |
|---|
| 1609 | PRINT *, ' IN THIS VERSION OF WRF-CPL-SST ' |
|---|
| 1610 | PRINT *, ' U S E A T Y O U R O W N R I S K ' |
|---|
| 1611 | |
|---|
| 1612 | ! Initialize ESMF, get the default Global VM, and set |
|---|
| 1613 | ! the default calendar to be Gregorian. |
|---|
| 1614 | #ifdef NO_LEAP_CALENDAR |
|---|
| 1615 | CALL ESMF_Initialize( vm=vm, defaultCalendar=ESMF_CAL_NOLEAP, defaultlogtype=ESMF_LOG_MULTI,rc=rc ) |
|---|
| 1616 | #else |
|---|
| 1617 | CALL ESMF_Initialize( vm=vm, defaultCalendar=ESMF_CAL_GREGORIAN, defaultlogtype=ESMF_LOG_MULTI,rc=rc ) |
|---|
| 1618 | #endif |
|---|
| 1619 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1620 | PRINT *, 'wrf_SST_ESMF: ESMF_Initialize failed' |
|---|
| 1621 | ENDIF |
|---|
| 1622 | ! Note: wrf_debug and wrf_error_fatal are not initialized yet |
|---|
| 1623 | PRINT *, 'DEBUG wrf_SST_ESMF: returned from ESMF_Initialize' |
|---|
| 1624 | CALL ESMF_SetInitialized() ! eliminate this once ESMF does it internally |
|---|
| 1625 | |
|---|
| 1626 | ! Create the WRF Gridded Component, passing in the default VM. |
|---|
| 1627 | compGriddedWRF = ESMF_GridCompCreate( name="WRF Model", rc=rc) |
|---|
| 1628 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1629 | PRINT *, 'wrf_SST_ESMF: ESMF_GridCompCreate(WRF Model) failed' |
|---|
| 1630 | ENDIF |
|---|
| 1631 | |
|---|
| 1632 | ! Create the SST Gridded Component, passing in the default VM. |
|---|
| 1633 | compGriddedSST = ESMF_GridCompCreate( name="SST Dummy Model", rc=rc) |
|---|
| 1634 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1635 | PRINT *, 'wrf_SST_ESMF: ESMF_GridCompCreate(WRF Dummy Model) failed' |
|---|
| 1636 | ENDIF |
|---|
| 1637 | |
|---|
| 1638 | ! Create the WRF-SST Coupler Component, passing in the default VM. |
|---|
| 1639 | compCplWRFSST = ESMF_CplCompCreate( name="WRF-SST Coupler", rc=rc) |
|---|
| 1640 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1641 | PRINT *, 'wrf_SST_ESMF: ESMF_CplCompCreate failed' |
|---|
| 1642 | ENDIF |
|---|
| 1643 | |
|---|
| 1644 | ! Create empty import and export states for WRF |
|---|
| 1645 | importStateWRF = ESMF_StateCreate(stateName="WRF Import State", statetype=ESMF_STATE_IMPORT, rc=rc) |
|---|
| 1646 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1647 | PRINT *, 'wrf_SST_ESMF: ESMF_StateCreate(WRF Import State) failed' |
|---|
| 1648 | ENDIF |
|---|
| 1649 | exportStateWRF = ESMF_StateCreate(stateName="WRF Export State", statetype=ESMF_STATE_EXPORT, rc=rc) |
|---|
| 1650 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1651 | PRINT *, 'wrf_SST_ESMF: ESMF_StateCreate(WRF Export State) failed' |
|---|
| 1652 | ENDIF |
|---|
| 1653 | |
|---|
| 1654 | ! Create empty import and export states for SST |
|---|
| 1655 | importStateSST = ESMF_StateCreate(stateName="SST Import State", statetype=ESMF_STATE_IMPORT, rc=rc) |
|---|
| 1656 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1657 | PRINT *, 'wrf_SST_ESMF: ESMF_StateCreate(SST Import State) failed' |
|---|
| 1658 | ENDIF |
|---|
| 1659 | exportStateSST = ESMF_StateCreate(stateName="SST Export State", statetype=ESMF_STATE_EXPORT, rc=rc) |
|---|
| 1660 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1661 | PRINT *, 'wrf_SST_ESMF: ESMF_StateCreate(SST Export State) failed' |
|---|
| 1662 | ENDIF |
|---|
| 1663 | |
|---|
| 1664 | ! Register the WRF Gridded Component |
|---|
| 1665 | CALL ESMF_GridCompSetServices(compGriddedWRF, WRF_register, rc) |
|---|
| 1666 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1667 | PRINT *, 'wrf_SST_ESMF: ESMF_GridCompSetServices(compGriddedWRF) failed' |
|---|
| 1668 | ENDIF |
|---|
| 1669 | |
|---|
| 1670 | ! Register the SST Gridded Component |
|---|
| 1671 | CALL ESMF_GridCompSetServices(compGriddedSST, SST_register, rc) |
|---|
| 1672 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1673 | PRINT *, 'wrf_SST_ESMF: ESMF_GridCompSetServices(compGriddedSST) failed' |
|---|
| 1674 | ENDIF |
|---|
| 1675 | |
|---|
| 1676 | ! Register the WRF-SST Coupler Component |
|---|
| 1677 | CALL ESMF_CplCompSetServices(compCplWRFSST, WRFSSTCpl_register, rc) |
|---|
| 1678 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1679 | PRINT *, 'wrf_SST_ESMF: ESMF_CplCompSetServices failed' |
|---|
| 1680 | ENDIF |
|---|
| 1681 | |
|---|
| 1682 | ! Create top-level clock. There is no way to create an "empty" clock, so |
|---|
| 1683 | ! stuff in bogus values for start time, stop time, and time step and fix |
|---|
| 1684 | ! them after gridded component "init" phases return. |
|---|
| 1685 | CALL ESMF_TimeSet(startTime, yy=2000, mm=1, dd=1, & |
|---|
| 1686 | h=0, m=0, s=0, rc=rc) |
|---|
| 1687 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1688 | PRINT *, 'wrf_SST_ESMF: ESMF_TimeSet(startTime) failed' |
|---|
| 1689 | ENDIF |
|---|
| 1690 | CALL ESMF_TimeSet(stopTime, yy=2000, mm=1, dd=1, & |
|---|
| 1691 | h=12, m=0, s=0, rc=rc) |
|---|
| 1692 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1693 | PRINT *, 'wrf_SST_ESMF: ESMF_TimeSet(stopTime) failed' |
|---|
| 1694 | ENDIF |
|---|
| 1695 | CALL ESMF_TimeIntervalSet(couplingInterval, s=2, rc=rc) |
|---|
| 1696 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1697 | PRINT *, 'wrf_SST_ESMF: ESMF_TimeIntervalSet failed' |
|---|
| 1698 | ENDIF |
|---|
| 1699 | driverClock = ESMF_ClockCreate(timeStep=couplingInterval, & |
|---|
| 1700 | startTime=startTime, & |
|---|
| 1701 | stopTime=stopTime, rc=rc) |
|---|
| 1702 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1703 | PRINT *, 'wrf_SST_ESMF: ESMF_ClockCreate failed' |
|---|
| 1704 | ENDIF |
|---|
| 1705 | |
|---|
| 1706 | ! Init, Run, and Finalize section |
|---|
| 1707 | |
|---|
| 1708 | ! Init... |
|---|
| 1709 | ! initialize WRF, phase 1 |
|---|
| 1710 | ! Phase 1 init returns WRF time and decomposition information as |
|---|
| 1711 | ! exportState metadata. |
|---|
| 1712 | PRINT *, 'DEBUG wrf_SST_ESMF: calling phase-1 WRF init (wrf_component_init1)' |
|---|
| 1713 | CALL ESMF_GridCompInitialize(compGriddedWRF, importStateWRF, & |
|---|
| 1714 | exportStateWRF, driverClock, phase=1, rc=rc) |
|---|
| 1715 | thecount = size(timevals) |
|---|
| 1716 | call esmf_attributeget(exportstatewrf,'ComponentCouplingInterval',timevals,itemcount=thecount,rc=rc) |
|---|
| 1717 | !write(0,*) 'exportStateWRF year ',timevals(1),__LINE__ |
|---|
| 1718 | !write(0,*) 'exportStateWRF month ',timevals(2),__LINE__ |
|---|
| 1719 | !write(0,*) 'exportStateWRF day ',timevals(3),__LINE__ |
|---|
| 1720 | !write(0,*) 'exportStateWRF hour ',timevals(4),__LINE__ |
|---|
| 1721 | !write(0,*) 'exportStateWRF minute ',timevals(5),__LINE__ |
|---|
| 1722 | !write(0,*) 'exportStateWRF second ',timevals(6),__LINE__ |
|---|
| 1723 | ! Note: wrf_debug and wrf_error_fatal are now initialized |
|---|
| 1724 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1725 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompInitialize(WRF phase 1) failed' ) |
|---|
| 1726 | ENDIF |
|---|
| 1727 | |
|---|
| 1728 | ! initialize SST, phase 1 |
|---|
| 1729 | ! Phase 1 init returns SST time information as |
|---|
| 1730 | ! exportState metadata. |
|---|
| 1731 | PRINT *, 'DEBUG wrf_SST_ESMF: calling phase-1 SST init (sst_component_init1)' |
|---|
| 1732 | CALL ESMF_GridCompInitialize(compGriddedSST, importStateSST, & |
|---|
| 1733 | exportStateSST, driverClock, phase=1, rc=rc) |
|---|
| 1734 | thecount = size(timevals) |
|---|
| 1735 | call esmf_attributeget(exportstatesst,'ComponentCouplingInterval',timevals,itemcount=thecount,rc=rc) |
|---|
| 1736 | !write(0,*) 'exportStateSST year ',timevals(1),__LINE__ |
|---|
| 1737 | !write(0,*) 'exportStateSST month ',timevals(2),__LINE__ |
|---|
| 1738 | !write(0,*) 'exportStateSST day ',timevals(3),__LINE__ |
|---|
| 1739 | !write(0,*) 'exportStateSST hour ',timevals(4),__LINE__ |
|---|
| 1740 | !write(0,*) 'exportStateSST minute ',timevals(5),__LINE__ |
|---|
| 1741 | !write(0,*) 'exportStateSST second ',timevals(6),__LINE__ |
|---|
| 1742 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1743 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompInitialize(SST phase 1) failed' ) |
|---|
| 1744 | ENDIF |
|---|
| 1745 | |
|---|
| 1746 | ! Reconcile clock settings from WRF and SST components to set up |
|---|
| 1747 | ! top-level clock. These are passed back from each "init" as attributes |
|---|
| 1748 | ! on exportState*. |
|---|
| 1749 | ! Stuff both States into a single State to pass into GetTimesFromStates() |
|---|
| 1750 | ! which is smart enough to deal with a Composite. |
|---|
| 1751 | PRINT *, 'DEBUG wrf_SST_ESMF: reconciling clock from WRF and SST components' |
|---|
| 1752 | tmpState = ESMF_StateCreate( rc=rc ) |
|---|
| 1753 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1754 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateCreate(tmpState) failed' ) |
|---|
| 1755 | ENDIF |
|---|
| 1756 | CALL ESMF_StateAdd( tmpState, exportStateWRF, rc ) |
|---|
| 1757 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1758 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateAdd(exportStateWRF) failed' ) |
|---|
| 1759 | ENDIF |
|---|
| 1760 | CALL ESMF_StateAdd( tmpState, exportStateSST, rc ) |
|---|
| 1761 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1762 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateAdd(exportStateSST) failed' ) |
|---|
| 1763 | ENDIF |
|---|
| 1764 | CALL GetTimesFromStates( tmpState, startTime, stopTime, couplingInterval ) |
|---|
| 1765 | CALL ESMF_TimeIntervalGet( couplingInterval, TimeString=couplingIntervalString, & |
|---|
| 1766 | rc=rc ) |
|---|
| 1767 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1768 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_TimeIntervalGet failed' ) |
|---|
| 1769 | ENDIF |
|---|
| 1770 | CALL wrf_debug( 100, 'wrf_SST_ESMF: couplingInterval = '//TRIM(couplingIntervalString) ) |
|---|
| 1771 | CALL ESMF_StateDestroy( tmpState, rc ) |
|---|
| 1772 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1773 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateDestroy(tmpState) failed' ) |
|---|
| 1774 | ENDIF |
|---|
| 1775 | ! update driver clock |
|---|
| 1776 | CALL ESMF_ClockDestroy(driverClock, rc) |
|---|
| 1777 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1778 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_ClockDestroy failed' ) |
|---|
| 1779 | ENDIF |
|---|
| 1780 | driverClock = ESMF_ClockCreate(timeStep=couplingInterval, & |
|---|
| 1781 | startTime=startTime, & |
|---|
| 1782 | stopTime=stopTime, rc=rc) |
|---|
| 1783 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1784 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_ClockCreate(driverClock) failed' ) |
|---|
| 1785 | ENDIF |
|---|
| 1786 | PRINT *, 'DEBUG wrf_SST_ESMF: done reconciling clock from WRF and SST components' |
|---|
| 1787 | CALL wrf_clockprint(50, driverClock, & |
|---|
| 1788 | 'DEBUG wrf_SST_ESMF: driverClock after creation,') |
|---|
| 1789 | |
|---|
| 1790 | ! initialize WRF-SST Coupler |
|---|
| 1791 | PRINT *, 'DEBUG wrf_SST_ESMF: calling phase-1 CPL init (WRFSSTCpl_init)' |
|---|
| 1792 | CALL ESMF_CplCompInitialize(compCplWRFSST, exportStateWRF, & |
|---|
| 1793 | importStateSST, driverClock, rc=rc) |
|---|
| 1794 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1795 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_CplCompInitialize(WRF -> SST) failed' ) |
|---|
| 1796 | ENDIF |
|---|
| 1797 | |
|---|
| 1798 | ! TBH: this bit is not needed, but would be in general |
|---|
| 1799 | ! CALL ESMF_CplCompInitialize(compCplWRFSST, exportStateSST, & |
|---|
| 1800 | ! importStateWRF, driverClock, rc=rc) |
|---|
| 1801 | ! IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1802 | ! CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_CplCompInitialize(SST -> WRF) failed' ) |
|---|
| 1803 | ! ENDIF |
|---|
| 1804 | |
|---|
| 1805 | ! initialize SST, phase 2 |
|---|
| 1806 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-2 init for SST (sst_component_init2)' |
|---|
| 1807 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1808 | CALL ESMF_GridCompInitialize(compGriddedSST, importStateSST, & |
|---|
| 1809 | exportStateSST, driverClock, phase=2, rc=rc) |
|---|
| 1810 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-2 init for SST' |
|---|
| 1811 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1812 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1813 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompInitialize(SST phase 2) failed' ) |
|---|
| 1814 | ENDIF |
|---|
| 1815 | |
|---|
| 1816 | ! initialize WRF, phase 2 |
|---|
| 1817 | ! Phase 2 init sets up WRF importState and exportState. |
|---|
| 1818 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-2 init for WRF (wrf_component_init2)' |
|---|
| 1819 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1820 | CALL ESMF_GridCompInitialize(compGriddedWRF, importStateWRF, & |
|---|
| 1821 | exportStateWRF, driverClock, phase=2, rc=rc) |
|---|
| 1822 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-2 init for WRF' |
|---|
| 1823 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1824 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1825 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompInitialize(WRF phase 2) failed' ) |
|---|
| 1826 | ENDIF |
|---|
| 1827 | |
|---|
| 1828 | CALL wrf_clockprint(50, driverClock, & |
|---|
| 1829 | 'DEBUG wrf_SST_ESMF: driverClock before main time-stepping loop,') |
|---|
| 1830 | ! Run... |
|---|
| 1831 | ! main time-stepping loop |
|---|
| 1832 | timestepdebug = 0 |
|---|
| 1833 | DO WHILE ( .NOT. ESMF_ClockIsStopTime(driverClock, rc) ) |
|---|
| 1834 | |
|---|
| 1835 | timestepdebug = timestepdebug + 1 |
|---|
| 1836 | WRITE(str,'(A,I8)') 'PROGRAM wrf_SST_ESMF: Top of time-stepping loop, timestepdebug = ',timestepdebug |
|---|
| 1837 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1838 | CALL wrf_clockprint(50, driverClock, & |
|---|
| 1839 | 'DEBUG wrf_SST_ESMF: driverClock at top of time-stepping loop,') |
|---|
| 1840 | |
|---|
| 1841 | ! Run SST phase 1 |
|---|
| 1842 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-1 run for SST (sst_component_run1)' |
|---|
| 1843 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1844 | CALL ESMF_GridCompRun(compGriddedSST, importStateSST, exportStateSST, & |
|---|
| 1845 | driverClock, phase=1, rc=rc) |
|---|
| 1846 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1847 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompRun(SST phase 1) failed' ) |
|---|
| 1848 | ENDIF |
|---|
| 1849 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-1 run for SST (sst_component_run1)' |
|---|
| 1850 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1851 | |
|---|
| 1852 | ! couple SST export -> WRF import |
|---|
| 1853 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling run for CPL SST->WRF (WRFSSTCpl_run)' |
|---|
| 1854 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1855 | CALL ESMF_CplCompRun(compCplWRFSST, exportStateSST, & |
|---|
| 1856 | importStateWRF, driverClock, rc=rc) |
|---|
| 1857 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1858 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_CplCompRun(SST -> WRF) failed' ) |
|---|
| 1859 | ENDIF |
|---|
| 1860 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from run for CPL SST->WRF (WRFSSTCpl_run)' |
|---|
| 1861 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1862 | |
|---|
| 1863 | ! Run WRF |
|---|
| 1864 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling run for WRF (wrf_component_run)' |
|---|
| 1865 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1866 | CALL ESMF_GridCompRun(compGriddedWRF, importStateWRF, exportStateWRF, & |
|---|
| 1867 | driverClock, rc=rc) |
|---|
| 1868 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1869 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompRun(WRF) failed' ) |
|---|
| 1870 | ENDIF |
|---|
| 1871 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from run for WRF (wrf_component_run)' |
|---|
| 1872 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1873 | |
|---|
| 1874 | ! couple WRF export -> SST import |
|---|
| 1875 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling run for CPL WRF->SST (WRFSSTCpl_run)' |
|---|
| 1876 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1877 | CALL ESMF_CplCompRun(compCplWRFSST, exportStateWRF, & |
|---|
| 1878 | importStateSST, driverClock, rc=rc) |
|---|
| 1879 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1880 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_CplCompRun(WRF -> SST) failed' ) |
|---|
| 1881 | ENDIF |
|---|
| 1882 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from run for CPL WRF->SST (WRFSSTCpl_run)' |
|---|
| 1883 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1884 | |
|---|
| 1885 | ! Run SST phase 2 |
|---|
| 1886 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-2 run for SST (sst_component_run2)' |
|---|
| 1887 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1888 | CALL ESMF_GridCompRun(compGriddedSST, importStateSST, exportStateSST, & |
|---|
| 1889 | driverClock, phase=2, rc=rc) |
|---|
| 1890 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1891 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompRun(SST phase 2) failed' ) |
|---|
| 1892 | ENDIF |
|---|
| 1893 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-2 run for SST (sst_component_run2)' |
|---|
| 1894 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1895 | |
|---|
| 1896 | ! advance clock to next coupling time step |
|---|
| 1897 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: advancing clock' |
|---|
| 1898 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1899 | CALL ESMF_ClockAdvance( driverClock, rc=rc ) |
|---|
| 1900 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1901 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_ClockAdvance failed' ) |
|---|
| 1902 | ENDIF |
|---|
| 1903 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: done advancing clock' |
|---|
| 1904 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1905 | |
|---|
| 1906 | CALL wrf_clockprint(50, driverClock, & |
|---|
| 1907 | 'DEBUG wrf_SST_ESMF: driverClock at end of time-stepping loop,') |
|---|
| 1908 | |
|---|
| 1909 | ENDDO |
|---|
| 1910 | |
|---|
| 1911 | WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: done with time-stepping loop' |
|---|
| 1912 | CALL wrf_debug ( 100 , TRIM(str) ) |
|---|
| 1913 | |
|---|
| 1914 | ! clean up SST |
|---|
| 1915 | CALL ESMF_GridCompFinalize(compGriddedSST, importStateSST, exportStateSST, & |
|---|
| 1916 | driverClock, rc=rc) |
|---|
| 1917 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1918 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompFinalize(compGriddedSST) failed' ) |
|---|
| 1919 | ENDIF |
|---|
| 1920 | |
|---|
| 1921 | ! clean up compCplWRFSST |
|---|
| 1922 | CALL ESMF_CplCompFinalize( compCplWRFSST, exportStateWRF, importStateSST, & |
|---|
| 1923 | driverClock, rc=rc) |
|---|
| 1924 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1925 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_CplCompFinalize(compCplWRFSST) failed' ) |
|---|
| 1926 | ENDIF |
|---|
| 1927 | |
|---|
| 1928 | ! clean up WRF |
|---|
| 1929 | ! must do this AFTER clean up of SST since SST uses WRF IOAPI |
|---|
| 1930 | CALL ESMF_GridCompFinalize(compGriddedWRF, importStateWRF, exportStateWRF, & |
|---|
| 1931 | driverClock, rc=rc) |
|---|
| 1932 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1933 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompFinalize(compGriddedWRF) failed' ) |
|---|
| 1934 | ENDIF |
|---|
| 1935 | |
|---|
| 1936 | ! Clean up |
|---|
| 1937 | |
|---|
| 1938 | CALL ESMF_GridCompDestroy(compGriddedWRF, rc) |
|---|
| 1939 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1940 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompDestroy(compGriddedWRF) failed' ) |
|---|
| 1941 | ENDIF |
|---|
| 1942 | CALL ESMF_StateDestroy(importStateWRF, rc) |
|---|
| 1943 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1944 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateDestroy(importStateWRF) failed' ) |
|---|
| 1945 | ENDIF |
|---|
| 1946 | CALL ESMF_StateDestroy(exportStateWRF, rc) |
|---|
| 1947 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1948 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateDestroy(exportStateWRF) failed' ) |
|---|
| 1949 | ENDIF |
|---|
| 1950 | CALL ESMF_StateDestroy(importStateSST, rc) |
|---|
| 1951 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1952 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateDestroy(importStateSST) failed' ) |
|---|
| 1953 | ENDIF |
|---|
| 1954 | CALL ESMF_StateDestroy(exportStateSST, rc) |
|---|
| 1955 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1956 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateDestroy(exportStateSST) failed' ) |
|---|
| 1957 | ENDIF |
|---|
| 1958 | CALL ESMF_ClockDestroy(driverClock, rc) |
|---|
| 1959 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1960 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_ClockDestroy(driverClock) failed' ) |
|---|
| 1961 | ENDIF |
|---|
| 1962 | |
|---|
| 1963 | CALL ESMF_Finalize( rc=rc ) |
|---|
| 1964 | IF ( rc /= ESMF_SUCCESS ) THEN |
|---|
| 1965 | CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_Finalize failed' ) |
|---|
| 1966 | ENDIF |
|---|
| 1967 | |
|---|
| 1968 | END PROGRAM wrf_SST_ESMF |
|---|
| 1969 | |
|---|
| 1970 | |
|---|