Page 1 Source Listing CETLIH4 2014-12-17 20:47 CETLIH4.f 1 SUBROUTINE CETLIH4(HE,HX,IMOT,JMOT,KSB,IOFFS) 2 C$$$ SUBPROGRAM DOCUMENTATION BLOCK 3 C . . . 4 C SUBPROGRAM: CETLIH4 INTERPOLATES 5 C PRGRMMR: TREADON ORG: W/NP2 DATE: 92-12-23 6 C 7 C ABSTRACT: 8 C THIS ROUTINE INTERPOLATES DATA IN ARRAY HE FROM HEIGHT 9 C POINTS ON AN ETA GRID TO HEIGHT POINTS ON ANOTHER GRID 10 C IN ARRAY HX. THE INTERPOLATION CONSERVES THE AREA 11 C INTEGRAL OF HE. 12 C 13 C ***WARNING*** 14 C COMPUTATION OF THE INTERPOLATION 'WEIGHTS' CONSUMES 15 C AN ENORMOUS AMOUNT OF CPU TIME, MUCH MORE THAN 16 C THE ACTUAL TIME IT TAKES TO DO THE INTERPOLATION. 17 C IT IS MUCH BETTER TO PRECOMPUTE THE REQUIRED 18 C WEIGHTS. SUBROUINE GD2EGK COMPUTES THESE 'WEIGHTS'. 19 C . 20 C 21 C PROGRAM HISTORY LOG: 22 C ??-??-?? ??? 23 C 92-12-23 RUSS TREADON - GENERALIZED CODE BY REMOVING 24 C HARDCODED (IM,JM). 25 C 93-06-09 RUSS TREADON - EXPANDED COMMENTS. 26 C 98-06-17 T BLACK - CONVERSION FROM 1-D TO 2-D 27 C 28 C USAGE: CETLIH4(HE,HX,IMOT,JMOT,KSB) 29 C INPUT ARGUMENT LIST: 30 C HE - DATA ON E-GRID. 31 C IMOT - FIRST DIMENSION OF OUTPUT GRID. 32 C JMOT - SECOND DIMENSION OF OUTPUT GRID. 33 C KSB - NUMBER OF SUB BOXES 34 C IOFFS - WIDTH (IN GRID POINTS) OF SEARCH WINDOW 35 C AROUND E-GRID POINT FROM WHICH INTERPOLATING. 36 C 37 C OUTPUT ARGUMENT LIST: 38 C HX - DATA INTERPOLATED TO THE OUTPUT GRID 39 C 40 C OUTPUT FILES: 41 C NONE 42 C 43 C SUBPROGRAMS CALLED: 44 C UTILITIES: 45 C NONE 46 C LIBRARY: 47 C COMMON - LLGRDS 48 C COMMON - INDX 49 C 50 C ATTRIBUTES: 51 C LANGUAGE: FORTRAN 52 C MACHINE : CRAY C-90 53 C$$$ 54 C 55 C 56 C INCLUDE ETA GRID DIMENSIONS. COMPUTE DEPENDENT PARAMETERS. 57 C Page 2 Source Listing CETLIH4 2014-12-17 20:47 CETLIH4.f 58 INCLUDE "parmeta" 76 INCLUDE "parmout" 77 C 81 PARAMETER (IMT=2*IM-1,JMT=JM) 82 C 83 C DECLARE VARIABLES. 84 INTEGER NZ(IMX,JMX) 85 REAL HE(IM,JM),HX(IMOT,JMOT) 86 C 87 C INCLUDE COMMON BLOCK. 88 INCLUDE "LLGRDS.comm" 102 INCLUDE "INDX.comm" 103 C 109 REAL SBLAT(IM,JM),SBLON(IM,JM),DSQMN(IM,JM) 110 INTEGER IISB(IM,JM),JJSB(IM,JM) 111 C 112 C 113 C********************************************************************** 114 C START CETLIH4. 115 C 116 C ZERO OUTPUT ARRAY AND NORMALIZATION ARRAY. 117 !$omp parallel do 118 DO 100 JJ=1,JMOT 119 DO 100 II=1,IMOT 120 HX(II,JJ)=0. 121 NZ(II,JJ)=0 122 100 CONTINUE 123 C 124 C SET CONSTANTS. 125 JMOT2 = JMOT-2 126 IMOT2 = IMOT-2 127 SBS=1./KSB 128 C 129 C LOOP OVER E-GRID. MOVE SOUTH TO NORTH THROUGH JM2 ROWS. 130 C ON EACH ROW MOVE WEST TO EAST THROUGH THE E-GRID K INDEX. 131 C AT EACH K INTERPOLATE DATA IN E-GRID ARRAY HE TO OUTPUT 132 C GRID ARRAY HX. 133 C 134 !$omp parallel do 135 !$omp& private(clat,clon,dsq,ie,iend,ip,is,iw,jp,js,p,pq,q) 136 DO 185 J=3,JM-2 137 C 138 IEND=IM-1-MOD(J+1,2) 139 C 140 C DISTRIBUTE THE E-GRID VALUES (IN ARRAY HE) TO THE SURROUNDING 141 C KSB*KSB OUTPUT GRID POINTS. 142 C 143 DO 160 JB=1,KSB 144 DO 160 IB=1,KSB 145 DO 175 I=2,IEND 146 C 147 C SET TRANSFORMED (LAT,LON) OF THE K-TH E-GRID MASS POINT. 148 C THIS BECOMES THE CENTER OF THE BOX OVER WHICH THE AREA 149 C CONSERVING INTERPOLATION IS DONE. 150 C 151 DSQMN(I,J)= 1. 152 IISB(I,J) = -1 Page 3 Source Listing CETLIH4 2014-12-17 20:47 CETLIH4.f 153 JJSB(I,J) = -1 154 JP = JEGRDK(I,J) 155 IF (JP.LT.1) GOTO 175 156 CLON=HTLON(I,J) 157 CLAT=HTLAT(I,j) 158 C 159 C LOAD THE OUTPUT GRID (I,J) NEAREST TO K-TH E-GRID MASS POINT. 160 C IF INTERPOLATION FROM THE K-TH E-GRID MASS POINT TO THE 161 C OUTPUT GRID IS NOT POSSIBLE (AT INDICATED BY ZERO OR NEGATIVE 162 C OUTPUT GRID (I,J), DO NOT ATTEMPT INTERPOLATION CENTERED ON 163 C THIS E-GRID MASS POINT. 164 C 165 C 166 C FOR THE (IB,JB)-TH SUB-BOX COMPUTE THE TRANSFORMED E-GRID 167 C LATITUDE AND LONGITUDE AT THE CENTER OF THIS SUB-BOX. 168 C 169 P=(IB-(KSB+1.)/2.)*SBS 170 Q=(JB-(KSB+1.)/2.)*SBS 171 PQ=P*Q 172 IE=I+IHE(J) 173 IW=I+IHW(J) 174 SBLON(I,J)=CLON+P*(HTLON(IE,J+1)-CLON) 175 1 +Q*(HTLON(IW,J+1)-CLON) 176 2 +PQ*(CLON-HTLON(IE,J+1)-HTLON(IW,J+1)+HTLON(I,J+2)) 177 SBLAT(I,J)=CLAT+P*(HTLAT(IE,J+1)-CLAT) 178 1 +Q*(HTLAT(IW,J+1)-CLAT) 179 2 +PQ*(CLAT-HTLAT(IE,J+1)-HTLAT(IW,J+1)+HTLAT(I,J+2)) 180 175 CONTINUE 181 C 182 DO 150 JJ=0,IOFFS 183 DO 150 II=0,IOFFS 184 C 185 DO 180 I=2,IEND 186 JP = JEGRDK(I,J) 187 IF (JP.LT.1) GOTO 180 188 IP = IEGRDK(I,J) 189 190 C SET OUTPUT GRID (I,J) SURROUNDING THE E-GRID MASS POINT. 191 C 192 IS=IP-(IOFFS-1) 193 JS=JP-(IOFFS-1) 194 C SEARCH FOR THE OUTPUT GRID POINT NEAREST TO THE CENTER 195 C OF THE (IB,JB)-TH SUB-BOX. ASSIGN THE (I,J) INDEX OF 196 C THIS POINT TO (IISB,JJSB) 197 C 198 DSQ=(GDTLON((IS+II),(JS+JJ))-SBLON(I,J))**2 199 * +(GDTLAT((IS+II),(JS+JJ))-SBLAT(I,J))**2 200 IF(DSQ.LT.DSQMN(I,J)) THEN 201 DSQMN(I,J)=DSQ 202 IISB(I,J)=IS+II 203 JJSB(I,J)=JS+JJ 204 ENDIF 205 180 CONTINUE 206 150 CONTINUE 207 C 208 C IF INTERPOLATION WAS NOT POSSIBLE TO THE CURRENT 209 C OUTPUT GRID SUB-BOX, THEN SKIP THIS SUB-BOX AND Page 4 Source Listing CETLIH4 2014-12-17 20:47 CETLIH4.f 210 C TRY THE NEXT ONE. 211 C 212 DO 155 I=2,IEND 213 IF(IISB(I,J).GT.0)THEN 214 C 215 C ADD E-GRID AMOUNT IN ARRAY HE ON INPUT E-GRID TO THE 216 C NEAREST NEIGHBOR OUTPUT GRID SUB-BOX IDENTIFIED ABOVE. 217 C 218 HX(IISB(I,J),JJSB(I,J))=HX(IISB(I,J),JJSB(I,J))+HE(I,J) 219 NZ(IISB(I,J),JJSB(I,J))=NZ(IISB(I,J),JJSB(I,J))+1 220 ENDIF 221 155 CONTINUE 222 C 223 C REPEAT FOR NEXT SUB-BOX. 224 C 225 160 CONTINUE 226 C 227 C REPEAT INTERPOLATION FOR NEXT E-GRID MASS POINT. 228 C 229 185 CONTINUE 230 C 231 C NORMALIZE OUTPUT GRID AMOUNT IN ARRAY HX BY THE NUMBER OF 232 C E-GRID AMOUNTS SUMMED TO OBTAIN THE OUTPUT GRID AMOUNT. 233 C 234 !$omp parallel do 235 DO 200 JJ=1,JMOT 236 DO 200 II=1,IMOT 237 C 238 C AVOID DIVISION BY ZERO. NZ=0 INDICATES NO 239 C INTERPOLATION WAS POSSIBLE AND SO THE OUTPUT 240 C GRID VALUE IN ARRAY HX SHOULD REMAIN THE ZERO 241 C IT WAS INITIALIZED TO. 242 c IF (NZ(II,JJ).EQ.0) NZ(II,JJ) = 1 243 C 244 IF (NZ(II,JJ).NE.0) THEN 245 HX (II,JJ)=HX(II,JJ) / NZ(II,JJ) 246 ENDIF 247 200 CONTINUE 248 C 249 C END OF ROUTINE. 250 C 251 RETURN 252 END Page 5 Source Listing CETLIH4 2014-12-17 20:47 Entry Points CETLIH4.f ENTRY POINTS Name cetlih4_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 100 Label 84 80,81 150 Label 168 144,145 155 Label 183 174 160 Label 187 105,106 175 Label 142 107,117 180 Label 167 147,149 185 Label 191 98 200 Label 209 197,198 CETLIH4 Subr 1 CLAT Local 119 R(4) 4 scalar 119,139,140,141 CLON Local 118 R(4) 4 scalar 118,136,137,138 DSQ Local 160 R(4) 4 scalar 160,162,163 DSQMN Local 71 R(4) 4 2 91719 113,162,163 EGRDI Scalar 9 R(4) 4 2 91719 COM EGRDJ Scalar 9 R(4) 4 2 91719 COM 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 161 GDTLON Scalar 4 R(4) 4 2 91719 COM 160 HE Dummy 1 R(4) 4 2 91719 ARG,INOUT 180 HTLAT Scalar 5 R(4) 4 2 91719 COM 119,139,140,141 HTLON Scalar 5 R(4) 4 2 91719 COM 118,136,137,138 HX Dummy 1 R(4) 4 2 0 ARG,INOUT 82,180,207 I Local 107 I(4) 4 scalar 107,113,114,115,116,118,119,134,13 5,136,138,139,141,147,148,150,160, 161,162,163,164,165,174,175,180,18 1 IB Local 106 I(4) 4 scalar 106,131 IDIM1 Param 14 I(4) 4 scalar IDIM2 Param 14 I(4) 4 scalar IE Local 134 I(4) 4 scalar 134,136,138,139,141 IEGRD Scalar 10 I(4) 4 2 91719 COM IEGRDK Scalar 6 I(4) 4 2 91719 COM 150 IEND Local 100 I(4) 4 scalar 100,107,147,174 IGSTL Param 9 I(4) 4 scalar 14 IGSTR Param 9 I(4) 4 scalar 14 IHE Scalar 3 I(4) 4 1 387 COM 134 IHW Scalar 3 I(4) 4 1 387 COM 135 II Local 81 I(4) 4 scalar 81,82,83,145,160,161,164,198,206,2 07 IISB Local 72 I(4) 4 2 91719 114,164,175,180,181 Page 6 Source Listing CETLIH4 2014-12-17 20:47 Symbol Table CETLIH4.f Name Object Declared Type Bytes Dimen Elements Attributes References IM Param 3 I(4) 4 scalar 3,5,6,7,11,14,61,65,71,72,100 IMOT Dummy 1 I(4) 4 scalar ARG,INOUT 65,81,88,198 IMOT2 Local 88 I(4) 4 scalar 88 IMT Param 61 I(4) 4 scalar 7,8 IMX Param 3 I(4) 4 scalar 3,4,9,10,11,12,64 INDX Common 2 6192 INPES Param 6 I(4) 4 scalar 11,14 IOFFS Dummy 1 I(4) 4 scalar ARG,INOUT 144,145,154,155 IP Local 150 I(4) 4 scalar 150,154 IS Local 154 I(4) 4 scalar 154,160,161,164 ITAIL Param 11 I(4) 4 scalar IVE Scalar 3 I(4) 4 1 387 COM IVW Scalar 3 I(4) 4 1 387 COM IW Local 135 I(4) 4 scalar 135,137,138,140,141 IWGT Scalar 11 I(4) 4 2 91719 COM J Local 98 I(4) 4 scalar 98,100,113,114,115,116,118,119,134 ,135,136,137,138,139,140,141,148,1 50,160,161,162,163,164,165,175,180 ,181 JB Local 105 I(4) 4 scalar 105,132 JDIM1 Param 15 I(4) 4 scalar JDIM2 Param 15 I(4) 4 scalar JEGRD Scalar 10 I(4) 4 2 91719 COM JEGRDK Scalar 6 I(4) 4 2 91719 COM 116,148 JGSTL Param 10 I(4) 4 scalar 15 JGSTR Param 10 I(4) 4 scalar 15 JJ Local 80 I(4) 4 scalar 80,82,83,144,160,161,165,197,206,2 07 JJSB Local 72 I(4) 4 2 91719 115,165,180,181 JM Param 3 I(4) 4 scalar 3,5,6,7,12,15,61,65,71,72,98 JMOT Dummy 1 I(4) 4 scalar ARG,INOUT 65,80,87,197 JMOT2 Local 87 I(4) 4 scalar 87 JMT Param 61 I(4) 4 scalar 7,8 JMX Param 3 I(4) 4 scalar 3,4,9,10,11,12,64 JNPES Param 6 I(4) 4 scalar 12,15 JP Local 116 I(4) 4 scalar 116,117,148,149,155 JS Local 155 I(4) 4 scalar 155,160,161,165 JTAIL Param 12 I(4) 4 scalar KSB Dummy 1 I(4) 4 scalar ARG,INOUT 89,105,106,131,132 LLGRDS Common 2 9167256 LM Param 3 I(4) 4 scalar 3 LSM Param 3 I(4) 4 scalar MOD Func 100 scalar 100 MXFLD Param 3 I(4) 4 scalar MXLVL Param 3 I(4) 4 scalar NZ Local 64 I(4) 4 2 91719 83,181,206,207 P Local 131 R(4) 4 scalar 131,133,136,139 PQ Local 133 R(4) 4 scalar 133,138,141 Q Local 132 R(4) 4 scalar 132,133,137,140 SBLAT Local 71 R(4) 4 2 91719 139,161 SBLON Local 71 R(4) 4 2 91719 136,160 SBS Local 89 R(4) 4 scalar 89,131,132 VTLAT Scalar 7 R(4) 4 2 91719 COM VTLON Scalar 7 R(4) 4 2 91719 COM WIJ Scalar 11 R(4) 4 2 91719 COM Page 7 Source Listing CETLIH4 2014-12-17 20:47 Symbol Table CETLIH4.f Name Object Declared Type Bytes Dimen Elements Attributes References WIJP Scalar 12 R(4) 4 2 91719 COM WIPJ Scalar 11 R(4) 4 2 91719 COM WIPJP Scalar 12 R(4) 4 2 91719 COM Page 8 Source Listing CETLIH4 2014-12-17 20:47 Subprograms/Common Blocks CETLIH4.f SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References CETLIH4 Subr 1 INDX Common 2 6192 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 CETLIH4 2014-12-17 20:47 CETLIH4.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 : CETLIH4.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100