psmile_loc_trans_real.F90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright 2006-2010, NEC Europe Ltd., London, UK.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PSMILe_Loc_Trans_real
!
! !INTERFACE:

      subroutine psmile_loc_trans_real ( task, nbr_fields, &
                                         len_in,  data_in,  &
                                         len_out, data_out, field_id )
!
! !USES:
!
      use PRISM_constants, only: PRISM_UNDEFINED, PRISM_Error_Arg
      Use PSMILe, dummy_interface => PSMILe_Loc_Trans_real
!
      Implicit None
!
! !INPUT PARAMETERS:
!
      Integer, Intent (In)                :: task
!
!     Coded task to be fulfilled 
!
      Integer, Intent (In)                :: nbr_fields
!
!     number of physical fields contained in the data 
!
      Integer, Intent (In)                :: len_in
!
!     Length of input array
!
      Real, Intent (In)                   :: data_in(len_in,nbr_fields)
!
!     Input data
!
      Integer, Intent (In)                :: len_out
!
!     Length of (gathered) output array
!!
      Integer, Optional, Intent (In)      :: field_id
!
!     Field Id to access the mask for the transformed field
!
! !INPUT/OUTPUT PARAMETERS:
!
      Real, Intent (InOut)                :: data_out(len_out,nbr_fields)
!
!     Transformed data
!
! !LOCAL VARIABLES
!
      Integer :: i
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Loc_Trans_real" performs some simple local transformations
!
!
! !REVISION HISTORY:
!   Date      Programmer   Description
! ----------  ----------   -----------
! 03.07.03    R. Redler    created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_loc_trans_real.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_loc_trans_real.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------

         select case ( task )

         case ( PSMILe_scat )
            
            if ( Fields(field_id)%mask_id == PRISM_UNDEFINED ) then
               data_out = data_in
            else
               do i = 1, nbr_fields
                  data_out(:,i) = unpack ( data_in(:,i), &
                       Masks(Fields(field_id)%mask_id)%mask_array, &
                       data_out(:,i) )
               enddo
            endif

         case ( PSMILe_gath )

            if ( Fields(field_id)%mask_id == PRISM_UNDEFINED ) then
               data_out = data_in
            else
               data_out(:,i) = pack ( data_in(:,i), Masks(Fields(field_id)%mask_id)%mask_array )
            endif

         case default

           print *, task, ' is not a valid number, no action performed '

         end select

      end subroutine PSMILe_Loc_Trans_real