ecearth3/sources/oasis3-mct/lib/mct/examples/climate_sequen1/srcmodel.F90

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!-----------------------------------------------------------------------
! CVS srcmodel.F90,v 1.8 2005-11-18 23:15:38 rloy Exp
! CVS MCT_2_8_0 
!BOP -------------------------------------------------------------------
!
! !MODULE: srcmodel -- generic model for unit tester
!
! !DESCRIPTION:
! init run and finalize methods for source model
!
module srcmodel

!
! !USES:
!
! Get the things needed from MCT by "Use,only" with renaming:
!
!---Domain Decomposition Descriptor DataType and associated methods
use m_GlobalSegMap,only: GlobalSegMap
use m_GlobalSegMap,only: GlobalSegMap_init => init
use m_GlobalSegMap,only: GlobalSegMap_lsize => lsize
use m_GlobalSegMap,only: GlobalSegMap_clean => clean
!---Field Storage DataType and associated methods
use m_AttrVect,only    : AttrVect
use m_AttrVect,only    : AttrVect_init => init
use m_AttrVect,only    : AttrVect_lsize => lsize
use m_AttrVect,only    : AttrVect_clean => clean
use m_AttrVect,only    : AttrVect_copy => copy
use m_AttrVect,only    : AttrVect_zero => zero
use m_AttrVect,only    : AttrVect_indxR => indexRA
use m_AttrVect,only    : AttrVect_importRAttr => importRAttr
use m_AttrVectComms,only : AttrVect_scatter => scatter

! Get things from MPEU
use m_inpak90   ! Resource files
use m_stdio     ! I/O utils
use m_ioutil

! Get utilities for this program.
use mutils

implicit none

private
! except
      
! !PUBLIC MEMBER FUNCTIONS:

public srcinit
public srcrun
public srcfin

! private module variables
character(len=*), parameter :: modelname='srcmodel.F90'
integer  :: rank
real, dimension(:), pointer :: avdata

!EOP -------------------------------------------------------------------

contains

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: srcinit  - Source model initialization

subroutine srcinit(GSMap,IMPORT,EXPORT,comm,compid)

! !INPUT PARAMETERS:
  type(GlobalSegMap),intent(inout) :: GSMap    !  decomposition
  type(AttrVect),intent(inout)     :: IMPORT,EXPORT  !  state data
  integer,intent(in)               :: comm     !  MPI communicator
  integer,intent(in)               :: compid   !  component ID
!
!EOP ___________________________________________________________________

!     local variables

!     parameters for this model
  integer :: nxa   ! number of points in x-direction
  integer :: nya   ! number of points in y-direction

  integer :: i,j,k,mdev,fx,fy
  integer :: nprocs, root, ier,fileno

! GlobalSegMap variables
  integer,dimension(:),pointer :: lindex

! AttrVect variables
  integer :: avsize
  type(AttrVect)   :: GlobalD  ! Av to hold global data

  real,dimension(:),pointer :: rootdata

  character*2 :: ldecomp


  call MPI_COMM_RANK(comm,rank, ier)
  call MPI_COMM_SIZE(comm,nprocs,ier)

  if(rank==0) then
    write(6,*) modelname, ' init start'
    write(6,*) modelname,' MyID ', compid
    write(6,*) modelname,' Num procs ', nprocs
  endif

!  Get configuration
   call i90_LoadF('src.rc',ier)

   call i90_label('nx:',ier)
   nxa=i90_gint(ier)
   call i90_label('ny:',ier)
   nya=i90_gint(ier)
  if(rank==0) write(6,*) modelname, ' x,y ', nxa,nya

   call i90_label('decomp:',ier)
   call i90_Gtoken(ldecomp, ier)
  if(rank==0) write(6,*) modelname, ' decomp ', ldecomp

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Initialize a Global Segment Map


  call get_index(ldecomp,nprocs,rank,nxa,nya,lindex)

  call GlobalSegMap_init(GSMap,lindex,comm,compid,gsize=nxa*nya)



!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  if(rank==0) write(6,*) modelname, ' GSMap ',GSMap%ngseg,GSMap%gsize


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Initialize import and export Attribute vectors

! size is the number of grid points on this processor
  avsize = GlobalSegMap_lsize(GSMap,comm)
  if(rank==0) write(6,*) modelname, ' localsize ', avsize

! Initialize the IMPORT  Av by scattering from a root Av
! with real data.

! Read in data from root and scatter to nodes
  if(rank==0) then
    call AttrVect_init(GlobalD,rList="field1:field2",lsize=nxa*nya)
    mdev=luavail()
    open(mdev, file="TS1.dat",status="old")
    read(mdev,*) fx,fy
    do i=1,nxa*nya
      read(mdev,*) GlobalD%rAttr(1,i)
    enddo
    write(6,*) modelname,'Global init ',GlobalD%rAttr(1,1),GlobalD%rAttr(1,8000)
  endif

! this scatter will create IMPORT if it hasn't already been initialized
  call AttrVect_scatter(GlobalD,IMPORT,GSMap,0,comm,ier)

! initialize EXPORT Av with two real attributes.
  call AttrVect_init(EXPORT,rList="field3:field4",lsize=avsize)
  
  call AttrVect_zero(EXPORT)

  if(rank==0) then
    write(6,*) modelname, rank,' IMPORT field1', IMPORT%rAttr(1,1)
    write(6,*) modelname, rank,' IMPORt field2', IMPORT%rAttr(2,1)
    write(6,*) modelname, rank,' EXPORT field3', EXPORT%rAttr(1,1)
    write(6,*) modelname, rank,' EXPORT field4', EXPORT%rAttr(2,1)
  endif

! allocate buffer for use in run method
  allocate(avdata(avsize),stat=ier)

  if(rank==0) write(6,*) modelname, ' init done'
end subroutine srcinit
!!! END OF INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   RUN PHASE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: srcrun  - Source model run method

subroutine srcrun(IMPORT,EXPORT)

! !INPUT PARAMETERS:
  type(AttrVect),intent(inout) :: IMPORT,EXPORT   ! Input and Output states

!EOP -------------------------------------------------------------------
! local variables
  integer :: avsize,ier,i
     
! Nothing to do with IMPORT


! Fill EXPORT with data
  if(rank==0) write(6,*) modelname, ' run start'

! Use Av copy to copy input data from field1 in Imp to field3 in EXPORT
  call AttrVect_copy(IMPORT,EXPORT,rList='field1',TrList='field3')

! Use import to load data in second field
  avdata=30.0
  call AttrVect_importRAttr(EXPORT,"field4",avdata)

  if(rank==0) write(6,*) modelname, ' In field1', IMPORT%rAttr(1,1)
  if(rank==0) write(6,*) modelname, ' In field2', IMPORT%rAttr(2,1)
  if(rank==0) write(6,*) modelname, ' Out field3', EXPORT%rAttr(1,1)
  if(rank==0) write(6,*) modelname, ' Out field4', EXPORT%rAttr(2,1)

  if(rank==0) write(6,*) modelname, ' run done'

end subroutine srcrun
!!! END OF RUN  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   FINALIZE PHASE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: srcfin  - Source model finalize method

subroutine srcfin(IMPORT,EXPORT,GSMap)

! !INPUT PARAMETERS:
  type(AttrVect),intent(inout) :: IMPORT,EXPORT   ! imp,exp states
  type(GlobalSegMap),intent(inout) :: GSMap
!EOP -------------------------------------------------------------------
 ! clean up
  call AttrVect_clean(IMPORT)
  call AttrVect_clean(EXPORT)
  call GlobalSegMap_clean(GSMap)
  deallocate(avdata)
  if(rank==0) write(6,*) modelname,' fin done'
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
endsubroutine srcfin

end module srcmodel