1C Copyright 1981-2016 ECMWF. 2C 3C This software is licensed under the terms of the Apache Licence 4C Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. 5C 6C In applying this licence, ECMWF does not waive the privileges and immunities 7C granted to it by virtue of its status as an intergovernmental organisation 8C nor does it submit to any jurisdiction. 9C 10 11 SUBROUTINE STRLAT( OLDLAT, STRETCH, KFLAG, NEWLAT, MFACTOR) 12C 13C----> 14C**** STRLAT 15C 16C PURPOSE 17C _______ 18C 19C This routine transforms between stretched and real latitudes 20C and calculates the map factor. 21C 22C INTERFACE 23C _________ 24C 25C CALL STRLAT( OLDLAT, STRETCH, KFLAG, NEWLAT, MFACTOR) 26C 27C Input parameters 28C ________________ 29C 30C OLDLAT - Input latitude 31C STRETCH - Stretching factor 32C KFLAG - Flag to show direction of transform (real <-> stretched) 33C 0 = transform from real latitudes to stretched latitudes 34C 1 = transform from stretched latitudes to real latitudes 35C 36C Output parameters 37C ________________ 38C 39C NEWLAT - Input latitude 40C MFACTOR - Map factor 41C 42C 43C Common block usage 44C __________________ 45C 46C None 47C 48C Method 49C ______ 50C 51C Stretching factor S 52C 53C Map factor, m = S**2 + 1 + (S**2 -1)*mu 54C ----------------------- 55C 2*S 56C 57C where mu = sin(lat) on the real sphere 58C 59C mu = (S**2+1)*md + (S**2-1) 60C ---------------------- 61C (S**2+1) + (S**2-1)*md 62C 63C where md = sin(lat) on the stretched sphere. 64C 65C By rearrangement: 66C 67C md = (S**2+1)*mu - (S**2-1) 68C ---------------------- 69C (S**2+1) - (S**2-1)*mu 70C 71C Wind U and V components are transformed as 72C 73C vreal = m * vtransformed 74C 75C Vorticity and divergence fields are transformed as 76C 77C vreal = (m*m) * vtransformed 78C 79C 80C Externals 81C _________ 82C 83C None 84C 85C 86C Reference 87C _________ 88C 89C None 90C 91C 92C Comments 93C ________ 94C 95C None. 96C 97C 98C AUTHOR 99C ______ 100C 101C J.D.Chambers ECMWF July 1999 102C 103C 104C MODIFICATIONS 105C _____________ 106C 107C None 108C 109C----< 110C _______________________________________________________ 111C 112C 113 IMPLICIT NONE 114C 115C Subroutine arguments 116C 117 REAL OLDLAT, STRETCH, NEWLAT, MFACTOR 118 INTEGER KFLAG 119C 120C Parameters 121C 122 INTEGER JPRL2TR 123 PARAMETER (JPRL2TR = 0) 124 REAL PPI, DEG2RAD, RAD2DEG 125 PARAMETER ( PPI = 3.14159265358979 ) 126 PARAMETER (DEG2RAD = PPI / 180.0) 127 PARAMETER (RAD2DEG = 180.0 / PPI) 128C 129C Local variables 130C 131 REAL A, B, ANGLE, MU, MUPRIME 132C _______________________________________________________ 133C 134C* Section 1. Initialization. 135C _______________________________________________________ 136C 137 100 CONTINUE 138C 139 A = STRETCH * STRETCH + 1 140 B = A - 2 141 ANGLE = OLDLAT * DEG2RAD 142C 143C _______________________________________________________ 144C 145C* Section 2. Work out geometry 146C _______________________________________________________ 147C 148 200 CONTINUE 149C 150C Transform from real latitudes to stretched latitudes 151C 152 IF( KFLAG.EQ.JPRL2TR ) THEN 153 MUPRIME = SIN(ANGLE) 154 MU = (A*MUPRIME + B) / (A + B*MUPRIME) 155 NEWLAT = ASIN(MU) * RAD2DEG 156C 157C Transform from stretched latitudes to real latitudes 158C 159 ELSE 160 MU = SIN(ANGLE) 161 MUPRIME = (A*MU - B) / (A - B*MU) 162 NEWLAT = ASIN(MUPRIME) * RAD2DEG 163 ENDIF 164C 165C Calculate the map factor 166C 167 MFACTOR = (A + B*MU) / (2*STRETCH) 168C 169C _______________________________________________________ 170C 171C* Section 9. Return to calling routine. 172C _______________________________________________________ 173C 174 RETURN 175 END 176