!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
SUBROUTINE reStoreCMA 1,14
#if defined (DOC)
*
***s/r reStoreCMA - restore Global array ROBDATA and MOBDATA.
*
*Author . Bin He (ARMA/MRB )
*
*Revision:
* PURPOSE:
*
* ARGUMENTS:
* INPUT: NONE
*
* OUTPUT: NONE
*
#endif
*
USE mod4dv
, only : l4dvar
USE obstag
IMPLICIT NONE
#include "comlun.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comcst.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "cvcord.cdk"
#include "commvo.cdk"
! Declaire Local Variables.
REAL,ALLOCATABLE,DIMENSION(:,:) :: ROBDATA_tmp
REAL,ALLOCATABLE,DIMENSION(:,:) :: ROBDATA_tt !ping
INTEGER,ALLOCATABLE,DIMENSION(:,:) :: MOBDATA_TMP
INTEGER,ALLOCATABLE,DIMENSION(:,:) :: MOBDATA_tt !ping
INTEGER,ALLOCATABLE,DIMENSION(:,:) :: MOBHDR_tmp
INTEGER,ALLOCATABLE,DIMENSION(:,:) :: MOBHDR_tt !ping
REAL*8,ALLOCATABLE,DIMENSION(:) :: RMTMOBS_tmp
REAL*8,ALLOCATABLE,DIMENSION(:) :: RMTMOBS_tt !ping
INTEGER :: i,j,iobs,ierr ,locObsize ,startindx,endindx
INTEGER :: idataend,jj,idata,ii,sizeMOBDATA
INTEGER ::sizeMOBHDR,sizeRMTMOBS
!!---------------------------------------------------------------
!!1. Release some memorys.
print*,'Entering restoreCMA'
DEALLOCATE(ROBDATA8)
!!1.2 Added restore global array MOBHDR and RMTMOBS
! MOBHDR and RMTMOBS are used in "cmaabrp.ftn"
ALLOCATE(MOBHDR_tmp(NCMLET,NOBTOTP),STAT=ierr)
IF(ierr /= 0) CALL ABORT3D(nulout,'Cannt allocate Mem. to MOBHDR_tmp,Abort!')
MOBHDR_TMP=0
!ping for MOBHDR_tt
ALLOCATE(MOBHDR_tt(NCMLET,NOBTOTP),STAT=ierr)
IF(ierr /= 0) CALL ABORT3D(nulout,'Cannt allocate Mem. to MOBHDR_tt,Abort!')
MOBHDR_tt=0 !fini01
ALLOCATE(RMTMOBS_tmp(NOBTOTP),STAT=ierr)
IF(ierr /= 0) CALL ABORT3D(nulout,'Cannt allocate Mem. to RMTMOBS_tmp,Abort!')
RMTMOBS_TMP=0.0D0
!ping for RMTMOBS_tt
ALLOCATE(RMTMOBS_tt(NOBTOTP),STAT=ierr)
IF(ierr /= 0) CALL ABORT3D(nulout,'Cannt allocate Mem. to RMTMOBS_tt,Abort!')
RMTMOBS_tt=0.0D0
! 1.3 retore global MOBHDR and RMTMOBS
ii=1
DO i=1,NOBTOT
iobs=locObsTag(i)
MOBHDR_tmp(1:NCMLET,iobs)=MOBHDR(1:NCMLET,ii)
RMTMOBS_tmp(iobs)=RMTMOBS(ii)
ii=ii+1
ENDDO
sizeMOBHDR=size(MOBHDR_tmp)
sizeRMTMOBS=NOBTOTP
!ping CALL RPN_COMM_ALLReduce(MOBHDR_tmp,MOBHDR_tmp,sizeMOBHDR,"mpi_integer","mpi_sum","GRID",ierr)
CALL RPN_COMM_ALLReduce(MOBHDR_tmp,MOBHDR_tt,sizeMOBHDR,"mpi_integer","mpi_sum","GRID",ierr)
!ping CALL RPN_COMM_ALLReduce(RMTMOBS_tmp,RMTMOBS_tmp,sizeRMTMOBS,"mpi_double_precision","mpi_sum","GRID",ierr)
CALL RPN_COMM_ALLReduce(RMTMOBS_tmp,RMTMOBS_tt,sizeRMTMOBS,"mpi_double_precision","mpi_sum","GRID",ierr)
DEALLOCATE(MOBHDR)
ALLOCATE(MOBHDR(NCMLET,NOBTOTP),STAT=ierr)
IF(ierr /= 0) CALL ABORT3D(nulout,'Cannt allocate Mem. to MOBHDR,Abort!')
!ping MOBHDR=MOBHDR_tmp
MOBHDR=MOBHDR_tt
DEALLOCATE(MOBHDR_tmp)
DEALLOCATE(MOBHDR_tt)
!! DEALLOCATE(RMTMOBS)
CALL HPDEALLC(PTMTMOBS,IERR,1)
CALL HPALLOC(PTMTMOBS,NOBTOTP,ierr,8)
IF(ierr /= 0) CALL ABORT3D(nulout,'Cannt allocate Mem. to RMTMOBS,Abort!')
!ping RMTMOBS=RMTMOBS_tmp
RMTMOBS=RMTMOBS_tt
DEALLOCATE(RMTMOBS_tmp)
DEALLOCATE(RMTMOBS_tt)
!!2. Allocate memory to the temporol arrays.
ALLOCATE(MOBDATA_tmp(NCMLBO,ndatap),STAT=ierr)
IF(ierr /= 0) CALL ABORT3D(nulout,'Cannt allocate Mem. to MOBDATA_tmp,Abort!')
MOBDATA_tmp=0
!ping for MOBDATA_tt
ALLOCATE(MOBDATA_tt(NCMLBO,ndatap),STAT=ierr)
IF(ierr /= 0) CALL ABORT3D(nulout,'Cannt allocate Mem. to MOBDATA_tt,Abort!')
MOBDATA_tt=0
ALLOCATE(ROBDATA_tmp(NCMLBO,ndatap),STAT=ierr)
IF(ierr /= 0) CALL ABORT3D(nulout, 'Cannt allocate Mem. to ROBDATA_tmp,Abort!')
ROBDATA_tmp=0.0
!ping for ROBDATA_tt
ALLOCATE(ROBDATA_tt(NCMLBO,ndatap),STAT=ierr)
IF(ierr /= 0) CALL ABORT3D(nulout, 'Cannt allocate Mem. to ROBDATA_tt,Abort!')
ROBDATA_tt=0.0
!3. Re-store the global array MOBDATA and ROBDATA
ii=0
DO i=1,nobtot
iobs=locObsTag(i)
idata= MOBHDR_G(NCMRLN,iobs)
idataend = MOBHDR_G(NCMNLV,iobs) + idata -1
DO j=idata,idataend
ii=ii+1
MOBDATA_tmp(1:NCMLBO,j)=MOBDATA(1:NCMLBO,ii)
ROBDATA_tmp(1:NCMLBO,j)=ROBDATA(1:NCMLBO,ii)
ENDDO
ENDDO
!
deallocate(MOBDATA)
deallocate(ROBDATA)
!
! Merge the global array MOBDATA_tmp and ROBDATA_tmp.
sizeMOBDATA=size(MOBDATA_tmp)
!ping CALL RPN_COMM_ALLReduce(MOBDATA_tmp,MOBDATA_tmp,sizeMOBDATA,"mpi_integer","mpi_sum","GRID",ierr)
CALL RPN_COMM_ALLReduce(MOBDATA_tmp,MOBDATA_tt,sizeMOBDATA,"mpi_integer","mpi_sum","GRID",ierr)
!ping CALL RPN_COMM_ALLReduce(ROBDATA_tmp,ROBDATA_tmp,sizeMOBDATA,"mpi_real","mpi_sum","GRID",ierr)
CALL RPN_COMM_ALLReduce(ROBDATA_tmp,ROBDATA_tt,sizeMOBDATA,"mpi_real","mpi_sum","GRID",ierr)
!
ALLOCATE(ROBDATA(NCMLBO,ndatap),STAT=ierr)
IF(ierr /= 0) CALL ABORT3D(nulout,'Cannt allocate Mem. to ROBDATA,Abort!')
!ping ROBDATA=ROBDATA_tmp
ROBDATA=ROBDATA_tt
DEALLOCATE(ROBDATA_tmp)
DEALLOCATE(ROBDATA_tt)
ALLOCATE(MOBDATA(NCMLBO,ndatap),STAT=ierr)
IF(ierr /= 0) CALL ABORT3D(nulout,'Cannt allocate Mem. to MOBDATA,Abort!')
!ping MOBDATA=MOBDATA_tmp
MOBDATA=MOBDATA_tt
DEALLOCATE(MOBDATA_tmp)
DEALLOCATE(MOBDATA_tt)
!!
DEALLOCATE(MOBHDR_G)
DEALLOCATE(ROBHDR_G)
DEALLOCATE(locObsTag)
IF(l4dvar) THEN
DEALLOCATE(ObsTagLoc)
DEALLOCATE(locObsTag0)
ENDIF
!!
RETURN
END