/wrfv2_fire/main/wrf_SST_ESMF.F
FORTRAN Legacy | 1967 lines | 926 code | 214 blank | 827 comment | 3 complexity | 922ed801948ecd1aebca9fa5803ec498 MD5 | raw file
Possible License(s): AGPL-1.0
Large files files are truncated, but you can click here to view the full file
- !WRF:DRIVER_LAYER:MAIN
- !
- !<DESCRIPTION>
- ! ESMF Application Wrapper for coupling WRF with a "dummy" component
- ! that simply reads SSTs from a file, sends to WRF, receives SST from
- ! WRF (two-way coupling). and checks that the SSTs match.
- !
- ! This file contains the main program and associated modules for the
- ! SST "dummy" component and a simple coupler. It creates ESMF Gridded
- ! and Coupler Components.
- !
- ! This source file is only built when ESMF coupling is used.
- !
- !</DESCRIPTION>
- !<DESCRIPTION>
- ! Modules module_sst_component_top and module_sst_setservices define the
- ! "SST" dummy component.
- !</DESCRIPTION>
- MODULE module_sst_component_top
- !<DESCRIPTION>
- ! This module defines sst_component_init1(), sst_component_init2(),
- ! sst_component_run1(), sst_component_run2(), and sst_component_finalize()
- ! routines that are called when SST is run as an ESMF component.
- !</DESCRIPTION>
- ! Updated for ESMF 5.2.0r -- see:
- ! http://www.earthsystemmodeling.org/esmf_releases/public/ESMF_5_2_0r/InterfaceChanges520to520r.pdf
- ! USE ESMF_Mod
- USE ESMF
- USE module_esmf_extensions
- USE module_metadatautils, ONLY: AttachTimesToState
- IMPLICIT NONE
- ! everything is private by default
- PRIVATE
- ! Public entry points
- PUBLIC sst_component_init1
- PUBLIC sst_component_init2
- PUBLIC sst_component_run1
- PUBLIC sst_component_run2
- PUBLIC sst_component_finalize
- ! private stuff
- TYPE(ESMF_Grid), SAVE :: esmfgrid ! grid used in fields
- CHARACTER (4096) :: str
- INTEGER, SAVE :: fid ! file handle
- ! decomposition information
- INTEGER, SAVE :: ids, ide, jds, jde, kds, kde
- INTEGER, SAVE :: ims, ime, jms, jme, kms, kme
- INTEGER, SAVE :: ips, ipe, jps, jpe, kps, kpe
- REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_out_sst(:,:)
- REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_out_landmask(:,:)
- REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_in_sst(:,:)
- REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_in_landmask(:,:)
- INTEGER, SAVE :: domdesc
- LOGICAL, SAVE :: bdy_mask(4)
- ! MPI communicator, if needed
- INTEGER, SAVE :: mpicom
- ! field data
- REAL, POINTER, SAVE :: file_landmask_data(:,:), file_sst_data(:,:)
- ! input data file name
- CHARACTER ( ESMF_MAXSTR ), SAVE :: sstinfilename
- ! field names
- INTEGER, PARAMETER :: datacount = 2
- INTEGER, PARAMETER :: SST_INDX = 1
- INTEGER, PARAMETER :: LANDMASK_INDX = 2
- CHARACTER(LEN=ESMF_MAXSTR), SAVE :: datanames(datacount)
- TYPE real2d
- REAL, POINTER :: r2d(:,:)
- END TYPE real2d
- TYPE(real2d) :: this_data(datacount)
- CONTAINS
- ! First-phase "init" reads "SST" data file and returns "time" metadata in
- ! exportState.
- SUBROUTINE sst_component_init1( gcomp, importState, exportState, clock, rc )
- USE module_io
- TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
- TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState
- TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState
- TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
- INTEGER, INTENT( OUT) :: rc
- !<DESCRIPTION>
- ! SST component init routine, phase 1.
- !
- ! The arguments are:
- ! gcomp Component
- ! importState Importstate
- ! exportState Exportstate
- ! clock External clock
- ! rc Return code; equals ESMF_SUCCESS if there are no errors,
- ! otherwise ESMF_FAILURE.
- !</DESCRIPTION>
- #ifdef DM_PARALLEL
- INCLUDE 'mpif.h'
- #endif
- ! Local variables
- CHARACTER (LEN=19) :: date_string
- #ifdef DM_PARALLEL
- TYPE(ESMF_VM) :: vm
- INTEGER :: mpicomtmp
- #endif
- TYPE(ESMF_Time) :: startTime, stopTime, currentTime, dataTime
- TYPE(ESMF_TimeInterval) :: timeStep
- INTEGER :: ierr, num_steps, time_loop_max
- INTEGER :: status_next_var
- !TODO: For now, sstinfilename is hard-coded
- !TODO: Upgrade to use a variant of construct_filename() via startTime
- !TODO: extracted from clock.
- sstinfilename = 'sstin_d01_000000'
- ! get MPI communicator out of current VM and duplicate (if needed)
- #ifdef DM_PARALLEL
- CALL ESMF_VMGetCurrent(vm, rc=rc)
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'sst_component_init1: ESMF_VMGetCurrent failed' )
- ENDIF
- CALL ESMF_VMGet(vm, mpiCommunicator=mpicomtmp, rc=rc)
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'sst_component_init1: ESMF_VMGet failed' )
- ENDIF
- CALL MPI_Comm_dup( mpicomtmp, mpicom, ierr )
- #else
- mpicom = 0
- #endif
- ! Open the "SST" input data file for reading.
- write(str,'(A,A)') 'Subroutine sst_component_init1: Opening data file ', &
- TRIM(sstinfilename)
- CALL wrf_message ( TRIM(str) )
- CALL wrf_open_for_read ( TRIM(sstinfilename) , &
- mpicom , &
- mpicom , &
- "DATASET=INPUT" , &
- fid , &
- ierr )
- IF ( ierr .NE. 0 ) THEN
- WRITE( str , FMT='(A,A,A,I8)' ) &
- 'subroutine sst_component_init1: error opening ', &
- TRIM(sstinfilename),' for reading ierr=',ierr
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- WRITE( str , FMT='(A,A,A,I8)' ) &
- 'subroutine sst_component_init1: opened file ', &
- TRIM(sstinfilename),' for reading fid=',fid
- CALL wrf_debug ( 100, TRIM(str) )
- ! How many data time levels are in the SST input file?
- num_steps = -1
- time_loop_max = 0
- CALL wrf_debug ( 100, 'subroutine sst_component_init1: find time_loop_max' )
- ! compute SST start time, time step, and end time here
- get_the_right_time : DO
- CALL wrf_get_next_time ( fid, date_string, status_next_var )
- write(str,'(A,A)') 'Subroutine sst_component_init1: SST data startTime: ', &
- date_string
- CALL wrf_debug ( 100 , TRIM(str) )
- IF ( status_next_var == 0 ) THEN
- IF ( time_loop_max == 0 ) THEN
- CALL wrf_atotime( date_string, startTime )
- ELSEIF ( time_loop_max == 1 ) THEN
- ! assumes fixed time step!
- CALL wrf_atotime( date_string, dataTime )
- timeStep = dataTime - startTime
- ENDIF
- time_loop_max = time_loop_max + 1
- CALL wrf_atotime( date_string, stopTime )
- ELSE
- EXIT get_the_right_time
- ENDIF
- END DO get_the_right_time
- CALL wrf_timetoa ( stopTime, date_string )
- write(str,'(A,A)') 'Subroutine sst_component_init1: SST data stopTime: ', &
- date_string
- CALL wrf_debug ( 100 , TRIM(str) )
- ! attach times to exportState for use by driver
- CALL AttachTimesToState( exportState, startTime, stopTime, timeStep )
- ! There should be a more elegant way to get to the beginning of the
- ! file, but this will do.
- CALL wrf_ioclose( fid , ierr )
- IF ( ierr .NE. 0 ) THEN
- CALL wrf_error_fatal ( 'sst_component_init1: wrf_ioclose failed' )
- ENDIF
- WRITE( str , FMT='(A,I8)' ) &
- 'subroutine sst_component_init1: closed file fid=',fid
- CALL wrf_debug ( 100, TRIM(str) )
- ! set up field names
- !TODO: use CF conventions for "standard_name" once WRF Registry supports them
- !TODO: datanames(SST_INDX) = "sea_surface_temperature"
- !TODO: datanames(LANDMASK_INDX) = "land_binary_mask"
- datanames(SST_INDX) = "SST"
- datanames(LANDMASK_INDX) = "LANDMASK"
- rc = ESMF_SUCCESS
- END SUBROUTINE sst_component_init1
- SUBROUTINE read_data( exportState, clock )
- USE module_io
- TYPE(ESMF_State), INTENT(INOUT) :: exportState
- TYPE(ESMF_Clock), INTENT(IN ) :: clock
- !<DESCRIPTION>
- ! Reads data from file and stores. Then
- ! stuffs the file data into the SST exportState.
- !</DESCRIPTION>
- #include <wrf_status_codes.h>
- #include <wrf_io_flags.h>
- ! Local variables
- CHARACTER (LEN=19) :: date_string
- TYPE(ESMF_Time) :: currentTime, dataTime
- REAL(ESMF_KIND_R4), POINTER :: out_sst_ptr(:,:), out_landmask_ptr(:,:)
- TYPE(ESMF_Field) :: out_sst_field, out_landmask_field
- TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
- INTEGER :: i, j
- CHARACTER(LEN=ESMF_MAXSTR) :: fieldname, debugmsg, errormsg, timestr
- INTEGER :: ierr
- INTEGER :: rc
- ! This call to wrf_get_next_time will position the dataset over the next
- ! time-frame in the file and return the date_string, which is used as an
- ! argument to the read_field routines in the blocks of code included
- ! below.
- CALL wrf_get_next_time( fid, date_string , ierr )
- WRITE(str,'(A,A)') 'Subroutine read_data: SST data time: ', &
- date_string
- CALL wrf_debug ( 100 , TRIM(str) )
- IF ( ierr .NE. 0 .AND. ierr .NE. WRF_WARN_NOTSUPPORTED .AND. &
- ierr .NE. WRF_WARN_DRYRUN_READ ) THEN
- CALL wrf_error_fatal ( "... May have run out of valid SST data ..." )
- ELSE IF ( ierr .NE. WRF_WARN_NOTSUPPORTED .AND. &
- ierr .NE. WRF_WARN_DRYRUN_READ) THEN
- ! check input time against current time (which will be start time at
- ! beginning)
- CALL wrf_atotime( date_string, dataTime )
- CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- CALL wrf_error_fatal ( 'read_data: ESMF_ClockGet() failed' )
- ENDIF
- CALL wrf_clockprint(150, clock, &
- 'DEBUG read_data(): get currentTime from clock,')
- IF ( dataTime .NE. currentTime ) THEN
- CALL wrf_timetoa ( dataTime, timestr )
- WRITE( errormsg , * )'Time in file: ',trim( timestr )
- CALL wrf_message ( trim(errormsg) )
- CALL wrf_timetoa ( currentTime, timestr )
- WRITE( errormsg , * )'Time on domain: ',trim( timestr )
- CALL wrf_message ( trim(errormsg) )
- CALL wrf_error_fatal( &
- "**ERROR** Time in input file not equal to time on domain **ERROR**" )
- ENDIF
- ENDIF
- ! doing this in a loop only works if staggering is the same for all fields
- this_data(SST_INDX)%r2d => file_sst_data
- this_data(LANDMASK_INDX)%r2d => file_landmask_data
- DO i=1, datacount
- fieldname = TRIM(datanames(i))
- debugmsg = 'ext_read_field '//TRIM(fieldname)//' memorder XY'
- errormsg = 'could not read '//TRIM(fieldname)//' data from file'
- CALL wrf_ext_read_field ( &
- fid , & ! DataHandle
- date_string , & ! DateStr
- TRIM(fieldname) , & ! Data Name
- this_data(i)%r2d , & ! Field
- WRF_REAL , & ! FieldType
- mpicom , & ! Comm
- mpicom , & ! I/O Comm
- domdesc , & ! Domain descriptor
- bdy_mask , & ! bdy_mask
- 'XY' , & ! MemoryOrder
- '' , & ! Stagger
- TRIM(debugmsg) , & ! Debug message
- #if 1
- ids , (ide-1) , jds , (jde-1) , 1 , 1 , &
- ims , ime , jms , jme , 1 , 1 , &
- ips , MIN( (ide-1), ipe ) , jps , MIN( (jde-1), jpe ) , 1 , 1 , &
- #else
- !jm the dimensions have already been reduced to the non-staggered WRF grid when
- ! they were stored in this module.. Just use as is.
- ids , ide , jds , jde , 1 , 1 , &
- ims , ime , jms , jme , 1 , 1 , &
- ips , ipe , jps , jpe , 1 , 1 , &
- #endif
- ierr )
- IF (ierr /= 0) THEN
- CALL wrf_error_fatal ( TRIM(errormsg) )
- ENDIF
- ENDDO
- ! stuff fields into exportState
- !TODO: change this to Bundles, eventually
- CALL ESMF_StateGet( exportState, TRIM(datanames(SST_INDX)), &
- out_sst_field, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- CALL wrf_error_fatal ( &
- 'could not find sea_surface_temperature field in exportState' )
- ENDIF
- CALL ESMF_StateGet( exportState, TRIM(datanames(LANDMASK_INDX)), &
- out_landmask_field, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- CALL wrf_error_fatal ( &
- 'could not find land_binary_mask field in exportState' )
- ENDIF
- ! CALL ESMF_FieldGetDataPointer( out_sst_field, out_sst_ptr, rc=rc )
- CALL ESMF_FieldGet( out_sst_field, 0, out_sst_ptr, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- CALL wrf_error_fatal ( &
- 'could not find sea_surface_temperature data in sea_surface_temperature field' )
- ENDIF
- ! CALL ESMF_FieldGetDataPointer( out_landmask_field, out_landmask_ptr, rc=rc )
- CALL ESMF_FieldGet( out_landmask_field, 0, out_landmask_ptr, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- CALL wrf_error_fatal ( &
- 'could not find land_binary_mask data in land_binary_mask field' )
- ENDIF
- ! staggered starts/ends
- DO j= jps , jpe
- DO i= ips , ipe
- out_sst_ptr(i,j) = file_sst_data(i,j)
- out_landmask_ptr(i,j) = file_landmask_data(i,j)
- ENDDO
- ENDDO
- END SUBROUTINE read_data
- SUBROUTINE compare_data( importState, clock )
- TYPE(ESMF_State), INTENT(INOUT) :: importState
- !TODO: remove clock after debugging is finished
- TYPE(ESMF_Clock), INTENT(INOUT) :: clock
- !<DESCRIPTION>
- ! Gets data from coupler via importState
- ! and compares with data read from file and
- ! error-exits if they differ.
- !
- ! The arguments are:
- ! importState Importstate
- !</DESCRIPTION>
- ! Local variables
- TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
- REAL(ESMF_KIND_R4), POINTER :: in_sst_ptr(:,:), in_landmask_ptr(:,:)
- REAL, POINTER :: in_sst_ptr_real(:,:), in_landmask_ptr_real(:,:)
- INTEGER :: i, j
- INTEGER :: rc
- LOGICAL :: landmask_ok, sst_ok
- ! use these for debug prints
- TYPE(ESMF_Time) :: currentTime
- INTEGER, SAVE :: numtimes=0 ! track number of calls
- CHARACTER(LEN=256) :: timestamp
- ! count calls for debug prints...
- CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- CALL wrf_error_fatal ( 'compare_data: ESMF_ClockGet() failed' )
- ENDIF
- CALL wrf_timetoa ( currentTime, timestamp )
- numtimes = numtimes + 1
- WRITE(str,*) 'SST compare_data: begin, numtimes = ',numtimes,' time = ',TRIM(timestamp)
- CALL wrf_debug ( 100 , TRIM(str) )
- ! extract data from the importState and compare with data from file
- !TODO: change this to Bundles, eventually
- CALL ESMF_StateGet( importState, TRIM(datanames(SST_INDX)), &
- in_sst_field, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- CALL wrf_error_fatal ( &
- 'could not extract sea_surface_temperature field from importState' )
- ENDIF
- CALL ESMF_StateGet( importState, TRIM(datanames(LANDMASK_INDX)), &
- in_landmask_field, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- CALL wrf_error_fatal ( &
- 'could not extract land_binary_mask field from importState' )
- ENDIF
- ! CALL ESMF_FieldGetDataPointer( in_sst_field, in_sst_ptr, rc=rc )
- CALL ESMF_FieldGet( in_sst_field, 0, in_sst_ptr, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- CALL wrf_error_fatal ( &
- 'could not extract sea_surface_temperature data from sea_surface_temperature field' )
- ENDIF
- ALLOCATE( in_sst_ptr_real(ims:ime,jms:jme) )
- WRITE( str,* ) 'compare_data, ips:ipe,jps:jpe = ', &
- ips,':',ipe,',',jps,':',jpe, &
- ', in_sst_ptr(BOUNDS) = ', &
- LBOUND(in_sst_ptr,1),':',UBOUND(in_sst_ptr,1),',', &
- LBOUND(in_sst_ptr,2),':',UBOUND(in_sst_ptr,2)
- CALL wrf_debug ( 100 , TRIM(str) )
- DO j= jms, jme
- DO i= ims, ime
- in_sst_ptr_real(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
- ENDDO
- ENDDO
- in_sst_ptr_real(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) = &
- in_sst_ptr(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe))
- ! CALL ESMF_FieldGetDataPointer( in_landmask_field, in_landmask_ptr, rc=rc )
- CALL ESMF_FieldGet( in_landmask_field, 0, in_landmask_ptr, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- CALL wrf_error_fatal ( &
- 'could not extract land_binary_mask data from land_binary_mask field' )
- ENDIF
- ALLOCATE( in_landmask_ptr_real(ims:ime,jms:jme) )
- WRITE( str,* ) 'compare_data, ips:ipe,jps:jpe = ', &
- ips,':',ipe,',',jps,':',jpe, &
- ', in_landmask_ptr(BOUNDS) = ', &
- LBOUND(in_landmask_ptr,1),':',UBOUND(in_landmask_ptr,1),',', &
- LBOUND(in_landmask_ptr,2),':',UBOUND(in_landmask_ptr,2)
- CALL wrf_debug ( 100 , TRIM(str) )
- DO j= jms, jme
- DO i= ims, ime
- in_landmask_ptr_real(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
- ENDDO
- ENDDO
- in_landmask_ptr_real(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) = &
- in_landmask_ptr(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe))
- ! compare LANDMASK...
- landmask_ok = .TRUE.
- ! staggered starts/ends
- LANDMASK_COMPARE : DO j= jps , MIN( (jde-1), jpe )
- DO i= ips , MIN( (ide-1), ipe )
- IF ( file_landmask_data(i,j) /= in_landmask_ptr_real(i,j) ) THEN
- landmask_ok = .FALSE.
- WRITE( str , * ) 'error landmask mismatch at (i,j) = (',i,',',j, &
- '), values are',file_landmask_data(i,j),' and ', &
- in_landmask_ptr_real(i,j)
- EXIT LANDMASK_COMPARE
- ENDIF
- ENDDO
- ENDDO LANDMASK_COMPARE
- IF ( landmask_ok ) THEN
- WRITE(str,*) 'TESTING data returned from WRF through ESMF: LANDMASK compares OK'
- CALL wrf_debug ( 0 , TRIM(str) )
- ELSE
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- ! compare SST...
- sst_ok = .TRUE.
- ! staggered starts/ends
- SST_COMPARE : DO j= jps , MIN( (jde-1), jpe )
- DO i= ips , MIN( (ide-1), ipe )
- IF ( file_sst_data(i,j) /= in_sst_ptr_real(i,j) ) THEN
- sst_ok = .FALSE.
- WRITE( str , * ) 'error sst mismatch at (i,j) = (',i,',',j, &
- '), values are',file_sst_data(i,j),' and ', &
- in_sst_ptr_real(i,j)
- EXIT SST_COMPARE
- ENDIF
- ENDDO
- ENDDO SST_COMPARE
- IF ( sst_ok ) THEN
- WRITE(str,*) 'TESTING data returned from WRF through ESMF: SST compares OK'
- CALL wrf_debug ( 0 , TRIM(str) )
- ELSE
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- DEALLOCATE( in_sst_ptr_real, in_landmask_ptr_real )
- WRITE(str,*) 'compare_data: end, numtimes = ',numtimes
- CALL wrf_debug ( 100 , TRIM(str) )
- END SUBROUTINE compare_data
- ! Second-phase "init" gets decomposition information from
- ! importState.
- SUBROUTINE sst_component_init2( gcomp, importState, exportState, clock, rc )
- USE module_metadatautils, ONLY: GetDecompFromState
- USE module_io
- TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
- TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState
- TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState
- TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
- INTEGER, INTENT( OUT) :: rc
- !<DESCRIPTION>
- ! SST component init routine, phase 2.
- !
- ! The arguments are:
- ! gcomp Component
- ! importState Importstate
- ! exportState Exportstate
- ! clock External clock
- ! rc Return code; equals ESMF_SUCCESS if there are no errors,
- ! otherwise ESMF_FAILURE.
- !</DESCRIPTION>
- ! Local variables
- TYPE(ESMF_Field) :: out_sst_field, out_landmask_field
- TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
- INTEGER, PARAMETER :: NUMDIMS=2
- INTEGER :: DomainStart(NUMDIMS)
- INTEGER :: DomainEnd(NUMDIMS)
- INTEGER :: MemoryStart(NUMDIMS)
- INTEGER :: MemoryEnd(NUMDIMS)
- INTEGER :: PatchStart(NUMDIMS)
- INTEGER :: PatchEnd(NUMDIMS)
- INTEGER :: rc, i, j
- INTEGER :: ierr
- ! Get decomposition information from importState. Note that index
- ! values are for staggered dimensions, following the WRF convention.
- !TODO: Note that this will only work for SPMD serial operation. For
- !TODO: concurrent operation (SPMD or MPMD), we will need to create a new
- !TODO: "domdesc" suitable for the task layout of the SST component. For
- !TODO: MPMD serial operation, we will need to extract serialized domdesc
- !TODO: from export state metadata and de-serialize it. Similar arguments
- !TODO: apply to [ij][mp][se] and bdy_mask.
- write(str,*) 'sst_component_init2: calling GetDecompFromState'
- CALL wrf_debug ( 100 , TRIM(str) )
- CALL GetDecompFromState( importState, &
- ids, ide, jds, jde, kds, kde, &
- ims, ime, jms, jme, kms, kme, &
- ips, ipe, jps, jpe, kps, kpe, &
- domdesc, bdy_mask )
- write(str,*) 'sst_component_init2: back from GetDecompFromState'
- CALL wrf_debug ( 100 , TRIM(str) )
- write(str,*) 'sst_component_init2: ids, ide, jds, jde, kds, kde = ', ids, ide, jds, jde, kds, kde
- CALL wrf_debug ( 100 , TRIM(str) )
- write(str,*) 'sst_component_init2: ims, ime, jms, jme, kms, kme = ', ims, ime, jms, jme, kms, kme
- CALL wrf_debug ( 100 , TRIM(str) )
- write(str,*) 'sst_component_init2: ips, ipe, jps, jpe, kps, kpe = ', ips, ipe, jps, jpe, kps, kpe
- CALL wrf_debug ( 100 , TRIM(str) )
- ! allocate space for data read from disk
- ALLOCATE( file_sst_data (ims:ime,jms:jme) )
- DO j= jms, jme
- DO i= ims, ime
- file_sst_data(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
- ENDDO
- ENDDO
- !TODO: Hmmm... really need to load these pointers here? Check...
- this_data(SST_INDX)%r2d => file_sst_data
- ALLOCATE( file_landmask_data(ims:ime,jms:jme) )
- DO j= jms, jme
- DO i= ims, ime
- file_landmask_data(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
- ENDDO
- ENDDO
- this_data(LANDMASK_INDX)%r2d => file_landmask_data
- ! Create ESMF_Fields in importState and exportState
- ! Create ESMF_Grid. Use exactly the same method as WRF so WRFIO will
- ! work.
- DomainStart(1) = ids; DomainEnd(1) = ide;
- DomainStart(2) = jds; DomainEnd(2) = jde;
- MemoryStart(1) = ims; MemoryEnd(1) = ime;
- MemoryStart(2) = jms; MemoryEnd(2) = jme;
- PatchStart(1) = ips; PatchEnd(1) = ipe;
- PatchStart(2) = jps; PatchEnd(2) = jpe
- !write(0,*)__FILE__,__LINE__,'DomainStart ',DomainStart(1:2)
- !write(0,*)__FILE__,__LINE__,'DomainEnd ',DomainEnd(1:2)
- !write(0,*)__FILE__,__LINE__,'MemoryStart ',MemoryStart(1:2)
- !write(0,*)__FILE__,__LINE__,'MemoryEnd ',MemoryEnd(1:2)
- !write(0,*)__FILE__,__LINE__,'PatchStart ',PatchStart(1:2)
- !write(0,*)__FILE__,__LINE__,'PatchEnd ',PatchEnd(1:2)
- CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: Calling ioesmf_create_grid_int()' )
- CALL ioesmf_create_grid_int( esmfgrid, NUMDIMS, &
- DomainStart, DomainEnd, &
- MemoryStart, MemoryEnd, &
- PatchStart, PatchEnd )
- !write(0,*)__FILE__,__LINE__
- CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: back from ioesmf_create_grid_int()' )
- ! create ESMF_Fields
- ! Note use of patch dimension for POINTERs allocated by ESMF.
- CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: Calling ESMF_GridValidate(esmfgrid)' )
- CALL ESMF_GridValidate( esmfgrid, rc=rc )
- !write(0,*)__FILE__,__LINE__
- IF ( rc /= ESMF_SUCCESS ) THEN
- WRITE( str,* ) 'Error in ESMF_GridValidate ', &
- __FILE__ , &
- ', line ', &
- __LINE__ , &
- ', error code = ',rc
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: back OK from ESMF_GridValidate(esmfgrid)' )
- !TODO: Once new ESMF 3.0 interfaces have settled down, eliminate "tmp_data_"
- !TODO: arrays and let ESMF allocate/deallocate them. Assuming of course that
- !TODO: we can convince ESMF to deallocate safely...
- !write(0,*)__FILE__,__LINE__
- ALLOCATE( tmp_data_out_sst(ips:ipe,jps:jpe) )
- !write(0,*)__FILE__,__LINE__
- write(str,*) 'sst_component_init2: tmp_data_out_sst(', &
- LBOUND(tmp_data_out_sst,1),':',UBOUND(tmp_data_out_sst,1),',',LBOUND(tmp_data_out_sst,2),':',UBOUND(tmp_data_out_sst,2),')'
- CALL wrf_debug ( 100 , TRIM(str) )
- CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(out_sst_field)' )
- !write(0,*)__FILE__,__LINE__,trim(datanames(sst_indx))
- !write(0,*)__FILE__,__LINE__,ips,jps,ipe,jpe
- out_sst_field = ESMF_FieldCreate( &
- esmfgrid, tmp_data_out_sst, &
- datacopyflag=ESMF_DATACOPY_REFERENCE, &
- staggerloc=ESMF_STAGGERLOC_CENTER, &
- name=TRIM(datanames(SST_INDX)), &
- rc=rc )
- !write(0,*)__FILE__,__LINE__,'Creating out_sst_field for exportState of SST component name ',TRIM(datanames(SST_INDX))
- IF ( rc /= ESMF_SUCCESS ) THEN
- WRITE( str,* ) 'ESMF_FieldCreate(out_sst_field) failed ', &
- __FILE__ , &
- ', line ', &
- __LINE__ , &
- ', error code = ',rc
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(out_sst_field)' )
- write(str,*) 'sst_component_init2: ips:ipe,jps:jpe = ', &
- ips,':',ipe,',',jps,':',jpe
- CALL wrf_debug ( 100 , TRIM(str) )
- !TODO: This bit will be useful once ESMF handles allocation/deallocation.
- ! validate ESMF allocation
- IF ( ( ips /= LBOUND(tmp_data_out_sst,1) ) .OR. ( ipe /= UBOUND(tmp_data_out_sst,1) ) .OR. &
- ( jps /= LBOUND(tmp_data_out_sst,2) ) .OR. ( jpe /= UBOUND(tmp_data_out_sst,2) ) ) THEN
- WRITE( str,* ) 'ESMF_FieldCreate(out_sst_field) allocation failed ', &
- __FILE__ , &
- ', line ', &
- __LINE__ , &
- ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
- ', tmp_data_out_sst(BOUNDS) = ',LBOUND(tmp_data_out_sst,1),':',UBOUND(tmp_data_out_sst,1),',', &
- LBOUND(tmp_data_out_sst,2),':',UBOUND(tmp_data_out_sst,2)
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- ALLOCATE( tmp_data_out_landmask(ips:ipe,jps:jpe) )
- write(str,*) 'sst_component_init2: tmp_data_out_landmask(', &
- LBOUND(tmp_data_out_landmask,1),':',UBOUND(tmp_data_out_landmask,1),',',LBOUND(tmp_data_out_landmask,2),':',UBOUND(tmp_data_out_landmask,2),')'
- CALL wrf_debug ( 100 , TRIM(str) )
- CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(out_landmask_field)' )
- out_landmask_field = ESMF_FieldCreate( &
- esmfgrid, tmp_data_out_landmask, &
- datacopyflag=ESMF_DATACOPY_REFERENCE, &
- staggerloc=ESMF_STAGGERLOC_CENTER, &
- name=TRIM(datanames(LANDMASK_INDX)), &
- ! lbounds=(/ips,jps/), &
- ! ubounds=(/ipe,jpe/), &
- rc=rc )
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'ESMF_FieldCreate(out_landmask_field) failed' )
- ENDIF
- CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(out_landmask_field)' )
- !TODO: This bit will be useful once ESMF handles allocation/deallocation.
- ! validate ESMF allocation
- IF ( ( ips /= LBOUND(tmp_data_out_landmask,1) ) .OR. ( ipe /= UBOUND(tmp_data_out_landmask,1) ) .OR. &
- ( jps /= LBOUND(tmp_data_out_landmask,2) ) .OR. ( jpe /= UBOUND(tmp_data_out_landmask,2) ) ) THEN
- WRITE( str,* ) 'ESMF_FieldCreate(out_landmask_field) allocation failed ', &
- __FILE__ , &
- ', line ', &
- __LINE__ , &
- ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
- ', tmp_data_out_landmask(BOUNDS) = ',LBOUND(tmp_data_out_landmask,1),':',UBOUND(tmp_data_out_landmask,1),',', &
- LBOUND(tmp_data_out_landmask,2),':',UBOUND(tmp_data_out_landmask,2)
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- ALLOCATE( tmp_data_in_sst(ips:ipe,jps:jpe) )
- write(str,*) 'sst_component_init2: tmp_data_in_sst(', &
- LBOUND(tmp_data_in_sst,1),':',UBOUND(tmp_data_in_sst,1),',',LBOUND(tmp_data_in_sst,2),':',UBOUND(tmp_data_in_sst,2),')'
- CALL wrf_debug ( 100 , TRIM(str) )
- CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(in_sst_field)' )
- in_sst_field = ESMF_FieldCreate( &
- esmfgrid, tmp_data_in_sst, &
- datacopyflag=ESMF_DATACOPY_REFERENCE, &
- staggerloc=ESMF_STAGGERLOC_CENTER, &
- name=TRIM(datanames(SST_INDX)), &
- ! lbounds=(/ips,jps/), &
- ! ubounds=(/ipe,jpe/), &
- rc=rc )
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'ESMF_FieldCreate(in_sst_field) failed' )
- ENDIF
- CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(in_sst_field)' )
- !TODO: This bit will be useful once ESMF handles allocation/deallocation.
- ! validate ESMF allocation
- IF ( ( ips /= LBOUND(tmp_data_in_sst,1) ) .OR. ( ipe /= UBOUND(tmp_data_in_sst,1) ) .OR. &
- ( jps /= LBOUND(tmp_data_in_sst,2) ) .OR. ( jpe /= UBOUND(tmp_data_in_sst,2) ) ) THEN
- WRITE( str,* ) 'ESMF_FieldCreate(in_sst_field) allocation failed ', &
- __FILE__ , &
- ', line ', &
- __LINE__ , &
- ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
- ', tmp_data_in_sst(BOUNDS) = ',LBOUND(tmp_data_in_sst,1),':',UBOUND(tmp_data_in_sst,1),',', &
- LBOUND(tmp_data_in_sst,2),':',UBOUND(tmp_data_in_sst,2)
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- ALLOCATE( tmp_data_in_landmask(ips:ipe,jps:jpe) )
- write(str,*) 'sst_component_init2: tmp_data_in_landmask(', &
- LBOUND(tmp_data_in_landmask,1),':',UBOUND(tmp_data_in_landmask,1),',',LBOUND(tmp_data_in_landmask,2),':',UBOUND(tmp_data_in_landmask,2),')'
- CALL wrf_debug ( 100 , TRIM(str) )
- CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(in_landmask_field)' )
- in_landmask_field = ESMF_FieldCreate( &
- esmfgrid, tmp_data_in_landmask, &
- datacopyflag=ESMF_DATACOPY_REFERENCE, &
- staggerloc=ESMF_STAGGERLOC_CENTER, &
- name=TRIM(datanames(LANDMASK_INDX)), &
- ! lbounds=(/ips,jps/), &
- ! ubounds=(/ipe,jpe/), &
- rc=rc )
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'ESMF_FieldCreate(in_landmask_field) failed' )
- ENDIF
- CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(in_landmask_field)' )
- !TODO: This bit will be useful once ESMF handles allocation/deallocation.
- ! validate ESMF allocation
- IF ( ( ips /= LBOUND(tmp_data_in_landmask,1) ) .OR. ( ipe /= UBOUND(tmp_data_in_landmask,1) ) .OR. &
- ( jps /= LBOUND(tmp_data_in_landmask,2) ) .OR. ( jpe /= UBOUND(tmp_data_in_landmask,2) ) ) THEN
- WRITE( str,* ) 'ESMF_FieldCreate(in_landmask_field) allocation failed ', &
- __FILE__ , &
- ', line ', &
- __LINE__ , &
- ', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
- ', tmp_data_in_landmask(BOUNDS) = ',LBOUND(tmp_data_in_landmask,1),':',UBOUND(tmp_data_in_landmask,1),',', &
- LBOUND(tmp_data_in_landmask,2),':',UBOUND(tmp_data_in_landmask,2)
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- ! attach ESMF_Field to importState
- CALL ESMF_StateAdd( importState, fieldList=(/in_sst_field/), rc=rc )
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'ESMF_StateAdd(in_sst_field) failed' )
- ENDIF
- CALL ESMF_StateAdd( importState, fieldList=(/in_landmask_field/), rc=rc )
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'ESMF_StateAdd(in_landmask_field) failed' )
- ENDIF
- ! attach ESMF_Field to exportState
- CALL ESMF_StateAdd( exportState, fieldList=(/out_sst_field/), rc=rc )
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'ESMF_StateAdd(out_sst_field) failed' )
- ENDIF
- CALL ESMF_StateAdd( exportState, fieldList=(/out_landmask_field/), rc=rc )
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'ESMF_StateAdd(out_landmask_field) failed' )
- ENDIF
- ! Open the "SST" input data file for reading.
- write(str,'(A,A)') 'sst_component_init2: Opening data file ', &
- TRIM(sstinfilename)
- CALL wrf_message ( TRIM(str) )
- CALL wrf_open_for_read ( TRIM(sstinfilename) , &
- mpicom , &
- mpicom , &
- "DATASET=INPUT" , &
- fid , &
- ierr )
- IF ( ierr .NE. 0 ) THEN
- WRITE( str , FMT='(A,A,A,I8)' ) &
- 'sst_component_init2: error opening ', &
- TRIM(sstinfilename),' for reading ierr=',ierr
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- WRITE( str , FMT='(A,A,A,I8)' ) &
- 'subroutine sst_component_init2: opened file ', &
- TRIM(sstinfilename),' for reading fid=',fid
- CALL wrf_debug ( 100, TRIM(str) )
- write(str,'(A)') 'sst_component_init2: returning rc=ESMF_SUCCESS'
- CALL wrf_debug ( 100 , TRIM(str) )
- rc = ESMF_SUCCESS
- END SUBROUTINE sst_component_init2
- SUBROUTINE sst_component_run1( gcomp, importState, exportState, clock, rc )
- TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
- TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
- TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
- INTEGER, INTENT( OUT) :: rc
- !<DESCRIPTION>
- ! SST component run routine, phase 1.
- ! Read "SST" data from file and stuff into exportState.
- !
- ! The arguments are:
- ! gcomp Component
- ! importState Importstate
- ! exportState Exportstate
- ! clock External clock
- ! rc Return code; equals ESMF_SUCCESS if there are no errors,
- ! otherwise ESMF_FAILURE.
- !</DESCRIPTION>
- rc = ESMF_SUCCESS
- ! Get "SST" data from file and stuff it into exportState.
- CALL read_data( exportState, clock )
- END SUBROUTINE sst_component_run1
- SUBROUTINE sst_component_run2( gcomp, importState, exportState, clock, rc )
- TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
- TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
- TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
- INTEGER, INTENT( OUT) :: rc
- !<DESCRIPTION>
- ! SST component run routine, phase 2.
- ! Get from importState, compare with file data, and error-exit
- ! if they differ... If they are the same, then
- ! stuff the file data into the exportState.
- !
- ! The arguments are:
- ! gcomp Component
- ! importState Importstate
- ! exportState Exportstate
- ! clock External clock
- ! rc Return code; equals ESMF_SUCCESS if there are no errors,
- ! otherwise ESMF_FAILURE.
- !</DESCRIPTION>
- rc = ESMF_SUCCESS
- ! Get from importState, compare with file data, and error_exit
- ! if they differ...
- !TODO: change this once WRF can load exportState after integrating
- ! This works because WRF loads its exportState BEFORE integrating.
- CALL wrf_clockprint ( 50, clock, 'sst_component_run2: clock before call to compare_data()' )
- CALL compare_data( importState, clock )
- CALL wrf_clockprint ( 50, clock, 'sst_component_run2: clock after call to compare_data()' )
- END SUBROUTINE sst_component_run2
- SUBROUTINE sst_component_finalize( gcomp, importState, exportState, clock, rc )
- USE module_io
- TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
- TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
- TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
- INTEGER, INTENT( OUT) :: rc
- !<DESCRIPTION>
- ! SST component finalize routine.
- !
- ! The arguments are:
- ! gcomp Component
- ! importState Importstate
- ! exportState Exportstate
- ! clock External clock
- ! rc Return code; equals ESMF_SUCCESS if there are no errors,
- ! otherwise ESMF_FAILURE.
- !</DESCRIPTION>
- ! Local variables
- TYPE(ESMF_Field) :: tmp_field
- INTEGER :: i, ierr
- rc = ESMF_SUCCESS
- ! destroy ESMF_Fields and other "deep" objects created by this component
- ! note that this component relied on ESMF to allocate data pointers during
- ! calls to ESMF_FieldCreate() so it also expects ESMF to free these pointers
- DO i=1, datacount
- ! destroy field in importState
- CALL ESMF_StateGet( importState, TRIM(datanames(i)), tmp_field, &
- rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- WRITE( str , * ) &
- 'sst_component_finalize: ESMF_StateGet( importState,', &
- TRIM(datanames(i)),') failed'
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- CALL ESMF_FieldDestroy( tmp_field, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- WRITE( str , * ) &
- 'sst_component_finalize: ESMF_FieldDestroy( importState,', &
- TRIM(datanames(i)),') failed'
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- ! destroy field in exportState
- CALL ESMF_StateGet( exportState, TRIM(datanames(i)), tmp_field, &
- rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- WRITE( str , * ) &
- 'sst_component_finalize: ESMF_StateGet( exportState,', &
- TRIM(datanames(i)),') failed'
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- CALL ESMF_FieldDestroy( tmp_field, rc=rc )
- IF (rc /= ESMF_SUCCESS) THEN
- WRITE( str , * ) &
- 'sst_component_finalize: ESMF_FieldDestroy( exportState,', &
- TRIM(datanames(i)),') failed'
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- ENDDO
- ! deallocate space for data read from disk
- DEALLOCATE( file_sst_data, file_landmask_data )
- ! close SST data file
- WRITE( str , FMT='(A,I8)' ) &
- 'subroutine sst_component_finalize: closing file fid=',fid
- CALL wrf_debug ( 100, TRIM(str) )
- CALL wrf_ioclose( fid , ierr )
- IF ( ierr .NE. 0 ) THEN
- CALL wrf_error_fatal ( 'sst_component_finalize: wrf_ioclose failed' )
- ENDIF
- END SUBROUTINE sst_component_finalize
- END MODULE module_sst_component_top
- MODULE module_sst_setservices
- !<DESCRIPTION>
- ! This module defines SST "Set Services" method sst_register()
- ! used for ESMF coupling.
- !</DESCRIPTION>
- USE module_sst_component_top, ONLY: sst_component_init1, &
- sst_component_init2, &
- sst_component_run1, &
- sst_component_run2, &
- sst_component_finalize
- ! Updated for ESMF 5.2.0r
- ! USE ESMF_Mod
- USE ESMF
- IMPLICIT NONE
- ! everything is private by default
- PRIVATE
- ! Public entry point for ESMF_GridCompSetServices()
- PUBLIC SST_register
- ! private stuff
- CHARACTER (ESMF_MAXSTR) :: str
- CONTAINS
- SUBROUTINE sst_register(gcomp, rc)
- TYPE(ESMF_GridComp), INTENT(INOUT) :: gcomp
- INTEGER, INTENT(OUT) :: rc
- INTEGER :: finalrc
- !
- !<DESCRIPTION>
- ! SST_register - Externally visible registration routine
- !
- ! User-supplied SetServices routine.
- ! The Register routine sets the subroutines to be called
- ! as the init, run, and finalize routines. Note that these are
- ! private to the module.
- !
- ! The arguments are:
- ! gcomp Component
- ! rc Return code; equals ESMF_SUCCESS if there are no errors,
- ! otherwise ESMF_FAILURE.
- !</DESCRIPTION>
- finalrc = ESMF_SUCCESS
- ! Register the callback routines.
- call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
- sst_component_init1, phase=1, rc=rc)
- IF ( rc /= ESMF_SUCCESS) THEN
- WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_init1) failed with rc = ', rc
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
- sst_component_init2, phase=2, rc=rc)
- IF ( rc /= ESMF_SUCCESS) THEN
- WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_init2) failed with rc = ', rc
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_RUN, &
- sst_component_run1, phase=1, rc=rc)
- IF ( rc /= ESMF_SUCCESS) THEN
- WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_run1) failed with rc = ', rc
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_RUN, &
- sst_component_run2, phase=2, rc=rc)
- IF ( rc /= ESMF_SUCCESS) THEN
- WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_run2) failed with rc = ', rc
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_FINALIZE, &
- sst_component_finalize, rc=rc)
- IF ( rc /= ESMF_SUCCESS) THEN
- WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_finalize) failed with rc = ', rc
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- PRINT *,'SST: Registered Initialize, Run, and Finalize routines'
- rc = finalrc
- END SUBROUTINE sst_register
- END MODULE module_sst_setservices
- !<DESCRIPTION>
- ! Module module_wrfsst_coupler defines the
- ! "WRF-SST" coupler component. It provides two-way coupling between
- ! the "SST" and "WRF" components.
- ! In its run routine it transfers data directly from the
- ! SST Component's export state to the WRF Component's import state.
- ! It also transfers data directly from the
- ! WRF Component's export state to the SST Component's import state.
- !
- ! This is derived from src/demo/coupled_flow/src/CouplerMod.F90
- ! created by Nancy Collins and others on the ESMF Core Team.
- !
- !</DESCRIPTION>
- MODULE module_wrfsst_coupler
- ! Updated for ESMF 5.2.0r
- ! USE ESMF_Mod
- USE ESMF
- IMPLICIT NONE
-
- ! everything is private by default
- PRIVATE
- ! Public entry point
- PUBLIC WRFSSTCpl_register
- ! private data members
- ! route handles and flags
- TYPE(ESMF_RouteHandle), SAVE :: fromWRF_rh, fromSST_rh
- LOGICAL, SAVE :: fromWRF_rh_ready = .FALSE.
- LOGICAL, SAVE :: fromSST_rh_ready = .FALSE.
- ! field names
- INTEGER, PARAMETER :: datacount = 2
- INTEGER, PARAMETER :: SST_INDX = 1
- INTEGER, PARAMETER :: LANDMASK_INDX = 2
- CHARACTER(LEN=ESMF_MAXSTR), SAVE :: datanames(datacount)
- CHARACTER(LEN=ESMF_MAXSTR) :: str
- CONTAINS
- SUBROUTINE WRFSSTCpl_register(comp, rc)
- TYPE(ESMF_CplComp), INTENT(INOUT) :: comp
- INTEGER, INTENT(OUT) :: rc
- !
- !<DESCRIPTION>
- ! WRFSSTCpl_register - Externally visible registration routine
- !
- ! User-supplied SetServices routine.
- ! The Register routine sets the subroutines to be called
- ! as the init, run, and finalize routines. Note that these are
- ! private to the module.
- !
- ! The arguments are:
- ! comp Component
- ! rc Return code; equals ESMF_SUCCESS if there are no errors,
- ! otherwise ESMF_FAILURE.
- !</DESCRIPTION>
- ! guilty until proven innocent
- rc = ESMF_FAILURE
- ! Register the callback routines.
- call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, WRFSSTCpl_init, &
- rc=rc)
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_init) failed' )
- ENDIF
- call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, WRFSSTCpl_run, &
- rc=rc)
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_run) failed' )
- ENDIF
- call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, WRFSSTCpl_final, &
- rc=rc)
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_final) failed' )
- ENDIF
- print *, "module_wrfsst_coupler: Registered Initialize, Run, and Finalize routines"
- END SUBROUTINE WRFSSTCpl_register
- SUBROUTINE WRFSSTCpl_init(comp, importState, exportState, clock, rc)
- USE module_metadatautils, ONLY: AttachDecompToState, GetDecompFromState
- TYPE(ESMF_CplComp), INTENT(INOUT) :: comp
- TYPE(ESMF_State), INTENT(INOUT) :: importState, exportState
- TYPE(ESMF_Clock), INTENT(INOUT) :: clock
- INTEGER, INTENT(OUT) :: rc
- !<DESCRIPTION>
- ! WRF-SST coupler component init routine. This simply passes needed
- ! metadata from WRF to SST. Initialization of ESMF_RouteHandle objects
- ! is handled later via lazy evaluation.
- !
- ! The arguments are:
- ! comp Component
- ! importState Importstate
- ! exportState Exportstate
- ! clock External clock
- ! rc Return code; equals ESMF_SUCCESS if there are no errors,
- ! otherwise ESMF_FAILURE.
- !</DESCRIPTION>
- ! Local variables
- CHARACTER(ESMF_MAXSTR) :: importstatename
- ! decomposition information
- INTEGER :: ids, ide, jds, jde, kds, kde
- INTEGER :: ims, ime, jms, jme, kms, kme
- INTEGER :: ips, ipe, jps, jpe, kps, kpe
- INTEGER :: domdesc
- LOGICAL :: bdy_mask(4)
- PRINT *, "DEBUG: Coupler Init starting"
- ! guilty until proven innocent
- rc = ESMF_FAILURE
- CALL ESMF_StateGet(importState, name=importstatename, rc=rc)
- IF ( rc /= ESMF_SUCCESS ) THEN
- CALL wrf_error_fatal ( 'WRFSSTCpl_init: ESMF_StateGet failed' )
- ENDIF
- IF ( TRIM(importstatename) .EQ. "WRF Export State" ) THEN
- ! get metadata from WRF export state
- CALL GetDecompFromState( importState, &
- ids, ide, jds, jde, kds, kde, &
- ims, ime, jms, jme, kms, kme, &
- ips, ipe, jps, jpe, kps, kpe, &
- domdesc, bdy_mask )
- ! put metadata from in SST import state
- CALL AttachDecompToState( exportState, &
- ids, ide, jds, jde, kds, kde, &
- ims, ime, jms, jme, kms, kme, &
- ips, ipe, jps, jpe, kps, kpe, &
- domdesc, bdy_mask )
- ELSE
- WRITE(str,*)'WRFSSTCpl_init: invalid importState name: ',TRIM(importstatename)
- CALL wrf_error_fatal ( TRIM(str) )
- ENDIF
- ! set up field names
- !TODO: use CF conventions for "standard_name" once WRF Registry supports them
- !TODO: datanames(SST_INDX) = "sea_surface_temperature"
- !TODO: datanames(LANDMASK_INDX) = "land_binary_mask"
- datanames(SST_INDX) = "SST"
- datanames(LANDMASK_INDX) = "LANDMASK"
- PRINT *, "DEBUG: Coupler Init returning"
-
- END SUBROUTINE WRFSSTCpl_init
- SUBROUTINE WRFSSTCpl_run(comp, importState, exportState, clock, rc)
- USE ESMF
- TYPE(ESMF…
Large files files are truncated, but you can click here to view the full file