psmile_info_coords_irreg2_real.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2006-2010, NEC Europe Ltd., London, UK.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007 ! !ROUTINE: PSMILe_Info_coords_irreg2_real
00008 !
00009 ! !INTERFACE:
00010 
00011       subroutine psmile_info_coords_irreg2_real (              &
00012                                x_coords, y_coords, z_coords,   &
00013                                coords_shape, grid_valid_shape, &
00014                                sinvec, cosvec, ierror)
00015 !
00016 ! !USES:
00017 !
00018       use PRISM_constants
00019 !
00020       use PSMILe, dummy_interface => PSMILe_Info_coords_irreg2_real
00021 
00022       implicit none
00023 !
00024 ! !INPUT PARAMETERS:
00025 !
00026       Integer, Intent (In)            :: coords_shape (2, ndim_3d)
00027 
00028 !     Dimension of coordinates (method) x_coords, ...
00029 
00030       Real, Intent (In)               :: x_coords(coords_shape(1,1): 
00031                                                   coords_shape(2,1), 
00032                                                   coords_shape(1,2): 
00033                                                   coords_shape(2,2))
00034       Real, Intent (In)               :: y_coords(coords_shape(1,1): 
00035                                                   coords_shape(2,1), 
00036                                                   coords_shape(1,2): 
00037                                                   coords_shape(2,2))
00038       Real, Intent (In)               :: z_coords(coords_shape(1,3): 
00039                                                   coords_shape(2,3))
00040 
00041 !     Coordinates of the method
00042 
00043 
00044       Integer, Intent (In)            :: grid_valid_shape (2, ndim_3d)
00045 
00046 !     Specifies the valid block shape for the "ndim_3d"-dimensional block
00047 
00048 !
00049 ! !INPUT/OUTPUT PARAMETERS:
00050 !
00051       Type (real_vector)              :: sinvec
00052 !
00053 !     Vector containing the sin values
00054 !
00055       Type (real_vector)              :: cosvec
00056 !
00057 !     Vector containing the cos values
00058 !
00059 ! !OUTPUT PARAMETERS:
00060 !
00061       Integer, Intent (Out)           :: ierror
00062 
00063 !     Returns the error code of PSMILE_Info__coords_irreg2_real;
00064 !             ierror = 0 : No error
00065 !             ierror > 0 : Severe error
00066 !
00067 ! !DEFINED PARAMETERS:
00068 !
00069 !  lon   = Index of Longitudes in arrays "sin_values" and "cos_values"
00070 !  lat   = Index of Latitudes  in arrays "sin_values" and "cos_values"
00071 !
00072       Integer, Parameter              :: lon = 1
00073       Integer, Parameter              :: lat = 2
00074 !
00075 ! !LOCAL VARIABLES
00076 !
00077 !     ... For sin and cos values
00078 !
00079       Integer                         :: len
00080 !
00081 !     ... for error handling
00082 !
00083       Integer, parameter              :: nerrp = 2
00084       Integer                         :: ierrp (nerrp)
00085 !
00086 !
00087 ! !DESCRIPTION:
00088 !
00089 ! Subroutine "PSMILe_Info_coords_irreg2_real" computes sin and cos values of
00090 ! the Longitudes and Latitudes of a 3d-dimensional grid of type
00091 ! "PRISM_Irrlonlat_Regvrt".
00092 !
00093 ! !REVISION HISTORY:
00094 !
00095 !   Date      Programmer   Description
00096 ! ----------  ----------   -----------
00097 ! 03.07.21    H. Ritzdorf  created
00098 !
00099 !EOP
00100 !----------------------------------------------------------------------
00101 !
00102 !  $Id: psmile_info_coords_irreg2_real.F90 2325 2010-04-21 15:00:07Z valcke $
00103 !  $Author: valcke $
00104 !
00105    Character(len=len_cvs_string), save :: mycvs = 
00106        '$Id: psmile_info_coords_irreg2_real.F90 2325 2010-04-21 15:00:07Z valcke $'
00107 !----------------------------------------------------------------------
00108 !
00109 !  Initialization
00110 !
00111 #ifdef VERBOSE
00112       print 9990, trim(ch_id)
00113 
00114       call psmile_flushstd
00115 #endif /* VERBOSE */
00116 
00117       ierror = 0
00118 !
00119 #ifdef PRISM_ASSERTION
00120 #endif
00121 !
00122 !-----------------------------------------------------------------------
00123 !     Allocate and set temporary array which is used for the 
00124 !     computation of distances.
00125 !     (*) Longitudes and Latitudes are transformed
00126 !         from degrees into radients.
00127 !     (*) The z-values are currently not transformed
00128 !         ??? Whats about PRISM_Irrlonlat_sigmavrt, ...
00129 !
00130 !     ??? Lohnt es sich den Shape weiter einzuschraenken ?
00131 !-----------------------------------------------------------------------
00132 !
00133       len = lat                                                 &
00134           * (grid_valid_shape(2,1) - grid_valid_shape(1,1) + 1) &
00135           * (grid_valid_shape(2,2) - grid_valid_shape(1,2) + 1)
00136 !
00137       Allocate (sinvec%vector(len),                &
00138                 cosvec%vector(len), STAT = ierror)
00139       if ( ierror > 0 ) then
00140          ierrp (1) = ierror
00141          ierrp (2) = len * 2
00142 
00143          ierror = PRISM_Error_Alloc
00144          call psmile_error ( ierror, 'sinvec%vector, cosvec%vector', &
00145                              ierrp, 2, __FILE__, __LINE__ )
00146          return
00147       endif
00148 !
00149 !===> Transform lon and lat values
00150 !
00151       call psmile_trf_lonlat_2d_real (x_coords, y_coords,             &
00152                                       coords_shape    (:, 1:ndim_2d), &
00153                                       grid_valid_shape(:, 1:ndim_2d), &
00154                                       sinvec%vector, cosvec%vector, ierror)
00155 !
00156 !===> All done
00157 !
00158 #ifdef VERBOSE
00159       print 9980, trim(ch_id), ierror
00160 
00161       call psmile_flushstd
00162 #endif /* VERBOSE */
00163 !
00164 !  Formats:
00165 !
00166 9990 format (1x, a, ': psmile_Info_coords_irreg2_real')
00167 9980 format (1x, a, ': psmile_Info_coords_irreg2_real: eof, ierror =', i3)
00168 
00169       end subroutine PSMILe_Info_coords_irreg2_real

Generated on 18 Mar 2011 for Oasis4 by  doxygen 1.6.1