From 0749708b6ffe33b5c1ebc75a178894e6c23bd512 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Tue, 16 Apr 2019 20:01:29 +0000 Subject: [PATCH] Vlab issue #40471. Add new parallel version of chgres based on ESMF regridding. Contains the same surface pressure adjustment, vertical interpolation and surface initialization as the serial version of chgres. Can ingest tiled FV3 data, FV3 nemsio data, GFS nemsio data, GFS sigio/sfcio data. Squashed commit of the following: commit c656e6279e2c5d715f3403f47a8be3398e3932a7 Merge: b400492 04f0e75 Author: George Gayno Date: Tue Apr 16 19:57:42 2019 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit b400492d4910154a60e73d681b920956502b6a2e Author: George Gayno Date: Tue Apr 16 19:56:51 2019 +0000 chgres_cube branch: This commit references #40471. Move chgres_cube program to the sorc directory under chgres_cube.fd. Change-Id: I49f02aca17e79d262fd353f66293f3ebe4644b8b commit cc1c409c2aae9347546e15e1b40b0af1ed6ab61f Author: George Gayno Date: Wed Apr 3 13:30:46 2019 +0000 chgres_cube branch: This commit references #40471. Add threads to routine VINTG. Add OMP_STACKSIZE variable to Cray run script. Change-Id: Ibb3d10256d367c7a4520b0feeeba0e9d1a207141 commit 8fe3c48409c437be71f4fb4bd87e0b09f70c53b5 Author: George Gayno Date: Tue Apr 2 17:37:18 2019 +0000 chgres_cube branch: This commit references #40471. Fix bug in search routine by checking original field (stored in field_save) instead of the adjusted field. Add sea ice default logic from original serial version of chgres. Both updates change results. Add threading to search routine. Change-Id: I46278241828a9020851530594d75e3362712353f commit 0ba7dcff2c14128a0792c30a5585a3d5da0754f5 Author: George Gayno Date: Thu Mar 7 18:42:25 2019 +0000 chgres_cube branch: This commit references #40471. Update Theia config files and run scripts for new paths. Change-Id: Ic244b4eabff9ac5c4ebe6e23f6e7845af65799e2 commit ccc1c1e541d27c4334f57ce731c92009b25fefb3 Author: George Gayno Date: Thu Mar 7 18:35:05 2019 +0000 chgres_cube branch: This commit references #40471. Add new Theia config file for running with spectral gfs sigio/sfcio files. Change-Id: Ice67f73de40b82943ed6469f7a4f7f7477d669ff commit 614113255549be1c9abfc6acc5e8e0cb04dd1201 Author: George Gayno Date: Thu Mar 7 14:40:12 2019 +0000 chgres_cube branch: This commit references #40471. Updates for compiling and running on Cray. Remove compilation option for WCOSS phase 1/2. Machine will be retired this year. Change-Id: I7a9d2c0e5c6e6b63908798eda829c443f80c1648 commit 3e02203853376d1f0504ad618934b8c0adebc660 Author: George Gayno Date: Wed Mar 6 21:31:08 2019 +0000 chgres_cube branch: This commit references #40471. Update paths in Dell config files. Change-Id: I6b82400ec53cdce2602c08a59059848b9adc8dd4 commit 595919780c34ae1f0798b62131be37cab26204ea Author: George Gayno Date: Wed Mar 6 16:33:01 2019 +0000 chgres_cube branch: This commit references #40471. Numerous updates so program can ingest/process spectral gfs data in the 'old' sigio/sfcio format. Correct units error when reading snow depth from fv3 tiled warm restart files and fv3 tiled history files. Program expects snow depth in millimeters. Change-Id: I332468857c20e48c645b038469db3848fafd3a37 commit 778af6b5eae7c728dd4598736bf88ac43f98cddd Author: George Gayno Date: Wed Feb 20 13:26:21 2019 +0000 Revert "chgres_cube for warm restart" This reverts commit 00c978c1c119850ec7de6d4dcc3426567717ecea. commit 2f920bd440216524adc211b1850784b6ab0293ee Merge: 257f8aa 00c978c Author: Scott Date: Tue Feb 19 20:51:52 2019 +0000 Merge branch 'chgres_cube_warm_restart' into chgres_cube commit 00c978c1c119850ec7de6d4dcc3426567717ecea Author: Scott Date: Tue Feb 19 20:49:39 2019 +0000 chgres_cube for warm restart commit 257f8aa7e6386f860db5d74697fbd9daf0e2e67f Author: George Gayno Date: Wed Feb 13 15:56:14 2019 +0000 chgres_cube branch: This commit references #40471. When using fv3 global gaussian nemsio files, convert snow depth to millimeters and roughness length to centimeters to be consistent with the fv3 tiled history and restart files. Change-Id: I721f8fd38f0dbe528883af1cd3d62808345930d0 commit d8256f42759b509a05e685cb81dfdba73eb0d939 Author: George Gayno Date: Wed Feb 13 15:09:58 2019 +0000 chgres_cube branch: This commit references #40471. New option to process spectral gfs gaussian nemsio files. Change-Id: Ie387df4daa40c770d6adbd2fcc46e8ada3889d49 commit 65e5949113e79c9c875ffcce3d9b8e6f3038dc26 Author: George Gayno Date: Mon Feb 11 18:51:47 2019 +0000 chgres_cube branch: This commit references #40471. Add script for running on Theia using slurm. Change-Id: I66ed45f8389cd4887db763317186c773aaba95e4 commit 448d6bd1b9378bfd9d01e59db6df38913d1ab1c9 Author: George Gayno Date: Fri Feb 8 20:02:43 2019 +0000 chgres_cube branch: This commit references #40471. static_data.F90 - Updates for new gridgen_sfc file naming convention. Change-Id: I386f9a0f7ae2bc443634420b64abd8a7017d1b27 commit 0d76a9d7c1c3dfda78c5e4269407dab08a0ec697 Merge: ba27618 cc32f99 Author: George Gayno Date: Fri Jan 25 19:15:35 2019 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit ba276186b9113cb0e3adbe71475300c4c1738d9a Author: George Gayno Date: Fri Nov 16 22:08:02 2018 +0000 chgres_cube branch: This commit references #40471. Update theia config files for tracers. Change-Id: Ibcafbc82dc4c6fff58b56cfa163d101abd66cdb5 commit bc7b201febc3613f0c4e5c394f54117147b0f768 Author: George Gayno Date: Fri Nov 16 21:14:25 2018 +0000 chgres_cube branch: This commit references #40471. Update Dell config files to include tracers. Change-Id: Ie30bb81dd10811e16d39e9e919b1c32590e20b8e commit 3375b682269240d05ede7c568d12ac5e13d2d4a3 Author: George Gayno Date: Fri Nov 16 19:39:47 2018 +0000 chgres_cube branch: This commit references #40471. Add namelist option for users to select which tracers to process. Update cray config files accordingly. Change-Id: Ibeffdb44ab550ab3f5514bca2153a35bb5dc9051 commit d9d4408e4949871de57a4b956312b55c64c1afd7 Author: George Gayno Date: Fri Nov 16 18:10:56 2018 +0000 chgres_cube branch: This commit references #40471. Numerous updates so the program can process a user-selected set of tracers at run time. Change-Id: I8679b5a327f457fb745927dfc7ca11926a2258ce commit 9b9c92d87aec005c23d22a1b416cf86d3bd9d297 Author: George Gayno Date: Tue Oct 30 17:43:16 2018 +0000 chgres_cube branch: This commit references #40471. Minor fix to two error messages. Change-Id: I423986d9ab7f62c4da79850d3352c5f0b2190fb2 commit 0b889ad6328ef0beb7a83feb57563e8e9856b895 Author: George Gayno Date: Tue Oct 30 12:26:30 2018 +0000 chgres_cube branch: This commit references #40471. Remove hardwired atm/surface files names in routine "define_input_grid_gaussian". Improve error handling in that routine. Change-Id: I18d894792a44ae4b101891d7155a397b8f5959cd commit 092bc27ffdd37562ccd91372cfaff91c79f5794a Author: George Gayno Date: Thu Oct 25 15:00:19 2018 +0000 chgres_cube branch: This commit references #40471. Horizontally interpolate surface pressure assuming a standard lapse rate (per recommentation of Phil Pegion). This reduces model initialization shock near steep terrain. Change-Id: I9748acde579605a76fc387124c11c31c7dfa4474 commit eebdf594c1792330fde03239d068accd72576df6 Author: George Gayno Date: Tue Oct 9 20:16:20 2018 +0000 chgres_cube branch: This commit references #40471. Standardize error handling. Change-Id: I861798e99b3d1c7c116e184dc04e3fc782de8347 commit d07ec3468703143b6ca1880cec8b9d78dfe34dba Author: George Gayno Date: Fri Oct 5 17:14:15 2018 +0000 chgres_cube branch: This commit references #40471. Add a basic prolog to the top of each module. Change-Id: I47741d78197c2f8f8153ef6256235bae896981b6 commit 780029c6a6d0d3ec628e6d85cceb480840b2968b Author: George Gayno Date: Thu Oct 4 16:33:46 2018 +0000 chgres_cube branch: This commit references #40471. Cleanup of variable declarations. General cleanup. Change-Id: I978c4d6162aa1eaad7efd8523518bc05f394e690 commit 9dbeb5a4bf20d7580717b41bf17d875ff27dd18c Author: George Gayno Date: Wed Oct 3 13:48:42 2018 +0000 chgres_cube branch: This commit references #40471. Add global attribute to atmospheric and boundary files that specifies which input data source was used. Update theia config files to explictly define all input source files. Change-Id: Ifdcc176db26c7070a1ff550d2aed78b2fdde096e commit 9626a74d9dfe55a9df514eff83121a028963df3f Author: George Gayno Date: Tue Oct 2 18:11:48 2018 +0000 chgres_cube branch: This commit references #40471. Remove hard-wired sfc/nsst input file names. Update config files for cray accordingly. Change-Id: I5bbac6304f375635d9e5ff5620a883917c06eb5c commit bfd4c4e4e04aa19b5d6eb1a163231def60c26e65 Author: George Gayno Date: Tue Oct 2 16:56:03 2018 +0000 chgres_cube branch: This commit references #40471. Remove hard-wired input grid atmospheric file names. Update Dell config files accordingly. Change-Id: I6f6cbec751acea32d516e0a67f4dafe97cd99c2c commit 1727ae775e2da4c3de1a1fff2a453dcd30e4273d Author: George Gayno Date: Fri Sep 28 19:28:52 2018 +0000 chgres_cube branch: This commit references #40471. Add comments to input_data.F90 Change-Id: Ic22435948bcdca68840aad989c3b942948880525 commit 3eb8afaf720af694793e3fb25eb062afb7da6017 Author: George Gayno Date: Fri Sep 28 13:57:20 2018 +0000 chgres_cube branch: This commit referenes #40471. Updates for compiling and running on Cray. Point to beta v8.0.0 of the esmf library. Change-Id: I2ec308278481c9fa9758af3db8d7ef031b779644 commit 58e0e214e4be5d8d40a3cc6a3e813fe80f8f4aeb Author: George Gayno Date: Thu Sep 27 19:45:32 2018 +0000 chgres_cube branch: This commit references #40471. Updates for compiling on Dell using a local copy of beta v8.0.0 of esmf. Change-Id: I21c367827f5a8788db8de635ea283f536a3fbdd0 commit 0631e3830b65854229fac8dccc148b13279cbac8 Author: George Gayno Date: Thu Sep 27 15:06:19 2018 +0000 chgres_cube branch: This commit references #40471. Update Theia build to use esmf beta v8.0.0. That version corrects a problem with FieldScatter and FieldGather for large array sizes (such as 3-d t1534 fields). Add extrapolation method NEAREST_STOD to the atmospheric call to RegridStore. That eliminates problems with unmapped points encountered for certain grid configurations (Ex: T1543 gaussian to C1152). New routine "read_input_atm_gaussian_file" for reading fv3gfs gaussian history files in nemsio format. Remove obsolete namelist entries from all run config files. Change-Id: Ibf12ec0102e621cf94761548075f982d765c5f6e commit 07160a501362413ca83698bedcba97c6e9a642bd Author: George Gayno Date: Tue Sep 25 17:33:24 2018 +0000 chgres_cube branch: This commit references #40471. Replace logical 'restart_file' - which determined whether the program was to ingest tiled history or restart files - with 'input_type'. The latter is set as 'history'/'restart'/'gaussian' for tiled history/tiled restart/gaussian history files. Add routine (read_input_nst_gausian_file) to read nst data from gaussian history file to input_data.F90. Change-Id: I577ba3f319d2c0ea1d99598cf55cc8147bcadb97 commit 7cf64d52594e8e30338cd1f8bae424b81289125a Author: George Gayno Date: Mon Sep 24 13:32:47 2018 +0000 chgres_cube branch: This commit references #40471. Updates for running on Cray. Change-Id: Ib4e42021fd31619c4d60064cf0320cfdbd587414 commit 68be11f25c06eab4eb70f0573bddb67a8601b0fa Author: George Gayno Date: Mon Sep 24 12:40:57 2018 +0000 chgres_cube branch: This commit references #40471. Move read of terrain from model_grid.F90 to input_data.F90. This allows the program to use the terrain from the atmospheric files when processing the atmospheric fields. This terrain should be more consistent with the atm fields than what is in the orog files. This change will also improve flexibility as the number of input data sources increases. For example, the gaussian data has no orog files, so terrain must be read in from the restart files. Change-Id: Iff532b85096ec48afd3ca7e1658ab66c86737dc5 commit a3c5fc0edabe9d02ce3b69d22c136bb71ca44e0f Author: George Gayno Date: Fri Sep 21 13:23:31 2018 +0000 chgres_cube branch: This commit references #40471. input_data.F90 - Place 2-d to 3-d wind conversion in its own routine. Change-Id: Iad7c8460fbcbc9e9d4cbbd2c5529331c9604ebda commit d8b8c675e1e9ab386eb7cc5058e2f7e6f368304b Author: George Gayno Date: Fri Sep 21 12:16:01 2018 +0000 chgres_cube branch: This commit references #40471. Change variable name 'levp_input' to 'levp1_input'. Change-Id: Iaa91b691d8747b6906ecd10ddb0f61d40855d5e7 commit d9382ae01c4b0289047c6390a1c234d6ef8fb7e1 Author: George Gayno Date: Tue Sep 18 17:51:43 2018 +0000 chgres_cube branch: This commit references #40471. Logic to process surface fields from an fv3 gaussian nemsio file. Change-Id: I486960805c2c8dd4020438aba11ed8504fac3739 commit 253834853c3c5e0e76257c9402135bfe0de64c9f Author: George Gayno Date: Fri Sep 14 19:31:02 2018 +0000 chgres_cube branch: This commit references #40471. Add some logic to ingest fv3gfs gaussian nemsio files. Currently, only tiled netcdf files may be ingested. Change-Id: Ibc8606fcb63f9c955e636e0200bc8b634155b559 commit 754e2f8161b60a0b7c8bea1f3c58a07afbbcc65d Author: George Gayno Date: Fri Sep 7 20:40:48 2018 +0000 chgres_cube branch: This commit references #40471. Add script and sample configuration files for running on Dell. Change-Id: I6999f9a9ad43b4d62d72e181c431e85dbd48899c commit fa7d51a9795f0e85ece97655434233b2f3433ac0 Author: George Gayno Date: Fri Sep 7 14:48:24 2018 +0000 chgres_cube branch: This commit references #40471. Update regional boundary condition logic to include a blending halo located within the computational grid. Halo indices are now defined with respect to the computation grid instead of the whole grid (computational plus lateral halo). Change-Id: I4429659172403c135c16df530e592a80e7912eab commit 94d1f288ab2994f851862338e06625c96aaa915a Author: George Gayno Date: Tue Sep 4 13:48:36 2018 +0000 chgres_cube branch: This commit references #40471. Update atmospheric write routine to write each tile on its own mpi task. Previously, all tiles were written sequentially on task 0. Change-Id: Ica45f3320970c105f2cda42f1becd83a311f784e commit d18199b2bd07a22976fd04181cda179990a5bebd Author: George Gayno Date: Fri Aug 31 18:42:02 2018 +0000 chgres_cube branch: This commit references #40471. Remove all 'goto' statements. Change-Id: I3a66a5254df2d3e5f3cb6bf12f44d96ead3b9f96 commit 17863752b96a772ee5cd6bfd9c96b904a77f95f5 Author: George Gayno Date: Fri Aug 31 14:40:24 2018 +0000 chgres_cube branch: This commit references #40471. Read input history file tiles in parallel instead of sequentially. Change-Id: Ifa29876014fe516249c788d3f2f81f543ffda171 commit 9cba10d151de587b6b63644f77bf74b073cb16c8 Author: George Gayno Date: Thu Aug 30 20:22:06 2018 +0000 chgres_cube branch: This commit references #40471. Update routine "read_input_atm_restart_data" to read each tile on its own mpi task (or pet). Previously, each file was read sequentially on task 0. Tests on theia showed results do not change, and wall clock time is reduced. Change-Id: I30899db560be58586871dc886283f0766957bef3 commit 4a59accf411686b26128d93e34ad63d9892facff Author: George Gayno Date: Wed Aug 29 20:06:44 2018 +0000 chgres_cube branch: This commit references #40471. Add config files for running the following transforms on Theia: (1) C768 L64 to C768 L91; (2) C768 L64 to C1152 L91 Both transforms ran sucessfully. Remove some diagnostic print. Change-Id: I698d92a016010ad9bc01171ecfe015802275b2ee commit fd3736a88cf1913ce6f9896f734be819f354d9f3 Author: George Gayno Date: Wed Aug 15 15:27:16 2018 +0000 chgres_cube branch: This commit references #40471. Add option to read in a weight file for part of the atmospheric interpolation. If weight file not available, then FieldRegridStore is called as before. Using weight file reduces wall clock time slightly and does not change results. Change-Id: I956bb094315f723840c62a7ee3dd2faeadba70c1 commit f3bb2e3ed2d77e53c6da98c6241c62491316d88f Author: George Gayno Date: Tue Aug 14 18:39:15 2018 +0000 chgres_cube branch: This commit references #40471. Remove extra calls to FieldRegridStore. Results do not change. Wall clock time reduced slightly. Change-Id: Icc93054d844752c5299bdc64c4c117c291b86a09 commit fbb566f9143d1b3a686f351d95352d1de4a9489e Author: George Gayno Date: Mon Aug 6 20:28:20 2018 +0000 chgres_cube branch: This commit references #40471. Remove subroutine 'flip' and replace with F90 statements to reverse arrays in 'z' direction . The latter is much faster. Change-Id: I1a405cc48c7e1981c908e64c77e0d65e0e875caa commit 963246d6061c4dd49001cc226e9df082931b5037 Author: George Gayno Date: Fri Aug 3 20:12:02 2018 +0000 chgres_cube branch: This commit references #40471. Add two new tests for Theia. Change-Id: I2fbb5a33ca236bf289eb643b0d361b1fe46b3419 commit 339b732caad6aa3c19fc0c533799d90978b3b16c Author: George Gayno Date: Fri Jun 22 19:20:19 2018 +0000 chgres_cube branch: This commit references #40471. Update 'make.sh' to build on WCOSS Phase 1/2. Change-Id: I9f6e0fd0154c2874be61af85a8e6b16946f70704 commit cbbb9644a5ef56acecd2cfc03e805414e5e67035 Author: George Gayno Date: Wed Jun 20 20:14:32 2018 +0000 chgres_cube branch: This commit references #40471. Add 3-d temperature and delta-p to target grid atmospheric netcdf file. Change-Id: I505df46a097c772b2cb0c792e18a0db66f9d0d20 commit dcaaba32b355e93720331fe5c0a3ee17d2c64d60 Merge: d868f97 eb1a299 Author: George Gayno Date: Fri Jun 15 13:36:09 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit d868f9737108d583451971bd7f7ac66d9792244a Author: George Gayno Date: Fri Jun 15 13:32:07 2018 +0000 chgres_cube branch: This commit references #40471. When ingesting 'restart' files, get model top pressure from the "fv_core.res.nc" file. Change-Id: Ib9856ceb7743ce8c9be6692128e4616c1c7d4e76 commit bce294fc9b507cdaacdda89af652fda786746d49 Author: George Gayno Date: Thu Jun 14 17:59:41 2018 +0000 chgres_cube branch: This commit references #40471. New namelist variable 'restart_file' to control whether input files are 'restart' or 'history' files. Change-Id: I969651711fa83c038574093447a7b8d4c05c41ba commit 73ddc22b528362edc7b5f5a05de94301bc00e9ba Author: George Gayno Date: Wed Jun 13 21:27:21 2018 +0000 chgres_cube branch: This commit references #40471. Add logic to process GFDL microphysics tracers. Change-Id: Iad9e15cc6477ecfc01120400826c0cf6e660a1ce commit 2a82e038a21fc6de82189362133d92a329ad101f Author: George Date: Mon Jun 11 19:09:45 2018 +0000 chgres_cube branch: This commit references #40471. Update "make.sh" for building on Dell. Change-Id: Iba4915467e315ebc83d4fed7e838391681a84a5f commit 9f9d9531ae37ca81608892b50d390d5c3513ce1d Author: George Date: Fri Jun 8 20:22:51 2018 +0000 chgres_cube branch: This commit references #40471. Preliminary modifications to read input atmospheric fields from 'restart' files. Currently, program only ingests atmospheric 'history' files. Change-Id: Iac0d3cf7672d108653ddb9da620b8cf68b361877 commit 94658f59fbb7d9d21bf773d1f8cd0a71dc485e92 Author: George Date: Thu Jun 7 20:57:44 2018 +0000 chgres_cube branch: This commit references #40471. Update to ingest tiled "restart" surface files. Previously, only tiled "history" files could be ingested. 1) New routine to read tiled restart surface files - "read_input_sfc_restart_data" 2) Rename existing read routine to "read_input_sfc_history_data". 3) Add logic to determine if surface file is a 'restart' or 'history' file. Logic checks for 'xaxis_1' in the header. If it exists, a 'restart' file is assumed. Change-Id: I0ab138d165d7f2646440acc07ee5691c726a1e85 commit 822ccffc37ee4f81398ebfdcfbbad8e39d946149 Author: George Gayno Date: Mon May 21 18:09:17 2018 +0000 chgres_cube branch: This commit references #40471. New routine "write_fv3_atm_bndy_data_netcdf" that outputs an atmospheric lateral boundary file. Supports stand-alone regional grids. Change-Id: Ic6a63a4d915ba7fd870e9c151ff274f90df0a059 commit d11d7cd2d534a3ea2756928a00423d7ca5c68236 Author: George Date: Wed May 16 20:47:04 2018 +0000 chgres_cube branch: This commit references #40471. Add "extrapMethod" argument to atmospheric regridding. This prevents a random glitch when interpolating winds from the center of the grid box to the box edges. Add halo removal logic for atmospheric file. Fix bug in halo removal logic for surface file. Change-Id: Idbee39ded541db7cb11dadc4b488759a736ce7b4 commit 325b729346b4303d2c2d142d6685ae5cb2e5b167 Merge: 3e46722 cebba5c Author: George Date: Fri May 11 14:21:49 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit 3e467223e7ce3d23b3e0a8a8f47d5e233fa3c69a Merge: 00921a5 ac03c87 Author: George Gayno Date: Thu May 3 19:55:50 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit 00921a50e7c7dffe3bc0194e1a9b93fcbf87cde5 Author: George Gayno Date: Mon Apr 30 17:33:17 2018 +0000 chgres_cube branch: This commit references #40471. Update to use v7.1 of ESMF instead of a beta snapshot. modified: chgres_cube/sorc/make.sh Change-Id: I0fc15198c3abb2c28ee758df8dc37bd3c008924c commit 930b87fd892009906db444e44fefd602248d883e Author: George Gayno Date: Tue Apr 24 13:55:34 2018 +0000 chgres_cube branch: This commit references #40471. New routine "write_fv3_atm_header_netcdf" to write the "gfs_ctrl.nc" header file, which contains tracer and vcoord information. Modify to read input surface data from tiled model history files. Change-Id: I39f0d573c2cae3b17f4758973d7bf002dcd7afbf commit 937997b65ee77b09ac69151db9388f0c107d38b7 Merge: ca61546 0e9d2d1 Author: George Gayno Date: Fri Apr 20 17:36:18 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit ca61546139daa5e51a409fa6a538503c10dd5742 Author: George Gayno Date: Fri Apr 13 13:32:40 2018 +0000 chgres_cube branch: This commit references #40471. New routine 'vintg' for vertically interpolating between the input and target hyb-sigma levels. This routine is taken from the GFS CHGRES code, which assumes the lowest model level in index '1'. This is opposite the fv3 convention. Therefore, add a vertical 'flip' of the fv3 data after the read and before the write of the atmospheric files. New routine 'compute_zh' to compute heights. To save memory, reduce the number of 3-d arrays during write of atmospheric file. Change-Id: Ia256b6d348d277119ab1e23da6d00f3653dd8eeb commit 6c95bf7246b74edef319814a13f3667b1cdcb6d7 Author: George Date: Mon Apr 9 20:52:51 2018 +0000 chgres_cube branch: This commit references #40471. New routine 'newpr1' which computes 3-d pressure based on 'ak' and 'bk'. Add esmf fields to hold data on target grid before vertical interpolation (denoted by 'b4adj' in the variable name). Change-Id: Ic9c9175f268f124c0d63498a9e771fe679456782 commit 4c5b40a11daf499c55f9000224c08dc3589d7d98 Merge: ebee537 6482117 Author: George Date: Mon Apr 9 17:36:57 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube. commit ebee53765fe252dec7517d332771ef7a847670cf Author: George Date: Mon Apr 9 17:22:27 2018 +0000 chgres_cube branch: This commit references #40471. Several updates to the atmospheric data processing: 1) Add horizontal interpolation of 3-d temperature. 2) Read input data from the tiled model history files instead of the coldstart files from CHGRES. These files store the winds unstaggered (at the center of the grid box). 3) Add read of target grid 'vcoord' file. 4) New routine 'newps' to adjust surface pressure to new terrain. Change-Id: I653dbc741f785b42ce6fba51333530dd873bd9ef commit 181f712adb0310f098b1f2c1ce2d6b870fd81a0b Author: George Date: Wed Apr 4 14:02:30 2018 +0000 chgres_cube branch: This commit references #40471. Add read of vertical coordinate file to get 'ak' and 'bk' for the target grid. Change-Id: I3ba9fbc8e5205e3c5ef6a04da955d52094197ce9 commit 25c8b572cd74aae0d826ed805ce75b47acad95e8 Merge: 7e00515 7b3afc8 Author: George Date: Tue Apr 3 12:16:15 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit 7e00515e2e1069d491f359c1eee9a63f84000732 Merge: c2ff052 8725547 Author: George Date: Tue Mar 27 19:48:54 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit c2ff0525532b1ed078c4e6bb258dd46f85e40ff6 Merge: 8fd71e9 0c7e545 Author: George Gayno Date: Thu Mar 22 14:20:13 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit 8fd71e907923b2df457d8cb80550e4a0ced1ea2d Author: George Gayno Date: Tue Mar 20 18:50:13 2018 +0000 chgres_cube branch: This commit references #40471. Update theia build to point to official esmf version 7.1.0. Add "module use" statement for locating NCEPLIBS. Change-Id: If06900baa3c70b9713a3d15b25d2a89fd569d5a8 commit 5a61108655e8f253fe1cddabc3cc9dd92f2fcf04 Merge: f944749 7fdcd04 Author: George Date: Mon Mar 19 18:18:58 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit f944749861cc6ecfcb8439c38525f42184d2eda1 Merge: a47764d 3169078 Author: George Gayno Date: Mon Mar 5 13:45:28 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit a47764d197d896b3aced87a390571ac7b9e3bb9a Merge: 944f618 ecf67b6 Author: George Gayno Date: Thu Feb 22 18:24:50 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit 944f6180e7500e6238685e8ae51d4d1a68c9f919 Merge: 73c0c43 03b9b56 Author: George Date: Tue Feb 20 13:56:03 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit 73c0c436bd431dd2b7bb88e87046d42e69bb1d80 Merge: f697860 6b2de36 Author: George Date: Mon Feb 12 13:36:35 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit f697860ab83ff8bcec2383dbe8d4cee86de1b84c Author: George Gayno Date: Thu Feb 8 21:46:24 2018 +0000 chgres_cube branch: This commit references #40471. Minor script changes related to recent master merge. Change-Id: Ibd0d61e3d7da3be6675195d0d8c3b4def38f70d4 commit 5024394887414c4f65e6921419ac8e1550108be7 Merge: 72778cb 2b9a059 Author: George Gayno Date: Thu Feb 8 21:33:29 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube Change-Id: Iadb058b872c1d578acf9895a1321923a8bd71c73 commit 72778cb00dac9f97cfdb5a6085025c80cccaee91 Author: George Gayno Date: Mon Jan 29 19:32:42 2018 +0000 chgres_cube branch: This commit references #40471. To ensure bit identical results for varying task counts, the following modifications were done: (1) The argument "isrctermprocessing=1" was added to all calls to ESMF_FieldRegridStore; (2) The argument "termorderflag=ESMF_TERMORDER_SRCSEQ" was added to all calls to ESMF_FieldRegrid. Change-Id: I354cbd94b5c9e63a8e5635dfb2a2a32fe91426e3 commit e263d0e6d5fce3f24cd0f15ae849be412fff161f Author: George Gayno Date: Mon Jan 8 21:04:00 2018 +0000 chgres_cube branch: This commit references #40471. Move all interpolations of surface fields into their own routine ("interp"). Change-Id: I1c1ffd972566092e17f9850bbfdfce2b3965abe2 commit 574bb6f72998099b7aacc8a15220de2637ba727b Author: George Gayno Date: Mon Jan 8 19:33:52 2018 +0000 chgres_cube branch: This commit references #40471. Move processing of nst fields to surface.F90 to ensure consistency between TREF and SST. This was a problem with the OPS version of CHGRES (see issue #44638.). Remove now obsolete routine nst.F90. Change-Id: Ifb7bf631ef75cdf2af8eb0ff3f77e236996224db commit bdb63dd83f7bf23fe198650fc84cc631428d7d6f Author: George Gayno Date: Thu Jan 4 19:46:18 2018 +0000 chgres_cube branch: This commit references #40471. Change default value of SST to be the same latitudinal dependent guess as that used for TREF. Change-Id: If2d0f1f13d4f7bb318c11003eb062c53609f1d92 commit 735e35ba6efcafe94db47540416b64578d13bb97 Author: George Gayno Date: Thu Jan 4 14:38:19 2018 +0000 chgres_cube branch: This commit references #40471. Simplify driver. General cleanup. Change-Id: I1b227f5f909ec42e4a2a664ccd324df0a2a19da8 commit 8f7e672cdcd40795afa721dbd7f6347ac876ab1f Merge: 9743273 3073c50 Author: George Gayno Date: Wed Jan 3 17:29:16 2018 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit 9743273c09dfb4b4d8931fb0583198d57274dd23 Author: George Gayno Date: Wed Jan 3 17:18:43 2018 +0000 chgres_cube branch: This commit references issue #40471. Add interpolation of u/v winds (on the staggered grid). The method is based on the vector interpolation in the model's write component (by Jun Wang): (1) convert from 2-d cartesian components to 3-d. (2) Horizontally interpolate the 3-d components to the target grid. (3) Convert from the 3-d components back to 2-d. Change-Id: If5110c8c20db8c5ad110f74a9f219e97799705f8 commit 1d90bf06dde893c5f28873fb016f874dc9dfc7e0 Merge: 04e2f1e 7bf492a Author: George Gayno Date: Thu Dec 21 19:16:33 2017 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit 04e2f1ec01dd032fd60893d54ba280759737521f Author: George Gayno Date: Thu Dec 21 19:12:01 2017 +0000 chgres_cube branch: This commit references #40471. Add read of latitude and longitude at the 's' edge and store as ESMF fields. Lat/lon is required to interpolate the staggered winds. Change-Id: I1f5d2a26522547a8887942b386175f65c6de9767 commit df04cc2fa792e0ed0b271e4bd395a400d80f3993 Author: George Gayno Date: Wed Dec 20 20:19:32 2017 +0000 chgres_cube branch: This commit references #40471. Rename routine "get_model_mask" to "get_model_mask_terrain" and remove read of lat/lons from the orography file. New routine "get_model_latlons" to read lat/lon from the 'grid' files. The 'grid' files have lat/lon on the staggered grid, which will be needed when interpolating winds. The orography files only have lat/lon on the 'A' grid. Change-Id: If291bb2f0b1e2294b52e7775347f756cdf68c6c5 commit e76e7f236a520428e35c2d9f79b18dea2fd45fe5 Author: George Gayno Date: Wed Dec 20 14:55:19 2017 +0000 chgres_cube branch: This commit references #40471. Switch from ESMF 7.1.0bs39 to 7.1.0bs44 (Theia). Latest version corrects bug in GridCreateMosaic for stand-alone nests. Change-Id: I50b271be7fbfabc14a51f4cc848308c3d8143d70 commit 56de1e7b5c857da69a63fe9473f6e3a4f01e35a4 Author: George Gayno Date: Fri Dec 15 18:41:50 2017 +0000 chgres_cube branch: This commit references #40471. Replace all remaining F77 netcdf functions with their F90 counterparts. Change-Id: Ieaea4b5485079b44d3c49e49556b2e2eba56b7f6 commit 23ece3b7d201be3c017d890576bc65c452e5810a Author: George Gayno Date: Fri Dec 15 16:02:32 2017 +0000 chgres_cube branch: This commit references #40471. Point (on Theia) to an updated ESMF v7.1.0bs39 library (was recompiled with -precise flag). Update read/write of atmospheric fields to use F90 versions of NetCDF functions. Change-Id: Iccd7b96a91b7d4d498847d00fec7679420852f87 commit 0eb38c145d8935b644ac014e65432a8e93f0f4fc Author: George Gayno Date: Thu Dec 14 21:43:47 2017 +0000 chgres_cube branch: This commit references #40471. Update Cray build to use ESFM v7.1.0bs39. Change-Id: I5cc221fb2be80ddfc4e55cae183b64f671b97553 commit 7f6369774f00955df5543c8a61212f59a52c0373 Author: George Gayno Date: Thu Dec 14 21:16:02 2017 +0000 chgres_cube branch: This commit references #40471. Update ESMF error handling per Gerhard's suggestion. Change-Id: I29b882c178f6595f8d371d6bddb8b080a00f88d7 commit bb2bccc4832080366bf49d67a1dbaa63881bf189 Author: George Gayno Date: Wed Dec 13 21:00:39 2017 +0000 chgres_cube branch: This commit references #40471. Update to use v7.1.0bs39 of the ESMF library, which is only available on Theia currently. Change-Id: I4be45d0dc3e5c9646c6ff52d57b27639665c4b93 commit 1976a12346150a8a6093105089820637f4f5037c Merge: e362248 8585699 Author: George Gayno Date: Wed Dec 13 17:23:00 2017 +0000 chgres_cube branch: This commit references #40471. Merge branch 'master' into chgres_cube commit e362248b338582f8c6f75e8ffacf328738a0a30c Author: George Gayno Date: Mon Nov 6 15:16:09 2017 +0000 This commit references #40471 Initial commit of the CHGRES cube-to_cube program to the chgres_cube branch. This initial version only processes surface and NSST fields. There are some hooks for processing the atmospheric fields. Change-Id: I33fa9e96637817dbe36e180e98b3b0c5e55b6945 --- sorc/chgres_cube.fd/.gitignore | 3 + .../run/config.C1152.l91.atm.theia.nml | 26 + .../run/config.C1152.l91.dell.nml | 25 + .../chgres_cube.fd/run/config.C1152.theia.nml | 17 + sorc/chgres_cube.fd/run/config.C384.cray.nml | 17 + sorc/chgres_cube.fd/run/config.C384.dell.nml | 24 + .../run/config.C384.gaussian.dell.nml | 24 + sorc/chgres_cube.fd/run/config.C384.theia.nml | 17 + sorc/chgres_cube.fd/run/config.C48.cray.nml | 21 + sorc/chgres_cube.fd/run/config.C48.dell.nml | 21 + .../run/config.C48.gaussian.theia.nml | 22 + .../run/config.C48.gfs.gaussian.theia.nml | 23 + .../run/config.C48.gfs.spectral.dell.nml | 23 + .../run/config.C48.gfs.spectral.theia.nml | 23 + sorc/chgres_cube.fd/run/config.C48.theia.nml | 23 + .../run/config.C768.atm.theia.nml | 26 + .../run/config.C768.l91.atm.theia.nml | 26 + .../run/config.C768.l91.dell.nml | 25 + .../run/config.C768.nest.atm.theia.nml | 24 + .../run/config.C768.nest.cray.nml | 18 + .../run/config.C768.nest.theia.nml | 18 + .../run/config.C768.stretch.cray.nml | 17 + .../run/config.C768.stretch.theia.nml | 17 + sorc/chgres_cube.fd/run/run.cray.sh | 36 + sorc/chgres_cube.fd/run/run.dell.sh | 48 + sorc/chgres_cube.fd/run/run.slurm.ksh | 60 + sorc/chgres_cube.fd/run/run.theia.ksh | 53 + sorc/chgres_cube.fd/sorc/atmosphere.F90 | 1787 +++++++ sorc/chgres_cube.fd/sorc/chgres.F90 | 101 + sorc/chgres_cube.fd/sorc/input_data.F90 | 4486 +++++++++++++++++ sorc/chgres_cube.fd/sorc/make.sh | 106 + sorc/chgres_cube.fd/sorc/makefile | 53 + sorc/chgres_cube.fd/sorc/model_grid.F90 | 1086 ++++ sorc/chgres_cube.fd/sorc/program_setup.f90 | 443 ++ sorc/chgres_cube.fd/sorc/search_util.f90 | 191 + sorc/chgres_cube.fd/sorc/static_data.F90 | 528 ++ sorc/chgres_cube.fd/sorc/surface.F90 | 3580 +++++++++++++ sorc/chgres_cube.fd/sorc/utils.f90 | 34 + sorc/chgres_cube.fd/sorc/write_data.F90 | 2602 ++++++++++ 39 files changed, 15674 insertions(+) create mode 100644 sorc/chgres_cube.fd/.gitignore create mode 100644 sorc/chgres_cube.fd/run/config.C1152.l91.atm.theia.nml create mode 100644 sorc/chgres_cube.fd/run/config.C1152.l91.dell.nml create mode 100644 sorc/chgres_cube.fd/run/config.C1152.theia.nml create mode 100644 sorc/chgres_cube.fd/run/config.C384.cray.nml create mode 100644 sorc/chgres_cube.fd/run/config.C384.dell.nml create mode 100644 sorc/chgres_cube.fd/run/config.C384.gaussian.dell.nml create mode 100644 sorc/chgres_cube.fd/run/config.C384.theia.nml create mode 100644 sorc/chgres_cube.fd/run/config.C48.cray.nml create mode 100644 sorc/chgres_cube.fd/run/config.C48.dell.nml create mode 100644 sorc/chgres_cube.fd/run/config.C48.gaussian.theia.nml create mode 100644 sorc/chgres_cube.fd/run/config.C48.gfs.gaussian.theia.nml create mode 100644 sorc/chgres_cube.fd/run/config.C48.gfs.spectral.dell.nml create mode 100644 sorc/chgres_cube.fd/run/config.C48.gfs.spectral.theia.nml create mode 100644 sorc/chgres_cube.fd/run/config.C48.theia.nml create mode 100644 sorc/chgres_cube.fd/run/config.C768.atm.theia.nml create mode 100644 sorc/chgres_cube.fd/run/config.C768.l91.atm.theia.nml create mode 100644 sorc/chgres_cube.fd/run/config.C768.l91.dell.nml create mode 100644 sorc/chgres_cube.fd/run/config.C768.nest.atm.theia.nml create mode 100644 sorc/chgres_cube.fd/run/config.C768.nest.cray.nml create mode 100644 sorc/chgres_cube.fd/run/config.C768.nest.theia.nml create mode 100644 sorc/chgres_cube.fd/run/config.C768.stretch.cray.nml create mode 100644 sorc/chgres_cube.fd/run/config.C768.stretch.theia.nml create mode 100755 sorc/chgres_cube.fd/run/run.cray.sh create mode 100755 sorc/chgres_cube.fd/run/run.dell.sh create mode 100755 sorc/chgres_cube.fd/run/run.slurm.ksh create mode 100755 sorc/chgres_cube.fd/run/run.theia.ksh create mode 100644 sorc/chgres_cube.fd/sorc/atmosphere.F90 create mode 100644 sorc/chgres_cube.fd/sorc/chgres.F90 create mode 100644 sorc/chgres_cube.fd/sorc/input_data.F90 create mode 100755 sorc/chgres_cube.fd/sorc/make.sh create mode 100755 sorc/chgres_cube.fd/sorc/makefile create mode 100644 sorc/chgres_cube.fd/sorc/model_grid.F90 create mode 100644 sorc/chgres_cube.fd/sorc/program_setup.f90 create mode 100644 sorc/chgres_cube.fd/sorc/search_util.f90 create mode 100644 sorc/chgres_cube.fd/sorc/static_data.F90 create mode 100644 sorc/chgres_cube.fd/sorc/surface.F90 create mode 100644 sorc/chgres_cube.fd/sorc/utils.f90 create mode 100644 sorc/chgres_cube.fd/sorc/write_data.F90 diff --git a/sorc/chgres_cube.fd/.gitignore b/sorc/chgres_cube.fd/.gitignore new file mode 100644 index 0000000000..865bc8b6cc --- /dev/null +++ b/sorc/chgres_cube.fd/.gitignore @@ -0,0 +1,3 @@ +*.o +*.mod +*exe diff --git a/sorc/chgres_cube.fd/run/config.C1152.l91.atm.theia.nml b/sorc/chgres_cube.fd/run/config.C1152.l91.atm.theia.nml new file mode 100644 index 0000000000..f4c3f646c7 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C1152.l91.atm.theia.nml @@ -0,0 +1,26 @@ + +# Convert atmosphere from C768 L64 to C1152 L91. +# Uses lots of memory. Use six nodes, six tasks per node. +# When using -O3, takes 8 1/2 minutes + +&config + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C1152/C1152_mosaic.nc" + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C1152" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C1152" + orog_files_target_grid="C1152_oro_data.tile1.nc","C1152_oro_data.tile2.nc","C1152_oro_data.tile3.nc","C1152_oro_data.tile4.nc","C1152_oro_data.tile5.nc","C1152_oro_data.tile6.nc" + vcoord_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l91.txt" + mosaic_file_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/ICs/C768_2018082906" + atm_core_files_input_grid="fv_core.res.tile1.nc","fv_core.res.tile2.nc","fv_core.res.tile3.nc","fv_core.res.tile4.nc","fv_core.res.tile5.nc","fv_core.res.tile6.nc","fv_core.res.nc" + atm_tracer_files_input_grid="fv_tracer.res.tile1.nc","fv_tracer.res.tile2.nc","fv_tracer.res.tile3.nc","fv_tracer.res.tile4.nc","fv_tracer.res.tile5.nc","fv_tracer.res.tile6.nc" + cycle_mon=08 + cycle_day=29 + cycle_hour=6 + convert_atm=.true. + convert_sfc=.false. + convert_nst=.false. + tracers="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" + tracers_input="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" +/ diff --git a/sorc/chgres_cube.fd/run/config.C1152.l91.dell.nml b/sorc/chgres_cube.fd/run/config.C1152.l91.dell.nml new file mode 100644 index 0000000000..79a113084f --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C1152.l91.dell.nml @@ -0,0 +1,25 @@ + +# C768 L64 to C1152 L91 +# Spread across six nodes. + +&config + fix_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/gridgen_sfc/C1152" + mosaic_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C1152/C1152_mosaic.nc" + orog_dir_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C1152" + orog_files_target_grid="C1152_oro_data.tile1.nc","C1152_oro_data.tile2.nc","C1152_oro_data.tile3.nc","C1152_oro_data.tile4.nc","C1152_oro_data.tile5.nc","C1152_oro_data.tile6.nc" + mosaic_file_input_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/ICs/C768_2018082906" + atm_core_files_input_grid="fv_core.res.tile1.nc","fv_core.res.tile2.nc","fv_core.res.tile3.nc","fv_core.res.tile4.nc","fv_core.res.tile5.nc","fv_core.res.tile6.nc","fv_core.res.nc" + atm_tracer_files_input_grid="fv_tracer.res.tile1.nc","fv_tracer.res.tile2.nc","fv_tracer.res.tile3.nc","fv_tracer.res.tile4.nc","fv_tracer.res.tile5.nc","fv_tracer.res.tile6.nc" + vcoord_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l91.txt" + cycle_mon=8 + cycle_day=29 + cycle_hour=6 + convert_atm=.true. + convert_sfc=.false. + convert_nst=.false. + tracers="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" + tracers_input="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" +/ diff --git a/sorc/chgres_cube.fd/run/config.C1152.theia.nml b/sorc/chgres_cube.fd/run/config.C1152.theia.nml new file mode 100644 index 0000000000..89234d7d40 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C1152.theia.nml @@ -0,0 +1,17 @@ +&config + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C1152" + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C1152/C1152_mosaic.nc" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C1152" + orog_files_target_grid="C1152_oro_data.tile1.nc","C1152_oro_data.tile2.nc","C1152_oro_data.tile3.nc","C1152_oro_data.tile4.nc","C1152_oro_data.tile5.nc","C1152_oro_data.tile6.nc" + mosaic_file_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/ICs/C768_2017082600" + sfc_files_input_grid="sfc_data.tile1.nc","sfc_data.tile2.nc","sfc_data.tile3.nc","sfc_data.tile4.nc","sfc_data.tile5.nc","sfc_data.tile6.nc" + cycle_mon=8 + cycle_day=26 + cycle_hour=0 + convert_atm=.false. + convert_sfc=.true. + convert_nst=.true. +/ diff --git a/sorc/chgres_cube.fd/run/config.C384.cray.nml b/sorc/chgres_cube.fd/run/config.C384.cray.nml new file mode 100644 index 0000000000..20f9f4f347 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C384.cray.nml @@ -0,0 +1,17 @@ +&config + fix_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/gridgen_sfc/C384" + mosaic_file_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384/C384_mosaic.nc" + orog_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384" + orog_files_target_grid="C384_oro_data.tile1.nc","C384_oro_data.tile2.nc","C384_oro_data.tile3.nc","C384_oro_data.tile4.nc","C384_oro_data.tile5.nc","C384_oro_data.tile6.nc" + mosaic_file_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/ICs/C768_2017082600" + sfc_files_input_grid="sfc_data.tile1.nc","sfc_data.tile2.nc","sfc_data.tile3.nc","sfc_data.tile4.nc","sfc_data.tile5.nc","sfc_data.tile6.nc" + cycle_mon=8 + cycle_day=26 + cycle_hour=0 + convert_atm=.false. + convert_sfc=.true. + convert_nst=.true. +/ diff --git a/sorc/chgres_cube.fd/run/config.C384.dell.nml b/sorc/chgres_cube.fd/run/config.C384.dell.nml new file mode 100644 index 0000000000..fb2ff02a56 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C384.dell.nml @@ -0,0 +1,24 @@ + +# Fits on one node + +&config + fix_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/gridgen_sfc/C384" + mosaic_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384/C384_mosaic.nc" + orog_dir_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384" + orog_files_target_grid="C384_oro_data.tile1.nc","C384_oro_data.tile2.nc","C384_oro_data.tile3.nc","C384_oro_data.tile4.nc","C384_oro_data.tile5.nc","C384_oro_data.tile6.nc" + mosaic_file_input_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/ICs/C768_2018082906" + atm_core_files_input_grid="fv_core.res.tile1.nc","fv_core.res.tile2.nc","fv_core.res.tile3.nc","fv_core.res.tile4.nc","fv_core.res.tile5.nc","fv_core.res.tile6.nc","fv_core.res.nc" + atm_tracer_files_input_grid="fv_tracer.res.tile1.nc","fv_tracer.res.tile2.nc","fv_tracer.res.tile3.nc","fv_tracer.res.tile4.nc","fv_tracer.res.tile5.nc","fv_tracer.res.tile6.nc" + vcoord_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l64.txt" + cycle_mon=8 + cycle_day=29 + cycle_hour=6 + convert_atm=.true. + convert_sfc=.false. + convert_nst=.false. + tracers="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" + tracers_input="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" +/ diff --git a/sorc/chgres_cube.fd/run/config.C384.gaussian.dell.nml b/sorc/chgres_cube.fd/run/config.C384.gaussian.dell.nml new file mode 100644 index 0000000000..73b9655b24 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C384.gaussian.dell.nml @@ -0,0 +1,24 @@ + +# Fits on one node + +&config + fix_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/gridgen_sfc/C384" + mosaic_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384/C384_mosaic.nc" + orog_dir_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384" + orog_files_target_grid="C384_oro_data.tile1.nc","C384_oro_data.tile2.nc","C384_oro_data.tile3.nc","C384_oro_data.tile4.nc","C384_oro_data.tile5.nc","C384_oro_data.tile6.nc" + mosaic_file_input_grid="NULL" + orog_dir_input_grid="NULL" + orog_files_input_grid="NULL" + data_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/ICs/C384_2018092800_gaussian" + atm_files_input_grid="gdas.t00z.atmf000.nemsio" + vcoord_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l64.txt" + cycle_mon=9 + cycle_day=28 + cycle_hour=0 + convert_atm=.true. + convert_sfc=.false. + convert_nst=.false. + input_type="gaussian" + tracers="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" + tracers_input="spfh","clwmr","o3mr","icmr","rwmr","snmr","grle" +/ diff --git a/sorc/chgres_cube.fd/run/config.C384.theia.nml b/sorc/chgres_cube.fd/run/config.C384.theia.nml new file mode 100644 index 0000000000..672b8a5a04 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C384.theia.nml @@ -0,0 +1,17 @@ +&config + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C384" + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384/C384_mosaic.nc" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384" + orog_files_target_grid="C384_oro_data.tile1.nc","C384_oro_data.tile2.nc","C384_oro_data.tile3.nc","C384_oro_data.tile4.nc","C384_oro_data.tile5.nc","C384_oro_data.tile6.nc" + mosaic_file_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/ICs/C768_2017082600" + sfc_files_input_grid="sfc_data.tile1.nc","sfc_data.tile2.nc","sfc_data.tile3.nc","sfc_data.tile4.nc","sfc_data.tile5.nc","sfc_data.tile6.nc" + cycle_mon=8 + cycle_day=26 + cycle_hour=0 + convert_atm=.false. + convert_sfc=.true. + convert_nst=.true. +/ diff --git a/sorc/chgres_cube.fd/run/config.C48.cray.nml b/sorc/chgres_cube.fd/run/config.C48.cray.nml new file mode 100644 index 0000000000..fc8f69da9e --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C48.cray.nml @@ -0,0 +1,21 @@ +&config + fix_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/gridgen_sfc/C48" + mosaic_file_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48/C48_mosaic.nc" + orog_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48" + orog_files_target_grid="C48_oro_data.tile1.nc","C48_oro_data.tile2.nc","C48_oro_data.tile3.nc","C48_oro_data.tile4.nc","C48_oro_data.tile5.nc","C48_oro_data.tile6.nc" + mosaic_file_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C96/C96_mosaic.nc" + orog_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C96" + orog_files_input_grid="C96_oro_data.tile1.nc","C96_oro_data.tile2.nc","C96_oro_data.tile3.nc","C96_oro_data.tile4.nc","C96_oro_data.tile5.nc","C96_oro_data.tile6.nc" + data_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/ICs/C96_2018022000" + atm_files_input_grid="dynf000.tile1.nc","dynf000.tile2.nc","dynf000.tile3.nc","dynf000.tile4.nc","dynf000.tile5.nc","dynf000.tile6.nc" + vcoord_file_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l64.txt" + cycle_mon=2 + cycle_day=22 + cycle_hour=0 + convert_atm=.true. + convert_sfc=.false. + convert_nst=.false. + input_type="history" + tracers="sphum","liq_wat","o3mr" + tracers_input="spfh","clwmr","o3mr" +/ diff --git a/sorc/chgres_cube.fd/run/config.C48.dell.nml b/sorc/chgres_cube.fd/run/config.C48.dell.nml new file mode 100644 index 0000000000..5a980fd631 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C48.dell.nml @@ -0,0 +1,21 @@ +&config + fix_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/gridgen_sfc/C48" + mosaic_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48/C48_mosaic.nc" + orog_dir_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48" + orog_files_target_grid="C48_oro_data.tile1.nc","C48_oro_data.tile2.nc","C48_oro_data.tile3.nc","C48_oro_data.tile4.nc","C48_oro_data.tile5.nc","C48_oro_data.tile6.nc" + mosaic_file_input_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C96/C96_mosaic.nc" + orog_dir_input_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C96" + orog_files_input_grid="C96_oro_data.tile1.nc","C96_oro_data.tile2.nc","C96_oro_data.tile3.nc","C96_oro_data.tile4.nc","C96_oro_data.tile5.nc","C96_oro_data.tile6.nc" + data_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/ICs/C96_2018022000" + atm_files_input_grid="dynf000.tile1.nc","dynf000.tile2.nc","dynf000.tile3.nc","dynf000.tile4.nc","dynf000.tile5.nc","dynf000.tile6.nc" + vcoord_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l64.txt" + cycle_mon=2 + cycle_day=22 + cycle_hour=0 + convert_atm=.true. + convert_sfc=.false. + convert_nst=.false. + input_type="history" + tracers="sphum","liq_wat","o3mr" + tracers_input="spfh","clwmr","o3mr" +/ diff --git a/sorc/chgres_cube.fd/run/config.C48.gaussian.theia.nml b/sorc/chgres_cube.fd/run/config.C48.gaussian.theia.nml new file mode 100644 index 0000000000..d9707f7da8 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C48.gaussian.theia.nml @@ -0,0 +1,22 @@ +&config + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48/C48_mosaic.nc" + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C48" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48" + orog_files_target_grid="C48_oro_data.tile1.nc","C48_oro_data.tile2.nc","C48_oro_data.tile3.nc","C48_oro_data.tile4.nc","C48_oro_data.tile5.nc","C48_oro_data.tile6.nc" + vcoord_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l64.txt" + mosaic_file_input_grid="NULL" + orog_dir_input_grid="NULL" + orog_files_input_grid="NULL" + data_dir_input_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/ICs/C768_2018091400_gaussian" + atm_files_input_grid="gdas.t00z.atmf000.nemsio" + sfc_files_input_grid="gdas.t00z.sfcf000.nemsio" + cycle_mon=9 + cycle_day=14 + cycle_hour=0 + convert_atm=.false. + convert_sfc=.true. + convert_nst=.false. + input_type="gaussian" + tracers="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" + tracers_input="spfh","clwmr","o3mr","icmr","rwmr","snmr","grle" +/ diff --git a/sorc/chgres_cube.fd/run/config.C48.gfs.gaussian.theia.nml b/sorc/chgres_cube.fd/run/config.C48.gfs.gaussian.theia.nml new file mode 100644 index 0000000000..7816683354 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C48.gfs.gaussian.theia.nml @@ -0,0 +1,23 @@ +&config + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48/C48_mosaic.nc" + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C48" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48" + orog_files_target_grid="C48_oro_data.tile1.nc","C48_oro_data.tile2.nc","C48_oro_data.tile3.nc","C48_oro_data.tile4.nc","C48_oro_data.tile5.nc","C48_oro_data.tile6.nc" + vcoord_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l64.txt" + mosaic_file_input_grid="NULL" + orog_dir_input_grid="NULL" + orog_files_input_grid="NULL" + data_dir_input_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_tutorial/nemsio" + atm_files_input_grid="gfnanl.gdas.2017071700" + nst_files_input_grid="nsnanl.gdas.2017071700" + sfc_files_input_grid="sfnanl.gdas.2017071700" + cycle_mon=7 + cycle_day=17 + cycle_hour=0 + convert_atm=.true. + convert_sfc=.true. + convert_nst=.true. + input_type="gfs_gaussian" + tracers="sphum","liq_wat","o3mr" + tracers_input="spfh","clwmr","o3mr" +/ diff --git a/sorc/chgres_cube.fd/run/config.C48.gfs.spectral.dell.nml b/sorc/chgres_cube.fd/run/config.C48.gfs.spectral.dell.nml new file mode 100644 index 0000000000..eee9d16b67 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C48.gfs.spectral.dell.nml @@ -0,0 +1,23 @@ +&config + mosaic_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48/C48_mosaic.nc" + fix_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/gridgen_sfc/C48" + orog_dir_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48" + orog_files_target_grid="C48_oro_data.tile1.nc","C48_oro_data.tile2.nc","C48_oro_data.tile3.nc","C48_oro_data.tile4.nc","C48_oro_data.tile5.nc","C48_oro_data.tile6.nc" + vcoord_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l65.txt" + mosaic_file_input_grid="NULL" + orog_dir_input_grid="NULL" + orog_files_input_grid="NULL" + data_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/chgres_tutorial/old.fmt" + atm_files_input_grid="gdas.t00z.sanl" + nst_files_input_grid="NULL" + sfc_files_input_grid="gdas.t00z.sfcanl" + cycle_mon=7 + cycle_day=17 + cycle_hour=0 + convert_atm=.true. + convert_sfc=.true. + convert_nst=.false. + input_type="gfs_spectral" + tracers_input="spfh","o3mr","clwmr" + tracers="sphum","o3mr","liq_wat" +/ diff --git a/sorc/chgres_cube.fd/run/config.C48.gfs.spectral.theia.nml b/sorc/chgres_cube.fd/run/config.C48.gfs.spectral.theia.nml new file mode 100644 index 0000000000..ccd66ce818 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C48.gfs.spectral.theia.nml @@ -0,0 +1,23 @@ +&config + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48/C48_mosaic.nc" + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C48" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48" + orog_files_target_grid="C48_oro_data.tile1.nc","C48_oro_data.tile2.nc","C48_oro_data.tile3.nc","C48_oro_data.tile4.nc","C48_oro_data.tile5.nc","C48_oro_data.tile6.nc" + vcoord_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l65.txt" + mosaic_file_input_grid="NULL" + orog_dir_input_grid="NULL" + orog_files_input_grid="NULL" + data_dir_input_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_tutorial/old.fmt" + atm_files_input_grid="gdas.t00z.sanl" + nst_files_input_grid="NULL" + sfc_files_input_grid="gdas.t00z.sfcanl" + cycle_mon=7 + cycle_day=17 + cycle_hour=0 + convert_atm=.true. + convert_sfc=.true. + convert_nst=.false. + input_type="gfs_spectral" + tracers_input="spfh","o3mr","clwmr" + tracers="sphum","o3mr","liq_wat" +/ diff --git a/sorc/chgres_cube.fd/run/config.C48.theia.nml b/sorc/chgres_cube.fd/run/config.C48.theia.nml new file mode 100644 index 0000000000..59c67a4795 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C48.theia.nml @@ -0,0 +1,23 @@ +&config + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48/C48_mosaic.nc" + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C48" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C48" + orog_files_target_grid="C48_oro_data.tile1.nc","C48_oro_data.tile2.nc","C48_oro_data.tile3.nc","C48_oro_data.tile4.nc","C48_oro_data.tile5.nc","C48_oro_data.tile6.nc" + vcoord_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l64.txt" + mosaic_file_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C96/C96_mosaic.nc" + orog_dir_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C96" + orog_files_input_grid="C96_oro_data.tile1.nc","C96_oro_data.tile2.nc","C96_oro_data.tile3.nc","C96_oro_data.tile4.nc","C96_oro_data.tile5.nc","C96_oro_data.tile6.nc" + data_dir_input_grid="/scratch4/NCEPDEV/stmp3/George.Gayno/FV3_RT/rt_10604/fv3_control/" + atm_files_input_grid="dynf000.tile1.nc","dynf000.tile2.nc","dynf000.tile3.nc","dynf000.tile4.nc","dynf000.tile5.nc","dynf000.tile6.nc" + sfc_files_input_grid="phyf000.tile1.nc","phyf000.tile2.nc","phyf000.tile3.nc","phyf000.tile4.nc","phyf000.tile5.nc","phyf000.tile6.nc" + input_type="history" + cycle_mon=2 + cycle_day=22 + cycle_hour=0 + convert_atm=.true. + convert_sfc=.true. + convert_nst=.false. + atm_weight_file="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/weights/C96_to_C48.bilinear.nc" + tracers="sphum","liq_wat","o3mr" + tracers_input="spfh","clwmr","o3mr" +/ diff --git a/sorc/chgres_cube.fd/run/config.C768.atm.theia.nml b/sorc/chgres_cube.fd/run/config.C768.atm.theia.nml new file mode 100644 index 0000000000..da2bff20f6 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C768.atm.theia.nml @@ -0,0 +1,26 @@ + +# Convert from C384 L64 to C768 L64. +# Use two nodes, six tasks per node. + +&config + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C768" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_target_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + vcoord_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l64.txt" + mosaic_file_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384/C384_mosaic.nc" + orog_dir_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384" + orog_files_input_grid="C384_oro_data.tile1.nc","C384_oro_data.tile2.nc","C384_oro_data.tile3.nc","C384_oro_data.tile4.nc","C384_oro_data.tile5.nc","C384_oro_data.tile6.nc" + data_dir_input_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/ICs/C384_2003110700" + atm_core_files_input_grid="fv_core.res.tile1.nc","fv_core.res.tile2.nc","fv_core.res.tile3.nc","fv_core.res.tile4.nc","fv_core.res.tile5.nc","fv_core.res.tile6.nc","fv_core.res.nc" + atm_tracer_files_input_grid="fv_tracer.res.tile1.nc","fv_tracer.res.tile2.nc","fv_tracer.res.tile3.nc","fv_tracer.res.tile4.nc","fv_tracer.res.tile5.nc","fv_tracer.res.tile6.nc" + cycle_mon=11 + cycle_day=7 + cycle_hour=0 + convert_atm=.true. + convert_sfc=.false. + convert_nst=.false. + atm_weight_file="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/weights/C384_to_C768.bilinear.nc" + tracers="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" + tracers_input="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" +/ diff --git a/sorc/chgres_cube.fd/run/config.C768.l91.atm.theia.nml b/sorc/chgres_cube.fd/run/config.C768.l91.atm.theia.nml new file mode 100644 index 0000000000..172637be42 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C768.l91.atm.theia.nml @@ -0,0 +1,26 @@ + +# Convert atmosphere from C768 L64 to C768 L91. +# Use three nodes, six tasks per node. +# When using -O3, takes about 7 minutes. + +&config + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C768" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_target_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + vcoord_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l91.txt" + mosaic_file_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/ICs/C768_2018082906" + atm_core_files_input_grid="fv_core.res.tile1.nc","fv_core.res.tile2.nc","fv_core.res.tile3.nc","fv_core.res.tile4.nc","fv_core.res.tile5.nc","fv_core.res.tile6.nc","fv_core.res.nc" + atm_tracer_files_input_grid="fv_tracer.res.tile1.nc","fv_tracer.res.tile2.nc","fv_tracer.res.tile3.nc","fv_tracer.res.tile4.nc","fv_tracer.res.tile5.nc","fv_tracer.res.tile6.nc" + cycle_mon=08 + cycle_day=29 + cycle_hour=6 + convert_atm=.true. + convert_sfc=.false. + convert_nst=.false. + tracers="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" + tracers_input="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" +/ diff --git a/sorc/chgres_cube.fd/run/config.C768.l91.dell.nml b/sorc/chgres_cube.fd/run/config.C768.l91.dell.nml new file mode 100644 index 0000000000..8ae9e738df --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C768.l91.dell.nml @@ -0,0 +1,25 @@ + +# C768 L64 to C768 L91. +# Spread across three nodes. + +&config + fix_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/gridgen_sfc/C768" + mosaic_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_target_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + mosaic_file_input_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/ICs/C768_2018082906" + atm_core_files_input_grid="fv_core.res.tile1.nc","fv_core.res.tile2.nc","fv_core.res.tile3.nc","fv_core.res.tile4.nc","fv_core.res.tile5.nc","fv_core.res.tile6.nc","fv_core.res.nc" + atm_tracer_files_input_grid="fv_tracer.res.tile1.nc","fv_tracer.res.tile2.nc","fv_tracer.res.tile3.nc","fv_tracer.res.tile4.nc","fv_tracer.res.tile5.nc","fv_tracer.res.tile6.nc" + vcoord_file_target_grid="/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l91.txt" + cycle_mon=8 + cycle_day=29 + cycle_hour=6 + convert_atm=.true. + convert_sfc=.false. + convert_nst=.false. + tracers="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" + tracers_input="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" +/ diff --git a/sorc/chgres_cube.fd/run/config.C768.nest.atm.theia.nml b/sorc/chgres_cube.fd/run/config.C768.nest.atm.theia.nml new file mode 100644 index 0000000000..2afc80acc9 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C768.nest.atm.theia.nml @@ -0,0 +1,24 @@ +# Takes lots of memory. Use two nodes - six tasks per node. + +&config + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C768" + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/esmf_grid/albedo_test_ll_to_fv3_nest/fix/C768_mosaic.nest.nc" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/esmf_grid/albedo_test_ll_to_fv3_nest/fix" + orog_files_target_grid="C768_oro_data.tile7.nc" + vcoord_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_am/global_hyblev.l64.txt" + mosaic_file_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384/C384_mosaic.nc" + orog_dir_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C384" + orog_files_input_grid="C384_oro_data.tile1.nc","C384_oro_data.tile2.nc","C384_oro_data.tile3.nc","C384_oro_data.tile4.nc","C384_oro_data.tile5.nc","C384_oro_data.tile6.nc" + data_dir_input_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/ICs/C384_2003110700" + atm_core_files_input_grid="fv_core.res.tile1.nc","fv_core.res.tile2.nc","fv_core.res.tile3.nc","fv_core.res.tile4.nc","fv_core.res.tile5.nc","fv_core.res.tile6.nc","fv_core.res.nc" + atm_tracer_files_input_grid="fv_tracer.res.tile1.nc","fv_tracer.res.tile2.nc","fv_tracer.res.tile3.nc","fv_tracer.res.tile4.nc","fv_tracer.res.tile5.nc","fv_tracer.res.tile6.nc" + cycle_mon=11 + cycle_day=7 + cycle_hour=0 + convert_atm=.true. + convert_sfc=.false. + convert_nst=.false. + regional=2 + tracers="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" + tracers_input="sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel" +/ diff --git a/sorc/chgres_cube.fd/run/config.C768.nest.cray.nml b/sorc/chgres_cube.fd/run/config.C768.nest.cray.nml new file mode 100644 index 0000000000..54196d8320 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C768.nest.cray.nml @@ -0,0 +1,18 @@ +&config + fix_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/gridgen_sfc/C768.nest" + mosaic_file_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/esmf_grid/albedo_test_ll_to_fv3_nest/fix/C768_mosaic.nest.nc" + orog_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/esmf_grid/albedo_test_ll_to_fv3_nest/fix" + orog_files_target_grid="C768_oro_data.tile7.nc" + mosaic_file_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/ICs/C768_2017082600" + sfc_files_input_grid="sfc_data.tile1.nc","sfc_data.tile2.nc","sfc_data.tile3.nc","sfc_data.tile4.nc","sfc_data.tile5.nc","sfc_data.tile6.nc" + cycle_mon=8 + cycle_day=26 + cycle_hour=0 + convert_atm=.false. + convert_sfc=.true. + convert_nst=.true. + regional=0 +/ diff --git a/sorc/chgres_cube.fd/run/config.C768.nest.theia.nml b/sorc/chgres_cube.fd/run/config.C768.nest.theia.nml new file mode 100644 index 0000000000..931c88d608 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C768.nest.theia.nml @@ -0,0 +1,18 @@ +&config + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C768" + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/esmf_grid/albedo_test_ll_to_fv3_nest/fix/C768_mosaic.nest.nc" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/esmf_grid/albedo_test_ll_to_fv3_nest/fix" + orog_files_target_grid="C768_oro_data.tile7.nc" + mosaic_file_input_grid="/scratch4/NCEPDEV/global/save/glopara/svn/fv3gfs/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/scratch4/NCEPDEV/global/save/glopara/svn/fv3gfs/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/ICs/C768_2017082600" + sfc_files_input_grid="sfc_data.tile1.nc","sfc_data.tile2.nc","sfc_data.tile3.nc","sfc_data.tile4.nc","sfc_data.tile5.nc","sfc_data.tile6.nc" + cycle_mon=8 + cycle_day=26 + cycle_hour=0 + convert_atm=.false. + convert_sfc=.true. + convert_nst=.true. + regional=0 +/ diff --git a/sorc/chgres_cube.fd/run/config.C768.stretch.cray.nml b/sorc/chgres_cube.fd/run/config.C768.stretch.cray.nml new file mode 100644 index 0000000000..46db7c63d3 --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C768.stretch.cray.nml @@ -0,0 +1,17 @@ +&config + fix_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/gridgen_sfc/C768.nest" + mosaic_file_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/esmf_grid/albedo_test_ll_to_fv3_nest/fix/C768_mosaic.6tiles.nc" + orog_dir_target_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/esmf_grid/albedo_test_ll_to_fv3_nest/fix" + orog_files_target_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + mosaic_file_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/chgres_cube/fix/ICs/C768_2017082600" + sfc_files_input_grid="sfc_data.tile1.nc","sfc_data.tile2.nc","sfc_data.tile3.nc","sfc_data.tile4.nc","sfc_data.tile5.nc","sfc_data.tile6.nc" + cycle_mon=8 + cycle_day=26 + cycle_hour=0 + convert_atm=.false. + convert_sfc=.true. + convert_nst=.true. +/ diff --git a/sorc/chgres_cube.fd/run/config.C768.stretch.theia.nml b/sorc/chgres_cube.fd/run/config.C768.stretch.theia.nml new file mode 100644 index 0000000000..a00a7d467a --- /dev/null +++ b/sorc/chgres_cube.fd/run/config.C768.stretch.theia.nml @@ -0,0 +1,17 @@ +&config + fix_dir_target_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/gridgen_sfc/C768" + mosaic_file_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/esmf_grid/albedo_test_ll_to_fv3_nest/fix/C768_mosaic.6tiles.nc" + orog_dir_target_grid="/scratch4/NCEPDEV/da/save/George.Gayno/esmf_grid/albedo_test_ll_to_fv3_nest/fix" + orog_files_target_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + mosaic_file_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768/C768_mosaic.nc" + orog_dir_input_grid="/scratch4/NCEPDEV/da/save/George.Gayno/fv3gfs.git/global-workflow/fix/fix_fv3/C768" + orog_files_input_grid="C768_oro_data.tile1.nc","C768_oro_data.tile2.nc","C768_oro_data.tile3.nc","C768_oro_data.tile4.nc","C768_oro_data.tile5.nc","C768_oro_data.tile6.nc" + data_dir_input_grid="/scratch4/NCEPDEV/da/noscrub/George.Gayno/chgres_cube/fix/ICs/C768_2017082600" + sfc_files_input_grid="sfc_data.tile1.nc","sfc_data.tile2.nc","sfc_data.tile3.nc","sfc_data.tile4.nc","sfc_data.tile5.nc","sfc_data.tile6.nc" + cycle_mon=8 + cycle_day=26 + cycle_hour=0 + convert_atm=.false. + convert_sfc=.true. + convert_nst=.true. +/ diff --git a/sorc/chgres_cube.fd/run/run.cray.sh b/sorc/chgres_cube.fd/run/run.cray.sh new file mode 100755 index 0000000000..75df20183d --- /dev/null +++ b/sorc/chgres_cube.fd/run/run.cray.sh @@ -0,0 +1,36 @@ +#!/bin/sh + +#BSUB -oo log +#BSUB -eo log +#BSUB -q debug +#BSUB -J chgres_fv3 +#BSUB -P FV3GFS-T2O +#BSUB -W 0:10 +#BSUB -M 1000 +#BSUB -extsched 'CRAYLINUX[]' + +set -x + +export NODES=1 +# threads useful when using gfs sigio files as input +export OMP_NUM_THREADS=1 +#export OMP_NUM_THREADS=4 +export OMP_STACKSIZE=1024M + +WORK_DIR=/gpfs/hps3/stmp/George.Gayno/chgres_fv3 +rm -fr $WORK_DIR +mkdir -p $WORK_DIR +cd $WORK_DIR + +#cp /gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/chgres_cube/run/config.C384.cray.nml ./fort.41 +#cp /gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/chgres_cube/run/config.C768.nest.cray.nml ./fort.41 +#cp /gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/chgres_cube/run/config.C768.stretch.cray.nml ./fort.41 +cp /gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/chgres_cube/run/config.C48.cray.nml ./fort.41 + +EXEC_DIR=/gpfs/hps3/emc/global/noscrub/George.Gayno/fv3gfs.git/global-workflow/chgres_cube/exec + +export KMP_AFFINITY=disabled +aprun -j 1 -n 6 -N 6 -d${OMP_NUM_THREADS} -cc depth $EXEC_DIR/global_chgres.exe +#aprun -j 1 -n 18 -N 18 -d${OMP_NUM_THREADS} -cc depth $EXEC_DIR/global_chgres.exe + +exit diff --git a/sorc/chgres_cube.fd/run/run.dell.sh b/sorc/chgres_cube.fd/run/run.dell.sh new file mode 100755 index 0000000000..b06a8710b5 --- /dev/null +++ b/sorc/chgres_cube.fd/run/run.dell.sh @@ -0,0 +1,48 @@ +#!/bin/bash + +#BSUB -oo log +#BSUB -eo log +#BSUB -q debug +#BSUB -P FV3GFS-T2O +#BSUB -J chgres.fv3 +#BSUB -W 0:15 +#BSUB -x # run not shared +#BSUB -n 6 # total tasks +#BSUB -R span[ptile=6] # tasks per node +#BSUB -R affinity[core(4):distribute=balance] + +set -x + +module purge +module load EnvVars/1.0.2 +module load ips/18.0.1.163 +module load impi/18.0.1 +module load lsf/10.1 +module use /usrx/local/dev/modulefiles +module load NetCDF/4.5.0 + +# On Dell, always set environment variables AFTER any module loads. +# Threads are only useful when using gfs sigio files. Set OMP_NUM_THREADS +# equal to "affinity[core(n)". + +export OMP_STACKSIZE=1024M +export OMP_NUM_THREADS=4 + +EXECDIR=/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/chgres_cube/exec +RUNDIR=/gpfs/dell2/emc/modeling/noscrub/George.Gayno/fv3gfs.git/global-workflow/chgres_cube/run + +WORKDIR=/gpfs/dell1/stmp/George.Gayno/chgres.fv3 +rm -fr $WORKDIR +mkdir -p $WORKDIR +cd $WORKDIR + +#cp $RUNDIR/config.C1152.l91.dell.nml ./fort.41 +#cp $RUNDIR/config.C768.l91.dell.nml ./fort.41 +#cp $RUNDIR/config.C384.dell.nml ./fort.41 +#cp $RUNDIR/config.C384.gaussian.dell.nml ./fort.41 +#cp $RUNDIR/config.C48.dell.nml ./fort.41 +cp $RUNDIR/config.C48.gfs.spectral.dell.nml ./fort.41 + +mpirun $EXECDIR/global_chgres.exe + +exit diff --git a/sorc/chgres_cube.fd/run/run.slurm.ksh b/sorc/chgres_cube.fd/run/run.slurm.ksh new file mode 100755 index 0000000000..b762b8d48f --- /dev/null +++ b/sorc/chgres_cube.fd/run/run.slurm.ksh @@ -0,0 +1,60 @@ +#!/bin/ksh + +#----------------------------------------------------------- +# Run test case on Theia. MUST BE RUN WITH A +# MULTIPLE OF SIX MPI TASKS. Could not get it to +# work otherwise. +# +# Invoke as: sbatch $script +#----------------------------------------------------------- + +####SBATCH --ntasks=12 --nodes=2 +#SBATCH --ntasks=6 --nodes=1 +#SBATCH -t 0:15:00 +#SBATCH -A fv3-cpu +#SBATCH -q debug +#SBATCH -J fv3 +#SBATCH -o ./log +#SBATCH -e ./log + +set -x + +source /apps/lmod/lmod/init/ksh +module purge +module load intel/18.1.163 +module load impi/5.1.1.109 +module load netcdf/4.3.0 +module load slurm/default + +# Threads useful when ingesting spectral gfs sigio files. +# Otherwise set to 1. +export OMP_NUM_THREADS=1 +export OMP_STACKSIZE=1024M + +WORKDIR=/scratch3/NCEPDEV/stmp1/$LOGNAME/chgres_fv3 +rm -fr $WORKDIR +mkdir -p $WORKDIR +cd $WORKDIR + +ln -fs ${SLURM_SUBMIT_DIR}/test.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C48.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C48.gaussian.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C48.gfs.gaussian.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C48.gfs.spectral.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C384.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C768.nest.atm.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C768.nest.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C768.atm.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C768.l91.atm.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C1152.l91.atm.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C96.nest.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C768.stretch.theia.nml ./fort.41 +#ln -fs ${SLURM_SUBMIT_DIR}/config.C1152.theia.nml ./fort.41 + +date + +srun ${SLURM_SUBMIT_DIR}/../exec/global_chgres.exe + +date + +exit 0 diff --git a/sorc/chgres_cube.fd/run/run.theia.ksh b/sorc/chgres_cube.fd/run/run.theia.ksh new file mode 100755 index 0000000000..d387082ed4 --- /dev/null +++ b/sorc/chgres_cube.fd/run/run.theia.ksh @@ -0,0 +1,53 @@ +#!/bin/ksh + +#----------------------------------------------------------- +# Run test case on Theia. MUST BE RUN WITH A +# MULTIPLE OF SIX MPI TASKS. Could not get it to +# work otherwise. +#----------------------------------------------------------- + +#PBS -l nodes=2:ppn=6 +#PBS -l walltime=0:10:00 +#PBS -A fv3-cpu +#PBS -q debug +#PBS -N fv3 +#PBS -o ./log +#PBS -e ./log + +set -x + +np=$PBS_NP + +source /apps/lmod/lmod/init/ksh +module purge +module load intel/15.1.133 +module load impi/5.1.1.109 +module load netcdf/4.3.0 + +# Threads are useful when processing spectal gfs data in +# sigio format. Otherwise, use one thread. +export OMP_NUM_THREADS=1 +export OMP_STACKSIZE=1024M + +WORKDIR=/scratch3/NCEPDEV/stmp1/$LOGNAME/chgres_fv3 +rm -fr $WORKDIR +mkdir -p $WORKDIR +cd $WORKDIR + +#ln -fs ${PBS_O_WORKDIR}/config.C48.theia.nml ./fort.41 +#ln -fs ${PBS_O_WORKDIR}/config.C48.gaussian.theia.nml ./fort.41 +#ln -fs ${PBS_O_WORKDIR}/config.C48.gfs.gaussian.theia.nml ./fort.41 +#ln -fs ${PBS_O_WORKDIR}/config.C48.gfs.spectral.theia.nml ./fort.41 +#ln -fs ${PBS_O_WORKDIR}/config.C384.theia.nml ./fort.41 +#ln -fs ${PBS_O_WORKDIR}/config.C768.nest.atm.theia.nml ./fort.41 +#ln -fs ${PBS_O_WORKDIR}/config.C768.nest.theia.nml ./fort.41 +#ln -fs ${PBS_O_WORKDIR}/config.C768.atm.theia.nml ./fort.41 +#ln -fs ${PBS_O_WORKDIR}/config.C768.l91.atm.theia.nml ./fort.41 +#ln -fs ${PBS_O_WORKDIR}/config.C1152.l91.atm.theia.nml ./fort.41 +#ln -fs ${PBS_O_WORKDIR}/config.C96.nest.theia.nml ./fort.41 +ln -fs ${PBS_O_WORKDIR}/config.C768.stretch.theia.nml ./fort.41 +#ln -fs ${PBS_O_WORKDIR}/config.C1152.theia.nml ./fort.41 + +mpirun -np $np ${PBS_O_WORKDIR}/../exec/global_chgres.exe + +exit 0 diff --git a/sorc/chgres_cube.fd/sorc/atmosphere.F90 b/sorc/chgres_cube.fd/sorc/atmosphere.F90 new file mode 100644 index 0000000000..067362c040 --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/atmosphere.F90 @@ -0,0 +1,1787 @@ + module atmosphere + +!-------------------------------------------------------------------------- +! Module atmosphere +! +! Abstract: Process atmospheric fields: Horizontally interpolate input +! fields to the target grid. Adjust surface pressure according to +! terrain difference between input and target grids. Vertically +! interpolate to target grid vertical levels. Processing based on +! the spectral GFS version of CHGRES. +! +! Public Subroutines: +! ------------------- +! atmosphere driver Driver routine for processing atmospheric +! fields +! +! Public variables: +! ----------------- +! Variables defined below. Here "b4adj" indicates fields on the target +! grid before vertical adjustment. "target" indicates data on target +! grid. "input" indicates data on input grid. "_s" indicates fields +! on the 'south' edge of the grid box. "_w" indicate fields on the +! 'west' edge of the grid box. Otherwise, fields are at the center +! of the grid box. +! +!-------------------------------------------------------------------------- + + use esmf + + use input_data, only : lev_input, & + levp1_input, & + tracers_input_grid, & + dzdt_input_grid, & + ps_input_grid, & + wind_input_grid, & + temp_input_grid, & + pres_input_grid, & + terrain_input_grid, & + read_input_atm_data, & + cleanup_input_atm_data + + use model_grid, only : target_grid, & + latitude_s_target_grid, & + longitude_s_target_grid, & + latitude_w_target_grid, & + longitude_w_target_grid, & + terrain_target_grid + + use program_setup, only : vcoord_file_target_grid, & + regional, & + tracers, num_tracers, & + atm_weight_file + + implicit none + + private + + integer, public :: lev_target ! num vertical levels + integer, public :: levp1_target ! num levels plus 1 + integer, public :: nvcoord_target ! num vertical coordinate + ! variables + + real(esmf_kind_r8), allocatable, public :: vcoord_target(:,:) ! vertical coordinate + + type(esmf_field), public :: delp_target_grid + ! pressure thickness + type(esmf_field), public :: dzdt_target_grid + ! vertical velocity + type(esmf_field) :: dzdt_b4adj_target_grid + ! vertical vel before vert adj + type(esmf_field), allocatable, public :: tracers_target_grid(:) + ! tracers + type(esmf_field), allocatable :: tracers_b4adj_target_grid(:) + ! tracers before vert adj + type(esmf_field), public :: ps_target_grid + ! surface pressure + type(esmf_field) :: ps_b4adj_target_grid + ! sfc pres before terrain adj + type(esmf_field) :: pres_target_grid + ! 3-d pressure + type(esmf_field) :: pres_b4adj_target_grid + ! 3-d pres before terrain adj + type(esmf_field), public :: temp_target_grid + ! temperautre + type(esmf_field) :: temp_b4adj_target_grid + ! temp before vert adj + type(esmf_field) :: terrain_interp_to_target_grid + ! Input grid terrain + ! interpolated to target grid. + type(esmf_field), public :: u_s_target_grid + ! u-wind, 'south' edge + type(esmf_field), public :: v_s_target_grid + ! v-wind, 'south' edge + type(esmf_field) :: wind_target_grid + ! 3-d wind, grid box center + type(esmf_field) :: wind_b4adj_target_grid + ! 3-d wind before vert adj + type(esmf_field) :: wind_s_target_grid + ! 3-d wind, 'south' edge + type(esmf_field), public :: u_w_target_grid + ! u-wind, 'west' edge + type(esmf_field), public :: v_w_target_grid + ! v-wind, 'west' edge + type(esmf_field) :: wind_w_target_grid + ! 3-d wind, 'west' edge + type(esmf_field), public :: zh_target_grid + ! 3-d height + + public :: atmosphere_driver + + contains + +!----------------------------------------------------------------------------------- +! Driver routine for atmospheric fields. +!----------------------------------------------------------------------------------- + + subroutine atmosphere_driver(localpet) + + implicit none + + include 'mpif.h' + + integer, intent(in) :: localpet + + integer :: isrctermprocessing + integer :: rc, n + + type(esmf_regridmethod_flag) :: method + type(esmf_routehandle) :: regrid_bl + + real(esmf_kind_r8), parameter :: p0=101325.0 + real(esmf_kind_r8), parameter :: rd = 287.058 + real(esmf_kind_r8), parameter :: grav = 9.81 + real(esmf_kind_r8), parameter :: lapse = -6.5e-03 + + real(esmf_kind_r8), parameter :: exponent = rd*lapse/grav + real(esmf_kind_r8), parameter :: one_over_exponent = 1.0 / exponent + + real(esmf_kind_r8), pointer :: psptr(:,:) + +!----------------------------------------------------------------------------------- +! Read atmospheric fields on the input grid. +!----------------------------------------------------------------------------------- + + call read_input_atm_data(localpet) + +!----------------------------------------------------------------------------------- +! Read vertical coordinate info for target grid. +!----------------------------------------------------------------------------------- + + call read_vcoord_info + +!----------------------------------------------------------------------------------- +! Create target grid field objects to hold data before vertical adjustment. +!----------------------------------------------------------------------------------- + + call create_atm_b4adj_esmf_fields + +!----------------------------------------------------------------------------------- +! Horizontally interpolate. If specified, use weights from file. +!----------------------------------------------------------------------------------- + + isrctermprocessing = 1 + + if (trim(atm_weight_file) /= "NULL") then + + print*,"- CALL FieldSMMStore FOR ATMOSPHERIC FIELDS." + + call ESMF_FieldSMMStore(temp_input_grid, & + temp_b4adj_target_grid, & + atm_weight_file, & + routehandle=regrid_bl, & + srctermprocessing=isrctermprocessing, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldSMMStore", rc) + + else + + print*,"- CALL FieldRegridStore FOR ATMOSPHERIC FIELDS." + + method=ESMF_REGRIDMETHOD_BILINEAR + + call ESMF_FieldRegridStore(temp_input_grid, & + temp_b4adj_target_grid, & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + extrapmethod=ESMF_EXTRAPMETHOD_NEAREST_STOD, & + routehandle=regrid_bl, & + regridmethod=method, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridStore", rc) + + endif + + print*,"- CALL Field_Regrid FOR TEMPERATURE." + call ESMF_FieldRegrid(temp_input_grid, & + temp_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid FOR PRESSURE." + call ESMF_FieldRegrid(pres_input_grid, & + pres_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + do n = 1, num_tracers + print*,"- CALL Field_Regrid FOR TRACER ", trim(tracers(n)) + call ESMF_FieldRegrid(tracers_input_grid(n), & + tracers_b4adj_target_grid(n), & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + enddo + + print*,"- CALL Field_Regrid FOR VERTICAL VELOCITY." + call ESMF_FieldRegrid(dzdt_input_grid, & + dzdt_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + nullify(psptr) + print*,"- CALL FieldGet FOR INPUT SURFACE PRESSURE." + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + +!------------------------------------------------------------------------------------ +! Assume standard lapse rate when interpolating pressure (per Phil Pegion). +!------------------------------------------------------------------------------------ + + psptr = (psptr/p0)**exponent + + print*,"- CALL Field_Regrid FOR SURFACE PRESSURE." + call ESMF_FieldRegrid(ps_input_grid, & + ps_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + nullify(psptr) + print*,"- CALL FieldGet FOR INPUT SURFACE PRESSURE B4ADJ." + call ESMF_FieldGet(ps_b4adj_target_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + psptr = p0 * psptr**one_over_exponent + + print*,"- CALL Field_Regrid FOR TERRAIN." + call ESMF_FieldRegrid(terrain_input_grid, & + terrain_interp_to_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid FOR 3-D WIND." + call ESMF_FieldRegrid(wind_input_grid, & + wind_b4adj_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_bl, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridRelease", rc) + +!----------------------------------------------------------------------------------- +! Deallocate input fields. +!----------------------------------------------------------------------------------- + + call cleanup_input_atm_data + +!----------------------------------------------------------------------------------- +! Create target grid field objects to hold data after vertical interpolation. +!----------------------------------------------------------------------------------- + + call create_atm_esmf_fields + +!----------------------------------------------------------------------------------- +! Adjust surface pressure for terrain differences. +!----------------------------------------------------------------------------------- + + call newps(localpet) + +!----------------------------------------------------------------------------------- +! Compute 3-d pressure based on adjusted surface pressure. +!----------------------------------------------------------------------------------- + + call newpr1(localpet) + +!----------------------------------------------------------------------------------- +! Vertically interpolate. +!----------------------------------------------------------------------------------- + + call vintg + +!----------------------------------------------------------------------------------- +! Compute height. +!----------------------------------------------------------------------------------- + + call compute_zh + +!----------------------------------------------------------------------------------- +! Free up memory. +!----------------------------------------------------------------------------------- + + call cleanup_target_atm_b4adj_data + +!----------------------------------------------------------------------------------- +! Interpolate winds to 'd' grid. +!----------------------------------------------------------------------------------- + + isrctermprocessing = 1 + method=ESMF_REGRIDMETHOD_BILINEAR + + print*,"- CALL FieldRegridStore FOR 3D-WIND WEST EDGE." + call ESMF_FieldRegridStore(wind_target_grid, & + wind_w_target_grid, & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_STOD, & + routehandle=regrid_bl, & + regridmethod=method, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid FOR 3-D WIND WEST EDGE." + call ESMF_FieldRegrid(wind_target_grid, & + wind_w_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_bl, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridRelease", rc) + + isrctermprocessing = 1 + method=ESMF_REGRIDMETHOD_BILINEAR + + print*,"- CALL FieldRegridStore FOR 3D-WIND SOUTH EDGE." + call ESMF_FieldRegridStore(wind_target_grid, & + wind_s_target_grid, & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_STOD, & + routehandle=regrid_bl, & + regridmethod=method, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid FOR 3-D WIND SOUTH EDGE." + call ESMF_FieldRegrid(wind_target_grid, & + wind_s_target_grid, & + routehandle=regrid_bl, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_bl, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridRelease", rc) + +!----------------------------------------------------------------------------------- +! Convert from 3-d to 2-d cartesian winds. +!----------------------------------------------------------------------------------- + + call convert_winds + +!----------------------------------------------------------------------------------- +! Write target data to file. +!----------------------------------------------------------------------------------- + + call write_fv3_atm_header_netcdf(localpet) + if (regional <= 1) call write_fv3_atm_data_netcdf(localpet) + if (regional >= 1) call write_fv3_atm_bndy_data_netcdf(localpet) + +!----------------------------------------------------------------------------------- +! Free up memory. +!----------------------------------------------------------------------------------- + + call cleanup_target_atm_data + + end subroutine atmosphere_driver + +!----------------------------------------------------------------------------------- +! Create target grid field objects to hold data before vertical interpolation. +! These will be defined with the same number of vertical levels as the input grid. +!----------------------------------------------------------------------------------- + + subroutine create_atm_b4adj_esmf_fields + + implicit none + + integer :: rc, n + + allocate(tracers_b4adj_target_grid(num_tracers)) + + do n = 1, num_tracers + print*,"- CALL FieldCreate FOR TARGET GRID TRACER BEFORE ADJUSTMENT ", trim(tracers(n)) + tracers_b4adj_target_grid(n) = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + enddo + + print*,"- CALL FieldCreate FOR TARGET GRID TEMPERATURE BEFORE ADJUSTMENT." + temp_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID PRESSURE BEFORE ADJUSTMENT." + pres_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID VERTICAL VELOCITY BEFORE ADJUSTMENT." + dzdt_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID UNSTAGGERED WINDS BEFORE ADJUSTMENT." + wind_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1,1/), & + ungriddedUBound=(/lev_input,3/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET TERRAIN." + terrain_interp_to_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET SURFACE PRESSURE BEFORE ADJUSTMENT." + ps_b4adj_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + end subroutine create_atm_b4adj_esmf_fields + +!----------------------------------------------------------------------------------- +! Create target grid field objects. +!----------------------------------------------------------------------------------- + + subroutine create_atm_esmf_fields + + implicit none + + integer :: rc, n + + allocate(tracers_target_grid(num_tracers)) + + do n = 1, num_tracers + print*,"- CALL FieldCreate FOR TARGET GRID TRACERS ", trim(tracers(n)) + tracers_target_grid(n) = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + enddo + + print*,"- CALL FieldCreate FOR TARGET GRID TEMPERATURE." + temp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID PRESSURE." + pres_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID VERTICAL VELOCITY." + dzdt_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID DELP." + delp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET HEIGHT." + zh_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/levp1_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET UNSTAGGERED 3D-WIND." + wind_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1,1/), & + ungriddedUBound=(/lev_target,3/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET U_S." + u_s_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET V_S." + v_s_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET 3D-WIND_S." + wind_s_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + ungriddedLBound=(/1,1/), & + ungriddedUBound=(/lev_target,3/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET U_W." + u_w_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET V_W." + v_w_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET 3D-WIND_W." + wind_w_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + ungriddedLBound=(/1,1/), & + ungriddedUBound=(/lev_target,3/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET SURFACE PRESSURE." + ps_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + end subroutine create_atm_esmf_fields + + subroutine convert_winds + + implicit none + + integer :: clb(4), cub(4) + integer :: i, j, k, rc + + real(esmf_kind_r8), pointer :: latptr(:,:) + real(esmf_kind_r8), pointer :: lonptr(:,:) + real(esmf_kind_r8), pointer :: uptr(:,:,:) + real(esmf_kind_r8), pointer :: vptr(:,:,:) + real(esmf_kind_r8), pointer :: windptr(:,:,:,:) + real(esmf_kind_r8) :: latrad, lonrad + +!----------------------------------------------------------------------------------- +! Convert from 3-d cartesian to 2-cartesian winds +!----------------------------------------------------------------------------------- + + print*,'- CONVERT WINDS.' + + print*,"- CALL FieldGet FOR 3-D WIND_S." + call ESMF_FieldGet(wind_s_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=windptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR U_S." + call ESMF_FieldGet(u_s_target_grid, & + farrayPtr=uptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR V_S." + call ESMF_FieldGet(v_s_target_grid, & + farrayPtr=vptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LATITUDE_S." + call ESMF_FieldGet(latitude_s_target_grid, & + farrayPtr=latptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LONGITUDE_S." + call ESMF_FieldGet(longitude_s_target_grid, & + farrayPtr=lonptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + latrad = latptr(i,j) * acos(-1.) / 180.0 + lonrad = lonptr(i,j) * acos(-1.) / 180.0 + do k = clb(3), cub(3) + uptr(i,j,k) = windptr(i,j,k,1) * cos(lonrad) + windptr(i,j,k,2) * sin(lonrad) + vptr(i,j,k) = -windptr(i,j,k,1) * sin(latrad) * sin(lonrad) + & + windptr(i,j,k,2) * sin(latrad) * cos(lonrad) + & + windptr(i,j,k,3) * cos(latrad) + enddo + enddo + enddo + + print*,"- CALL FieldGet FOR 3-D WIND_W." + call ESMF_FieldGet(wind_w_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=windptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR U_W." + call ESMF_FieldGet(u_w_target_grid, & + farrayPtr=uptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR V_W." + call ESMF_FieldGet(v_w_target_grid, & + farrayPtr=vptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LATITUDE_W." + call ESMF_FieldGet(latitude_w_target_grid, & + farrayPtr=latptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LONGITUDE_W." + call ESMF_FieldGet(longitude_w_target_grid, & + farrayPtr=lonptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + latrad = latptr(i,j) * acos(-1.) / 180.0 + lonrad = lonptr(i,j) * acos(-1.) / 180.0 + do k = clb(3), cub(3) + uptr(i,j,k) = windptr(i,j,k,1) * cos(lonrad) + windptr(i,j,k,2) * sin(lonrad) + vptr(i,j,k) = -windptr(i,j,k,1) * sin(latrad) * sin(lonrad) + & + windptr(i,j,k,2) * sin(latrad) * cos(lonrad) + & + windptr(i,j,k,3) * cos(latrad) + enddo + enddo + enddo + + end subroutine convert_winds + + subroutine newpr1(localpet) +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! +! SUBPROGRAM: NEWPR1 COMPUTE MODEL PRESSURES +! PRGMMR: JUANG ORG: W/NMC23 DATE: 2005-04-11 +! PRGMMR: Fanglin Yang ORG: W/NMC23 DATE: 2006-11-28 +! PRGMMR: S. Moorthi ORG: NCEP/EMC DATE: 2006-12-12 +! PRGMMR: S. Moorthi ORG: NCEP/EMC DATE: 2007-01-02 +! +! ABSTRACT: COMPUTE MODEL PRESSURES. +! +! PROGRAM HISTORY LOG: +! 2005-04-11 HANN_MING HENRY JUANG hybrid sigma, sigma-p, and sigma- +! +! USAGE: CALL NEWPR1(IM,IX,KM,KMP,IDVC,IDSL,NVCOORD,VCOORD,PP,TP,QP,P +! INPUT ARGUMENT LIST: +! IM INTEGER NUMBER OF POINTS TO COMPUTE +! KM INTEGER NUMBER OF LEVELS +! IDVC INTEGER VERTICAL COORDINATE ID +! (1 FOR SIGMA AND 2 FOR HYBRID) +! IDSL INTEGER TYPE OF SIGMA STRUCTURE +! (1 FOR PHILLIPS OR 2 FOR MEAN) +! NVCOORD INTEGER NUMBER OF VERTICAL COORDINATES +! VCOORD REAL (KM+1,NVCOORD) VERTICAL COORDINATE VALUES +! FOR IDVC=1, NVCOORD=1: SIGMA INTERFACE +! FOR IDVC=2, NVCOORD=2: HYBRID INTERFACE A AND B +! FOR IDVC=3, NVCOORD=3: JUANG GENERAL HYBRID INTERFACE +! AK REAL (KM+1) HYBRID INTERFACE A +! BK REAL (KM+1) HYBRID INTERFACE B +! PS REAL (IX) SURFACE PRESSURE (PA) +! OUTPUT ARGUMENT LIST: +! PM REAL (IX,KM) MID-LAYER PRESSURE (PA) +! DP REAL (IX,KM) LAYER DELTA PRESSURE (PA) +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN +! +!C$$$ + implicit none + + integer, intent(in) :: localpet + + integer :: idsl, idvc, rc + integer :: i, j, k, clb(3), cub(3) + + real(esmf_kind_r8), parameter :: rd=287.05 + real(esmf_kind_r8), parameter :: cp=1004.6 + real(esmf_kind_r8), parameter :: rocp=rd/cp + real(esmf_kind_r8), parameter :: rocp1=rocp+1 + real(esmf_kind_r8), parameter :: rocpr=1/rocp + + real(esmf_kind_r8), pointer :: delp_ptr(:,:,:) + real(esmf_kind_r8), pointer :: pptr(:,:,:) ! adjusted 3-d p. + real(esmf_kind_r8), pointer :: psptr(:,:) ! adjusted surface p. + real(esmf_kind_r8) :: ak, bk + real(esmf_kind_r8), allocatable :: pi(:,:,:) + + print*,"COMPUTE 3-D PRESSURE FROM ADJUSTED SURFACE PRESSURE." + + idvc = 2 ! hard wire for now. + idsl = 2 ! hard wire for now. + + print*,"- CALL FieldGet FOR 3-D PRES." + call ESMF_FieldGet(pres_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=pptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR DELP." + call ESMF_FieldGet(delp_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=delp_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE AFTER ADJUSTMENT" + call ESMF_FieldGet(ps_target_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + allocate(pi(clb(1):cub(1),clb(2):cub(2),1:levp1_target)) + + if(idvc.eq.2) then + do k=1,levp1_target + ak = vcoord_target(k,1) + bk = vcoord_target(k,2) + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pi(i,j,k) = ak + bk*psptr(i,j) + enddo + enddo + enddo + do k=1,lev_target + do i= clb(1), cub(1) + do j= clb(2), cub(2) + delp_ptr(i,j,k) = pi(i,j,k) - pi(i,j,k+1) + enddo + enddo + enddo + else + call error_handler("PROGRAM ONLY WORKS WITH IDVC 2", 1) + endif + + if(idsl.eq.2) then + do k=1,lev_target + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pptr(i,j,k) = (pi(i,j,k)+pi(i,j,k+1))/2.0 + enddo + enddo + enddo + else + do k=1,lev_target + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pptr(i,j,k) = ((pi(i,j,k)**rocp1-pi(i,j,k+1)**rocp1)/ & + (rocp1*(pi(i,j,k)-pi(i,j,k+1))))**rocpr + enddo + enddo + enddo + endif + + deallocate(pi) + + if (localpet == 0) then + print*,'new pres ',pptr(clb(1),clb(2),:) + print*,'delp ',delp_ptr(clb(1),clb(2),:) + endif + + end subroutine newpr1 + + subroutine newps(localpet) + +!$$$ subprogram documentation block +! +! subprogram: newps compute new surface pressure +! prgmmr: iredell org: w/nmc23 date: 92-10-31 +! +! abstract: computes a new surface pressure given a new orography. +! the new pressure is computed assuming a hydrostatic balance +! and a constant temperature lapse rate. below ground, the +! lapse rate is assumed to be -6.5 k/km. +! +! program history log: +! 91-10-31 mark iredell +! 2018-apr adapt for fv3. george gayno +! +!c$$$ + + implicit none + + integer, intent(in) :: localpet + integer :: i, j, k, ii + integer :: clb(3), cub(3), ls, rc + + real(esmf_kind_r8), pointer :: pptr(:,:,:) + real(esmf_kind_r8), pointer :: psptr(:,:) + real(esmf_kind_r8), pointer :: psnewptr(:,:) ! adjusted surface p. + real(esmf_kind_r8), pointer :: tptr(:,:,:) + real(esmf_kind_r8), pointer :: qptr(:,:,:) + real(esmf_kind_r8), pointer :: zsptr(:,:) + real(esmf_kind_r8), pointer :: zsnewptr(:,:) + real(esmf_kind_r8), allocatable :: zu(:,:) + real(esmf_kind_r8), parameter :: beta=-6.5E-3 + real(esmf_kind_r8), parameter :: epsilon=1.E-9 + real(esmf_kind_r8), parameter :: g=9.80665 + real(esmf_kind_r8), parameter :: rd=287.05 + real(esmf_kind_r8), parameter :: rv=461.50 + real(esmf_kind_r8), parameter :: gor=g/rd + real(esmf_kind_r8), parameter :: fv=rv/rd-1. + real(esmf_kind_r8) :: ftv, fgam, apu, fz0 + real(esmf_kind_r8) :: atvu, atv, fz1, fp0 + real(esmf_kind_r8) :: apd, azd, agam, azu + real(esmf_kind_r8) :: atvd, fp1, gamma, pu + real(esmf_kind_r8) :: tvu, pd, tvd + real(esmf_kind_r8) :: at, aq, ap, az + + ftv(at,aq)=at*(1+fv*aq) + fgam(apu,atvu,apd,atvd)=-gor*log(atvd/atvu)/log(apd/apu) + fz0(ap,atv,azd,apd)=azd+atv/gor*log(apd/ap) + fz1(ap,atv,azd,apd,agam)=azd-atv/agam*((apd/ap)**(-agam/gor)-1) + fp0(az,azu,apu,atvu)=apu*exp(-gor/atvu*(az-azu)) + fp1(az,azu,apu,atvu,agam)=apu*(1+agam/atvu*(az-azu))**(-gor/agam) + + print*,"- ADJUST SURFACE PRESSURE FOR NEW TERRAIN." + + print*,"- CALL FieldGet FOR 3-D PRES." + call ESMF_FieldGet(pres_b4adj_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=pptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + if(localpet==0) then + print*,'old pres ',pptr(clb(1),clb(2),:) + endif + + print*,"- CALL FieldGet FOR TEMPERATURE" + call ESMF_FieldGet(temp_b4adj_target_grid, & + farrayPtr=tptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + +! Find specific humidity in the array of tracer fields. + + do ii = 1, num_tracers + if (trim(tracers(ii)) == "sphum") exit + enddo + + print*,"- CALL FieldGet FOR SPECIFIC HUMIDITY" + call ESMF_FieldGet(tracers_b4adj_target_grid(ii), & + farrayPtr=qptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE BEFORE ADJUSTMENT" + call ESMF_FieldGet(ps_b4adj_target_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE AFTER ADJUSTMENT" + call ESMF_FieldGet(ps_target_grid, & + farrayPtr=psnewptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR OLD TERRAIN" + call ESMF_FieldGet(terrain_interp_to_target_grid, & + farrayPtr=zsptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR NEW TERRAIN" + call ESMF_FieldGet(terrain_target_grid, & + farrayPtr=zsnewptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + allocate(zu(clb(1):cub(1),clb(2):cub(2))) + +!----------------------------------------------------------------------------------- +! Note, this routine was adapted from the spectral GFS which labeled the lowest +! model layer as '1'. +!----------------------------------------------------------------------------------- + +!----------------------------------------------------------------------------------- +! Compute surface pressure below the original ground. +!----------------------------------------------------------------------------------- + + ls=0 + k=1 + gamma=beta + do i=clb(1), cub(1) + do j=clb(2), cub(2) + pu=pptr(i,j,k) + tvu=ftv(tptr(i,j,k),qptr(i,j,k)) + zu(i,j)=fz1(pu,tvu,zsptr(i,j),psptr(i,j),gamma) + if(zsnewptr(i,j).le.zu(i,j)) then + pu=pptr(i,j,k) + tvu=ftv(tptr(i,j,k),qptr(i,j,k)) + if(abs(gamma).gt.epsilon) then + psnewptr(i,j)=fp1(zsnewptr(i,j),zu(i,j),pu,tvu,gamma) + else + psnewptr(i,j)=fp0(zsnewptr(i,j),zu(i,j),pu,tvu) + endif + else + psnewptr(i,j)=0 + ls=ls+1 + endif + enddo + enddo + +!----------------------------------------------------------------------------------- +! Compute surface pressure above the original ground. +!----------------------------------------------------------------------------------- + + do k=2,cub(3) + if(ls.gt.0) then + do i=clb(1),cub(1) + do j=clb(2),cub(2) + if(psnewptr(i,j).eq.0) then + pu=pptr(i,j,k) + tvu=ftv(tptr(i,j,k),qptr(i,j,k)) + pd=pptr(i,j,k-1) + tvd=ftv(tptr(i,j,k-1),qptr(i,j,k-1)) + gamma=fgam(pu,tvu,pd,tvd) + if(abs(gamma).gt.epsilon) then + zu(i,j)=fz1(pu,tvu,zu(i,j),pd,gamma) + else + zu(i,j)=fz0(pu,tvu,zu(i,j),pd) + endif + if(zsnewptr(i,j).le.zu(i,j)) then + if(abs(gamma).gt.epsilon) then + psnewptr(i,j)=fp1(zsnewptr(i,j),zu(i,j),pu,tvu,gamma) + else + psnewptr(i,j)=fp0(zsnewptr(i,j),zu(i,j),pu,tvu) + endif + ls=ls-1 + endif + endif + enddo + enddo + endif + enddo + +!----------------------------------------------------------------------------------- +! Compute surface pressure over the top. +!----------------------------------------------------------------------------------- + + if(ls.gt.0) then + k=cub(3) + gamma=0 + do i=clb(1),cub(1) + do j=clb(2),cub(2) + if(psnewptr(i,j).eq.0) then + pu=pptr(i,j,k) + tvu=ftv(tptr(i,j,k),qptr(i,j,k)) + psnewptr(i,j)=fp0(zsnewptr(i,j),zu(i,j),pu,tvu) + endif + enddo + enddo + endif + + deallocate(zu) + + if (localpet == 0) then +! do i=clb(1),cub(1) +! do j=clb(2),cub(2) + do i=clb(1),clb(1) + do j=clb(2),clb(2) + print*,'sfcp adjust ',(zsnewptr(i,j)-zsptr(i,j)), psptr(i,j),psnewptr(i,j) + enddo + enddo + endif + + end subroutine newps + + subroutine read_vcoord_info + +!--------------------------------------------------------------------------------- +! Read vertical coordinate information. +!--------------------------------------------------------------------------------- + + implicit none + + integer :: istat, n, k + + print* + print*,"OPEN VERTICAL COORD FILE: ", trim(vcoord_file_target_grid) + open(14, file=trim(vcoord_file_target_grid), form='formatted', iostat=istat) + if (istat /= 0) then + call error_handler("OPENING VERTICAL COORD FILE", istat) + endif + + read(14, *, iostat=istat) nvcoord_target, lev_target + if (istat /= 0) then + call error_handler("READING VERTICAL COORD FILE", istat) + endif + + levp1_target = lev_target + 1 + + allocate(vcoord_target(levp1_target, nvcoord_target)) + read(14, *, iostat=istat) ((vcoord_target(n,k), k=1,nvcoord_target), n=1,levp1_target) + if (istat /= 0) then + call error_handler("READING VERTICAL COORD FILE", istat) + endif + + print* + do k = 1, levp1_target + print*,'VCOORD FOR LEV ', k, 'IS: ', vcoord_target(k,:) + enddo + + close(14) + + end subroutine read_vcoord_info + + SUBROUTINE VINTG +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! +! SUBPROGRAM: VINTG VERTICALLY INTERPOLATE UPPER-AIR FIELDS +! PRGMMR: IREDELL ORG: W/NMC23 DATE: 92-10-31 +! +! ABSTRACT: VERTICALLY INTERPOLATE UPPER-AIR FIELDS. +! WIND, TEMPERATURE, HUMIDITY AND OTHER TRACERS ARE INTERPOLATED. +! THE INTERPOLATION IS CUBIC LAGRANGIAN IN LOG PRESSURE +! WITH A MONOTONIC CONSTRAINT IN THE CENTER OF THE DOMAIN. +! IN THE OUTER INTERVALS IT IS LINEAR IN LOG PRESSURE. +! OUTSIDE THE DOMAIN, FIELDS ARE GENERALLY HELD CONSTANT, +! EXCEPT FOR TEMPERATURE AND HUMIDITY BELOW THE INPUT DOMAIN, +! WHERE THE TEMPERATURE LAPSE RATE IS HELD FIXED AT -6.5 K/KM AND +! THE RELATIVE HUMIDITY IS HELD CONSTANT. THIS ROUTINE EXPECTS +! FIELDS ORDERED FROM BOTTOM TO TOP OF ATMOSPHERE. +! +! PROGRAM HISTORY LOG: +! 91-10-31 MARK IREDELL +! +! USAGE: CALL VINTG +! +! SUBPROGRAMS CALLED: +! TERP3 CUBICALLY INTERPOLATE IN ONE DIMENSION +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN +! +! + IMPLICIT NONE + + include 'mpif.h' + + REAL(ESMF_KIND_R8), PARAMETER :: DLTDZ=-6.5E-3*287.05/9.80665 + REAL(ESMF_KIND_R8), PARAMETER :: DLPVDRT=-2.5E6/461.50 + REAL(ESMF_KIND_R8), PARAMETER :: ONE = 1.0_ESMF_KIND_R8 + + INTEGER :: I, J, K, CLB(3), CUB(3), RC + INTEGER :: IM, KM1, KM2, NT, II + + REAL(ESMF_KIND_R8) :: DZ + REAL(ESMF_KIND_R8), ALLOCATABLE :: Z1(:,:,:), Z2(:,:,:) + REAL(ESMF_KIND_R8), ALLOCATABLE :: C1(:,:,:,:),C2(:,:,:,:) + + REAL(ESMF_KIND_R8), POINTER :: P1PTR(:,:,:) ! input pressure + REAL(ESMF_KIND_R8), POINTER :: P2PTR(:,:,:) ! output pressure + REAL(ESMF_KIND_R8), POINTER :: DZDT1PTR(:,:,:) ! input vvel + REAL(ESMF_KIND_R8), POINTER :: DZDT2PTR(:,:,:) ! output vvel + REAL(ESMF_KIND_R8), POINTER :: T1PTR(:,:,:) ! input temperature + REAL(ESMF_KIND_R8), POINTER :: T2PTR(:,:,:) ! output temperature + REAL(ESMF_KIND_R8), POINTER :: Q1PTR(:,:,:) ! input tracer + REAL(ESMF_KIND_R8), POINTER :: Q2PTR(:,:,:) ! output tracer + REAL(ESMF_KIND_R8), POINTER :: WIND1PTR(:,:,:,:) ! input wind (x,y,z components) + REAL(ESMF_KIND_R8), POINTER :: WIND2PTR(:,:,:,:) ! input wind (x,y,z components) + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! COMPUTE LOG PRESSURE INTERPOLATING COORDINATE +! AND COPY INPUT WIND, TEMPERATURE, HUMIDITY AND OTHER TRACERS +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + print*,"- VERTICALY INTERPOLATE FIELDS." + + print*,"- CALL FieldGet FOR 3-D PRES." + call ESMF_FieldGet(pres_b4adj_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=p1ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! The '1'/'2' arrays hold fields before/after interpolation. +! Note the 'z' component of the horizontal wind will be treated as a +! tracer. So add one extra third dimension to these 3-d arrays. +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + ALLOCATE(Z1(CLB(1):CUB(1),CLB(2):CUB(2),LEV_INPUT)) + ALLOCATE(Z2(CLB(1):CUB(1),CLB(2):CUB(2),LEV_TARGET)) + ALLOCATE(C1(CLB(1):CUB(1),CLB(2):CUB(2),LEV_INPUT,NUM_TRACERS+5)) + ALLOCATE(C2(CLB(1):CUB(1),CLB(2):CUB(2),LEV_TARGET,NUM_TRACERS+5)) + + Z1 = -LOG(P1PTR) + + print*,"- CALL FieldGet FOR 3-D ADJUSTED PRESS" + call ESMF_FieldGet(pres_target_grid, & + farrayPtr=P2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + Z2 = -LOG(P2PTR) + + print*,"- CALL FieldGet FOR 3-D WIND." + call ESMF_FieldGet(wind_b4adj_target_grid, & + farrayPtr=WIND1PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + C1(:,:,:,1) = WIND1PTR(:,:,:,1) + C1(:,:,:,2) = WIND1PTR(:,:,:,2) + C1(:,:,:,3) = WIND1PTR(:,:,:,3) + + print*,"- CALL FieldGet FOR VERTICAL VELOCITY." + call ESMF_FieldGet(dzdt_b4adj_target_grid, & + farrayPtr=DZDT1PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + C1(:,:,:,4) = DZDT1PTR(:,:,:) + + print*,"- CALL FieldGet FOR 3-D TEMP." + call ESMF_FieldGet(temp_b4adj_target_grid, & + farrayPtr=T1PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + C1(:,:,:,5) = T1PTR(:,:,:) + + DO I = 1, NUM_TRACERS + + print*,"- CALL FieldGet FOR 3-D TRACERS ", trim(tracers(i)) + call ESMF_FieldGet(tracers_b4adj_target_grid(i), & + farrayPtr=Q1PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + C1(:,:,:,5+I) = Q1PTR(:,:,:) + + ENDDO + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! PERFORM LAGRANGIAN ONE-DIMENSIONAL INTERPOLATION +! THAT IS 4TH-ORDER IN INTERIOR, 2ND-ORDER IN OUTSIDE INTERVALS +! AND 1ST-ORDER FOR EXTRAPOLATION. +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + IM = (CUB(1)-CLB(1)+1) * (CUB(2)-CLB(2)+1) + KM1= LEV_INPUT + KM2= LEV_TARGET + NT= NUM_TRACERS + 1 ! treat 'z' wind as tracer. + + CALL TERP3(IM,1,1,1,1,4+NT,(IM*KM1),(IM*KM2), & + KM1,IM,IM,Z1,C1,KM2,IM,IM,Z2,C2) + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! COPY OUTPUT WIND, TEMPERATURE, HUMIDITY AND OTHER TRACERS +! EXCEPT BELOW THE INPUT DOMAIN, LET TEMPERATURE INCREASE WITH A FIXED +! LAPSE RATE AND LET THE RELATIVE HUMIDITY REMAIN CONSTANT. +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + print*,"- CALL FieldGet FOR 3-D ADJUSTED TEMP." + call ESMF_FieldGet(temp_target_grid, & + farrayPtr=T2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR ADJUSTED VERTICAL VELOCITY." + call ESMF_FieldGet(dzdt_target_grid, & + farrayPtr=DZDT2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR 3-D ADJUSTED WIND." + call ESMF_FieldGet(wind_target_grid, & + farrayPtr=WIND2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + DO K=1,LEV_TARGET + DO I=CLB(1),CUB(1) + DO J=CLB(2),CUB(2) + WIND2PTR(I,J,K,1)=C2(I,J,K,1) + WIND2PTR(I,J,K,2)=C2(I,J,K,2) + WIND2PTR(I,J,K,3)=C2(I,J,K,3) + DZDT2PTR(I,J,K)=C2(I,J,K,4) + DZ=Z2(I,J,K)-Z1(I,J,1) + IF(DZ.GE.0) THEN + T2PTR(I,J,K)=C2(I,J,K,5) + ELSE + T2PTR(I,J,K)=C1(I,J,1,5)*EXP(DLTDZ*DZ) + ENDIF + ENDDO + ENDDO + ENDDO + + DO II = 1, NUM_TRACERS + + print*,"- CALL FieldGet FOR 3-D TRACER ", trim(tracers(ii)) + call ESMF_FieldGet(tracers_target_grid(ii), & + farrayPtr=Q2PTR, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + IF (TRIM(TRACERS(II)) == "sphum") THEN ! specific humidity + + DO K=1,LEV_TARGET + DO I=CLB(1),CUB(1) + DO J=CLB(2),CUB(2) + DZ=Z2(I,J,K)-Z1(I,J,1) + IF(DZ.GE.0) THEN + Q2PTR(I,J,K) = C2(I,J,K,5+II) + ELSE + Q2PTR(I,J,K) = C1(I,J,1,5+II)*EXP(DLPVDRT*(ONE/T2PTR(I,J,K)-ONE/T1PTR(I,J,1))-DZ) + ENDIF + ENDDO + ENDDO + ENDDO + + ELSE ! all other tracers + + DO K=1,LEV_TARGET + DO I=CLB(1),CUB(1) + DO J=CLB(2),CUB(2) + Q2PTR(I,J,K) = C2(I,J,K,5+II) + ENDDO + ENDDO + ENDDO + + ENDIF + + ENDDO + + DEALLOCATE (Z1, Z2, C1, C2) + + END SUBROUTINE VINTG + + SUBROUTINE TERP3(IM,IXZ1,IXQ1,IXZ2,IXQ2,NM,NXQ1,NXQ2, & + KM1,KXZ1,KXQ1,Z1,Q1,KM2,KXZ2,KXQ2,Z2,Q2) +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! +! SUBPROGRAM: TERP3 CUBICALLY INTERPOLATE IN ONE DIMENSION +! PRGMMR: IREDELL ORG: W/NMC23 DATE: 98-05-01 +! +! ABSTRACT: INTERPOLATE FIELD(S) IN ONE DIMENSION ALONG THE COLUMN(S). +! THE INTERPOLATION IS CUBIC LAGRANGIAN WITH A MONOTONIC CONSTRAINT +! IN THE CENTER OF THE DOMAIN. IN THE OUTER INTERVALS IT IS LINEAR. +! OUTSIDE THE DOMAIN, FIELDS ARE HELD CONSTANT. +! +! PROGRAM HISTORY LOG: +! 98-05-01 MARK IREDELL +! 1999-01-04 IREDELL USE ESSL SEARCH +! +! USAGE: CALL TERP3(IM,IXZ1,IXQ1,IXZ2,IXQ2,NM,NXQ1,NXQ2, +! & KM1,KXZ1,KXQ1,Z1,Q1,KM2,KXZ2,KXQ2,Z2,Q2,J2) +! INPUT ARGUMENT LIST: +! IM INTEGER NUMBER OF COLUMNS +! IXZ1 INTEGER COLUMN SKIP NUMBER FOR Z1 +! IXQ1 INTEGER COLUMN SKIP NUMBER FOR Q1 +! IXZ2 INTEGER COLUMN SKIP NUMBER FOR Z2 +! IXQ2 INTEGER COLUMN SKIP NUMBER FOR Q2 +! NM INTEGER NUMBER OF FIELDS PER COLUMN +! NXQ1 INTEGER FIELD SKIP NUMBER FOR Q1 +! NXQ2 INTEGER FIELD SKIP NUMBER FOR Q2 +! KM1 INTEGER NUMBER OF INPUT POINTS +! KXZ1 INTEGER POINT SKIP NUMBER FOR Z1 +! KXQ1 INTEGER POINT SKIP NUMBER FOR Q1 +! Z1 REAL (1+(IM-1)*IXZ1+(KM1-1)*KXZ1) +! INPUT COORDINATE VALUES IN WHICH TO INTERPOLATE +! (Z1 MUST BE STRICTLY MONOTONIC IN EITHER DIRECTION) +! Q1 REAL (1+(IM-1)*IXQ1+(KM1-1)*KXQ1+(NM-1)*NXQ1) +! INPUT FIELDS TO INTERPOLATE +! KM2 INTEGER NUMBER OF OUTPUT POINTS +! KXZ2 INTEGER POINT SKIP NUMBER FOR Z2 +! KXQ2 INTEGER POINT SKIP NUMBER FOR Q2 +! Z2 REAL (1+(IM-1)*IXZ2+(KM2-1)*KXZ2) +! OUTPUT COORDINATE VALUES TO WHICH TO INTERPOLATE +! (Z2 NEED NOT BE MONOTONIC) +! +! OUTPUT ARGUMENT LIST: +! Q2 REAL (1+(IM-1)*IXQ2+(KM2-1)*KXQ2+(NM-1)*NXQ2) +! OUTPUT INTERPOLATED FIELDS +! J2 REAL (1+(IM-1)*IXQ2+(KM2-1)*KXQ2+(NM-1)*NXQ2) +! OUTPUT INTERPOLATED FIELDS CHANGE WRT Z2 +! +! SUBPROGRAMS CALLED: +! RSEARCH SEARCH FOR A SURROUNDING REAL INTERVAL +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN +! +!C$$$ + IMPLICIT NONE + INTEGER IM,IXZ1,IXQ1,IXZ2,IXQ2,NM,NXQ1,NXQ2 + INTEGER KM1,KXZ1,KXQ1,KM2,KXZ2,KXQ2 + INTEGER I,K1,K2,N + INTEGER K1S(IM,KM2) + REAL(ESMF_KIND_R8), PARAMETER :: ONE = 1.0_ESMF_KIND_R8 + REAL(ESMF_KIND_R8) :: Z1(1+(IM-1)*IXZ1+(KM1-1)*KXZ1) + REAL(ESMF_KIND_R8) :: Q1(1+(IM-1)*IXQ1+(KM1-1)*KXQ1+(NM-1)*NXQ1) + REAL(ESMF_KIND_R8) :: Z2(1+(IM-1)*IXZ2+(KM2-1)*KXZ2) + REAL(ESMF_KIND_R8) :: Q2(1+(IM-1)*IXQ2+(KM2-1)*KXQ2+(NM-1)*NXQ2) +! REAL(ESMF_KIND_R8) :: J2(1+(IM-1)*IXQ2+(KM2-1)*KXQ2+(NM-1)*NXQ2) + REAL(ESMF_KIND_R8) :: FFA(IM),FFB(IM),FFC(IM),FFD(IM) + REAL(ESMF_KIND_R8) :: GGA(IM),GGB(IM),GGC(IM),GGD(IM) + REAL(ESMF_KIND_R8) :: Z1A,Z1B,Z1C,Z1D,Q1A,Q1B,Q1C,Q1D,Z2S,Q2S +! REAL(ESMF_KIND_R8) :: J2S + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! FIND THE SURROUNDING INPUT INTERVAL FOR EACH OUTPUT POINT. + CALL RSEARCH(IM,KM1,IXZ1,KXZ1,Z1,KM2,IXZ2,KXZ2,Z2,1,IM,K1S) + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! GENERALLY INTERPOLATE CUBICALLY WITH MONOTONIC CONSTRAINT +! FROM TWO NEAREST INPUT POINTS ON EITHER SIDE OF THE OUTPUT POINT, +! BUT WITHIN THE TWO EDGE INTERVALS INTERPOLATE LINEARLY. +! KEEP THE OUTPUT FIELDS CONSTANT OUTSIDE THE INPUT DOMAIN. + +!$OMP PARALLEL DO DEFAULT(PRIVATE) SHARED(IM,IXZ1,IXQ1,IXZ2), & +!$OMP& SHARED(IXQ2,NM,NXQ1,NXQ2,KM1,KXZ1,KXQ1,Z1,Q1,KM2,KXZ2), & +!$OMP& SHARED(KXQ2,Z2,Q2,K1S) + + DO K2=1,KM2 + DO I=1,IM + K1=K1S(I,K2) + IF(K1.EQ.1.OR.K1.EQ.KM1-1) THEN + Z2S=Z2(1+(I-1)*IXZ2+(K2-1)*KXZ2) + Z1A=Z1(1+(I-1)*IXZ1+(K1-1)*KXZ1) + Z1B=Z1(1+(I-1)*IXZ1+(K1+0)*KXZ1) + FFA(I)=(Z2S-Z1B)/(Z1A-Z1B) + FFB(I)=(Z2S-Z1A)/(Z1B-Z1A) + GGA(I)=ONE/(Z1A-Z1B) + GGB(I)=ONE/(Z1B-Z1A) + ELSEIF(K1.GT.1.AND.K1.LT.KM1-1) THEN + Z2S=Z2(1+(I-1)*IXZ2+(K2-1)*KXZ2) + Z1A=Z1(1+(I-1)*IXZ1+(K1-2)*KXZ1) + Z1B=Z1(1+(I-1)*IXZ1+(K1-1)*KXZ1) + Z1C=Z1(1+(I-1)*IXZ1+(K1+0)*KXZ1) + Z1D=Z1(1+(I-1)*IXZ1+(K1+1)*KXZ1) + FFA(I)=(Z2S-Z1B)/(Z1A-Z1B)* & + (Z2S-Z1C)/(Z1A-Z1C)* & + (Z2S-Z1D)/(Z1A-Z1D) + FFB(I)=(Z2S-Z1A)/(Z1B-Z1A)* & + (Z2S-Z1C)/(Z1B-Z1C)* & + (Z2S-Z1D)/(Z1B-Z1D) + FFC(I)=(Z2S-Z1A)/(Z1C-Z1A)* & + (Z2S-Z1B)/(Z1C-Z1B)* & + (Z2S-Z1D)/(Z1C-Z1D) + FFD(I)=(Z2S-Z1A)/(Z1D-Z1A)* & + (Z2S-Z1B)/(Z1D-Z1B)* & + (Z2S-Z1C)/(Z1D-Z1C) + GGA(I)= ONE/(Z1A-Z1B)* & + (Z2S-Z1C)/(Z1A-Z1C)* & + (Z2S-Z1D)/(Z1A-Z1D)+ & + (Z2S-Z1B)/(Z1A-Z1B)* & + ONE/(Z1A-Z1C)* & + (Z2S-Z1D)/(Z1A-Z1D)+ & + (Z2S-Z1B)/(Z1A-Z1B)* & + (Z2S-Z1C)/(Z1A-Z1C)* & + ONE/(Z1A-Z1D) + GGB(I)= ONE/(Z1B-Z1A)* & + (Z2S-Z1C)/(Z1B-Z1C)* & + (Z2S-Z1D)/(Z1B-Z1D)+ & + (Z2S-Z1A)/(Z1B-Z1A)* & + ONE/(Z1B-Z1C)* & + (Z2S-Z1D)/(Z1B-Z1D)+ & + (Z2S-Z1A)/(Z1B-Z1A)* & + (Z2S-Z1C)/(Z1B-Z1C)* & + ONE/(Z1B-Z1D) + GGC(I)= ONE/(Z1C-Z1A)* & + (Z2S-Z1B)/(Z1C-Z1B)* & + (Z2S-Z1D)/(Z1C-Z1D)+ & + (Z2S-Z1A)/(Z1C-Z1A)* & + ONE/(Z1C-Z1B)* & + (Z2S-Z1D)/(Z1C-Z1D)+ & + (Z2S-Z1A)/(Z1C-Z1A)* & + (Z2S-Z1B)/(Z1C-Z1B)* & + ONE/(Z1C-Z1D) + GGD(I)= ONE/(Z1D-Z1A)* & + (Z2S-Z1B)/(Z1D-Z1B)* & + (Z2S-Z1C)/(Z1D-Z1C)+ & + (Z2S-Z1A)/(Z1D-Z1A)* & + ONE/(Z1D-Z1B)* & + (Z2S-Z1C)/(Z1D-Z1C)+ & + (Z2S-Z1A)/(Z1D-Z1A)* & + (Z2S-Z1B)/(Z1D-Z1B)* & + ONE/(Z1D-Z1C) + ENDIF + ENDDO +! INTERPOLATE. + DO N=1,NM + DO I=1,IM + K1=K1S(I,K2) + IF(K1.EQ.0) THEN + Q2S=Q1(1+(I-1)*IXQ1+(N-1)*NXQ1) +! J2S=0 + ELSEIF(K1.EQ.KM1) THEN + Q2S=Q1(1+(I-1)*IXQ1+(KM1-1)*KXQ1+(N-1)*NXQ1) +! J2S=0 + ELSEIF(K1.EQ.1.OR.K1.EQ.KM1-1) THEN + Q1A=Q1(1+(I-1)*IXQ1+(K1-1)*KXQ1+(N-1)*NXQ1) + Q1B=Q1(1+(I-1)*IXQ1+(K1+0)*KXQ1+(N-1)*NXQ1) + Q2S=FFA(I)*Q1A+FFB(I)*Q1B +! J2S=GGA(I)*Q1A+GGB(I)*Q1B + ELSE + Q1A=Q1(1+(I-1)*IXQ1+(K1-2)*KXQ1+(N-1)*NXQ1) + Q1B=Q1(1+(I-1)*IXQ1+(K1-1)*KXQ1+(N-1)*NXQ1) + Q1C=Q1(1+(I-1)*IXQ1+(K1+0)*KXQ1+(N-1)*NXQ1) + Q1D=Q1(1+(I-1)*IXQ1+(K1+1)*KXQ1+(N-1)*NXQ1) + Q2S=FFA(I)*Q1A+FFB(I)*Q1B+FFC(I)*Q1C+FFD(I)*Q1D +! J2S=GGA(I)*Q1A+GGB(I)*Q1B+GGC(I)*Q1C+GGD(I)*Q1D + IF(Q2S.LT.MIN(Q1B,Q1C)) THEN + Q2S=MIN(Q1B,Q1C) +! J2S=0 + ELSEIF(Q2S.GT.MAX(Q1B,Q1C)) THEN + Q2S=MAX(Q1B,Q1C) +! J2S=0 + ENDIF + ENDIF + Q2(1+(I-1)*IXQ2+(K2-1)*KXQ2+(N-1)*NXQ2)=Q2S +! J2(1+(I-1)*IXQ2+(K2-1)*KXQ2+(N-1)*NXQ2)=J2S + ENDDO + ENDDO + ENDDO +!$OMP END PARALLEL DO + + END SUBROUTINE TERP3 + + SUBROUTINE RSEARCH(IM,KM1,IXZ1,KXZ1,Z1,KM2,IXZ2,KXZ2,Z2,IXL2,KXL2,L2) +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! +! SUBPROGRAM: RSEARCH SEARCH FOR A SURROUNDING REAL INTERVAL +! PRGMMR: IREDELL ORG: W/NMC23 DATE: 98-05-01 +! +! ABSTRACT: THIS SUBPROGRAM SEARCHES MONOTONIC SEQUENCES OF REAL NUMBERS +! FOR INTERVALS THAT SURROUND A GIVEN SEARCH SET OF REAL NUMBERS. +! THE SEQUENCES MAY BE MONOTONIC IN EITHER DIRECTION; THE REAL NUMBERS +! MAY BE SINGLE OR DOUBLE PRECISION; THE INPUT SEQUENCES AND SETS +! AND THE OUTPUT LOCATIONS MAY BE ARBITRARILY DIMENSIONED. +! +! PROGRAM HISTORY LOG: +! 1999-01-05 MARK IREDELL +! +! USAGE: CALL RSEARCH(IM,KM1,IXZ1,KXZ1,Z1,KM2,IXZ2,KXZ2,Z2,IXL2,KXL2, +! & L2) +! INPUT ARGUMENT LIST: +! IM INTEGER NUMBER OF SEQUENCES TO SEARCH +! KM1 INTEGER NUMBER OF POINTS IN EACH SEQUENCE +! IXZ1 INTEGER SEQUENCE SKIP NUMBER FOR Z1 +! KXZ1 INTEGER POINT SKIP NUMBER FOR Z1 +! Z1 REAL (1+(IM-1)*IXZ1+(KM1-1)*KXZ1) +! SEQUENCE VALUES TO SEARCH +! (Z1 MUST BE MONOTONIC IN EITHER DIRECTION) +! KM2 INTEGER NUMBER OF POINTS TO SEARCH FOR +! IN EACH RESPECTIVE SEQUENCE +! IXZ2 INTEGER SEQUENCE SKIP NUMBER FOR Z2 +! KXZ2 INTEGER POINT SKIP NUMBER FOR Z2 +! Z2 REAL (1+(IM-1)*IXZ2+(KM2-1)*KXZ2) +! SET OF VALUES TO SEARCH FOR +! (Z2 NEED NOT BE MONOTONIC) +! IXL2 INTEGER SEQUENCE SKIP NUMBER FOR L2 +! KXL2 INTEGER POINT SKIP NUMBER FOR L2 +! +! OUTPUT ARGUMENT LIST: +! L2 INTEGER (1+(IM-1)*IXL2+(KM2-1)*KXL2) +! INTERVAL LOCATIONS HAVING VALUES FROM 0 TO KM1 +! (Z2 WILL BE BETWEEN Z1(L2) AND Z1(L2+1)) +! +! REMARKS: +! IF THE ARRAY Z1 IS DIMENSIONED (IM,KM1), THEN THE SKIP NUMBERS ARE +! IXZ1=1 AND KXZ1=IM; IF IT IS DIMENSIONED (KM1,IM), THEN THE SKIP +! NUMBERS ARE IXZ1=KM1 AND KXZ1=1; IF IT IS DIMENSIONED (IM,JM,KM1), +! THEN THE SKIP NUMBERS ARE IXZ1=1 AND KXZ1=IM*JM; ETCETERA. +! SIMILAR EXAMPLES APPLY TO THE SKIP NUMBERS FOR Z2 AND L2. +! +! RETURNED VALUES OF 0 OR KM1 INDICATE THAT THE GIVEN SEARCH VALUE +! IS OUTSIDE THE RANGE OF THE SEQUENCE. +! +! IF A SEARCH VALUE IS IDENTICAL TO ONE OF THE SEQUENCE VALUES +! THEN THE LOCATION RETURNED POINTS TO THE IDENTICAL VALUE. +! IF THE SEQUENCE IS NOT STRICTLY MONOTONIC AND A SEARCH VALUE IS +! IDENTICAL TO MORE THAN ONE OF THE SEQUENCE VALUES, THEN THE +! LOCATION RETURNED MAY POINT TO ANY OF THE IDENTICAL VALUES. +! +! TO BE EXACT, FOR EACH I FROM 1 TO IM AND FOR EACH K FROM 1 TO KM2, +! Z=Z2(1+(I-1)*IXZ2+(K-1)*KXZ2) IS THE SEARCH VALUE AND +! L=L2(1+(I-1)*IXL2+(K-1)*KXL2) IS THE LOCATION RETURNED. +! IF L=0, THEN Z IS LESS THAN THE START POINT Z1(1+(I-1)*IXZ1) +! FOR ASCENDING SEQUENCES (OR GREATER THAN FOR DESCENDING SEQUENCES). +! IF L=KM1, THEN Z IS GREATER THAN OR EQUAL TO THE END POINT +! Z1(1+(I-1)*IXZ1+(KM1-1)*KXZ1) FOR ASCENDING SEQUENCES +! (OR LESS THAN OR EQUAL TO FOR DESCENDING SEQUENCES). +! OTHERWISE Z IS BETWEEN THE VALUES Z1(1+(I-1)*IXZ1+(L-1)*KXZ1) AND +! Z1(1+(I-1)*IXZ1+(L-0)*KXZ1) AND MAY EQUAL THE FORMER. +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN +! +! + IMPLICIT NONE + + INTEGER,INTENT(IN) :: IM,KM1,IXZ1,KXZ1,KM2,IXZ2,KXZ2,IXL2,KXL2 + INTEGER,INTENT(OUT) :: L2(1+(IM-1)*IXL2+(KM2-1)*KXL2) + + REAL(ESMF_KIND_R8),INTENT(IN) :: Z1(1+(IM-1)*IXZ1+(KM1-1)*KXZ1) + REAL(ESMF_KIND_R8),INTENT(IN) :: Z2(1+(IM-1)*IXZ2+(KM2-1)*KXZ2) + + INTEGER :: I,K2,L + + REAL(ESMF_KIND_R8) :: Z + +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! FIND THE SURROUNDING INPUT INTERVAL FOR EACH OUTPUT POINT. + DO I=1,IM + IF (Z1(1+(I-1)*IXZ1).LE.Z1(1+(I-1)*IXZ1+(KM1-1)*KXZ1)) THEN +! INPUT COORDINATE IS MONOTONICALLY ASCENDING. + DO K2=1,KM2 + Z=Z2(1+(I-1)*IXZ2+(K2-1)*KXZ2) + L=0 + DO + IF(Z.LT.Z1(1+(I-1)*IXZ1+L*KXZ1)) EXIT + L=L+1 + IF(L.EQ.KM1) EXIT + ENDDO + L2(1+(I-1)*IXL2+(K2-1)*KXL2)=L + ENDDO + ELSE +! INPUT COORDINATE IS MONOTONICALLY DESCENDING. + DO K2=1,KM2 + Z=Z2(1+(I-1)*IXZ2+(K2-1)*KXZ2) + L=0 + DO + IF(Z.GT.Z1(1+(I-1)*IXZ1+L*KXZ1)) EXIT + L=L+1 + IF(L.EQ.KM1) EXIT + ENDDO + L2(1+(I-1)*IXL2+(K2-1)*KXL2)=L + ENDDO + ENDIF + ENDDO + + END SUBROUTINE RSEARCH + + subroutine compute_zh + + implicit none + + integer :: i,ii, j,k, rc, clb(2), cub(2) + + real(esmf_kind_r8), allocatable :: pe0(:), pn0(:) + real(esmf_kind_r8), pointer :: psptr(:,:) + real(esmf_kind_r8), pointer :: zhsfcptr(:,:) + real(esmf_kind_r8), pointer :: zhptr(:,:,:) + real(esmf_kind_r8), pointer :: tptr(:,:,:) + real(esmf_kind_r8), pointer :: qptr(:,:,:) + real(esmf_kind_r8) :: ak, bk, zvir, grd + real(esmf_kind_r8), parameter :: grav = 9.80665 + real(esmf_kind_r8), parameter :: rdgas = 287.05 + real(esmf_kind_r8), parameter :: rvgas = 461.50 + + print*,"- COMPUTE HEIGHT" + + print*,"- CALL FieldGet FOR SURFACE PRESSURE" + call ESMF_FieldGet(ps_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TERRAIN HEIGHT" + call ESMF_FieldGet(terrain_target_grid, & + farrayPtr=zhsfcptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR HEIGHT" + call ESMF_FieldGet(zh_target_grid, & + farrayPtr=zhptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TEMPERATURE" + call ESMF_FieldGet(temp_target_grid, & + farrayPtr=tptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do ii = 1, num_tracers + if (trim(tracers(ii)) == "sphum") exit + enddo + + print*,"- CALL FieldGet FOR SPECIFIC HUMIDITY" + call ESMF_FieldGet(tracers_target_grid(ii), & + farrayPtr=qptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + grd = grav/rdgas + zvir = rvgas/rdgas - 1.0_esmf_kind_r8 + + allocate(pe0(levp1_target)) + allocate(pn0(levp1_target)) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + + do k = 1, levp1_target + ak = vcoord_target(k,1) + ak = max(ak, 1.e-9) + bk = vcoord_target(k,2) + + pe0(k) = ak + bk*psptr(i,j) + pn0(k) = log(pe0(k)) + enddo + + zhptr(i,j,1) = zhsfcptr(i,j) + + do k = 2, levp1_target + zhptr(i,j,k) = zhptr(i,j,k-1)+tptr(i,j,k-1)*(1.+zvir*qptr(i,j,k-1))* & + (pn0(k-1)-pn0(k))/grd + enddo + + enddo + enddo + + deallocate(pe0, pn0) + + end subroutine compute_zh + + subroutine cleanup_target_atm_b4adj_data + + implicit none + + integer :: i, rc + + print*,"- DESTROY TARGET GRID ATMOSPHERIC BEFORE ADJUSTMENT FIELDS." + + call ESMF_FieldDestroy(wind_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(dzdt_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(ps_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(pres_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(temp_b4adj_target_grid, rc=rc) + call ESMF_FieldDestroy(terrain_interp_to_target_grid, rc=rc) + + do i = 1, num_tracers + call ESMF_FieldDestroy(tracers_b4adj_target_grid(i), rc=rc) + enddo + + deallocate(tracers_b4adj_target_grid) + + end subroutine cleanup_target_atm_b4adj_data + + subroutine cleanup_target_atm_data + + implicit none + + integer :: i, rc + + print*,"- DESTROY TARGET GRID ATMOSPHERIC FIELDS." + + call ESMF_FieldDestroy(delp_target_grid, rc=rc) + call ESMF_FieldDestroy(dzdt_target_grid, rc=rc) + call ESMF_FieldDestroy(ps_target_grid, rc=rc) + call ESMF_FieldDestroy(pres_target_grid, rc=rc) + call ESMF_FieldDestroy(temp_target_grid, rc=rc) + call ESMF_FieldDestroy(u_s_target_grid, rc=rc) + call ESMF_FieldDestroy(v_s_target_grid, rc=rc) + call ESMF_FieldDestroy(wind_target_grid, rc=rc) + call ESMF_FieldDestroy(wind_s_target_grid, rc=rc) + call ESMF_FieldDestroy(wind_w_target_grid, rc=rc) + call ESMF_FieldDestroy(u_w_target_grid, rc=rc) + call ESMF_FieldDestroy(v_w_target_grid, rc=rc) + call ESMF_FieldDestroy(zh_target_grid, rc=rc) + + do i = 1, num_tracers + call ESMF_FieldDestroy(tracers_target_grid(i), rc=rc) + enddo + + deallocate(tracers_target_grid) + + end subroutine cleanup_target_atm_data + + end module atmosphere diff --git a/sorc/chgres_cube.fd/sorc/chgres.F90 b/sorc/chgres_cube.fd/sorc/chgres.F90 new file mode 100644 index 0000000000..2b160b32a3 --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/chgres.F90 @@ -0,0 +1,101 @@ + program chgres + +!------------------------------------------------------------------------- +! Program CHGRES +! +! Abstract: Initialize an FV3 run using history or restart data from +! another FV3 run, or the NEMS version of the spectral GFS. +! Converts atmospheric, surface and nst data. +! +!------------------------------------------------------------------------- + + use esmf + + use atmosphere, only : atmosphere_driver + + use program_setup, only : read_setup_namelist, & + convert_atm, & + convert_sfc + + use model_grid, only : define_target_grid, & + define_input_grid, & + cleanup_input_target_grid_data + + use surface, only : surface_driver + + implicit none + + integer :: ierr, localpet, npets + + type(esmf_vm) :: vm + +!------------------------------------------------------------------------- +! Initialize mpi and esmf environment. +!------------------------------------------------------------------------- + + include 'mpif.h' + + call mpi_init(ierr) + + print*,"- INITIALIZE ESMF" + call ESMF_Initialize(rc=ierr) + if(ESMF_logFoundError(rcToCheck=ierr,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("INITIALIZING ESMF", ierr) + + print*,"- CALL VMGetGlobal" + call ESMF_VMGetGlobal(vm, rc=ierr) + if(ESMF_logFoundError(rcToCheck=ierr,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN VMGetGlobal", ierr) + + print*,"- CALL VMGet" + call ESMF_VMGet(vm, localPet=localpet, petCount=npets, rc=ierr) + if(ESMF_logFoundError(rcToCheck=ierr,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN VMGet", ierr) + + print*,'- NPETS IS ',npets + print*,'- LOCAL PET ',localpet + +!------------------------------------------------------------------------- +! Read program configuration namelist. +!------------------------------------------------------------------------- + + call read_setup_namelist + +!------------------------------------------------------------------------- +! Create esmf grid objects for input and target grids. +!------------------------------------------------------------------------- + + call define_input_grid(localpet, npets) + + call define_target_grid(localpet, npets) + +!------------------------------------------------------------------------- +! Convert atmospheric fields +!------------------------------------------------------------------------- + + if (convert_atm) then + + call atmosphere_driver(localpet) + + end if + +!------------------------------------------------------------------------- +! Convert surface/nsst fields +!------------------------------------------------------------------------- + + if (convert_sfc) then + + call surface_driver(localpet) + + end if + + call cleanup_input_target_grid_data + + print*,"- CALL ESMF_finalize" + call ESMF_finalize(endflag=ESMF_END_KEEPMPI, rc=ierr) + + call mpi_finalize(ierr) + + print*,"- DONE." + + end program chgres diff --git a/sorc/chgres_cube.fd/sorc/input_data.F90 b/sorc/chgres_cube.fd/sorc/input_data.F90 new file mode 100644 index 0000000000..2725e5560e --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/input_data.F90 @@ -0,0 +1,4486 @@ + module input_data + +!-------------------------------------------------------------------------- +! Module input_data +! +! Abstract: Read atmospheric, surface and nst data on the input grid. +! Supported formats include fv3 tiled 'restart' files, fv3 tiled +! 'history' files, fv3 gaussian history files, spectral gfs +! gaussian nemsio files, and spectral gfs sigio/sfcio files. +! +! Public Subroutines: +! ----------------- +! read_input_atm_data Driver routine to read atmospheric data +! cleanup_input_atm_data Free up memory associated with atm data +! read_input_sfc_data Driver routine to read surface data +! cleanup_input_sfc_data Free up memory associated with sfc data +! read_input_nst_data Driver routine to read nst data +! cleanup_input_nst_data Free up memory associated with nst data +! +! Public variables: +! ----------------- +! Defined below. "input" indicates field associated with the input grid. +! +!-------------------------------------------------------------------------- + + use esmf + use netcdf + use nemsio_module + + use program_setup, only : data_dir_input_grid, & + nst_files_input_grid, & + sfc_files_input_grid, & + atm_files_input_grid, & + atm_core_files_input_grid, & + atm_tracer_files_input_grid, & + convert_nst, & + orog_dir_input_grid, & + orog_files_input_grid, & + tracers_input, num_tracers, & + input_type + + use model_grid, only : input_grid, & + i_input, j_input, & + ip1_input, jp1_input, & + num_tiles_input_grid, & + latitude_input_grid, & + longitude_input_grid + + implicit none + + private + +! Fields associated with the atmospheric model. + + type(esmf_field), public :: dzdt_input_grid ! vert velocity + type(esmf_field) :: dpres_input_grid ! pressure thickness + type(esmf_field), public :: pres_input_grid ! 3-d pressure + type(esmf_field), public :: ps_input_grid ! surface pressure + type(esmf_field), public :: terrain_input_grid ! terrain height + type(esmf_field), public :: temp_input_grid ! temperature + type(esmf_field) :: u_input_grid ! u/v wind at grid + type(esmf_field) :: v_input_grid ! box center + type(esmf_field), public :: wind_input_grid ! 3-component wind + type(esmf_field), allocatable, public :: tracers_input_grid(:) ! tracers + + integer, public :: lev_input ! # of atmospheric layers + integer, public :: levp1_input ! # of atmos layer interfaces + +! Fields associated with the land-surface model. + + integer, public :: veg_type_landice_input = 15 ! NOAH land ice option + ! defined at this veg type. + ! Default is igbp. + + type(esmf_field), public :: canopy_mc_input_grid ! canopy moist content + type(esmf_field), public :: f10m_input_grid ! log((z0+10)*1/z0) + type(esmf_field), public :: ffmm_input_grid ! log((z0+z1)*1/z0) + ! See sfc_diff.f for details. + type(esmf_field), public :: landsea_mask_input_grid ! land sea mask; + ! 0-water, 1-land, 2-ice + type(esmf_field), public :: q2m_input_grid ! 2-m spec hum + type(esmf_field), public :: seaice_depth_input_grid ! sea ice depth + type(esmf_field), public :: seaice_fract_input_grid ! sea ice fraction + type(esmf_field), public :: seaice_skin_temp_input_grid ! sea ice skin temp + type(esmf_field), public :: skin_temp_input_grid ! skin temp/sst + type(esmf_field), public :: snow_depth_input_grid ! snow dpeth + type(esmf_field), public :: snow_liq_equiv_input_grid ! snow liq equiv depth + type(esmf_field), public :: soil_temp_input_grid ! 3-d soil temp + type(esmf_field), public :: soil_type_input_grid ! soil type + type(esmf_field), public :: soilm_liq_input_grid ! 3-d liquid soil moisture + type(esmf_field), public :: soilm_tot_input_grid ! 3-d total soil moisture + type(esmf_field), public :: srflag_input_grid ! snow/rain flag + type(esmf_field), public :: t2m_input_grid ! 2-m temperature + type(esmf_field), public :: tprcp_input_grid ! precip + type(esmf_field), public :: ustar_input_grid ! fric velocity + type(esmf_field), public :: veg_type_input_grid ! vegetation type + type(esmf_field), public :: z0_input_grid ! roughness length + + integer, parameter, public :: lsoil_input=4 ! # of soil layers, + ! # hardwire for now + +! Fields associated with the nst model. + + type(esmf_field), public :: c_d_input_grid + type(esmf_field), public :: c_0_input_grid + type(esmf_field), public :: d_conv_input_grid + type(esmf_field), public :: dt_cool_input_grid + type(esmf_field), public :: ifd_input_grid + type(esmf_field), public :: qrain_input_grid + type(esmf_field), public :: tref_input_grid ! reference temperature + type(esmf_field), public :: w_d_input_grid + type(esmf_field), public :: w_0_input_grid + type(esmf_field), public :: xs_input_grid + type(esmf_field), public :: xt_input_grid + type(esmf_field), public :: xu_input_grid + type(esmf_field), public :: xv_input_grid + type(esmf_field), public :: xz_input_grid + type(esmf_field), public :: xtts_input_grid + type(esmf_field), public :: xzts_input_grid + type(esmf_field), public :: z_c_input_grid + type(esmf_field), public :: zm_input_grid + + public :: read_input_atm_data + public :: cleanup_input_atm_data + public :: read_input_sfc_data + public :: cleanup_input_sfc_data + public :: read_input_nst_data + public :: cleanup_input_nst_data + + contains + +!--------------------------------------------------------------------------- +! Read input grid atmospheric data driver +!--------------------------------------------------------------------------- + + subroutine read_input_atm_data(localpet) + + implicit none + + integer, intent(in) :: localpet + + if (trim(input_type) == "restart") then + call read_input_atm_restart_file(localpet) + elseif (trim(input_type) == "history") then + call read_input_atm_history_file(localpet) + elseif (trim(input_type) == "gaussian") then ! fv3gfs gaussian nemsio + call read_input_atm_gaussian_file(localpet) + elseif (trim(input_type) == "gfs_gaussian") then ! spectral gfs gaussian + ! nemsio. + call read_input_atm_gfs_gaussian_file(localpet) + elseif (trim(input_type) == "gfs_spectral") then ! spectral gfs sigio format. + call read_input_atm_gfs_spectral_file(localpet) + endif + + end subroutine read_input_atm_data + +!--------------------------------------------------------------------------- +! Read input grid nst data driver +!--------------------------------------------------------------------------- + + subroutine read_input_nst_data(localpet) + + implicit none + + integer, intent(in) :: localpet + + integer :: rc + + print*,"- READ INPUT GRID NST DATA." + + print*,"- CALL FieldCreate FOR INPUT GRID C_D." + c_d_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID C_0." + c_0_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID D_CONV." + d_conv_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID DT_COOL." + dt_cool_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID IFD." + ifd_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID QRAIN." + qrain_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TREF." + tref_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID W_D." + w_d_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID W_0." + w_0_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XS." + xs_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XT." + xt_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XU." + xu_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XV." + xv_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XZ." + xz_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XTTS." + xtts_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID XZTS." + xzts_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID Z_C." + z_c_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID ZM." + zm_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + if (trim(input_type) == "gaussian" .or. trim(input_type) == "gfs_gaussian") then + call read_input_nst_gaussian_file(localpet) + else + call read_input_nst_tile_file(localpet) + endif + + end subroutine read_input_nst_data + +!--------------------------------------------------------------------------- +! Read input grid surface data driver. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_data(localpet) + + implicit none + + integer, intent(in) :: localpet + + integer :: rc + + print*,"- CALL FieldCreate FOR INPUT GRID LANDSEA MASK." + landsea_mask_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID Z0." + z0_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID VEGETATION TYPE." + veg_type_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID CANOPY MOISTURE CONTENT." + canopy_mc_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SEAICE FRACTION." + seaice_fract_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SEAICE DEPTH." + seaice_depth_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SEAICE SKIN TEMPERATURE." + seaice_skin_temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SNOW DEPTH." + snow_depth_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SNOW LIQUID EQUIVALENT." + snow_liq_equiv_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID T2M." + t2m_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID Q2M." + q2m_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TPRCP." + tprcp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID F10M." + f10m_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID USTAR." + ustar_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID FFMM." + ffmm_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SRFLAG." + srflag_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT SKIN TEMPERATURE." + skin_temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT SOIL TYPE." + soil_type_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT TERRAIN." + terrain_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT SOIL TEMPERATURE." + soil_temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT TOTAL SOIL MOISTURE." + soilm_tot_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT LIQUID SOIL MOISTURE." + soilm_liq_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + if (trim(input_type) == "restart") then + call read_input_sfc_restart_file(localpet) + elseif (trim(input_type) == "history") then + call read_input_sfc_history_file(localpet) + elseif (trim(input_type) == "gaussian") then + call read_input_sfc_gaussian_file(localpet) + elseif (trim(input_type) == "gfs_gaussian") then + call read_input_sfc_gfs_gaussian_file(localpet) + elseif (trim(input_type) == "gfs_spectral") then + call read_input_sfc_gfs_sfcio_file(localpet) + endif + + end subroutine read_input_sfc_data + +!--------------------------------------------------------------------------- +! Read input atmospheric data from spectral gfs (old sigio format). +! Used prior to July 19, 2017. +!--------------------------------------------------------------------------- + + subroutine read_input_atm_gfs_spectral_file(localpet) + + use sigio_module + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + + integer(sigio_intkind) :: iret + integer :: rc, i, j, k + integer :: clb(3), cub(3) + + real(esmf_kind_r8) :: ak, bk + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + real(esmf_kind_r8), allocatable :: dummy3d2(:,:,:) + real(esmf_kind_r8), pointer :: pptr(:,:,:), psptr(:,:) + real(esmf_kind_r8), allocatable :: pi(:,:,:) + + type(sigio_head) :: sighead + type(sigio_dbta) :: sigdata + + the_file = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1)) + + print*,"- ATMOSPHERIC DATA IN SIGIO FORMAT." + print*,"- OPEN AND READ: ", trim(the_file) + + call sigio_sropen(21, trim(the_file), iret) + if (iret /= 0) then + rc = iret + call error_handler("OPENING SPECTRAL GFS SIGIO FILE.", rc) + endif + call sigio_srhead(21, sighead, iret) + if (iret /= 0) then + rc = iret + call error_handler("READING SPECTRAL GFS SIGIO FILE.", rc) + endif + + lev_input = sighead%levs + levp1_input = lev_input + 1 + + if (num_tracers /= sighead%ntrac) then + call error_handler("WRONG NUMBER OF TRACERS EXPECTED.", 99) + endif + + if (sighead%idvt == 0 .or. sighead%idvt == 21) then + if (trim(tracers_input(1)) /= 'spfh' .or. & + trim(tracers_input(2)) /= 'o3mr' .or. & + trim(tracers_input(3)) /= 'clwmr') then + call error_handler("TRACERS SELECTED DO NOT MATCH FILE CONTENTS.", 99) + endif + else + print*,'- UNRECOGNIZED IDVT: ', sighead%idvt + call error_handler("UNRECOGNIZED IDVT", 99) + endif + + print*,"- CALL FieldCreate FOR INPUT GRID SURFACE PRESSURE." + ps_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TERRAIN." + terrain_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TEMPERATURE." + temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + allocate(tracers_input_grid(num_tracers)) + + do i = 1, num_tracers + print*,"- CALL FieldCreate FOR INPUT GRID TRACER ", trim(tracers_input(i)) + tracers_input_grid(i) = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + enddo + + print*,"- CALL FieldCreate FOR INPUT GRID DZDT." + dzdt_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID U." + u_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID V." + v_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + if (localpet == 0) then + allocate(dummy2d(i_input,j_input)) + allocate(dummy3d(i_input,j_input,lev_input)) + allocate(dummy3d2(i_input,j_input,lev_input)) + else + allocate(dummy2d(0,0)) + allocate(dummy3d(0,0,0)) + allocate(dummy3d2(0,0,0)) + endif + + if (localpet == 0) then + call sigio_aldbta(sighead, sigdata, iret) + if (iret /= 0) then + rc = iret + call error_handler("ALLOCATING SIGDATA.", rc) + endif + call sigio_srdbta(21, sighead, sigdata, iret) + if (iret /= 0) then + rc = iret + call error_handler("READING SIGDATA.", rc) + endif + call sptez(0,sighead%jcap,4,i_input, j_input, sigdata%ps, dummy2d, 1) + dummy2d = exp(dummy2d) * 1000.0 + print*,'surface pres ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR SURFACE PRESSURE." + call ESMF_FieldScatter(ps_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call sptez(0,sighead%jcap,4,i_input, j_input, sigdata%hs, dummy2d, 1) + print*,'terrain ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + do k = 1, num_tracers + + if (localpet == 0) then + call sptezm(0,sighead%jcap,4,i_input, j_input, lev_input, sigdata%q(:,:,k), dummy3d, 1) + print*,trim(tracers_input(k)),maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(k)) + call ESMF_FieldScatter(tracers_input_grid(k), dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + if (localpet == 0) then + call sptezm(0,sighead%jcap,4,i_input, j_input, lev_input, sigdata%t, dummy3d, 1) + print*,'temp ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." + call ESMF_FieldScatter(temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +!--------------------------------------------------------------------------- +! The spectral gfs files have omega, not vertical velocity. Set to +! zero for now. Convert from omega to vv in the future? +!--------------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- NO VERTICAL VELOCITY RECORD. SET TO ZERO." + dummy3d = 0.0 + endif + + print*,"- CALL FieldScatter FOR INPUT DZDT." + call ESMF_FieldScatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call sptezmv(0, sighead%jcap, 4, i_input, j_input, lev_input, sigdata%d, sigdata%z, dummy3d, dummy3d2, 1) + print*,'u ',maxval(dummy3d),minval(dummy3d) + print*,'v ',maxval(dummy3d2),minval(dummy3d2) + endif + + print*,"- CALL FieldScatter FOR INPUT U-WIND." + call ESMF_FieldScatter(u_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldScatter FOR INPUT V-WIND." + call ESMF_FieldScatter(v_input_grid, dummy3d2, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy2d, dummy3d, dummy3d2) + + if (localpet == 0) call sigio_axdbta(sigdata, iret) + + call sigio_sclose(21, iret) + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d component winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Compute 3-d pressure from 'ak' and 'bk'. +!--------------------------------------------------------------------------- + + print*,"- COMPUTE 3-D PRESSURE." + + print*,"- CALL FieldCreate FOR INPUT GRID PRESSURE." + pres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + + print*,"- CALL FieldGet FOR 3-D PRES." + nullify(pptr) + call ESMF_FieldGet(pres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=pptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE." + nullify(psptr) + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + +!--------------------------------------------------------------------------- +! First, compute interface pressure. +!--------------------------------------------------------------------------- + + allocate(pi(clb(1):cub(1),clb(2):cub(2),1:levp1_input),stat=rc) + + do k=1,levp1_input + ak = sighead%vcoord(k,1) + bk = sighead%vcoord(k,2) + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pi(i,j,k) = ak + bk*psptr(i,j) + enddo + enddo + enddo + + if (localpet == 0) then + print*,'pres int ',psptr(clb(1),clb(2)),pi(clb(1),clb(2),:) + endif + +!--------------------------------------------------------------------------- +! Now comput mid-layer pressure from interface pressure. +!--------------------------------------------------------------------------- + + do k=1,lev_input + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pptr(i,j,k) = (pi(i,j,k)+pi(i,j,k+1))/2.0_esmf_kind_r8 + enddo + enddo + enddo + + deallocate(pi) + + if (localpet == 0) then + print*,'pres ',psptr(clb(1),clb(2)),pptr(clb(1),clb(2),:) + endif + + end subroutine read_input_atm_gfs_spectral_file + +!--------------------------------------------------------------------------- +! Read input atmospheric data from spectral gfs (global gaussian in +! nemsio format. Starting July 19, 2017). +!--------------------------------------------------------------------------- + + subroutine read_input_atm_gfs_gaussian_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + character(len=20) :: vlevtyp, vname + + integer(nemsio_intkind) :: vlev, iret + integer :: i, j, k, n, rc + integer :: clb(3), cub(3) + + real(nemsio_realkind), allocatable :: vcoord(:,:,:) + real(nemsio_realkind), allocatable :: dummy(:) + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + real(esmf_kind_r8) :: ak, bk + real(esmf_kind_r8), allocatable :: pi(:,:,:) + real(esmf_kind_r8), pointer :: pptr(:,:,:), psptr(:,:) + + type(nemsio_gfile) :: gfile + + the_file = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1)) + + print*,"- READ ATMOS DATA FROM SPECTRAL GFS NEMSIO FILE: ", trim(the_file) + + print*,"- OPEN FILE." + call nemsio_open(gfile, the_file, "read", iret=iret) + if (iret /= 0) call error_handler("OPENING SPECTRAL GFS NEMSIO ATM FILE.", iret) + + print*,"- READ NUMBER OF VERTICAL LEVELS." + call nemsio_getfilehead(gfile, iret=iret, dimz=lev_input) + if (iret /= 0) call error_handler("READING NUMBER OF VERTICAL LEVLES.", iret) + + levp1_input = lev_input + 1 + + allocate(vcoord(levp1_input,3,2)) + + print*,"- READ VERTICAL COORDINATE INFO." + call nemsio_getfilehead(gfile, iret=iret, vcoord=vcoord) + if (iret /= 0) call error_handler("READING VERTICAL COORDINATE INFO.", iret) + + print*,"- CALL FieldCreate FOR INPUT GRID SURFACE PRESSURE." + ps_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TEMPERATURE." + temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + allocate(tracers_input_grid(num_tracers)) + + do i = 1, num_tracers + print*,"- CALL FieldCreate FOR INPUT GRID TRACER ", trim(tracers_input(i)) + tracers_input_grid(i) = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + enddo + + print*,"- CALL FieldCreate FOR INPUT GRID U." + u_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID V." + v_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID DZDT." + dzdt_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TERRAIN." + terrain_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + if (localpet == 0) then + allocate(dummy(i_input*j_input)) + allocate(dummy2d(i_input,j_input)) + allocate(dummy3d(i_input,j_input,lev_input)) + else + allocate(dummy(0)) + allocate(dummy2d(0,0)) + allocate(dummy3d(0,0,0)) + endif + +!----------------------------------------------------------------------- +! 3-d fields in gaussian files increment from bottom to model top. +! That is what is expected by this program, so no need to flip indices. +!----------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- READ TEMPERATURE." + vname = "tmp" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING TEMPERATURE RECORD.", iret) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) +! print*,'temp check after read ',vlev, dummy3d(1,1,vlev) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." + call ESMF_FieldScatter(temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + do n = 1, num_tracers + + if (localpet == 0) then + print*,"- READ ", trim(tracers_input(n)) + vname = trim(tracers_input(n)) + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING TRACER RECORD.", iret) +! print*,'tracer ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(n)) + call ESMF_FieldScatter(tracers_input_grid(n), dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + if (localpet == 0) then + print*,"- READ U-WINDS." + vname = "ugrd" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING U-WIND RECORD.", iret) +! print*,'ugrd ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT U-WIND." + call ESMF_FieldScatter(u_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ V-WINDS." + vname = "vgrd" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING V-WIND RECORD.", iret) +! print*,'vgrd ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT V-WIND." + call ESMF_FieldScatter(v_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +!--------------------------------------------------------------------------- +! The spectral gfs nemsio files do not have a vertical velocity or +! omega record. So set to zero for now. +!--------------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- NO VERTICAL VELOCITY RECORD. SET TO ZERO." + dummy3d = 0.0 + endif + + print*,"- CALL FieldScatter FOR INPUT DZDT." + call ESMF_FieldScatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ HGT." + vname = "hgt" + vlevtyp = "sfc" + vlev = 1 + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING HGT RECORD.", iret) +! print*,'hgt ',vlev, maxval(dummy),minval(dummy) + dummy2d = reshape(dummy, (/i_input,j_input/)) + endif + + print*,"- CALL FieldScatter FOR TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ PRES." + vname = "pres" + vlevtyp = "sfc" + vlev = 1 + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING PRES RECORD.", iret) +! print*,'pres ',vlev, maxval(dummy),minval(dummy) + dummy2d = reshape(dummy, (/i_input,j_input/)) + endif + + print*,"- CALL FieldScatter FOR SURFACE PRESSURE." + call ESMF_FieldScatter(ps_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + call nemsio_close(gfile) + + deallocate(dummy, dummy2d, dummy3d) + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d component winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Compute 3-d pressure from 'ak' and 'bk'. +!--------------------------------------------------------------------------- + + print*,"- COMPUTE 3-D PRESSURE." + + print*,"- CALL FieldCreate FOR INPUT GRID PRESSURE." + pres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + + print*,"- CALL FieldGet FOR 3-D PRES." + nullify(pptr) + call ESMF_FieldGet(pres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=pptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE." + nullify(psptr) + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + +!--------------------------------------------------------------------------- +! First, compute interface pressure. +!--------------------------------------------------------------------------- + + allocate(pi(clb(1):cub(1),clb(2):cub(2),1:levp1_input)) + + do k=1,levp1_input + ak = vcoord(k,1,1) + bk = vcoord(k,2,1) + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pi(i,j,k) = ak + bk*psptr(i,j) + enddo + enddo + enddo + + deallocate(vcoord) + +!--------------------------------------------------------------------------- +! Now comput mid-layer pressure from interface pressure. +!--------------------------------------------------------------------------- + + do k=1,lev_input + do i= clb(1), cub(1) + do j= clb(2), cub(2) + pptr(i,j,k) = (pi(i,j,k)+pi(i,j,k+1))/2.0 + enddo + enddo + enddo + + deallocate(pi) + + end subroutine read_input_atm_gfs_gaussian_file + +!--------------------------------------------------------------------------- +! Read input grid atmospheric fv3 gaussian history files (nemsio format). +!--------------------------------------------------------------------------- + + subroutine read_input_atm_gaussian_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + character(len=20) :: vlevtyp, vname + + integer :: i, j, k, n + integer :: rc, clb(3), cub(3) + integer(nemsio_intkind) :: vlev, iret + + real(nemsio_realkind), allocatable :: vcoord(:,:,:) + real(nemsio_realkind), allocatable :: dummy(:) + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + real(esmf_kind_r8), pointer :: presptr(:,:,:), psptr(:,:) + real(esmf_kind_r8), pointer :: dpresptr(:,:,:) + real(esmf_kind_r8), allocatable :: pres_interface(:) + + type(nemsio_gfile) :: gfile + + the_file = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1)) + + print*,"- READ ATMOS DATA FROM GAUSSIAN NEMSIO FILE: ", trim(the_file) + + print*,"- OPEN FILE." + call nemsio_open(gfile, the_file, "read", iret=iret) + if (iret /= 0) call error_handler("OPENING GAUSSIAN NEMSIO ATM FILE.", iret) + + print*,"- READ NUMBER OF VERTICAL LEVELS." + call nemsio_getfilehead(gfile, iret=iret, dimz=lev_input) + if (iret /= 0) call error_handler("READING NUMBER OF VERTICAL LEVLES.", iret) + + levp1_input = lev_input + 1 + + allocate(vcoord(levp1_input,3,2)) + + print*,"- READ VERTICAL COORDINATE INFO." + call nemsio_getfilehead(gfile, iret=iret, vcoord=vcoord) + if (iret /= 0) call error_handler("READING VERTICAL COORDINATE INFO.", iret) + + print*,"- CALL FieldCreate FOR INPUT GRID SURFACE PRESSURE." + ps_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TEMPERATURE." + temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + allocate(tracers_input_grid(num_tracers)) + + do i = 1, num_tracers + print*,"- CALL FieldCreate FOR INPUT GRID TRACER ", trim(tracers_input(i)) + tracers_input_grid(i) = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + enddo + + print*,"- CALL FieldCreate FOR INPUT GRID U." + u_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID V." + v_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT DPRES." + dpres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID DZDT." + dzdt_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TERRAIN." + terrain_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + if (localpet == 0) then + allocate(dummy(i_input*j_input)) + allocate(dummy2d(i_input,j_input)) + allocate(dummy3d(i_input,j_input,lev_input)) + else + allocate(dummy(0)) + allocate(dummy2d(0,0)) + allocate(dummy3d(0,0,0)) + endif + +!----------------------------------------------------------------------- +! 3-d fields in gaussian files increment from bottom to model top. +! That is what is expected by this program, so no need to flip indices. +!----------------------------------------------------------------------- + + if (localpet == 0) then + print*,"- READ TEMPERATURE." + vname = "tmp" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING TEMPERATURE RECORD.", iret) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + print*,'temp check after read ',vlev, dummy3d(1,1,vlev) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." + call ESMF_FieldScatter(temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + do n = 1, num_tracers + + if (localpet == 0) then + print*,"- READ ", trim(tracers_input(n)) + vname = trim(tracers_input(n)) + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING TRACER RECORD.", iret) + print*,'tracer ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(n)) + call ESMF_FieldScatter(tracers_input_grid(n), dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + if (localpet == 0) then + print*,"- READ U-WINDS." + vname = "ugrd" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING U-WIND RECORD.", iret) + print*,'ugrd ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT U-WIND." + call ESMF_FieldScatter(u_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ V-WINDS." + vname = "vgrd" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING V-WIND RECORD.", iret) + print*,'vgrd ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT V-WIND." + call ESMF_FieldScatter(v_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ DPRES." + vname = "dpres" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING DPRES RECORD.", iret) + print*,'dpres ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT DPRES." + call ESMF_FieldScatter(dpres_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ DZDT." + vname = "dzdt" + vlevtyp = "mid layer" + do vlev = 1, lev_input + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING DZDT RECORD.", iret) + print*,'dzdt ',vlev, maxval(dummy),minval(dummy) + dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/)) + enddo + endif + + print*,"- CALL FieldScatter FOR INPUT DZDT." + call ESMF_FieldScatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ HGT." + vname = "hgt" + vlevtyp = "sfc" + vlev = 1 + call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret) + if (iret /= 0) call error_handler("READING HGT RECORD.", iret) + print*,'hgt ',vlev, maxval(dummy),minval(dummy) + dummy2d = reshape(dummy, (/i_input,j_input/)) + endif + + print*,"- CALL FieldScatter FOR TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + call nemsio_close(gfile) + + deallocate(dummy, dummy2d, dummy3d) + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d component winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Compute 3-d pressure. Mid-layer and surface pressure are computed +! from delta p. The surface pressure in the file is not used. After +! the model's write component interpolates from the cubed-sphere grid +! to the gaussian grid, the surface pressure is no longer consistent +! with the delta p (per Jun Wang). +!--------------------------------------------------------------------------- + + print*,"- COMPUTE 3-D PRESSURE." + + print*,"- CALL FieldCreate FOR INPUT GRID PRESSURE." + pres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldGet FOR DELTA PRESSURE." + nullify(dpresptr) + call ESMF_FieldGet(dpres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=dpresptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR 3-D PRESSURE." + nullify(presptr) + call ESMF_FieldGet(pres_input_grid, & + farrayPtr=presptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE." + nullify(psptr) + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + allocate(pres_interface(levp1_input)) + + if (localpet == 0) then + do k = clb(3), cub(3) + print*,'dpres is ',cub(1),cub(2),k, dpresptr(cub(1),cub(2),k) + enddo + endif + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + pres_interface(levp1_input) = vcoord(levp1_input,1,1) + do k = lev_input, 1, -1 + pres_interface(k) = pres_interface(k+1) + dpresptr(i,j,k) + enddo + psptr(i,j) = pres_interface(1) + do k = 1, lev_input + presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8 + enddo + enddo + enddo + + deallocate(vcoord) + + if (localpet == 0) then + print*,'psfc is ',clb(1),clb(2),psptr(clb(1),clb(2)) + print*,'pres is ',clb(1),clb(2),presptr(clb(1),clb(2),:) + endif + + print*,'pres check 1',localpet,maxval(presptr(:,:,1)),minval(presptr(:,:,1)) + print*,'pres check lev',localpet,maxval(presptr(:,:,lev_input)),minval(presptr(:,:,lev_input)) + + deallocate(pres_interface) + + call ESMF_FieldDestroy(dpres_input_grid, rc=rc) + + end subroutine read_input_atm_gaussian_file + +!--------------------------------------------------------------------------- +! Read input grid fv3 atmospheric data restart files. +! +! Routine reads tiled files in parallel. Tile 1 is read by +! localpet 0; tile 2 by localpet 1, etc. The number of pets +! must be equal to or greater than the number of tiled files. +! Logic only tested with global input data of six tiles. +!--------------------------------------------------------------------------- + + subroutine read_input_atm_restart_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=500) :: tilefile + + integer :: i, j, k + integer :: clb(3), cub(3) + integer :: rc, tile, ncid, id_var + integer :: error, id_dim + + real(esmf_kind_r8), allocatable :: ak(:) + real(esmf_kind_r8), pointer :: presptr(:,:,:), psptr(:,:) + real(esmf_kind_r8), pointer :: dpresptr(:,:,:) + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + real(esmf_kind_r8), allocatable :: pres_interface(:) + +!--------------------------------------------------------------------------- +! Get number of vertical levels and model top pressure. +!--------------------------------------------------------------------------- + + tilefile = trim(data_dir_input_grid) // "/" // trim(atm_core_files_input_grid(7)) + print*,"- READ ATM VERTICAL LEVELS FROM: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + + error=nf90_inq_dimid(ncid, 'xaxis_1', id_dim) + call netcdf_err(error, 'reading xaxis_1 id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=levp1_input) + call netcdf_err(error, 'reading xaxis_1 value' ) + + lev_input = levp1_input - 1 + + allocate(ak(levp1_input)) + + error=nf90_inq_varid(ncid, 'ak', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, ak) + call netcdf_err(error, 'reading ak' ) + + error = nf90_close(ncid) + + print*,"- CALL FieldCreate FOR INPUT GRID U." + u_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID V." + v_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID DZDT." + dzdt_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TEMPERATURE." + temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID DELTA PRESSURE." + dpres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TERRAIN." + terrain_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + allocate(tracers_input_grid(num_tracers)) + + do i = 1, num_tracers + + print*,"- CALL FieldCreate FOR INPUT GRID TRACER ", trim(tracers_input(i)) + tracers_input_grid(i) = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + enddo + + if (localpet < num_tiles_input_grid) then + allocate(data_one_tile_3d(i_input,j_input,lev_input)) + allocate(data_one_tile(i_input,j_input)) + else + allocate(data_one_tile_3d(0,0,0)) + allocate(data_one_tile(0,0)) + endif + + if (localpet < num_tiles_input_grid) then + tile = localpet+1 + tilefile= trim(data_dir_input_grid) // "/" // trim(atm_core_files_input_grid(tile)) + print*,"- READ ATMOSPHERIC CORE FILE: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + endif + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, 'phis', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile) + call netcdf_err(error, 'reading field' ) + data_one_tile = data_one_tile / 9.806_8 ! geopotential height + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID TERRAIN for tile ",tile + call ESMF_FieldScatter(terrain_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, 'W', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID VERTICAL VELOCITY for tile ",tile + call ESMF_FieldScatter(dzdt_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, 'T', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." + call ESMF_FieldScatter(temp_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, 'delp', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT DELTA PRESSURE." + call ESMF_FieldScatter(dpres_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, 'ua', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID U." + call ESMF_FieldScatter(u_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, 'va', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID V." + call ESMF_FieldScatter(v_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) error = nf90_close(ncid) + + if (localpet < num_tiles_input_grid) then + tile = localpet+1 + tilefile= trim(data_dir_input_grid) // "/" // trim(atm_tracer_files_input_grid(tile)) + print*,"- READ ATMOSPHERIC TRACER FILE: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + endif + + do i = 1, num_tracers + + if (localpet < num_tiles_input_grid) then + error=nf90_inq_varid(ncid, tracers_input(i), id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(i)) + call ESMF_FieldScatter(tracers_input_grid(i), data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + enddo + + if (localpet < num_tiles_input_grid) error=nf90_close(ncid) + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d cartesian winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Compute pressures +!--------------------------------------------------------------------------- + + print*,"- CALL FieldCreate FOR INPUT GRID SURFACE PRESSURE." + ps_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE." + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID PRESSURE." + pres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldGet FOR PRESSURE." + call ESMF_FieldGet(pres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=presptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR DELTA PRESSURE." + call ESMF_FieldGet(dpres_input_grid, & + farrayPtr=dpresptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + allocate(pres_interface(levp1_input)) + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + pres_interface(levp1_input) = ak(1) ! model top in Pa + do k = (levp1_input-1), 1, -1 + pres_interface(k) = pres_interface(k+1) + dpresptr(i,j,k) + enddo + do k = 1, lev_input + presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8 + enddo + psptr(i,j) = pres_interface(1) + enddo + enddo + + deallocate(ak) + deallocate(pres_interface) + + call ESMF_FieldDestroy(dpres_input_grid, rc=rc) + + deallocate(data_one_tile_3d, data_one_tile) + + end subroutine read_input_atm_restart_file + +!--------------------------------------------------------------------------- +! Read input grid fv3 atmospheric history files. +! +! Routine reads tiled files in parallel. Tile 1 is read by +! localpet 0; tile 2 by localpet 1, etc. The number of pets +! must be equal to or greater than the number of tiled files. +! Logic only tested with global input data of six tiles. +!--------------------------------------------------------------------------- + + subroutine read_input_atm_history_file(localpet) + + implicit none + + include 'mpif.h' + + integer, intent(in) :: localpet + + character(len=500) :: tilefile + + integer :: error, ncid, rc, tile + integer :: id_dim, idim_input, jdim_input + integer :: id_var, i, j, k, n + integer :: clb(3), cub(3), num_tracers_file + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + real(esmf_kind_r8), pointer :: presptr(:,:,:), dpresptr(:,:,:) + real(esmf_kind_r8), pointer :: psptr(:,:) + real(esmf_kind_r8), allocatable :: pres_interface(:) + + print*,"- READ INPUT ATMOS DATA FROM TILED HISTORY FILES." + + tilefile = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1)) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + + error=nf90_inq_dimid(ncid, 'grid_xt', id_dim) + call netcdf_err(error, 'reading grid_xt id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=idim_input) + call netcdf_err(error, 'reading grid_xt value' ) + + error=nf90_inq_dimid(ncid, 'grid_yt', id_dim) + call netcdf_err(error, 'reading grid_yt id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input) + call netcdf_err(error, 'reading grid_yt value' ) + + if (idim_input /= i_input .or. jdim_input /= j_input) then + call error_handler("DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 2) + endif + + error=nf90_inq_dimid(ncid, 'pfull', id_dim) + call netcdf_err(error, 'reading pfull id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=lev_input) + call netcdf_err(error, 'reading pfull value' ) + + error=nf90_inq_dimid(ncid, 'phalf', id_dim) + call netcdf_err(error, 'reading phalf id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=levp1_input) + call netcdf_err(error, 'reading phalf value' ) + + error=nf90_get_att(ncid, nf90_global, 'ncnsto', num_tracers_file) + call netcdf_err(error, 'reading ntracer value' ) + + error = nf90_close(ncid) + + print*,'- FILE HAS ', num_tracers_file, ' TRACERS.' + print*,'- WILL PROCESS ', num_tracers, ' TRACERS.' + + allocate(tracers_input_grid(num_tracers)) + + do i = 1, num_tracers + + print*,"- CALL FieldCreate FOR INPUT GRID TRACER ", trim(tracers_input(i)) + tracers_input_grid(i) = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + enddo + + print*,"- CALL FieldCreate FOR INPUT GRID DZDT." + dzdt_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID DELTA PRESSURE." + dpres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TEMPERATURE." + temp_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID U." + u_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID V." + v_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID SURFACE PRESSURE." + ps_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID TERRAIN." + terrain_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + if (localpet < num_tiles_input_grid) then + allocate(data_one_tile(i_input,j_input)) + allocate(data_one_tile_3d(i_input,j_input,lev_input)) + else + allocate(data_one_tile(0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + if (localpet < num_tiles_input_grid) then + tile = localpet+1 + tilefile= trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(tile)) + print*,"- READ ATMOSPHERIC DATA FROM: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + endif + + if (localpet < num_tiles_input_grid) then + print*,"- READ VERTICAL VELOCITY." + error=nf90_inq_varid(ncid, 'dzdt', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID VERTICAL VELOCITY." + call ESMF_FieldScatter(dzdt_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + do n = 1, num_tracers + + if (localpet < num_tiles_input_grid) then + print*,"- READ ", trim(tracers_input(n)) + error=nf90_inq_varid(ncid, tracers_input(n), id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID TRACER ", trim(tracers_input(n)) + call ESMF_FieldScatter(tracers_input_grid(n), data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ TEMPERATURE." + error=nf90_inq_varid(ncid, 'tmp', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE." + call ESMF_FieldScatter(temp_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ U-WIND." + error=nf90_inq_varid(ncid, 'ugrd', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID U." + call ESMF_FieldScatter(u_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ V-WIND." + error=nf90_inq_varid(ncid, 'vgrd', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID V." + call ESMF_FieldScatter(v_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ SURFACE PRESSURE." + error=nf90_inq_varid(ncid, 'pressfc', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile) + call netcdf_err(error, 'reading field' ) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID SURFACE PRESSURE." + call ESMF_FieldScatter(ps_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ TERRAIN." + error=nf90_inq_varid(ncid, 'hgtsfc', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile) + call netcdf_err(error, 'reading field' ) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT GRID TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) then + print*,"- READ DELTA PRESSURE." + error=nf90_inq_varid(ncid, 'dpres', id_var) + call netcdf_err(error, 'reading field id' ) + error=nf90_get_var(ncid, id_var, data_one_tile_3d) + call netcdf_err(error, 'reading field' ) + data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1) + endif + + do tile = 1, num_tiles_input_grid + print*,"- CALL FieldScatter FOR INPUT DELTA PRESSURE." + call ESMF_FieldScatter(dpres_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + enddo + + if (localpet < num_tiles_input_grid) error = nf90_close(ncid) + + deallocate(data_one_tile_3d, data_one_tile) + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d cartesian winds. +!--------------------------------------------------------------------------- + + call convert_winds + +!--------------------------------------------------------------------------- +! Compute pressure. +!--------------------------------------------------------------------------- + + print*,"- CALL FieldCreate FOR INPUT GRID PRESSURE." + pres_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lev_input/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldGet FOR PRESSURE." + call ESMF_FieldGet(pres_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=presptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR DELTA PRESSURE." + call ESMF_FieldGet(dpres_input_grid, & + farrayPtr=dpresptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SURFACE PRESSURE." + call ESMF_FieldGet(ps_input_grid, & + farrayPtr=psptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + allocate(pres_interface(levp1_input)) + + if (localpet == 0) then + print*,'dpres is ',dpresptr(1,1,:) + endif + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + pres_interface(1) = psptr(i,j) + do k = 2, levp1_input + pres_interface(k) = pres_interface(k-1) - dpresptr(i,j,k-1) + enddo + do k = 1, lev_input + presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8 + enddo + enddo + enddo + + if (localpet == 0) then + print*,'pres is ',presptr(1,1,:) + endif + + deallocate(pres_interface) + + call ESMF_FieldDestroy(dpres_input_grid, rc=rc) + + end subroutine read_input_atm_history_file + +!--------------------------------------------------------------------------- +! Read input grid surface data from a spectral gfs gaussian sfcio file. +! Prior to July 19, 2017. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_gfs_sfcio_file(localpet) + + use sfcio_module + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + + integer(sfcio_intkind) :: iret + integer :: rc + + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + + type(sfcio_head) :: sfchead + type(sfcio_dbta) :: sfcdata + + the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + + print*,"- READ SURFACE DATA IN SFCIO FORMAT." + print*,"- OPEN AND READ: ",trim(the_file) + call sfcio_sropen(23, trim(the_file), iret) + if (iret /= 0) then + rc=iret + call error_handler("OPENING FILE", rc) + endif + + call sfcio_srhead(23, sfchead, iret) + if (iret /= 0) then + rc=iret + call error_handler("READING HEADER", rc) + endif + + if (localpet == 0) then + call sfcio_aldbta(sfchead, sfcdata, iret) + if (iret /= 0) then + rc=iret + call error_handler("ALLOCATING DATA.", rc) + endif + call sfcio_srdbta(23, sfchead, sfcdata, iret) + if (iret /= 0) then + rc=iret + call error_handler("READING DATA.", rc) + endif + allocate(dummy2d(i_input,j_input)) + allocate(dummy3d(i_input,j_input,lsoil_input)) + else + allocate(dummy2d(0,0)) + allocate(dummy3d(0,0,0)) + endif + + if (localpet == 0) dummy2d = sfcdata%slmsk + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%zorl + + print*,"- CALL FieldScatter FOR INPUT Z0." + call ESMF_FieldScatter(z0_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = nint(sfcdata%vtype) + + print*,"- CALL FieldScatter FOR INPUT VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! Prior to July, 2017, gfs used zobler soil types. '13' indicates permanent land ice. + veg_type_landice_input = 13 + + if (localpet == 0) dummy2d = sfcdata%canopy + + print*,"- CALL FieldScatter FOR INPUT CANOPY MC." + call ESMF_FieldScatter(canopy_mc_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%fice + + print*,"- CALL FieldScatter FOR INPUT ICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%hice + + print*,"- CALL FieldScatter FOR INPUT ICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%tisfc + + print*,"- CALL FieldScatter FOR INPUT ICE SKIN TEMP." + call ESMF_FieldScatter(seaice_skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%snwdph ! mm (expected by program) + + print*,"- CALL FieldScatter FOR INPUT SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%sheleg + + print*,"- CALL FieldScatter FOR INPUT SNOW LIQUID EQUIV." + call ESMF_FieldScatter(snow_liq_equiv_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%t2m + + print*,"- CALL FieldScatter FOR INPUT T2M." + call ESMF_FieldScatter(t2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%q2m + + print*,"- CALL FieldScatter FOR INPUT Q2M." + call ESMF_FieldScatter(q2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%tprcp + + print*,"- CALL FieldScatter FOR INPUT TPRCP." + call ESMF_FieldScatter(tprcp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%f10m + + print*,"- CALL FieldScatter FOR INPUT F10M." + call ESMF_FieldScatter(f10m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%uustar + + print*,"- CALL FieldScatter FOR INPUT USTAR." + call ESMF_FieldScatter(ustar_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%ffmm + + print*,"- CALL FieldScatter FOR INPUT FFMM." + call ESMF_FieldScatter(ffmm_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%srflag + + print*,"- CALL FieldScatter FOR INPUT SRFLAG." + call ESMF_FieldScatter(srflag_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%tsea + + print*,"- CALL FieldScatter FOR INPUT SKIN TEMP." + call ESMF_FieldScatter(skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = nint(sfcdata%stype) + + print*,"- CALL FieldScatter FOR INPUT SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = sfcdata%orog + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy3d = sfcdata%slc + + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy3d = sfcdata%smc + + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy3d = sfcdata%stc + + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy2d, dummy3d) + call sfcio_axdbta(sfcdata, iret) + + call sfcio_sclose(23, iret) + + end subroutine read_input_sfc_gfs_sfcio_file + +!--------------------------------------------------------------------------- +! Read input grid surface data from a spectral gfs gaussian nemsio file. +! Format used by gfs starting July 19, 2017. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_gfs_gaussian_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + + integer :: rc + + real(nemsio_realkind), allocatable :: dummy(:) + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + + type(nemsio_gfile) :: gfile + + the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + + if (localpet == 0) then + allocate(dummy3d(i_input,j_input,lsoil_input)) + allocate(dummy2d(i_input,j_input)) + allocate(dummy(i_input*j_input)) + print*,"- OPEN FILE ", trim(the_file) + call nemsio_open(gfile, the_file, "read", iret=rc) + if (rc /= 0) call error_handler("OPENING FILE.", rc) + else + allocate(dummy3d(0,0,0)) + allocate(dummy2d(0,0)) + allocate(dummy(0)) + endif + + if (localpet == 0) then + print*,"- READ TERRAIN." + call nemsio_readrecv(gfile, "orog", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING TERRAIN.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'orog ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ LANDSEA MASK." + call nemsio_readrecv(gfile, "land", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LANDSEA MASK.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'landmask ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE FRACTION." + call nemsio_readrecv(gfile, "icec", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE FRACTION.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'icec ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE DEPTH." + call nemsio_readrecv(gfile, "icetk", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE DEPTH.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'icetk ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE SKIN TEMPERATURE." + call nemsio_readrecv(gfile, "tisfc", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE SKIN TEMP.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'ti ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." + call ESMF_FieldScatter(seaice_skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SNOW LIQUID EQUIVALENT." + call nemsio_readrecv(gfile, "weasd", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SNOW LIQUID EQUIVALENT.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'weasd ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." + call ESMF_FieldScatter(snow_liq_equiv_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SNOW DEPTH." + call nemsio_readrecv(gfile, "snod", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SNOW DEPTH.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'snod ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ VEG TYPE." + call nemsio_readrecv(gfile, "vtype", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING VEG TYPE", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'vtype ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SOIL TYPE." + call nemsio_readrecv(gfile, "sotyp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SOIL TYPE.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'sotype ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ T2M." + call nemsio_readrecv(gfile, "tmp", "2 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING T2M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'t2m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID T2M." + call ESMF_FieldScatter(t2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ Q2M." + call nemsio_readrecv(gfile, "spfh", "2 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING Q2M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'q2m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Q2M." + call ESMF_FieldScatter(q2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ TPRCP." + call nemsio_readrecv(gfile, "tprcp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING TPRCP.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'tprcp ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TPRCP." + call ESMF_FieldScatter(tprcp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ FFMM." + call nemsio_readrecv(gfile, "ffmm", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING FFMM.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'ffmm ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID FFMM" + call ESMF_FieldScatter(ffmm_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ USTAR." + call nemsio_readrecv(gfile, "fricv", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING USTAR.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'fricv ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID USTAR" + call ESMF_FieldScatter(ustar_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = 0.0 + print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG" + call ESMF_FieldScatter(srflag_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SKIN TEMPERATURE." + call nemsio_readrecv(gfile, "tmp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SKIN TEMPERATURE.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'tmp ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" + call ESMF_FieldScatter(skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ F10M." + call nemsio_readrecv(gfile, "f10m", "10 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING F10M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'f10m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID F10M." + call ESMF_FieldScatter(f10m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ CANOPY MOISTURE CONTENT." + call nemsio_readrecv(gfile, "cnwat", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING CANOPY MOISTURE CONTENT.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'cnwat ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." + call ESMF_FieldScatter(canopy_mc_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ Z0." + call nemsio_readrecv(gfile, "sfcr", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING Z0.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'sfcr ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Z0." + call ESMF_FieldScatter(z0_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy2d) + + if (localpet == 0) then + print*,"- READ LIQUID SOIL MOISTURE." + call nemsio_readrecv(gfile, "slc", "soil layer", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "slc", "soil layer", 2, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "slc", "soil layer", 3, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "slc", "soil layer", 4, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'slc ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ TOTAL SOIL MOISTURE." + call nemsio_readrecv(gfile, "smc", "soil layer", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "smc", "soil layer", 2, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "smc", "soil layer", 3, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "smc", "soil layer", 4, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'smc ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SOIL TEMPERATURE." + call nemsio_readrecv(gfile, "stc", "soil layer", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 SOIL TEMP.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "stc", "soil layer", 2, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 SOIL TEMP.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "stc", "soil layer", 3, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 SOIL TEMP.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "stc", "soil layer", 4, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 SOIL TEMP.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'stc ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy3d, dummy) + + if (localpet == 0) call nemsio_close(gfile) + + end subroutine read_input_sfc_gfs_gaussian_file + +!--------------------------------------------------------------------------- +! Read input grid surface data from an fv3 gaussian history file. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_gaussian_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=250) :: the_file + + integer :: rc + + real(nemsio_realkind), allocatable :: dummy(:) + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + real(esmf_kind_r8), allocatable :: dummy3d(:,:,:) + + type(nemsio_gfile) :: gfile + + the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + + if (localpet == 0) then + allocate(dummy3d(i_input,j_input,lsoil_input)) + allocate(dummy2d(i_input,j_input)) + allocate(dummy(i_input*j_input)) + print*,"- OPEN FILE ", trim(the_file) + call nemsio_open(gfile, the_file, "read", iret=rc) + if (rc /= 0) call error_handler("OPENING FILE.", rc) + else + allocate(dummy3d(0,0,0)) + allocate(dummy2d(0,0)) + allocate(dummy(0)) + endif + + if (localpet == 0) then + print*,"- READ TERRAIN." + call nemsio_readrecv(gfile, "orog", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING TERRAIN.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'orog ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ LANDSEA MASK." + call nemsio_readrecv(gfile, "land", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LANDSEA MASK.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'landmask ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE FRACTION." + call nemsio_readrecv(gfile, "icec", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE FRACTION.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'icec ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE DEPTH." + call nemsio_readrecv(gfile, "icetk", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE DEPTH.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'icetk ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SEAICE SKIN TEMPERATURE." + call nemsio_readrecv(gfile, "ti", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SEAICE SKIN TEMP.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'ti ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." + call ESMF_FieldScatter(seaice_skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SNOW LIQUID EQUIVALENT." + call nemsio_readrecv(gfile, "weasd", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SNOW LIQUID EQUIVALENT.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'weasd ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." + call ESMF_FieldScatter(snow_liq_equiv_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SNOW DEPTH." + call nemsio_readrecv(gfile, "snod", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SNOW DEPTH.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) * 1000.0_8 + print*,'snod ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ VEG TYPE." + call nemsio_readrecv(gfile, "vtype", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING VEG TYPE", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'vtype ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SOIL TYPE." + call nemsio_readrecv(gfile, "sotyp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SOIL TYPE.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'sotype ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ T2M." + call nemsio_readrecv(gfile, "tmp", "2 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING T2M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'t2m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID T2M." + call ESMF_FieldScatter(t2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ Q2M." + call nemsio_readrecv(gfile, "spfh", "2 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING Q2M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'q2m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Q2M." + call ESMF_FieldScatter(q2m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ TPRCP." + call nemsio_readrecv(gfile, "tprcp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING TPRCP.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'tprcp ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TPRCP." + call ESMF_FieldScatter(tprcp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ FFMM." + call nemsio_readrecv(gfile, "ffmm", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING FFMM.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'ffmm ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID FFMM" + call ESMF_FieldScatter(ffmm_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ USTAR." + call nemsio_readrecv(gfile, "fricv", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING USTAR.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'fricv ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID USTAR" + call ESMF_FieldScatter(ustar_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) dummy2d = 0.0 + print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG" + call ESMF_FieldScatter(srflag_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SKIN TEMPERATURE." + call nemsio_readrecv(gfile, "tmp", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING SKIN TEMPERATURE.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'tmp ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" + call ESMF_FieldScatter(skin_temp_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ F10M." + call nemsio_readrecv(gfile, "f10m", "10 m above gnd", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING F10M.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'f10m ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID F10M." + call ESMF_FieldScatter(f10m_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ CANOPY MOISTURE CONTENT." + call nemsio_readrecv(gfile, "cnwat", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING CANOPY MOISTURE CONTENT.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'cnwat ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." + call ESMF_FieldScatter(canopy_mc_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ Z0." + call nemsio_readrecv(gfile, "sfcr", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING Z0.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) * 100.0_8 ! convert to cm + print*,'sfcr ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Z0." + call ESMF_FieldScatter(z0_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy2d) + + if (localpet == 0) then + print*,"- READ LIQUID SOIL MOISTURE." + call nemsio_readrecv(gfile, "soill", "0-10 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soill", "10-40 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soill", "40-100 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soill", "100-200 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 LIQUID SOIL MOIST.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'soill ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ TOTAL SOIL MOISTURE." + call nemsio_readrecv(gfile, "soilw", "0-10 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soilw", "10-40 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soilw", "40-100 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "soilw", "100-200 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 TOTAL SOIL MOIST.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'soilm ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ SOIL TEMPERATURE." + call nemsio_readrecv(gfile, "tmp", "0-10 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 1 SOIL TEMP.", rc) + dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "tmp", "10-40 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 2 SOIL TEMP.", rc) + dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "tmp", "40-100 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 3 SOIL TEMP.", rc) + dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/)) + call nemsio_readrecv(gfile, "tmp", "100-200 cm down", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING LAYER 4 SOIL TEMP.", rc) + dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/)) + print*,'soilt ',maxval(dummy3d),minval(dummy3d) + endif + + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy3d, dummy) + + if (localpet == 0) call nemsio_close(gfile) + + end subroutine read_input_sfc_gaussian_file + +!--------------------------------------------------------------------------- +! Read input grid surface data tiled 'restart' files. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_restart_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=500) :: tilefile + + integer :: error, rc + integer :: id_dim, idim_input, jdim_input + integer :: ncid, tile, id_var + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + +!--------------------------------------------------------------------------- +! Get i/j dimensions and number of soil layers from first surface file. +! Do dimensions match those from the orography file? +!--------------------------------------------------------------------------- + + tilefile = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + print*,"- READ GRID DIMENSIONS FROM: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + + error=nf90_inq_dimid(ncid, 'xaxis_1', id_dim) + call netcdf_err(error, 'reading xaxis_1 id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=idim_input) + call netcdf_err(error, 'reading xaxis_1 value' ) + + error=nf90_inq_dimid(ncid, 'yaxis_1', id_dim) + call netcdf_err(error, 'reading yaxis_1 id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input) + call netcdf_err(error, 'reading yaxis_1 value' ) + + if (idim_input /= i_input .or. jdim_input /= j_input) then + call error_handler("DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 1) + endif + + error = nf90_close(ncid) + + if (localpet == 0) then + allocate(data_one_tile(idim_input,jdim_input)) + allocate(data_one_tile_3d(idim_input,jdim_input,lsoil_input)) + else + allocate(data_one_tile(0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + TERRAIN_LOOP: do tile = 1, num_tiles_input_grid + + if (localpet == 0) then + tilefile = trim(orog_dir_input_grid) // trim(orog_files_input_grid(tile)) + print*,'- OPEN OROGRAPHY FILE: ', trim(tilefile) + error=nf90_open(tilefile,nf90_nowrite,ncid) + call netcdf_err(error, 'OPENING OROGRAPHY FILE' ) + error=nf90_inq_varid(ncid, 'orog_raw', id_var) + call netcdf_err(error, 'READING OROG RECORD ID' ) + error=nf90_get_var(ncid, id_var, data_one_tile) + call netcdf_err(error, 'READING OROG RECORD' ) + print*,'terrain check ',tile, maxval(data_one_tile) + error=nf90_close(ncid) + endif + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo TERRAIN_LOOP + + TILE_LOOP : do tile = 1, num_tiles_input_grid + +! liquid soil moisture + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('slc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata_3d=data_one_tile_3d) + endif + + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('smc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata_3d=data_one_tile_3d) + endif + + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('stc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata_3d=data_one_tile_3d) + endif + + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! land mask + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('slmsk', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice fraction + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('fice', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('hice', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice skin temperature + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tisfc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." + call ESMF_FieldScatter(seaice_skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! liquid equivalent snow depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('sheleg', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." + call ESMF_FieldScatter(snow_liq_equiv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! physical snow depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('snwdph', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile = data_one_tile + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! Vegetation type + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('vtype', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! Soil type + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('stype', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! Two-meter temperature + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('t2m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID T2M." + call ESMF_FieldScatter(t2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! Two-meter q + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('q2m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Q2M." + call ESMF_FieldScatter(q2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tprcp', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TPRCP." + call ESMF_FieldScatter(tprcp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('f10m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID F10M" + call ESMF_FieldScatter(f10m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('ffmm', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID FFMM" + call ESMF_FieldScatter(ffmm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('uustar', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID USTAR" + call ESMF_FieldScatter(ustar_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('srflag', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG" + call ESMF_FieldScatter(srflag_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tsea', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" + call ESMF_FieldScatter(skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('canopy', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." + call ESMF_FieldScatter(canopy_mc_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('zorl', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Z0." + call ESMF_FieldScatter(z0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo TILE_LOOP + + deallocate(data_one_tile, data_one_tile_3d) + + end subroutine read_input_sfc_restart_file + +!--------------------------------------------------------------------------- +! Read input grid surface tiled 'history' files. +!--------------------------------------------------------------------------- + + subroutine read_input_sfc_history_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=500) :: tilefile + + integer :: error, id_var + integer :: id_dim, idim_input, jdim_input + integer :: ncid, rc, tile + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + +!--------------------------------------------------------------------------- +! Get i/j dimensions and number of soil layers from first surface file. +! Do dimensions match those from the orography file? +!--------------------------------------------------------------------------- + + tilefile = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + print*,"- READ GRID DIMENSIONS FROM: ", trim(tilefile) + error=nf90_open(trim(tilefile),nf90_nowrite,ncid) + call netcdf_err(error, 'opening: '//trim(tilefile) ) + + error=nf90_inq_dimid(ncid, 'grid_xt', id_dim) + call netcdf_err(error, 'reading grid_xt id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=idim_input) + call netcdf_err(error, 'reading grid_xt value' ) + + error=nf90_inq_dimid(ncid, 'grid_yt', id_dim) + call netcdf_err(error, 'reading grid_yt id' ) + error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input) + call netcdf_err(error, 'reading grid_yt value' ) + + if (idim_input /= i_input .or. jdim_input /= j_input) then + call error_handler("DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 3) + endif + + error = nf90_close(ncid) + + if (localpet == 0) then + allocate(data_one_tile(idim_input,jdim_input)) + allocate(data_one_tile_3d(idim_input,jdim_input,lsoil_input)) + else + allocate(data_one_tile(0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + TERRAIN_LOOP: do tile = 1, num_tiles_input_grid + + if (localpet == 0) then + tilefile = trim(orog_dir_input_grid) // trim(orog_files_input_grid(tile)) + print*,'- OPEN OROGRAPHY FILE: ', trim(tilefile) + error=nf90_open(tilefile,nf90_nowrite,ncid) + call netcdf_err(error, 'OPENING OROGRAPHY FILE.' ) + error=nf90_inq_varid(ncid, 'orog_raw', id_var) + call netcdf_err(error, 'READING OROGRAPHY RECORD ID.' ) + error=nf90_get_var(ncid, id_var, data_one_tile) + call netcdf_err(error, 'READING OROGRAPHY RECORD.' ) + print*,'terrain check history ',tile, maxval(data_one_tile) + error=nf90_close(ncid) + endif + + print*,"- CALL FieldScatter FOR INPUT TERRAIN." + call ESMF_FieldScatter(terrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo TERRAIN_LOOP + + TILE_LOOP : do tile = 1, num_tiles_input_grid + +! liquid soil moisture + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('soill1', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,1) = data_one_tile + call read_fv3_grid_data_netcdf('soill2', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,2) = data_one_tile + call read_fv3_grid_data_netcdf('soill3', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,3) = data_one_tile + call read_fv3_grid_data_netcdf('soill4', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,4) = data_one_tile + endif + + print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE." + call ESMF_FieldScatter(soilm_liq_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! total soil moisture + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('soilw1', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,1) = data_one_tile + call read_fv3_grid_data_netcdf('soilw2', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,2) = data_one_tile + call read_fv3_grid_data_netcdf('soilw3', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,3) = data_one_tile + call read_fv3_grid_data_netcdf('soilw4', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,4) = data_one_tile + endif + + print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE." + call ESMF_FieldScatter(soilm_tot_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! soil tempeature (ice temp at land ice points) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('soilt1', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,1) = data_one_tile + call read_fv3_grid_data_netcdf('soilt2', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,2) = data_one_tile + call read_fv3_grid_data_netcdf('soilt3', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,3) = data_one_tile + call read_fv3_grid_data_netcdf('soilt4', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile_3d(:,:,4) = data_one_tile + endif + + print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE." + call ESMF_FieldScatter(soil_temp_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! land mask + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('land', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK." + call ESMF_FieldScatter(landsea_mask_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice fraction + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('icec', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION." + call ESMF_FieldScatter(seaice_fract_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('icetk', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH." + call ESMF_FieldScatter(seaice_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! sea ice skin temperature + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tisfc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE." + call ESMF_FieldScatter(seaice_skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! liquid equivalent snow depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('weasd', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT." + call ESMF_FieldScatter(snow_liq_equiv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! physical snow depth + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('snod', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + data_one_tile = data_one_tile * 1000.0 ! convert from meters to mm. + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH." + call ESMF_FieldScatter(snow_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! Vegetation type + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('vtype', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE." + call ESMF_FieldScatter(veg_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! Soil type + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('sotyp', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! Two-meter temperature + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tmp2m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID T2M." + call ESMF_FieldScatter(t2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! Two-meter q + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('spfh2m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Q2M." + call ESMF_FieldScatter(q2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tprcp', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID TPRCP." + call ESMF_FieldScatter(tprcp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('f10m', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID F10M" + call ESMF_FieldScatter(f10m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('ffmm', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID FFMM" + call ESMF_FieldScatter(ffmm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('fricv', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID USTAR" + call ESMF_FieldScatter(ustar_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then +! call read_fv3_grid_data_netcdf('srflag', tile, idim_input, jdim_input, & +! lsoil_input, sfcdata=data_one_tile) + data_one_tile = 0.0 + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG" + call ESMF_FieldScatter(srflag_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tmpsfc', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE" + call ESMF_FieldScatter(skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('cnwat', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT." + call ESMF_FieldScatter(canopy_mc_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('sfcr', tile, idim_input, jdim_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT GRID Z0." + call ESMF_FieldScatter(z0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo TILE_LOOP + + deallocate(data_one_tile, data_one_tile_3d) + + end subroutine read_input_sfc_history_file + +!--------------------------------------------------------------------------- +! Read nst data from tiled history or restart files. +!--------------------------------------------------------------------------- + + subroutine read_input_nst_tile_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=10) :: field + + integer :: rc, tile + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + + if (localpet == 0) then + allocate(data_one_tile(i_input,j_input)) + else + allocate(data_one_tile(0,0)) + endif + + TILE_LOOP : do tile = 1, num_tiles_input_grid + +! c_d + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='c_d' + else + field='cd' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT C_D" + call ESMF_FieldScatter(c_d_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! c_0 + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='c_0' + else + field='c0' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT C_0" + call ESMF_FieldScatter(c_0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! d_conv + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='d_conv' + else + field='dconv' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT D_CONV." + call ESMF_FieldScatter(d_conv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! dt_cool + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='dt_cool' + else + field='dtcool' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT DT_COOL." + call ESMF_FieldScatter(dt_cool_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! ifd - xu li said initialize to '1'. + + if (localpet == 0) then + data_one_tile = 1.0 + endif + + print*,"- CALL FieldScatter FOR INPUT IFD." + call ESMF_FieldScatter(ifd_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! qrain + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('qrain', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT QRAIN." + call ESMF_FieldScatter(qrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! tref + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('tref', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT TREF" + call ESMF_FieldScatter(tref_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! w_d + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='w_d' + else + field='wd' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT W_D" + call ESMF_FieldScatter(w_d_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! w_0 + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='w_0' + else + field='w0' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT W_0" + call ESMF_FieldScatter(w_0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xs + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xs', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XS" + call ESMF_FieldScatter(xs_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xt + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xt', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XT" + call ESMF_FieldScatter(xt_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xu + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xu', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XU" + call ESMF_FieldScatter(xu_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xv + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xv', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XV" + call ESMF_FieldScatter(xv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xz + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xz', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XZ" + call ESMF_FieldScatter(xz_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xtts + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xtts', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XTTS" + call ESMF_FieldScatter(xtts_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xzts + + if (localpet == 0) then + call read_fv3_grid_data_netcdf('xzts', tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT XZTS" + call ESMF_FieldScatter(xzts_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! z_c + + if (localpet == 0) then + if (trim(input_type) == "restart") then + field='z_c' + else + field='zc' + endif + call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, & + lsoil_input, sfcdata=data_one_tile) + endif + + print*,"- CALL FieldScatter FOR INPUT Z_C" + call ESMF_FieldScatter(z_c_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! zm - Not used yet. Xu li said set to '0'. + + if (localpet == 0) then + data_one_tile = 0.0 + endif + + print*,"- CALL FieldScatter FOR INPUT ZM" + call ESMF_FieldScatter(zm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo TILE_LOOP + + deallocate(data_one_tile) + + end subroutine read_input_nst_tile_file + +!-------------------------------------------------------------------------- +! Read input grid nst data from fv3 gaussian nemsio history file or +! spectral GFS nemsio file. The spectral GFS nst data is in a separate +! file from the surface data. The fv3 surface and nst data are in a +! single file. +!-------------------------------------------------------------------------- + + subroutine read_input_nst_gaussian_file(localpet) + + implicit none + + integer, intent(in) :: localpet + + character(len=300) :: the_file + + integer :: rc + + real(nemsio_realkind), allocatable :: dummy(:) + real(esmf_kind_r8), allocatable :: dummy2d(:,:) + + type(nemsio_gfile) :: gfile + + if (trim(input_type) == "gfs_gaussian") then ! spectral gfs nemsio in + ! separate file. + the_file = trim(data_dir_input_grid) // "/" // trim(nst_files_input_grid) + else + the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + endif + + print*,"- READ NST DATA FROM: ", trim(the_file) + + if (localpet == 0) then + allocate(dummy(i_input*j_input)) + allocate(dummy2d(i_input,j_input)) + call nemsio_open(gfile, the_file, "read", iret=rc) + else + allocate(dummy(0)) + allocate(dummy2d(0,0)) + endif + + if (localpet == 0) then + print*,"- READ TREF" + call nemsio_readrecv(gfile, "tref", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING TREF.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'tref ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT TREF." + call ESMF_FieldScatter(tref_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ CD" + call nemsio_readrecv(gfile, "cd", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING CD.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'cd ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT C_D." + call ESMF_FieldScatter(c_d_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ C0" + call nemsio_readrecv(gfile, "c0", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING C0.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'c0 ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT C_0." + call ESMF_FieldScatter(c_0_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ DCONV" + call nemsio_readrecv(gfile, "dconv", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING DCONV.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'dconv ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT D_CONV." + call ESMF_FieldScatter(d_conv_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ DTCOOL" + call nemsio_readrecv(gfile, "dtcool", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING DTCOOL.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'dtcool ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT DT_COOL." + call ESMF_FieldScatter(dt_cool_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + dummy2d = 1.0 ! IFD not in file. Set to '1' per Xu Li. + endif + + print*,"- CALL FieldScatter FOR INPUT IFD." + call ESMF_FieldScatter(ifd_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ QRAIN" + call nemsio_readrecv(gfile, "qrain", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING QRAIN.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'qrain ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT QRAIN." + call ESMF_FieldScatter(qrain_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ WD" + call nemsio_readrecv(gfile, "wd", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING WD.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'wd ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT WD." + call ESMF_FieldScatter(w_d_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ W0" + call nemsio_readrecv(gfile, "w0", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING W0.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'w0 ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT W0." + call ESMF_FieldScatter(w_0_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XS" + call nemsio_readrecv(gfile, "xs", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XS.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xs ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XS." + call ESMF_FieldScatter(xs_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XT" + call nemsio_readrecv(gfile, "xt", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XT.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xt ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XT." + call ESMF_FieldScatter(xt_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XU" + call nemsio_readrecv(gfile, "xu", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XU.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xu ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XU." + call ESMF_FieldScatter(xu_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XV" + call nemsio_readrecv(gfile, "xv", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XV.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xv ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XV." + call ESMF_FieldScatter(xv_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XZ" + call nemsio_readrecv(gfile, "xz", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XZ.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xz ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XZ." + call ESMF_FieldScatter(xz_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XTTS" + call nemsio_readrecv(gfile, "xtts", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XTTS.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xtts ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XTTS." + call ESMF_FieldScatter(xtts_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ XZTS" + call nemsio_readrecv(gfile, "xzts", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING XZTS.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'xzts ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT XZTS." + call ESMF_FieldScatter(xzts_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + print*,"- READ ZC" + call nemsio_readrecv(gfile, "zc", "sfc", 1, dummy, 0, iret=rc) + if (rc /= 0) call error_handler("READING ZC.", rc) + dummy2d = reshape(dummy, (/i_input,j_input/)) + print*,'zc ',maxval(dummy2d),minval(dummy2d) + endif + + print*,"- CALL FieldScatter FOR INPUT Z_C." + call ESMF_FieldScatter(z_c_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (localpet == 0) then + dummy2d = 0.0 ! zm not used yet. Set to zero per Xu Li. + endif + + print*,"- CALL FieldScatter FOR INPUT ZM." + call ESMF_FieldScatter(zm_input_grid, dummy2d, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + deallocate(dummy, dummy2d) + + if (localpet == 0) call nemsio_close(gfile) + + end subroutine read_input_nst_gaussian_file + + SUBROUTINE READ_FV3_GRID_DATA_NETCDF(FIELD,TILE_NUM,IMO,JMO,LMO, & + SFCDATA, SFCDATA_3D) + + IMPLICIT NONE + + CHARACTER(LEN=*),INTENT(IN) :: FIELD + + INTEGER, INTENT(IN) :: IMO, JMO, LMO, TILE_NUM + + REAL(ESMF_KIND_R8), INTENT(OUT), OPTIONAL :: SFCDATA(IMO,JMO) + REAL(ESMF_KIND_R8), INTENT(OUT), OPTIONAL :: SFCDATA_3D(IMO,JMO,LMO) + + CHARACTER(LEN=256) :: TILEFILE + + INTEGER :: ERROR, NCID, ID_VAR + + TILEFILE = TRIM(DATA_DIR_INPUT_GRID) // "/" // TRIM(SFC_FILES_INPUT_GRID(TILE_NUM)) + + PRINT*,'WILL READ ',TRIM(FIELD), ' FROM: ', TRIM(TILEFILE) + + ERROR=NF90_OPEN(TRIM(TILEFILE),NF90_NOWRITE,NCID) + CALL NETCDF_ERR(ERROR, 'OPENING: '//TRIM(TILEFILE) ) + + ERROR=NF90_INQ_VARID(NCID, FIELD, ID_VAR) + CALL NETCDF_ERR(ERROR, 'READING FIELD ID' ) + + IF (PRESENT(SFCDATA_3D)) THEN + ERROR=NF90_GET_VAR(NCID, ID_VAR, SFCDATA_3D) + CALL NETCDF_ERR(ERROR, 'READING FIELD' ) + ELSE + ERROR=NF90_GET_VAR(NCID, ID_VAR, SFCDATA) + CALL NETCDF_ERR(ERROR, 'READING FIELD' ) + ENDIF + + ERROR = NF90_CLOSE(NCID) + + END SUBROUTINE READ_FV3_GRID_DATA_NETCDF + +!--------------------------------------------------------------------------- +! Convert from 2-d to 3-d winds. +!--------------------------------------------------------------------------- + + subroutine convert_winds + + implicit none + + integer :: clb(4), cub(4) + integer :: i, j, k, rc + + real(esmf_kind_r8) :: latrad, lonrad + real(esmf_kind_r8), pointer :: windptr(:,:,:,:) + real(esmf_kind_r8), pointer :: uptr(:,:,:) + real(esmf_kind_r8), pointer :: vptr(:,:,:) + real(esmf_kind_r8), pointer :: latptr(:,:) + real(esmf_kind_r8), pointer :: lonptr(:,:) + + print*,"- CALL FieldCreate FOR INPUT GRID 3-D WIND." + wind_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1,1/), & + ungriddedUBound=(/lev_input,3/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldGet FOR 3-D WIND." + call ESMF_FieldGet(wind_input_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=windptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR U." + call ESMF_FieldGet(u_input_grid, & + farrayPtr=uptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR V." + call ESMF_FieldGet(v_input_grid, & + farrayPtr=vptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LATITUDE." + call ESMF_FieldGet(latitude_input_grid, & + farrayPtr=latptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LONGITUDE." + call ESMF_FieldGet(longitude_input_grid, & + farrayPtr=lonptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do i = clb(1), cub(1) + do j = clb(2), cub(2) + latrad = latptr(i,j) * acos(-1.) / 180.0 + lonrad = lonptr(i,j) * acos(-1.) / 180.0 + do k = clb(3), cub(3) + windptr(i,j,k,1) = uptr(i,j,k) * cos(lonrad) - vptr(i,j,k) * sin(latrad) * sin(lonrad) + windptr(i,j,k,2) = uptr(i,j,k) * sin(lonrad) + vptr(i,j,k) * sin(latrad) * cos(lonrad) + windptr(i,j,k,3) = vptr(i,j,k) * cos(latrad) + enddo + enddo + enddo + + call ESMF_FieldDestroy(u_input_grid, rc=rc) + call ESMF_FieldDestroy(v_input_grid, rc=rc) + + end subroutine convert_winds + + subroutine cleanup_input_atm_data + + implicit none + + integer :: rc, n + + print*,'- DESTROY ATMOSPHERIC INPUT DATA.' + + call ESMF_FieldDestroy(terrain_input_grid, rc=rc) + call ESMF_FieldDestroy(pres_input_grid, rc=rc) + call ESMF_FieldDestroy(dzdt_input_grid, rc=rc) + call ESMF_FieldDestroy(temp_input_grid, rc=rc) + call ESMF_FieldDestroy(wind_input_grid, rc=rc) + call ESMF_FieldDestroy(ps_input_grid, rc=rc) + + do n = 1, num_tracers + call ESMF_FieldDestroy(tracers_input_grid(n), rc=rc) + enddo + deallocate(tracers_input_grid) + + end subroutine cleanup_input_atm_data + + subroutine cleanup_input_nst_data + + implicit none + + integer :: rc + + print*,'- DESTROY NST INPUT DATA.' + + call ESMF_FieldDestroy(landsea_mask_input_grid, rc=rc) + call ESMF_FieldDestroy(c_d_input_grid, rc=rc) + call ESMF_FieldDestroy(c_0_input_grid, rc=rc) + call ESMF_FieldDestroy(d_conv_input_grid, rc=rc) + call ESMF_FieldDestroy(dt_cool_input_grid, rc=rc) + call ESMF_FieldDestroy(ifd_input_grid, rc=rc) + call ESMF_FieldDestroy(qrain_input_grid, rc=rc) + call ESMF_FieldDestroy(tref_input_grid, rc=rc) + call ESMF_FieldDestroy(w_d_input_grid, rc=rc) + call ESMF_FieldDestroy(w_0_input_grid, rc=rc) + call ESMF_FieldDestroy(xs_input_grid, rc=rc) + call ESMF_FieldDestroy(xt_input_grid, rc=rc) + call ESMF_FieldDestroy(xu_input_grid, rc=rc) + call ESMF_FieldDestroy(xv_input_grid, rc=rc) + call ESMF_FieldDestroy(xz_input_grid, rc=rc) + call ESMF_FieldDestroy(xtts_input_grid, rc=rc) + call ESMF_FieldDestroy(xzts_input_grid, rc=rc) + call ESMF_FieldDestroy(z_c_input_grid, rc=rc) + call ESMF_FieldDestroy(zm_input_grid, rc=rc) + + end subroutine cleanup_input_nst_data + + subroutine cleanup_input_sfc_data + + implicit none + + integer :: rc + + print*,"- CALL FieldDestroy FOR INPUT GRID FIELDS." + + call ESMF_FieldDestroy(canopy_mc_input_grid, rc=rc) + call ESMF_FieldDestroy(f10m_input_grid, rc=rc) + call ESMF_FieldDestroy(ffmm_input_grid, rc=rc) + if (.not. convert_nst) then + call ESMF_FieldDestroy(landsea_mask_input_grid, rc=rc) + endif + call ESMF_FieldDestroy(q2m_input_grid, rc=rc) + call ESMF_FieldDestroy(seaice_depth_input_grid, rc=rc) + call ESMF_FieldDestroy(seaice_fract_input_grid, rc=rc) + call ESMF_FieldDestroy(seaice_skin_temp_input_grid, rc=rc) + call ESMF_FieldDestroy(skin_temp_input_grid, rc=rc) + call ESMF_FieldDestroy(snow_depth_input_grid, rc=rc) + call ESMF_FieldDestroy(snow_liq_equiv_input_grid, rc=rc) + call ESMF_FieldDestroy(soil_temp_input_grid, rc=rc) + call ESMF_FieldDestroy(soil_type_input_grid, rc=rc) + call ESMF_FieldDestroy(soilm_liq_input_grid, rc=rc) + call ESMF_FieldDestroy(soilm_tot_input_grid, rc=rc) + call ESMF_FieldDestroy(srflag_input_grid, rc=rc) + call ESMF_FieldDestroy(t2m_input_grid, rc=rc) + call ESMF_FieldDestroy(tprcp_input_grid, rc=rc) + call ESMF_FieldDestroy(ustar_input_grid, rc=rc) + call ESMF_FieldDestroy(veg_type_input_grid, rc=rc) + call ESMF_FieldDestroy(z0_input_grid, rc=rc) + call ESMF_FieldDestroy(terrain_input_grid, rc=rc) + + end subroutine cleanup_input_sfc_data + + end module input_data diff --git a/sorc/chgres_cube.fd/sorc/make.sh b/sorc/chgres_cube.fd/sorc/make.sh new file mode 100755 index 0000000000..8d7f19cea9 --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/make.sh @@ -0,0 +1,106 @@ +#!/bin/sh + +set -x + +if [[ ! -d ../exec ]];then + mkdir ../exec +fi + +mac=$(hostname -f) + +case $mac in + +#--------------------------------------------------------------------------------- +# BUILD PROGRAM ON WCOSS CRAY. +#--------------------------------------------------------------------------------- + +llogin? | slogin?) + + module purge + module load modules/3.2.6.7 + module load PrgEnv-intel/5.2.56 + module rm intel + module load intel/16.3.210 + module load cray-mpich/7.2.0 + module load craype-haswell + module load cray-netcdf + module load w3nco-intel/2.0.6 + module load nemsio-intel/2.2.3 + module load bacio-intel/2.0.2 + module load sp-intel/2.0.2 + module load sigio-intel/2.1.0 + module load sfcio-intel/1.0.0 + +# module use /gpfs/hps3/emc/nems/noscrub/emc.nemspara/soft/modulefiles +# module load esmf/7.1.0r + export ESMFMKFILE=/gpfs/hps3/emc/global/noscrub/George.Gayno/esmf/8_0_0_bs20/lib/esmf.mk + + export FCOMP=ftn + export FFLAGS="-O0 -g -r8 -i4 -qopenmp -convert big_endian -check bounds -assume byterecl -warn unused" + + make clean + make + rc=$? ;; + +#--------------------------------------------------------------------------------- +# BUILD PROGRAM ON THEIA. +#--------------------------------------------------------------------------------- + +tfe??) + + source /apps/lmod/lmod/init/sh + module purge + + module load intel/15.1.133 + module load impi/5.1.1.109 + module load netcdf/4.3.0 + + module use /scratch4/NCEPDEV/nems/noscrub/emc.nemspara/soft/modulefiles + module load esmf/8.0.0bs20 + + module use -a /scratch3/NCEPDEV/nwprod/lib/modulefiles + module load w3nco + module load nemsio/v2.2.3 + module load bacio/v2.0.1 + module load sp/v2.0.2 + module load sfcio/v1.0.0 + module load sigio/v2.0.1 + + export FCOMP=mpiifort + export FFLAGS="-O0 -g -traceback -r8 -i4 -qopenmp -convert big_endian -check bounds -warn unused -assume byterecl" + + make clean + make + rc=$? ;; + +#--------------------------------------------------------------------------------- +# BUILD PROGRAM ON DELL. +#--------------------------------------------------------------------------------- + +m????.ncep.noaa.gov | v????.ncep.noaa.gov ) + + module purge + module use /usrx/local/dev/modulefiles + + module load ips/18.0.1.163 + module load impi/18.0.1 + module load NetCDF/4.5.0 +# module load ESMF/7_1_0r + export ESMFMKFILE=/gpfs/dell2/emc/modeling/noscrub/George.Gayno/esmf_lib/8_0_0bs20/lib/libO/Linux.intel.64.intelmpi.default/esmf.mk + module load w3nco/2.0.6 + module load sp/2.0.2 + module load nemsio/2.2.3 + module load bacio/2.0.2 + module load sfcio/1.0.0 + module load sigio/2.1.0 + + export FCOMP=mpif90 + export FFLAGS="-O0 -g -traceback -r8 -i4 -qopenmp -convert big_endian -check bounds -warn unused -assume byterecl" + + make clean + make + rc=$? ;; + +esac + +exit diff --git a/sorc/chgres_cube.fd/sorc/makefile b/sorc/chgres_cube.fd/sorc/makefile new file mode 100755 index 0000000000..dfb95b4046 --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/makefile @@ -0,0 +1,53 @@ +SHELL= /bin/sh + +include $(ESMFMKFILE) + +CMD= global_chgres.exe + +OBJS = chgres.o \ + atmosphere.o \ + input_data.o \ + surface.o \ + model_grid.o \ + program_setup.o \ + write_data.o \ + search_util.o \ + static_data.o \ + utils.o + +$(CMD): $(OBJS) + $(FCOMP) $(FFLAGS) $(ESMF_F90COMPILEPATHS) -o $(CMD) $(OBJS) $(SP_LIBd) $(NEMSIO_LIB) $(BACIO_LIB4) $(W3NCO_LIBd) $(SFCIO_LIB4) $(SIGIO_LIB4) $(ESMF_F90LINKPATHS) $(ESMF_F90ESMFLINKRPATHS) $(ESMF_F90ESMFLINKLIBS) -g -traceback + mv $(CMD) ../exec + +model_grid.o: program_setup.o model_grid.F90 + $(FCOMP) $(FFLAGS) -I$(NEMSIO_INC) -I$(SFCIO_INC4) -I$(SIGIO_INC4) $(ESMF_F90COMPILEPATHS) -c model_grid.F90 + +utils.o: utils.f90 + $(FCOMP) $(FFLAGS) -c $(ESMF_F90COMPILEPATHS) utils.f90 + +program_setup.o: program_setup.f90 + $(FCOMP) $(FFLAGS) $(ESMF_F90COMPILEPATHS) -c program_setup.f90 + +atmosphere.o: program_setup.o model_grid.o input_data.o atmosphere.F90 + $(FCOMP) $(FFLAGS) $(ESMF_F90COMPILEPATHS) -c atmosphere.F90 + +chgres.o: atmosphere.o model_grid.o program_setup.o surface.o chgres.F90 + $(FCOMP) $(FFLAGS) $(ESMF_F90COMPILEPATHS) -c chgres.F90 + +write_data.o: atmosphere.o model_grid.o program_setup.o surface.o static_data.o write_data.F90 + $(FCOMP) $(FFLAGS) $(ESMF_F90COMPILEPATHS) -c write_data.F90 + +input_data.o: program_setup.o model_grid.o input_data.F90 + $(FCOMP) $(FFLAGS) -I$(NEMSIO_INC) -I$(SIGIO_INC4) -I$(SFCIO_INC4) $(ESMF_F90COMPILEPATHS) -c input_data.F90 + +surface.o: search_util.o model_grid.o input_data.o program_setup.o static_data.o surface.F90 + $(FCOMP) $(FFLAGS) $(ESMF_F90COMPILEPATHS) -c surface.F90 + +search_util.o: search_util.f90 + $(FCOMP) $(FFLAGS) $(ESMF_F90COMPILEPATHS) -c search_util.f90 + +static_data.o: model_grid.o program_setup.o static_data.F90 + $(FCOMP) $(FFLAGS) $(ESMF_F90COMPILEPATHS) -c static_data.F90 + +clean: + rm -f *.o *.mod ${CMD} ../exec/${CMD} diff --git a/sorc/chgres_cube.fd/sorc/model_grid.F90 b/sorc/chgres_cube.fd/sorc/model_grid.F90 new file mode 100644 index 0000000000..1fc4f25679 --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/model_grid.F90 @@ -0,0 +1,1086 @@ + module model_grid + +!-------------------------------------------------------------------------- +! Module model_grid +! +! Abstract: Specify input and target model grids +! +! Public Subroutines: +! ------------------- +! define_target_grid Setup the esmf grid object for the +! target grid. +! define_input_grid Setup the esmf grid object for the +! input grid. +! cleanup_input_target_grid_data Deallocate all esmf grid objects. +! +! Public variables: +! ----------------- +! i/j_input i/j dimension of each cube of the +! input grid. +! ip1/jp1_input i/j dimension plus 1 of input grid. +! i/j_target i/j dimension of each cube or of +! a nest, target grid. +! ip1/jp1_target i/j dimension plus 1 of input grid. +! input_grid input grid esmf grid object +! landmask_target_grid land mask target grid - '1' land; +! '0' non-land +! latitude_input_grid latitude of grid center, input grid +! latitude_target_grid latitude of grid center, target grid +! latitude_s_input_grid latitude of 'south' edge of grid +! box, input grid +! latitude_s_target_grid latitude of 'south' edge of grid +! box, target grid +! latitude_w_input_grid latitude of 'west' edge of grid +! box, input grid +! latitude_w_target_grid latitude of 'west' edge of grid +! box, target grid +! longitude_input_grid longitude of grid center, input grid +! longitude_target_grid longitude of grid center, target grid +! longitude_s_input_grid longitude of 'south' edge of grid +! box, input grid +! longitude_s_target_grid longitude of 'south' edge of grid +! box, target grid +! longitude_w_input_grid longitude of 'west' edge of grid +! box, input grid +! longitude_w_target_grid longitude of 'west' edge of grid +! box, target grid +! lsoil_target Number of soil layers, target grid. +! num_tiles_input_grid Number of tiles, input grid +! num_tiles_target_grid Number of tiles, target grid +! seamask_target_grid sea mask target grid - '1' non-land; +! '0' land +! target_grid target grid esmf grid object. +! terrain_target_grid terrain height target grid +! tiles_target_grid Tile names of target grid. +! +!-------------------------------------------------------------------------- + + use esmf + + implicit none + + private + + character(len=5), allocatable, public :: tiles_target_grid(:) + + integer, parameter, public :: lsoil_target = 4 ! # soil layers + integer, public :: i_input, j_input + integer, public :: ip1_input, jp1_input + integer, public :: i_target, j_target + integer, public :: ip1_target, jp1_target + integer, public :: num_tiles_input_grid + integer, public :: num_tiles_target_grid + + type(esmf_grid), public :: input_grid + type(esmf_grid), public :: target_grid + + type(esmf_field), public :: latitude_input_grid + type(esmf_field), public :: longitude_input_grid + type(esmf_field), public :: latitude_s_input_grid + type(esmf_field), public :: longitude_s_input_grid + type(esmf_field), public :: latitude_w_input_grid + type(esmf_field), public :: longitude_w_input_grid + + type(esmf_field), public :: landmask_target_grid + type(esmf_field), public :: latitude_target_grid + type(esmf_field), public :: latitude_s_target_grid + type(esmf_field), public :: latitude_w_target_grid + type(esmf_field), public :: longitude_target_grid + type(esmf_field), public :: longitude_s_target_grid + type(esmf_field), public :: longitude_w_target_grid + type(esmf_field), public :: seamask_target_grid + type(esmf_field), public :: terrain_target_grid + + public :: define_target_grid + public :: define_input_grid + public :: cleanup_input_target_grid_data + + contains + +!-------------------------------------------------------------------------- +! Set up the esmf grid object for the input grid. If the input +! source is tiled fv3 restart or history data, the grid is created +! by reading the mosaic and grid files. If the input source is +! fv3 global gaussian nemsio, spectral gfs global gaussian nemsio, or +! spectral gfs global gaussian sigio/sfcio, the grid is setup by +! computing lat/lons using the sp library. +!-------------------------------------------------------------------------- + + subroutine define_input_grid(localpet, npets) + + use program_setup, only : input_type + + implicit none + + integer, intent(in) :: localpet, npets + + if (trim(input_type) == "gaussian" .or. & + trim(input_type) == "gfs_gaussian" .or. & + trim(input_type) == "gfs_spectral") then + call define_input_grid_gaussian(localpet, npets) + else + call define_input_grid_mosaic(localpet, npets) + endif + + end subroutine define_input_grid + +!-------------------------------------------------------------------------- +! Define grid object for input data on global gaussian grids. +! Recognized file formats: +! +! - fv3gfs nemsio +! - spectral gfs nemsio (starting July 19, 2017) +! - spectral gfs sigio (prior to July 19, 2017) +! - spectral gfs sfcio (prior to July 19, 2017) +!-------------------------------------------------------------------------- + + subroutine define_input_grid_gaussian(localpet, npets) + + use nemsio_module + + use program_setup, only : data_dir_input_grid, & + atm_files_input_grid, & + sfc_files_input_grid, & + input_type, & + convert_atm, convert_sfc + + use sfcio_module + use sigio_module + + implicit none + + integer, intent(in) :: localpet, npets + + character(len=250) :: the_file + + integer :: i, j, rc, clb(2), cub(2) + integer(sfcio_intkind) :: rc2 + integer(sigio_intkind) :: rc3 + + real(esmf_kind_r8), allocatable :: latitude(:,:) + real(esmf_kind_r8), allocatable :: longitude(:,:) + real(esmf_kind_r8), pointer :: lat_src_ptr(:,:) + real(esmf_kind_r8), pointer :: lon_src_ptr(:,:) + real(esmf_kind_r8) :: deltalon + real(esmf_kind_r8), allocatable :: slat(:), wlat(:) + + type(nemsio_gfile) :: gfile + type(esmf_polekind_flag) :: polekindflag(2) + type(sfcio_head) :: sfchead + type(sigio_head) :: sighead + + print*,"- DEFINE INPUT GRID OBJECT FOR GAUSSIAN DATA." + + num_tiles_input_grid = 1 + + if (convert_sfc) then + the_file=trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1)) + elseif (convert_atm) then + the_file=trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1)) + endif + + if (trim(input_type) == "gfs_spectral") then ! sigio/sfcio format, used by + ! spectral gfs prior to 7/19/2017. + + if (convert_sfc) then ! sfcio format + print*,"- OPEN AND READ ", trim(the_file) + call sfcio_sropen(21, trim(the_file), rc2) + if (rc2 /= 0) call error_handler("OPENING FILE", rc2) + call sfcio_srhead(21, sfchead, rc2) + if (rc2 /= 0) call error_handler("READING FILE", rc2) + call sfcio_sclose(21, rc2) + i_input = sfchead%lonb + j_input = sfchead%latb + elseif (convert_atm) then ! sigio format + print*,"- OPEN AND READ ", trim(the_file) + call sigio_sropen(21, trim(the_file), rc3) + if (rc3 /= 0) call error_handler("OPENING FILE", rc3) + call sigio_srhead(21, sighead, rc3) + if (rc3 /= 0) call error_handler("READING FILE", rc3) + call sigio_sclose(21, rc3) + i_input = sighead%lonb + j_input = sighead%latb + endif + + else ! nemsio format + + call nemsio_init(iret=rc) + + print*,"- OPEN AND READ ", trim(the_file) + call nemsio_open(gfile, the_file, "read", iret=rc) + if (rc /= 0) call error_handler("OPENING FILE", rc) + + call nemsio_getfilehead(gfile, iret=rc, dimx=i_input, dimy=j_input) + if (rc /= 0) call error_handler("READING FILE", rc) + + call nemsio_close(gfile) + + endif + + ip1_input = i_input + 1 + jp1_input = j_input + 1 + + polekindflag(1:2) = ESMF_POLEKIND_MONOPOLE + + print*,"- CALL GridCreate1PeriDim FOR INPUT GRID." + input_grid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & + maxIndex=(/i_input,j_input/), & + polekindflag=polekindflag, & + periodicDim=1, & + poleDim=2, & + coordSys=ESMF_COORDSYS_SPH_DEG, & + regDecomp=(/1,npets/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridCreate1PeriDim", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID LATITUDE." + latitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_latitude", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INPUT GRID LONGITUDE." + longitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + allocate(longitude(i_input,j_input)) + allocate(latitude(i_input,j_input)) + + deltalon = 360.0_esmf_kind_r8 / real(i_input,kind=esmf_kind_r8) + do i = 1, i_input + longitude(i,:) = real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + allocate(slat(j_input)) + allocate(wlat(j_input)) + call splat(4, j_input, slat, wlat) + + do i = 1, j_input + latitude(:,i) = 90.0_esmf_kind_r8 - (acos(slat(i))* 180.0_esmf_kind_r8 / & + (4.0_esmf_kind_r8*atan(1.0_esmf_kind_r8))) + enddo + + deallocate(slat, wlat) + + print*,"- CALL FieldScatter FOR INPUT GRID LONGITUDE." + call ESMF_FieldScatter(longitude_input_grid, longitude, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldScatter FOR INPUT GRID LATITUDE." + call ESMF_FieldScatter(latitude_input_grid, latitude, rootpet=0, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL GridAddCoord FOR INPUT GRID." + call ESMF_GridAddCoord(input_grid, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridAddCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID X-COORD." + nullify(lon_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=1, & + farrayPtr=lon_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridGetCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID Y-COORD." + nullify(lat_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridGetCoord", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_src_ptr(i,j) = longitude(i,j) + if (lon_src_ptr(i,j) > 360.0_esmf_kind_r8) lon_src_ptr(i,j) = lon_src_ptr(i,j) - 360.0_esmf_kind_r8 + lat_src_ptr(i,j) = latitude(i,j) + enddo + enddo + + print*,"- CALL GridAddCoord FOR INPUT GRID." + call ESMF_GridAddCoord(input_grid, & + staggerloc=ESMF_STAGGERLOC_CORNER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridAddCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID X-COORD." + nullify(lon_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CORNER, & + coordDim=1, & + farrayPtr=lon_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridGetCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID Y-COORD." + nullify(lat_src_ptr) + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CORNER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_src_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridGetCoord", rc) + + print*,'bounds for corners ',localpet,clb(1),cub(1),clb(2),cub(2) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_src_ptr(i,j) = longitude(i,1) - (0.5_esmf_kind_r8*deltalon) + if (lon_src_ptr(i,j) > 360.0_esmf_kind_r8) lon_src_ptr(i,j) = lon_src_ptr(i,j) - 360.0_esmf_kind_r8 + if (j == 1) then + lat_src_ptr(i,j) = 90.0_esmf_kind_r8 + cycle + endif + if (j == jp1_input) then + lat_src_ptr(i,j) = -90.0_esmf_kind_r8 + cycle + endif + lat_src_ptr(i,j) = 0.5_esmf_kind_r8 * (latitude(i,j-1)+ latitude(i,j)) + enddo + enddo + + deallocate(latitude,longitude) + + end subroutine define_input_grid_gaussian + + subroutine define_input_grid_mosaic(localpet, npets) + + use netcdf + use program_setup, only : mosaic_file_input_grid, & + orog_dir_input_grid, & + orog_files_input_grid + + implicit none + + character(len=500) :: the_file + + integer, intent(in) :: localpet, npets + + integer :: id_tiles, id_dim, tile + integer :: extra, error, ncid + integer, allocatable :: decomptile(:,:) + + integer(esmf_kind_i8), allocatable :: landmask_one_tile(:,:) + + real(esmf_kind_r8), allocatable :: latitude_one_tile(:,:) + real(esmf_kind_r8), allocatable :: latitude_s_one_tile(:,:) + real(esmf_kind_r8), allocatable :: latitude_w_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_s_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_w_one_tile(:,:) + + print*,'- OPEN INPUT GRID MOSAIC FILE: ',trim(mosaic_file_input_grid) + error=nf90_open(trim(mosaic_file_input_grid),nf90_nowrite,ncid) + call netcdf_err(error, 'opening grid mosaic file') + + print*,"- READ NUMBER OF TILES" + error=nf90_inq_dimid(ncid, 'ntiles', id_tiles) + call netcdf_err(error, 'reading ntiles id') + error=nf90_inquire_dimension(ncid,id_tiles,len=num_tiles_input_grid) + call netcdf_err(error, 'reading ntiles') + + error = nf90_close(ncid) + + print*,'- NUMBER OF TILES, INPUT MODEL GRID IS ', num_tiles_input_grid + + if (mod(npets,num_tiles_input_grid) /= 0) then + call error_handler("MUST RUN WITH A TASK COUNT THAT IS A MULTIPLE OF 6.", 1) + endif + +!----------------------------------------------------------------------- +! Create ESMF grid object for the model grid. +!----------------------------------------------------------------------- + + extra = npets / num_tiles_input_grid + + allocate(decomptile(2,num_tiles_input_grid)) + + do tile = 1, num_tiles_input_grid + decomptile(:,tile)=(/1,extra/) + enddo + + print*,"- CALL GridCreateMosaic FOR INPUT MODEL GRID" + input_grid = ESMF_GridCreateMosaic(filename=trim(mosaic_file_input_grid), & + regDecompPTile=decomptile, & + staggerLocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER, & + ESMF_STAGGERLOC_EDGE1, ESMF_STAGGERLOC_EDGE2/), & + indexflag=ESMF_INDEX_GLOBAL, & + tileFilePath=trim(orog_dir_input_grid), & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridCreateMosaic", error) + +!----------------------------------------------------------------------- +! Read the mask and lat/lons. +!----------------------------------------------------------------------- + + print*,"- CALL FieldCreate FOR INPUT GRID LATITUDE." + latitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_latitude", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR INPUT GRID LONGITUDE." + longitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR INPUT GRID LATITUDE_S." + latitude_s_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + name="input_grid_latitude_s", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR INPUT GRID LONGITUDE_S." + longitude_s_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + name="input_grid_longitude_s", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR INPUT GRID LATITUDE_W." + latitude_w_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + name="input_grid_latitude_w", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR INPUT GRID LONGITUDE_W." + longitude_w_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + name="input_grid_longitude_w", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + the_file = trim(orog_dir_input_grid) // trim(orog_files_input_grid(1)) + + print*,'- OPEN FIRST INPUT GRID OROGRAPHY FILE: ',trim(the_file) + error=nf90_open(trim(the_file),nf90_nowrite,ncid) + call netcdf_err(error, 'opening ororgraphy file') + print*,"- READ GRID DIMENSIONS" + error=nf90_inq_dimid(ncid, 'lon', id_dim) + call netcdf_err(error, 'reading lon id') + error=nf90_inquire_dimension(ncid,id_dim,len=i_input) + call netcdf_err(error, 'reading lon') + error=nf90_inq_dimid(ncid, 'lat', id_dim) + call netcdf_err(error, 'reading lat id') + error=nf90_inquire_dimension(ncid,id_dim,len=j_input) + call netcdf_err(error, 'reading lat') + error = nf90_close(ncid) + + print*,"- I/J DIMENSIONS OF THE INPUT GRID TILES ", i_input, j_input + + ip1_input = i_input + 1 + jp1_input = j_input + 1 + + if (localpet == 0) then + allocate(longitude_one_tile(i_input,j_input)) + allocate(longitude_s_one_tile(i_input,jp1_input)) + allocate(longitude_w_one_tile(ip1_input,j_input)) + allocate(latitude_one_tile(i_input,j_input)) + allocate(latitude_s_one_tile(i_input,jp1_input)) + allocate(latitude_w_one_tile(ip1_input,j_input)) + allocate(landmask_one_tile(i_input,j_input)) + else + allocate(longitude_one_tile(0,0)) + allocate(longitude_s_one_tile(0,0)) + allocate(longitude_w_one_tile(0,0)) + allocate(latitude_one_tile(0,0)) + allocate(latitude_s_one_tile(0,0)) + allocate(latitude_w_one_tile(0,0)) + allocate(landmask_one_tile(0,0)) + endif + + do tile = 1, num_tiles_input_grid + if (localpet == 0) then + call get_model_latlons(mosaic_file_input_grid, orog_dir_input_grid, num_tiles_input_grid, tile, & + i_input, j_input, ip1_input, jp1_input, latitude_one_tile, & + latitude_s_one_tile, latitude_w_one_tile, longitude_one_tile, & + longitude_s_one_tile, longitude_w_one_tile) + endif + print*,"- CALL FieldScatter FOR INPUT GRID LATITUDE. TILE IS: ", tile + call ESMF_FieldScatter(latitude_input_grid, latitude_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR INPUT GRID LONGITUDE. TILE IS: ", tile + call ESMF_FieldScatter(longitude_input_grid, longitude_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR INPUT GRID LATITUDE_S. TILE IS: ", tile + call ESMF_FieldScatter(latitude_s_input_grid, latitude_s_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR INPUT GRID LONGITUDE_S. TILE IS: ", tile + call ESMF_FieldScatter(longitude_s_input_grid, longitude_s_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR INPUT GRID LATITUDE_W. TILE IS: ", tile + call ESMF_FieldScatter(latitude_w_input_grid, latitude_w_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR INPUT GRID LONGITUDE_W. TILE IS: ", tile + call ESMF_FieldScatter(longitude_w_input_grid, longitude_w_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + + deallocate(longitude_one_tile) + deallocate(longitude_s_one_tile) + deallocate(longitude_w_one_tile) + deallocate(latitude_one_tile) + deallocate(latitude_s_one_tile) + deallocate(latitude_w_one_tile) + deallocate(landmask_one_tile) + + end subroutine define_input_grid_mosaic + + subroutine define_target_grid(localpet, npets) + + use netcdf + use program_setup, only : mosaic_file_target_grid, & + orog_dir_target_grid, & + orog_files_target_grid + + implicit none + + integer, intent(in) :: localpet, npets + + character(len=500) :: the_file + + integer :: error, ncid, extra + integer :: id_tiles + integer :: id_dim, id_grid_tiles + integer :: tile + integer, allocatable :: decomptile(:,:) + integer(esmf_kind_i8), allocatable :: landmask_one_tile(:,:) + integer(esmf_kind_i8), allocatable :: seamask_one_tile(:,:) + + real(esmf_kind_r8), allocatable :: latitude_one_tile(:,:) + real(esmf_kind_r8), allocatable :: latitude_s_one_tile(:,:) + real(esmf_kind_r8), allocatable :: latitude_w_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_s_one_tile(:,:) + real(esmf_kind_r8), allocatable :: longitude_w_one_tile(:,:) + real(esmf_kind_r8), allocatable :: terrain_one_tile(:,:) + + print*,'- OPEN TARGET GRID MOSAIC FILE: ',trim(mosaic_file_target_grid) + error=nf90_open(trim(mosaic_file_target_grid),nf90_nowrite,ncid) + call netcdf_err(error, 'opening grid mosaic file') + + print*,"- READ NUMBER OF TILES" + error=nf90_inq_dimid(ncid, 'ntiles', id_tiles) + call netcdf_err(error, 'reading ntile id') + error=nf90_inquire_dimension(ncid,id_tiles,len=num_tiles_target_grid) + call netcdf_err(error, 'reading ntiles') + error=nf90_inq_varid(ncid, 'gridtiles', id_grid_tiles) + call netcdf_err(error, 'reading gridtiles id') + allocate(tiles_target_grid(num_tiles_target_grid)) + tiles_target_grid="NULL" + print*,"- READ TILE NAMES" + error=nf90_get_var(ncid, id_grid_tiles, tiles_target_grid) + call netcdf_err(error, 'reading gridtiles') + + error = nf90_close(ncid) + + print*,'- NUMBER OF TILES, TARGET MODEL GRID IS ', num_tiles_target_grid + + if (mod(npets,num_tiles_target_grid) /= 0) then + call error_handler("MUST RUN WITH TASK COUNT THAT IS A MULTIPLE OF # OF TILES.", 1) + endif + +!----------------------------------------------------------------------- +! Get the model grid specs and land mask from the orography files. +!----------------------------------------------------------------------- + + the_file = trim(orog_dir_target_grid) // trim(orog_files_target_grid(1)) + + print*,'- OPEN FIRST TARGET GRID OROGRAPHY FILE: ',trim(the_file) + error=nf90_open(trim(the_file),nf90_nowrite,ncid) + call netcdf_err(error, 'opening orography file') + print*,"- READ GRID DIMENSIONS" + error=nf90_inq_dimid(ncid, 'lon', id_dim) + call netcdf_err(error, 'reading lon id') + error=nf90_inquire_dimension(ncid,id_dim,len=i_target) + call netcdf_err(error, 'reading lon') + error=nf90_inq_dimid(ncid, 'lat', id_dim) + call netcdf_err(error, 'reading lat id') + error=nf90_inquire_dimension(ncid,id_dim,len=j_target) + call netcdf_err(error, 'reading lat') + error = nf90_close(ncid) + + print*,"- I/J DIMENSIONS OF THE TARGET GRID TILES ", i_target, j_target + + ip1_target = i_target + 1 + jp1_target = j_target + 1 + +!----------------------------------------------------------------------- +! Create ESMF grid object for the model grid. +!----------------------------------------------------------------------- + + extra = npets / num_tiles_target_grid + + allocate(decomptile(2,num_tiles_target_grid)) + + do tile = 1, num_tiles_target_grid + decomptile(:,tile)=(/1,extra/) + enddo + + print*,"- CALL GridCreateMosaic FOR TARGET GRID" + target_grid = ESMF_GridCreateMosaic(filename=trim(mosaic_file_target_grid), & + regDecompPTile=decomptile, & + staggerLocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER, & + ESMF_STAGGERLOC_EDGE1, ESMF_STAGGERLOC_EDGE2/), & + indexflag=ESMF_INDEX_GLOBAL, & + tileFilePath=trim(orog_dir_target_grid), rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridCreateMosaic", error) + +!----------------------------------------------------------------------- +! Set target model landmask (1 - land, 0 - not land) and +! seamask (1 - non-land, 0 -land). Read lat/lon on target grid. +!----------------------------------------------------------------------- + + print*,"- CALL FieldCreate FOR TARGET GRID LANDMASK." + landmask_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_I8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_landmask", rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID SEAMASK." + seamask_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_I8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_seamask", rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LATITUDE." + latitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_latitude", rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LATITUDE_S." + latitude_s_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + name="target_grid_latitude_s", rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LATITUDE_W." + latitude_w_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + name="target_grid_latitude_w", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LONGITUDE." + longitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_longitude", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LONGITUDE_S." + longitude_s_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE2, & + name="target_grid_longitude_s", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID LONGITUDE_W." + longitude_w_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_EDGE1, & + name="target_grid_longitude_w", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID TERRAIN." + terrain_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_terrain", & + rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + if (localpet == 0) then + allocate(landmask_one_tile(i_target,j_target)) + allocate(seamask_one_tile(i_target,j_target)) + allocate(latitude_one_tile(i_target,j_target)) + allocate(latitude_s_one_tile(i_target,jp1_target)) + allocate(latitude_w_one_tile(ip1_target,j_target)) + allocate(longitude_one_tile(i_target,j_target)) + allocate(longitude_s_one_tile(i_target,jp1_target)) + allocate(longitude_w_one_tile(ip1_target,j_target)) + allocate(terrain_one_tile(i_target,j_target)) + else + allocate(landmask_one_tile(0,0)) + allocate(seamask_one_tile(0,0)) + allocate(longitude_one_tile(0,0)) + allocate(longitude_s_one_tile(0,0)) + allocate(longitude_w_one_tile(0,0)) + allocate(latitude_one_tile(0,0)) + allocate(latitude_s_one_tile(0,0)) + allocate(latitude_w_one_tile(0,0)) + allocate(terrain_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + the_file = trim(orog_dir_target_grid) // trim(orog_files_target_grid(tile)) + call get_model_mask_terrain(trim(the_file), i_target, j_target, landmask_one_tile, & + terrain_one_tile) + seamask_one_tile = 0 + where(landmask_one_tile == 0) seamask_one_tile = 1 + call get_model_latlons(mosaic_file_target_grid, orog_dir_target_grid, num_tiles_target_grid, tile, & + i_target, j_target, ip1_target, jp1_target, latitude_one_tile, & + latitude_s_one_tile, latitude_w_one_tile, longitude_one_tile, & + longitude_s_one_tile, longitude_w_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID LANDMASK. TILE IS: ", tile + call ESMF_FieldScatter(landmask_target_grid, landmask_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID SEAMASK. TILE IS: ", tile + call ESMF_FieldScatter(seamask_target_grid, seamask_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LONGITUDE. TILE IS: ", tile + call ESMF_FieldScatter(longitude_target_grid, longitude_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LONGITUDE_S. TILE IS: ", tile + call ESMF_FieldScatter(longitude_s_target_grid, longitude_s_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LONGITUDE_W. TILE IS: ", tile + call ESMF_FieldScatter(longitude_w_target_grid, longitude_w_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LATITUDE. TILE IS: ", tile + call ESMF_FieldScatter(latitude_target_grid, latitude_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LATITUDE_S. TILE IS: ", tile + call ESMF_FieldScatter(latitude_s_target_grid, latitude_s_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID LATITUDE_W. TILE IS: ", tile + call ESMF_FieldScatter(latitude_w_target_grid, latitude_w_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID TERRAIN. TILE IS: ", tile + call ESMF_FieldScatter(terrain_target_grid, terrain_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + + deallocate(landmask_one_tile) + deallocate(seamask_one_tile) + deallocate(longitude_one_tile) + deallocate(longitude_s_one_tile) + deallocate(longitude_w_one_tile) + deallocate(latitude_one_tile) + deallocate(latitude_s_one_tile) + deallocate(latitude_w_one_tile) + deallocate(terrain_one_tile) + + end subroutine define_target_grid + +!----------------------------------------------------------------------- +! Read model lat/lons for a single tile from the "grid" file. +!----------------------------------------------------------------------- + + subroutine get_model_latlons(mosaic_file, orog_dir, num_tiles, tile, & + i_tile, j_tile, ip1_tile, jp1_tile, & + latitude, latitude_s, latitude_w, & + longitude, longitude_s, longitude_w) + + use netcdf + + implicit none + + character(len=*), intent(in) :: mosaic_file, orog_dir + + integer, intent(in) :: num_tiles, tile + integer, intent(in) :: i_tile, j_tile + integer, intent(in) :: ip1_tile, jp1_tile + + real(esmf_kind_r8), intent(out) :: latitude(i_tile, j_tile) + real(esmf_kind_r8), intent(out) :: latitude_s(i_tile, jp1_tile) + real(esmf_kind_r8), intent(out) :: latitude_w(ip1_tile, j_tile) + real(esmf_kind_r8), intent(out) :: longitude(i_tile, j_tile) + real(esmf_kind_r8), intent(out) :: longitude_s(i_tile, jp1_tile) + real(esmf_kind_r8), intent(out) :: longitude_w(ip1_tile, j_tile) + + character(len=25) :: grid_files(num_tiles) + character(len=255) :: grid_file + + integer :: error, id_var, ncid + integer :: id_dim, nxp, nyp, i, j, ii, jj + + real(esmf_kind_r8), allocatable :: tmpvar(:,:) + + print*,"- READ MODEL GRID FILE" + + print*,'- OPEN MOSAIC FILE: ', trim(mosaic_file) + error=nf90_open(trim(mosaic_file), nf90_nowrite, ncid) + call netcdf_err(error, 'opening mosaic file') + + print*,"- READ GRID FILE NAMES" + error=nf90_inq_varid(ncid, 'gridfiles', id_var) + call netcdf_err(error, 'reading gridfiles id') + error=nf90_get_var(ncid, id_var, grid_files) + call netcdf_err(error, 'reading gridfiles') + + error = nf90_close(ncid) + + grid_file = trim(orog_dir) // trim(grid_files(tile)) + + print*,'- OPEN GRID FILE: ', trim(grid_file) + error=nf90_open(trim(grid_file), nf90_nowrite, ncid) + call netcdf_err(error, 'opening grid file') + + print*,'- READ NXP ID' + error=nf90_inq_dimid(ncid, 'nxp', id_dim) + call netcdf_err(error, 'reading nxp id') + + print*,'- READ NXP' + error=nf90_inquire_dimension(ncid,id_dim,len=nxp) + call netcdf_err(error, 'reading nxp') + + print*,'- READ NYP ID' + error=nf90_inq_dimid(ncid, 'nyp', id_dim) + call netcdf_err(error, 'reading nyp id') + + print*,'- READ NYP' + error=nf90_inquire_dimension(ncid,id_dim,len=nyp) + call netcdf_err(error, 'reading nyp') + + if ((nxp/2 /= i_tile) .or. (nyp/2 /= j_tile)) then + call error_handler("DIMENSION MISMATCH IN GRID FILE.", 1) + endif + + allocate(tmpvar(nxp,nyp)) + + print*,'- READ LONGITUDE ID' + error=nf90_inq_varid(ncid, 'x', id_var) + call netcdf_err(error, 'reading longitude id') + + print*,'- READ LONGITUDE' + error=nf90_get_var(ncid, id_var, tmpvar) + call netcdf_err(error, 'reading longitude') + + do j = 1, j_tile + do i = 1, i_tile + ii = 2*i + jj = 2*j + longitude(i,j) = tmpvar(ii,jj) + enddo + enddo + + do j = 1, jp1_tile + do i = 1, i_tile + ii = 2*i + jj = (2*j) - 1 + longitude_s(i,j) = tmpvar(ii,jj) + enddo + enddo + + do j = 1, j_tile + do i = 1, ip1_tile + ii = (2*i) - 1 + jj = 2*j + longitude_w(i,j) = tmpvar(ii,jj) + enddo + enddo + + print*,'- READ LATITUDE ID' + error=nf90_inq_varid(ncid, 'y', id_var) + call netcdf_err(error, 'reading latitude id') + + print*,'- READ LATIITUDE' + error=nf90_get_var(ncid, id_var, tmpvar) + call netcdf_err(error, 'reading latitude') + + do j = 1, j_tile + do i = 1, i_tile + ii = 2*i + jj = 2*j + latitude(i,j) = tmpvar(ii,jj) + enddo + enddo + + do j = 1, jp1_tile + do i = 1, i_tile + ii = 2*i + jj = (2*j) - 1 + latitude_s(i,j) = tmpvar(ii,jj) + enddo + enddo + + do j = 1, j_tile + do i = 1, ip1_tile + ii = (2*i) - 1 + jj = 2*j + latitude_w(i,j) = tmpvar(ii,jj) + enddo + enddo + + deallocate(tmpvar) + + error = nf90_close(ncid) + + end subroutine get_model_latlons + +!----------------------------------------------------------------------- +! Read the model land mask and terrain for a single tile. +!----------------------------------------------------------------------- + + subroutine get_model_mask_terrain(orog_file, idim, jdim, mask, terrain) + + use netcdf + + implicit none + + character(len=*), intent(in) :: orog_file + + integer, intent(in) :: idim, jdim + integer(esmf_kind_i8), intent(out) :: mask(idim,jdim) + + real(esmf_kind_i8), intent(out) :: terrain(idim,jdim) + + integer :: error, lat, lon + integer :: ncid, id_dim, id_var + + real(kind=4), allocatable :: dummy(:,:) + + print*,"- READ MODEL LAND MASK FILE" + + print*,'- OPEN LAND MASK FILE: ', orog_file + error=nf90_open(orog_file,nf90_nowrite,ncid) + call netcdf_err(error, 'opening land mask file') + + print*,"- READ I-DIMENSION" + error=nf90_inq_dimid(ncid, 'lon', id_dim) + call netcdf_err(error, 'reading idim id') + error=nf90_inquire_dimension(ncid,id_dim,len=lon) + call netcdf_err(error, 'reading idim') + + print*,"- READ J-DIMENSION" + error=nf90_inq_dimid(ncid, 'lat', id_dim) + call netcdf_err(error, 'reading jdim id') + error=nf90_inquire_dimension(ncid,id_dim,len=lat) + call netcdf_err(error, 'reading jdim') + + print*,"- I/J DIMENSIONS: ", lon, lat + + if ((lon /= idim) .or. (lat /= jdim)) then + call error_handler("MISMATCH IN DIMENSIONS.", 1) + endif + + allocate(dummy(idim,jdim)) + + print*,"- READ LAND MASK" + error=nf90_inq_varid(ncid, 'slmsk', id_var) + call netcdf_err(error, 'reading slmsk id') + error=nf90_get_var(ncid, id_var, dummy) + call netcdf_err(error, 'reading slmsk') + mask = nint(dummy) + + print*,"- READ RAW OROGRAPHY." + error=nf90_inq_varid(ncid, 'orog_raw', id_var) + call netcdf_err(error, 'reading orog_raw id') + error=nf90_get_var(ncid, id_var, dummy) + call netcdf_err(error, 'reading orog_raw') + terrain = dummy + + error = nf90_close(ncid) + + deallocate (dummy) + + end subroutine get_model_mask_terrain + + subroutine cleanup_input_target_grid_data + + implicit none + + integer :: rc + + print*,"- DESTROY MODEL DATA." + + if (ESMF_FieldIsCreated(latitude_s_input_grid)) then + call ESMF_FieldDestroy(latitude_s_input_grid, rc=rc) + endif + if (ESMF_FieldIsCreated(latitude_w_input_grid)) then + call ESMF_FieldDestroy(latitude_w_input_grid, rc=rc) + endif + if (ESMF_FieldIsCreated(longitude_s_input_grid)) then + call ESMF_FieldDestroy(longitude_s_input_grid, rc=rc) + endif + if (ESMF_FieldIsCreated(longitude_w_input_grid)) then + call ESMF_FieldDestroy(longitude_w_input_grid, rc=rc) + endif + call ESMF_FieldDestroy(landmask_target_grid, rc=rc) + call ESMF_FieldDestroy(latitude_target_grid, rc=rc) + call ESMF_FieldDestroy(latitude_s_target_grid, rc=rc) + call ESMF_FieldDestroy(latitude_w_target_grid, rc=rc) + call ESMF_FieldDestroy(longitude_target_grid, rc=rc) + call ESMF_FieldDestroy(longitude_s_target_grid, rc=rc) + call ESMF_FieldDestroy(longitude_w_target_grid, rc=rc) + call ESMF_FieldDestroy(seamask_target_grid, rc=rc) + call ESMF_FieldDestroy(terrain_target_grid, rc=rc) + call ESMF_GridDestroy(input_grid, rc=rc) + call ESMF_GridDestroy(target_grid, rc=rc) + + end subroutine cleanup_input_target_grid_data + + end module model_grid diff --git a/sorc/chgres_cube.fd/sorc/program_setup.f90 b/sorc/chgres_cube.fd/sorc/program_setup.f90 new file mode 100644 index 0000000000..1d75de537d --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/program_setup.f90 @@ -0,0 +1,443 @@ + module program_setup + +!-------------------------------------------------------------------------- +! Module program_setup +! +! Abstract: Set up program execution +! +! Public Subroutines: +! ------------------- +! read_setup_namelist Reads configuration namelist +! calc_soil_params_driver Computes soil parameters +! +! Public variables: +! ----------------- +! atm_file_input_grid File names of input atmospheric data. +! History or gaussian input type only. +! atm_core_files_input_grid File names of input atmospheric restart +! core files. +! atm_tracer_files_input_grid File names of input atmospheric restart +! tracer files. +! atm_weight_file File containing pre-computed weights +! to horizontally interpolate +! atmospheric fields. +! bb_target Soil 'b' parameter, target grid +! convert_atm Convert atmospheric data when true. +! convert_nst Convert nst data when true. +! convert_sfc Convert sfc data when true. +! cres_target_grid Target grid resolution, i.e., C768. +! cycle_mon/day/hour Cycle month/day/hour +! data_dir_input_grid Directory containing input atm or sfc +! files. +! drysmc_input/target Air dry soil moisture content input/ +! target grids. +! fix_dir_target_grid Directory containing target grid +! pre-computed fixed data (ex: soil type) +! halo_blend Number of row/cols of blending halo, +! where model tendencies and lateral +! boundary tendencies are applied. +! Regional target grids only. +! halo_bndy Number of row/cols of lateral halo, +! where pure lateral bndy conditions are +! applied (regional target grids). +! input_type Input data type: "restart" for fv3 +! tiled restart files; "history" for fv3 +! tiled history files; "gaussian" +! for fv3 gaussian nemsio files; +! "gfs_gaussian" for spectral gfs gaussian +! nemsio files. +! max_tracers Maximum number of atmospheric tracers +! processed +! maxsmc_input/target Maximum soil moisture content input/ +! target grids +! mosaic_file_input_grid Input grid mosaic file. Not used +! with "gaussian" or "gfs_gaussian" +! input type. +! mosaic_file_target_grid Target grid mosaic file +! nst_files_input_grid File name of input nst data. Only +! used for input_type "gfs_gaussian". +! num_tracers Number of atmospheric tracers to +! be processed. +! orog_dir_input_grid Directory containing the input grid +! orography files. Not used for "gaussian" +! or "gfs_gaussian" input types. +! orog_files_input_grid Input grid orography files. Not used +! for "gaussian" or "gfs_gaussian" +! input types. +! orog_dir_target_grid Directory containing the target grid +! orography files. +! orog_files_target_grid Target grid orography files. +! refsmc_input/target Reference soil moisture content input/ +! target grids (onset of soil moisture +! stress). +! regional For regional target grids. When '1' +! remove boundary halo region from +! atmospheric/surface data and +! output atmospheric boundary file. +! When '2' output boundary file only. +! Default is '0' (global grids). +! satpsi_target Saturated soil potential, target grid +! sfc_files_input_grid File names containing input surface data. +! tracers Name of each atmos tracer to be processed. +! These names will be used to identify +! the tracer records in the output files. +! Follows the convention in the field table. +! tracers_input Name of each atmos tracer record in +! the input file. May be different from +! value in 'tracers'. +! vcoord_file_target_grid Vertical coordinate definition file +! wltsmc_input/target Wilting point soil moisture content +! input/target grids +! +!-------------------------------------------------------------------------- + + implicit none + + private + + character(len=500), public :: atm_files_input_grid(6) = "NULL" + character(len=500), public :: atm_core_files_input_grid(7) = "NULL" + character(len=500), public :: atm_tracer_files_input_grid(6) = "NULL" + character(len=500), public :: data_dir_input_grid = "NULL" + character(len=500), public :: fix_dir_target_grid = "NULL" + character(len=500), public :: mosaic_file_input_grid = "NULL" + character(len=500), public :: mosaic_file_target_grid = "NULL" + character(len=500), public :: nst_files_input_grid = "NULL" + character(len=500), public :: orog_dir_input_grid = "NULL" + character(len=500), public :: orog_files_input_grid(6) = "NULL" + character(len=500), public :: orog_dir_target_grid = "NULL" + character(len=500), public :: orog_files_target_grid(6) = "NULL" + character(len=500), public :: sfc_files_input_grid(6) = "NULL" + character(len=500), public :: vcoord_file_target_grid = "NULL" + character(len=6), public :: cres_target_grid = " " + character(len=500), public :: atm_weight_file="NULL" + character(len=20), public :: input_type="restart" + + integer, parameter, public :: max_tracers=100 + integer, public :: num_tracers + character(len=20), public :: tracers(max_tracers)="NULL" + character(len=20), public :: tracers_input(max_tracers)="NULL" + + integer, public :: cycle_mon = -999 + integer, public :: cycle_day = -999 + integer, public :: cycle_hour = -999 + integer, public :: regional = 0 + integer, public :: halo_bndy = 0 + integer, public :: halo_blend = 0 + + logical, public :: convert_atm = .false. + logical, public :: convert_nst = .false. + logical, public :: convert_sfc = .false. + + real, allocatable, public :: drysmc_input(:), drysmc_target(:) + real, allocatable, public :: maxsmc_input(:), maxsmc_target(:) + real, allocatable, public :: refsmc_input(:), refsmc_target(:) + real, allocatable, public :: wltsmc_input(:), wltsmc_target(:) + real, allocatable, public :: bb_target(:), satpsi_target(:) + + public :: read_setup_namelist + public :: calc_soil_params_driver + + contains + + subroutine read_setup_namelist + + implicit none + + integer :: is, ie, ierr + + namelist /config/ mosaic_file_target_grid, & + fix_dir_target_grid, & + orog_dir_target_grid, & + orog_files_target_grid, & + mosaic_file_input_grid, & + orog_dir_input_grid, & + orog_files_input_grid, & + nst_files_input_grid, & + sfc_files_input_grid, & + atm_files_input_grid, & + atm_core_files_input_grid, & + atm_tracer_files_input_grid, & + data_dir_input_grid, & + vcoord_file_target_grid, & + cycle_mon, cycle_day, & + cycle_hour, convert_atm, & + convert_nst, convert_sfc, & + regional, input_type, & + atm_weight_file, tracers, & + tracers_input + + print*,"- READ SETUP NAMELIST" + + open(41, file="./fort.41", iostat=ierr) + if (ierr /= 0) call error_handler("OPENING SETUP NAMELIST.", ierr) + read(41, nml=config, iostat=ierr) + if (ierr /= 0) call error_handler("READING SETUP NAMELIST.", ierr) + close (41) + + orog_dir_target_grid = trim(orog_dir_target_grid) // '/' + orog_dir_input_grid = trim(orog_dir_input_grid) // '/' + +!------------------------------------------------------------------------- +! Determine CRES of target grid from the name of the mosaic file. +!------------------------------------------------------------------------- + + is = index(mosaic_file_target_grid, "/", .true.) + ie = index(mosaic_file_target_grid, "_mosaic") + + if (is == 0 .or. ie == 0) then + call error_handler("CANT DETERMINE CRES FROM MOSAIC FILE.", 1) + endif + + cres_target_grid = mosaic_file_target_grid(is+1:ie-1) + + if (.not. convert_sfc .and. .not. convert_atm) then + call error_handler("MUST CONVERT EITHER AN ATM OR SFC FILE.", 1) + endif + +!------------------------------------------------------------------------- +! Flag for processing stand-alone regional grid. When '1', +! remove halo from atmospheric and surface data and output +! atmospheric lateral boundary condition file. When '2', +! create lateral boundary file only. When '0' (the default), +! process normally as a global grid. +!------------------------------------------------------------------------- + + if (regional > 0) then + halo_bndy = 3 + halo_blend = 5 + print*,"- PROCESSING A REGIONAL NEST WITH A BOUNDARY HALO OF ",halo_bndy + print*,"- PROCESSING A REGIONAL NEST WITH A BLENDING HALO OF ",halo_blend + endif + + num_tracers = 0 + do is = 1, max_tracers + if (trim(tracers(is)) == "NULL") exit + num_tracers = num_tracers + 1 + print*,"- WILL PROCESS TRACER ", trim(tracers(is)) + enddo + +!------------------------------------------------------------------------- +! Ensure program recognizes the input data type. +!------------------------------------------------------------------------- + + select case (trim(input_type)) + case ("restart") + print*,'- INPUT DATA FROM FV3 TILED RESTART FILES.' + case ("history") + print*,'- INPUT DATA FROM FV3 TILED HISTORY FILES.' + case ("gaussian") + print*,'- INPUT DATA FROM FV3 GAUSSIAN NEMSIO FILE.' + case ("gfs_gaussian") + print*,'- INPUT DATA FROM SPECTRAL GFS GAUSSIAN NEMSIO FILE.' + case ("gfs_spectral") + print*,'- INPUT DATA FROM SPECTRAL GFS SIGIO/SFCIO FILE.' + case default + call error_handler("UNRECOGNIZED INPUT DATA TYPE.", 1) + end select + + return + + end subroutine read_setup_namelist + + subroutine calc_soil_params_driver(localpet) + + implicit none + + integer, intent(in) :: localpet + + integer, parameter :: num_statsgo = 16 + real, parameter :: smlow_statsgo = 0.5 + real, parameter :: smhigh_statsgo = 6.0 + +! zobler soil type used by spectral gfs prior to June 2017. + integer, parameter :: num_zobler = 9 + real, parameter :: smlow_zobler = 0.5 + real, parameter :: smhigh_zobler = 6.0 + + integer :: num_soil_cats + + real :: bb_statsgo(num_statsgo) + real :: maxsmc_statsgo(num_statsgo) + real :: satdk_statsgo(num_statsgo) + real :: satpsi_statsgo(num_statsgo) + + real :: bb_zobler(num_zobler) + real :: maxsmc_zobler(num_zobler) + real :: satdk_zobler(num_zobler) + real :: satpsi_zobler(num_zobler) + + real, allocatable :: bb(:) + real :: smlow, smhigh + real, allocatable :: f11(:) + real, allocatable :: satdk(:) + real, allocatable :: satpsi(:) + real, allocatable :: satdw(:) + + data bb_statsgo /4.05, 4.26, 4.74, 5.33, 5.33, 5.25, & + 6.77, 8.72, 8.17, 10.73, 10.39, 11.55, & + 5.25, -9.99, 4.05, 4.26/ + + data maxsmc_statsgo /0.395, 0.421, 0.434, 0.476, 0.476, 0.439, & + 0.404, 0.464, 0.465, 0.406, 0.468, 0.457, & + 0.464, -9.99, 0.200, 0.421/ + + data satdk_statsgo /1.7600e-4, 1.4078e-5, 5.2304e-6, 2.8089e-6, 2.8089e-6, & + 3.3770e-6, 4.4518e-6, 2.0348e-6, 2.4464e-6, 7.2199e-6, & + 1.3444e-6, 9.7384e-7, 3.3770e-6, -9.99, 1.4078e-5, & + 1.4078e-5/ + + data satpsi_statsgo /0.0350, 0.0363, 0.1413, 0.7586, 0.7586, 0.3548, & + 0.1349, 0.6166, 0.2630, 0.0977, 0.3236, 0.4677, & + 0.3548, -9.99, 0.0350, 0.0363/ + + data bb_zobler /4.26, 8.72, 11.55, 4.74, 10.73, 8.17, & + 6.77, 5.25, 4.26/ + + data maxsmc_zobler /0.421, 0.464, 0.468, 0.434, 0.406, 0.465, & + 0.404, 0.439, 0.421/ + + data satdk_zobler /1.41e-5, 0.20e-5, 0.10e-5, 0.52e-5, 0.72e-5, & + 0.25e-5, 0.45e-5, 0.34e-5, 1.41e-5/ + + data satpsi_zobler /0.040, 0.620, 0.470, 0.140, 0.100, 0.260, & + 0.140, 0.360, 0.040/ + +!------------------------------------------------------------------------- +! Compute soil parameters for the input grid. +!------------------------------------------------------------------------- + + select case (trim(input_type)) + case ("gfs_spectral") + print*,'- INPUT GRID USED ZOBLER SOIL TYPES.' + num_soil_cats = num_zobler + case default + print*,'- INPUT GRID USED STATSGO SOIL TYPES.' + num_soil_cats = num_statsgo + end select + + allocate(maxsmc_input(num_soil_cats)) + allocate(wltsmc_input(num_soil_cats)) + allocate(drysmc_input(num_soil_cats)) + allocate(refsmc_input(num_soil_cats)) + allocate(bb(num_soil_cats)) + allocate(satdk(num_soil_cats)) + allocate(satpsi(num_soil_cats)) + allocate(satdw(num_soil_cats)) + allocate(f11(num_soil_cats)) + + select case (trim(input_type)) + case ("gfs_spectral") + smlow = smlow_zobler + smhigh = smhigh_zobler + maxsmc_input = maxsmc_zobler + bb = bb_zobler + satdk = satdk_zobler + satpsi = satpsi_zobler + case default + smlow = smlow_statsgo + smhigh = smhigh_statsgo + maxsmc_input = maxsmc_statsgo + bb = bb_statsgo + satdk = satdk_statsgo + satpsi = satpsi_statsgo + end select + + call calc_soil_params(num_soil_cats, smlow, smhigh, satdk, maxsmc_input, & + bb, satpsi, satdw, f11, refsmc_input, drysmc_input, wltsmc_input) + + deallocate(bb, satdk, satpsi, satdw, f11) + + if (localpet == 0) print*,'maxsmc input grid ',maxsmc_input + if (localpet == 0) print*,'wltsmc input grid ',wltsmc_input + +!------------------------------------------------------------------------- +! Compute soil parameters for the target grid. +!------------------------------------------------------------------------- + + print*,'- TARGET GRID USEING STATSGO SOIL TYPES.' + + num_soil_cats = num_statsgo + + allocate(maxsmc_target(num_soil_cats)) + allocate(wltsmc_target(num_soil_cats)) + allocate(drysmc_target(num_soil_cats)) + allocate(refsmc_target(num_soil_cats)) + allocate(bb_target(num_soil_cats)) + allocate(satpsi_target(num_soil_cats)) + allocate(satdk(num_soil_cats)) + allocate(satdw(num_soil_cats)) + allocate(f11(num_soil_cats)) + + smlow = smlow_statsgo + smhigh = smhigh_statsgo + maxsmc_target = maxsmc_statsgo + bb_target = bb_statsgo + satdk = satdk_statsgo + satpsi_target = satpsi_statsgo + + call calc_soil_params(num_soil_cats, smlow, smhigh, satdk, maxsmc_target, & + bb_target, satpsi_target, satdw, f11, refsmc_target, drysmc_target, wltsmc_target) + + deallocate(satdk, satdw, f11) + + if (localpet == 0) print*,'maxsmc target grid ',maxsmc_target + if (localpet == 0) print*,'wltsmc input grid ',wltsmc_target + + end subroutine calc_soil_params_driver + + subroutine calc_soil_params(num_soil_cats, smlow, smhigh, satdk, & + maxsmc, bb, satpsi, satdw, f11, refsmc, drysmc, wltsmc) + + implicit none + + integer, intent(in) :: num_soil_cats + + real, intent(in) :: smlow, smhigh + real, intent(in) :: bb(num_soil_cats) + real, intent(in) :: maxsmc(num_soil_cats) + real, intent(in) :: satdk(num_soil_cats) + real, intent(in) :: satpsi(num_soil_cats) + + real, intent(out) :: f11(num_soil_cats) + real, intent(out) :: satdw(num_soil_cats) + real, intent(out) :: refsmc(num_soil_cats) + real, intent(out) :: drysmc(num_soil_cats) + real, intent(out) :: wltsmc(num_soil_cats) + + integer :: i + + real :: refsmc1 + real :: wltsmc1 + + satdw = 0.0 + f11 = 0.0 + refsmc = 0.0 + wltsmc = 0.0 + drysmc = 0.0 + + do i = 1, num_soil_cats + + if (maxsmc(i) > 0.0) then + + SATDW(I) = BB(I)*SATDK(I)*(SATPSI(I)/MAXSMC(I)) + F11(I) = ALOG10(SATPSI(I)) + BB(I)*ALOG10(MAXSMC(I)) + 2.0 + REFSMC1 = MAXSMC(I)*(5.79E-9/SATDK(I)) **(1.0/(2.0*BB(I)+3.0)) + REFSMC(I) = REFSMC1 + (MAXSMC(I)-REFSMC1) / SMHIGH + WLTSMC1 = MAXSMC(I) * (200.0/SATPSI(I))**(-1.0/BB(I)) + WLTSMC(I) = WLTSMC1 - SMLOW * WLTSMC1 + +!---------------------------------------------------------------------- +! CURRENT VERSION DRYSMC VALUES THAT EQUATE TO WLTSMC. +! FUTURE VERSION COULD LET DRYSMC BE INDEPENDENTLY SET VIA NAMELIST. +!---------------------------------------------------------------------- + + DRYSMC(I) = WLTSMC(I) + + end if + + END DO + + end subroutine calc_soil_params + + end module program_setup diff --git a/sorc/chgres_cube.fd/sorc/search_util.f90 b/sorc/chgres_cube.fd/sorc/search_util.f90 new file mode 100644 index 0000000000..7f67286f9a --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/search_util.f90 @@ -0,0 +1,191 @@ + module search_util + +!-------------------------------------------------------------------------- +! Module search +! +! Abstract: Replace undefined values with a valid value. This can +! happen for an isolated lake or island that is unresolved by +! the input grid. +! +! Public Subroutines: +! ------------------- +! search Performs the search and replace. +! +!-------------------------------------------------------------------------- + + private + + public :: search + + contains + + subroutine search (field, mask, idim, jdim, tile, field_num, latitude) + +!----------------------------------------------------------------------- +! Replace undefined values on the model grid with a valid value at +! a nearby neighbor. Undefined values are typically associated +! with isolated islands where there is no source data. +! +! Routine searches a neighborhood with a radius of 100 grid points. +! If no valid value is found, a default value is used. +! +! Note: This routine works for one tile of a cubed sphere grid. It +! does not consider valid values at adjacent faces. That is a +! future upgrade. +!----------------------------------------------------------------------- + + use esmf + + implicit none + + include 'mpif.h' + + integer, intent(in) :: idim, jdim, tile, field_num + integer(esmf_kind_i8), intent(in) :: mask(idim,jdim) + + real(esmf_kind_r8), intent(in), optional :: latitude(idim,jdim) + + real(esmf_kind_r8), intent(inout) :: field(idim,jdim) + + integer :: i, j, krad, ii, jj + integer :: istart, iend + integer :: jstart, jend + integer :: ierr + + real :: default_value + real(esmf_kind_r8) :: field_save(idim,jdim) + +!----------------------------------------------------------------------- +! Set default value. +!----------------------------------------------------------------------- + + select case (field_num) + case (0) ! most nst fields + default_value = 0.0 + case (1) ! ifd + default_value = 1.0 + case (7) ! terrain height, flag value to turn off terrain adjustment + ! of soil temperatures. + default_value = -99999.9 + case (11) ! water temperature will use latitude-dependent value + default_value = -999.0 + case (21) ! ice temperature + default_value = 265.0 + case (30) ! xz + default_value = 30.0 + case (65) ! snow liq equivalent + default_value = 0.0 + case (66) ! snow depth + default_value = 0.0 + case (83) ! z0 (cm) + default_value = 0.01 + case (85) ! soil temp + default_value = 280.0 + case (86) ! soil moisture (volumetric) + default_value = 0.18 + case (91) ! sea ice fraction + default_value = 0.5 + case (92) ! sea ice depth (meters) + default_value = 1.0 + case (223) ! canopy moist + default_value = 0.0 + case (224) ! soil type, flag value to turn off soil moisture rescaling. + default_value = -99999.9 + case default + print*,'- FATAL ERROR. UNIDENTIFIED FIELD NUMBER : ', field + call mpi_abort(mpi_comm_world, 77, ierr) + end select + +!----------------------------------------------------------------------- +! Perform search and replace. +!----------------------------------------------------------------------- + + field_save = field + +!$OMP PARALLEL DO DEFAULT(NONE), & +!$OMP SHARED(IDIM,JDIM,MASK,FIELD_SAVE,FIELD,TILE,LATITUDE,DEFAULT_VALUE,FIELD_NUM), & +!$OMP PRIVATE(I,J,KRAD,ISTART,IEND,JSTART,JEND,II,JJ) + + J_LOOP : do j = 1, jdim + I_LOOP : do i = 1, idim + + if (mask(i,j) == 1 .and. field_save(i,j) < -9999.0) then + + KRAD_LOOP : do krad = 1, 100 + + istart = i - krad + iend = i + krad + jstart = j - krad + jend = j + krad + + JJ_LOOP : do jj = jstart, jend + II_LOOP : do ii = istart, iend + +!----------------------------------------------------------------------- +! Search only along outer square. +!----------------------------------------------------------------------- + + if ((jj == jstart) .or. (jj == jend) .or. & + (ii == istart) .or. (ii == iend)) then + + if (jj < 1 .or. jj > jdim) cycle JJ_LOOP + if (ii < 1 .or. ii > idim) cycle II_LOOP + + if (mask(ii,jj) == 1 .and. field_save(ii,jj) > -9999.0) then + field(i,j) = field_save(ii,jj) +! write(6,100) tile,i,j,ii,jj,field(i,j) + cycle I_LOOP + endif + + endif + + enddo II_LOOP + enddo JJ_LOOP + + enddo KRAD_LOOP + + if (field_num == 11) then + call sst_guess(latitude(i,j), field(i,j)) + elseif (field_num == 91) then ! sea ice fract + if (abs(latitude(i,j)) > 55.0) then + field(i,j) = default_value + else + field(i,j) = 0.0 + endif + else + field(i,j) = default_value ! Search failed. Use default value. + endif + + write(6,101) tile,i,j,field(i,j) + + endif + enddo I_LOOP + enddo J_LOOP +!$OMP END PARALLEL DO + + 100 format(1x,"- MISSING POINT TILE: ",i2," I/J: ",i5,i5," SET TO VALUE AT: ",i5,i5,". NEW VALUE IS: ",f8.3) + 101 format(1x,"- MISSING POINT TILE: ",i2," I/J: ",i5,i5," SET TO DEFAULT VALUE OF: ",f8.3) + + end subroutine search + + subroutine sst_guess(latitude, sst) + + use esmf + + implicit none + + real(esmf_kind_r8), intent(in) :: latitude + + real(esmf_kind_r8), intent(out) :: sst + + if (latitude >= 60.0) then + sst = 273.16 + elseif (abs(latitude) <= 30.0) then + sst = 300.0 + else + sst = (-0.8947) * abs(latitude) + 326.84 + endif + + end subroutine sst_guess + + end module search_util diff --git a/sorc/chgres_cube.fd/sorc/static_data.F90 b/sorc/chgres_cube.fd/sorc/static_data.F90 new file mode 100644 index 0000000000..9d6f7fc75f --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/static_data.F90 @@ -0,0 +1,528 @@ + module static_data + +!-------------------------------------------------------------------------- +! Module static data +! +! Abstract: Read pre-computed static/climatological data on the fv3 +! target grid. Time interpolate if necessary (for example a +! monthly climo fields). +! +! Public Subroutines: +! ------------------- +! get_static_fields Driver routine to read/time interpolate +! static/climo fields on the fv3 target +! grid. +! cleanup_static_fields Free up memory for fields in this module. +! +! Public variables: +! ----------------- +! alnsf_target_grid near ir black sky albedo +! alnwf_target_grid near ir white sky albedo +! alvsf_target_grid visible black sky albedo +! alvwf_target_grid visible white sky albedo +! facsf_target_grid fractional coverage for strong +! zenith angle dependent albedo +! facwf_target_grid fractional coverage for weak +! zenith angle dependent albedo +! max_veg_greenness_target_grid maximum annual greenness fraction +! min_veg_greenness_target_grid minimum annual greenness fraction +! mxsno_albedo_target_grid maximum snow albedo +! slope_type_target_grid slope type +! soil_type_target_grid soil type +! substrate_temp_target_grid soil subtrate temperature +! veg_greenness_target_grid vegetation greenness fraction +! veg_type_targe_grid vegetation type +! +!-------------------------------------------------------------------------- + + use esmf + + implicit none + + private + + type(esmf_field), public :: alvsf_target_grid + type(esmf_field), public :: alvwf_target_grid + type(esmf_field), public :: alnsf_target_grid + type(esmf_field), public :: alnwf_target_grid + type(esmf_field), public :: facsf_target_grid + type(esmf_field), public :: facwf_target_grid + type(esmf_field), public :: max_veg_greenness_target_grid + type(esmf_field), public :: min_veg_greenness_target_grid + type(esmf_field), public :: mxsno_albedo_target_grid + type(esmf_field), public :: slope_type_target_grid + type(esmf_field), public :: soil_type_target_grid + type(esmf_field), public :: substrate_temp_target_grid + type(esmf_field), public :: veg_greenness_target_grid + type(esmf_field), public :: veg_type_target_grid + + public :: get_static_fields + public :: cleanup_static_fields + + contains + +!------------------------------------------------------------------------------ +! Read static fields on the target grid. +!------------------------------------------------------------------------------ + + subroutine get_static_fields(localpet) + + use model_grid, only : target_grid, & + num_tiles_target_grid, & + i_target, j_target + + implicit none + + integer, intent(in) :: localpet + + integer :: error, tile, i, j + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: max_data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: min_data_one_tile(:,:) + + if (localpet==0) then + allocate(data_one_tile(i_target,j_target)) + else + allocate(data_one_tile(0,0)) + endif + +!------------------------------------------------------------------------------ +! Slope type +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID SLOPE TYPE." + slope_type_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('slope_type', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID SLOPE TYPE." + call ESMF_FieldScatter(slope_type_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! Maximum snow albedo. +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID MAXIMUM SNOW ALBEDO." + mxsno_albedo_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('maximum_snow_albedo', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID MAXIMUM SNOW ALBEDO." + call ESMF_FieldScatter(mxsno_albedo_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! Soil type +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID SOIL TYPE." + soil_type_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('soil_type', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID SOIL TYPE." + call ESMF_FieldScatter(soil_type_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! Vegetation type +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID VEGETATION TYPE." + veg_type_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('vegetation_type', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID VEGETATION TYPE." + call ESMF_FieldScatter(veg_type_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! Vegetation greenness +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID VEGETATION GREENNESS." + veg_greenness_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID MAXIMUM VEGETATION GREENNESS." + max_veg_greenness_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID MINIMUM VEGETATION GREENNESS." + min_veg_greenness_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + if (localpet == 0) then + allocate(max_data_one_tile(i_target,j_target)) + allocate(min_data_one_tile(i_target,j_target)) + else + allocate(max_data_one_tile(0,0)) + allocate(min_data_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('vegetation_greenness', i_target, j_target, tile, data_one_tile, & + max_data_one_tile, min_data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID VEGETATION GREENNESS." + call ESMF_FieldScatter(veg_greenness_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID MAXIMUM VEGETATION GREENNESS." + call ESMF_FieldScatter(max_veg_greenness_target_grid, max_data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + print*,"- CALL FieldScatter FOR TARGET GRID MINIMUM VEGETATION GREENNESS." + call ESMF_FieldScatter(min_veg_greenness_target_grid, min_data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + + deallocate(max_data_one_tile, min_data_one_tile) + +!------------------------------------------------------------------------------ +! Soil substrate temperature +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID SUBSTRATE TEMPERATURE." + substrate_temp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('substrate_temperature', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID SUBSTRATE TEMPERATURE." + call ESMF_FieldScatter(substrate_temp_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! Four-component albedo. +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR ALVSF." + alvsf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('visible_black_sky_albedo', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID ALVSF." + call ESMF_FieldScatter(alvsf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + + print*,"- CALL FieldCreate FOR ALVWF." + alvwf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('visible_white_sky_albedo', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID ALVWF." + call ESMF_FieldScatter(alvwf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + + print*,"- CALL FieldCreate FOR ALNSF." + alnsf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('near_IR_black_sky_albedo', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID ALNSF." + call ESMF_FieldScatter(alnsf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + + print*,"- CALL FieldCreate FOR ALNWF." + alnwf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('near_IR_white_sky_albedo', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID ALNWF." + call ESMF_FieldScatter(alnwf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + +!------------------------------------------------------------------------------ +! facsf and facwf +!------------------------------------------------------------------------------ + + print*,"- CALL FieldCreate FOR TARGET GRID FACSF." + facsf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + print*,"- CALL FieldCreate FOR TARGET GRID FACWF." + facwf_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", error) + + do tile = 1, num_tiles_target_grid + if (localpet == 0) then + call read_static_file('facsf', i_target, j_target, tile, data_one_tile) + endif + print*,"- CALL FieldScatter FOR TARGET GRID FACSF." + call ESMF_FieldScatter(facsf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + if (localpet == 0) then + do j = 1, j_target + do i = 1, i_target + if (data_one_tile(i,j) >= 0.0) then + data_one_tile(i,j) = 1.0 - data_one_tile(i,j) + endif + enddo + enddo + endif + call ESMF_FieldScatter(facwf_target_grid, data_one_tile, rootpet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", error) + enddo + + deallocate(data_one_tile) + + end subroutine get_static_fields + +!------------------------------------------------------------------------------ +! Read data file. +!------------------------------------------------------------------------------ + + subroutine read_static_file(field, i_target, j_target, tile, & + data_one_tile, max_data_one_tile, & + min_data_one_tile) + + use netcdf + use model_grid, only : tiles_target_grid + use program_setup, only : fix_dir_target_grid, cres_target_grid, & + cycle_mon, cycle_day, cycle_hour + + implicit none + + character(len=*), intent(in) :: field + character(len=100) :: filename + character(len=500) :: the_file + + integer, intent(in) :: i_target, j_target, tile + + real(esmf_kind_r8), intent(out) :: data_one_tile(i_target,j_target) + real(esmf_kind_r8), intent(out), optional :: max_data_one_tile(i_target,j_target) + real(esmf_kind_r8), intent(out), optional :: min_data_one_tile(i_target,j_target) + + integer :: bound1, bound2 + integer :: error, ncid, id_var, n + integer :: i, j, id_time, num_times + integer :: idat(8), jdat(8) + integer, allocatable :: days_since(:) + + real(kind=4), allocatable :: dummy(:,:,:) + real(esmf_kind_r8) :: num_days, num_days_rec1, rinc(5) + real(esmf_kind_r8) :: weight_rec1, weight_rec2 + + if (trim(field) == 'facsf') filename = "/" // trim(cres_target_grid) // ".facsf." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'maximum_snow_albedo') filename = "/" // trim(cres_target_grid) // ".maximum_snow_albedo." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'slope_type') filename = "/" // trim(cres_target_grid) // ".slope_type." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'soil_type') filename = "/" // trim(cres_target_grid) // ".soil_type." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'substrate_temperature') filename = "/" // trim(cres_target_grid) // ".substrate_temperature." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'vegetation_greenness') filename = "/" // trim(cres_target_grid) // ".vegetation_greenness." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'vegetation_type') filename = "/" // trim(cres_target_grid) // ".vegetation_type." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'visible_black_sky_albedo') filename = "/" // trim(cres_target_grid) // ".snowfree_albedo." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'visible_white_sky_albedo') filename = "/" // trim(cres_target_grid) // ".snowfree_albedo." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'near_IR_black_sky_albedo') filename = "/" // trim(cres_target_grid) // ".snowfree_albedo." // trim(tiles_target_grid(tile)) // ".nc" + if (trim(field) == 'near_IR_white_sky_albedo') filename = "/" // trim(cres_target_grid) // ".snowfree_albedo." // trim(tiles_target_grid(tile)) // ".nc" + + the_file = trim(fix_dir_target_grid) // trim(filename) + + print*,'- OPEN FILE ',trim(the_file) + error=nf90_open(trim(the_file),nf90_nowrite,ncid) + call netcdf_err(error, 'OPENING: '//trim(the_file) ) + + error=nf90_inq_dimid(ncid, 'time', id_time) + call netcdf_err(error, 'INQ TIME DIMENSION') + error=nf90_inquire_dimension(ncid, id_time, len=num_times) + call netcdf_err(error, 'READING TIME DIMENSION') + print*,'- FILE CONTAINS ', num_times, ' TIME RECORDS.' + + allocate(dummy(i_target,j_target,num_times)) + error=nf90_inq_varid(ncid, field, id_var) + call netcdf_err(error, 'READING FIELD ID' ) + error=nf90_get_var(ncid, id_var, dummy) + call netcdf_err(error, 'READING FIELD' ) + + if (num_times > 1) then + allocate (days_since(num_times)) + error=nf90_inq_varid(ncid, 'time', id_time) + error=nf90_get_var(ncid, id_time, days_since) + print*,'- TIME RECORDS (DAYS SINCE): ', days_since + idat = 0 + idat(1) = 2015 + idat(2) = 1 + idat(3) = 1 + idat(5) = 0 + jdat = 0 + jdat(1) = 2015 + jdat(2) = cycle_mon + jdat(3) = cycle_day + jdat(5) = cycle_hour + call w3difdat(jdat,idat,1,rinc) + do n = 1, num_times + if (rinc(1) <= days_since(n)) exit + enddo + bound2 = n + bound1 = n - 1 + if (bound1 == 0) bound1 = num_times + if (bound2 == num_times+1) bound2 = 1 + print*,"- BOUNDING TIME RECORDS: ", bound1, bound2 + if (bound2 /= 1) then + num_days = float(days_since(bound2)) - float(days_since(bound1)) + num_days_rec1 = rinc(1) - float(days_since(bound1)) + weight_rec2 = num_days_rec1 / num_days + weight_rec1 = 1.0 - weight_rec2 + print*,"- BOUNDING WEIGHTS ", weight_rec1, weight_rec2 + else + num_days = (float(days_since(bound2)) + 1.0) + (365.0 - float(days_since(bound1)) - 1.0) + if (rinc(1) >= days_since(bound1)) then + num_days_rec1 = rinc(1) - float(days_since(bound1)) + else + num_days_rec1 = (365.0 - float(days_since(bound1))) + rinc(1) + endif + weight_rec2 = num_days_rec1 / num_days + weight_rec1 = 1.0 - weight_rec2 + print*,"- BOUNDING WEIGHTS ", weight_rec1, weight_rec2 + endif + + do j = 1, j_target + do i = 1, i_target + data_one_tile(i,j) = (weight_rec1*dummy(i,j,bound1)) + (weight_rec2*dummy(i,j,bound2)) + enddo + enddo + + deallocate(days_since) + + else ! file contains only one time record + + data_one_tile = dummy(:,:,1) + + endif + + if (trim(field) == 'vegetation_greenness') then + + do j = 1, j_target + do i = 1, i_target + max_data_one_tile(i,j) = maxval(dummy(i,j,:)) + min_data_one_tile(i,j) = minval(dummy(i,j,:)) + enddo + enddo + + endif + + deallocate(dummy) + + error = nf90_close(ncid) + + end subroutine read_static_file + + subroutine cleanup_static_fields + + implicit none + + integer :: rc + + print*,"- DESTROY STATIC FIELDS." + + call ESMF_FieldDestroy(alvsf_target_grid, rc=rc) + call ESMF_FieldDestroy(alvwf_target_grid, rc=rc) + call ESMF_FieldDestroy(alnsf_target_grid, rc=rc) + call ESMF_FieldDestroy(alnwf_target_grid, rc=rc) + call ESMF_FieldDestroy(facsf_target_grid, rc=rc) + call ESMF_FieldDestroy(facwf_target_grid, rc=rc) + call ESMF_FieldDestroy(max_veg_greenness_target_grid, rc=rc) + call ESMF_FieldDestroy(min_veg_greenness_target_grid, rc=rc) + call ESMF_FieldDestroy(mxsno_albedo_target_grid, rc=rc) + call ESMF_FieldDestroy(slope_type_target_grid, rc=rc) + call ESMF_FieldDestroy(soil_type_target_grid, rc=rc) + call ESMF_FieldDestroy(substrate_temp_target_grid, rc=rc) + call ESMF_FieldDestroy(veg_greenness_target_grid, rc=rc) + call ESMF_FieldDestroy(veg_type_target_grid, rc=rc) + + end subroutine cleanup_static_fields + + end module static_data diff --git a/sorc/chgres_cube.fd/sorc/surface.F90 b/sorc/chgres_cube.fd/sorc/surface.F90 new file mode 100644 index 0000000000..bd9e7c8af6 --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/surface.F90 @@ -0,0 +1,3580 @@ + module surface + +!-------------------------------------------------------------------------- +! Module surface +! +! Abstract: Process surface and nst fields. Interpolates fields from +! the input to target grids. Adjusts soil temperature according +! to differences in input and target grid terrain. Rescales +! soil moisture for soil type differences between input and target +! grid. Computes frozen portion of total soil moisture. +! +! Public Subroutines: +! ----------------- +! surface_driver Driver routine to process surface/nst data +! +! Public variables: +! ----------------- +! Defined below. "target" indicates field associated with the target grid. +! "input" indicates field associated with the input grid. +! +!-------------------------------------------------------------------------- + + use esmf + + implicit none + + private + +! noah land ice option is applied at these vegetation types. + integer, parameter :: veg_type_landice_target = 15 + +! surface fields (not including nst) + type(esmf_field), public :: canopy_mc_target_grid + ! canopy moisture content + type(esmf_field), public :: f10m_target_grid + ! log((z0+10)*1/z0) + ! See sfc_diff.f for details + type(esmf_field), public :: ffmm_target_grid + ! log((z0+z1)*1/z0) + ! See sfc_diff.f for details + type(esmf_field), public :: q2m_target_grid + ! 2-m specific humidity + type(esmf_field), public :: seaice_depth_target_grid + ! sea ice depth + type(esmf_field), public :: seaice_fract_target_grid + ! sea ice fraction + type(esmf_field), public :: seaice_skin_temp_target_grid + ! sea ice skin temperature + type(esmf_field), public :: skin_temp_target_grid + ! skin temperature/sst + type(esmf_field), public :: srflag_target_grid + ! snow/rain flag + type(esmf_field), public :: snow_liq_equiv_target_grid + ! liquid equiv snow depth + type(esmf_field), public :: snow_depth_target_grid + ! physical snow depth + type(esmf_field), public :: soil_temp_target_grid + ! 3-d soil temperature + type(esmf_field), public :: soilm_liq_target_grid + ! 3-d liquid soil moisture + type(esmf_field), public :: soilm_tot_target_grid + ! 3-d total soil moisture + type(esmf_field), public :: t2m_target_grid + ! 2-m temperatrure + type(esmf_field), public :: tprcp_target_grid + ! precip + type(esmf_field), public :: ustar_target_grid + ! friction velocity + type(esmf_field), public :: z0_target_grid + ! roughness length + +! nst fields + type(esmf_field), public :: c_d_target_grid + type(esmf_field), public :: c_0_target_grid + type(esmf_field), public :: d_conv_target_grid + type(esmf_field), public :: dt_cool_target_grid + type(esmf_field), public :: ifd_target_grid + type(esmf_field), public :: qrain_target_grid + type(esmf_field), public :: tref_target_grid + ! reference temperature + type(esmf_field), public :: w_d_target_grid + type(esmf_field), public :: w_0_target_grid + type(esmf_field), public :: xs_target_grid + type(esmf_field), public :: xt_target_grid + type(esmf_field), public :: xu_target_grid + type(esmf_field), public :: xv_target_grid + type(esmf_field), public :: xz_target_grid + type(esmf_field), public :: xtts_target_grid + type(esmf_field), public :: xzts_target_grid + type(esmf_field), public :: z_c_target_grid + type(esmf_field), public :: zm_target_grid + + type(esmf_field) :: soil_type_from_input_grid + ! soil type interpolated from + ! input grid + type(esmf_field) :: terrain_from_input_grid + ! terrain height interpolated + ! from input grid + + real, parameter, private :: blim = 5.5 + ! soil 'b' parameter limit + real, parameter, private :: frz_h2o = 273.15 + ! melting pt water + real, parameter, private :: frz_ice = 271.21 + ! melting pt sea ice + real, parameter, private :: grav = 9.81 + ! gravity + real, parameter, private :: hlice = 3.335E5 + ! latent heat of fusion + + public :: surface_driver + + contains + + subroutine surface_driver(localpet) + + use input_data, only : cleanup_input_sfc_data, & + cleanup_input_nst_data, & + read_input_sfc_data, & + read_input_nst_data + + use program_setup, only : calc_soil_params_driver, & + convert_nst + + use static_data, only : get_static_fields, & + cleanup_static_fields + + implicit none + + integer, intent(in) :: localpet + +!----------------------------------------------------------------------- +! Compute soil-based parameters. +!----------------------------------------------------------------------- + + call calc_soil_params_driver(localpet) + +!----------------------------------------------------------------------- +! Get static data (like vegetation type) on the target grid. +!----------------------------------------------------------------------- + + call get_static_fields(localpet) + +!----------------------------------------------------------------------- +! Read surface data on input grid. +!----------------------------------------------------------------------- + + call read_input_sfc_data(localpet) + +!----------------------------------------------------------------------- +! Read nst data on input grid. +!----------------------------------------------------------------------- + + if (convert_nst) call read_input_nst_data(localpet) + +!----------------------------------------------------------------------- +! Create surface field objects for target grid. +!----------------------------------------------------------------------- + + call create_surface_esmf_fields + +!----------------------------------------------------------------------- +! Create nst field objects for target grid. +!----------------------------------------------------------------------- + + if (convert_nst) call create_nst_esmf_fields + +!----------------------------------------------------------------------- +! Horizontally interpolate fields. +!----------------------------------------------------------------------- + + call interp(localpet) + +!--------------------------------------------------------------------------------------------- +! Adjust soil/landice column temperatures for any change in elevation between the +! input and target grids. +!--------------------------------------------------------------------------------------------- + + call adjust_soilt_for_terrain + +!--------------------------------------------------------------------------------------------- +! Rescale soil moisture for changes in soil type between the input and target grids. +!--------------------------------------------------------------------------------------------- + + call rescale_soil_moisture + +!--------------------------------------------------------------------------------------------- +! Compute liquid portion of total soil moisture. +!--------------------------------------------------------------------------------------------- + + call calc_liq_soil_moisture + +!--------------------------------------------------------------------------------------------- +! Set z0 at land and sea ice. +!--------------------------------------------------------------------------------------------- + + call roughness + +!--------------------------------------------------------------------------------------------- +! Perform some final qc checks. +!--------------------------------------------------------------------------------------------- + + call qc_check + +!--------------------------------------------------------------------------------------------- +! Set flag values at land for nst fields. +!--------------------------------------------------------------------------------------------- + + if (convert_nst) call nst_land_fill + +!--------------------------------------------------------------------------------------------- +! Free up memory. +!--------------------------------------------------------------------------------------------- + + call cleanup_input_sfc_data + + if (convert_nst) call cleanup_input_nst_data + +!--------------------------------------------------------------------------------------------- +! Write data to file. +!--------------------------------------------------------------------------------------------- + + call write_fv3_sfc_data_netcdf(localpet) + +!--------------------------------------------------------------------------------------------- +! Free up memory. +!--------------------------------------------------------------------------------------------- + + if (convert_nst) call cleanup_target_nst_data + + call cleanup_target_sfc_data + + call cleanup_static_fields + + return + + end subroutine surface_driver + +!--------------------------------------------------------------------------------------------- +! Horizontally interpolate surface fields using esmf routines. +!--------------------------------------------------------------------------------------------- + + subroutine interp(localpet) + + use esmf + + use input_data, only : canopy_mc_input_grid, & + f10m_input_grid, & + ffmm_input_grid, & + landsea_mask_input_grid, & + q2m_input_grid, & + seaice_depth_input_grid, & + seaice_fract_input_grid, & + seaice_skin_temp_input_grid, & + skin_temp_input_grid, & + snow_depth_input_grid, & + snow_liq_equiv_input_grid, & + soil_temp_input_grid, & + soil_type_input_grid, & + soilm_tot_input_grid, & + srflag_input_grid, & + t2m_input_grid, & + tprcp_input_grid, & + ustar_input_grid, & + veg_type_input_grid, & + z0_input_grid, & + c_d_input_grid, & + c_0_input_grid, & + d_conv_input_grid, & + dt_cool_input_grid, & + ifd_input_grid, & + qrain_input_grid, & + tref_input_grid, & + w_d_input_grid, & + w_0_input_grid, & + xs_input_grid, & + xt_input_grid, & + xu_input_grid, & + xv_input_grid, & + xz_input_grid, & + xtts_input_grid, & + xzts_input_grid, & + z_c_input_grid, & + zm_input_grid, terrain_input_grid, & + veg_type_landice_input + + use model_grid, only : input_grid, target_grid, & + i_target, j_target, & + lsoil_target, & + num_tiles_target_grid, & + landmask_target_grid, & + seamask_target_grid, & + latitude_target_grid + + use program_setup, only : convert_nst + + use static_data, only : veg_type_target_grid + + use search_util + + implicit none + + include 'mpif.h' + + integer, intent(in) :: localpet + + integer :: l(1), u(1) + integer :: i, j, ij, rc, tile + integer :: clb_target(2), cub_target(2) + integer :: isrctermprocessing + integer(esmf_kind_i4), pointer :: unmapped_ptr(:) + integer(esmf_kind_i4), pointer :: mask_input_ptr(:,:) + integer(esmf_kind_i4), pointer :: mask_target_ptr(:,:) + integer(esmf_kind_i8), pointer :: landmask_target_ptr(:,:) + integer(esmf_kind_i8), allocatable :: mask_target_one_tile(:,:) + integer(esmf_kind_i8), allocatable :: water_target_one_tile(:,:) + integer(esmf_kind_i8), allocatable :: land_target_one_tile(:,:) + integer(esmf_kind_i8), pointer :: seamask_target_ptr(:,:) + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + real(esmf_kind_r8), allocatable :: latitude_one_tile(:,:) + real(esmf_kind_r8), pointer :: canopy_mc_target_ptr(:,:) + real(esmf_kind_r8), pointer :: c_d_target_ptr(:,:) + real(esmf_kind_r8), pointer :: c_0_target_ptr(:,:) + real(esmf_kind_r8), pointer :: d_conv_target_ptr(:,:) + real(esmf_kind_r8), pointer :: dt_cool_target_ptr(:,:) + real(esmf_kind_r8), pointer :: ifd_target_ptr(:,:) + real(esmf_kind_r8), pointer :: qrain_target_ptr(:,:) + real(esmf_kind_r8), pointer :: tref_target_ptr(:,:) + real(esmf_kind_r8), pointer :: w_d_target_ptr(:,:) + real(esmf_kind_r8), pointer :: w_0_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xs_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xt_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xu_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xv_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xz_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xtts_target_ptr(:,:) + real(esmf_kind_r8), pointer :: xzts_target_ptr(:,:) + real(esmf_kind_r8), pointer :: z_c_target_ptr(:,:) + real(esmf_kind_r8), pointer :: zm_target_ptr(:,:) + real(esmf_kind_r8), pointer :: seaice_depth_target_ptr(:,:) + real(esmf_kind_r8), pointer :: seaice_fract_target_ptr(:,:) + real(esmf_kind_r8), pointer :: seaice_skin_temp_target_ptr(:,:) + real(esmf_kind_r8), pointer :: skin_temp_target_ptr(:,:) + real(esmf_kind_r8), pointer :: snow_depth_target_ptr(:,:) + real(esmf_kind_r8), pointer :: snow_liq_equiv_target_ptr(:,:) + real(esmf_kind_r8), pointer :: soil_temp_target_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soil_type_from_input_ptr(:,:) + real(esmf_kind_r8), pointer :: soilm_tot_target_ptr(:,:,:) + real(esmf_kind_r8), pointer :: srflag_target_ptr(:,:) + real(esmf_kind_r8), pointer :: terrain_from_input_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_target_ptr(:,:) + real(esmf_kind_r8), pointer :: z0_target_ptr(:,:) + real(esmf_kind_r8), pointer :: landmask_input_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_input_ptr(:,:) + real(esmf_kind_r8), allocatable :: veg_type_target_one_tile(:,:) + + type(esmf_regridmethod_flag) :: method + type(esmf_routehandle) :: regrid_bl_no_mask + type(esmf_routehandle) :: regrid_all_land + type(esmf_routehandle) :: regrid_land + type(esmf_routehandle) :: regrid_landice + type(esmf_routehandle) :: regrid_nonland + type(esmf_routehandle) :: regrid_seaice + type(esmf_routehandle) :: regrid_water + +!----------------------------------------------------------------------- +! Interpolate fieids that do not require 'masked' interpolation. +!----------------------------------------------------------------------- + + method=ESMF_REGRIDMETHOD_BILINEAR + + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore FOR NON-MASKED BILINEAR INTERPOLATION." + call ESMF_FieldRegridStore(t2m_input_grid, & + t2m_target_grid, & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + routehandle=regrid_bl_no_mask, & + regridmethod=method, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid T2M." + call ESMF_FieldRegrid(t2m_input_grid, & + t2m_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid Q2M." + call ESMF_FieldRegrid(q2m_input_grid, & + q2m_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid TPRCP." + call ESMF_FieldRegrid(tprcp_input_grid, & + tprcp_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid F10M." + call ESMF_FieldRegrid(f10m_input_grid, & + f10m_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid FFMM." + call ESMF_FieldRegrid(ffmm_input_grid, & + ffmm_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid USTAR." + call ESMF_FieldRegrid(ustar_input_grid, & + ustar_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid SRFLAG." + call ESMF_FieldRegrid(srflag_input_grid, & + srflag_target_grid, & + routehandle=regrid_bl_no_mask, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR SRFLAG." + call ESMF_FieldGet(srflag_target_grid, & + farrayPtr=srflag_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + +!----------------------------------------------------------------------- +! This is a flag field. Using neighbor was expensive. So use +! bilinear and 'nint'. +!----------------------------------------------------------------------- + + srflag_target_ptr = nint(srflag_target_ptr) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_bl_no_mask, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridRelease", rc) + +!----------------------------------------------------------------------- +! Next, determine the sea ice fraction on target grid. +! +! First, set the mask on the target and input grids. +!----------------------------------------------------------------------- + + print*,"- CALL GridAddItem FOR TARGET GRID." + call ESMF_GridAddItem(target_grid, & + itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridAddItem", rc) + + print*,"- CALL GridGetItem FOR TARGET GRID." + call ESMF_GridGetItem(target_grid, & + itemflag=ESMF_GRIDITEM_MASK, & + farrayPtr=mask_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridGetItem", rc) + + print*,"- CALL FieldGet FOR TARGET GRID SEAMASK." + call ESMF_FieldGet(seamask_target_grid, & + computationalLBound=clb_target, & + computationalUBound=cub_target, & + farrayPtr=seamask_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + mask_target_ptr = seamask_target_ptr + + print*,"- CALL GridAddItem FOR INPUT GRID SEAMASK." + call ESMF_GridAddItem(input_grid, & + itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridAddItem", rc) + + print*,"- CALL FieldGet FOR INPUT GRID LANDMASK." + call ESMF_FieldGet(landsea_mask_input_grid, & + farrayPtr=landmask_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL GridGetItem FOR INPUT GRID LANDMASK." + call ESMF_GridGetItem(input_grid, & + itemflag=ESMF_GRIDITEM_MASK, & + farrayPtr=mask_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN GridGetItem", rc) + + mask_input_ptr = 1 + where (nint(landmask_input_ptr) == 1) mask_input_ptr = 0 + +!----------------------------------------------------------------------- +! Interpolate. +!----------------------------------------------------------------------- + + method=ESMF_REGRIDMETHOD_CONSERVE + + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for sea ice fraction." + call ESMF_FieldRegridStore(seaice_fract_input_grid, & + seaice_fract_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_nonland, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for sea ice fraction." + call ESMF_FieldRegrid(seaice_fract_input_grid, & + seaice_fract_target_grid, & + routehandle=regrid_nonland, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + if (localpet == 0) then + allocate(data_one_tile(i_target,j_target)) + allocate(data_one_tile_3d(i_target,j_target,lsoil_target)) + allocate(mask_target_one_tile(i_target,j_target)) + else + allocate(data_one_tile(0,0)) + allocate(data_one_tile_3d(0,0,0)) + allocate(mask_target_one_tile(0,0)) + endif + + print*,"- CALL FieldGet FOR TARGET grid sea ice fraction." + call ESMF_FieldGet(seaice_fract_target_grid, & + farrayPtr=seaice_fract_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + seaice_fract_target_ptr(i,j) = -9999.9 ! flag value for missing point + ! which will be replaced in routine + ! "search". + enddo + + if (localpet == 0) then + allocate(latitude_one_tile(i_target,j_target)) + else + allocate(latitude_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + + print*,"- CALL FieldGather FOR TARGET GRID SEAICE FRACTION TILE: ", tile + call ESMF_FieldGather(seaice_fract_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET GRID MASK TILE: ", tile + call ESMF_FieldGather(seamask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile + call ESMF_FieldGather(latitude_target_grid, latitude_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 91, & + latitude=latitude_one_tile) + endif + + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + do j = 1, j_target + do i = 1, i_target + if (data_one_tile(i,j) < 0.15) data_one_tile(i,j) = 0.0 + if (data_one_tile(i,j) >= 0.15) mask_target_one_tile(i,j) = 2 + enddo + enddo + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SEAICE FRACTION TILE: ", tile + call ESMF_FieldScatter(seaice_fract_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldScatter FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldScatter(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + deallocate(latitude_one_tile) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_nonland, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridRelease", rc) + +!--------------------------------------------------------------------------------------------- +! Now interpolate other sea ice related fields. Since we know what points are ice on +! the target grid, reset the target grid mask. +!--------------------------------------------------------------------------------------------- + + mask_input_ptr = 0 + where (nint(landmask_input_ptr) == 2) mask_input_ptr = 1 + + print*,"- CALL FieldGet FOR TARGET land sea mask." + call ESMF_FieldGet(landmask_target_grid, & + farrayPtr=landmask_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + mask_target_ptr = 0 + do j = clb_target(2), cub_target(2) + do i = clb_target(1), cub_target(1) + if (landmask_target_ptr(i,j) == 2) mask_target_ptr(i,j) = 1 + enddo + enddo + + method=ESMF_REGRIDMETHOD_NEAREST_STOD + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for 3d seaice fields." + call ESMF_FieldRegridStore(soil_temp_input_grid, & + soil_temp_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_seaice, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for soil temperature over seaice." + call ESMF_FieldRegrid(soil_temp_input_grid, & + soil_temp_target_grid, & + routehandle=regrid_seaice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid soil temperature over seaice." + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=soil_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL Field_Regrid for sea ice depth." + call ESMF_FieldRegrid(seaice_depth_input_grid, & + seaice_depth_target_grid, & + routehandle=regrid_seaice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid sea ice depth." + call ESMF_FieldGet(seaice_depth_target_grid, & + farrayPtr=seaice_depth_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL Field_Regrid for snow depth." + call ESMF_FieldRegrid(snow_depth_input_grid, & + snow_depth_target_grid, & + routehandle=regrid_seaice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid snow depth." + call ESMF_FieldGet(snow_depth_target_grid, & + farrayPtr=snow_depth_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL Field_Regrid for snow liq equiv." + call ESMF_FieldRegrid(snow_liq_equiv_input_grid, & + snow_liq_equiv_target_grid, & + routehandle=regrid_seaice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid snow liq equiv." + call ESMF_FieldGet(snow_liq_equiv_target_grid, & + farrayPtr=snow_liq_equiv_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL Field_Regrid for sea ice skin temp." + call ESMF_FieldRegrid(seaice_skin_temp_input_grid, & + seaice_skin_temp_target_grid, & + routehandle=regrid_seaice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid sea ice skin temp." + call ESMF_FieldGet(seaice_skin_temp_target_grid, & + farrayPtr=seaice_skin_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + seaice_depth_target_ptr(i,j) = -9999.9 + snow_depth_target_ptr(i,j) = -9999.9 + snow_liq_equiv_target_ptr(i,j) = -9999.9 + seaice_skin_temp_target_ptr(i,j) = -9999.9 + soil_temp_target_ptr(i,j,:) = -9999.9 + enddo + + do tile = 1, num_tiles_target_grid + + print*,"- CALL FieldGather FOR TARGET GRID SEAICE DEPTH TILE: ", tile + call ESMF_FieldGather(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + where(mask_target_one_tile == 1) mask_target_one_tile = 0 + where(mask_target_one_tile == 2) mask_target_one_tile = 1 + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 92) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SEAICE DEPTH TILE: ", tile + call ESMF_FieldScatter(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile + call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 66) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH TILE: ", tile + call ESMF_FieldScatter(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile + call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 65) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile + call ESMF_FieldScatter(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SEAICE SKIN TEMP: ", tile + call ESMF_FieldGather(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 21) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SEAICE SKIN TEMP: ", tile + call ESMF_FieldScatter(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SEAICE COLUMN TEMP: ", tile + call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + do j = 1, lsoil_target + data_one_tile = data_one_tile_3d(:,:,j) + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 21) + data_one_tile_3d(:,:,j) = data_one_tile + enddo + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SEAICE COLUMN TEMP: ", tile + call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_seaice, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridRelease", rc) + +!--------------------------------------------------------------------------------------------- +! Now interpolate water fields. +!--------------------------------------------------------------------------------------------- + + mask_input_ptr = 0 + where (nint(landmask_input_ptr) == 0) mask_input_ptr = 1 + + mask_target_ptr = 0 + where (landmask_target_ptr == 0) mask_target_ptr = 1 + + method=ESMF_REGRIDMETHOD_CONSERVE + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for water fields." + call ESMF_FieldRegridStore(skin_temp_input_grid, & + skin_temp_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_water, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for skin temperature over water." + call ESMF_FieldRegrid(skin_temp_input_grid, & + skin_temp_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET skin temperature." + call ESMF_FieldGet(skin_temp_target_grid, & + farrayPtr=skin_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL Field_Regrid for z0 over water." + call ESMF_FieldRegrid(z0_input_grid, & + z0_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET z0." + call ESMF_FieldGet(z0_target_grid, & + farrayPtr=z0_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + skin_temp_target_ptr(i,j) = -9999.9 + z0_target_ptr(i,j) = -9999.9 + enddo + + if (convert_nst) then + + print*,"- CALL Field_Regrid for c_d over water." + call ESMF_FieldRegrid(c_d_input_grid, & + c_d_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for c_0 over water." + call ESMF_FieldRegrid(c_0_input_grid, & + c_0_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for d_conv over water." + call ESMF_FieldRegrid(d_conv_input_grid, & + d_conv_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for dt_cool over water." + call ESMF_FieldRegrid(dt_cool_input_grid, & + dt_cool_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for ifd over water." + call ESMF_FieldRegrid(ifd_input_grid, & + ifd_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for qrain over water." + call ESMF_FieldRegrid(qrain_input_grid, & + qrain_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for tref over water." + call ESMF_FieldRegrid(tref_input_grid, & + tref_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for w_d over water." + call ESMF_FieldRegrid(w_d_input_grid, & + w_d_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for w_0 over water." + call ESMF_FieldRegrid(w_0_input_grid, & + w_0_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xs over water." + call ESMF_FieldRegrid(xs_input_grid, & + xs_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xt over water." + call ESMF_FieldRegrid(xt_input_grid, & + xt_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xu over water." + call ESMF_FieldRegrid(xu_input_grid, & + xu_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xv over water." + call ESMF_FieldRegrid(xv_input_grid, & + xv_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xz over water." + call ESMF_FieldRegrid(xz_input_grid, & + xz_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xtts over water." + call ESMF_FieldRegrid(xtts_input_grid, & + xtts_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for xzts over water." + call ESMF_FieldRegrid(xzts_input_grid, & + xzts_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for z_c over water." + call ESMF_FieldRegrid(z_c_input_grid, & + z_c_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for zm over water." + call ESMF_FieldRegrid(zm_input_grid, & + zm_target_grid, & + routehandle=regrid_water, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + +! Tag unmapped points + + print*,"- CALL FieldGet FOR TARGET c_d." + call ESMF_FieldGet(c_d_target_grid, & + farrayPtr=c_d_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET c_0." + call ESMF_FieldGet(c_0_target_grid, & + farrayPtr=c_0_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET d_conv." + call ESMF_FieldGet(d_conv_target_grid, & + farrayPtr=d_conv_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET dt_cool." + call ESMF_FieldGet(dt_cool_target_grid, & + farrayPtr=dt_cool_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET ifd." + call ESMF_FieldGet(ifd_target_grid, & + farrayPtr=ifd_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + ifd_target_ptr = float(nint(ifd_target_ptr)) + + print*,"- CALL FieldGet FOR TARGET qrain." + call ESMF_FieldGet(qrain_target_grid, & + farrayPtr=qrain_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET tref." + call ESMF_FieldGet(tref_target_grid, & + farrayPtr=tref_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET w_d." + call ESMF_FieldGet(w_d_target_grid, & + farrayPtr=w_d_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET w_0." + call ESMF_FieldGet(w_0_target_grid, & + farrayPtr=w_0_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xs." + call ESMF_FieldGet(xs_target_grid, & + farrayPtr=xs_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xt." + call ESMF_FieldGet(xt_target_grid, & + farrayPtr=xt_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xu." + call ESMF_FieldGet(xu_target_grid, & + farrayPtr=xu_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xv." + call ESMF_FieldGet(xv_target_grid, & + farrayPtr=xv_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xz." + call ESMF_FieldGet(xz_target_grid, & + farrayPtr=xz_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xtts." + call ESMF_FieldGet(xtts_target_grid, & + farrayPtr=xtts_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET xzts." + call ESMF_FieldGet(xzts_target_grid, & + farrayPtr=xzts_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET z_c." + call ESMF_FieldGet(z_c_target_grid, & + farrayPtr=z_c_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET zm." + call ESMF_FieldGet(zm_target_grid, & + farrayPtr=zm_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + c_d_target_ptr(i,j) = -9999.9 + c_0_target_ptr(i,j) = -9999.9 + d_conv_target_ptr(i,j) = -9999.9 + dt_cool_target_ptr(i,j) = -9999.9 + ifd_target_ptr(i,j) = -9999.9 + qrain_target_ptr(i,j) = -9999.9 + tref_target_ptr(i,j) = -9999.9 + w_d_target_ptr(i,j) = -9999.9 + w_0_target_ptr(i,j) = -9999.9 + xs_target_ptr(i,j) = -9999.9 + xt_target_ptr(i,j) = -9999.9 + xu_target_ptr(i,j) = -9999.9 + xv_target_ptr(i,j) = -9999.9 + xz_target_ptr(i,j) = -9999.9 + xtts_target_ptr(i,j) = -9999.9 + xzts_target_ptr(i,j) = -9999.9 + z_c_target_ptr(i,j) = -9999.9 + zm_target_ptr(i,j) = -9999.9 + enddo + + endif + + if (localpet == 0) then + allocate(latitude_one_tile(i_target,j_target)) + else + allocate(latitude_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + +! skin temp + + print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMPERATURE TILE: ", tile + call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile + call ESMF_FieldGather(latitude_target_grid, latitude_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + allocate(water_target_one_tile(i_target,j_target)) + water_target_one_tile = 0 + where(mask_target_one_tile == 0) water_target_one_tile = 1 + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & + latitude=latitude_one_tile) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMP: ", tile + call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! z0 + + print*,"- CALL FieldGather FOR TARGET GRID Z0 TILE: ", tile + call ESMF_FieldGather(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 83) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID Z0: ", tile + call ESMF_FieldScatter(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + if (convert_nst) then + +! c_d + + print*,"- CALL FieldGather FOR TARGET GRID C_D TILE: ", tile + call ESMF_FieldGather(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID C_D: ", tile + call ESMF_FieldScatter(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! c_0 + + print*,"- CALL FieldGather FOR TARGET GRID C_0 TILE: ", tile + call ESMF_FieldGather(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID C_0: ", tile + call ESMF_FieldScatter(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! d_conv + + print*,"- CALL FieldGather FOR TARGET GRID D_CONV TILE: ", tile + call ESMF_FieldGather(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID D_CONV: ", tile + call ESMF_FieldScatter(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! dt_cool + + print*,"- CALL FieldGather FOR TARGET GRID DT_COOL TILE: ", tile + call ESMF_FieldGather(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID DT_COOL: ", tile + call ESMF_FieldScatter(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! ifd + + print*,"- CALL FieldGather FOR TARGET GRID IFD TILE: ", tile + call ESMF_FieldGather(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 1) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID IFD: ", tile + call ESMF_FieldScatter(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! qrain + + print*,"- CALL FieldGather FOR TARGET GRID QRAIN TILE: ", tile + call ESMF_FieldGather(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID QRAIN: ", tile + call ESMF_FieldScatter(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! tref + + print*,"- CALL FieldGather FOR TARGET GRID TREF TILE: ", tile + call ESMF_FieldGather(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & + latitude=latitude_one_tile) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID TREF: ", tile + call ESMF_FieldScatter(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! w_d + + print*,"- CALL FieldGather FOR TARGET GRID W_D TILE: ", tile + call ESMF_FieldGather(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID W_D: ", tile + call ESMF_FieldScatter(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! w_0 + + print*,"- CALL FieldGather FOR TARGET GRID W_0 TILE: ", tile + call ESMF_FieldGather(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID W_0: ", tile + call ESMF_FieldScatter(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xs + + print*,"- CALL FieldGather FOR TARGET GRID XS TILE: ", tile + call ESMF_FieldGather(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XS: ", tile + call ESMF_FieldScatter(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xt + + print*,"- CALL FieldGather FOR TARGET GRID XT TILE: ", tile + call ESMF_FieldGather(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XT: ", tile + call ESMF_FieldScatter(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xu + + print*,"- CALL FieldGather FOR TARGET GRID XU TILE: ", tile + call ESMF_FieldGather(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XU: ", tile + call ESMF_FieldScatter(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xv + + print*,"- CALL FieldGather FOR TARGET GRID XV TILE: ", tile + call ESMF_FieldGather(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XV: ", tile + call ESMF_FieldScatter(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xz + + print*,"- CALL FieldGather FOR TARGET GRID XZ TILE: ", tile + call ESMF_FieldGather(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 30) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XZ: ", tile + call ESMF_FieldScatter(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xtts + + print*,"- CALL FieldGather FOR TARGET GRID XTTS TILE: ", tile + call ESMF_FieldGather(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XTTS: ", tile + call ESMF_FieldScatter(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! xzts + + print*,"- CALL FieldGather FOR TARGET GRID XZTS TILE: ", tile + call ESMF_FieldGather(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID XZTS: ", tile + call ESMF_FieldScatter(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! z_c + + print*,"- CALL FieldGather FOR TARGET GRID Z_C TILE: ", tile + call ESMF_FieldGather(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID Z_C: ", tile + call ESMF_FieldScatter(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + +! zm + + print*,"- CALL FieldGather FOR TARGET GRID ZM TILE: ", tile + call ESMF_FieldGather(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID ZM: ", tile + call ESMF_FieldScatter(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + endif + + if (localpet == 0) deallocate(water_target_one_tile) + + enddo + + deallocate(latitude_one_tile) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_water, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridRelease", rc) + +!--------------------------------------------------------------------------------------------- +! Now interpolate "all land" to "all land". Here, "all land" means landice and non-land ice. +!--------------------------------------------------------------------------------------------- + + mask_input_ptr = 0 + where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1 + + mask_target_ptr = 0 + where (landmask_target_ptr == 1) mask_target_ptr = 1 + + method=ESMF_REGRIDMETHOD_CONSERVE + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for land fields." + call ESMF_FieldRegridStore(snow_depth_input_grid, & + snow_depth_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_all_land, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for snow depth over land." + call ESMF_FieldRegrid(snow_depth_input_grid, & + snow_depth_target_grid, & + routehandle=regrid_all_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, & ! flag needed so snow over sea + ! ice is not zeroed out. + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for snow liq equiv over land." + call ESMF_FieldRegrid(snow_liq_equiv_input_grid, & + snow_liq_equiv_target_grid, & + routehandle=regrid_all_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for canopy mc." + call ESMF_FieldRegrid(canopy_mc_input_grid, & + canopy_mc_target_grid, & + routehandle=regrid_all_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET snow depth." + call ESMF_FieldGet(snow_depth_target_grid, & + farrayPtr=snow_depth_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET snow liq equiv." + call ESMF_FieldGet(snow_liq_equiv_target_grid, & + farrayPtr=snow_liq_equiv_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET canopy moisture." + call ESMF_FieldGet(canopy_mc_target_grid, & + farrayPtr=canopy_mc_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + snow_depth_target_ptr(i,j) = -9999.9 + snow_liq_equiv_target_ptr(i,j) = -9999.9 + canopy_mc_target_ptr(i,j) = -9999.9 + enddo + + do tile = 1, num_tiles_target_grid + + print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile + call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + allocate(land_target_one_tile(i_target,j_target)) + land_target_one_tile = 0 + where(mask_target_one_tile == 1) land_target_one_tile = 1 + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 66) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH: ", tile + call ESMF_FieldScatter(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQUID EQUIV: ", tile + call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 65) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SNOW LIQUID EQUIV: ", tile + call ESMF_FieldScatter(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID CANOPY MC: ", tile + call ESMF_FieldGather(canopy_mc_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 223) + deallocate(land_target_one_tile) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID CANOPY MC: ", tile + call ESMF_FieldScatter(canopy_mc_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_all_land, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridRelease", rc) + +!--------------------------------------------------------------------------------------------- +! Now interpolate landice points to landice points. +!--------------------------------------------------------------------------------------------- + + print*,"- CALL FieldGet FOR INPUT GRID VEG TYPE." + call ESMF_FieldGet(veg_type_input_grid, & + farrayPtr=veg_type_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,'land ice check ',veg_type_landice_input + + mask_input_ptr = 0 + where (nint(veg_type_input_ptr) == veg_type_landice_input) mask_input_ptr = 1 + + print*,"- CALL FieldGet FOR TARGET GRID VEG TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + mask_target_ptr = 0 + where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 1 + + method=ESMF_REGRIDMETHOD_NEAREST_STOD + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for landice fields." + call ESMF_FieldRegridStore(soil_temp_input_grid, & + soil_temp_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_landice, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for soil temperature over landice." + call ESMF_FieldRegrid(soil_temp_input_grid, & + soil_temp_target_grid, & + routehandle=regrid_landice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for skin temperature over landice." + call ESMF_FieldRegrid(skin_temp_input_grid, & + skin_temp_target_grid, & + routehandle=regrid_landice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for terrain over landice." + call ESMF_FieldRegrid(terrain_input_grid, & + terrain_from_input_grid, & + routehandle=regrid_landice, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid column temperature over landice." + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=soil_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET skin temperature." + call ESMF_FieldGet(skin_temp_target_grid, & + farrayPtr=skin_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR terrain from input grid." + call ESMF_FieldGet(terrain_from_input_grid, & + farrayPtr=terrain_from_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + soil_temp_target_ptr(i,j,:) = -9999.9 + skin_temp_target_ptr(i,j) = -9999.9 + terrain_from_input_ptr(i,j) = -9999.9 + enddo + + if (localpet == 0) then + allocate (veg_type_target_one_tile(i_target,j_target)) + allocate (land_target_one_tile(i_target,j_target)) + else + allocate (veg_type_target_one_tile(0,0)) + allocate (land_target_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + + print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMP TILE: ", tile + call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile + call ESMF_FieldGather(veg_type_target_grid, veg_type_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + land_target_one_tile = 0 + where(nint(veg_type_target_one_tile) == veg_type_landice_target) land_target_one_tile = 1 + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 21) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMP, TILE: ", tile + call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID, TILE: ", tile + call ESMF_FieldGather(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 7) + endif + + print*,"- CALL FieldScatter FOR TERRAIN FROM INPUT GRID, TILE: ", tile + call ESMF_FieldScatter(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID LANDICE COLUMN TEMP: ", tile + call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + do j = 1, lsoil_target + data_one_tile = data_one_tile_3d(:,:,j) + call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 21) + data_one_tile_3d(:,:,j) = data_one_tile + enddo + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SEAICE COLUMN TEMP: ", tile + call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + deallocate (veg_type_target_one_tile) + deallocate (land_target_one_tile) + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_landice, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridRelease", rc) + +!--------------------------------------------------------------------------------------------- +! Now interpolate land (not including landice pts) to land (not including landice). +!--------------------------------------------------------------------------------------------- + + mask_input_ptr = 0 + where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1 + where (nint(veg_type_input_ptr) == veg_type_landice_input) mask_input_ptr = 0 + + mask_target_ptr = 0 + where (landmask_target_ptr == 1) mask_target_ptr = 1 + where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 0 + + method=ESMF_REGRIDMETHOD_NEAREST_STOD + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore for 3d land (but no land ice) fields." + call ESMF_FieldRegridStore(soilm_tot_input_grid, & + soilm_tot_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_land, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridStore", rc) + + print*,"- CALL Field_Regrid for total soil moisture over land." + call ESMF_FieldRegrid(soilm_tot_input_grid, & + soilm_tot_target_grid, & + routehandle=regrid_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for soil temperature over land." + call ESMF_FieldRegrid(soil_temp_input_grid, & + soil_temp_target_grid, & + routehandle=regrid_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for skin temperature over land." + call ESMF_FieldRegrid(skin_temp_input_grid, & + skin_temp_target_grid, & + routehandle=regrid_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for terrain over land." + call ESMF_FieldRegrid(terrain_input_grid, & + terrain_from_input_grid, & + routehandle=regrid_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL Field_Regrid for soil type over land." + call ESMF_FieldRegrid(soil_type_input_grid, & + soil_type_from_input_grid, & + routehandle=regrid_land, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegrid", rc) + + print*,"- CALL FieldGet FOR TARGET grid total soil moisture over land." + call ESMF_FieldGet(soilm_tot_target_grid, & + farrayPtr=soilm_tot_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET grid soil temp over ice." + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=soil_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET skin temperature." + call ESMF_FieldGet(skin_temp_target_grid, & + farrayPtr=skin_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR terrain from input grid." + call ESMF_FieldGet(terrain_from_input_grid, & + farrayPtr=terrain_from_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR soil type from input grid." + call ESMF_FieldGet(soil_type_from_input_grid, & + farrayPtr=soil_type_from_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + soilm_tot_target_ptr(i,j,:) = -9999.9 + soil_temp_target_ptr(i,j,:) = -9999.9 + skin_temp_target_ptr(i,j) = -9999.9 + terrain_from_input_ptr(i,j) = -9999.9 + soil_type_from_input_ptr(i,j) = -9999.9 + enddo + + if (localpet == 0) then + allocate (veg_type_target_one_tile(i_target,j_target)) + else + allocate (veg_type_target_one_tile(0,0)) + endif + + do tile = 1, num_tiles_target_grid + + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile + call ESMF_FieldGather(veg_type_target_grid, veg_type_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID, TILE: ", tile + call ESMF_FieldGather(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + where(nint(veg_type_target_one_tile) == veg_type_landice_target) mask_target_one_tile = 0 + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 7) + endif + + print*,"- CALL FieldScatter FOR TERRAIN FROM INPUT GRID, TILE: ", tile + call ESMF_FieldScatter(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMPERATURE, TILE: ", tile + call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 85) + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMPERATURE, TILE: ", tile + call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR SOIL TYPE FROM INPUT GRID, TILE: ", tile + call ESMF_FieldGather(soil_type_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 224) + endif + + print*,"- CALL FieldScatter FOR SOIL TYPE FROM INPUT GRID, TILE: ", tile + call ESMF_FieldScatter(soil_type_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile + call ESMF_FieldGather(soilm_tot_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + do j = 1, lsoil_target + data_one_tile = data_one_tile_3d(:,:,j) + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 86) + data_one_tile_3d(:,:,j) = data_one_tile + enddo + endif + + print*,"- CALL FieldScatter FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile + call ESMF_FieldScatter(soilm_tot_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + print*,"- CALL FieldGather FOR TARGET GRID SOIL TEMPERATURE, TILE: ", tile + call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + do j = 1, lsoil_target + data_one_tile = data_one_tile_3d(:,:,j) + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 85) + data_one_tile_3d(:,:,j) = data_one_tile + enddo + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SOIL TEMPERATURE, TILE: ", tile + call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldScatter", rc) + + enddo + + print*,"- CALL FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_land, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldRegridRelease", rc) + + deallocate(veg_type_target_one_tile) + + deallocate(data_one_tile) + deallocate(data_one_tile_3d) + deallocate(mask_target_one_tile) + + return + + end subroutine interp + +!--------------------------------------------------------------------------------------------- +! Compute liquid portion of the total soil moisture. +!--------------------------------------------------------------------------------------------- + + subroutine calc_liq_soil_moisture + + use esmf + + use model_grid, only : landmask_target_grid + + use program_setup, only : maxsmc_target, & + bb_target, & + satpsi_target + + use static_data, only : soil_type_target_grid, & + veg_type_target_grid + + implicit none + + integer :: clb(3), cub(3), rc + integer :: i, j, n, soil_type + + integer(esmf_kind_i8), pointer :: landmask_ptr(:,:) + + real :: bx, fk + real(esmf_kind_r8), pointer :: soilm_liq_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soilm_tot_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soil_temp_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soil_type_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_ptr(:,:) + + print*,"- COMPUTE LIQUID PORTION OF TOTAL SOIL MOISTURE." + + print*,"- CALL FieldGet FOR TOTAL SOIL MOISTURE." + call ESMF_FieldGet(soilm_tot_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=soilm_tot_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LIQUID SOIL MOISTURE." + call ESMF_FieldGet(soilm_liq_target_grid, & + farrayPtr=soilm_liq_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SOIL TEMPERATURE." + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=soil_temp_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR VEGETATION TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SOIL TYPE." + call ESMF_FieldGet(soil_type_target_grid, & + farrayPtr=soil_type_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LANDMASK." + call ESMF_FieldGet(landmask_target_grid, & + farrayPtr=landmask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + +!--------------------------------------------------------------------------------------------- +! Check land points that are not permanent land ice. +!--------------------------------------------------------------------------------------------- + + if (landmask_ptr(i,j) == 1 .and. nint(veg_type_ptr(i,j)) /= veg_type_landice_target) then + + soil_type = nint(soil_type_ptr(i,j)) + + do n = clb(3), cub(3) + + if (soil_temp_ptr(i,j,n) < (frz_h2o-0.0001)) then + + bx = bb_target(soil_type) + + if (bx .gt. blim) bx = blim + + fk=(((hlice/(grav*(-satpsi_target(soil_type))))* & + ((soil_temp_ptr(i,j,n)-frz_h2o)/soil_temp_ptr(i,j,n)))** & + (-1/bx))*maxsmc_target(soil_type) + + if (fk .lt. 0.02) fk = 0.02 + + soilm_liq_ptr(i,j,n) = min ( fk, soilm_tot_ptr(i,j,n) ) + +!----------------------------------------------------------------------- +! now use iterative solution for liquid soil water content using +! FUNCTION FRH2O with the initial guess for SH2O from above explicit +! first guess. +!----------------------------------------------------------------------- + + soilm_liq_ptr(i,j,n) = frh2O(soil_temp_ptr(i,j,n), & + soilm_tot_ptr(i,j,n), soilm_liq_ptr(i,j,n), & + maxsmc_target(soil_type),bb_target(soil_type), & + satpsi_target(soil_type)) + + else ! temp above freezing. all moisture is liquid + + soilm_liq_ptr(i,j,n) = soilm_tot_ptr(i,j,n) + + end if ! is soil layer below freezing? + + enddo ! soil layer + + end if ! is this point land? + + enddo + enddo + + end subroutine calc_liq_soil_moisture + + FUNCTION FRH2O (TKELV,SMC,SH2O,SMCMAX,BEXP,PSIS) +!$$$ function documentation block +! +! function: frh2o +! prgmmr: gayno org: w/np2 date: 2005-05-20 +! +! abstract: calculate supercooled soil moisture +! +! program history log: +! 2005-05-20 gayno - initial version +! +! usage: x = frh2o (tkelv,smc,sh2o,smcmax,bexp,psis) +! +! input argument list: +! tkelv - temperature (Kelvin) +! smc - total soil moisture content (volumetric) +! sh2O - liquid soil moisture content (volumetric) +! smcmax - saturation soil moisture content +! b - soil type "b" parameter +! psis - saturated soil matric potential +! +! output argument list: +! frh2O - supercooled liquid water content +! +! remarks: stolen from noah lsm code +! +! CALCULATE AMOUNT OF SUPERCOOLED LIQUID SOIL WATER CONTENT IF +! TEMPERATURE IS BELOW 273.15K (T0). REQUIRES NEWTON-TYPE ITERATION TO +! SOLVE THE NONLINEAR IMPLICIT EQUATION GIVEN IN EQN 17 OF KOREN ET AL +! (1999, JGR, VOL 104(D16), 19569-19585). +! +! NEW VERSION (JUNE 2001): MUCH FASTER AND MORE ACCURATE NEWTON +! ITERATION ACHIEVED BY FIRST TAKING LOG OF EQN CITED ABOVE -- LESS THAN +! 4 (TYPICALLY 1 OR 2) ITERATIONS ACHIEVES CONVERGENCE. ALSO, EXPLICIT +! 1-STEP SOLUTION OPTION FOR SPECIAL CASE OF PARAMETER CK=0, WHICH +! REDUCES THE ORIGINAL IMPLICIT EQUATION TO A SIMPLER EXPLICIT FORM, +! KNOWN AS THE "FLERCHINGER EQN". IMPROVED HANDLING OF SOLUTION IN THE +! LIMIT OF FREEZING POINT TEMPERATURE [AT0. +! +! attributes: +! language: fortran 90 +! machine: IBM SP +! +!$$$ + + use esmf + + IMPLICIT NONE + + INTEGER NLOG + INTEGER KCOUNT + + REAL BEXP + REAL BX + REAL DENOM + REAL DF + REAL DSWL + REAL FK + REAL FRH2O + REAL PSIS + REAL(esmf_kind_r8) :: SH2O + REAL(esmf_kind_r8) :: SMC + REAL SMCMAX + REAL SWL + REAL SWLK + REAL(esmf_kind_r8) :: TKELV + + REAL, PARAMETER :: CK = 8.0 + REAL, PARAMETER :: ERROR = 0.005 + +! ---------------------------------------------------------------------- +! LIMITS ON PARAMETER B: B < 5.5 (use parameter BLIM) +! SIMULATIONS SHOWED IF B > 5.5 UNFROZEN WATER CONTENT IS +! NON-REALISTICALLY HIGH AT VERY LOW TEMPERATURES. +! ---------------------------------------------------------------------- + + BX = BEXP + IF (BEXP .GT. BLIM) BX = BLIM + +! ---------------------------------------------------------------------- +! INITIALIZING ITERATIONS COUNTER AND ITERATIVE SOLUTION FLAG. +! ---------------------------------------------------------------------- + + NLOG=0 + KCOUNT=0 + + IF (CK .NE. 0.0) THEN + +! ---------------------------------------------------------------------- +! OPTION 1: ITERATED SOLUTION FOR NONZERO CK +! IN KOREN ET AL, JGR, 1999, EQN 17 +! ---------------------------------------------------------------------- +! INITIAL GUESS FOR SWL (frozen content) +! ---------------------------------------------------------------------- + + SWL = SMC-SH2O + +! ---------------------------------------------------------------------- +! KEEP WITHIN BOUNDS. +! ---------------------------------------------------------------------- + + IF (SWL .GT. (SMC-0.02)) SWL = SMC-0.02 + IF (SWL .LT. 0.) SWL = 0. + +! ---------------------------------------------------------------------- +! START OF ITERATIONS +! ---------------------------------------------------------------------- + + DO WHILE ( (NLOG .LT. 10) .AND. (KCOUNT .EQ. 0) ) + + NLOG = NLOG+1 + DF = ALOG(( PSIS*GRAV/HLICE ) * ( ( 1.+CK*SWL )**2. ) * & + ( SMCMAX/(SMC-SWL) )**BX) - ALOG(-(TKELV-frz_h2o)/TKELV) + DENOM = 2. * CK / ( 1.+CK*SWL ) + BX / ( SMC - SWL ) + SWLK = SWL - DF/DENOM + +! ---------------------------------------------------------------------- +! BOUNDS USEFUL FOR MATHEMATICAL SOLUTION. +! ---------------------------------------------------------------------- + + IF (SWLK .GT. (SMC-0.02)) SWLK = SMC - 0.02 + IF (SWLK .LT. 0.) SWLK = 0. + +! ---------------------------------------------------------------------- +! MATHEMATICAL SOLUTION BOUNDS APPLIED. +! ---------------------------------------------------------------------- + + DSWL = ABS(SWLK-SWL) + SWL = SWLK + +! ---------------------------------------------------------------------- +! IF MORE THAN 10 ITERATIONS, USE EXPLICIT METHOD (CK=0 APPROX.) +! WHEN DSWL LESS OR EQ. ERROR, NO MORE ITERATIONS REQUIRED. +! ---------------------------------------------------------------------- + + IF ( DSWL .LE. ERROR ) THEN + KCOUNT = KCOUNT+1 + ENDIF + + END DO + +! ---------------------------------------------------------------------- +! END OF ITERATIONS +! ---------------------------------------------------------------------- +! BOUNDS APPLIED WITHIN DO-BLOCK ARE VALID FOR PHYSICAL SOLUTION. +! ---------------------------------------------------------------------- + + FRH2O = SMC - SWL + +! ---------------------------------------------------------------------- +! END OPTION 1 +! ---------------------------------------------------------------------- + + ENDIF + +!----------------------------------------------------------------------- +! OPTION 2: EXPLICIT SOLUTION FOR FLERCHINGER EQ. i.e. CK=0 +! IN KOREN ET AL., JGR, 1999, EQN 17 +! APPLY PHYSICAL BOUNDS TO FLERCHINGER SOLUTION +! ---------------------------------------------------------------------- + + IF (KCOUNT .EQ. 0) THEN + + FK = (((HLICE/(GRAV*(-PSIS)))* & + ((TKELV-frz_h2o)/TKELV))**(-1/BX))*SMCMAX + + IF (FK .LT. 0.02) FK = 0.02 + + FRH2O = MIN (FK, SMC) + + ENDIF + + RETURN + + END function frh2o + +!--------------------------------------------------------------------------------------------- +! Adjust soil moisture for changes in soil type between the input and target grids. +!--------------------------------------------------------------------------------------------- + + subroutine rescale_soil_moisture + + use esmf + + use model_grid, only : landmask_target_grid + + use program_setup, only : drysmc_input, drysmc_target, & + maxsmc_input, maxsmc_target, & + refsmc_input, refsmc_target, & + wltsmc_input, wltsmc_target + + use static_data, only : soil_type_target_grid, & + veg_greenness_target_grid, & + veg_type_target_grid + + implicit none + + integer :: clb(3), cub(3), i, j, k, rc + integer :: soilt_input, soilt_target + integer(esmf_kind_i8), pointer :: landmask_ptr(:,:) + + real(esmf_kind_r8), pointer :: soilm_tot_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soil_type_input_ptr(:,:) + real(esmf_kind_r8), pointer :: soil_type_target_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_greenness_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_ptr(:,:) + real :: f1, fn, smcdir, smctra + + print*,"- RESCALE SOIL MOISTURE FOR CHANGES IN SOIL TYPE." + + print*,"- CALL FieldGet FOR TOTAL SOIL MOISTURE." + call ESMF_FieldGet(soilm_tot_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=soilm_tot_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR LAND MASK." + call ESMF_FieldGet(landmask_target_grid, & + farrayPtr=landmask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR VEGETATION TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR VEGETATION GREENNESS." + call ESMF_FieldGet(veg_greenness_target_grid, & + farrayPtr=veg_greenness_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID SOIL TYPE." + call ESMF_FieldGet(soil_type_target_grid, & + farrayPtr=soil_type_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SOIL TYPE FROM INPUT GRID." + call ESMF_FieldGet(soil_type_from_input_grid, & + farrayPtr=soil_type_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + +!--------------------------------------------------------------------------------------------- +! Check land points that are not permanent land ice. +!--------------------------------------------------------------------------------------------- + + if (landmask_ptr(i,j) == 1 .and. nint(veg_type_ptr(i,j)) /= veg_type_landice_target) then + + soilt_target = nint(soil_type_target_ptr(i,j)) + soilt_input = nint(soil_type_input_ptr(i,j)) + +!--------------------------------------------------------------------------------------------- +! Rescale soil moisture at points where the soil type between the input and output +! grids is different. Caution, this logic assumes the input and target grids use the same +! soil type dataset. +!--------------------------------------------------------------------------------------------- + + if (soilt_target /= soilt_input) then + +!--------------------------------------------------------------------------------------------- +! Rescale top layer. First, determine direct evaporation part: +!--------------------------------------------------------------------------------------------- + + f1=(soilm_tot_ptr(i,j,1)-drysmc_input(soilt_input)) / & + (maxsmc_input(soilt_input)-drysmc_input(soilt_input)) + + smcdir=drysmc_target(soilt_target) + f1 * & + (maxsmc_target(soilt_target) - drysmc_target(soilt_target)) + +!--------------------------------------------------------------------------------------------- +! Continue top layer rescale. Now determine transpiration part: +!--------------------------------------------------------------------------------------------- + + if (soilm_tot_ptr(i,j,1) < refsmc_input(soilt_input)) then + f1=(soilm_tot_ptr(i,j,1) - wltsmc_input(soilt_input)) / & + (refsmc_input(soilt_input) - wltsmc_input(soilt_input)) + smctra=wltsmc_target(soilt_target) + f1 * & + (refsmc_target(soilt_target) - wltsmc_target(soilt_target)) + else + f1=(soilm_tot_ptr(i,j,1) - refsmc_input(soilt_input)) / & + (maxsmc_input(soilt_input) - refsmc_input(soilt_input)) + smctra=refsmc_target(soilt_target) + f1 * & + (maxsmc_target(soilt_target) - refsmc_target(soilt_target)) + endif + +!--------------------------------------------------------------------------------------------- +! Top layer is weighted by green vegetation fraction: +!--------------------------------------------------------------------------------------------- + + soilm_tot_ptr(i,j,1) = ((1.0 - veg_greenness_ptr(i,j)) * smcdir) + & + (veg_greenness_ptr(i,j) * smctra) + +!--------------------------------------------------------------------------------------------- +! Rescale bottom layers as follows: +! +! - Rescale between wilting point and reference value when wilting < soil m < reference, or +! - Rescale between reference point and maximum value when reference < soil m < max. +!--------------------------------------------------------------------------------------------- + + do k = 2, cub(3) + if (soilm_tot_ptr(i,j,k) < refsmc_input(soilt_input)) then + fn = (soilm_tot_ptr(i,j,k) - wltsmc_input(soilt_input)) / & + (refsmc_input(soilt_input) - wltsmc_input(soilt_input)) + soilm_tot_ptr(i,j,k) = wltsmc_target(soilt_target) + fn * & + (refsmc_target(soilt_target) - wltsmc_target(soilt_target)) + else + fn = (soilm_tot_ptr(i,j,k) - refsmc_input(soilt_input)) / & + (maxsmc_input(soilt_input) - refsmc_input(soilt_input)) + soilm_tot_ptr(i,j,k) = refsmc_target(soilt_target) + fn * & + (maxsmc_target(soilt_target) - refsmc_target(soilt_target)) + endif + enddo + + endif ! is soil type different? + +!--------------------------------------------------------------------------------------------- +! Range check all layers. +!--------------------------------------------------------------------------------------------- + + soilm_tot_ptr(i,j,1)=min(soilm_tot_ptr(i,j,1),maxsmc_target(soilt_target)) + soilm_tot_ptr(i,j,1)=max(drysmc_target(soilt_target),soilm_tot_ptr(i,j,1)) + + do k = 2, cub(3) + soilm_tot_ptr(i,j,k)=min(soilm_tot_ptr(i,j,k),maxsmc_target(soilt_target)) + soilm_tot_ptr(i,j,k)=max(wltsmc_target(soilt_target),soilm_tot_ptr(i,j,k)) + enddo + + endif ! is this a land point? + + enddo + enddo + + return + + end subroutine rescale_soil_moisture + +!--------------------------------------------------------------------------------------------- +! Adjust soil temperature for changes in terrain height between the input and +! target grids. +!--------------------------------------------------------------------------------------------- + + subroutine adjust_soilt_for_terrain + + use model_grid, only : landmask_target_grid, & + terrain_target_grid + + use static_data, only : veg_type_target_grid + + implicit none + + integer :: clb(3), cub(3), i, j, k, rc + integer(esmf_kind_i8), pointer :: landmask_ptr(:,:) + + real, parameter :: lapse_rate = 6.5e-03 + real :: terrain_diff + real(esmf_kind_r8), pointer :: terrain_input_ptr(:,:) + real(esmf_kind_r8), pointer :: terrain_target_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_target_ptr(:,:) + real(esmf_kind_r8), pointer :: soil_temp_target_ptr(:,:,:) + + print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK." + call ESMF_FieldGet(landmask_target_grid, & + farrayPtr=landmask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID VEGETATION TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID TERRAIN." + call ESMF_FieldGet(terrain_target_grid, & + farrayPtr=terrain_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TERRAIN INTERP TO TARGET GRID." + call ESMF_FieldGet(terrain_from_input_grid, & + farrayPtr=terrain_input_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SOIL TEMP TARGET GRID." + call ESMF_FieldGet(soil_temp_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=soil_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 1) then + terrain_diff = abs(terrain_input_ptr(i,j) - terrain_target_ptr(i,j)) + if (terrain_diff > 100.0) then + do k = clb(3), cub(3) + soil_temp_target_ptr(i,j,k) = soil_temp_target_ptr(i,j,k) + & + ((terrain_input_ptr(i,j) - terrain_target_ptr(i,j)) * lapse_rate) + if (nint(veg_type_target_ptr(i,j)) == veg_type_landice_target) then + soil_temp_target_ptr(i,j,k) = min(soil_temp_target_ptr(i,j,k), 273.16) + endif + enddo + endif + endif + enddo + enddo + + end subroutine adjust_soilt_for_terrain + +!--------------------------------------------------------------------------------------------- +! Set roughness at land and sea ice. +!--------------------------------------------------------------------------------------------- + + subroutine roughness + + use model_grid, only : landmask_target_grid + use static_data, only : veg_type_target_grid + + implicit none + + integer :: clb(2), cub(2), i, j, rc + integer(esmf_kind_i8), pointer :: landmask_ptr(:,:) + + real :: z0_igbp(20) + real(esmf_kind_r8), pointer :: data_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_ptr(:,:) + + data z0_igbp /1.089, 2.653, 0.854, 0.826, 0.800, 0.050, & + 0.030, 0.856, 0.856, 0.150, 0.040, 0.130, & + 1.000, 0.250, 0.011, 0.011, 0.001, 0.076, & + 0.050, 0.030/ + + print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK." + call ESMF_FieldGet(landmask_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=landmask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID VEGETATION TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID Z0." + call ESMF_FieldGet(z0_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 2) then + data_ptr(i,j) = 1.0 + elseif (landmask_ptr(i,j) == 1) then + data_ptr(i,j) = z0_igbp(nint(veg_type_ptr(i,j))) * 100.0 + endif + enddo + enddo + + end subroutine roughness + +!--------------------------------------------------------------------------------------------- +! QC data before output. +!--------------------------------------------------------------------------------------------- + + subroutine qc_check + + use model_grid, only : landmask_target_grid + + use static_data, only : alvsf_target_grid, & + alvwf_target_grid, & + alnsf_target_grid, & + alnwf_target_grid, & + facsf_target_grid, & + facwf_target_grid, & + mxsno_albedo_target_grid, & + max_veg_greenness_target_grid, & + min_veg_greenness_target_grid, & + slope_type_target_grid, & + soil_type_target_grid, & + substrate_temp_target_grid, & + veg_greenness_target_grid, & + veg_type_target_grid + + implicit none + + integer :: clb(2), cub(2), i, j, rc + integer(esmf_kind_i8), pointer :: landmask_ptr(:,:) + + real(esmf_kind_r8), pointer :: data_ptr(:,:) + real(esmf_kind_r8), pointer :: data3d_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soilmt_ptr(:,:,:) + real(esmf_kind_r8), pointer :: soilml_ptr(:,:,:) + real(esmf_kind_r8), pointer :: veg_greenness_ptr(:,:) + real(esmf_kind_r8), pointer :: veg_type_ptr(:,:) + real(esmf_kind_r8), pointer :: seaice_skint_ptr(:,:) + real(esmf_kind_r8), pointer :: skint_ptr(:,:) + real(esmf_kind_r8), pointer :: fice_ptr(:,:) + + print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK." + call ESMF_FieldGet(landmask_target_grid, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=landmask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + +!--------------------------------------------------------------------------------------------- +! Set slope type flag value at non-land points. +!--------------------------------------------------------------------------------------------- + + print*,"- CALL FieldGet FOR TARGET GRID SLOPE TYPE." + call ESMF_FieldGet(slope_type_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID SOIL TYPE." + call ESMF_FieldGet(soil_type_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID VEGETATION TYPE." + call ESMF_FieldGet(veg_type_target_grid, & + farrayPtr=veg_type_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) veg_type_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID ALVSF." + call ESMF_FieldGet(alvsf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID ALVWF." + call ESMF_FieldGet(alvwf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID ALNSF." + call ESMF_FieldGet(alnsf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID ALNWF." + call ESMF_FieldGet(alnwf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID FACSF." + call ESMF_FieldGet(facsf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID FAWSF." + call ESMF_FieldGet(facwf_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID MAXIMUM GREENNESS." + call ESMF_FieldGet(max_veg_greenness_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID MINIMUM GREENNESS." + call ESMF_FieldGet(min_veg_greenness_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID VEGETATION GREENNESS." + call ESMF_FieldGet(veg_greenness_target_grid, & + farrayPtr=veg_greenness_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) veg_greenness_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID MAX SNOW ALBEDO." + call ESMF_FieldGet(mxsno_albedo_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID CANOPY MOISTURE CONTENT." + call ESMF_FieldGet(canopy_mc_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (veg_greenness_ptr(i,j) <= 0.01) data_ptr(i,j) = 0.0 + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID ICE SKIN TEMP." + call ESMF_FieldGet(seaice_skin_temp_target_grid, & + farrayPtr=seaice_skint_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID SKIN TEMP." + call ESMF_FieldGet(skin_temp_target_grid, & + farrayPtr=skint_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID SEA ICE FRACTION." + call ESMF_FieldGet(seaice_fract_target_grid, & + farrayPtr=fice_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (fice_ptr(i,j) > 0.0) then + skint_ptr(i,j) = (fice_ptr(i,j) * seaice_skint_ptr(i,j)) + & + ( (1.0 - fice_ptr(i,j)) * frz_ice ) + else + seaice_skint_ptr(i,j) = skint_ptr(i,j) + endif + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID SUBSTRATE TEMP." + call ESMF_FieldGet(substrate_temp_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 2) then ! sea ice + data_ptr(i,j) = frz_ice + elseif (landmask_ptr(i,j) == 0) then ! open water flag value. + data_ptr(i,j) = skint_ptr(i,j) + endif + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID TOTAL SOIL MOISTURE." + call ESMF_FieldGet(soilm_tot_target_grid, & + farrayPtr=soilmt_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR TARGET GRID LIQUID SOIL MOISTURE." + call ESMF_FieldGet(soilm_liq_target_grid, & + farrayPtr=soilml_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 2 .or. landmask_ptr(i,j) == 0 .or. & + nint(veg_type_ptr(i,j)) == veg_type_landice_target) then + soilmt_ptr(i,j,:) = 1.0 + soilml_ptr(i,j,:) = 1.0 + endif + enddo + enddo + + print*,"- CALL FieldGet FOR TARGET GRID SOIL TEMPERATURE." + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=data3d_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + if (landmask_ptr(i,j) == 0) then + data3d_ptr(i,j,:) = skint_ptr(i,j) ! open water flag value. + endif + enddo + enddo + + return + + end subroutine qc_check + +!--------------------------------------------------------------------------------------------- +! nst is not active at land or sea ice points. Set nst fields to flag values at these +! points. +!--------------------------------------------------------------------------------------------- + + subroutine nst_land_fill + + use model_grid, only : landmask_target_grid + + implicit none + + integer(esmf_kind_i8), pointer :: mask_ptr(:,:) + integer :: rc + + real(esmf_kind_r8), pointer :: data_ptr(:,:) + real(esmf_kind_r8), pointer :: skint_ptr(:,:) + + print*,"- CALL FieldGet FOR TARGET GRID LANDMASK." + call ESMF_FieldGet(landmask_target_grid, & + farrayPtr=mask_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + +! c_d + + print*,"- CALL FieldGet FOR C_D." + call ESMF_FieldGet(c_d_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! c_0 + + print*,"- CALL FieldGet FOR C_0." + call ESMF_FieldGet(c_0_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! d_conv + + print*,"- CALL FieldGet FOR D_CONV." + call ESMF_FieldGet(d_conv_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! dt_cool + + print*,"- CALL FieldGet FOR DT_COOL." + call ESMF_FieldGet(dt_cool_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! ifd + + print*,"- CALL FieldGet FOR IFD." + call ESMF_FieldGet(ifd_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! qrain + + print*,"- CALL FieldGet FOR QRAIN." + call ESMF_FieldGet(qrain_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! tref + + print*,"- CALL FieldGet FOR TREF." + call ESMF_FieldGet(tref_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + print*,"- CALL FieldGet FOR SKIN T." + call ESMF_FieldGet(skin_temp_target_grid, & + farrayPtr=skint_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = skint_ptr + +! w_d + + print*,"- CALL FieldGet FOR W_D." + call ESMF_FieldGet(w_d_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! w_0 + + print*,"- CALL FieldGet FOR W_0." + call ESMF_FieldGet(w_0_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xs + + print*,"- CALL FieldGet FOR XS." + call ESMF_FieldGet(xs_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xt + + print*,"- CALL FieldGet FOR XT." + call ESMF_FieldGet(xt_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xu + + print*,"- CALL FieldGet FOR XU." + call ESMF_FieldGet(xu_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xv + + print*,"- CALL FieldGet FOR XV." + call ESMF_FieldGet(xv_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xz + + print*,"- CALL FieldGet FOR XZ." + call ESMF_FieldGet(xz_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 30.0 + +! xtts + + print*,"- CALL FieldGet FOR XTTS." + call ESMF_FieldGet(xtts_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! xzts + + print*,"- CALL FieldGet FOR XZTS." + call ESMF_FieldGet(xzts_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! z_c + + print*,"- CALL FieldGet FOR Z_C." + call ESMF_FieldGet(z_c_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + +! zm + + print*,"- CALL FieldGet FOR ZM." + call ESMF_FieldGet(zm_target_grid, & + farrayPtr=data_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGet", rc) + + where(mask_ptr /= 0) data_ptr = 0.0 + + end subroutine nst_land_fill + + subroutine create_surface_esmf_fields + + use model_grid, only : target_grid, lsoil_target + + implicit none + + integer :: rc + + print*,"- CALL FieldCreate FOR TARGET GRID T2M." + t2m_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID Q2M." + q2m_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID TPRCP." + tprcp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID F10M." + f10m_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID FFMM." + ffmm_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID USTAR." + ustar_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID SNOW LIQ EQUIV." + snow_liq_equiv_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID SNOW DEPTH." + snow_depth_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE FRACTION." + seaice_fract_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE DEPTH." + seaice_depth_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE SKIN TEMP." + seaice_skin_temp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID SRFLAG." + srflag_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID SKIN TEMPERATURE." + skin_temp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID CANOPY MOISTURE CONTENT." + canopy_mc_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID Z0." + z0_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID TERRAIN." + terrain_from_input_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID SOIL TYPE." + soil_type_from_input_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID SOIL TEMPERATURE." + soil_temp_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID TOTAL SOIL MOISTURE." + soilm_tot_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID LIQUID SOIL MOISTURE." + soilm_liq_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_target/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + end subroutine create_surface_esmf_fields + + subroutine create_nst_esmf_fields + + use model_grid, only : target_grid + + implicit none + + integer :: rc + + print*,"- CALL FieldCreate FOR TARGET GRID C_D." + c_d_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID C_0." + c_0_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID D_CONV." + d_conv_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID DT_COOL." + dt_cool_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID IFD." + ifd_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID QRAIN." + qrain_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID TREF." + tref_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID W_D." + w_d_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID W_0." + w_0_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XS." + xs_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XT." + xt_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XU." + xu_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XV." + xv_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XZ." + xz_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XTTS." + xtts_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID XZTS." + xzts_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID Z_C." + z_c_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + print*,"- CALL FieldCreate FOR TARGET GRID ZM." + zm_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldCreate", rc) + + end subroutine create_nst_esmf_fields + + subroutine ij_to_i_j(ij, itile, jtile, i, j) + + implicit none + + integer(esmf_kind_i4), intent(in) :: ij + integer , intent(in) :: itile, jtile + + integer , intent(out) :: i, j + + integer :: tile_num + integer :: pt_loc_this_tile + + tile_num = ((ij-1) / (itile*jtile)) ! tile number minus 1 + pt_loc_this_tile = ij - (tile_num * itile * jtile) + ! "ij" location of point within tile. + + j = (pt_loc_this_tile - 1) / itile + 1 + i = mod(pt_loc_this_tile, itile) + + if (i==0) i = itile + + return + + end subroutine ij_to_i_j + + subroutine cleanup_target_sfc_data + + implicit none + + integer :: rc + + print*,"- DESTROY TARGET GRID SURFACE FIELDS." + + call ESMF_FieldDestroy(t2m_target_grid, rc=rc) + call ESMF_FieldDestroy(q2m_target_grid, rc=rc) + call ESMF_FieldDestroy(tprcp_target_grid, rc=rc) + call ESMF_FieldDestroy(f10m_target_grid, rc=rc) + call ESMF_FieldDestroy(ffmm_target_grid, rc=rc) + call ESMF_FieldDestroy(ustar_target_grid, rc=rc) + call ESMF_FieldDestroy(snow_liq_equiv_target_grid, rc=rc) + call ESMF_FieldDestroy(snow_depth_target_grid, rc=rc) + call ESMF_FieldDestroy(seaice_fract_target_grid, rc=rc) + call ESMF_FieldDestroy(seaice_depth_target_grid, rc=rc) + call ESMF_FieldDestroy(seaice_skin_temp_target_grid, rc=rc) + call ESMF_FieldDestroy(srflag_target_grid, rc=rc) + call ESMF_FieldDestroy(skin_temp_target_grid, rc=rc) + call ESMF_FieldDestroy(canopy_mc_target_grid, rc=rc) + call ESMF_FieldDestroy(z0_target_grid, rc=rc) + call ESMF_FieldDestroy(terrain_from_input_grid, rc=rc) + call ESMF_FieldDestroy(soil_type_from_input_grid, rc=rc) + call ESMF_FieldDestroy(soil_temp_target_grid, rc=rc) + call ESMF_FieldDestroy(soilm_tot_target_grid, rc=rc) + call ESMF_FieldDestroy(soilm_liq_target_grid, rc=rc) + + end subroutine cleanup_target_sfc_data + + subroutine cleanup_target_nst_data + + implicit none + + integer :: rc + + print*,"- DESTROY TARGET GRID NST DATA." + + call ESMF_FieldDestroy(c_d_target_grid, rc=rc) + call ESMF_FieldDestroy(c_0_target_grid, rc=rc) + call ESMF_FieldDestroy(d_conv_target_grid, rc=rc) + call ESMF_FieldDestroy(dt_cool_target_grid, rc=rc) + call ESMF_FieldDestroy(ifd_target_grid, rc=rc) + call ESMF_FieldDestroy(qrain_target_grid, rc=rc) + call ESMF_FieldDestroy(tref_target_grid, rc=rc) + call ESMF_FieldDestroy(w_d_target_grid, rc=rc) + call ESMF_FieldDestroy(w_0_target_grid, rc=rc) + call ESMF_FieldDestroy(xs_target_grid, rc=rc) + call ESMF_FieldDestroy(xt_target_grid, rc=rc) + call ESMF_FieldDestroy(xu_target_grid, rc=rc) + call ESMF_FieldDestroy(xv_target_grid, rc=rc) + call ESMF_FieldDestroy(xz_target_grid, rc=rc) + call ESMF_FieldDestroy(xtts_target_grid, rc=rc) + call ESMF_FieldDestroy(xzts_target_grid, rc=rc) + call ESMF_FieldDestroy(z_c_target_grid, rc=rc) + call ESMF_FieldDestroy(zm_target_grid, rc=rc) + + end subroutine cleanup_target_nst_data + + end module surface diff --git a/sorc/chgres_cube.fd/sorc/utils.f90 b/sorc/chgres_cube.fd/sorc/utils.f90 new file mode 100644 index 0000000000..a99b0b5d73 --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/utils.f90 @@ -0,0 +1,34 @@ + subroutine error_handler(string, rc) + + implicit none + + character(len=*), intent(in) :: string + + integer, intent(in) :: rc + + print*,"- FATAL ERROR: ", string + print*,"- IOSTAT IS: ", rc + call mpi_abort + + end subroutine error_handler + + subroutine netcdf_err( err, string ) + + use netcdf + + implicit none + integer, intent(in) :: err + character(len=*), intent(in) :: string + character(len=256) :: errmsg + + include "mpif.h" + + if( err.EQ.NF90_NOERR )return + errmsg = NF90_STRERROR(err) + print*,'' + print*,'FATAL ERROR: ', trim(string), ': ', trim(errmsg) + print*,'STOP.' + call mpi_abort(mpi_comm_world, 999) + + return + end subroutine netcdf_err diff --git a/sorc/chgres_cube.fd/sorc/write_data.F90 b/sorc/chgres_cube.fd/sorc/write_data.F90 new file mode 100644 index 0000000000..166d819825 --- /dev/null +++ b/sorc/chgres_cube.fd/sorc/write_data.F90 @@ -0,0 +1,2602 @@ +!-------------------------------------------------------------------------- +! Module: write_data +! +! Abstract: Write out target grid data into appropriate files for +! the forecast model. +! +! Main Subroutines: +! ------------------- +! write_fv3_atm_header_netcdf Writes atmospheric header file, +! netcdf format. +! write_fv3_atm_bndy_data_netcdf Writes atmospheric fields along the +! lateral boundary. For regional grids. +! netcdf format. +! write_fv3_atm_data_netcdf Writes atmospheric data into a +! 'coldstart' file (netcdf) +! write_fv3_sfc_data_netcdf Writes surface and nst data into a +! 'coldstart' file (netcdf) +!-------------------------------------------------------------------------- + + subroutine write_fv3_atm_header_netcdf(localpet) + + use esmf + + use netcdf + + use atmosphere, only : nvcoord_target, & + vcoord_target, & + levp1_target + + use program_setup, only : num_tracers + + implicit none + + integer, intent(in) :: localpet + + character(len=13) :: outfile + + integer :: fsize=65536, initial = 0 + integer :: header_buffer_val = 16384 + integer :: error, ncid, dim_nvcoord + integer :: dim_levp1, id_ntrac, id_vcoord + + real(kind=esmf_kind_r8), allocatable :: tmp(:,:) + + if (localpet /= 0) return + + outfile="./gfs_ctrl.nc" + + print*,"- WRITE ATMOSPHERIC HEADER FILE: ", trim(outfile) + + error = nf90_create(outfile, IOR(NF90_NETCDF4,NF90_CLASSIC_MODEL), & + ncid, initialsize=initial, chunksize=fsize) + call netcdf_err(error, 'CREATING FILE='//trim(outfile) ) + + error = nf90_def_dim(ncid, 'nvcoord', nvcoord_target, dim_nvcoord) + call netcdf_err(error, 'define dimension nvcoord for file='//trim(outfile) ) + + error = nf90_def_dim(ncid, 'levsp', levp1_target, dim_levp1) + call netcdf_err(error, 'define dimension levsp for file='//trim(outfile) ) + + error = nf90_def_var(ncid, 'ntrac', nf90_int, id_ntrac) + call netcdf_err(error, 'define var ntrac for file='//trim(outfile) ) + + error = nf90_def_var(ncid, 'vcoord', nf90_double, (/dim_levp1, dim_nvcoord/), id_vcoord) + call netcdf_err(error, 'define var vcoord for file='//trim(outfile) ) + + error = nf90_enddef(ncid, header_buffer_val,4,0,4) + call netcdf_err(error, 'end meta define for file='//trim(outfile) ) + + error = nf90_put_var( ncid, id_ntrac, num_tracers) + call netcdf_err(error, 'write var ntrac for file='//trim(outfile) ) + + allocate(tmp(levp1_target, nvcoord_target)) + tmp(1:levp1_target,:) = vcoord_target(levp1_target:1:-1,:) + + error = nf90_put_var( ncid, id_vcoord, tmp) + call netcdf_err(error, 'write var vcoord for file='//trim(outfile) ) + + deallocate(tmp) + + error = nf90_close(ncid) + + end subroutine write_fv3_atm_header_netcdf + + subroutine write_fv3_atm_bndy_data_netcdf(localpet) + +!--------------------------------------------------------------------------- +! +! Output data along the four halo boundaries. The naming convention +! assumes point (1,1) is the lower left corner of the grid: +! +! --------------- TOP --------------- +! | | +! | | +! LEFT | | RIGHT +! | | +! |PT(1,1) | +! ------------- BOTTOM -------------- +! +!--------------------------------------------------------------------------- + + use esmf + use netcdf + + use atmosphere, only : lev_target, levp1_target, & + dzdt_target_grid, & + ps_target_grid, & + tracers_target_grid, & + u_s_target_grid, & + v_s_target_grid, & + u_w_target_grid, & + v_w_target_grid, & + zh_target_grid + + use model_grid, only : i_target, ip1_target, j_target, jp1_target + + use program_setup, only : halo_bndy, halo_blend, & + input_type, tracers, num_tracers + + implicit none + + integer, intent(in) :: localpet + + character(len=50) :: name + + integer :: fsize=65536, initial = 0 + integer :: header_buffer_val = 16384 + integer :: ncid, error, tile, i, n + integer :: dim_lon, dim_lat + integer :: dim_lonp, dim_halo + integer :: dim_halop, dim_latm + integer :: dim_lev, dim_levp1 + integer :: j_target2, halo, halo_p1 + integer :: id_i_bottom, id_j_bottom + integer :: id_i_top, id_j_top + integer :: id_i_right, id_j_right + integer :: id_i_left, id_j_left + integer :: id_ps_bottom, id_ps_top + integer :: id_ps_right, id_ps_left + integer :: id_w_bottom, id_w_top + integer :: id_w_right, id_w_left + integer :: id_zh_bottom, id_zh_top + integer :: id_zh_right, id_zh_left + integer, allocatable :: id_tracer_bottom(:), id_tracer_top(:) + integer, allocatable :: id_tracer_right(:), id_tracer_left(:) + integer :: id_i_w_bottom, id_j_w_bottom + integer :: id_i_w_top, id_j_w_top + integer :: id_j_w_right, id_i_w_left + integer :: id_j_w_left, id_i_w_right + integer :: id_u_w_bottom, id_u_w_top + integer :: id_u_w_right, id_u_w_left + integer :: id_v_w_bottom, id_v_w_top + integer :: id_v_w_right, id_v_w_left + integer :: id_i_s_bottom, id_j_s_bottom + integer :: id_i_s_top, id_j_s_top + integer :: id_i_s_right, id_j_s_right + integer :: id_i_s_left, id_j_s_left + integer :: id_u_s_bottom, id_u_s_top + integer :: id_u_s_right, id_u_s_left + integer :: id_v_s_bottom, id_v_s_top + integer :: id_v_s_right, id_v_s_left + integer :: i_start_top, i_end_top + integer :: j_start_top, j_end_top + integer :: i_start_bottom, i_end_bottom + integer :: j_start_bottom, j_end_bottom + integer :: i_start_left, i_end_left + integer :: j_start_left, j_end_left + integer :: i_start_right, i_end_right + integer :: j_start_right, j_end_right + integer(kind=4), allocatable :: idum(:) + + real(kind=4), allocatable :: dum2d_top(:,:), dum2d_bottom(:,:) + real(kind=4), allocatable :: dum2d_left(:,:), dum2d_right(:,:) + real(kind=4), allocatable :: dum3d_top(:,:,:), dum3d_bottom(:,:,:) + real(kind=4), allocatable :: dum3d_left(:,:,:), dum3d_right(:,:,:) + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + + print*,"- OUTPUT LATERAL BOUNDARY DATA." + + halo = halo_bndy + halo_blend + halo_p1 = halo + 1 + + allocate(id_tracer_bottom(num_tracers)) + allocate(id_tracer_top(num_tracers)) + allocate(id_tracer_left(num_tracers)) + allocate(id_tracer_right(num_tracers)) + + if (localpet == 0) then + +!--- open the file + error = nf90_create("./gfs.bndy.nc", IOR(NF90_NETCDF4,NF90_CLASSIC_MODEL), & + ncid, initialsize=initial, chunksize=fsize) + call netcdf_err(error, 'CREATING BNDY FILE' ) + + error = nf90_def_dim(ncid, 'lon', i_target, dim_lon) + call netcdf_err(error, 'defining lon dimension') + + j_target2 = j_target - (2*halo) + error = nf90_def_dim(ncid, 'lat', j_target2, dim_lat) + call netcdf_err(error, 'DEFINING LAT DIMENSION') + + error = nf90_def_dim(ncid, 'lonp', ip1_target, dim_lonp) + call netcdf_err(error, 'DEFINING LONP DIMENSION') + + j_target2 = jp1_target - (2*halo_p1) + error = nf90_def_dim(ncid, 'latm', j_target2, dim_latm) + call netcdf_err(error, 'DEFINING LATM DIMENSION') + + error = nf90_def_dim(ncid, 'halo', halo, dim_halo) + call netcdf_err(error, 'DEFINING HALO DIMENSION') + + error = nf90_def_dim(ncid, 'halop', halo_p1, dim_halop) + call netcdf_err(error, 'DEFINING HALOP DIMENSION') + + error = nf90_def_dim(ncid, 'lev', lev_target, dim_lev) + call netcdf_err(error, 'DEFINING LEV DIMENSION') + + error = nf90_def_dim(ncid, 'levp', levp1_target, dim_levp1) + call netcdf_err(error, 'DEFINING LEVP DIMENSION') + + error = nf90_def_var(ncid, 'i_bottom', NF90_INT, & + (/dim_lon/), id_i_bottom) + call netcdf_err(error, 'DEFINING I_BOTTOM') + + error = nf90_def_var(ncid, 'j_bottom', NF90_INT, & + (/dim_halo/), id_j_bottom) + call netcdf_err(error, 'DEFINING J_BOTTOM') + + error = nf90_def_var(ncid, 'i_top', NF90_INT, & + (/dim_lon/), id_i_top) + call netcdf_err(error, 'DEFINING I_TOP') + + error = nf90_def_var(ncid, 'j_top', NF90_INT, & + (/dim_halo/), id_j_top) + call netcdf_err(error, 'DEFINING J_TOP') + + error = nf90_def_var(ncid, 'i_right', NF90_INT, & + (/dim_halo/), id_i_right) + call netcdf_err(error, 'DEFINING I_RIGHT') + + error = nf90_def_var(ncid, 'j_right', NF90_INT, & + (/dim_lat/), id_j_right) + call netcdf_err(error, 'DEFINING J_RIGHT') + + error = nf90_def_var(ncid, 'i_left', NF90_INT, & + (/dim_halo/), id_i_left) + call netcdf_err(error, 'DEFINING I_LEFT') + + error = nf90_def_var(ncid, 'j_left', NF90_INT, & + (/dim_lat/), id_j_left) + call netcdf_err(error, 'DEFINING J_LEFT') + + error = nf90_def_var(ncid, 'ps_bottom', NF90_FLOAT, & + (/dim_lon, dim_halo/), id_ps_bottom) + call netcdf_err(error, 'DEFINING PS_BOTTOM') + + error = nf90_def_var(ncid, 'ps_top', NF90_FLOAT, & + (/dim_lon, dim_halo/), id_ps_top) + call netcdf_err(error, 'DEFINING PS_TOP') + + error = nf90_def_var(ncid, 'ps_right', NF90_FLOAT, & + (/dim_halo, dim_lat/), id_ps_right) + call netcdf_err(error, 'DEFINING PS_RIGHT') + + error = nf90_def_var(ncid, 'ps_left', NF90_FLOAT, & + (/dim_halo, dim_lat/), id_ps_left) + call netcdf_err(error, 'DEFINING PS_LEFT') + + error = nf90_def_var(ncid, 'w_bottom', NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_w_bottom) + call netcdf_err(error, 'DEFINING W_BOTTOM') + + error = nf90_def_var(ncid, 'w_top', NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_w_top) + call netcdf_err(error, 'DEFINING W_TOP') + + error = nf90_def_var(ncid, 'w_right', NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_w_right) + call netcdf_err(error, 'DEFINING W_RIGHT') + + error = nf90_def_var(ncid, 'w_left', NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_w_left) + call netcdf_err(error, 'DEFINING W_LEFT') + + error = nf90_def_var(ncid, 'zh_bottom', NF90_FLOAT, & + (/dim_lon, dim_halo, dim_levp1/), id_zh_bottom) + call netcdf_err(error, 'DEFINING ZH_BOTTOM') + + error = nf90_def_var(ncid, 'zh_top', NF90_FLOAT, & + (/dim_lon, dim_halo, dim_levp1/), id_zh_top) + call netcdf_err(error, 'DEFINING ZH_TOP') + + error = nf90_def_var(ncid, 'zh_right', NF90_FLOAT, & + (/dim_halo, dim_lat, dim_levp1/), id_zh_right) + call netcdf_err(error, 'DEFINING ZH_RIGHT') + + error = nf90_def_var(ncid, 'zh_left', NF90_FLOAT, & + (/dim_halo, dim_lat, dim_levp1/), id_zh_left) + call netcdf_err(error, 'DEFINING ZH_LEFT') + + do n = 1, num_tracers + + name = trim(tracers(n)) // "_bottom" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_tracer_bottom(n)) + call netcdf_err(error, 'DEFINING TRACER_BOTTOM') + + name = trim(tracers(n)) // "_top" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_lon, dim_halo, dim_lev/), id_tracer_top(n)) + call netcdf_err(error, 'DEFINING TRACER_TOP') + + name = trim(tracers(n)) // "_right" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_tracer_right(n)) + call netcdf_err(error, 'DEFINING TRACER_RIGHT') + + name = trim(tracers(n)) // "_left" + error = nf90_def_var(ncid, name, NF90_FLOAT, & + (/dim_halo, dim_lat, dim_lev/), id_tracer_left(n)) + call netcdf_err(error, 'DEFINING TRACER_LEFT') + + enddo + + error = nf90_def_var(ncid, 'i_w_bottom', NF90_INT, & + (/dim_lonp/), id_i_w_bottom) + call netcdf_err(error, 'DEFINING I_W_BOTTOM') + + error = nf90_def_var(ncid, 'j_w_bottom', NF90_INT, & + (/dim_halo/), id_j_w_bottom) + call netcdf_err(error, 'DEFINING J_W_BOTTOM') + + error = nf90_def_var(ncid, 'i_w_top', NF90_INT, & + (/dim_lonp/), id_i_w_top) + call netcdf_err(error, 'DEFINING I_W_TOP') + + error = nf90_def_var(ncid, 'j_w_top', NF90_INT, & + (/dim_halo/), id_j_w_top) + call netcdf_err(error, 'DEFINING J_W_TOP') + + error = nf90_def_var(ncid, 'i_w_right', NF90_INT, & + (/dim_halop/), id_i_w_right) + call netcdf_err(error, 'DEFINING I_W_RIGHT') + + error = nf90_def_var(ncid, 'j_w_right', NF90_INT, & + (/dim_lat/), id_j_w_right) + call netcdf_err(error, 'DEFINING J_W_RIGHT') + + error = nf90_def_var(ncid, 'i_w_left', NF90_INT, & + (/dim_halop/), id_i_w_left) + call netcdf_err(error, 'DEFINING I_W_LEFT') + + error = nf90_def_var(ncid, 'j_w_left', NF90_INT, & + (/dim_lat/), id_j_w_left) + call netcdf_err(error, 'DEFINING J_W_LEFT') + + error = nf90_def_var(ncid, 'u_w_bottom', NF90_FLOAT, & + (/dim_lonp, dim_halo, dim_lev/), id_u_w_bottom) + call netcdf_err(error, 'DEFINING U_W_BOTTOM') + + error = nf90_def_var(ncid, 'u_w_top', NF90_FLOAT, & + (/dim_lonp, dim_halo, dim_lev/), id_u_w_top) + call netcdf_err(error, 'DEFINING U_W_TOP') + + error = nf90_def_var(ncid, 'u_w_right', NF90_FLOAT, & + (/dim_halop, dim_lat, dim_lev/), id_u_w_right) + call netcdf_err(error, 'DEFINING U_W_RIGHT') + + error = nf90_def_var(ncid, 'u_w_left', NF90_FLOAT, & + (/dim_halop, dim_lat, dim_lev/), id_u_w_left) + call netcdf_err(error, 'DEFINING U_W_LEFT') + + error = nf90_def_var(ncid, 'v_w_bottom', NF90_FLOAT, & + (/dim_lonp, dim_halo, dim_lev/), id_v_w_bottom) + call netcdf_err(error, 'DEFINING V_W_BOTTOM') + + error = nf90_def_var(ncid, 'v_w_top', NF90_FLOAT, & + (/dim_lonp, dim_halo, dim_lev/), id_v_w_top) + call netcdf_err(error, 'DEFINING V_W_TOP') + + error = nf90_def_var(ncid, 'v_w_right', NF90_FLOAT, & + (/dim_halop, dim_lat, dim_lev/), id_v_w_right) + call netcdf_err(error, 'DEFINING V_W_RIGHT') + + error = nf90_def_var(ncid, 'v_w_left', NF90_FLOAT, & + (/dim_halop, dim_lat, dim_lev/), id_v_w_left) + call netcdf_err(error, 'DEFINING V_W_LEFT') + + error = nf90_def_var(ncid, 'i_s_bottom', NF90_INT, & + (/dim_lon/), id_i_s_bottom) + call netcdf_err(error, 'DEFINING I_S_BOTTOM') + + error = nf90_def_var(ncid, 'j_s_bottom', NF90_INT, & + (/dim_halop/), id_j_s_bottom) + call netcdf_err(error, 'DEFINING J_S_BOTTOM') + + error = nf90_def_var(ncid, 'i_s_top', NF90_INT, & + (/dim_lon/), id_i_s_top) + call netcdf_err(error, 'DEFINING I_S_TOP') + + error = nf90_def_var(ncid, 'j_s_top', NF90_INT, & + (/dim_halop/), id_j_s_top) + call netcdf_err(error, 'DEFINING J_S_TOP') + + error = nf90_def_var(ncid, 'i_s_right', NF90_INT, & + (/dim_halo/), id_i_s_right) + call netcdf_err(error, 'DEFINING I_S_RIGHT') + + error = nf90_def_var(ncid, 'j_s_right', NF90_INT, & + (/dim_latm/), id_j_s_right) + call netcdf_err(error, 'DEFINING J_S_RIGHT') + + error = nf90_def_var(ncid, 'i_s_left', NF90_INT, & + (/dim_halo/), id_i_s_left) + call netcdf_err(error, 'DEFINING I_S_LEFT') + + error = nf90_def_var(ncid, 'j_s_left', NF90_INT, & + (/dim_latm/), id_j_s_left) + call netcdf_err(error, 'DEFINING J_S_LEFT') + + error = nf90_def_var(ncid, 'u_s_bottom', NF90_FLOAT, & + (/dim_lon, dim_halop, dim_lev/), id_u_s_bottom) + call netcdf_err(error, 'DEFINING U_S_BOTTOM') + + error = nf90_def_var(ncid, 'u_s_top', NF90_FLOAT, & + (/dim_lon, dim_halop, dim_lev/), id_u_s_top) + call netcdf_err(error, 'DEFINING U_S_TOP') + + error = nf90_def_var(ncid, 'u_s_right', NF90_FLOAT, & + (/dim_halo, dim_latm, dim_lev/), id_u_s_right) + call netcdf_err(error, 'DEFINING U_S_RIGHT') + + error = nf90_def_var(ncid, 'u_s_left', NF90_FLOAT, & + (/dim_halo, dim_latm, dim_lev/), id_u_s_left) + call netcdf_err(error, 'DEFINING U_S_LEFT') + + error = nf90_def_var(ncid, 'v_s_bottom', NF90_FLOAT, & + (/dim_lon, dim_halop, dim_lev/), id_v_s_bottom) + call netcdf_err(error, 'DEFINING V_S_BOTTOM') + + error = nf90_def_var(ncid, 'v_s_top', NF90_FLOAT, & + (/dim_lon, dim_halop, dim_lev/), id_v_s_top) + call netcdf_err(error, 'DEFINING V_S_TOP') + + error = nf90_def_var(ncid, 'v_s_right', NF90_FLOAT, & + (/dim_halo, dim_latm, dim_lev/), id_v_s_right) + call netcdf_err(error, 'DEFINING V_S_RIGHT') + + error = nf90_def_var(ncid, 'v_s_left', NF90_FLOAT, & + (/dim_halo, dim_latm, dim_lev/), id_v_s_left) + call netcdf_err(error, 'DEFINING V_S_LEFT') + +!--- define global attributes + if (trim(input_type) == "gaussian") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS GAUSSIAN NEMSIO FILE') + elseif (trim(input_type) == "gfs_gaussian") then + error = nf90_put_att(ncid, nf90_global, 'source', 'SPECTRAL GFS GAUSSIAN NEMSIO FILE') + elseif (trim(input_type) == "gfs_spectral") then + error = nf90_put_att(ncid, nf90_global, 'source', 'SPECTRAL GFS SIGIO FILE') + elseif (trim(input_type) == "history") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS TILED HISTORY FILE') + elseif (trim(input_type) == "restart") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS TILED RESTART FILE') + endif + + error = nf90_enddef(ncid, header_buffer_val,4,0,4) + call netcdf_err(error, 'DEFINING END OF HEADER') + + endif + +! Set up bounds. Indices are with respect to the whole grid - +! including halo. + + i_start_top = 1 + i_end_top = i_target + j_start_top = j_target - halo + 1 + j_end_top = j_target + + i_start_bottom = 1 + i_end_bottom = i_target + j_start_bottom = 1 + j_end_bottom = halo + + i_start_left = 1 + i_end_left = halo + j_start_left = halo + 1 + j_end_left = j_target - halo + + i_start_right = i_target - halo + 1 + i_end_right = i_target + j_start_right = halo + 1 + j_end_right = j_target - halo + + if (localpet == 0) then + +! Indices are with respect to the computational grid - +! without lateral halo but including blending halo. + + allocate(idum(i_start_top:i_end_top)) + do i = i_start_top, i_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_top, idum) + call netcdf_err(error, "WRITING I_TOP") + deallocate(idum) + allocate(idum(i_start_bottom:i_end_bottom)) + do i = i_start_bottom, i_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_bottom, idum) + call netcdf_err(error, "WRITING I_BOTTOM") + deallocate(idum) + allocate(idum(i_start_left:i_end_left)) + do i = i_start_left, i_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_left, idum) + call netcdf_err(error, "WRITING I_LEFT") + deallocate(idum) + allocate(idum(i_start_right:i_end_right)) + do i = i_start_right, i_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_right, idum) + call netcdf_err(error, "WRITING I_RIGHT") + deallocate(idum) + allocate(idum(j_start_top:j_end_top)) + do i = j_start_top, j_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_top, idum) + call netcdf_err(error, "WRITING J_TOP") + deallocate(idum) + allocate(idum(j_start_bottom:j_end_bottom)) + do i = j_start_bottom, j_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_bottom, idum) + call netcdf_err(error, "WRITING J_BOTTOM") + deallocate(idum) + allocate(idum(j_start_left:j_end_left)) + do i = j_start_left, j_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_left, idum) + call netcdf_err(error, "WRITING J_LEFT") + deallocate(idum) + allocate(idum(j_start_right:j_end_right)) + do i = j_start_right, j_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_right, idum) + call netcdf_err(error, "WRITING J_RIGHT") + deallocate(idum) + endif + +! surface pressure + + if (localpet == 0) then + allocate(data_one_tile(i_target,j_target)) + allocate(dum2d_top(i_target,halo)) + allocate(dum2d_bottom(i_target,halo)) + allocate(dum2d_left(halo, j_target-2*halo)) + allocate(dum2d_right(halo, j_target-2*halo)) + else + allocate(data_one_tile(0,0)) + allocate(dum2d_top(0,0)) + allocate(dum2d_bottom(0,0)) + allocate(dum2d_left(0,0)) + allocate(dum2d_right(0,0)) + endif + + tile = 1 + + print*,"- CALL FieldGather FOR TARGET GRID SURFACE PRESSURE" + call ESMF_FieldGather(ps_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d_top(:,:) = data_one_tile(i_start_top:i_end_top, j_start_top:j_end_top) + error = nf90_put_var( ncid, id_ps_top, dum2d_top) + call netcdf_err(error, 'WRITING PS TOP' ) + dum2d_bottom(:,:) = data_one_tile(i_start_bottom:i_end_bottom, j_start_bottom:j_end_bottom) + error = nf90_put_var( ncid, id_ps_bottom, dum2d_bottom) + call netcdf_err(error, 'WRITING PS BOTTOM' ) + dum2d_left(:,:) = data_one_tile(i_start_left:i_end_left, j_start_left:j_end_left) + error = nf90_put_var( ncid, id_ps_left, dum2d_left) + call netcdf_err(error, 'WRITING PS LEFT' ) + dum2d_right(:,:) = data_one_tile(i_start_right:i_end_right, j_start_right:j_end_right) + error = nf90_put_var( ncid, id_ps_right, dum2d_right) + call netcdf_err(error, 'WRITING PS RIGHT' ) + endif + + deallocate(dum2d_top, dum2d_bottom, dum2d_left, dum2d_right, data_one_tile) + +! height + + if (localpet == 0) then + allocate(data_one_tile_3d(i_target,j_target,levp1_target)) + allocate(dum3d_top(i_target,halo,levp1_target)) + allocate(dum3d_bottom(i_target,halo,levp1_target)) + allocate(dum3d_left(halo, (j_target-2*halo), levp1_target)) + allocate(dum3d_right(halo, (j_target-2*halo), levp1_target)) + else + allocate(data_one_tile_3d(0,0,0)) + allocate(dum3d_top(0,0,0)) + allocate(dum3d_bottom(0,0,0)) + allocate(dum3d_left(0,0,0)) + allocate(dum3d_right(0,0,0)) + endif + + print*,"- CALL FieldGather FOR TARGET GRID HEIGHT FOR TILE: ", tile + call ESMF_FieldGather(zh_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:levp1_target) = dum3d_top(:,:,levp1_target:1:-1) + error = nf90_put_var( ncid, id_zh_top, dum3d_top) + call netcdf_err(error, 'WRITING ZH TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:levp1_target) = dum3d_bottom(:,:,levp1_target:1:-1) + error = nf90_put_var( ncid, id_zh_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING ZH BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:levp1_target) = dum3d_left(:,:,levp1_target:1:-1) + error = nf90_put_var( ncid, id_zh_left, dum3d_left) + call netcdf_err(error, 'WRITING ZH LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:levp1_target) = dum3d_right(:,:,levp1_target:1:-1) + error = nf90_put_var( ncid, id_zh_right, dum3d_right) + call netcdf_err(error, 'WRITING ZH RIGHT' ) + endif + + deallocate(dum3d_top, dum3d_bottom, dum3d_left, dum3d_right, data_one_tile_3d) + +! Tracers + + if (localpet == 0) then + allocate(data_one_tile_3d(i_target,j_target,lev_target)) + allocate(dum3d_top(i_target,halo,lev_target)) + allocate(dum3d_bottom(i_target,halo,lev_target)) + allocate(dum3d_left(halo, (j_target-2*halo), lev_target)) + allocate(dum3d_right(halo, (j_target-2*halo), lev_target)) + else + allocate(data_one_tile_3d(0,0,0)) + allocate(dum3d_top(0,0,0)) + allocate(dum3d_bottom(0,0,0)) + allocate(dum3d_left(0,0,0)) + allocate(dum3d_right(0,0,0)) + endif + + do n = 1, num_tracers + + print*,"- CALL FieldGather FOR TARGET GRID TRACER FOR TILE: ", trim(tracers(n)), tile + call ESMF_FieldGather(tracers_target_grid(n), data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_tracer_top(n), dum3d_top) + call netcdf_err(error, 'WRITING TRACER TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_tracer_bottom(n), dum3d_bottom) + call netcdf_err(error, 'WRITING TRACER BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_tracer_left(n), dum3d_left) + call netcdf_err(error, 'WRITING TRACER LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_tracer_right(n), dum3d_right) + call netcdf_err(error, 'WRITING TRACER RIGHT' ) + endif + + enddo + +! Vertical velocity + + print*,"- CALL FieldGather FOR TARGET GRID W FOR TILE: ", tile + call ESMF_FieldGather(dzdt_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_w_top, dum3d_top) + call netcdf_err(error, 'WRITING W TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_w_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING W BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_w_left, dum3d_left) + call netcdf_err(error, 'WRITING W LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_w_right, dum3d_right) + call netcdf_err(error, 'WRITING W RIGHT' ) + endif + + deallocate(dum3d_top, dum3d_bottom, dum3d_left, dum3d_right, data_one_tile_3d) + +! Set up bounds for staggered 'S' winds + + i_start_top = 1 + i_end_top = i_target + j_start_top = jp1_target - halo_p1 + 1 + j_end_top = jp1_target + + i_start_bottom = 1 + i_end_bottom = i_target + j_start_bottom = 1 + j_end_bottom = halo_p1 + + i_start_left = 1 + i_end_left = halo + j_start_left = halo_p1 + 1 + j_end_left = jp1_target - halo_p1 + + i_start_right = i_target - halo + 1 + i_end_right = i_target + j_start_right = halo_p1 + 1 + j_end_right = jp1_target - halo_p1 + + if (localpet == 0) then + allocate(idum(i_start_top:i_end_top)) + do i = i_start_top, i_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_s_top, idum) + call netcdf_err(error, "WRITING I_S_TOP") + deallocate(idum) + allocate(idum(i_start_bottom:i_end_bottom)) + do i = i_start_bottom, i_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_s_bottom, idum) + call netcdf_err(error, "WRITING I_S_BOTTOM") + deallocate(idum) + allocate(idum(i_start_left:i_end_left)) + do i = i_start_left, i_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_s_left, idum) + call netcdf_err(error, "WRITING I_S_LEFT") + deallocate(idum) + allocate(idum(i_start_right:i_end_right)) + do i = i_start_right, i_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_s_right, idum) + call netcdf_err(error, "WRITING I_S_RIGHT") + deallocate(idum) + allocate(idum(j_start_top:j_end_top)) + do i = j_start_top, j_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_s_top, idum) + call netcdf_err(error, "WRITING J_S_TOP") + deallocate(idum) + allocate(idum(j_start_bottom:j_end_bottom)) + do i = j_start_bottom, j_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_s_bottom, idum) + call netcdf_err(error, "WRITING J_S_BOTTOM") + deallocate(idum) + allocate(idum(j_start_left:j_end_left)) + do i = j_start_left, j_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_s_left, idum) + call netcdf_err(error, "WRITING J_S_LEFT") + deallocate(idum) + allocate(idum(j_start_right:j_end_right)) + do i = j_start_right, j_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_s_right, idum) + call netcdf_err(error, "WRITING J_S_RIGHT") + deallocate(idum) + endif + +! U-WINDS 'S' + + if (localpet == 0) then + allocate(data_one_tile_3d(i_target,jp1_target,lev_target)) + allocate(dum3d_top(i_target,halo_p1,lev_target)) + allocate(dum3d_bottom(i_target,halo_p1,lev_target)) + allocate(dum3d_left(halo, (j_end_left-j_start_left+1), lev_target)) + allocate(dum3d_right(halo, (j_end_right-j_start_right+1), lev_target)) + else + allocate(data_one_tile_3d(0,0,0)) + allocate(dum3d_top(0,0,0)) + allocate(dum3d_bottom(0,0,0)) + allocate(dum3d_left(0,0,0)) + allocate(dum3d_right(0,0,0)) + endif + + print*,"- CALL FieldGather FOR TARGET GRID U_S FOR TILE: ", tile + call ESMF_FieldGather(u_s_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_s_top, dum3d_top) + call netcdf_err(error, 'WRITING U_S TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_s_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING U_S BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_s_left, dum3d_left) + call netcdf_err(error, 'WRITING U_S LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_s_right, dum3d_right) + call netcdf_err(error, 'WRITING U_S RIGHT' ) + endif + +! V-WINDS 'S' + + print*,"- CALL FieldGather FOR TARGET GRID V_S FOR TILE: ", tile + call ESMF_FieldGather(v_s_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_s_top, dum3d_top) + call netcdf_err(error, 'WRITING V_S TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_s_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING V_S BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_s_left, dum3d_left) + call netcdf_err(error, 'WRITING V_S LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_s_right, dum3d_right) + call netcdf_err(error, 'WRITING V_S RIGHT' ) + endif + + deallocate(dum3d_top, dum3d_bottom, dum3d_left, dum3d_right, data_one_tile_3d) + +! Set up bounds for staggered 'W' winds + + i_start_top = 1 + i_end_top = ip1_target + j_start_top = j_target - halo + 1 + j_end_top = j_target + + i_start_bottom = 1 + i_end_bottom = ip1_target + j_start_bottom = 1 + j_end_bottom = halo + + i_start_left = 1 + i_end_left = halo_p1 + j_start_left = halo_p1 + j_end_left = j_target - halo + + i_start_right = ip1_target - halo_p1 + 1 + i_end_right = ip1_target + j_start_right = halo_p1 + j_end_right = j_target - halo + + if (localpet == 0) then + allocate(idum(i_start_top:i_end_top)) + do i = i_start_top, i_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_w_top, idum) + call netcdf_err(error, "WRITING I_W_TOP") + deallocate(idum) + allocate(idum(i_start_bottom:i_end_bottom)) + do i = i_start_bottom, i_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_w_bottom, idum) + call netcdf_err(error, "WRITING I_W_BOTTOM") + deallocate(idum) + allocate(idum(i_start_left:i_end_left)) + do i = i_start_left, i_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_w_left, idum) + call netcdf_err(error, "WRITING I_W_LEFT") + deallocate(idum) + allocate(idum(i_start_right:i_end_right)) + do i = i_start_right, i_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_i_w_right, idum) + call netcdf_err(error, "WRITING I_W_RIGHT") + deallocate(idum) + allocate(idum(j_start_top:j_end_top)) + do i = j_start_top, j_end_top + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_w_top, idum) + call netcdf_err(error, "WRITING J_W_TOP") + deallocate(idum) + allocate(idum(j_start_bottom:j_end_bottom)) + do i = j_start_bottom, j_end_bottom + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_w_bottom, idum) + call netcdf_err(error, "WRITING J_W_BOTTOM") + deallocate(idum) + allocate(idum(j_start_left:j_end_left)) + do i = j_start_left, j_end_left + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_w_left, idum) + call netcdf_err(error, "WRITING J_W_LEFT") + deallocate(idum) + allocate(idum(j_start_right:j_end_right)) + do i = j_start_right, j_end_right + idum(i) = i - halo_bndy + enddo + error = nf90_put_var(ncid, id_j_w_right, idum) + call netcdf_err(error, "WRITING J_W_RIGHT") + deallocate(idum) + endif + +! U-WINDS 'W' + + if (localpet == 0) then + allocate(data_one_tile_3d(ip1_target,j_target,lev_target)) + allocate(dum3d_top(ip1_target,halo,lev_target)) + allocate(dum3d_bottom(ip1_target,halo,lev_target)) + allocate(dum3d_left(halo_p1, (j_end_left-j_start_left+1), lev_target)) + allocate(dum3d_right(halo_p1, (j_end_right-j_start_right+1), lev_target)) + else + allocate(data_one_tile_3d(0,0,0)) + allocate(dum3d_top(0,0,0)) + allocate(dum3d_bottom(0,0,0)) + allocate(dum3d_left(0,0,0)) + allocate(dum3d_right(0,0,0)) + endif + + print*,"- CALL FieldGather FOR TARGET GRID U_W FOR TILE: ", tile + call ESMF_FieldGather(u_w_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_w_top, dum3d_top) + call netcdf_err(error, 'WRITING U_W TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_w_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING U_W BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_w_left, dum3d_left) + call netcdf_err(error, 'WRITING U_W LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_w_right, dum3d_right) + call netcdf_err(error, 'WRITING U_W RIGHT' ) + endif + +! V-WINDS 'W' + + print*,"- CALL FieldGather FOR TARGET GRID V_W FOR TILE: ", tile + call ESMF_FieldGather(v_w_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_w_top, dum3d_top) + call netcdf_err(error, 'WRITING V_W TOP' ) + dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_w_bottom, dum3d_bottom) + call netcdf_err(error, 'WRITING V_W BOTTOM' ) + dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_w_left, dum3d_left) + call netcdf_err(error, 'WRITING V_W LEFT' ) + dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_w_right, dum3d_right) + call netcdf_err(error, 'WRITING V_W RIGHT' ) + endif + + deallocate(dum3d_top, dum3d_bottom, dum3d_left, dum3d_right, data_one_tile_3d) + deallocate(id_tracer_bottom, id_tracer_top, id_tracer_left, id_tracer_right) + + if (localpet == 0) error = nf90_close(ncid) + + end subroutine write_fv3_atm_bndy_data_netcdf + +!--------------------------------------------------------------------------- +! Write atmospheric coldstart files. +! +! Routine write tiled files in parallel. Tile 1 is written by +! localpet 0; tile 2 by localpet 1, etc. The number of pets +! must be equal to or greater than the number of tiled files. +!--------------------------------------------------------------------------- + + subroutine write_fv3_atm_data_netcdf(localpet) + + use esmf + use netcdf + + use program_setup, only : halo=>halo_bndy, & + input_type, tracers, num_tracers + + use atmosphere, only : lev_target, & + levp1_target, & + ps_target_grid, & + zh_target_grid, & + dzdt_target_grid, & + tracers_target_grid, & + temp_target_grid, & + delp_target_grid, & + u_s_target_grid, & + v_s_target_grid, & + u_w_target_grid, & + v_w_target_grid + + use model_grid, only : num_tiles_target_grid, & + i_target, j_target, & + ip1_target, jp1_target, & + longitude_target_grid, & + latitude_target_grid + + implicit none + + integer, intent(in) :: localpet + + character(len=128) :: outfile + + integer :: error, ncid, tile, n + integer :: fsize=65536, initial = 0 + integer :: header_buffer_val = 16384 + integer :: dim_lon, dim_lat + integer :: dim_lonp, dim_latp + integer :: dim_lev, dim_levp1, dim_ntracer + integer, allocatable :: id_tracers(:) + integer :: id_lon, id_lat, id_ps + integer :: id_w, id_zh, id_u_w + integer :: id_v_w, id_u_s, id_v_s + integer :: id_t, id_delp + integer :: i_start, i_end, j_start, j_end + integer :: i_target_out, j_target_out + integer :: ip1_target_out, jp1_target_out + integer :: ip1_end, jp1_end + + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + real(kind=4), allocatable :: dum2d(:,:) + real(kind=4), allocatable :: dum3d(:,:,:) + +! Remove any halo region. + + i_target_out = i_target-(2*halo) + j_target_out = j_target-(2*halo) + + i_start = halo + 1 + j_start = halo + 1 + i_end = i_target - halo + j_end = j_target - halo + + ip1_target_out = i_target_out + 1 + jp1_target_out = j_target_out + 1 + + ip1_end = i_end + 1 + jp1_end = j_end + 1 + + if (localpet < num_tiles_target_grid) then + allocate(data_one_tile(i_target,j_target)) + allocate(dum2d(i_target_out,j_target_out)) + else + allocate(data_one_tile(0,0)) + allocate(dum2d(0,0)) + endif + + allocate(id_tracers(num_tracers)) + + HEADER : if (localpet < num_tiles_target_grid) then + + tile = localpet + 1 + WRITE(OUTFILE, '(A, I1, A)'), 'out.atm.tile', tile, '.nc' + +!--- open the file + error = nf90_create(outfile, IOR(NF90_NETCDF4,NF90_CLASSIC_MODEL), & + ncid, initialsize=initial, chunksize=fsize) + call netcdf_err(error, 'CREATING FILE='//trim(outfile) ) + +!--- define dimension + error = nf90_def_dim(ncid, 'lon', i_target_out, dim_lon) + call netcdf_err(error, 'DEFINING LON DIMENSION' ) + error = nf90_def_dim(ncid, 'lat', j_target_out, dim_lat) + call netcdf_err(error, 'DEFINING LAT DIMENSION' ) + error = nf90_def_dim(ncid, 'lonp', ip1_target_out, dim_lonp) + call netcdf_err(error, 'DEFINING LONP DIMENSION' ) + error = nf90_def_dim(ncid, 'latp', jp1_target_out, dim_latp) + call netcdf_err(error, 'DEFINING LATP DIMENSION' ) + error = nf90_def_dim(ncid, 'lev', lev_target, dim_lev) + call netcdf_err(error, 'DEFINING LEV DIMENSION' ) + error = nf90_def_dim(ncid, 'levp', levp1_target, dim_levp1) + call netcdf_err(error, 'DEFINING LEVP DIMENSION' ) + error = nf90_def_dim(ncid, 'ntracer', num_tracers, dim_ntracer) + call netcdf_err(error, 'DEFINING NTRACER DIMENSION' ) + +!--- define global attributes + if (trim(input_type) == "gaussian") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS GAUSSIAN NEMSIO FILE') + elseif (trim(input_type) == "gfs_gaussian") then + error = nf90_put_att(ncid, nf90_global, 'source', 'SPECTRAL GFS GAUSSIAN NEMSIO FILE') + elseif (trim(input_type) == "gfs_spectral") then + error = nf90_put_att(ncid, nf90_global, 'source', 'SPECTRAL GFS SIGIO FILE') + elseif (trim(input_type) == "history") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS TILED HISTORY FILE') + elseif (trim(input_type) == "restart") then + error = nf90_put_att(ncid, nf90_global, 'source', 'FV3GFS TILED RESTART FILE') + endif + +!--- define field + error = nf90_def_var(ncid, 'lon', NF90_FLOAT, (/dim_lon/), id_lon) + call netcdf_err(error, 'DEFINING LON FIELD' ) + error = nf90_put_att(ncid, id_lon, "cartesian_axis", "X") + call netcdf_err(error, 'WRITING LON FIELD' ) + error = nf90_def_var(ncid, 'lat', NF90_FLOAT, (/dim_lat/), id_lat) + call netcdf_err(error, 'DEFINING LAT FIELD' ) + error = nf90_put_att(ncid, id_lat, "cartesian_axis", "Y") + call netcdf_err(error, 'WRITING LAT FIELD' ) + error = nf90_def_var(ncid, 'ps', NF90_FLOAT, (/dim_lon,dim_lat/), id_ps) + call netcdf_err(error, 'WRITING PS' ) + error = nf90_def_var(ncid, 'w', NF90_FLOAT, (/dim_lon,dim_lat,dim_lev/), id_w) + call netcdf_err(error, 'WRITING W' ) + error = nf90_def_var(ncid, 'zh', NF90_FLOAT, (/dim_lon,dim_lat,dim_levp1/), id_zh) + call netcdf_err(error, 'WRITING ZH' ) + error = nf90_def_var(ncid, 't', NF90_FLOAT, (/dim_lon,dim_lat,dim_lev/), id_t) + call netcdf_err(error, 'WRITING T' ) + error = nf90_def_var(ncid, 'delp', NF90_FLOAT, (/dim_lon,dim_lat,dim_lev/), id_delp) + call netcdf_err(error, 'WRITING DELP' ) + do n = 1, num_tracers + error = nf90_def_var(ncid, tracers(n), NF90_FLOAT, (/dim_lon,dim_lat,dim_lev/), id_tracers(n)) + call netcdf_err(error, 'WRITING TRACERS' ) + enddo + error = nf90_def_var(ncid, 'u_w', NF90_FLOAT, (/dim_lonp,dim_lat,dim_lev/), id_u_w) + call netcdf_err(error, 'WRITING U_W' ) + error = nf90_def_var(ncid, 'v_w', NF90_FLOAT, (/dim_lonp,dim_lat,dim_lev/), id_v_w) + call netcdf_err(error, 'WRITING V_W' ) + error = nf90_def_var(ncid, 'u_s', NF90_FLOAT, (/dim_lon,dim_latp,dim_lev/), id_u_s) + call netcdf_err(error, 'WRITING U_S' ) + error = nf90_def_var(ncid, 'v_s', NF90_FLOAT, (/dim_lon,dim_latp,dim_lev/), id_v_s) + call netcdf_err(error, 'WRITING V_S' ) + + error = nf90_enddef(ncid, header_buffer_val,4,0,4) + call netcdf_err(error, 'DEFINING HEADER' ) + + endif HEADER + +! longitude + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID LONGITUDE FOR TILE: ", tile + call ESMF_FieldGather(longitude_target_grid, data_one_tile, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum2d(:,:) = data_one_tile(i_start:i_end, j_start:j_end) + error = nf90_put_var( ncid, id_lon, dum2d(:,1)) + call netcdf_err(error, 'WRITING LONGITUDE RECORD' ) + endif + +! latitude + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID LATITUDE FOR TILE: ", tile + call ESMF_FieldGather(latitude_target_grid, data_one_tile, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum2d(:,:) = data_one_tile(i_start:i_end, j_start:j_end) + error = nf90_put_var( ncid, id_lat, dum2d(1,:)) + call netcdf_err(error, 'WRITING LATITUDE RECORD' ) + endif + +! surface pressure + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID SURFACE PRESSURE FOR TILE: ", tile + call ESMF_FieldGather(ps_target_grid, data_one_tile, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum2d(:,:) = data_one_tile(i_start:i_end, j_start:j_end) + error = nf90_put_var( ncid, id_ps, dum2d) + call netcdf_err(error, 'WRITING SURFACE PRESSURE RECORD' ) + endif + + deallocate(dum2d, data_one_tile) + +! height + + if (localpet < num_tiles_target_grid) then + allocate(dum3d(i_target_out,j_target_out,levp1_target)) + allocate(data_one_tile_3d(i_target,j_target,levp1_target)) + else + allocate(dum3d(0,0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID HEIGHT FOR TILE: ", tile + call ESMF_FieldGather(zh_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:levp1_target) = dum3d(:,:,levp1_target:1:-1) + error = nf90_put_var( ncid, id_zh, dum3d) + call netcdf_err(error, 'WRITING HEIGHT RECORD' ) + endif + + deallocate(dum3d, data_one_tile_3d) + +! vertical velocity + + if (localpet < num_tiles_target_grid) then + allocate(dum3d(i_target_out,j_target_out,lev_target)) + allocate(data_one_tile_3d(i_target,j_target,lev_target)) + else + allocate(dum3d(0,0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID VERTICAL VELOCITY FOR TILE: ", tile + call ESMF_FieldGather(dzdt_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_w, dum3d) + call netcdf_err(error, 'WRITING VERTICAL VELOCITY RECORD' ) + endif + +! delp + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID DELP FOR TILE: ", tile + call ESMF_FieldGather(delp_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_delp, dum3d) + call netcdf_err(error, 'WRITING DELP RECORD' ) + endif + +! temperature + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID TEMPERATURE FOR TILE: ", tile + call ESMF_FieldGather(temp_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_t, dum3d) + call netcdf_err(error, 'WRITING TEMPERTAURE RECORD' ) + endif + +! tracers + + do n = 1, num_tracers + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID TRACER ", trim(tracers(n)), " TILE: ", tile + call ESMF_FieldGather(tracers_target_grid(n), data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_tracers(n), dum3d) + call netcdf_err(error, 'WRITING TRACER RECORD' ) + endif + + enddo + + deallocate(dum3d, data_one_tile_3d) + +! uwinds s + + if (localpet < num_tiles_target_grid) then + allocate(dum3d(i_target_out,jp1_target_out,lev_target)) + allocate(data_one_tile_3d(i_target,jp1_target,lev_target)) + else + allocate(dum3d(0,0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID U_S FOR TILE: ", tile + call ESMF_FieldGather(u_s_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:jp1_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_s, dum3d) + call netcdf_err(error, 'WRITING U_S RECORD' ) + endif + +! vwinds s + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID V_S FOR TILE: ", tile + call ESMF_FieldGather(v_s_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:jp1_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_s, dum3d) + call netcdf_err(error, 'WRITING V_S RECORD' ) + endif + + deallocate(dum3d, data_one_tile_3d) + +! uwinds w + + if (localpet < num_tiles_target_grid) then + allocate(dum3d(ip1_target_out,j_target_out,lev_target)) + allocate(data_one_tile_3d(ip1_target,j_target,lev_target)) + else + allocate(dum3d(0,0,0)) + allocate(data_one_tile_3d(0,0,0)) + endif + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID U_W FOR TILE: ", tile + call ESMF_FieldGather(u_w_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:ip1_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_u_w, dum3d) + call netcdf_err(error, 'WRITING U_W RECORD' ) + endif + +! vwinds w + + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET GRID V_W FOR TILE: ", tile + call ESMF_FieldGather(v_w_target_grid, data_one_tile_3d, rootPet=tile-1, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + enddo + + if (localpet < num_tiles_target_grid) then + dum3d(:,:,:) = data_one_tile_3d(i_start:ip1_end,j_start:j_end,:) + dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) + error = nf90_put_var( ncid, id_v_w, dum3d) + call netcdf_err(error, 'WRITING V_W RECORD' ) + endif + + deallocate(dum3d, data_one_tile_3d, id_tracers) + +!------------------------------------------------------------------------------- +! close file +!------------------------------------------------------------------------------- + + if (localpet < num_tiles_target_grid) error = nf90_close(ncid) + + end subroutine write_fv3_atm_data_netcdf + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + + subroutine write_fv3_sfc_data_netcdf(localpet) + + use esmf + use netcdf + + use model_grid, only : num_tiles_target_grid, & + landmask_target_grid, & + i_target, j_target, lsoil_target + + use program_setup, only : convert_nst, halo=>halo_bndy + + use surface, only : canopy_mc_target_grid, & + f10m_target_grid, & + ffmm_target_grid, & + q2m_target_grid, & + seaice_depth_target_grid, & + seaice_fract_target_grid, & + seaice_skin_temp_target_grid, & + skin_temp_target_grid, & + soil_temp_target_grid, & + soilm_liq_target_grid, & + soilm_tot_target_grid, & + srflag_target_grid, & + snow_liq_equiv_target_grid, & + snow_depth_target_grid, & + t2m_target_grid, & + tprcp_target_grid, & + ustar_target_grid, & + z0_target_grid, & + c_d_target_grid, & + c_0_target_grid, & + d_conv_target_grid, & + dt_cool_target_grid, & + ifd_target_grid, & + qrain_target_grid, & + tref_target_grid, & + w_d_target_grid, & + w_0_target_grid, & + xs_target_grid, & + xt_target_grid, & + xu_target_grid, & + xv_target_grid, & + xz_target_grid, & + xtts_target_grid, & + xzts_target_grid, & + z_c_target_grid, & + zm_target_grid + + use static_data, only : alvsf_target_grid, & + alnsf_target_grid, & + alvwf_target_grid, & + alnwf_target_grid, & + facsf_target_grid, & + facwf_target_grid, & + max_veg_greenness_target_grid, & + min_veg_greenness_target_grid, & + mxsno_albedo_target_grid, & + slope_type_target_grid, & + soil_type_target_grid, & + substrate_temp_target_grid, & + veg_greenness_target_grid, & + veg_type_target_grid + + implicit none + + integer, intent(in) :: localpet + character(len=128) :: outfile + + integer :: fsize=65536, initial = 0 + integer :: header_buffer_val = 16384 + integer :: dim_x, dim_y, dim_lsoil, dim_time + integer :: error, i, ncid, tile + integer :: id_x, id_y, id_lsoil + integer :: id_slmsk, id_time + integer :: id_tsea, id_sheleg, id_tg3 + integer :: id_zorl, id_alvsf, id_alvwf + integer :: id_alnsf, id_alnwf, id_vfrac + integer :: id_canopy, id_f10m, id_t2m + integer :: id_q2m, id_vtype, id_stype + integer :: id_facsf, id_facwf, id_uustar + integer :: id_ffmm, id_ffhh, id_hice + integer :: id_fice, id_tisfc, id_tprcp + integer :: id_srflag, id_snwdph, id_shdmin + integer :: id_shdmax, id_slope, id_snoalb + integer :: id_stc, id_smc, id_slc + integer :: id_tref, id_z_c, id_c_0 + integer :: id_c_d, id_w_0, id_w_d + integer :: id_xt, id_xs, id_xu, id_xv + integer :: id_xz, id_zm, id_xtts, id_xzts + integer :: id_d_conv, id_ifd, id_dt_cool + integer :: id_qrain + integer :: i_target_out, j_target_out + integer :: istart, iend, jstart, jend + + integer(esmf_kind_i8), allocatable :: idata_one_tile(:,:) + + real(kind=4), allocatable :: lsoil_data(:), x_data(:), y_data(:) + real(kind=8), allocatable :: dum2d(:,:), dum3d(:,:,:) + real(kind=4) :: times + real(esmf_kind_r8), allocatable :: data_one_tile(:,:) + real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) + +! Remove any halo region. + + i_target_out = i_target-(2*halo) + j_target_out = j_target-(2*halo) + + istart = halo + 1 + jstart = halo + 1 + iend = i_target - halo + jend = j_target - halo + + allocate(lsoil_data(lsoil_target)) + do i = 1, lsoil_target + lsoil_data(i) = float(i) + enddo + + allocate(x_data(i_target_out)) + do i = 1, i_target_out + x_data(i) = float(i) + enddo + + allocate(y_data(j_target_out)) + do i = 1, j_target_out + y_data(i) = float(i) + enddo + + if (convert_nst) then + print*,'- WRITE FV3 SURFACE AND NST DATA TO NETCDF FILE' + else + print*,'- WRITE FV3 SURFACE DATA TO NETCDF FILE' + endif + + if (localpet == 0) then + allocate(data_one_tile(i_target,j_target)) + allocate(data_one_tile_3d(i_target,j_target,lsoil_target)) + allocate(idata_one_tile(i_target,j_target)) + allocate(dum2d(i_target_out,j_target_out)) + allocate(dum3d(i_target_out,j_target_out,lsoil_target)) + else + allocate(data_one_tile(0,0)) + allocate(data_one_tile_3d(0,0,0)) + allocate(idata_one_tile(0,0)) + allocate(dum2d(0,0)) + allocate(dum3d(0,0,0)) + endif + + TILE_LOOP : do tile = 1, num_tiles_target_grid + + LOCAL_PET : if (localpet == 0) then + + WRITE(OUTFILE, '(A, I1, A)'), 'out.sfc.tile', tile, '.nc' + +!--- open the file + error = nf90_create(outfile, IOR(NF90_NETCDF4,NF90_CLASSIC_MODEL), & + ncid, initialsize=initial, chunksize=fsize) + call netcdf_err(error, 'CREATING FILE='//trim(outfile) ) + +!--- define dimensions + error = nf90_def_dim(ncid, 'xaxis_1', i_target_out, dim_x) + call netcdf_err(error, 'DEFINING XAXIS DIMENSION' ) + error = nf90_def_dim(ncid, 'yaxis_1', j_target_out, dim_y) + call netcdf_err(error, 'DEFINING YAXIS DIMENSION' ) + error = nf90_def_dim(ncid, 'zaxis_1', lsoil_target, dim_lsoil) + call netcdf_err(error, 'DEFINING ZAXIS DIMENSION' ) + error = nf90_def_dim(ncid, 'Time', 1, dim_time) + call netcdf_err(error, 'DEFINING TIME DIMENSION' ) + + !--- define fields + error = nf90_def_var(ncid, 'xaxis_1', NF90_FLOAT, (/dim_x/), id_x) + call netcdf_err(error, 'DEFINING XAXIS_1 FIELD' ) + error = nf90_put_att(ncid, id_x, "long_name", "xaxis_1") + call netcdf_err(error, 'DEFINING XAXIS_1 LONG NAME' ) + error = nf90_put_att(ncid, id_x, "units", "none") + call netcdf_err(error, 'DEFINING XAXIS_1 UNITS' ) + error = nf90_put_att(ncid, id_x, "cartesian_axis", "X") + call netcdf_err(error, 'WRITING XAXIS_1 FIELD' ) + + error = nf90_def_var(ncid, 'yaxis_1', NF90_FLOAT, (/dim_y/), id_y) + call netcdf_err(error, 'DEFINING YAXIS_1 FIELD' ) + error = nf90_put_att(ncid, id_y, "long_name", "yaxis_1") + call netcdf_err(error, 'DEFINING YAXIS_1 LONG NAME' ) + error = nf90_put_att(ncid, id_y, "units", "none") + call netcdf_err(error, 'DEFINING YAXIS_1 UNITS' ) + error = nf90_put_att(ncid, id_y, "cartesian_axis", "Y") + call netcdf_err(error, 'WRITING YAXIS_1 FIELD' ) + + error = nf90_def_var(ncid, 'zaxis_1', NF90_FLOAT, (/dim_lsoil/), id_lsoil) + call netcdf_err(error, 'DEFINING ZAXIS_1 FIELD' ) + error = nf90_put_att(ncid, id_lsoil, "long_name", "zaxis_1") + call netcdf_err(error, 'DEFINING ZAXIS_1 LONG NAME' ) + error = nf90_put_att(ncid, id_lsoil, "units", "none") + call netcdf_err(error, 'DEFINING ZAXIS_1 UNITS' ) + error = nf90_put_att(ncid, id_lsoil, "cartesian_axis", "Z") + call netcdf_err(error, 'WRITING ZAXIS_1 FIELD' ) + + error = nf90_def_var(ncid, 'Time', NF90_FLOAT, dim_time, id_time) + call netcdf_err(error, 'DEFINING TIME FIELD' ) + error = nf90_put_att(ncid, id_time, "long_name", "Time") + call netcdf_err(error, 'DEFINING TIME LONG NAME' ) + error = nf90_put_att(ncid, id_time, "units", "time level") + call netcdf_err(error, 'DEFINING TIME UNITS' ) + error = nf90_put_att(ncid, id_time, "cartesian_axis", "T") + call netcdf_err(error, 'WRITING TIME FIELD' ) + + error = nf90_def_var(ncid, 'slmsk', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_slmsk) + call netcdf_err(error, 'DEFINING SLMSK' ) + error = nf90_put_att(ncid, id_slmsk, "long_name", "slmsk") + call netcdf_err(error, 'DEFINING SLMSK LONG NAME' ) + error = nf90_put_att(ncid, id_slmsk, "units", "none") + call netcdf_err(error, 'DEFINING SLMSK UNITS' ) + + error = nf90_def_var(ncid, 'tsea', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_tsea) + call netcdf_err(error, 'DEFINING TSEA' ) + error = nf90_put_att(ncid, id_tsea, "long_name", "tsea") + call netcdf_err(error, 'DEFINING TSEA LONG NAME' ) + error = nf90_put_att(ncid, id_tsea, "units", "none") + call netcdf_err(error, 'DEFINING TSEA UNITS' ) + + error = nf90_def_var(ncid, 'sheleg', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_sheleg) + call netcdf_err(error, 'DEFINING SHELEG' ) + error = nf90_put_att(ncid, id_sheleg, "long_name", "sheleg") + call netcdf_err(error, 'DEFINING SHELEG LONG NAME' ) + error = nf90_put_att(ncid, id_sheleg, "units", "none") + call netcdf_err(error, 'DEFINING SHELEG UNITS' ) + + error = nf90_def_var(ncid, 'tg3', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_tg3) + call netcdf_err(error, 'DEFINING TG3' ) + error = nf90_put_att(ncid, id_tg3, "long_name", "tg3") + call netcdf_err(error, 'DEFINING TG3 LONG NAME' ) + error = nf90_put_att(ncid, id_tg3, "units", "none") + call netcdf_err(error, 'DEFINING TG3 UNITS' ) + + error = nf90_def_var(ncid, 'zorl', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_zorl) + call netcdf_err(error, 'DEFINING ZORL' ) + error = nf90_put_att(ncid, id_zorl, "long_name", "zorl") + call netcdf_err(error, 'DEFINING ZORL LONG NAME' ) + error = nf90_put_att(ncid, id_zorl, "units", "none") + call netcdf_err(error, 'DEFINING ZORL UNITS' ) + + error = nf90_def_var(ncid, 'alvsf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_alvsf) + call netcdf_err(error, 'DEFINING ALVSF' ) + error = nf90_put_att(ncid, id_alvsf, "long_name", "alvsf") + call netcdf_err(error, 'DEFINING ALVSF LONG NAME' ) + error = nf90_put_att(ncid, id_alvsf, "units", "none") + call netcdf_err(error, 'DEFINING ALVSF UNITS' ) + + error = nf90_def_var(ncid, 'alvwf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_alvwf) + call netcdf_err(error, 'DEFINING ALVWF' ) + error = nf90_put_att(ncid, id_alvwf, "long_name", "alvwf") + call netcdf_err(error, 'DEFINING ALVWF LONG NAME' ) + error = nf90_put_att(ncid, id_alvwf, "units", "none") + call netcdf_err(error, 'DEFINING ALVWF UNITS' ) + + error = nf90_def_var(ncid, 'alnsf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_alnsf) + call netcdf_err(error, 'DEFINING ALNSF' ) + error = nf90_put_att(ncid, id_alnsf, "long_name", "alnsf") + call netcdf_err(error, 'DEFINING ALNSF LONG NAME' ) + error = nf90_put_att(ncid, id_alnsf, "units", "none") + call netcdf_err(error, 'DEFINING ALNSF UNITS' ) + + error = nf90_def_var(ncid, 'alnwf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_alnwf) + call netcdf_err(error, 'DEFINING ALNWF' ) + error = nf90_put_att(ncid, id_alnwf, "long_name", "alnwf") + call netcdf_err(error, 'DEFINING ALNWF LONG NAME' ) + error = nf90_put_att(ncid, id_alnwf, "units", "none") + call netcdf_err(error, 'DEFINING ALNWF UNITS' ) + + error = nf90_def_var(ncid, 'facsf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_facsf) + call netcdf_err(error, 'DEFINING FACSF' ) + error = nf90_put_att(ncid, id_facsf, "long_name", "facsf") + call netcdf_err(error, 'DEFINING FACSF LONG NAME' ) + error = nf90_put_att(ncid, id_facsf, "units", "none") + call netcdf_err(error, 'DEFINING FACSF UNITS' ) + + error = nf90_def_var(ncid, 'facwf', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_facwf) + call netcdf_err(error, 'DEFINING FACWF' ) + error = nf90_put_att(ncid, id_facwf, "long_name", "facwf") + call netcdf_err(error, 'DEFINING FACWF LONG NAME' ) + error = nf90_put_att(ncid, id_facwf, "units", "none") + call netcdf_err(error, 'DEFINING FACWF UNITS' ) + + error = nf90_def_var(ncid, 'vfrac', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_vfrac) + call netcdf_err(error, 'DEFINING VFRAC' ) + error = nf90_put_att(ncid, id_vfrac, "long_name", "vfrac") + call netcdf_err(error, 'DEFINING VFRAC LONG NAME' ) + error = nf90_put_att(ncid, id_vfrac, "units", "none") + call netcdf_err(error, 'DEFINING VFRAC UNITS' ) + + error = nf90_def_var(ncid, 'canopy', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_canopy) + call netcdf_err(error, 'DEFINING CANOPY' ) + error = nf90_put_att(ncid, id_canopy, "long_name", "canopy") + call netcdf_err(error, 'DEFINING CANOPY LONG NAME' ) + error = nf90_put_att(ncid, id_canopy, "units", "none") + call netcdf_err(error, 'DEFINING CANOPY UNITS' ) + + error = nf90_def_var(ncid, 'f10m', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_f10m) + call netcdf_err(error, 'DEFINING F10M' ) + error = nf90_put_att(ncid, id_f10m, "long_name", "f10m") + call netcdf_err(error, 'DEFINING F10M LONG NAME' ) + error = nf90_put_att(ncid, id_f10m, "units", "none") + call netcdf_err(error, 'DEFINING F10M UNITS' ) + + error = nf90_def_var(ncid, 't2m', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_t2m) + call netcdf_err(error, 'DEFINING T2M' ) + error = nf90_put_att(ncid, id_t2m, "long_name", "t2m") + call netcdf_err(error, 'DEFINING T2M LONG NAME' ) + error = nf90_put_att(ncid, id_t2m, "units", "none") + call netcdf_err(error, 'DEFINING T2M UNITS' ) + + error = nf90_def_var(ncid, 'q2m', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_q2m) + call netcdf_err(error, 'DEFINING Q2M' ) + error = nf90_put_att(ncid, id_q2m, "long_name", "q2m") + call netcdf_err(error, 'DEFINING Q2M LONG NAME' ) + error = nf90_put_att(ncid, id_q2m, "units", "none") + call netcdf_err(error, 'DEFINING Q2M UNITS' ) + + error = nf90_def_var(ncid, 'vtype', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_vtype) + call netcdf_err(error, 'DEFINING VTYPE' ) + error = nf90_put_att(ncid, id_vtype, "long_name", "vtype") + call netcdf_err(error, 'DEFINING VTYPE LONG NAME' ) + error = nf90_put_att(ncid, id_vtype, "units", "none") + call netcdf_err(error, 'DEFINING VTYPE UNITS' ) + + error = nf90_def_var(ncid, 'stype', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_stype) + call netcdf_err(error, 'DEFINING STYPE' ) + error = nf90_put_att(ncid, id_stype, "long_name", "stype") + call netcdf_err(error, 'DEFINING STYPE LONG NAME' ) + error = nf90_put_att(ncid, id_stype, "units", "none") + call netcdf_err(error, 'DEFINING STYPE UNITS' ) + + error = nf90_def_var(ncid, 'uustar', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_uustar) + call netcdf_err(error, 'DEFINING UUSTAR' ) + error = nf90_put_att(ncid, id_uustar, "long_name", "uustar") + call netcdf_err(error, 'DEFINING UUSTAR LONG NAME' ) + error = nf90_put_att(ncid, id_uustar, "units", "none") + call netcdf_err(error, 'DEFINING UUSTAR UNITS' ) + + error = nf90_def_var(ncid, 'ffmm', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_ffmm) + call netcdf_err(error, 'DEFINING FFMM' ) + error = nf90_put_att(ncid, id_ffmm, "long_name", "ffmm") + call netcdf_err(error, 'DEFINING FFMM LONG NAME' ) + error = nf90_put_att(ncid, id_ffmm, "units", "none") + call netcdf_err(error, 'DEFINING FFMM UNITS' ) + + error = nf90_def_var(ncid, 'ffhh', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_ffhh) + call netcdf_err(error, 'DEFINING FFHH' ) + error = nf90_put_att(ncid, id_ffhh, "long_name", "ffhh") + call netcdf_err(error, 'DEFINING FFHH LONG NAME' ) + error = nf90_put_att(ncid, id_ffhh, "units", "none") + call netcdf_err(error, 'DEFINING FFHH UNITS' ) + + error = nf90_def_var(ncid, 'hice', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_hice) + call netcdf_err(error, 'DEFINING HICE' ) + error = nf90_put_att(ncid, id_hice, "long_name", "hice") + call netcdf_err(error, 'DEFINING HICE LONG NAME' ) + error = nf90_put_att(ncid, id_hice, "units", "none") + call netcdf_err(error, 'DEFINING HICE UNITS' ) + + error = nf90_def_var(ncid, 'fice', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_fice) + call netcdf_err(error, 'DEFINING FICE' ) + error = nf90_put_att(ncid, id_fice, "long_name", "fice") + call netcdf_err(error, 'DEFINING FICE LONG NAME' ) + error = nf90_put_att(ncid, id_fice, "units", "none") + call netcdf_err(error, 'DEFINING FICE UNITS' ) + + error = nf90_def_var(ncid, 'tisfc', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_tisfc) + call netcdf_err(error, 'DEFINING TISFC' ) + error = nf90_put_att(ncid, id_tisfc, "long_name", "tisfc") + call netcdf_err(error, 'DEFINING TISFC LONG NAME' ) + error = nf90_put_att(ncid, id_tisfc, "units", "none") + call netcdf_err(error, 'DEFINING TISFC UNITS' ) + + error = nf90_def_var(ncid, 'tprcp', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_tprcp) + call netcdf_err(error, 'DEFINING TPRCP' ) + error = nf90_put_att(ncid, id_tprcp, "long_name", "tprcp") + call netcdf_err(error, 'DEFINING TPRCP LONG NAME' ) + error = nf90_put_att(ncid, id_tprcp, "units", "none") + call netcdf_err(error, 'DEFINING TPRCP UNITS' ) + + error = nf90_def_var(ncid, 'srflag', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_srflag) + call netcdf_err(error, 'DEFINING SRFLAG' ) + error = nf90_put_att(ncid, id_srflag, "long_name", "srflag") + call netcdf_err(error, 'DEFINING SRFLAG LONG NAME' ) + error = nf90_put_att(ncid, id_srflag, "units", "none") + call netcdf_err(error, 'DEFINING SRFLAG UNITS' ) + + error = nf90_def_var(ncid, 'snwdph', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_snwdph) + call netcdf_err(error, 'DEFINING SNWDPH' ) + error = nf90_put_att(ncid, id_snwdph, "long_name", "snwdph") + call netcdf_err(error, 'DEFINING SNWDPH LONG NAME' ) + error = nf90_put_att(ncid, id_snwdph, "units", "none") + call netcdf_err(error, 'DEFINING SNWDPH UNITS' ) + + error = nf90_def_var(ncid, 'shdmin', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_shdmin) + call netcdf_err(error, 'DEFINING SHDMIN' ) + error = nf90_put_att(ncid, id_shdmin, "long_name", "shdmin") + call netcdf_err(error, 'DEFINING SHDMIN LONG NAME' ) + error = nf90_put_att(ncid, id_shdmin, "units", "none") + call netcdf_err(error, 'DEFINING SHDMIN UNITS' ) + + error = nf90_def_var(ncid, 'shdmax', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_shdmax) + call netcdf_err(error, 'DEFINING SHDMAX' ) + error = nf90_put_att(ncid, id_shdmax, "long_name", "shdmax") + call netcdf_err(error, 'DEFINING SHDMAX LONG NAME' ) + error = nf90_put_att(ncid, id_shdmax, "units", "none") + call netcdf_err(error, 'DEFINING SHDMAX UNITS' ) + + error = nf90_def_var(ncid, 'slope', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_slope) + call netcdf_err(error, 'DEFINING SLOPE' ) + error = nf90_put_att(ncid, id_slope, "long_name", "slope") + call netcdf_err(error, 'DEFINING SLOPE LONG NAME' ) + error = nf90_put_att(ncid, id_slope, "units", "none") + call netcdf_err(error, 'DEFINING SLOPE UNITS' ) + + error = nf90_def_var(ncid, 'snoalb', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_snoalb) + call netcdf_err(error, 'DEFINING SNOALB' ) + error = nf90_put_att(ncid, id_snoalb, "long_name", "snoalb") + call netcdf_err(error, 'DEFINING SNOALB LONG NAME' ) + error = nf90_put_att(ncid, id_snoalb, "units", "none") + call netcdf_err(error, 'DEFINING SNOALB UNITS' ) + + error = nf90_def_var(ncid, 'stc', NF90_DOUBLE, (/dim_x,dim_y,dim_lsoil,dim_time/), id_stc) + call netcdf_err(error, 'DEFINING STC' ) + error = nf90_put_att(ncid, id_stc, "long_name", "stc") + call netcdf_err(error, 'DEFINING STC LONG NAME' ) + error = nf90_put_att(ncid, id_stc, "units", "none") + call netcdf_err(error, 'DEFINING STC UNITS' ) + + error = nf90_def_var(ncid, 'smc', NF90_DOUBLE, (/dim_x,dim_y,dim_lsoil,dim_time/), id_smc) + call netcdf_err(error, 'DEFINING SMC' ) + error = nf90_put_att(ncid, id_smc, "long_name", "smc") + call netcdf_err(error, 'DEFINING SMC LONG NAME' ) + error = nf90_put_att(ncid, id_smc, "units", "none") + call netcdf_err(error, 'DEFINING SMC UNITS' ) + + error = nf90_def_var(ncid, 'slc', NF90_DOUBLE, (/dim_x,dim_y,dim_lsoil,dim_time/), id_slc) + call netcdf_err(error, 'DEFINING SLC' ) + error = nf90_put_att(ncid, id_slc, "long_name", "slc") + call netcdf_err(error, 'DEFINING SLC LONG NAME' ) + error = nf90_put_att(ncid, id_slc, "units", "none") + call netcdf_err(error, 'DEFINING SLC UNITS' ) + + if (convert_nst) then + + error = nf90_def_var(ncid, 'tref', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_tref) + call netcdf_err(error, 'DEFINING TREF' ) + error = nf90_put_att(ncid, id_tref, "long_name", "tref") + call netcdf_err(error, 'DEFINING TREF LONG NAME' ) + error = nf90_put_att(ncid, id_tref, "units", "none") + call netcdf_err(error, 'DEFINING TREF UNITS' ) + + error = nf90_def_var(ncid, 'z_c', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_z_c) + call netcdf_err(error, 'DEFINING Z_C' ) + error = nf90_put_att(ncid, id_z_c, "long_name", "z_c") + call netcdf_err(error, 'DEFINING Z_C LONG NAME' ) + error = nf90_put_att(ncid, id_z_c, "units", "none") + call netcdf_err(error, 'DEFINING Z_C UNITS' ) + + error = nf90_def_var(ncid, 'c_0', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_c_0) + call netcdf_err(error, 'DEFINING C_0' ) + error = nf90_put_att(ncid, id_c_0, "long_name", "c_0") + call netcdf_err(error, 'DEFINING C_0 LONG NAME' ) + error = nf90_put_att(ncid, id_c_0, "units", "none") + call netcdf_err(error, 'DEFINING C_0 UNITS' ) + + error = nf90_def_var(ncid, 'c_d', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_c_d) + call netcdf_err(error, 'DEFINING C_D' ) + error = nf90_put_att(ncid, id_c_d, "long_name", "c_d") + call netcdf_err(error, 'DEFINING C_D LONG NAME' ) + error = nf90_put_att(ncid, id_c_d, "units", "none") + call netcdf_err(error, 'DEFINING C_D UNITS' ) + + error = nf90_def_var(ncid, 'w_0', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_w_0) + call netcdf_err(error, 'DEFINING W_0' ) + error = nf90_put_att(ncid, id_w_0, "long_name", "w_0") + call netcdf_err(error, 'DEFINING W_0 LONG NAME' ) + error = nf90_put_att(ncid, id_w_0, "units", "none") + call netcdf_err(error, 'DEFINING W_0 UNITS' ) + + error = nf90_def_var(ncid, 'w_d', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_w_d) + call netcdf_err(error, 'DEFINING W_D' ) + error = nf90_put_att(ncid, id_w_d, "long_name", "w_d") + call netcdf_err(error, 'DEFINING W_D LONG NAME' ) + error = nf90_put_att(ncid, id_w_d, "units", "none") + call netcdf_err(error, 'DEFINING W_D UNITS' ) + + error = nf90_def_var(ncid, 'xt', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xt) + call netcdf_err(error, 'DEFINING XT' ) + error = nf90_put_att(ncid, id_xt, "long_name", "xt") + call netcdf_err(error, 'DEFINING XT LONG NAME' ) + error = nf90_put_att(ncid, id_xt, "units", "none") + call netcdf_err(error, 'DEFINING XT UNITS' ) + + error = nf90_def_var(ncid, 'xs', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xs) + call netcdf_err(error, 'DEFINING XS' ) + error = nf90_put_att(ncid, id_xs, "long_name", "xs") + call netcdf_err(error, 'DEFINING XS LONG NAME' ) + error = nf90_put_att(ncid, id_xs, "units", "none") + call netcdf_err(error, 'DEFINING XS UNITS' ) + + error = nf90_def_var(ncid, 'xu', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xu) + call netcdf_err(error, 'DEFINING XU' ) + error = nf90_put_att(ncid, id_xu, "long_name", "xu") + call netcdf_err(error, 'DEFINING XU LONG NAME' ) + error = nf90_put_att(ncid, id_xu, "units", "none") + call netcdf_err(error, 'DEFINING XU UNITS' ) + + error = nf90_def_var(ncid, 'xv', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xv) + call netcdf_err(error, 'DEFINING XV' ) + error = nf90_put_att(ncid, id_xv, "long_name", "xv") + call netcdf_err(error, 'DEFINING XV LONG NAME' ) + error = nf90_put_att(ncid, id_xv, "units", "none") + call netcdf_err(error, 'DEFINING XV UNITS' ) + + error = nf90_def_var(ncid, 'xz', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xz) + call netcdf_err(error, 'DEFINING XZ' ) + error = nf90_put_att(ncid, id_xz, "long_name", "xz") + call netcdf_err(error, 'DEFINING XZ LONG NAME' ) + error = nf90_put_att(ncid, id_xz, "units", "none") + call netcdf_err(error, 'DEFINING XZ UNITS' ) + + error = nf90_def_var(ncid, 'zm', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_zm) + call netcdf_err(error, 'DEFINING ZM' ) + error = nf90_put_att(ncid, id_zm, "long_name", "zm") + call netcdf_err(error, 'DEFINING ZM LONG NAME' ) + error = nf90_put_att(ncid, id_zm, "units", "none") + call netcdf_err(error, 'DEFINING ZM UNITS' ) + + error = nf90_def_var(ncid, 'xtts', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xtts) + call netcdf_err(error, 'DEFINING XTTS' ) + error = nf90_put_att(ncid, id_xtts, "long_name", "xtts") + call netcdf_err(error, 'DEFINING XTTS LONG NAME' ) + error = nf90_put_att(ncid, id_xtts, "units", "none") + call netcdf_err(error, 'DEFINING XTTS UNITS' ) + + error = nf90_def_var(ncid, 'xzts', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_xzts) + call netcdf_err(error, 'DEFINING XZTS' ) + error = nf90_put_att(ncid, id_xzts, "long_name", "xzts") + call netcdf_err(error, 'DEFINING XZTS LONG NAME' ) + error = nf90_put_att(ncid, id_xzts, "units", "none") + call netcdf_err(error, 'DEFINING XZTS UNITS' ) + + error = nf90_def_var(ncid, 'd_conv', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_d_conv) + call netcdf_err(error, 'DEFINING D_CONV' ) + error = nf90_put_att(ncid, id_d_conv, "long_name", "d_conv") + call netcdf_err(error, 'DEFINING D_CONV LONG NAME' ) + error = nf90_put_att(ncid, id_d_conv, "units", "none") + call netcdf_err(error, 'DEFINING D_CONV UNITS' ) + + error = nf90_def_var(ncid, 'ifd', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_ifd) + call netcdf_err(error, 'DEFINING IFD' ) + error = nf90_put_att(ncid, id_ifd, "long_name", "ifd") + call netcdf_err(error, 'DEFINING IFD LONG NAME' ) + error = nf90_put_att(ncid, id_ifd, "units", "none") + call netcdf_err(error, 'DEFINING IFD UNITS' ) + + error = nf90_def_var(ncid, 'dt_cool', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_dt_cool) + call netcdf_err(error, 'DEFINING DT_COOL' ) + error = nf90_put_att(ncid, id_dt_cool, "long_name", "dt_cool") + call netcdf_err(error, 'DEFINING DT_COOL LONG NAME' ) + error = nf90_put_att(ncid, id_dt_cool, "units", "none") + call netcdf_err(error, 'DEFINING DT_COOL UNITS' ) + + error = nf90_def_var(ncid, 'qrain', NF90_DOUBLE, (/dim_x,dim_y,dim_time/), id_qrain) + call netcdf_err(error, 'DEFINING QRAIN' ) + error = nf90_put_att(ncid, id_qrain, "long_name", "qrain") + call netcdf_err(error, 'DEFINING QRAIN LONG NAME' ) + error = nf90_put_att(ncid, id_qrain, "units", "none") + call netcdf_err(error, 'DEFINING QRAIN UNITS' ) + + endif ! nsst records + + error = nf90_enddef(ncid, header_buffer_val,4,0,4) + call netcdf_err(error, 'DEFINING HEADER' ) + + endif LOCAL_PET ! is localpet 0? + + if (localpet == 0) then + error = nf90_put_var( ncid, id_lsoil, lsoil_data) + call netcdf_err(error, 'WRITING ZAXIS RECORD' ) + error = nf90_put_var( ncid, id_x, x_data) + call netcdf_err(error, 'WRITING XAXIS RECORD' ) + error = nf90_put_var( ncid, id_y, y_data) + call netcdf_err(error, 'WRITING YAXIS RECORD' ) + times = 1.0 + error = nf90_put_var( ncid, id_time, times) + call netcdf_err(error, 'WRITING TIME RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQ EQUIV FOR TILE: ", tile + call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_sheleg, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SNOW LIQ EQUIV RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH FOR TILE: ", tile + call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_snwdph, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SNWDPH RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SLOPE TYPE FOR TILE: ", tile + call ESMF_FieldGather(slope_type_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_slope, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SLOPE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID Z0 FOR TILE: ", tile + call ESMF_FieldGather(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_zorl, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING Z0 RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID MAX SNOW ALBEDO FOR TILE: ", tile + call ESMF_FieldGather(mxsno_albedo_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_snoalb, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING MAX SNOW ALBEDO RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SOIL TYPE FOR TILE: ", tile + call ESMF_FieldGather(soil_type_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_stype, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SOIL TYPE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID VEGETATION TYPE FOR TILE: ", tile + call ESMF_FieldGather(veg_type_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_vtype, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING VEGETATION TYPE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID VEGETATION GREENNESS FOR TILE: ", tile + call ESMF_FieldGather(veg_greenness_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_vfrac, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING VEGETATION GREENNESS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SUBSTRATE TEMPERATURE FOR TILE: ", tile + call ESMF_FieldGather(substrate_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_tg3, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SUBSTRATE TEMPERATURE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID FACSF FOR TILE: ", tile + call ESMF_FieldGather(facsf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_facsf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING FACSF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID FACWF FOR TILE: ", tile + call ESMF_FieldGather(facwf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_facwf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING FACWF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID ALNSF FOR TILE: ", tile + call ESMF_FieldGather(alnsf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_alnsf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING ALNSF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID ALNWF FOR TILE: ", tile + call ESMF_FieldGather(alnwf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_alnwf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING ALNWF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID ALVSF FOR TILE: ", tile + call ESMF_FieldGather(alvsf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_alvsf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING ALVSF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID ALVWF FOR TILE: ", tile + call ESMF_FieldGather(alvwf_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_alvwf, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING ALVWF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID MAX VEGETATION GREENNESS FOR TILE: ", tile + call ESMF_FieldGather(max_veg_greenness_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_shdmax, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING MAX VEGETATION GREENNESS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID MIN VEGETATION GREENNESS FOR TILE: ", tile + call ESMF_FieldGather(min_veg_greenness_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_shdmin, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING MIN VEGETATION GREENNESS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID T2M FOR TILE: ", tile + call ESMF_FieldGather(t2m_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_t2m, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING T2M RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID Q2M FOR TILE: ", tile + call ESMF_FieldGather(q2m_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_q2m, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING Q2M RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID TPRCP FOR TILE: ", tile + call ESMF_FieldGather(tprcp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_tprcp, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING TPRCP RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID F10M FOR TILE: ", tile + call ESMF_FieldGather(f10m_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_f10m, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING F10M RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID FFMM FOR TILE: ", tile + call ESMF_FieldGather(ffmm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_ffmm, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING FFMM RECORD' ) + dum2d = 0.0 + error = nf90_put_var( ncid, id_ffhh, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING FFHH RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID USTAR FOR TILE: ", tile + call ESMF_FieldGather(ustar_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_uustar, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING USTAR RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SRFLAG FOR TILE: ", tile + call ESMF_FieldGather(srflag_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_srflag, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING SRFLAG RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SEA ICE FRACTION FOR TILE: ", tile + call ESMF_FieldGather(seaice_fract_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_fice, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING FICE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SEA ICE DEPTH FOR TILE: ", tile + call ESMF_FieldGather(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_hice, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING HICE RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SEA ICE SKIN TEMP FOR TILE: ", tile + call ESMF_FieldGather(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_tisfc, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING TISFC RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMP FOR TILE: ", tile + call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_tsea, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING TSEA RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID LANDMASK FOR TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, idata_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = float(idata_one_tile(istart:iend, jstart:jend)) + error = nf90_put_var( ncid, id_slmsk, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING LANDMASK RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET GRID CANOPY MOISTURE CONTENT FOR TILE: ", tile + call ESMF_FieldGather(canopy_mc_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_canopy, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING CANOPY MC RECORD' ) + endif + +! soil temperature + + print*,"- CALL FieldGather FOR TARGET GRID SOIL TEMPERATURE FOR TILE: ", tile + call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d(:,:,:) = data_one_tile_3d(istart:iend, jstart:jend,:) + error = nf90_put_var( ncid, id_stc, dum3d, start=(/1,1,1,1/), count=(/i_target_out,j_target_out,lsoil_target,1/)) + call netcdf_err(error, 'WRITING SOIL TEMP RECORD' ) + endif + +! soil moisture (total) + + print*,"- CALL FieldGather FOR TARGET GRID TOTAL SOIL MOISTURE FOR TILE: ", tile + call ESMF_FieldGather(soilm_tot_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d(:,:,:) = data_one_tile_3d(istart:iend, jstart:jend,:) + error = nf90_put_var( ncid, id_smc, dum3d, start=(/1,1,1,1/), count=(/i_target_out,j_target_out,lsoil_target,1/)) + call netcdf_err(error, 'WRITING TOTAL SOIL MOISTURE RECORD' ) + endif + +! soil moisture (liquid) + + print*,"- CALL FieldGather FOR TARGET GRID LIQUID SOIL MOISTURE FOR TILE: ", tile + call ESMF_FieldGather(soilm_liq_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum3d(:,:,:) = data_one_tile_3d(istart:iend, jstart:jend,:) + error = nf90_put_var( ncid, id_slc, dum3d, start=(/1,1,1,1/), count=(/i_target_out,j_target_out,lsoil_target,1/)) + call netcdf_err(error, 'WRITING LIQUID SOIL MOISTURE RECORD' ) + endif + + if (convert_nst) then + + print*,"- CALL FieldGather FOR TARGET C_D FOR TILE: ", tile + call ESMF_FieldGather(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_c_d, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING C_D RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET C_0 FOR TILE: ", tile + call ESMF_FieldGather(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_c_0, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING C_0 RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET D_CONV FOR TILE: ", tile + call ESMF_FieldGather(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_d_conv, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING D_CONV RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET DT_COOL FOR TILE: ", tile + call ESMF_FieldGather(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_dt_cool, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING DT_COOL RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET IFD FOR TILE: ", tile + call ESMF_FieldGather(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_ifd, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING IFD RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET QRAIN FOR TILE: ", tile + call ESMF_FieldGather(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_qrain, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING QRAIN RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET TREF FOR TILE: ", tile + call ESMF_FieldGather(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_tref, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING TREF RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET W_D FOR TILE: ", tile + call ESMF_FieldGather(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_w_d, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING W_D RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET W_0 FOR TILE: ", tile + call ESMF_FieldGather(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_w_0, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING W_0 RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XS FOR TILE: ", tile + call ESMF_FieldGather(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xs, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XT FOR TILE: ", tile + call ESMF_FieldGather(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xt, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XT RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XU FOR TILE: ", tile + call ESMF_FieldGather(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xu, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XU RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XV FOR TILE: ", tile + call ESMF_FieldGather(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xv, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XV RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XZ FOR TILE: ", tile + call ESMF_FieldGather(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xz, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XZ RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XTTS FOR TILE: ", tile + call ESMF_FieldGather(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xtts, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XTTS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET XZTS FOR TILE: ", tile + call ESMF_FieldGather(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_xzts, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING XZTS RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET Z_C FOR TILE: ", tile + call ESMF_FieldGather(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_z_c, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING Z_C RECORD' ) + endif + + print*,"- CALL FieldGather FOR TARGET ZM FOR TILE: ", tile + call ESMF_FieldGather(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=error) + if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__line__,file=__file__)) & + call error_handler("IN FieldGather", error) + + if (localpet == 0) then + dum2d(:,:) = data_one_tile(istart:iend, jstart:jend) + error = nf90_put_var( ncid, id_zm, dum2d, start=(/1,1,1/), count=(/i_target_out,j_target_out,1/)) + call netcdf_err(error, 'WRITING ZM RECORD' ) + endif + + endif ! convert nst + +!------------------------------------------------------------------------------- +! close file +!------------------------------------------------------------------------------- + + error = nf90_close(ncid) + + enddo TILE_LOOP + + deallocate(lsoil_data, x_data, y_data) + deallocate(data_one_tile, data_one_tile_3d, idata_one_tile, dum2d, dum3d) + + return + + end subroutine write_fv3_sfc_data_netcdf