psmile_transrot_back_dble.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_transrot_back_dble
00008 !
00009 ! !INTERFACE:
00010 !
00011 
00012       subroutine psmile_transrot_back_dble ( flong, flati, rmlon, rmlat )
00013 !
00014 ! !USES:
00015 !
00016       use psmile, only : ch_id, len_cvs_string
00017 
00018       implicit none
00019 !
00020 ! !INPUT PARAMETERS:
00021 !
00022       Double Precision, Intent (In) :: rmlat, rmlon
00023 !
00024 !     Output:rmlon: transformed longitude
00025 !            rmlat: transformed latitude
00026 !            ...all in degrees ...
00027 !
00028 ! !OUTPUT PARAMETERS:
00029 !
00030       Double Precision, Intent (Out)  :: flong, flati
00031 !
00032 !     Input: fLong: Geographical longitude
00033 !            fLati: Geographical latitude
00034 !            ...all in degrees ...
00035 !
00036 ! !LOCAL VARIABLES
00037 !
00038       Double Precision :: pif, pi
00039 
00040       Double Precision :: fl
00041       Double Precision :: sinphi, phi
00042       Double Precision :: coslam, cosphi
00043 !
00044 ! !DESCRIPTION:
00045 !
00046 !
00047 ! Routine kindly provided by C. Koeberle, R. Gerdes AWI Bremerhaven
00048 ! originally used to rotate part of the Atlantic model grid.
00049 !
00050 ! Is the reverse operation to psmile_transrot
00051 !
00052 !------------------------------------------------------------
00053 !
00054 ! !REVISION HISTORY:
00055 !
00056 !   Date      Programmer   Description
00057 ! ----------  ----------   -----------
00058 ! 08.10.09    R. Redler    created
00059 ! 16.09.09    M. Hanke     changed to transrot_back
00060 !
00061 !EOP
00062 !----------------------------------------------------------------------
00063 !
00064 !  $Id: psmile_transrot_back_dble.F90 2575 2010-09-17 07:27:31Z hanke $
00065 !  $Author: hanke $
00066 !
00067    Character(len=len_cvs_string), save :: mycvs = 
00068        '$Id: psmile_transrot_back_dble.F90 2575 2010-09-17 07:27:31Z hanke $'
00069 !
00070 !----------------------------------------------------------------------
00071 
00072 #ifdef VERBOSE
00073       print 9990, trim(ch_id), rmlon, rmlat
00074       call psmile_flushstd
00075 #endif /* VERBOSE */
00076 
00077 !
00078 !   Latitude
00079 !
00080       pi  = 4.0d0*atan(1.0d0)
00081       pif = pi/180.0d0
00082 
00083       sinphi=cos( rmlat*pif ) * cos( rmlon*pif )
00084       phi   =asin( sinphi )
00085       cosphi=cos ( phi )
00086       fLati =max(-90.0d0,min(90.0d0,PHI/Pif))
00087 !
00088 !   Longitude
00089 !
00090       If (cosphi.ne.0.0d0) then
00091 
00092          coslam=cos( rmlat*pif )*Sin ( rmlon*pif )/Cosphi
00093          if(abs(coslam).gt.1.0d0.and.(1.0d0-abs(coslam)).gt.1.e-10) &
00094             write(*,*) '*** WARNING ==> coslam out of [-1,1]:',coslam
00095          coslam=min(1.0d0,max(-1.0d0,coslam))
00096          fLong =sign(acos( coslam )/pif,rmlat)
00097 
00098       else
00099          fLong =90.0d0
00100          If (phi.lt.0.0d0) fLong=270.0d0
00101       endif
00102 
00103       fLong =mod(fLong+360.0d0,360.0d0)
00104 
00105 #ifdef VERBOSE
00106       print 9980, trim(ch_id), flong, flati
00107       call psmile_flushstd
00108 #endif /* VERBOSE */
00109 !
00110 9990 format (1x, a, ': psmile_transrot_back_dble: in : ', 2f8.2)
00111 9980 format (1x, a, ': psmile_transrot_back_dble: out: ', 2f8.2, ' eof')
00112 
00113       end subroutine psmile_transrot_back_dble
00114