Page 1 Source Listing GENBIL 2014-12-17 20:48 GENBIL.f 1 SUBROUTINE GENBIL(EGFUL,IMOT,JMOT) 2 C 3 C$$$ SUBPROGRAM DOCUMENTATION BLOCK 4 C . . . 5 C SUBPROGRAM: GENBIL COMPUTE BILINEAR INTRP WEIGHTS 6 C PRGRMMR: TREADON ORG: W/NP2 DATE: 92-12-23 7 C 8 C ABSTRACT: 9 C THIS ROUTINE IS BASED ON CODE SUBROUTINE INTERP FOUND 10 C IN DAVID PLUMMER'S ETAPACKC. GIVEN THE E-GRID AND 11 C OUTPUT GRID BILINEAR INTERPOLATION WEIGHTS ARE COMPUTED 12 C AND SAVED COMMON BLOCK LLGRDS ARRAYS. THE PASSED FILLED 13 C E-GRID ARRAY, EGFUL CAN CONTAIN ANY FIELD. IT IS USED 14 C TO DETERMINE THE EXTENT KNOW DATA VALUES IN THE E-GRID. 15 C THOSE GRID POINTS ON THE E-GRID WHICH EQUAL OR EXCEED 16 C THE SPECIAL VALUE, SPVC, ARE TREATED DIFFERENTLY IN THE 17 C INTERPOLATION. FOR MOST APPLICATIONS THIS CHECK IS NOT 18 C NECESSARY. 19 C . 20 C 21 C PROGRAM HISTORY LOG: 22 C ??-??-?? DAVID PLUMMER - SUBROUTINE INTERP IN ETAPACKC 23 C 92-12-23 RUSS TREADON - EXTRACTED CODE FROM INTERP AND 24 C GENERALIZED TO HANDLE VARIOUS 25 C INPUT AND OUTPUT GRIDS 26 C 27 C USAGE: CALL GENBIL(EGFUL,IMOT,JMOT) 28 C INPUT ARGUMENT LIST: 29 C EGFUL - FILLED E-GRID DEFINING EXTENT OF E-GRID. 30 C IMOT - FIRST DIMENSION OF OUTPUT GRID. 31 C JMOT - SECOND DIMENSION OF OUTPUT GRID. 32 C OUTPUT ARGUMENT LIST: 33 C 34 C OUTPUT FILES: 35 C STDOUT - RUN TIME STANDARD OUT. 36 C 37 C SUBPROGRAMS CALLED: 38 C UTILITIES: 39 C NONE 40 C LIBRARY: 41 C COMMON - LLGRDS 42 C IOUNIT 43 C 44 C ATTRIBUTES: 45 C LANGUAGE: FORTRAN 46 C MACHINE : CRAY C-90 47 C$$$ 48 C 49 C 50 C INCLUDE DECLARED GRID DIMENSIONS. 51 INCLUDE "parmeta" 69 INCLUDE "parmout" 73 PARAMETER (IMJM=IM*JM-JM/2,IMT=2*IM-1,JMT=JM) 74 C 75 C DECLARE VARIABLES. 76 LOGICAL LM0N0,LM1N0,LM0N1,LM1N1 77 INTEGER IMOT,JMOT Page 2 Source Listing GENBIL 2014-12-17 20:48 GENBIL.f 78 REAL EGFUL(IMT,JMT) 79 C 80 C INCLUDE COMMON. 81 INCLUDE "LLGRDS.comm" 95 INCLUDE "IOUNIT.comm" 96 C 97 C SET TOLERANCE LIMITS. 98 C 106 DATA SPVC,SMALL /1.E20,1.E-4/ 107 C 108 C****************************************************************** 109 C START GENBIL HERE. 110 C 111 C COMPUTE INTERPOLATION WEIGHTS. 112 C 113 WRITE(STDOUT,*)'GENBIL: GENERATE BILIN WEIGHTS' 114 MAXI = IMT 115 MAXJ = JMT 116 DO 90 J = 1,JMOT 117 DO 90 I = 1,IMOT 118 XX = EGRDI(I,J) 119 YY = EGRDJ(I,J) 120 M = XX 121 N = YY 122 IEGRD(I,J) = M 123 JEGRD(I,J) = N 124 C 125 IF ( ( M.LE.0 ).OR.( N.LE.0 ) ) THEN 126 WIJ(I,J) = 0. 127 WIPJ(I,J) = 0. 128 WIJP(I,J) = 0. 129 WIPJP(I,J) = 0. 130 IWGT(I,J) = 0 131 GOTO 75 132 ENDIF 133 C 134 IF ( (XX.GT.MAXI).OR.(YY.GT.MAXJ) ) THEN 135 WIJ(I,J) = 0. 136 WIPJ(I,J) = 0. 137 WIJP(I,J) = 0. 138 WIPJP(I,J) = 0. 139 IWGT(I,J) = 0 140 GOTO 75 141 ENDIF 142 C 143 DX = (XX - M) 144 DY = (YY - N) 145 DX1 = 1.0 - DX 146 DY1 = 1.0 - DY 147 IF ( (ABS(DX ).LT.SMALL).AND.(ABS(DY ).LT.SMALL) ) THEN 148 W00 = 1. 149 W10 = 0. 150 W01 = 0. 151 W11 = 0. 152 WIJ(I,J) = W00 153 WIPJ(I,J) = W10 154 WIJP(I,J) = W01 Page 3 Source Listing GENBIL 2014-12-17 20:48 GENBIL.f 155 WIPJP(I,J) = W11 156 IWGT(I,J) = 1 157 GOTO 75 158 CX DAT = EGFUL(M,N) 159 ELSEIF ( (ABS(DX ).LT.SMALL).AND. 160 X (ABS(DY1).LT.SMALL) ) THEN 161 W00 = 0. 162 W10 = 0. 163 W01 = 1. 164 W11 = 0. 165 WIJ(I,J) = W00 166 WIPJ(I,J) = W10 167 WIJP(I,J) = W01 168 WIPJP(I,J) = W11 169 IWGT(I,J) = 1 170 GOTO 75 171 CX DAT = EGFUL(M,N+1) 172 ELSEIF ( (ABS(DX1).LT.SMALL).AND. 173 X (ABS(DY ).LT.SMALL) ) THEN 174 W00 = 0. 175 W10 = 1. 176 W01 = 0. 177 W11 = 0. 178 WIJ(I,J) = W00 179 WIPJ(I,J) = W10 180 WIJP(I,J) = W01 181 WIPJP(I,J) = W11 182 IWGT(I,J) = 1 183 GOTO 75 184 CX DAT = EGFUL(M+1,N) 185 ELSEIF ( (ABS(DX1).LT.SMALL).AND. 186 X (ABS(DY1).LT.SMALL) ) THEN 187 W00 = 0. 188 W10 = 0. 189 W01 = 0. 190 W11 = 1. 191 WIJ(I,J) = W00 192 WIPJ(I,J) = W10 193 WIJP(I,J) = W01 194 WIPJP(I,J) = W11 195 IWGT(I,J) = 1 196 GOTO 75 197 CX DAT = EGFUL(M+1,N+1) 198 END IF 199 C 200 C DONE WITH SPECIAL CASES. NOW FOR GENERAL CASES. 201 C 202 LM0N0 = (EGFUL(M ,N ).GE.SPVC) 203 LM1N0 = (EGFUL(M+1,N ).GE.SPVC) 204 LM0N1 = (EGFUL(M ,N+1).GE.SPVC) 205 LM1N1 = (EGFUL(M+1,N+1).GE.SPVC) 206 IF ( (.NOT.LM0N0).AND.(.NOT.LM1N0).AND. 207 X (.NOT.LM0N1).AND.(.NOT.LM1N1) ) THEN 208 W00 = (1.-DY)*(1.-DX) 209 W10 = (1.-DY)*DX 210 W01 = DY*(1.-DX) 211 W11 = DY*DX Page 4 Source Listing GENBIL 2014-12-17 20:48 GENBIL.f 212 WIJ(I,J) = W00 213 WIPJ(I,J) = W10 214 WIJP(I,J) = W01 215 WIPJP(I,J) = W11 216 IWGT(I,J) = 1 217 CX DAT = (1.0-DY)*((1.0-DX)*EGFUL(M,N) + 218 CX DX*EGFUL(M+1,N)) + 219 CX DY*((1.0-DX)*EGFUL(M,N+1) + 220 CX DX*EGFUL(M+1,N+1)) 221 GOTO 75 222 ELSEIF (LM0N0.AND.LM1N0.AND.LM0N1.AND.LM1N1) THEN 223 WIJ(I,J) = 0. 224 WIPJ(I,J) = 0. 225 WIJP(I,J) = 0. 226 WIPJP(I,J) = 0. 227 IWGT(I,J) = 0 228 GOTO 75 229 CX DAT = SPVAL 230 ELSE 231 IM0N0 = 1 232 IF (LM0N0) IM0N0 = 0 233 IM1N0 = 1 234 IF (LM1N0) IM1N0 = 0 235 IM0N1 = 1 236 IF (LM0N1) IM0N1 = 0 237 IM1N1 = 1 238 IF (LM1N1) IM1N1 = 0 239 RXX = ((SQRT(2.0)/4.0)*(IM0N0+IM1N0+IM0N1+IM1N1))**2 240 R00 = ( DX * DX) + ( DY * DY) 241 R10 = ((1.0-DX)*(1.0-DX)) + ( DY * DY) 242 R01 = ( DX * DX) + ((1.0-DY)*(1.0-DY)) 243 R11 = ((1.0-DX)*(1.0-DX)) + ((1.0-DY)*(1.0-DY)) 244 W00 = IM0N0 * MAX(0.0,(RXX - R00)) / (RXX + R00) 245 W10 = IM1N0 * MAX(0.0,(RXX - R10)) / (RXX + R10) 246 W01 = IM0N1 * MAX(0.0,(RXX - R01)) / (RXX + R01) 247 W11 = IM1N1 * MAX(0.0,(RXX - R11)) / (RXX + R11) 248 WSUM = W00 + W01 + W10 + W11 249 IF (WSUM .NE. 0.0) THEN 250 WIJ(I,J) = W00/WSUM 251 WIPJ(I,J) = W10/WSUM 252 WIJP(I,J) = W01/WSUM 253 WIPJP(I,J) = W11/WSUM 254 IWGT(I,J) = 1 255 GOTO 75 256 CX DAT = (W00*EGFUL(M,N)+W10*EGFUL(M+1,N) + 257 CX W01*EGFUL(M,N+1)+W11*EGFUL(M+1,N+1)) / WSUM 258 ELSE 259 WIJ(I,J) = 0. 260 WIPJ(I,J) = 0. 261 WIJP(I,J) = 0. 262 WIPJP(I,J) = 0. 263 IWGT(I,J) = 0 264 GOTO 75 265 CX DAT = SPVAL 266 END IF 267 END IF 268 WRITE(STDOUT,*)'GENWGT: SHOULD NOT REACH THIS LINE' Page 5 Source Listing GENBIL 2014-12-17 20:48 GENBIL.f 269 75 CONTINUE 270 90 CONTINUE 271 C 272 C END OF ROUTINE. 273 C 274 RETURN 275 END ENTRY POINTS Name genbil_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 75 Label 229 91,100,117,130,143,156,181,188,215 ,224 90 Label 230 76,77 ABS Func 107 scalar 107,119,120,132,133,145,146 DX Local 103 R(4) 4 scalar 103,105,107,119,168,169,170,171,20 0,201,202,203 DX1 Local 105 R(4) 4 scalar 105,132,145 DY Local 104 R(4) 4 scalar 104,106,107,133,168,169,170,171,20 0,201,202,203 DY1 Local 106 R(4) 4 scalar 106,120,146 EGFUL Dummy 1 R(4) 4 2 183051 ARG,INOUT 162,163,164,165 EGRDI Scalar 9 R(4) 4 2 91719 COM 78 EGRDJ Scalar 9 R(4) 4 2 91719 COM 79 EVLAT Scalar 8 R(4) 4 2 183051 COM EVLON Scalar 8 R(4) 4 2 183051 COM FVTLON Scalar 7 R(4) 4 2 183051 COM GDLAT Scalar 3 R(4) 4 2 91719 COM GDLON Scalar 3 R(4) 4 2 91719 COM GDTLAT Scalar 4 R(4) 4 2 91719 COM GDTLON Scalar 4 R(4) 4 2 91719 COM GENBIL Subr 1 HTLAT Scalar 5 R(4) 4 2 91719 COM HTLON Scalar 5 R(4) 4 2 91719 COM I Local 77 I(4) 4 scalar 77,78,79,82,83,86,87,88,89,90,95,9 6,97,98,99,112,113,114,115,116,125 ,126,127,128,129,138,139,140,141,1 42,151,152,153,154,155,172,173,174 ,175,176,183,184,185,186,187,210,2 11,212,213,214,219,220,221,222,223 IDIM1 Param 14 I(4) 4 scalar IDIM2 Param 14 I(4) 4 scalar IEGRD Scalar 10 I(4) 4 2 91719 COM 82 IEGRDK Scalar 6 I(4) 4 2 91719 COM IGSTL Param 9 I(4) 4 scalar 14 IGSTR Param 9 I(4) 4 scalar 14 IM Param 3 I(4) 4 scalar 3,5,6,7,11,14,53 IM0N0 Local 191 I(4) 4 scalar 191,192,199,204 Page 6 Source Listing GENBIL 2014-12-17 20:48 Symbol Table GENBIL.f Name Object Declared Type Bytes Dimen Elements Attributes References IM0N1 Local 195 I(4) 4 scalar 195,196,199,206 IM1N0 Local 193 I(4) 4 scalar 193,194,199,205 IM1N1 Local 197 I(4) 4 scalar 197,198,199,207 IMJM Param 53 I(4) 4 scalar IMOT Dummy 1 I(4) 4 scalar ARG,INOUT 77 IMT Param 53 I(4) 4 scalar 7,8,58,74 IMX Param 3 I(4) 4 scalar 3,4,9,10,11,12 INPES Param 6 I(4) 4 scalar 11,14 IOUNIT Common 4 20 ITAIL Param 11 I(4) 4 scalar IWGT Scalar 11 I(4) 4 2 91719 COM 90,99,116,129,142,155,176,187,214, 223 J Local 76 I(4) 4 scalar 76,78,79,82,83,86,87,88,89,90,95,9 6,97,98,99,112,113,114,115,116,125 ,126,127,128,129,138,139,140,141,1 42,151,152,153,154,155,172,173,174 ,175,176,183,184,185,186,187,210,2 11,212,213,214,219,220,221,222,223 JDIM1 Param 15 I(4) 4 scalar JDIM2 Param 15 I(4) 4 scalar JEGRD Scalar 10 I(4) 4 2 91719 COM 83 JEGRDK Scalar 6 I(4) 4 2 91719 COM JGSTL Param 10 I(4) 4 scalar 15 JGSTR Param 10 I(4) 4 scalar 15 JM Param 3 I(4) 4 scalar 3,5,6,7,12,15,53 JMOT Dummy 1 I(4) 4 scalar ARG,INOUT 76 JMT Param 53 I(4) 4 scalar 7,8,58,75 JMX Param 3 I(4) 4 scalar 3,4,9,10,11,12 JNPES Param 6 I(4) 4 scalar 12,15 JTAIL Param 12 I(4) 4 scalar LCNTRL Scalar 5 I(4) 4 scalar COM LLGRDS Common 2 9167256 LM Param 3 I(4) 4 scalar 3 LM0N0 Local 56 L(4) 4 scalar 162,166,182,192 LM0N1 Local 56 L(4) 4 scalar 164,167,182,196 LM1N0 Local 56 L(4) 4 scalar 163,166,182,194 LM1N1 Local 56 L(4) 4 scalar 165,167,182,198 LSM Param 3 I(4) 4 scalar LUNCO Scalar 5 I(4) 4 scalar COM LUNLL Scalar 5 I(4) 4 scalar COM LUNOUT Scalar 5 I(4) 4 scalar COM M Local 80 I(4) 4 scalar 80,82,85,103,162,163,164,165 MAX Func 204 scalar 204,205,206,207 MAXI Local 74 I(4) 4 scalar 74,94 MAXJ Local 75 I(4) 4 scalar 75,94 MXFLD Param 3 I(4) 4 scalar MXLVL Param 3 I(4) 4 scalar N Local 81 I(4) 4 scalar 81,83,85,104,162,163,164,165 R00 Local 200 R(4) 4 scalar 200,204 R01 Local 202 R(4) 4 scalar 202,206 R10 Local 201 R(4) 4 scalar 201,205 R11 Local 203 R(4) 4 scalar 203,207 RXX Local 199 R(4) 4 scalar 199,204,205,206,207 SMALL Local 66 R(4) 4 scalar 66,107,119,120,132,133,145,146 SPVC Local 66 R(4) 4 scalar 66,162,163,164,165 Page 7 Source Listing GENBIL 2014-12-17 20:48 Symbol Table GENBIL.f Name Object Declared Type Bytes Dimen Elements Attributes References SQRT Func 199 scalar 199 STDOUT Scalar 2 I(4) 4 scalar COM 73,228 VTLAT Scalar 7 R(4) 4 2 91719 COM VTLON Scalar 7 R(4) 4 2 91719 COM W00 Local 108 R(4) 4 scalar 108,112,121,125,134,138,147,151,16 8,172,204,208,210 W01 Local 110 R(4) 4 scalar 110,114,123,127,136,140,149,153,17 0,174,206,208,212 W10 Local 109 R(4) 4 scalar 109,113,122,126,135,139,148,152,16 9,173,205,208,211 W11 Local 111 R(4) 4 scalar 111,115,124,128,137,141,150,154,17 1,175,207,208,213 WIJ Scalar 11 R(4) 4 2 91719 COM 86,95,112,125,138,151,172,183,210, 219 WIJP Scalar 12 R(4) 4 2 91719 COM 88,97,114,127,140,153,174,185,212, 221 WIPJ Scalar 11 R(4) 4 2 91719 COM 87,96,113,126,139,152,173,184,211, 220 WIPJP Scalar 12 R(4) 4 2 91719 COM 89,98,115,128,141,154,175,186,213, 222 WSUM Local 208 R(4) 4 scalar 208,209,210,211,212,213 XX Local 78 R(4) 4 scalar 78,80,94,103 YY Local 79 R(4) 4 scalar 79,81,94,104 Page 8 Source Listing GENBIL 2014-12-17 20:48 Subprograms/Common Blocks GENBIL.f SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References GENBIL Subr 1 IOUNIT Common 4 20 LLGRDS Common 2 9167256 COMPILER OPTIONS BEING USED -align nocommons -align nodcommons -align noqcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume byterecl -assume nocc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_unit_star -assume old_ldout_format -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume nostd_mod_proc_name -assume norealloc_lhs -assume underscore -assume no2underscores no -auto -auto_scalar no -bintext -ccdefault default -check noargs -check noarg_temp_created -check nobounds -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check power -check noshape -check nounderflow -check nouninitialized -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D _MT -D __INTEL_COMPILER_BUILD_DATE=20120612 -D __i686 -D __i686__ -D __pentiumpro -D __pentiumpro__ -D __pentium4 -D __pentium4__ -D __tune_pentium4__ -D __SSE2__ -D __SSE__ -D __MMX__ -double_size 64 no -d_lines no -Qdyncom -error_limit 30 no -f66 no -f77rtl no -fast -fpscomp nofilesfromcmd -fpscomp nogeneral -fpscomp noioformat -fpscomp noldio_spacing -fpscomp nologicals Page 9 Source Listing GENBIL 2014-12-17 20:48 GENBIL.f -fixed no -fpconstant -fpe3 -fprm nearest no -ftz -fp_model noprecise -fp_model fast -fp_model nostrict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -heap_arrays 0 no -threadprivate_compat -g2 -iface nomixed_str_len_arg -iface nono_mixed_str_len_arg no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase no -noinclude -O2 no -pad_source -real_size 32 no -recursive -reentrancy none no -sharable_localsaves -vec=simd -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w noargument_checking -w nodeclarations -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage -includepath : /gpfs/tp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/,.f,./.f,/usrx/local/intel/composerxe/mkl/include/.f, /usrx/local/intel/composerxe/tbb/include/.f,/gpfs/tp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/.f, /gpfs/tp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/.f,/usr/local/include/.f,/usr/lib/gcc/x86_64-redhat-linux/4.4.7/include/.f, /usr/include/.f,/usr/include/.f -list filename : GENBIL.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100