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 IBASINI(KFORCE) 12C 13C----> 14C**** IBASINI 15C 16C Purpose 17C ------- 18C 19C Ensures basic initialisation of common blocks is done 20C 21C Interface 22C --------- 23C 24C IRET = IBASINI(KFORCE) 25C 26C 27C Input parameters 28C ---------------- 29C 30C KFORCE = 1, to force initialisation of common blocks. 31C = 0, to check if initialisation of common blocks is done 32C already (and do it if not already done). 33C 34C 35C Method 36C ------ 37C 38C NJDCDOT in nifld.common is checked/set. 39C 40C Looks for environment variable INTERP_GEN_COEFFS which gives 41C the name of a file containing the cutoff spectral truncation 42C above which interpolation coefficients are generated 'on the 43C fly'. Variable NICOMP is set with this value in nifld.common. 44C The file contains entries for each computer architecture in 45C format: 46C 47C col 1 48C | 49C v 50C FUJITSU 319 51C sgimips 213 52C hppa 213 53C DEFAULT 106 54C 55C If no matching $ARCH value, the DEFAULT value is used. 56C If no matching $ARCH and no DEFAULT value, a hard-code value is used. 57C 58C Looks for environment variable USE_HIRLAM_12POINT to determine 59C whether or not the Hiralm 12-point horizontal interpolation is 60C to be used for rotations. 61C 62C 63C Externals 64C --------- 65C 66C CLEAR_C - Clear common block variables 67C GETENV - Get value of an environment variable 68C JINDEX - Returns length of character string 69C 70C 71C Author 72C ------ 73C 74C J.D.Chambers ECMWF August 1994. 75C 76C----< 77C 78C -----------------------------------------------------------------| 79C 80 IMPLICIT NONE 81C 82#include "parim.h" 83#include "nifld.common" 84#include "nofld.common" 85#include "intf.h" 86C 87C Function arguments 88C 89 INTEGER KFORCE 90C 91C Local variables 92C 93 CHARACTER*120 LINE 94 CHARACTER*20 ARCH, USEHIR 95 CHARACTER*256 CONFIG 96 INTEGER IMAGIC, IRET, ICONFIG, IBLANK, LOOP 97 DATA ICONFIG/69/ 98 DATA IMAGIC/1952999238/ 99C 100C Externals 101C 102 INTEGER JINDEX 103C 104C -----------------------------------------------------------------| 105C Section 1. Force initialisation if requested. 106C -----------------------------------------------------------------| 107C 108 100 CONTINUE 109C 110 IF ( KFORCE .EQ. 1 ) NJDCDOT = 0 111C 112C See if basic initialisation has already been done or not 113C 114 IF ( NJDCDOT .NE. IMAGIC ) THEN 115C 116C Clear common block variables 117C 118 CALL CLEAR_C() 119C 120 IRET = 1 121 CALL IAINIT(0,IRET) 122C 123C Set interpolation handling default values 124C (Replaces old call to rddefs) 125C 126 NILOCAL = 0 127 NISTREM = 0 128 NIFORM = 1 129 NOFORM = 1 130 NITABLE = 128 131 NOTABLE = 128 132 NIPARAM = 0 133 DO LOOP = 1,4 134 NIAREA(LOOP) = 0 135 NOAREA(LOOP) = 0 136 ENDDO 137 NISCNM = 0 138 NOSCNM = 0 139C 140C Set default value for truncation above which interpolation 141C coefficients are to be computed dynamically 142C 143 NICOMP = 319 144C 145C Now see if this default value has been modified in a 146C configuration file 147C 148 CALL GETENV('INTERP_GEN_COEFFS', CONFIG) 149 IBLANK = JINDEX(CONFIG) 150 IF( IBLANK.GE.1 ) THEN 151C 152C Open the configuration file 153C 154 OPEN( ICONFIG, FILE=CONFIG, STATUS='OLD', ERR=200) 155 CALL GETENV('ARCH', ARCH) 156 IBLANK = JINDEX(ARCH) 157 IF( IBLANK.LT.1 ) ARCH = 'DEFAULT' 158 IBLANK = JINDEX(ARCH) 159C 160C Look for matching 'arch' 161C 162 110 CONTINUE 163 READ( ICONFIG, '(A)', END= 200) LINE 164 IF( ARCH(1:IBLANK).EQ.LINE(1:IBLANK) ) THEN 165 READ(LINE(IBLANK+1:),'(1X,I3)') NICOMP 166 GOTO 200 167 ENDIF 168C 169C Pickup default (will be used if no matching 'arch') 170C 171 IF( (LINE(1:7).EQ.'DEFAULT').OR. 172 X (LINE(1:7).EQ.'default') ) 173 X READ(LINE(IBLANK+1:),'(1X,I3)') NICOMP 174C 175 GOTO 110 176 ENDIF 177C 178C -----------------------------------------------------------------| 179C Section 2. See if Hirlam 12-point horizontal interpolation to be 180C use for rotations (default = 'yes'). 181C -----------------------------------------------------------------| 182C 183 200 CONTINUE 184C 185 LUSEHIR = .TRUE. 186 CALL GETENV('USE_HIRLAM_12POINT', USEHIR) 187 IF( (USEHIR(1:3).EQ.'OFF').OR.(USEHIR(1:2).EQ.'NO') ) 188 X LUSEHIR = .FALSE. 189C 190C -----------------------------------------------------------------| 191C Section 9. Return 192C -----------------------------------------------------------------| 193C 194 900 CONTINUE 195C 196C Set 'magic number' to show basic initialisation has been done 197C 198 NJDCDOT = IMAGIC 199C 200 ENDIF 201C 202 IBASINI = 0 203C 204 RETURN 205 END 206