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 INTEGER FUNCTION LSM_RED( KGAUSS, KDATE, KBITS, HPATH ) 12C 13C----> 14C**** LSM_RED 15C 16C PURPOSE 17C ------- 18C 19C Generates the land sea mask file pathname. 20C 21C 22C INTERFACE 23C --------- 24C 25C IRET = LSM_RED( KGAUSS, KDATE, KBITS, HPATH ) 26C 27C 28C Input 29C ----- 30C KGAUSS - The gaussian number (80 or 160) 31C KDATE - The data date in YYYYMMDD format. 32C KBITS - Number of bits per land-sea mask value (eg 32 or 64) 33C 34C Output 35C ------ 36C HPATH - The full file pathname (with gaussian number 37C number of bits and date). 38C 39C 40C Return value 41C ------------ 42C 43C Function returns the number of characters in the file pathname, 44C or zero if no match found. 45C 46C 47C Common block usage 48C ------------------ 49C 50C None 51C 52C 53C EXTERNALS 54C --------- 55C 56C GETENV - Standard routine to get environmental variable. 57C INDEX - Intrinsic routine to find position of substring. 58C EMOSNUM - Gives current EMOSLIB version number. 59C 60C 61C METHOD 62C ------ 63C None 64C 65C 66C REFERENCE 67C --------- 68C 69C None 70C 71C COMMENTS 72C -------- 73C 74C None 75C 76C 77C AUTHOR 78C ------ 79C 80C J.D.Chambers *ECMWF* ??? 1996 81C 82C 83C MODIFICATIONS 84C ------------- 85C 86C J.D.Chambers *ECMWF* July 1998 87C Use dates in YYYYMMDD format to handle year 2000 etc. 88C 89C----< 90C _______________________________________________________ 91C 92C* Section 0. Definition of variables. 93C _______________________________________________________ 94C 95 IMPLICIT NONE 96C 97C Parameters 98C 99 INTEGER JPD160, JPD80 100 PARAMETER (JPD160=6) 101 PARAMETER (JPD80=2) 102C 103C Function parameters 104C 105 INTEGER KGAUSS, KDATE, KBITS 106 CHARACTER*(*) HPATH 107C 108C Local variables 109C 110 INTEGER LOOP 111C 112C External functions 113C 114 INTEGER DPATH_TABLES_INTERPOL 115 EXTERNAL DPATH_TABLES_INTERPOL 116C 117C Change dates for N160 118C 119 INTEGER DATE160(JPD160) 120 DATA DATE160/ 121 X 19790930, 122 X 19910917, 123 X 19930804, 124 X 19940302, 125 X 19940823, 126 X 19950404 127 X / 128C 129C Change dates for N80 130C 131 INTEGER DATE80(JPD80) 132 DATA DATE80/ 133 X 19790930, 134 X 19790930 135 X / 136C 137 CHARACTER*256 YBASE 138 INTEGER IBASELEN 139 140 CHARACTER*50 PATH160(JPD160) 141 CHARACTER*50 PATH80(JPD80) 142C 143C Pathnames for N160 144C 145 DATA PATH160/ 146 X '_19790930', 147 X '_19910917', 148 X '_19930804', 149 X '_19940302', 150 X '_19940823', 151 X '_19950404' 152 X / 153C 154C 155C Pathnames for N80 156 DATA PATH80/ 157 X '_19790930', 158 X '_19790930' 159 X / 160C 161 INTEGER INDEX 162C 163C External functions 164C 165 INTEGER EMOSNUM 166 EXTERNAL EMOSNUM 167C 168C*************************************************************** 169C Section 1. Initialize and check input values. 170C*************************************************************** 171C 172 100 CONTINUE 173C 174 LSM_RED = 0 175 HPATH = ' ' 176C 177C Only reduced N160 gaussian fields handled. 178C 179 IF( KGAUSS.NE.160 ) GOTO 900 180C 181C Only 32 bit and 64 bit land-sea masks handled. 182C 183 IF( (KBITS.NE.32).AND.(KBITS.NE.64) ) GOTO 900 184C 185C Check environment variable for path of land sea masks. 186C (no error is raised, since 0 is a possible resulting value) 187C 188 IBASELEN = DPATH_TABLES_INTERPOL(YBASE) 189C 190C*************************************************************** 191C Section 2. Build pathnames. 192C*************************************************************** 193C 194 200 CONTINUE 195C 196C Handle N160 197C 198 IF( KGAUSS.EQ.160 ) THEN 199 DO 210 LOOP = 1, JPD160-1 200 IF( (KDATE.GE.DATE160(LOOP) ) .AND. 201 X (KDATE.LT.DATE160(LOOP+1)) ) THEN 202 HPATH(1:) = YBASE(1:IBASELEN) // 203 X 'r160_' // 'xx' // PATH160(LOOP) 204 LSM_RED = INDEX(HPATH,' ') 205 GOTO 900 206 ENDIF 207 210 CONTINUE 208C 209C Dropthrough -> take latest. 210C 211 HPATH(1:) = YBASE(1:IBASELEN) // 212 X 'r160_' // 'xx' // PATH160(JPD160) 213 LSM_RED = INDEX(HPATH,' ') 214C 215C Handle N80 216C 217 ELSE 218 DO 220 LOOP = 1, JPD80-1 219 IF( (KDATE.GE.DATE80(LOOP) ) .AND. 220 X (KDATE.LT.DATE80(LOOP+1)) ) THEN 221 HPATH(1:) = YBASE(1:IBASELEN) // 222 X 'r80_' // 'xx' // PATH80(LOOP) 223 LSM_RED = INDEX(HPATH,' ') 224 GOTO 900 225 ENDIF 226 220 CONTINUE 227C 228C Dropthrough -> take latest. 229C 230 HPATH(1:) = YBASE(1:IBASELEN) // 231 X 'r80_' // 'xx' // PATH80(JPD80) 232 LSM_RED = INDEX(HPATH,' ') 233 ENDIF 234C 235C*************************************************************** 236C Section 9. Return. 237C*************************************************************** 238C 239 900 CONTINUE 240C 241 RETURN 242 END 243