psmile_loc_trans_dble.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_dble
!
! !INTERFACE:

      subroutine psmile_loc_trans_dble ( 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_dble
!
      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

      Double Precision, 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:
!
      Double Precision, Intent (InOut)    :: data_out(len_out,nbr_fields)

!     Transformed data
!
! !LOCAL VARIABLES
!
      Integer :: i
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Loc_Trans_dble" performs some simple local transformations
!
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 03.07.03    R. Redler    created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_loc_trans_dble.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_loc_trans_dble.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_dble