| 1 | SUBROUTINE interp (kindex, kfield) |
|---|
| 2 | C**** |
|---|
| 3 | C ***************************** |
|---|
| 4 | C |
|---|
| 5 | C * OASIS ROUTINE - LEVEL 1 * |
|---|
| 6 | C * ------------- ------- * |
|---|
| 7 | C ***************************** |
|---|
| 8 | C |
|---|
| 9 | C**** *interp* - Control routine for interpolation |
|---|
| 10 | C |
|---|
| 11 | C |
|---|
| 12 | C Purpose: |
|---|
| 13 | C ------- |
|---|
| 14 | C Monitor the field interpolation and auxilary analysis |
|---|
| 15 | C |
|---|
| 16 | C** Interface: |
|---|
| 17 | C --------- |
|---|
| 18 | C *CALL* *interp (kindex, kfield)* |
|---|
| 19 | C |
|---|
| 20 | C Input: |
|---|
| 21 | C ----- |
|---|
| 22 | C kindex : current active fields index array |
|---|
| 23 | C kfield : current active fields total number |
|---|
| 24 | C |
|---|
| 25 | C Output: |
|---|
| 26 | C ------ |
|---|
| 27 | C None |
|---|
| 28 | C |
|---|
| 29 | C Workspace: |
|---|
| 30 | C --------- |
|---|
| 31 | C None |
|---|
| 32 | C |
|---|
| 33 | C Externals: |
|---|
| 34 | C --------- |
|---|
| 35 | C fiasco, blasold, filling, mozaic |
|---|
| 36 | C |
|---|
| 37 | C Reference: |
|---|
| 38 | C --------- |
|---|
| 39 | C See OASIS manual (1995) |
|---|
| 40 | C |
|---|
| 41 | C History: |
|---|
| 42 | C ------- |
|---|
| 43 | C Version Programmer Date Description |
|---|
| 44 | C ------- ---------- ---- ----------- |
|---|
| 45 | C 2.0beta L. Terray 95/09/01 created |
|---|
| 46 | C 2.0 L. Terray 96/02/01 modified: mozaic interpolation |
|---|
| 47 | C 2.1 L. Terray 96/08/05 modified: Add new arrays for |
|---|
| 48 | C mapping data(weight, adresses) |
|---|
| 49 | C addition of no interpolation |
|---|
| 50 | C 2.3 S. Valcke 99/04/30 added: printing levels |
|---|
| 51 | C 2.3 L. Terray 99/09/15 changed: periodicity variables |
|---|
| 52 | C 2.5 Gayler/Declat 01/11/09 scrip remapping |
|---|
| 53 | C |
|---|
| 54 | C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
|---|
| 55 | C |
|---|
| 56 | C* ----------------Include files and USE of modules --------------------------- |
|---|
| 57 | C |
|---|
| 58 | USE mod_kinds_oasis |
|---|
| 59 | USE mod_parameter |
|---|
| 60 | USE mod_extrapol |
|---|
| 61 | USE mod_string |
|---|
| 62 | USE mod_analysis |
|---|
| 63 | USE mod_memory |
|---|
| 64 | USE mod_anais |
|---|
| 65 | USE mod_rainbow |
|---|
| 66 | USE mod_unit |
|---|
| 67 | USE mod_printing |
|---|
| 68 | C |
|---|
| 69 | C* ---------------------------- Argument declarations ------------------- |
|---|
| 70 | C |
|---|
| 71 | INTEGER (kind=ip_intwp_p) kindex(kfield) |
|---|
| 72 | C |
|---|
| 73 | C* ---------------------------- Local declarations ---------------------- |
|---|
| 74 | C |
|---|
| 75 | REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: zbocoef |
|---|
| 76 | INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: iaddr, |
|---|
| 77 | $ isize, iflag |
|---|
| 78 | CHARACTER(len=8),DIMENSION(:), ALLOCATABLE :: clbofld |
|---|
| 79 | CHARACTER*8 clintmet, clgrdtyp, clfldtyp, clfilfic, clfilmet |
|---|
| 80 | CHARACTER*8 clfic, clstrg, clname |
|---|
| 81 | CHARACTER*8 clsper, cltper |
|---|
| 82 | LOGICAL llchk |
|---|
| 83 | C |
|---|
| 84 | C* ---------------------------- Poema verses ---------------------------- |
|---|
| 85 | C |
|---|
| 86 | C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
|---|
| 87 | C |
|---|
| 88 | C* 1. Initialization and allocation of local arrays |
|---|
| 89 | C --------------------------------------------- |
|---|
| 90 | C |
|---|
| 91 | IF (nlogprt .GE. 1) THEN |
|---|
| 92 | WRITE (UNIT = nulou,FMT = *) ' ' |
|---|
| 93 | WRITE (UNIT = nulou,FMT = *) ' ' |
|---|
| 94 | WRITE (UNIT = nulou,FMT = *) |
|---|
| 95 | $ ' ROUTINE interp - Level 1' |
|---|
| 96 | WRITE (UNIT = nulou,FMT = *) |
|---|
| 97 | $ ' ************** *******' |
|---|
| 98 | WRITE (UNIT = nulou,FMT = *) ' ' |
|---|
| 99 | WRITE (UNIT = nulou,FMT = *) ' Monitor field interpolation' |
|---|
| 100 | WRITE (UNIT = nulou,FMT = *) ' ' |
|---|
| 101 | WRITE (UNIT = nulou,FMT = *) ' ' |
|---|
| 102 | ENDIF |
|---|
| 103 | C |
|---|
| 104 | ALLOCATE (zbocoef(ig_maxcomb),stat=il_err) |
|---|
| 105 | IF (il_err.NE.0) CALL prtout ('Error in "zbocoef" allocation of |
|---|
| 106 | $ cookart ',il_err,1) |
|---|
| 107 | ALLOCATE (iaddr(ig_maxcomb),stat=il_err) |
|---|
| 108 | IF (il_err.NE.0) CALL prtout ('Error in "iaddr" allocation of |
|---|
| 109 | $ cookart ',il_err,1) |
|---|
| 110 | ALLOCATE (isize(ig_maxcomb),stat=il_err) |
|---|
| 111 | IF (il_err.NE.0) CALL prtout ('Error in "isize" allocation of |
|---|
| 112 | $ cookart ',il_err,1) |
|---|
| 113 | ALLOCATE (iflag(ig_maxcomb),stat=il_err) |
|---|
| 114 | IF (il_err.NE.0) CALL prtout ('Error in "iflag" allocation of |
|---|
| 115 | $ cookart ',il_err,1) |
|---|
| 116 | ALLOCATE (clbofld(ig_maxcomb),stat=il_err) |
|---|
| 117 | IF (il_err.NE.0) CALL prtout ('Error in "clbofld" allocation of |
|---|
| 118 | $ cookart ',il_err,1) |
|---|
| 119 | zbocoef(:)=0 |
|---|
| 120 | iaddr(:)=0 |
|---|
| 121 | isize(:)=0 |
|---|
| 122 | iflag(:)=0 |
|---|
| 123 | clbofld(:)=' ' |
|---|
| 124 | C |
|---|
| 125 | C |
|---|
| 126 | C* 2. Do the job |
|---|
| 127 | C ---------- |
|---|
| 128 | C |
|---|
| 129 | !$omp parallel do default (shared) |
|---|
| 130 | !$omp+ private (ja,jf,jj,ji,jd,jb,jc,jk,jl) |
|---|
| 131 | !$omp+ private (ifield,clsper,clname,ilataf,ilonaf) |
|---|
| 132 | !$omp+ private (itper,isper,cltper) |
|---|
| 133 | !$omp+ private (ipdeb,ilatbf,ilonbf,isiznew) |
|---|
| 134 | !$omp+ private (ibofld,zfldcobo,iadrnew,iadrnew_grid) |
|---|
| 135 | !$omp+ private (iadrold,iadrold_grid,isizold) |
|---|
| 136 | !$omp+ private (isize,iflag) |
|---|
| 137 | !$omp+ private (ipointer,iaddr,isiztot,clfic) |
|---|
| 138 | !$omp+ private (clfilmet,iunit,ivoisin,clstrg) |
|---|
| 139 | !$omp+ private (iloc,clintmet,clgrdtyp,clfldtyp) |
|---|
| 140 | !$omp+ private (clfilfic,llchk) |
|---|
| 141 | |
|---|
| 142 | DO 210 jf = 1, kfield |
|---|
| 143 | C |
|---|
| 144 | C* Assign local variables |
|---|
| 145 | C |
|---|
| 146 | ifield = kindex(jf) |
|---|
| 147 | iadrold = nadrold(ifield) |
|---|
| 148 | iadrold_grid = nadrold_grid(ifield) |
|---|
| 149 | isizold = nsizold(ifield) |
|---|
| 150 | iadrnew = nadrnew(ifield) |
|---|
| 151 | iadrnew_grid = nadrnew_grid(ifield) |
|---|
| 152 | isiznew = nsiznew(ifield) |
|---|
| 153 | ilonbf = nlonbf(ifield) |
|---|
| 154 | ilatbf = nlatbf(ifield) |
|---|
| 155 | ilonaf = nlonaf(ifield) |
|---|
| 156 | ilataf = nlataf(ifield) |
|---|
| 157 | clname = cnaminp(ifield) |
|---|
| 158 | clsper = csper(ifield) |
|---|
| 159 | cltper = ctper(ifield) |
|---|
| 160 | isper = nosper(ifield) |
|---|
| 161 | itper = notper(ifield) |
|---|
| 162 | C |
|---|
| 163 | C* Print field name |
|---|
| 164 | C |
|---|
| 165 | IF (nlogprt .GE. 1) THEN |
|---|
| 166 | CALL prcout('Treatment of field : ', clname, 2) |
|---|
| 167 | ENDIF |
|---|
| 168 | C |
|---|
| 169 | C* - Do interpolation |
|---|
| 170 | C |
|---|
| 171 | DO 220 ja = 1, ig_ntrans(ifield) |
|---|
| 172 | IF (canal(ja,ifield) .EQ. 'INTERP') THEN |
|---|
| 173 | C |
|---|
| 174 | C* --->>> Interp |
|---|
| 175 | C |
|---|
| 176 | C* Assign local variables |
|---|
| 177 | clintmet = cintmet(ifield) |
|---|
| 178 | clgrdtyp = cgrdtyp(ifield) |
|---|
| 179 | clfldtyp = cfldtyp(ifield) |
|---|
| 180 | C |
|---|
| 181 | C* Zero work array |
|---|
| 182 | C |
|---|
| 183 | CALL szero (work, ig_work) |
|---|
| 184 | !$omp critical |
|---|
| 185 | CALL fiasco |
|---|
| 186 | C* Data about fields, grids, masks and surfaces |
|---|
| 187 | $ (fldnew(iadrnew), |
|---|
| 188 | $ xgrnew(iadrnew_grid), ygrnew(iadrnew_grid), |
|---|
| 189 | $ surnew(iadrnew_grid), |
|---|
| 190 | $ msknew(iadrnew_grid), ilonaf, ilataf, cltper, itper, |
|---|
| 191 | $ fldold(iadrold), |
|---|
| 192 | $ xgrold(iadrold_grid), ygrold(iadrold_grid), |
|---|
| 193 | $ surold(iadrold_grid), |
|---|
| 194 | $ mskold(iadrold_grid), ilonbf, ilatbf, clsper, isper, |
|---|
| 195 | C* Work arrays for the different interpolators |
|---|
| 196 | $ work(1), |
|---|
| 197 | $ work(1+ilonaf), |
|---|
| 198 | $ work(1+ilonaf+ilataf), |
|---|
| 199 | $ work(1+ilonaf+ilataf+isizold), |
|---|
| 200 | $ work(1+ilonaf+ilataf+isizold+isiznew), |
|---|
| 201 | $ work(1+ilonaf+ilataf+2*isizold+isiznew), |
|---|
| 202 | C* Define field number and type, grid and interpolation |
|---|
| 203 | $ ifield, clintmet, clgrdtyp, clfldtyp) |
|---|
| 204 | !$omp end critical |
|---|
| 205 | C |
|---|
| 206 | C* --->>> Nointerp |
|---|
| 207 | C |
|---|
| 208 | ELSE IF (canal(ja,ifield) .EQ. 'NOINTERP') THEN |
|---|
| 209 | C |
|---|
| 210 | C* output field is equal to input field |
|---|
| 211 | C |
|---|
| 212 | C* First, check dimension |
|---|
| 213 | C |
|---|
| 214 | llchk = ilataf .EQ. ilatbf .AND. |
|---|
| 215 | $ ilonaf-itper .EQ. ilonbf-isper |
|---|
| 216 | IF (.NOT. llchk) CALL prcout('WARNING: size mismatch |
|---|
| 217 | $ in NOINTERP between old and new field ',clname,2) |
|---|
| 218 | IF (.NOT. llchk) CALL HALTE('STOP in interp') |
|---|
| 219 | C* Do the assign |
|---|
| 220 | DO 230 jj = 1, ilatbf |
|---|
| 221 | DO 233 ji = 1, ilonbf-isper |
|---|
| 222 | jk = (jj-1)*ilonaf+ji |
|---|
| 223 | jl = (jj-1)*ilonbf+ji |
|---|
| 224 | fldnew(iadrnew - 1 + jk) = fldold(iadrold - 1 + jl) |
|---|
| 225 | 233 CONTINUE |
|---|
| 226 | DO 236 ji = 1, itper |
|---|
| 227 | jk = (jj-1)*ilonaf+ilonaf-itper+ji |
|---|
| 228 | jl = (jj-1)*ilonbf+ji |
|---|
| 229 | fldnew(iadrnew - 1 + jk) = fldold(iadrold - 1 + jl) |
|---|
| 230 | 236 CONTINUE |
|---|
| 231 | 230 CONTINUE |
|---|
| 232 | C |
|---|
| 233 | C* --->>> Mozaic |
|---|
| 234 | C |
|---|
| 235 | ELSE IF (canal(ja,ifield) .EQ. 'MOZAIC') THEN |
|---|
| 236 | C |
|---|
| 237 | C* assign local variables and get pointer for mapping interpolation |
|---|
| 238 | C |
|---|
| 239 | clfic = cgrdmap(ifield) |
|---|
| 240 | iunit = nlumap(ifield) |
|---|
| 241 | iloc = nmapfl(ifield) |
|---|
| 242 | ipdeb = (nmapfl(ifield)-1)*ig_maxmoa*ig_maxgrd+1 |
|---|
| 243 | ivoisin = nmapvoi(ifield) |
|---|
| 244 | clstrg = cficbf(ifield)//cficaf(ifield) |
|---|
| 245 | CALL mozaic (fldnew(iadrnew), isiznew, |
|---|
| 246 | $ fldold(iadrold), isizold, |
|---|
| 247 | $ clfic, iunit, clstrg, iloc, |
|---|
| 248 | $ amapp(ipdeb), nmapp(ipdeb), |
|---|
| 249 | $ ivoisin, lmapp(ifield)) |
|---|
| 250 | C* --->>> SCRIP remapping |
|---|
| 251 | C |
|---|
| 252 | ELSE IF (canal(ja,ifield) .EQ. 'SCRIPR') THEN |
|---|
| 253 | C |
|---|
| 254 | C* perform the scrip remapping |
|---|
| 255 | C |
|---|
| 256 | clgrdtyp = cgrdtyp(ifield) |
|---|
| 257 | C |
|---|
| 258 | C* Vector case |
|---|
| 259 | C |
|---|
| 260 | IF (cfldtype(ifield) .eq. 'VECTOR_I' .or. |
|---|
| 261 | $ cfldtype(ifield) .eq. 'VECTOR_J') THEN |
|---|
| 262 | |
|---|
| 263 | ifield_assoc = ig_assoc_input_field(ifield) |
|---|
| 264 | iadrold_assoc = nadrold(ifield_assoc) |
|---|
| 265 | iadrold_assoc_grid = nadrold_grid(ifield_assoc) |
|---|
| 266 | iadrnew_assoc = nadrnew(ifield_assoc) |
|---|
| 267 | isizold_assoc = nsizold(ifield_assoc) |
|---|
| 268 | isiznew_assoc = nsiznew(ifield_assoc) |
|---|
| 269 | ilonbf_assoc = nlonbf(ifield_assoc) |
|---|
| 270 | ilatbf_assoc = nlatbf(ifield_assoc) |
|---|
| 271 | |
|---|
| 272 | CALL scriprmp_vector ( |
|---|
| 273 | $ fldnew(iadrnew), fldold(iadrold), isizold, isiznew, |
|---|
| 274 | $ mskold(iadrold_grid), msknew(iadrnew_grid), |
|---|
| 275 | $ xgrold(iadrold_grid), ygrold(iadrold_grid), |
|---|
| 276 | $ ilonbf, ilatbf, |
|---|
| 277 | $ xgrnew(iadrnew_grid), ygrnew(iadrnew_grid), ilonaf, |
|---|
| 278 | $ ilataf, |
|---|
| 279 | $ cmap_method(ifield), clgrdtyp, nosper(ifield), |
|---|
| 280 | $ cficbf(ifield), cficaf(ifield), cnorm_opt(ifield), |
|---|
| 281 | $ corder(ifield), crsttype(ifield), nbins(ifield), |
|---|
| 282 | $ lextrapdone(ifield), varmul(ifield), |
|---|
| 283 | $ nscripvoi(ifield), |
|---|
| 284 | $ fldold(iadrold_assoc),cfldtype(ifield), |
|---|
| 285 | $ xgrold(iadrold_assoc_grid), |
|---|
| 286 | $ ygrold(iadrold_assoc_grid), |
|---|
| 287 | $ mskold(iadrold_assoc_grid),cficbf(ifield_assoc), |
|---|
| 288 | $ cficaf(ifield_assoc),lrotate(ifield), |
|---|
| 289 | $ fldnew(iadrnew_assoc),isizold_assoc,isiznew_assoc, |
|---|
| 290 | $ ilonbf_assoc, ilatbf_assoc) |
|---|
| 291 | |
|---|
| 292 | ELSE |
|---|
| 293 | C |
|---|
| 294 | C* Scalar case |
|---|
| 295 | C |
|---|
| 296 | |
|---|
| 297 | CALL scriprmp ( |
|---|
| 298 | $ fldnew(iadrnew), fldold(iadrold), isizold, |
|---|
| 299 | $ isiznew, |
|---|
| 300 | $ mskold(iadrold_grid), msknew(iadrnew_grid), |
|---|
| 301 | $ xgrold(iadrold_grid), ygrold(iadrold_grid), |
|---|
| 302 | $ ilonbf, ilatbf, |
|---|
| 303 | $ xgrnew(iadrnew_grid), ygrnew(iadrnew_grid), |
|---|
| 304 | $ ilonaf, ilataf, |
|---|
| 305 | $ cmap_method(ifield), clgrdtyp, nosper(ifield), |
|---|
| 306 | $ cficbf(ifield), cficaf(ifield), |
|---|
| 307 | $ cnorm_opt(ifield), |
|---|
| 308 | $ corder(ifield), crsttype(ifield), |
|---|
| 309 | $ nbins(ifield), |
|---|
| 310 | $ lextrapdone(ifield), varmul(ifield), |
|---|
| 311 | $ nscripvoi(ifield)) |
|---|
| 312 | END IF |
|---|
| 313 | C |
|---|
| 314 | C* --->>> Blasold |
|---|
| 315 | C |
|---|
| 316 | ELSE IF (canal(ja,ifield) .EQ. 'BLASOLD') THEN |
|---|
| 317 | C |
|---|
| 318 | C* Assign local variables |
|---|
| 319 | C |
|---|
| 320 | zfldcobo = afldcobo(ifield) |
|---|
| 321 | ibofld = nbofld(ifield) |
|---|
| 322 | DO 240 jc = 1, ibofld |
|---|
| 323 | clbofld(jc) = cbofld(jc,ifield) |
|---|
| 324 | zbocoef(jc) = abocoef(jc,ifield) |
|---|
| 325 | 240 CONTINUE |
|---|
| 326 | C |
|---|
| 327 | C* Get the additional fields (pointers and sizes) |
|---|
| 328 | C |
|---|
| 329 | CALL szero( work, ig_work) |
|---|
| 330 | DO 250 jc = 1, ibofld |
|---|
| 331 | IF (clbofld(jc) .EQ. 'CONSTANT') THEN |
|---|
| 332 | isize(jc) = isizold |
|---|
| 333 | ELSE |
|---|
| 334 | DO 260 jb = 1, ig_nfield |
|---|
| 335 | C |
|---|
| 336 | C* Check field names input list |
|---|
| 337 | C |
|---|
| 338 | IF (clbofld(jc) .EQ. cnaminp(jb)) THEN |
|---|
| 339 | iflag(jc) = jb |
|---|
| 340 | ENDIF |
|---|
| 341 | 260 CONTINUE |
|---|
| 342 | ipointer = nadrold(iflag(jc)) |
|---|
| 343 | isize(jc) = nsizold(iflag(jc)) |
|---|
| 344 | ENDIF |
|---|
| 345 | IF (jc .EQ. 1) THEN |
|---|
| 346 | iaddr(jc) = 1 |
|---|
| 347 | ELSE |
|---|
| 348 | iaddr(jc) = 1 + isize(jc-1) |
|---|
| 349 | ENDIF |
|---|
| 350 | C |
|---|
| 351 | C* Assign values to temporary array work |
|---|
| 352 | C |
|---|
| 353 | IF (clbofld(jc) .EQ. 'CONSTANT') THEN |
|---|
| 354 | DO 270 jd = 1, isize(jc) |
|---|
| 355 | work(iaddr(jc)+jd-1) = 1.0 |
|---|
| 356 | 270 CONTINUE |
|---|
| 357 | ELSE |
|---|
| 358 | DO 280 jd = 1, isize(jc) |
|---|
| 359 | work(iaddr(jc)+jd-1) = fldold(ipointer+jd-1) |
|---|
| 360 | 280 CONTINUE |
|---|
| 361 | ENDIF |
|---|
| 362 | 250 CONTINUE |
|---|
| 363 | C |
|---|
| 364 | C* Get total size for array work ( sum of additional fields sizes) |
|---|
| 365 | C |
|---|
| 366 | isiztot = iaddr(ibofld) + isize(ibofld) - 1 |
|---|
| 367 | CALL blasold (fldold(iadrold), isizold, ifield, |
|---|
| 368 | $ zfldcobo, ibofld, iaddr, isize, |
|---|
| 369 | $ zbocoef, isiztot, work) |
|---|
| 370 | C |
|---|
| 371 | C* --->>> Filling |
|---|
| 372 | C |
|---|
| 373 | ELSE IF (canal(ja,ifield) .EQ. 'FILLING') THEN |
|---|
| 374 | C |
|---|
| 375 | C* Assign local variables |
|---|
| 376 | C |
|---|
| 377 | clfilfic = cfilfic(ifield) |
|---|
| 378 | iunit = nlufil(ifield) |
|---|
| 379 | clfilmet = cfilmet(ifield) |
|---|
| 380 | C |
|---|
| 381 | C* Zero work array |
|---|
| 382 | C |
|---|
| 383 | CALL szero (work, ig_work) |
|---|
| 384 | C |
|---|
| 385 | C* Address of overlapping grids array used in Anaism |
|---|
| 386 | C |
|---|
| 387 | ipointer = (naismfl(ifield)-1)*ig_maxgrd + 1 |
|---|
| 388 | CALL filling (fldnew(iadrnew), work(1), work(isiznew+1), |
|---|
| 389 | $ work(2*isiznew+1), |
|---|
| 390 | $ xgrnew(iadrnew_grid), ygrnew(iadrnew_grid), |
|---|
| 391 | $ ilonaf, ilataf, |
|---|
| 392 | $ msknew(iadrnew_grid), nmesh(ipointer), iunit, |
|---|
| 393 | $ clfilfic, clfilmet) |
|---|
| 394 | ELSE |
|---|
| 395 | CONTINUE |
|---|
| 396 | END IF |
|---|
| 397 | 220 CONTINUE |
|---|
| 398 | 210 CONTINUE |
|---|
| 399 | C |
|---|
| 400 | C |
|---|
| 401 | C* 3. Deallocation and end of routine |
|---|
| 402 | C ------------------------------- |
|---|
| 403 | C |
|---|
| 404 | DEALLOCATE(zbocoef) |
|---|
| 405 | DEALLOCATE(iaddr) |
|---|
| 406 | DEALLOCATE(isize) |
|---|
| 407 | DEALLOCATE(iflag) |
|---|
| 408 | DEALLOCATE(clbofld) |
|---|
| 409 | |
|---|
| 410 | IF (nlogprt .GE. 1) THEN |
|---|
| 411 | WRITE (UNIT = nulou,FMT = *) ' ' |
|---|
| 412 | WRITE (UNIT = nulou,FMT = *) |
|---|
| 413 | $ ' --------- End of routine interp ---------' |
|---|
| 414 | CALL FLUSH (nulou) |
|---|
| 415 | ENDIF |
|---|
| 416 | RETURN |
|---|
| 417 | END |
|---|
