diff --git a/README.md b/README.md index 1ecd483fe..47c3bc2fd 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,8 @@ [![Build Status](https://travis-ci.org/CICE-Consortium/CICE.svg?branch=master)](https://travis-ci.org/CICE-Consortium/CICE) [![Documentation Status](https://readthedocs.org/projects/cice-consortium-cice/badge/?version=master)](http://cice-consortium-cice.readthedocs.io/en/master/?badge=master) -[![codecov](https://codecov.io/gh/apcraig/Test_CICE_Icepack/branch/master/graph/badge.svg)](https://codecov.io/gh/apcraig/Test_CICE_Icepack) +[![lcov](https://img.shields.io/endpoint?url=https://apcraig.github.io/coverage.json)](https://apcraig.github.io) + + ## The CICE Consortium sea-ice model CICE is a computationally efficient model for simulating the growth, melting, and movement of polar sea ice. Designed as one component of coupled atmosphere-ocean-land-ice global climate models, today’s CICE model is the outcome of more than two decades of community collaboration in building a sea ice model suitable for multiple uses including process studies, operational forecasting, and climate simulation. diff --git a/cice.setup b/cice.setup index f7ff12bd6..86fc782bb 100755 --- a/cice.setup +++ b/cice.setup @@ -13,7 +13,7 @@ set dash = "-" set spval = "UnDeFiNeD" set machcomp = ${spval} set machine = ${spval} -set compilers = intel +set envnames = intel set case = ${spval} set test = ${spval} set grid = gx3 @@ -34,8 +34,8 @@ set stime = `date -u "+%H%M%S"` set docase = 0 set dotest = 0 set dosuite = 0 -set codecov = 0 # code coverage measurement and reporting -set codecovflag = false +set coverage = 0 # code coverage measurement and reporting +set coverageflag = false set suitebuild = true set suitereuse = true set suiterun = false @@ -84,7 +84,7 @@ SYNOPSIS --suite SUITE[,SUITE2] -m MACH --testid ID [-e ENV1,ENV2][--acct ACCT][--bdir DIR][--bgen DIR] - [--bcmp DIR][--tdir PATH][--report || --codecov] + [--bcmp DIR][--tdir PATH][--report || --coverage] [--setup-only || --setup-build || --setup-build-run || --setup-build-submit] DESCRIPTION @@ -93,7 +93,7 @@ DESCRIPTION --setvers : updates cice version number in sandbox --case, -c : case, case directory/name (not with --test or --suite) --mach, -m : machine, machine name (required) - --env, -e : compiler(s), comma separated (default = $compilers) + --env, -e : envname(s), comma separated (default = $envnames) --pes, -p : tasks x threads [x blocksize_x x blocksize_y [x maxblocks]] (default is ${pesx}) --acct : account number for the batch submission --grid, -g : grid, grid (default = ${grid}) @@ -111,8 +111,8 @@ DESCRIPTION --testid : test ID, user-defined id for testing (REQUIRED with --test or --suite) --diff : generate comparison against another case --report : automatically post results when tests are complete - --codecov : generate and report test coverage metrics when tests are complete, - requires GNU compiler (--env gnu) + --coverage : generate and report test coverage metrics when tests are complete, + requires GNU env (--env gnu*) --setup-only : for suite, setup testcases, no build, no submission --setup-build : for suite, setup and build testcases, no submission --setup-build-run : for suite, setup, build, and run interactively @@ -229,9 +229,9 @@ while (1) set report = 1 shift argv - else if ("$option" == "--codecov") then - set codecov = 1 - set codecovflag = true + else if ("$option" == "--coverage") then + set coverage = 1 + set coverageflag = true set suitereuse = false shift argv @@ -281,7 +281,7 @@ while (1) else if ("$option" =~ --mach* || "$option" == "-m") then set machine = $argv[1] else if ("$option" =~ --env* || "$option" == "-e") then - set compilers = $argv[1] + set envnames = $argv[1] else if ("$option" == "--test") then set test = $argv[1] set dotest = 1 @@ -336,18 +336,18 @@ if (${dosum} > 1) then exit -1 endif -if ($codecov == 1 && $report == 1) then - echo "${0}: ERROR in arguments, not recommmended to set both --codecov and --report" +if ($coverage == 1 && $report == 1) then + echo "${0}: ERROR in arguments, not recommmended to set both --coverage and --report" exit -1 endif -if ($codecov == 1 && "$compilers" != "gnu") then - echo "${0}: ERROR in arguments, must use --env gnu with --codecov" +if ($coverage == 1 && "$envnames" !~ "gnu*") then + echo "${0}: ERROR in arguments, must use --env gnu* with --coverage" exit -1 endif -if ($codecov == 1 && `where curl` == "" && `where wget` == "") then - echo "${0}: ERROR 'curl' or 'wget' is required for --codecov" +if ($coverage == 1 && `where curl` == "" && `where wget` == "") then + echo "${0}: ERROR 'curl' or 'wget' is required for --coverage" exit -1 endif @@ -356,26 +356,29 @@ if (${dosuite} == 0) then echo "${0}: ERROR in arguments, must use --suite with --report" exit -1 endif - if ($codecov == 1) then - echo "${0}: ERROR in arguments, must use --suite with --codecov" + if ($coverage == 1) then + echo "${0}: ERROR in arguments, must use --suite with --coverage" exit -1 endif - if ("$compilers" =~ "*,*") then - echo "${0}: ERROR in arguments, cannot set multiple compilers without --suite" + if ("$envnames" =~ "*,*") then + echo "${0}: ERROR in arguments, cannot set multiple envnames without --suite" exit -1 else - set compiler = ${compilers} - set machcomp = ${machine}_${compiler} + set envname = ${envnames} + set machcomp = ${machine}_${envname} + endif +else + if ($coverage == 1) then + if ("$envnames" =~ "*,*") then + echo "${0}: ERROR in arguments, cannot set multiple envnamess with --coverage" + exit -1 + else + set envname = ${envnames} + set machcomp = ${machine}_${envname} + endif endif endif -# tcraig, lets find another way to validate argument -#if (${test} != ${spval} && ${test} != 'smoke' && ${test} != '10day' && ${test} != 'annual' \ -# && ${test} != 'restart') then -# echo "${0}: ERROR in arguments. ${test} is not a valid test" -# exit -1 -#endif - if ((${dosuite} == 1 || ${dotest} == 1) && ${testid} == ${spval}) then echo "${0}: ERROR in arguments. --testid must be passed if using --suite or --test" exit -1 @@ -422,7 +425,9 @@ if ( ${dosuite} == 0 ) then else set tarrays = `echo ${testsuite} | sed 's/,/ /g' | fmt -1 | sort -u` + set testsuitecnt = 0 foreach tarray ( ${tarrays} ) + @ testsuitecnt = ${testsuitecnt} + 1 if (-e ${tarray}) then cat ${tarray} >> $tsfile else if (-e ${tarray}.ts) then @@ -504,6 +509,14 @@ EOF0 cat >! ${tsdir}/report_codecov.csh << EOF0 #!/bin/csh -f +source ${ICE_SCRIPTS}/machines/env.${machcomp} + +set rn0 = "${sdate}-${stime}:${shhash}:${testsuitecnt}:${testsuite}" +set rn1 = \`echo \${rn0} | sed -e 's/ //g'\` +set report_name = \`echo \${rn1} | sed -e 's/_suite//g'\` + +#for codecov +set use_curl = 1 # define CODECOV_TOKEN env variable if !(\$?CODECOV_TOKEN) then if (-e ~/.codecov_cice_token) then @@ -515,26 +528,28 @@ if !(\$?CODECOV_TOKEN) then endif endif -set report_name = "${shhash}:${branch}:${machine} ${testsuite}" -set use_curl = 1 +#for lcov +setenv PERL5LIB ~/usr/lib/perl5/site_perl/5.18.2/x86_64-linux-thread-multi/ +set lcovalist = "" EOF0 chmod +x ${tsdir}/suite.submit chmod +x ${tsdir}/results.csh chmod +x ${tsdir}/report_codecov.csh + cp -p -f ${tsdir}/report_codecov.csh ${tsdir}/report_lcov.csh endif #------------------------------------------------------------------- # Loop over cases/tests -set ncompilers = "`echo $compilers | sed -e 's/,/ /g'`" +set nenvnames = "`echo $envnames | sed -e 's/,/ /g'`" -# check that machines and compilers are valid before starting big loop +# check that machines and envnames are valid before starting big loop set doabort = false -foreach compiler ( $ncompilers ) - set machcomp = ${machine}_${compiler} +foreach envname ( $nenvnames ) + set machcomp = ${machine}_${envname} foreach file (env.${machcomp} Macros.${machcomp}) if !(-e ${ICE_SCRIPTS}/machines/$file) then echo "${0}: ERROR, ${ICE_SCRIPTS}/machines/$file not found" @@ -549,8 +564,8 @@ endif # Create a new sets_base variable to store sets passed to cice.setup set sets_base = "${sets}" set bfbcomp_base = "$bfbcomp" -foreach compiler ( $ncompilers ) - set machcomp = ${machine}_${compiler} +foreach envname ( $nenvnames ) + set machcomp = ${machine}_${envname} foreach line ( "`cat $tsfile`" ) # Check if line is a comment line @@ -572,6 +587,15 @@ EOF continue endif + # unset env variables that might not exist in env machine file + # to avoid any carry over during multi envname suites + unsetenv ICE_MACHINE_MAXTHREADS + unsetenv ICE_MACHINE_MAXPES + unsetenv ICE_MACHINE_QUIETMODE + unsetenv ICE_MACHINE_CPPDEFS + unsetenv ICE_MACHINE_QSTAT + unsetenv ICE_MACHINE_MACHINFO + unsetenv ICE_MACHINE_ENVINFO source ${ICE_SCRIPTS}/machines/env.${machcomp} -nomodules || exit 2 # Obtain the test name, sets, grid, and PE information from .ts file @@ -754,7 +778,7 @@ EOF echo "${0}: ERROR, ${ICE_SCRIPTS}/$file not found" exit -1 endif - cp -f -p ${ICE_SCRIPTS}/$file ${casedir} + cp -f -p ${ICE_SCRIPTS}/$file ${casedir}/ end # from machines dir to case @@ -763,16 +787,16 @@ EOF echo "${0}: ERROR, ${ICE_SCRIPTS}/machines/$file not found" exit -1 endif - cp -f -p ${ICE_SCRIPTS}/machines/$file ${casedir} + cp -f -p ${ICE_SCRIPTS}/machines/$file ${casedir}/ end # from basic script dir to casescr - foreach file (parse_namelist.sh parse_settings.sh parse_namelist_from_env.sh cice_decomp.csh cice.run.setup.csh cice.test.setup.csh) + foreach file (parse_namelist.sh parse_settings.sh parse_namelist_from_env.sh cice_decomp.csh cice.run.setup.csh cice.test.setup.csh cice.results.csh cice.codecov.csh cice.lcov.csh) if !(-e ${ICE_SCRIPTS}/$file) then echo "${0}: ERROR, ${ICE_SCRIPTS}/$file not found" exit -1 endif - cp -f -p ${ICE_SCRIPTS}/$file ${casescr} + cp -f -p ${ICE_SCRIPTS}/$file ${casescr}/ end cd ${casedir} @@ -782,6 +806,11 @@ EOF set quietmode = ${ICE_MACHINE_QUIETMODE} endif + set cppdefs = "" + if ($?ICE_MACHINE_CPPDEFS) then + set cppdefs = ${ICE_MACHINE_CPPDEFS} + endif + if (${acct} == ${spval}) then if (-e ~/.cice_proj) then set acct = `head -1 ~/.cice_proj` @@ -820,7 +849,7 @@ EOF echo "ICE_CASENAME = ${casename}" echo "ICE_CASEDIR = ${casedir}" echo "ICE_MACHINE = ${machine}" - echo "ICE_COMPILER = ${compiler}" + echo "ICE_ENVNAME = ${envname}" echo "ICE_RUNDIR = ${rundir}" echo "ICE_PES = ${task}x${thrd}" echo "ICE_GRID = ${grid} (${ICE_DECOMP_NXGLOB}x${ICE_DECOMP_NYGLOB}) blocksize=${ICE_DECOMP_BLCKX}x${ICE_DECOMP_BLCKY}x${ICE_DECOMP_MXBLCKS}" @@ -874,21 +903,17 @@ setenv ICE_SCRIPTS ${ICE_SCRIPTS} setenv ICE_CASENAME ${casename} setenv ICE_CASEDIR ${casedir} setenv ICE_MACHINE ${machine} -setenv ICE_COMPILER ${compiler} +setenv ICE_ENVNAME ${envname} setenv ICE_MACHCOMP ${machcomp} setenv ICE_RUNDIR ${rundir} setenv ICE_GRID ${grid} -#setenv ICE_NXGLOB ${ICE_DECOMP_NXGLOB} # moved to namelist -#setenv ICE_NYGLOB ${ICE_DECOMP_NYGLOB} # moved to namelist setenv ICE_NTASKS ${task} setenv ICE_NTHRDS ${thrd} -#setenv ICE_MXBLCKS ${ICE_DECOMP_MXBLCKS} # moved to namelist -#setenv ICE_BLCKX ${ICE_DECOMP_BLCKX} # moved to namelist -#setenv ICE_BLCKY ${ICE_DECOMP_BLCKY} # moved to namelist setenv ICE_BASELINE ${basedir_tmp} setenv ICE_BASEGEN ${baseGen} setenv ICE_BASECOM ${baseCom} setenv ICE_SPVAL ${spval} +setenv ICE_CPPDEFS ${cppdefs} setenv ICE_QUIETMODE ${quietmode} setenv ICE_TEST ${test} setenv ICE_TESTNAME ${testname_noid} @@ -896,7 +921,7 @@ setenv ICE_TESTID ${testid} setenv ICE_BFBCOMP ${fbfbcomp} setenv ICE_ACCOUNT ${acct} setenv ICE_QUEUE ${queue} -setenv ICE_CODECOV ${codecovflag} +setenv ICE_COVERAGE ${coverageflag} EOF1 if (${sets} != "") then @@ -1026,6 +1051,14 @@ EOF mkdir ${testname_base}/codecov_output cp ${rundir}/compile/*.{gcno,gcda} ${testname_base}/codecov_output/ +EOF + + cat >> ${tsdir}/report_lcov.csh << EOF +lcov --gcov-tool gcov -c -d ${rundir}/compile -o ${testname_base}/lcov.info +if (-s ${testname_base}/lcov.info) then + set lcovalist = "\${lcovalist} -a ${testname_base}/lcov.info" +endif + EOF cat >> ${tsdir}/suite.submit << EOF @@ -1036,7 +1069,7 @@ cd ${testname_base} source ./cice.settings if (\${dobuild} == true) then if (\${doreuse} == true) then - set ciceexe = "../ciceexe.\${ICE_COMPILER}.\${ICE_COMMDIR}.\${ICE_BLDDEBUG}.\${ICE_THREADED}.\${ICE_IOTYPE}" + set ciceexe = "../ciceexe.\${ICE_ENVNAME}.\${ICE_COMMDIR}.\${ICE_BLDDEBUG}.\${ICE_THREADED}.\${ICE_IOTYPE}" ./cice.build --exe \${ciceexe} if !(-e \${ciceexe}) cp -p \${ICE_RUNDIR}/cice \${ciceexe} else @@ -1061,7 +1094,7 @@ EOF # This is the foreach end for the testsuite end -# This is the foreach end for the compilers +# This is the foreach end for the envnames end #----------------------------------------------------- @@ -1076,60 +1109,7 @@ set nonomatch && rm -f ciceexe.* && unset nonomatch EOF0 - # Add code to results.csh to count the number of failures - cat >> ${tsdir}/results.csh << EOF -cat ./results.log -set pends = \`cat ./results.log | grep PEND | wc -l\` -set misses = \`cat ./results.log | grep MISS | wc -l\` -set failures = \`cat ./results.log | grep FAIL | wc -l\` -set failbuild = \`cat ./results.log | grep FAIL | grep " build " | wc -l\` -set failrun = \`cat ./results.log | grep FAIL | grep " run " | wc -l\` -set failtest = \`cat ./results.log | grep FAIL | grep " test " | wc -l\` -set failcomp = \`cat ./results.log | grep FAIL | grep " compare " | wc -l\` -set failbfbc = \`cat ./results.log | grep FAIL | grep " bfbcomp " | wc -l\` -set failgen = \`cat ./results.log | grep FAIL | grep " generate " | wc -l\` -set success = \`cat ./results.log | grep 'PASS\|COPY' | wc -l\` -set comments = \`cat ./results.log | grep "#" | wc -l\` -set alltotal = \`cat ./results.log | wc -l\` -@ total = \$alltotal - \$comments -@ chkcnt = \$pends + \$misses + \$failures + \$success - -echo "#------- " >> results.log -echo " " >> results.log -echo "#totl = \$total total" >> results.log -echo "#chkd = \$chkcnt checked" >> results.log -echo "#pass = \$success" >> results.log -echo "#pend = \$pends" >> results.log -echo "#miss = \$misses" >> results.log -echo "#fail = \$failures" >> results.log -echo " #failbuild = \$failbuild" >> results.log -echo " #failrun = \$failrun" >> results.log -echo " #failtest = \$failtest" >> results.log -echo " #failcomp = \$failcomp" >> results.log -echo " #failbfbc = \$failbfbc" >> results.log -echo " #failgen = \$failgen" >> results.log - -echo "" -echo "Descriptors:" -echo " PASS - successful completion" -echo " COPY - previously compiled code was copied for new test" -echo " MISS - comparison data is missing" -echo " PEND - status is undertermined; test may still be queued, running, or timed out" -echo " FAIL - test failed" -echo "" -echo "\$chkcnt measured results of \$total total results" -echo "\$success of \$chkcnt tests PASSED" -echo "\$pends of \$chkcnt tests PENDING" -echo "\$misses of \$chkcnt tests MISSING data" -echo "\$failures of \$chkcnt tests FAILED" -#echo " \$failbuild of \$failures FAILED build" -#echo " \$failrun of \$failures FAILED run" -#echo " \$failtest of \$failures FAILED test" -#echo " \$failcomp of \$failures FAILED compare" -#echo " \$failbfbc of \$failures FAILED bfbcomp" -#echo " \$failgen of \$failures FAILED generate" -exit \$failures -EOF + # Add code to post processing scripts if ($?ICE_MACHINE_QSTAT) then cat >! ${tsdir}/poll_queue.env << EOF0 @@ -1137,19 +1117,11 @@ setenv ICE_MACHINE_QSTAT ${ICE_MACHINE_QSTAT} EOF0 endif -cat >> ${tsdir}/report_codecov.csh << EOF -source ${ICE_SCRIPTS}/machines/env.${machcomp} + cat ${casescr}/cice.results.csh >> ${tsdir}/results.csh -if ( \${use_curl} == 1 ) then - bash -c "bash <(curl -s https://codecov.io/bash) -n '\${report_name}' -y ./codecov.yml " -else - bash -c "bash <(wget -O - https://codecov.io/bash) -n '\${report_name}' -y ./codecov.yml " -endif + cat ${casescr}/cice.codecov.csh >> ${tsdir}/report_codecov.csh -sleep 10 -rm -r -f ./*/codecov_output - -EOF + cat ${casescr}/cice.lcov.csh >> ${tsdir}/report_lcov.csh # build and submit tests cd ${tsdir} @@ -1164,10 +1136,11 @@ EOF ./results.csh ./report_results.csh endif - if ($codecov == 1) then - echo "Generating codecov reports" + if ($coverage == 1) then + echo "Generating coverage reports" ./poll_queue.csh - ./report_codecov.csh + ./report_lcov.csh + #./report_codecov.csh endif cd ${ICE_SANDBOX} diff --git a/cicecore/cicedynB/analysis/ice_history.F90 b/cicecore/cicedynB/analysis/ice_history.F90 index 21fea93fe..660676a64 100644 --- a/cicecore/cicedynB/analysis/ice_history.F90 +++ b/cicecore/cicedynB/analysis/ice_history.F90 @@ -30,10 +30,11 @@ module ice_history use ice_kinds_mod + use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c1, c2, c100, c360, c180, & p001, p25, p5, mps_to_cmpdy, kg_to_g, spval use ice_fileunits, only: nu_nml, nml_filename, nu_diag, & - get_fileunit, release_fileunit + get_fileunit, release_fileunit, flush_fileunit use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_snow_temperature, icepack_ice_temperature @@ -62,7 +63,6 @@ subroutine init_hist (dt) use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar, broadcast_array - use ice_communicate, only: my_task, master_task use ice_calendar, only: yday, days_per_year, histfreq, & histfreq_n, nstreams use ice_domain_size, only: max_blocks, max_nstrm, nilyr, nslyr, nblyr, ncat, nfsd @@ -1570,10 +1570,6 @@ subroutine init_hist (dt) if (allocated(Tsnz4d)) deallocate(Tsnz4d) allocate(Tsnz4d(nx_block,ny_block,nzslyr,ncat_hist)) endif - if (f_Sinz (1:1) /= 'x') then - if (allocated(Sinz4d)) deallocate(Sinz4d) - allocate(Sinz4d(nx_block,ny_block,nzilyr,ncat_hist)) - endif !----------------------------------------------------------------- ! 4D (floe size, thickness categories) variables looped separately @@ -1616,6 +1612,8 @@ subroutine init_hist (dt) ntmp(:) = 0 if (my_task == master_task) then write(nu_diag,*) ' ' + write(nu_diag,*) 'total number of history fields = ',num_avail_hist_fields_tot + write(nu_diag,*) 'max number of history fields = ',max_avail_hist_fields write(nu_diag,*) 'The following variables will be ', & 'written to the history tape: ' write(nu_diag,101) 'description','units','variable','frequency','x' @@ -1687,7 +1685,7 @@ subroutine init_hist (dt) if (allocated(a3Df)) a3Df(:,:,:,:,:) = c0 if (allocated(a4Di)) a4Di(:,:,:,:,:,:) = c0 if (allocated(a4Ds)) a4Ds(:,:,:,:,:,:) = c0 - if (allocated(a4Ds)) a4Df(:,:,:,:,:,:) = c0 + if (allocated(a4Df)) a4Df(:,:,:,:,:,:) = c0 avgct(:) = c0 albcnt(:,:,:,:) = c0 @@ -2970,7 +2968,7 @@ subroutine accum_hist (dt) enddo enddo enddo - call accum_hist_field(n_Tinz-n3Dacum, iblk, nzilyr, ncat_hist, & + call accum_hist_field(n_Tinz-n3Dfcum, iblk, nzilyr, ncat_hist, & Tinz4d(:,:,1:nzilyr,1:ncat_hist), a4Di) endif if (f_Sinz (1:1) /= 'x') then @@ -2984,7 +2982,7 @@ subroutine accum_hist (dt) enddo enddo enddo - call accum_hist_field(n_Sinz-n3Dacum, iblk, nzilyr, ncat_hist, & + call accum_hist_field(n_Sinz-n3Dfcum, iblk, nzilyr, ncat_hist, & Sinz4d(:,:,1:nzilyr,1:ncat_hist), a4Di) endif @@ -3796,7 +3794,7 @@ subroutine accum_hist (dt) enddo ! n do n = 1, num_avail_hist_fields_4Di - nn = n3Dacum + n + nn = n3Dfcum + n if (avail_hist_fields(nn)%vhistfreq == histfreq(ns)) then do k = 1, nzilyr do ic = 1, ncat_hist @@ -4025,7 +4023,7 @@ subroutine accum_hist (dt) if (avail_hist_fields(n)%vhistfreq == histfreq(ns)) a3Df(:,:,:,nn,:) = c0 enddo do n = n3Dfcum + 1, n4Dicum - nn = n - n3Dacum + nn = n - n3Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns)) a4Di(:,:,:,:,nn,:) = c0 enddo do n = n4Dicum + 1, n4Dscum diff --git a/cicecore/cicedynB/analysis/ice_history_fsd.F90 b/cicecore/cicedynB/analysis/ice_history_fsd.F90 index 7b5a1470d..43afc1e27 100644 --- a/cicecore/cicedynB/analysis/ice_history_fsd.F90 +++ b/cicecore/cicedynB/analysis/ice_history_fsd.F90 @@ -116,24 +116,6 @@ subroutine init_hist_fsd_2D call abort_ice(subname//'ERROR: reading icefields_fsd_nml') endif - if (.not. tr_fsd) then - f_afsd = 'x' - f_afsdn = 'x' - f_dafsd_newi = 'x' - f_dafsd_latg = 'x' - f_dafsd_latm = 'x' - f_dafsd_wave = 'x' - f_dafsd_weld = 'x' - f_wave_sig_ht = 'x' - f_fsdrad = 'x' - f_fsdperim = 'x' - endif - if ((.not. tr_fsd) .or. (.not. wave_spec)) then - f_aice_ww = 'x' - f_diam_ww = 'x' - f_hice_ww = 'x' - endif - call broadcast_scalar (f_afsd, master_task) call broadcast_scalar (f_afsdn, master_task) call broadcast_scalar (f_dafsd_newi, master_task) @@ -184,6 +166,24 @@ subroutine init_hist_fsd_2D enddo ! nstreams + else ! tr_fsd + + f_afsd = 'x' + f_afsdn = 'x' + f_dafsd_newi = 'x' + f_dafsd_latg = 'x' + f_dafsd_latm = 'x' + f_dafsd_wave = 'x' + f_dafsd_weld = 'x' + f_wave_sig_ht = 'x' + f_fsdrad = 'x' + f_fsdperim = 'x' + if (.not. wave_spec) then + f_aice_ww = 'x' + f_diam_ww = 'x' + f_hice_ww = 'x' + endif + endif ! tr_fsd end subroutine init_hist_fsd_2D @@ -428,11 +428,6 @@ subroutine accum_hist_fsd (iblk) call accum_hist_field(n_fsdperim, iblk, worka, a2D) endif - - - - - endif ! a2D allocated ! 3D category fields @@ -474,19 +469,20 @@ subroutine accum_hist_fsd (iblk) if (allocated(a4Df)) then if (f_afsdn(1:1) /= 'x') then + do n = 1, ncat_hist + do k = 1, nfsd_hist do j = 1, ny_block do i = 1, nx_block - do n = 1, ncat_hist - do k = 1, nfsd_hist - workd(i,j,k,n) = trcrn(i,j,nt_fsd+k-1,n,iblk) & - * aicen_init(i,j,n,iblk)/floe_binwidth(k) - end do - end do + workd(i,j,k,n) = trcrn(i,j,nt_fsd+k-1,n,iblk) & + * aicen_init(i,j,n,iblk)/floe_binwidth(k) + end do end do end do - call accum_hist_field(n_afsdn-n4Dscum, iblk, & - nfsd_hist, ncat_hist, workd, a4Df) + end do + call accum_hist_field(n_afsdn-n4Dscum, iblk, nfsd_hist, ncat_hist, & + workd(:,:,1:nfsd_hist,1:ncat_hist), a4Df) endif + endif ! a4Df allocated endif ! tr_fsd diff --git a/cicecore/cicedynB/analysis/ice_history_shared.F90 b/cicecore/cicedynB/analysis/ice_history_shared.F90 index 60740aea1..b5f2226fa 100644 --- a/cicecore/cicedynB/analysis/ice_history_shared.F90 +++ b/cicecore/cicedynB/analysis/ice_history_shared.F90 @@ -24,8 +24,10 @@ module ice_history_shared use ice_kinds_mod + use ice_communicate, only: my_task, master_task use ice_domain_size, only: max_nstrm use ice_exit, only: abort_ice + use ice_fileunits, only: nu_diag use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted implicit none @@ -33,6 +35,8 @@ module ice_history_shared private public :: define_hist_field, accum_hist_field, icefields_nml, construct_filename + integer (kind=int_kind), public :: history_precision + logical (kind=log_kind), public :: & hist_avg ! if true, write averaged data instead of snapshots @@ -50,6 +54,9 @@ module ice_history_shared character (len=char_len), public :: & version_name + character (len=char_len), public :: & + history_format + !--------------------------------------------------------------- ! Instructions for adding a field: (search for 'example') ! Here: @@ -77,7 +84,7 @@ module ice_history_shared end type integer (kind=int_kind), parameter, public :: & - max_avail_hist_fields = 600 ! Max number of history fields + max_avail_hist_fields = 800 ! Max number of history fields integer (kind=int_kind), public :: & num_avail_hist_fields_tot = 0, & ! Current, total number of defined fields @@ -109,8 +116,8 @@ module ice_history_shared nzblyr , & ! bio grid nzalyr ! aerosols (2 snow & nblyr+2 bio) - type (ice_hist_field), dimension(max_avail_hist_fields), public :: & - avail_hist_fields + type (ice_hist_field), public :: & + avail_hist_fields(max_avail_hist_fields) integer (kind=int_kind), parameter, public :: & nvar = 12 , & ! number of grid fields that can be written @@ -804,8 +811,13 @@ subroutine define_hist_field(id, vname, vunit, vcoord, vcellmeas, & num_avail_hist_fields_4Df = num_avail_hist_fields_4Df + 1 endif - if (num_avail_hist_fields_tot > max_avail_hist_fields) & - call abort_ice(subname//'ERROR: Need to increase max_avail_hist_fields') + if (num_avail_hist_fields_tot > max_avail_hist_fields) then + if (my_task == master_task) then + write(nu_diag,*) subname,' num_avail_hist_fields_tot = ',num_avail_hist_fields_tot + write(nu_diag,*) subname,' max_avail_hist_fields = ',max_avail_hist_fields + endif + call abort_ice(subname//'ERROR: Need in computation of max_avail_hist_fields') + endif if (num_avail_hist_fields_tot /= & num_avail_hist_fields_2D + & @@ -817,8 +829,11 @@ subroutine define_hist_field(id, vname, vunit, vcoord, vcellmeas, & num_avail_hist_fields_4Di + & num_avail_hist_fields_4Ds + & num_avail_hist_fields_4Df) then - call abort_ice(subname//'ERROR: num_avail_hist_fields error') - endif + if (my_task == master_task) then + write(nu_diag,*) subname,' num_avail_hist_fields_tot = ',num_avail_hist_fields_tot + endif + call abort_ice(subname//'ERROR: in num_avail_hist_fields') + endif id(ns) = num_avail_hist_fields_tot diff --git a/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 b/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 index 8239d00d5..3b31fa8cd 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 @@ -1293,9 +1293,6 @@ subroutine stress_eap (nx_block, ny_block, & strtmp(:,:,:) = c0 -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icellt i = indxti(ij) j = indxtj(ij) @@ -2144,7 +2141,6 @@ subroutine read_restart_eap() use ice_domain, only: nblocks, halo_info use ice_grid, only: grid_type use ice_restart, only: read_restart_field - use ice_restart_shared, only: restart_format ! local variables @@ -2183,7 +2179,7 @@ subroutine read_restart_eap() call read_restart_field(nu_restart_eap,0,a12_4,'ruf8', & 'a12_4',1,diag,field_loc_center,field_type_scalar) ! a12_4 - if (trim(grid_type) == 'tripole' .and. trim(restart_format) == 'pio') then + if (trim(grid_type) == 'tripole') then call ice_HaloUpdate_stress(a11_1, a11_3, halo_info, & field_loc_center, field_type_scalar) diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 index b9c797a9f..0f8acd547 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 @@ -143,6 +143,8 @@ subroutine evp (dt) type (block) :: & this_block ! block information for current block + + logical (kind=log_kind), save :: first_time = .true. character(len=*), parameter :: subname = '(evp)' @@ -349,7 +351,10 @@ subroutine evp (dt) endif call ice_timer_start(timer_evp_2d) if (kevp_kernel > 0) then -! if (my_task == 0) write(nu_diag,*) subname,' Entering kevp_kernel version ',kevp_kernel + if (first_time .and. my_task == 0) then + write(nu_diag,'(2a,i6)') subname,' Entering kevp_kernel version ',kevp_kernel + first_time = .false. + endif if (trim(grid_type) == 'tripole') then call abort_ice(trim(subname)//' & & Kernel not tested on tripole grid. Set kevp_kernel=0') @@ -663,9 +668,6 @@ subroutine stress (nx_block, ny_block, & str(:,:,:) = c0 -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icellt i = indxti(ij) j = indxtj(ij) diff --git a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 index 7eaba64cf..c500e1631 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 @@ -51,6 +51,9 @@ module ice_transport_driver logical (kind=log_kind), dimension (:), allocatable, public :: & has_dependents ! true if a tracer has dependent tracers + logical (kind=log_kind), public :: & + conserv_check ! if true, check conservation + integer (kind=int_kind), parameter :: & integral_order = 3 ! polynomial order of quadrature integrals ! linear=1, quadratic=2, cubic=3 @@ -147,68 +150,70 @@ subroutine init_transport ! diagnostic output if (my_task == master_task) then - write (nu_diag, *) 'tracer index depend type has_dependents' + write (nu_diag, *) 'tracer index depend type has_dependents' nt = 1 - write(nu_diag,*) ' hi ',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'hi ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) nt = 2 - write(nu_diag,*) ' hs ',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'hs ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) k=2 do nt = k+1, k+ntrcr if (nt-k==nt_Tsfc) & - write(nu_diag,*) 'nt_Tsfc',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_Tsfc ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_qice) & - write(nu_diag,*) 'nt_qice',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_qice ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_qsno) & - write(nu_diag,*) 'nt_qsno',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_qsno ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_sice) & - write(nu_diag,*) 'nt_sice',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_sice ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_fbri) & - write(nu_diag,*) 'nt_fbri',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_fbri ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_iage) & - write(nu_diag,*) 'nt_iage',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_iage ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_FY) & - write(nu_diag,*) 'nt_FY ', nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_FY ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_alvl) & - write(nu_diag,*) 'nt_alvl',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_alvl ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_vlvl) & - write(nu_diag,*) 'nt_vlvl',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_vlvl ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_apnd) & - write(nu_diag,*) 'nt_apnd',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_apnd ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_hpnd) & - write(nu_diag,*) 'nt_hpnd',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_hpnd ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_ipnd) & - write(nu_diag,*) 'nt_ipnd',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_ipnd ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_fsd) & - write(nu_diag,*) 'nt_fsd ',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_fsd ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_isosno) & - write(nu_diag,*) 'nt_isosno',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_isosno ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_isoice) & - write(nu_diag,*) 'nt_isoice',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_isoice ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_bgc_Nit) & - write(nu_diag,*) 'nt_bgc_Nit',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_bgc_Nit ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) if (nt-k==nt_bgc_S) & - write(nu_diag,*) 'nt_bgc_S',nt,depend(nt),tracer_type(nt),& + write(nu_diag,1000) 'nt_bgc_S ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) enddo + write(nu_diag,*) ' ' endif ! master_task + 1000 format (1x,a,2x,i6,2x,i6,2x,i4,4x,l4) if (trim(advection)=='remap') call init_remap ! grid quantities @@ -288,7 +293,6 @@ subroutine transport_remap (dt) ! variables related to optional bug checks logical (kind=log_kind), parameter :: & - l_conservation_check = .false. ,&! if true, check conservation l_monotonicity_check = .false. ! if true, check monotonicity real (kind=dbl_kind), dimension(0:ncat) :: & @@ -308,6 +312,8 @@ subroutine transport_remap (dt) real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & work1 + character(len=char_len_long) :: fieldid + character(len=*), parameter :: subname = '(transport_remap)' call ice_timer_start(timer_advect) ! advection @@ -396,7 +402,7 @@ subroutine transport_remap (dt) !---! Optional conservation and monotonicity checks. !---!------------------------------------------------------------------- - if (l_conservation_check) then + if (conserv_check) then !------------------------------------------------------------------- ! Compute initial values of globally conserved quantities. @@ -434,7 +440,7 @@ subroutine transport_remap (dt) enddo ! nt enddo ! n - endif ! l_conservation_check + endif ! conserv_check if (l_monotonicity_check) then @@ -563,7 +569,7 @@ subroutine transport_remap (dt) ! Check global conservation of area and area*tracers. (Optional) !------------------------------------------------------------------- - if (l_conservation_check) then + if (conserv_check) then do n = 0, ncat asum_final(n) = global_sum(aim(:,:,n,:), distrb_info, & @@ -598,25 +604,27 @@ subroutine transport_remap (dt) enddo ! n if (my_task == master_task) then - call global_conservation (l_stop, & + fieldid = subname//':000' + call global_conservation (l_stop, fieldid, & asum_init(0), asum_final(0)) if (l_stop) then - write (nu_diag,*) 'istep1, my_task, iblk =', & - istep1, my_task, iblk + write (nu_diag,*) 'istep1, my_task =', & + istep1, my_task write (nu_diag,*) 'transport: conservation error, cat 0' call abort_ice(subname//'ERROR: conservation error1') endif - do n = 1, ncat + do n = 1, ncat + write(fieldid,'(a,i3.3)') subname,n call global_conservation & - (l_stop, & + (l_stop, fieldid, & asum_init(n), asum_final(n), & atsum_init(:,n), atsum_final(:,n)) if (l_stop) then - write (nu_diag,*) 'istep1, my_task, iblk, cat =', & - istep1, my_task, iblk, n + write (nu_diag,*) 'istep1, my_task, cat =', & + istep1, my_task, n write (nu_diag,*) 'transport: conservation error, cat ',n call abort_ice(subname//'ERROR: conservation error2') endif @@ -624,7 +632,7 @@ subroutine transport_remap (dt) endif ! my_task = master_task - endif ! l_conservation_check + endif ! conserv_check !------------------------------------------------------------------- ! Check tracer monotonicity. (Optional) @@ -1075,10 +1083,13 @@ end subroutine tracers_to_state ! ! author William H. Lipscomb, LANL - subroutine global_conservation (l_stop, & + subroutine global_conservation (l_stop, fieldid, & asum_init, asum_final, & atsum_init, atsum_final) + character(len=*), intent(in) :: & + fieldid ! field information string + real (kind=dbl_kind), intent(in) :: & asum_init ,&! initial global ice area asum_final ! final global ice area @@ -1111,11 +1122,11 @@ subroutine global_conservation (l_stop, & if (abs(diff/asum_init) > puny) then l_stop = .true. write (nu_diag,*) - write (nu_diag,*) 'Ice area conserv error' - write (nu_diag,*) 'Initial global area =', asum_init - write (nu_diag,*) 'Final global area =', asum_final - write (nu_diag,*) 'Fractional error =', abs(diff)/asum_init - write (nu_diag,*) 'asum_final-asum_init =', diff + write (nu_diag,*) subname,'Ice area conserv error ', trim(fieldid) + write (nu_diag,*) subname,' Initial global area =', asum_init + write (nu_diag,*) subname,' Final global area =', asum_final + write (nu_diag,*) subname,' Fractional error =', abs(diff)/asum_init + write (nu_diag,*) subname,' asum_final-asum_init =', diff endif endif @@ -1126,15 +1137,12 @@ subroutine global_conservation (l_stop, & if (abs(diff/atsum_init(nt)) > puny) then l_stop = .true. write (nu_diag,*) - write (nu_diag,*) 'area*tracer conserv error' - write (nu_diag,*) 'tracer index =', nt - write (nu_diag,*) 'Initial global area*tracer =', & - atsum_init(nt) - write (nu_diag,*) 'Final global area*tracer =', & - atsum_final(nt) - write (nu_diag,*) 'Fractional error =', & - abs(diff)/atsum_init(nt) - write (nu_diag,*) 'atsum_final-atsum_init =', diff + write (nu_diag,*) subname,'Ice area*tracer conserv error ', trim(fieldid),nt + write (nu_diag,*) subname,' Tracer index =', nt + write (nu_diag,*) subname,' Initial global area*tracer =', atsum_init(nt) + write (nu_diag,*) subname,' Final global area*tracer =', atsum_final(nt) + write (nu_diag,*) subname,' Fractional error =', abs(diff)/atsum_init(nt) + write (nu_diag,*) subname,' atsum_final-atsum_init =', diff endif endif enddo diff --git a/cicecore/cicedynB/dynamics/ice_transport_remap.F90 b/cicecore/cicedynB/dynamics/ice_transport_remap.F90 index b641104ed..070f3b7ad 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_remap.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_remap.F90 @@ -30,6 +30,7 @@ module ice_transport_remap use ice_kinds_mod + use ice_blocks, only: nx_block, ny_block use ice_communicate, only: my_task use ice_constants, only: c0, c1, c2, c12, p333, p4, p5, p6, & eps13, eps16, & @@ -254,7 +255,6 @@ module ice_transport_remap subroutine init_remap use ice_domain, only: nblocks - use ice_blocks, only: nx_block, ny_block use ice_grid, only: xav, yav, xxav, yyav ! dxt, dyt, xyav, & ! xxxav, xxyav, xyyav, yyyav @@ -324,7 +324,7 @@ subroutine horizontal_remap (dt, ntrace, & use ice_boundary, only: ice_halo, ice_HaloMask, ice_HaloUpdate, & ice_HaloDestroy use ice_domain, only: nblocks, blocks_ice, halo_info, maskhalo_remap - use ice_blocks, only: block, get_block, nghost, nx_block, ny_block + use ice_blocks, only: block, get_block, nghost use ice_grid, only: HTE, HTN, dxu, dyu, & tarear, hm, & xav, yav, xxav, yyav @@ -384,8 +384,7 @@ subroutine horizontal_remap (dt, ntrace, & integer (kind=int_kind), dimension(0:ncat,max_blocks) :: & icellsnc ! number of cells with ice - integer (kind=int_kind), & - dimension(nx_block*ny_block,0:ncat) :: & + integer (kind=int_kind), dimension(nx_block*ny_block,0:ncat) :: & indxinc, indxjnc ! compressed i/j indices real (kind=dbl_kind), dimension(nx_block,ny_block) :: & @@ -403,13 +402,11 @@ subroutine horizontal_remap (dt, ntrace, & real (kind=dbl_kind), dimension(nx_block,ny_block,0:ncat) :: & mmask ! = 1. if mass is present, = 0. otherwise - real (kind=dbl_kind), & - dimension (nx_block,ny_block,ntrace,ncat,max_blocks) :: & + real (kind=dbl_kind), dimension (nx_block,ny_block,ntrace,ncat,max_blocks) :: & tc ,&! tracer values at geometric center of cell tx, ty ! limited derivative of tracer wrt x and y - real (kind=dbl_kind), & - dimension (nx_block,ny_block,ntrace,ncat) :: & + real (kind=dbl_kind), dimension (nx_block,ny_block,ntrace,ncat) :: & tmask ! = 1. if tracer is present, = 0. otherwise real (kind=dbl_kind), dimension (nx_block,ny_block,0:ncat) :: & @@ -424,19 +421,19 @@ subroutine horizontal_remap (dt, ntrace, & real (kind=dbl_kind), dimension (nx_block,ny_block,0:nvert,ngroups) :: & xp, yp ! x and y coordinates of special triangle points ! (need 4 points for triangle integrals) - - integer (kind=int_kind), & - dimension (nx_block,ny_block,ngroups) :: & + integer (kind=int_kind), dimension (nx_block,ny_block,ngroups) :: & iflux ,&! i index of cell contributing transport jflux ! j index of cell contributing transport integer (kind=int_kind), dimension(ngroups,max_blocks) :: & icellsng ! number of cells with ice - integer (kind=int_kind), & - dimension(nx_block*ny_block,ngroups) :: & + integer (kind=int_kind), dimension(nx_block*ny_block,ngroups) :: & indxing, indxjng ! compressed i/j indices + integer (kind=int_kind), dimension(nx_block,ny_block,max_blocks) :: & + halomask ! temporary mask for fast halo updates + logical (kind=log_kind) :: & l_stop ! if true, abort the model @@ -446,9 +443,6 @@ subroutine horizontal_remap (dt, ntrace, & character (len=char_len) :: & edge ! 'north' or 'east' - integer (kind=int_kind), & - dimension(nx_block,ny_block,max_blocks) :: halomask - type (ice_halo) :: halo_info_tracer type (block) :: & @@ -515,6 +509,7 @@ subroutine horizontal_remap (dt, ntrace, & mmask (:,:,0) ) ! ice categories + do n = 1, ncat call construct_fields(nx_block, ny_block, & @@ -1248,9 +1243,6 @@ subroutine construct_fields (nx_block, ny_block, & enddo enddo -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells ! Note: no tx or ty in ghost cells ! (bound calls are later) i = indxi(ij) @@ -3133,10 +3125,6 @@ subroutine triangle_coordinates (nx_block, ny_block, & elseif (integral_order == 2) then ! quadratic (3-point formula) -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu - do ng = 1, ngroups do ij = 1, icells(ng) i = indxi(ij,ng) @@ -3164,9 +3152,6 @@ subroutine triangle_coordinates (nx_block, ny_block, & else ! cubic (4-point formula) -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ng = 1, ngroups do ij = 1, icells(ng) i = indxi(ij,ng) @@ -3298,9 +3283,6 @@ subroutine transport_integrals (nx_block, ny_block, & if (integral_order == 1) then ! linear (1-point formula) -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells(ng) i = indxi(ij,ng) j = indxj(ij,ng) @@ -3326,9 +3308,6 @@ subroutine transport_integrals (nx_block, ny_block, & elseif (integral_order == 2) then ! quadratic (3-point formula) -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells(ng) i = indxi(ij,ng) j = indxj(ij,ng) @@ -3373,9 +3352,6 @@ subroutine transport_integrals (nx_block, ny_block, & else ! cubic (4-point formula) -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells(ng) i = indxi(ij,ng) j = indxj(ij,ng) @@ -3433,9 +3409,6 @@ subroutine transport_integrals (nx_block, ny_block, & do nt = 1, ntrace if (tracer_type(nt)==1) then ! does not depend on another tracer -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells(ng) i = indxi(ij,ng) j = indxj(ij,ng) @@ -3464,9 +3437,6 @@ subroutine transport_integrals (nx_block, ny_block, & elseif (tracer_type(nt)==2) then ! depends on another tracer nt1 = depend(nt) -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells(ng) i = indxi(ij,ng) j = indxj(ij,ng) @@ -3486,9 +3456,6 @@ subroutine transport_integrals (nx_block, ny_block, & elseif (tracer_type(nt)==3) then ! depends on two tracers nt1 = depend(nt) -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells(ng) i = indxi(ij,ng) j = indxj(ij,ng) @@ -3690,9 +3657,6 @@ subroutine update_fields (nx_block, ny_block, & elseif (tracer_type(nt)==2) then ! depends on another tracer nt1 = depend(nt) -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells i = indxi(ij) j = indxj(ij) @@ -3710,9 +3674,6 @@ subroutine update_fields (nx_block, ny_block, & nt1 = depend(nt) nt2 = depend(nt1) -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells i = indxi(ij) j = indxj(ij) diff --git a/cicecore/cicedynB/general/ice_flux.F90 b/cicecore/cicedynB/general/ice_flux.F90 index 607b763eb..6b16edb77 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -1071,9 +1071,6 @@ subroutine scale_fluxes (nx_block, ny_block, & if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do j = 1, ny_block do i = 1, nx_block if (tmask(i,j) .and. aice(i,j) > c0) then @@ -1139,9 +1136,6 @@ subroutine scale_fluxes (nx_block, ny_block, & ! Scale fluxes for history output if (present(fsurf) .and. present(fcondtop) ) then -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do j = 1, ny_block do i = 1, nx_block if (tmask(i,j) .and. aice(i,j) > c0) then diff --git a/cicecore/cicedynB/general/ice_forcing.F90 b/cicecore/cicedynB/general/ice_forcing.F90 index 52d4124b4..66a7d9ef3 100755 --- a/cicecore/cicedynB/general/ice_forcing.F90 +++ b/cicecore/cicedynB/general/ice_forcing.F90 @@ -122,6 +122,9 @@ module ice_forcing ! 'hadgem_sst' or 'hadgem_sst_uvocn' ice_data_type, & ! 'default', 'box2001', 'boxslotcyl' precip_units ! 'mm_per_month', 'mm_per_sec', 'mks','m_per_sec' + + logical (kind=log_kind), public :: & + rotate_wind ! rotate wind/stress to computational grid from true north directed character(char_len_long), public :: & atm_data_dir , & ! top directory for atmospheric data @@ -1628,11 +1631,10 @@ subroutine prepare_forcing (nx_block, ny_block, & if (calc_strair) then - do j = jlo, jhi - do i = ilo, ihi - - wind(i,j) = sqrt(uatm(i,j)**2 + vatm(i,j)**2) - + if (rotate_wind) then + do j = jlo, jhi + do i = ilo, ihi + wind(i,j) = sqrt(uatm(i,j)**2 + vatm(i,j)**2) !----------------------------------------------------------------- ! Rotate zonal/meridional vectors to local coordinates. ! Velocity comes in on T grid, but is oriented geographically --- @@ -1644,30 +1646,38 @@ subroutine prepare_forcing (nx_block, ny_block, & ! atmo_boundary_layer, and are interpolated to the U grid later as ! necessary. !----------------------------------------------------------------- - workx = uatm(i,j) ! wind velocity, m/s - worky = vatm(i,j) - uatm (i,j) = workx*cos(ANGLET(i,j)) & ! convert to POP grid - + worky*sin(ANGLET(i,j)) ! note uatm, vatm, wind - vatm (i,j) = worky*cos(ANGLET(i,j)) & ! are on the T-grid here - - workx*sin(ANGLET(i,j)) - - enddo ! i - enddo ! j - - else ! strax, stray, wind are read from files - - do j = jlo, jhi - do i = ilo, ihi - - workx = strax(i,j) ! wind stress - worky = stray(i,j) - strax(i,j) = workx*cos(ANGLET(i,j)) & ! convert to POP grid - + worky*sin(ANGLET(i,j)) ! note strax, stray, wind - stray(i,j) = worky*cos(ANGLET(i,j)) & ! are on the T-grid here - - workx*sin(ANGLET(i,j)) - - enddo ! i - enddo ! j + workx = uatm(i,j) ! wind velocity, m/s + worky = vatm(i,j) + uatm (i,j) = workx*cos(ANGLET(i,j)) & ! convert to POP grid + + worky*sin(ANGLET(i,j)) ! note uatm, vatm, wind + vatm (i,j) = worky*cos(ANGLET(i,j)) & ! are on the T-grid here + - workx*sin(ANGLET(i,j)) + enddo ! i + enddo ! j + else ! not rotated + do j = jlo, jhi + do i = ilo, ihi + wind(i,j) = sqrt(uatm(i,j)**2 + vatm(i,j)**2) + enddo ! i + enddo ! j + endif ! rotated + + else ! strax, stray, wind are read from files + + if (rotate_wind) then + do j = jlo, jhi + do i = ilo, ihi + workx = strax(i,j) ! wind stress + worky = stray(i,j) + strax(i,j) = workx*cos(ANGLET(i,j)) & ! convert to POP grid + + worky*sin(ANGLET(i,j)) ! note strax, stray, wind + stray(i,j) = worky*cos(ANGLET(i,j)) & ! are on the T-grid here + - workx*sin(ANGLET(i,j)) + enddo ! i + enddo ! j + else ! not rotated + ! wind (speed) is already read from file, so all is in place + endif ! rotated endif ! calc_strair @@ -2050,11 +2060,11 @@ subroutine JRA55_gx1_files(yr) uwind_file = & trim(atm_data_dir)//'/8XDAILY/JRA55_03hr_forcing_2005.nc' call file_year(uwind_file,yr) - if (my_task == master_task) then + if (my_task == master_task) then write (nu_diag,*) ' ' write (nu_diag,*) 'Atmospheric data files:' write (nu_diag,*) trim(uwind_file) - endif + endif end subroutine JRA55_gx1_files subroutine JRA55_tx1_files(yr) ! @@ -2066,11 +2076,11 @@ subroutine JRA55_tx1_files(yr) uwind_file = & trim(atm_data_dir)//'/8XDAILY/JRA55_03hr_forcing_tx1_2005.nc' call file_year(uwind_file,yr) - if (my_task == master_task) then + if (my_task == master_task) then write (nu_diag,*) ' ' write (nu_diag,*) 'Atmospheric data files:' write (nu_diag,*) trim(uwind_file) - endif + endif end subroutine JRA55_tx1_files subroutine JRA55_gx3_files(yr) ! @@ -2082,11 +2092,11 @@ subroutine JRA55_gx3_files(yr) uwind_file = & trim(atm_data_dir)//'/8XDAILY/JRA55_gx3_03hr_forcing_2005.nc' call file_year(uwind_file,yr) - if (my_task == master_task) then + if (my_task == master_task) then write (nu_diag,*) ' ' write (nu_diag,*) 'Atmospheric data files:' write (nu_diag,*) trim(uwind_file) - endif + endif end subroutine JRA55_gx3_files !======================================================================= ! @@ -4471,7 +4481,7 @@ subroutine hycom_atm_data write (nu_diag,*) & 'ERROR: CICE: Atm forcing not available at hcdate =',hcdate write (nu_diag,*) & - 'ERROR: CICE: nyr, year_init, yday = ',nyr, year_init, yday + 'ERROR: CICE: nyr, year_init, yday ,sec = ',nyr, year_init, yday, sec call abort_ice ('ERROR: CICE stopped') endif diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index 6ffe3d05c..9b55f41d2 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -59,7 +59,7 @@ subroutine input_data use ice_broadcast, only: broadcast_scalar, broadcast_array use ice_diagnostics, only: diag_file, print_global, print_points, latpnt, lonpnt - use ice_domain, only: close_boundaries + use ice_domain, only: close_boundaries, ns_boundary_type use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd, nfreq, & n_iso, n_aero, n_zaero, n_algae, & n_doc, n_dic, n_don, n_fed, n_fep, & @@ -76,13 +76,14 @@ subroutine input_data restart, restart_ext, restart_dir, restart_file, pointer_file, & runid, runtype, use_restart_time, restart_format, lcdf64 use ice_history_shared, only: hist_avg, history_dir, history_file, & - incond_dir, incond_file, version_name + incond_dir, incond_file, version_name, & + history_precision, history_format use ice_flux, only: update_ocn_f, l_mpond_fresh use ice_flux, only: default_season use ice_flux_bgc, only: cpl_bgc use ice_forcing, only: & ycycle, fyear_init, dbug, & - atm_data_type, atm_data_dir, precip_units, & + atm_data_type, atm_data_dir, precip_units, rotate_wind, & atm_data_format, ocn_data_format, & bgc_data_type, & ocn_data_type, ocn_data_dir, wave_spec_file, & @@ -98,7 +99,7 @@ subroutine input_data basalstress, k1, k2, alphab, threshold_hw, & Ktens, e_ratio, coriolis, & kridge, ktransport, brlx, arlx - use ice_transport_driver, only: advection + use ice_transport_driver, only: advection, conserv_check use ice_restoring, only: restore_ice #ifdef CESMCOUPLED use shr_file_mod, only: shr_file_setIO @@ -116,7 +117,7 @@ subroutine input_data ahmax, R_ice, R_pnd, R_snw, dT_mlt, rsnw_mlt, emissivity, & mu_rdg, hs0, dpscale, rfracmin, rfracmax, pndaspect, hs1, hp1, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, dSdt_slow_mode, & - phi_c_slow_mode, phi_i_mushy, kalg + phi_c_slow_mode, phi_i_mushy, kalg, atmiter_conv integer (kind=int_kind) :: ktherm, kstrength, krdg_partic, krdg_redist, natmiter, & kitd, kcatbound @@ -133,8 +134,9 @@ subroutine input_data integer (kind=int_kind) :: rpcesm, rplvl, rptopo real (kind=dbl_kind) :: Cf, ksno, puny - integer :: abort_flag + character (len=char_len) :: abort_list character (len=64) :: tmpstr + character (len=128) :: tmpstr2 character(len=*), parameter :: subname='(input_data)' @@ -149,10 +151,11 @@ subroutine input_data ice_ic, restart, restart_dir, restart_file, & restart_ext, use_restart_time, restart_format, lcdf64, & pointer_file, dumpfreq, dumpfreq_n, dump_last, & - diagfreq, diag_type, diag_file, & + diagfreq, diag_type, diag_file, history_format,& print_global, print_points, latpnt, lonpnt, & dbug, histfreq, histfreq_n, hist_avg, & - history_dir, history_file, cpl_bgc, & + history_dir, history_file, history_precision, cpl_bgc, & + conserv_check, & write_ic, incond_dir, incond_file, version_name namelist /grid_nml/ & @@ -202,7 +205,8 @@ subroutine input_data namelist /forcing_nml/ & formdrag, atmbndy, calc_strair, calc_Tsfc, & - highfreq, natmiter, ustar_min, emissivity, & + highfreq, natmiter, atmiter_conv, & + ustar_min, emissivity, & fbot_xfer_type, update_ocn_f, l_mpond_fresh, tfrz_option, & oceanmixed_ice, restore_ice, restore_ocn, trestore, & precip_units, default_season, wave_spec_type,nfreq, & @@ -210,14 +214,14 @@ subroutine input_data ice_data_type, wave_spec_file, & fyear_init, ycycle, & atm_data_dir, ocn_data_dir, bgc_data_dir, & - atm_data_format, ocn_data_format, & + atm_data_format, ocn_data_format, rotate_wind, & oceanmixed_file !----------------------------------------------------------------- ! default values !----------------------------------------------------------------- - abort_flag = 0 + abort_list = "" call icepack_query_parameters(puny_out=puny) ! nu_diag not yet defined @@ -249,10 +253,12 @@ subroutine input_data histfreq(5) = 'y' ! output frequency option for different streams histfreq_n(:) = 1 ! output frequency hist_avg = .true. ! if true, write time-averages (not snapshots) + history_format = 'default' ! history file format history_dir = './' ! write to executable dir for default history_file = 'iceh' ! history file name prefix + history_precision = 4 ! precision of history files write_ic = .false. ! write out initial condition - cpl_bgc = .false. ! history file name prefix + cpl_bgc = .false. ! couple bgc thru driver incond_dir = history_dir ! write to history dir for default incond_file = 'iceh_ic'! file prefix dumpfreq='y' ! restart frequency option @@ -262,9 +268,9 @@ subroutine input_data restart_dir = './' ! write to executable dir for default restart_file = 'iced' ! restart file name prefix restart_ext = .false. ! if true, read/write ghost cells - use_restart_time = .true. ! if true, use time info written in file + use_restart_time = .true. ! if true, use time info written in file pointer_file = 'ice.restart_file' - restart_format = 'nc' ! file format ('bin'=binary or 'nc'=netcdf or 'pio') + restart_format = 'default' ! restart file format lcdf64 = .false. ! 64 bit offset for netCDF ice_ic = 'default' ! latitude and sst-dependent grid_format = 'bin' ! file format ('bin'=binary or 'nc'=netcdf) @@ -297,6 +303,8 @@ subroutine input_data mu_rdg = 3 ! e-folding scale of ridged ice, krdg_partic=1 (m^0.5) Cf = 17.0_dbl_kind ! ratio of ridging work to PE change in ridging ksno = 0.3_dbl_kind ! snow thermal conductivity + dxrect = 0.0_dbl_kind ! user defined grid spacing in cm in x direction + dyrect = 0.0_dbl_kind ! user defined grid spacing in cm in y direction close_boundaries = .false. ! true = set land on edges of grid basalstress= .false. ! if true, basal stress for landfast is on k1 = 8.0_dbl_kind ! 1st free parameter for landfast parameterization @@ -306,6 +314,7 @@ subroutine input_data Ktens = 0.0_dbl_kind ! T=Ktens*P (tensile strength: see Konig and Holland, 2010) e_ratio = 2.0_dbl_kind ! EVP ellipse aspect ratio advection = 'remap' ! incremental remapping transport scheme + conserv_check = .false.! tracer conservation check shortwave = 'ccsm3' ! 'ccsm3' or 'dEdd' (delta-Eddington) albedo_type = 'ccsm3' ! 'ccsm3' or 'constant' ktherm = 1 ! -1 = OFF, 0 = 0-layer, 1 = BL99, 2 = mushy thermo @@ -348,10 +357,12 @@ subroutine input_data atm_data_format = 'bin' ! file format ('bin'=binary or 'nc'=netcdf) atm_data_type = 'default' atm_data_dir = ' ' + rotate_wind = .true. ! rotate wind/stress composants to computational grid orientation calc_strair = .true. ! calculate wind stress formdrag = .false. ! calculate form drag highfreq = .false. ! calculate high frequency RASM coupling natmiter = 5 ! number of iterations for atm boundary layer calcs + atmiter_conv = c0 ! ustar convergence criteria precip_units = 'mks' ! 'mm_per_month' or ! 'mm_per_sec' = 'mks' = kg/m^2 s tfrz_option = 'mushy' ! freezing temp formulation @@ -536,6 +547,8 @@ subroutine input_data call broadcast_scalar(hist_avg, master_task) call broadcast_scalar(history_dir, master_task) call broadcast_scalar(history_file, master_task) + call broadcast_scalar(history_precision, master_task) + call broadcast_scalar(history_format, master_task) call broadcast_scalar(write_ic, master_task) call broadcast_scalar(cpl_bgc, master_task) call broadcast_scalar(incond_dir, master_task) @@ -586,6 +599,7 @@ subroutine input_data call broadcast_scalar(Ktens, master_task) call broadcast_scalar(e_ratio, master_task) call broadcast_scalar(advection, master_task) + call broadcast_scalar(conserv_check, master_task) call broadcast_scalar(shortwave, master_task) call broadcast_scalar(albedo_type, master_task) call broadcast_scalar(ktherm, master_task) @@ -618,11 +632,13 @@ subroutine input_data call broadcast_scalar(atm_data_format, master_task) call broadcast_scalar(atm_data_type, master_task) call broadcast_scalar(atm_data_dir, master_task) + call broadcast_scalar(rotate_wind, master_task) call broadcast_scalar(calc_strair, master_task) call broadcast_scalar(calc_Tsfc, master_task) call broadcast_scalar(formdrag, master_task) call broadcast_scalar(highfreq, master_task) call broadcast_scalar(natmiter, master_task) + call broadcast_scalar(atmiter_conv, master_task) call broadcast_scalar(update_ocn_f, master_task) call broadcast_scalar(l_mpond_fresh, master_task) call broadcast_scalar(ustar_min, master_task) @@ -751,7 +767,7 @@ subroutine input_data write(nu_diag,*) subname//' ERROR: runtype=',trim(runtype), ' restart=',restart, ' ice_ic=',trim(ice_ic) write(nu_diag,*) subname//' ERROR: Please review user guide' endif - abort_flag = 1 + abort_list = trim(abort_list)//":1" endif #ifndef ncdf @@ -760,13 +776,13 @@ subroutine input_data write(nu_diag,*) subname//' ERROR: ncdf CPP flag unset, data formats must be bin' write(nu_diag,*) subname//' ERROR: check grid_format, atm_data_format, ocn_data_format or set ncdf CPP' endif - abort_flag = 2 + abort_list = trim(abort_list)//":2" endif #endif if (advection /= 'remap' .and. advection /= 'upwind' .and. advection /= 'none') then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: invalid advection=',trim(advection) - abort_flag = 3 + abort_list = trim(abort_list)//":3" endif if (ncat == 1 .and. kitd == 1) then @@ -776,7 +792,7 @@ subroutine input_data write(nu_diag,*) subname//' ERROR: Use kitd = 0 (delta function ITD) with kcatbound = 0' write(nu_diag,*) subname//' ERROR: or for column configurations use kcatbound = -1' endif - abort_flag = 4 + abort_list = trim(abort_list)//":4" endif if (ncat /= 1 .and. kcatbound == -1) then @@ -785,7 +801,7 @@ subroutine input_data write(nu_diag,*) subname//' ERROR: ncat=',ncat,' kcatbound=',kcatbound write(nu_diag,*) subname//' ERROR: Please review user guide' endif - abort_flag = 5 + abort_list = trim(abort_list)//":5" endif if (kdyn == 2 .and. revised_evp) then @@ -796,6 +812,13 @@ subroutine input_data revised_evp = .false. endif + if (kdyn > 2) then + if (my_task == master_task) then + write(nu_diag,*) subname//' WARNING: kdyn out of range' + endif + abort_list = trim(abort_list)//":33" + endif + rpcesm = 0 rplvl = 0 rptopo = 0 @@ -810,14 +833,14 @@ subroutine input_data if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: Must use only one melt pond scheme' endif - abort_flag = 6 + abort_list = trim(abort_list)//":6" endif if (tr_pond_lvl .and. .not. tr_lvl) then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: tr_pond_lvl=T but tr_lvl=F' endif - abort_flag = 30 + abort_list = trim(abort_list)//":30" endif ! tcraig - this was originally implemented by resetting hs0=0. EH says it might be OK @@ -828,7 +851,7 @@ subroutine input_data if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: tr_pond_lvl=T and hs0 /= 0' endif - abort_flag = 7 + abort_list = trim(abort_list)//":7" endif if (trim(shortwave) /= 'dEdd' .and. tr_pond .and. calc_tsfc) then @@ -836,25 +859,62 @@ subroutine input_data write(nu_diag,*) subname//' ERROR: tr_pond=T, calc_tsfc=T, invalid shortwave' write(nu_diag,*) subname//' ERROR: Must use shortwave=dEdd' endif - abort_flag = 8 + abort_list = trim(abort_list)//":8" endif if (tr_iso .and. n_iso==0) then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: isotopes activated but' write(nu_diag,*) subname//' ERROR: not allocated in tracer array.' - write(nu_diag,*) subname//' ERROR: Activate in compilation script.' + write(nu_diag,*) subname//' ERROR: if tr_iso, n_iso must be > 0.' endif - abort_flag = 31 + abort_list = trim(abort_list)//":31" endif if (tr_aero .and. n_aero==0) then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: aerosols activated but' write(nu_diag,*) subname//' ERROR: not allocated in tracer array.' - write(nu_diag,*) subname//' ERROR: Activate in compilation script.' + write(nu_diag,*) subname//' ERROR: if tr_aero, n_aero must be > 0.' + endif + abort_list = trim(abort_list)//":9" + endif + + if (ncat < 1) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: ncat < 1' + endif + abort_list = trim(abort_list)//":32" + endif + + if (nilyr < 1) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: nilyr < 1' endif - abort_flag = 9 + abort_list = trim(abort_list)//":33" + endif + + if (nslyr < 1) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: nslyr < 1' + endif + abort_list = trim(abort_list)//":34" + endif + + if (nblyr < 1) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: nblyr < 1' + write(nu_diag,*) subname//' ERROR: not allowed due to history implementation.' + endif + abort_list = trim(abort_list)//":35" + endif + + if (nfsd < 1) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: nfsd < 1' + write(nu_diag,*) subname//' ERROR: not allowed due to history implementation.' + endif + abort_list = trim(abort_list)//":36" endif if (trim(shortwave) /= 'dEdd' .and. tr_aero) then @@ -862,7 +922,7 @@ subroutine input_data write(nu_diag,*) subname//' ERROR: tr_aero=T, invalid shortwave' write(nu_diag,*) subname//' ERROR: Must use shortwave=dEdd' endif - abort_flag = 10 + abort_list = trim(abort_list)//":10" endif if ((rfracmin < -puny .or. rfracmin > c1+puny) .or. & @@ -872,19 +932,19 @@ subroutine input_data write(nu_diag,*) subname//' ERROR: rfracmin, rfracmax must be between 0 and 1' write(nu_diag,*) subname//' ERROR: and rfracmax >= rfracmin' endif - abort_flag = 11 + abort_list = trim(abort_list)//":11" endif rfracmin = min(max(rfracmin,c0),c1) rfracmax = min(max(rfracmax,c0),c1) if (trim(atm_data_type) == 'monthly' .and. calc_strair) then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: atm_data_type=monthly and calc_strair=T' - abort_flag = 12 + abort_list = trim(abort_list)//":12" endif if (ktherm == 2 .and. .not. calc_Tsfc) then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: ktherm = 2 and calc_Tsfc=F' - abort_flag = 13 + abort_list = trim(abort_list)//":13" endif ! tcraig, is it really OK for users to run inconsistently? @@ -906,35 +966,40 @@ subroutine input_data if (formdrag) then if (trim(atmbndy) == 'constant') then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: formdrag=T and atmbndy=constant' - abort_flag = 14 + abort_list = trim(abort_list)//":14" endif if (.not. calc_strair) then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: formdrag=T and calc_strair=F' - abort_flag = 15 + abort_list = trim(abort_list)//":15" endif if (.not. tr_pond) then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: formdrag=T and tr_pond=F' - abort_flag = 16 + abort_list = trim(abort_list)//":16" endif if (tr_pond_cesm) then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: formdrag=T and frzpnd=cesm' - abort_flag = 17 + abort_list = trim(abort_list)//":17" endif if (.not. tr_lvl) then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: formdrag=T and tr_lvl=F' - abort_flag = 18 + abort_list = trim(abort_list)//":18" endif endif if (trim(fbot_xfer_type) == 'Cdn_ocn' .and. .not. formdrag) then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: formdrag=F and fbot_xfer_type=Cdn_ocn' - abort_flag = 19 + abort_list = trim(abort_list)//":19" endif + if(history_precision .ne. 4 .and. history_precision .ne. 8) then + write (nu_diag,*) subname//' ERROR: bad value for history_precision, allowed values: 4, 8' + abort_list = trim(abort_list)//":22" + endif + if (.not.(trim(dumpfreq) == 'y' .or. trim(dumpfreq) == 'Y' .or. & trim(dumpfreq) == 'm' .or. trim(dumpfreq) == 'M' .or. & trim(dumpfreq) == 'd' .or. trim(dumpfreq) == 'D' .or. & @@ -965,7 +1030,390 @@ subroutine input_data if (my_task == master_task) then - write(nu_diag,*) ' Document ice_in namelist parameters:' + write(nu_diag,*) ' Overview of model configuration with relevant parameters' + write(nu_diag,*) ' ========================================================' + write(nu_diag,*) ' For details, compare namelist output below with the' + write(nu_diag,*) ' Case Settings section in the model documentation.' + write(nu_diag,*) ' ' + write(nu_diag,*) ' Calendar' + write(nu_diag,*) '--------------------------------' + write(nu_diag,1022) ' days_per_year = ',days_per_year,' number of days in a model year' + if (use_leap_years) then + tmpstr2 = ' leap days are included' + else + tmpstr2 = ' leap days are not included' + endif + write(nu_diag,1012) ' use_leap_years = ',use_leap_years,trim(tmpstr2) + write(nu_diag,1002) ' dt = ', dt, ' model time step' + + write(nu_diag,*) ' ' + write(nu_diag,*) ' Grid, Discretization' + write(nu_diag,*) '--------------------------------' + if (trim(grid_type) == 'rectangular') & + write(nu_diag,*) 'grid_type = ', & + trim(grid_type),': internally defined, rectangular grid' + if (trim(grid_type) == 'regional') & + write(nu_diag,*) 'grid_type = ', & + trim(grid_type),': user-defined, regional grid' + if (trim(grid_type) == 'displaced_pole') & + write(nu_diag,*) 'grid_type = ', & + trim(grid_type),': user-defined grid with rotated north pole' + if (trim(grid_type) == 'tripole') then + write(nu_diag,*) 'grid_type = ', & + trim(grid_type),': user-defined grid with northern hemisphere zipper' + if (trim(ns_boundary_type) == 'tripole') then + tmpstr2 = ' on U points (nodes)' + elseif (trim(ns_boundary_type) == 'tripoleT') then + tmpstr2 = ' on T points (cell centers)' + endif + write(nu_diag,*) 'ns_boundary_type = ', trim(ns_boundary_type),trim(tmpstr2) + endif + if (trim(grid_type) /= 'rectangular') then + if (use_bathymetry) then + tmpstr2 = ' bathymetric input data is used' + else + tmpstr2 = ' bathymetric input data is not used' + endif + write(nu_diag,1012) ' use_bathymetry = ', use_bathymetry,trim(tmpstr2) + endif + write(nu_diag,1022) ' nilyr = ', nilyr, ' number of ice layers (equal thickness)' + write(nu_diag,1022) ' nslyr = ', nslyr, ' number of snow layers (equal thickness)' + write(nu_diag,1022) ' nblyr = ', nblyr, ' number of bio layers (equal thickness)' + if (trim(shortwave) == 'dEdd') & + write(nu_diag,*) 'dEdd interior and sfc scattering layers are used in both ice, snow (unequal)' + write(nu_diag,1022) ' ncat = ', ncat, ' number of ice categories' + if (kcatbound == 0) then + tmpstr2 = ' original ITD category bounds' + elseif (kcatbound == 1) then + tmpstr2 = ' round-number category bounds' + elseif (kcatbound == 2) then + tmpstr2 = ' WMO standard ITD categories' + elseif (kcatbound == -1) then + tmpstr2 = ' one thickness category' + endif + write(nu_diag,1022) ' kcatbound = ', kcatbound,trim(tmpstr2) + if (kitd==0) then + tmpstr2 = ' delta function ITD approx' + else + tmpstr2 = ' linear remapping ITD approx' + endif + write(nu_diag,1022) ' kitd = ', kitd,trim(tmpstr2) + + if (tr_fsd) then + tmpstr2 = ' floe size distribution is enabled' + ! write(nu_diag,1002) ' floediam = ', floediam, ' constant floe diameter' + else + tmpstr2 = ' floe size distribution is disabled' + endif + write(nu_diag,1012) ' tr_fsd = ', tr_fsd,trim(tmpstr2) + write(nu_diag,1022) ' nfsd = ', nfsd, ' number of floe size categories' + + write(nu_diag,*) ' ' + write(nu_diag,*) ' Horizontal Dynamics' + write(nu_diag,*) '--------------------------------' + if (kdyn == 1) then + tmpstr2 = ' elastic-viscous-plastic dynamics' + write(nu_diag,*) 'yield_curve = ', trim(yield_curve) + if (trim(yield_curve) == 'ellipse') & + write(nu_diag,1007) ' e_ratio = ', e_ratio, ' aspect ratio of ellipse' + elseif (kdyn == 2) then + tmpstr2 = ' elastic-anisotropic-plastic dynamics' + elseif (kdyn < 1) then + tmpstr2 = ' dynamics disabled' + endif + write(nu_diag,1022) ' kdyn = ', kdyn,trim(tmpstr2) + if (kdyn >= 1) then + if (revised_evp) then + tmpstr2 = ' revised EVP formulation used' + else + tmpstr2 = ' revised EVP formulation not used' + endif + write(nu_diag,1012) ' revised_evp = ', revised_evp,trim(tmpstr2) + write(nu_diag,1022) ' kevp_kernel = ', kevp_kernel,' EVP solver' + + write(nu_diag,1022) ' ndtd = ', ndtd, ' number of dynamics/advection/ridging/steps per thermo timestep' + write(nu_diag,1022) ' ndte = ', ndte, ' number of EVP or EAP subcycles' + write(nu_diag,1007) ' arlx = ', arlx, ' stress equation factor alpha' + write(nu_diag,1007) ' brlx = ', brlx, ' stress equation factor beta' + + if (trim(coriolis) == 'latitude') then + tmpstr2 = ': latitude-dependent Coriolis parameter' + elseif (trim(coriolis) == 'contant') then + tmpstr2 = ' = 1.46e-4/s' + elseif (trim(coriolis) == 'zero') then + tmpstr2 = ' = 0.0' + endif + write(nu_diag,*) 'coriolis = ',trim(coriolis),trim(tmpstr2) + + if (ktransport == 1) then + tmpstr2 = ' transport enabled' + if (trim(advection) == 'remap') then + tmpstr2 = ': linear remapping advection' + elseif (trim(advection) == 'upwind') then + tmpstr2 = ': donor cell (upwind) advection' + endif + write(nu_diag,*) 'advection = ', trim(advection),trim(tmpstr2) + else + tmpstr2 = ' transport disabled' + endif + write(nu_diag,1022) ' ktransport = ', ktransport,trim(tmpstr2) + + if (basalstress) then + tmpstr2 = ' use basal stress parameterization for landfast ice' + else + tmpstr2 = ' basal stress not used for landfast ice' + endif + write(nu_diag,1012) ' basalstress = ', basalstress,trim(tmpstr2) + if (basalstress) then + write(nu_diag,1007) ' k1 = ', k1, ' free parameter for landfast ice' + write(nu_diag,1007) ' k2 = ', k2, ' free parameter for landfast ice' + write(nu_diag,1007) ' alphab = ', alphab, ' factor for landfast ice' + write(nu_diag,1007) ' threshold_hw = ', threshold_hw, ' max water depth for grounding ice' + write(nu_diag,1007) ' Ktens = ', Ktens, ' tensile strength factor' + endif + endif ! kdyn enabled + + write(nu_diag,*) ' ' + write(nu_diag,*) ' Mechanical Deformation (Ridging) and Ice Strength' + write(nu_diag,*) '--------------------------------------------------' + if (kridge == 1) then + tmpstr2 = ' ridging enabled' + else + tmpstr2 = ' ridging disabled' + endif + write(nu_diag,1012) ' tr_lvl = ', tr_lvl,' ridging related tracers' + write(nu_diag,1022) ' kridge = ', kridge,trim(tmpstr2) + if (kridge == 1) then + if (krdg_partic == 1) then + tmpstr2 = ' new participation function' + else + tmpstr2 = ' old participation function' + endif + write(nu_diag,1022) ' krdg_partic = ', krdg_partic,trim(tmpstr2) + if (krdg_partic == 1) & + write(nu_diag,1007) ' mu_rdg = ', mu_rdg,' e-folding scale of ridged ice' + if (krdg_redist == 1) then + tmpstr2 = ' new redistribution function' + else + tmpstr2 = ' old redistribution function' + endif + write(nu_diag,1022) ' krdg_redist = ', krdg_redist,trim(tmpstr2) + endif + + if (kstrength == 0) then + tmpstr2 = ' Hibler (1979)' + elseif (kstrength == 1) then + tmpstr2 = ' Rothrock (1975)' + endif + write(nu_diag,1022) ' kstrength = ', kstrength,trim(tmpstr2) + if (kstrength == 0) then + ! write(nu_diag,1007) ' Pstar = ', Pstar, ' P* strength factor' + ! write(nu_diag,1007) ' Cstar = ', Cstar, ' C* strength exponent factor' + elseif (kstrength == 1) then + write(nu_diag,1007) ' Cf = ', Cf, ' ratio of ridging work to PE change' + endif + + write(nu_diag,*) ' ' + write(nu_diag,*) ' Thermodynamics' + write(nu_diag,*) '--------------------------------' + + if (ktherm == 1) then + tmpstr2 = ' Bitz and Lipscomb 1999 thermo' + elseif (ktherm == 2) then + tmpstr2 = ' mushy-layer thermo' + elseif (ktherm == 0) then + tmpstr2 = ' zero-layer thermo' + elseif (ktherm < 0) then + tmpstr2 = ' thermodynamics disabled' + endif + if (ktherm >= 0) then + write(nu_diag,1022) ' ktherm = ', ktherm,trim(tmpstr2) + write(nu_diag,1002) ' dt = ', dt, ' thermodynamic time step' + write(nu_diag,1007) ' ksno = ', ksno,' snow thermal conductivity' + if (ktherm == 1) & + write(nu_diag,*) 'conduct = ', trim(conduct),' ice thermal conductivity' + if (ktherm == 2) then + write(nu_diag,1002) ' a_rapid_mode = ', a_rapid_mode,' brine channel diameter' + write(nu_diag,1007) ' Rac_rapid_mode = ', Rac_rapid_mode,' critical Rayleigh number' + write(nu_diag,1007) ' aspect_rapid_mode= ', aspect_rapid_mode,' brine convection aspect ratio' + write(nu_diag,*) 'dSdt_slow_mode = ', dSdt_slow_mode,' drainage strength parameter' + write(nu_diag,1007) ' phi_c_slow_mode = ', phi_c_slow_mode,' critical liquid fraction' + write(nu_diag,1007) ' phi_i_mushy = ', phi_i_mushy,' solid fraction at lower boundary' + endif + endif + !write(nu_diag,1007) ' hfrazilmin = ', hfrazilmin,' minimum new frazil ice thickness' + + write(nu_diag,*) ' ' + write(nu_diag,*) ' Radiation' + write(nu_diag,*) '--------------------------------' + if (trim(shortwave) == 'dEdd') then + tmpstr2 = ': delta-Eddington multiple-scattering method' + elseif (trim(shortwave) == 'ccsm3') then + tmpstr2 = ': NCAR CCSM3 distribution method' + endif + write(nu_diag,*) ' shortwave = ', trim(shortwave),trim(tmpstr2) + if (trim(shortwave) == 'dEdd') then + write(nu_diag,1007) ' R_ice = ', R_ice,' tuning parameter for sea ice albedo' + write(nu_diag,1007) ' R_pnd = ', R_pnd,' tuning parameter for ponded sea ice albedo' + write(nu_diag,1007) ' R_snw = ', R_snw,' tuning parameter for snow broadband albedo' + write(nu_diag,1007) ' dT_mlt = ', dT_mlt,' change in temperature per change in snow grain radius' + write(nu_diag,1002) ' rsnw_mlt = ', rsnw_mlt,' maximum melting snow grain radius' + write(nu_diag,1007) ' kalg = ', kalg,' absorption coefficient for algae' + else + if (trim(albedo_type) == 'ccsm3') then + tmpstr2 = ': NCAR CCSM3 albedos' + elseif (trim(albedo_type) == 'constant') then + tmpstr2 = ': four constant albedos' + endif + write(nu_diag,*) 'albedo_type = ', trim(albedo_type),trim(tmpstr2) + if (trim(albedo_type) == 'ccsm3') then + write(nu_diag,1007) ' albicev = ', albicev,' visible ice albedo for thicker ice' + write(nu_diag,1007) ' albicei = ', albicei,' near infrared ice albedo for thicker ice' + write(nu_diag,1007) ' albsnowv = ', albsnowv,' visible, cold snow albedo' + write(nu_diag,1007) ' albsnowi = ', albsnowi,' near infrared, cold snow albedo' + write(nu_diag,1007) ' ahmax = ', ahmax,' albedo is constant above this thickness' + endif + endif + write(nu_diag,1007) ' emissivity = ', emissivity,' emissivity of snow and ice' + + write(nu_diag,*) ' ' + write(nu_diag,*) ' Atmospheric Forcing / Coupling' + write(nu_diag,*) '--------------------------------' + write(nu_diag,1012) ' calc_Tsfc = ', calc_Tsfc,' calculate surface temperature as part of thermo' + write(nu_diag,1012) ' calc_strair = ', calc_strair,' calculate wind stress and speed' + write(nu_diag,1012) ' rotate_wind = ', rotate_wind,' rotate wind/stress to computational grid' + write(nu_diag,1012) ' formdrag = ', formdrag,' use form drag parameterization' + if (trim(atmbndy) == 'constant') then + tmpstr2 = ': stability-based boundary layer' + write(nu_diag,1012) ' highfreq = ', highfreq,' high-frequency atmospheric coupling' + write(nu_diag,1022) ' natmiter = ', natmiter,' number of atmo boundary layer iterations' + write(nu_diag,1006) ' atmiter_conv = ', atmiter_conv,' convergence criterion for ustar' + elseif (trim(atmbndy) == 'default') then + tmpstr2 = ': boundary layer uses bulk transfer coefficients' + endif + write(nu_diag,*) 'atmbndy = ', trim(atmbndy),trim(tmpstr2) + + write(nu_diag,*) ' ' + write(nu_diag,*) ' Oceanic Forcing / Coupling' + write(nu_diag,*) '--------------------------------' + if (oceanmixed_ice) then + tmpstr2 = ' ocean mixed layer calculation (SST) enabled' + else + tmpstr2 = ' ocean mixed layer calculation (SST) disabled' + endif + write(nu_diag,1012) ' oceanmixed_ice = ', oceanmixed_ice,trim(tmpstr2) + if (trim(tfrz_option) == 'minus1p8') then + tmpstr2 = ': constant ocean freezing temperature (-1.8C)' + elseif (trim(tfrz_option) == 'linear_salt') then + tmpstr2 = ': linear function of salinity (use with ktherm=1)' + elseif (trim(tfrz_option) == 'mushy') then + tmpstr2 = ': Assur (1958) as in mushy-layer thermo (ktherm=2)' + endif + write(nu_diag,*) 'tfrz_option = ', trim(tfrz_option),trim(tmpstr2) + if (update_ocn_f) then + tmpstr2 = ' frazil water/salt fluxes included in ocean fluxes' + else + tmpstr2 = ' frazil water/salt fluxes not included in ocean fluxes' + endif + write(nu_diag,1012) ' update_ocn_f = ', update_ocn_f,trim(tmpstr2) + if (l_mpond_fresh .and. tr_pond_topo) then + tmpstr2 = ' retain (topo) pond water until ponds drain' + else + tmpstr2 = ' pond water not retained on ice (virtual only)' + endif + write(nu_diag,1012) ' l_mpond_fresh = ', l_mpond_fresh,trim(tmpstr2) + if (trim(fbot_xfer_type) == 'constant') then + tmpstr2 = ': ocean heat transfer coefficient is constant' + elseif (trim(fbot_xfer_type) == 'Cdn_ocn') then + tmpstr2 = ': variable ocean heat transfer coefficient' ! only used with form_drag=T? + endif + write(nu_diag,*) 'fbot_xfer_type = ', trim(fbot_xfer_type),trim(tmpstr2) + write(nu_diag,1006) ' ustar_min = ', ustar_min,' minimum value of ocean friction velocity' + + if (tr_fsd) then + if (wave_spec) then + tmpstr2 = ' use wave spectrum for floe size distribution' + else + tmpstr2 = ' floe size distribution does not use wave spectrum' + endif + write(nu_diag,1012) ' wave_spec = ', wave_spec,trim(tmpstr2) + if (wave_spec) then + if (trim(wave_spec_type) == 'none') then + tmpstr2 = ': no wave data provided, no wave-ice interactions' + elseif (trim(wave_spec_type) == 'profile') then + tmpstr2 = ': use fixed dummy wave spectrum for testing' + elseif (trim(wave_spec_type) == 'constant') then + tmpstr2 = ': constant wave spectrum data file provided for testing' + elseif (trim(wave_spec_type) == 'random') then + tmpstr2 = ': wave data file provided, spectrum generated using random number' + endif + write(nu_diag,*) 'wave_spec_type = ', trim(wave_spec_type),trim(tmpstr2) + endif + write(nu_diag,1022) ' nfreq = ', nfreq,' number of wave spectral forcing frequencies' + endif + + write(nu_diag,*) ' ' + write(nu_diag,*) ' Age related tracers' + write(nu_diag,*) '--------------------------------' + write(nu_diag,1012) ' tr_iage = ', tr_iage,' chronological ice age' + write(nu_diag,1012) ' tr_FY = ', tr_FY,' first-year ice area' + + write(nu_diag,*) ' ' + write(nu_diag,*) ' Melt ponds' + write(nu_diag,*) '--------------------------------' + if (tr_pond_cesm) then + write(nu_diag,1012) ' tr_pond_cesm = ', tr_pond_cesm,' CESM pond formulation' + write(nu_diag,1007) ' pndaspect = ', pndaspect + elseif (tr_pond_lvl) then + write(nu_diag,1012) ' tr_pond_lvl = ', tr_pond_lvl,' level-ice pond formulation' + write(nu_diag,1007) ' pndaspect = ', pndaspect + write(nu_diag,1006) ' dpscale = ', dpscale,' time scale for flushing in permeable ice' + if (trim(frzpnd) == 'hlid') then + tmpstr2 = ': Stefan refreezing with pond ice thickness' + elseif (trim(frzpnd) == 'cesm') then + tmpstr2 = ': CESM refreezing empirical formula' + endif + write(nu_diag,*) ' frzpnd = ', trim(frzpnd),trim(tmpstr2) + write(nu_diag,1007) ' hs1 = ', hs1,' snow depth of transition to pond ice' + elseif (tr_pond_topo) then + write(nu_diag,1012) ' tr_pond_topo = ', tr_pond_topo,' topo pond formulation' + write(nu_diag,1007) ' hp1 = ', hp1,' critical ice lid thickness for topo ponds' + elseif (trim(shortwave) == 'ccsm3') then + write(nu_diag,*) 'Pond effects on radiation are treated implicitly in the ccsm3 shortwave scheme' + else + write(nu_diag,*) ' Using default dEdd melt pond scheme for testing only' + endif + + if (trim(shortwave) == 'dEdd') then + write(nu_diag,1007) ' hs0 = ', hs0,' snow depth of transition to bare sea ice' + endif + + write(nu_diag,1007) ' rfracmin = ', rfracmin,' minimum fraction of melt water added to ponds' + write(nu_diag,1007) ' rfracmax = ', rfracmax,' maximum fraction of melt water added to ponds' + + write(nu_diag,*) ' ' + write(nu_diag,*) ' Primary state variables, tracers' + write(nu_diag,*) ' (excluding biogeochemistry)' + write(nu_diag,*) '---------------------------------' + write(nu_diag,*) 'Conserved properties (all tracers are conserved):' + write(nu_diag,*) 'ice concentration, volume and enthalpy' + write(nu_diag,*) 'snow volume and enthalpy' + if (ktherm == 2) write(nu_diag,*) 'ice salinity' + if (tr_fsd) write(nu_diag,1012) ' tr_fsd = ', tr_fsd,' floe size distribution' + if (tr_lvl) write(nu_diag,1012) ' tr_lvl = ', tr_lvl,' ridging related tracers' + if (tr_pond_lvl) write(nu_diag,1012) ' tr_pond_lvl = ', tr_pond_lvl,' level-ice pond formulation' + if (tr_pond_topo) write(nu_diag,1012) ' tr_pond_topo = ', tr_pond_topo,' topo pond formulation' + if (tr_pond_cesm) write(nu_diag,1012) ' tr_pond_cesm = ', tr_pond_cesm,' CESM pond formulation' + if (tr_iage) write(nu_diag,1012) ' tr_iage = ', tr_iage,' chronological ice age' + if (tr_FY) write(nu_diag,1012) ' tr_FY = ', tr_FY,' first-year ice area' + if (tr_iso) write(nu_diag,1012) ' tr_iso = ', tr_iso,' diagnostic isotope tracers' + if (tr_aero) write(nu_diag,1012) ' tr_aero = ', tr_aero,' CESM aerosol tracers' + write(nu_diag,*) 'Non-conserved properties:' + write(nu_diag,*) 'ice surface temperature' + write(nu_diag,*) 'ice velocity components and internal stress' + + write(nu_diag,*) ' ' + write(nu_diag,*) ' Other ice_in namelist parameters:' write(nu_diag,*) ' ==================================== ' write(nu_diag,*) ' ' if (trim(runid) /= 'unknown') & @@ -973,11 +1421,8 @@ subroutine input_data trim(runid) write(nu_diag,1030) ' runtype = ', & trim(runtype) - write(nu_diag,1020) ' days_per_year = ', days_per_year - write(nu_diag,1010) ' use_leap_years = ', use_leap_years write(nu_diag,1020) ' year_init = ', year_init write(nu_diag,1020) ' istep0 = ', istep0 - write(nu_diag,1000) ' dt = ', dt write(nu_diag,1020) ' npt = ', npt write(nu_diag,1020) ' diagfreq = ', diagfreq write(nu_diag,1010) ' print_global = ', print_global @@ -988,13 +1433,16 @@ subroutine input_data write(nu_diag,1050) ' histfreq = ', histfreq(:) write(nu_diag,1040) ' histfreq_n = ', histfreq_n(:) write(nu_diag,1010) ' hist_avg = ', hist_avg - if (.not. hist_avg) write(nu_diag,*) 'History data will be snapshots' + if (.not. hist_avg) write(nu_diag,*) ' History data will be snapshots' write(nu_diag,*) ' history_dir = ', & trim(history_dir) write(nu_diag,*) ' history_file = ', & trim(history_file) + write(nu_diag,1020) ' history_precision = ', history_precision + write(nu_diag,*) ' history_format = ', & + trim(history_format) if (write_ic) then - write(nu_diag,*) 'Initial condition will be written in ', & + write(nu_diag,*) ' Initial condition will be written in ', & trim(incond_dir) endif write(nu_diag,1030) ' dumpfreq = ', & @@ -1016,8 +1464,6 @@ subroutine input_data write(nu_diag,*) ' use_restart_time = ', use_restart_time write(nu_diag,*) ' ice_ic = ', & trim(ice_ic) - write(nu_diag,*) ' grid_type = ', & - trim(grid_type) if (trim(grid_type) /= 'rectangular' .or. & trim(grid_type) /= 'column') then write(nu_diag,*) ' grid_file = ', & @@ -1026,111 +1472,13 @@ subroutine input_data trim(gridcpl_file) write(nu_diag,*) ' bathymetry_file = ', & trim(bathymetry_file) - write(nu_diag,*) ' use_bathymetry = ', & - use_bathymetry write(nu_diag,*) ' kmt_file = ', & trim(kmt_file) endif - write(nu_diag,1020) ' kitd = ', kitd - write(nu_diag,1020) ' kcatbound = ', & - kcatbound write(nu_diag,1010) ' close_boundaries = ', & close_boundaries - if (kdyn == 1) then - write(nu_diag,1021) ' kdyn = ','evp ', kdyn - elseif (kdyn == 2) then - write(nu_diag,1021) ' kdyn = ','eap ', kdyn - else - write(nu_diag,1020) ' kdyn = ', kdyn - endif - write(nu_diag,1020) ' ndtd = ', ndtd - write(nu_diag,1020) ' ndte = ', ndte - write(nu_diag,1010) ' revised_evp = ', revised_evp - write(nu_diag,1020) ' kevp_kernel = ', kevp_kernel - write(nu_diag,1005) ' brlx = ', brlx - write(nu_diag,1005) ' arlx = ', arlx - if (kdyn == 1) & - write(nu_diag,*) ' yield_curve = ', & - trim(yield_curve) - write(nu_diag,1020) ' kstrength = ', kstrength - write(nu_diag,1030) ' coriolis = ', coriolis - write(nu_diag,1020) ' kridge = ', kridge - write(nu_diag,1020) ' ktransport = ', ktransport - write(nu_diag,1020) ' krdg_partic = ', & - krdg_partic - write(nu_diag,1020) ' krdg_redist = ', & - krdg_redist - if (krdg_redist == 1) & - write(nu_diag,1000) ' mu_rdg = ', mu_rdg - if (kstrength == 1) & - write(nu_diag,1000) ' Cf = ', Cf - - write(nu_diag,1010) ' basalstress = ', basalstress - write(nu_diag,1005) ' k1 = ', k1 - write(nu_diag,1005) ' k2 = ', k2 - write(nu_diag,1005) ' alphab = ', alphab - write(nu_diag,1005) ' threshold_hw = ', threshold_hw - write(nu_diag,1005) ' Ktens = ', Ktens - write(nu_diag,1005) ' e_ratio = ', e_ratio - write(nu_diag,1030) ' advection = ', & - trim(advection) - write(nu_diag,1030) ' shortwave = ', & - trim(shortwave) - write(nu_diag,1000) ' ksno = ', ksno - if (cpl_bgc) then - write(nu_diag,1000) ' BGC coupling is switched ON' - else - write(nu_diag,1000) ' BGC coupling is switched OFF' - endif - if (trim(shortwave) == 'dEdd') then - write(nu_diag,1000) ' R_ice = ', R_ice - write(nu_diag,1000) ' R_pnd = ', R_pnd - write(nu_diag,1000) ' R_snw = ', R_snw - write(nu_diag,1000) ' dT_mlt = ', dT_mlt - write(nu_diag,1000) ' rsnw_mlt = ', rsnw_mlt - write(nu_diag,1000) ' kalg = ', kalg - write(nu_diag,1000) ' hp1 = ', hp1 - write(nu_diag,1000) ' hs0 = ', hs0 - else - write(nu_diag,1030) ' albedo_type = ', & - trim(albedo_type) - write(nu_diag,1000) ' albicev = ', albicev - write(nu_diag,1000) ' albicei = ', albicei - write(nu_diag,1000) ' albsnowv = ', albsnowv - write(nu_diag,1000) ' albsnowi = ', albsnowi - write(nu_diag,1000) ' ahmax = ', ahmax - endif - - write(nu_diag,1000) ' rfracmin = ', rfracmin - write(nu_diag,1000) ' rfracmax = ', rfracmax - if (tr_pond_lvl) then - write(nu_diag,1000) ' hs1 = ', hs1 - write(nu_diag,1000) ' dpscale = ', dpscale - write(nu_diag,1030) ' frzpnd = ', trim(frzpnd) - endif - if (tr_pond .and. .not. tr_pond_lvl) & - write(nu_diag,1000) ' pndaspect = ', pndaspect - - write(nu_diag,1020) ' ktherm = ', ktherm - if (ktherm == 1) & - write(nu_diag,1030) ' conduct = ', conduct - if (ktherm == 2) then - write(nu_diag,1005) ' a_rapid_mode = ', a_rapid_mode - write(nu_diag,1005) ' Rac_rapid_mode = ', Rac_rapid_mode - write(nu_diag,1005) ' aspect_rapid_mode = ', aspect_rapid_mode - write(nu_diag,1005) ' dSdt_slow_mode = ', dSdt_slow_mode - write(nu_diag,1005) ' phi_c_slow_mode = ', phi_c_slow_mode - write(nu_diag,1005) ' phi_i_mushy = ', phi_i_mushy - endif - - write(nu_diag,1030) ' atmbndy = ', & - trim(atmbndy) - write(nu_diag,1010) ' formdrag = ', formdrag - write(nu_diag,1010) ' highfreq = ', highfreq - write(nu_diag,1020) ' natmiter = ', natmiter - write(nu_diag,1010) ' calc_strair = ', calc_strair - write(nu_diag,1010) ' calc_Tsfc = ', calc_Tsfc + write(nu_diag,1010) ' conserv_check = ', conserv_check write(nu_diag,1020) ' fyear_init = ', & fyear_init @@ -1146,27 +1494,19 @@ subroutine input_data write(nu_diag,*) ' default_season = ', trim(default_season) endif - write(nu_diag,1010) ' update_ocn_f = ', update_ocn_f - write(nu_diag,1010) ' l_mpond_fresh = ', l_mpond_fresh - write(nu_diag,1005) ' ustar_min = ', ustar_min - write(nu_diag,1005) ' emissivity = ', emissivity - write(nu_diag, *) ' fbot_xfer_type = ', & - trim(fbot_xfer_type) - write(nu_diag,1010) ' oceanmixed_ice = ', & - oceanmixed_ice - write(nu_diag,1010) ' wave_spec = ', wave_spec if (wave_spec) then - write(nu_diag,*) ' wave_spec_type = ', wave_spec_type - write(nu_diag,*) ' wave_spec_file = ', wave_spec_file + write(nu_diag,*) ' wave_spec_file = ', trim(wave_spec_file) endif - write(nu_diag,1020) ' nfreq = ', nfreq - write(nu_diag,*) ' tfrz_option = ', & - trim(tfrz_option) if (trim(bgc_data_type) == 'ncar' .or. & trim(ocn_data_type) == 'ncar') then write(nu_diag,*) ' oceanmixed_file = ', & trim(oceanmixed_file) endif + if (cpl_bgc) then + write(nu_diag,1000) ' BGC coupling is switched ON' + else + write(nu_diag,1000) ' BGC coupling is switched OFF' + endif write(nu_diag,*) ' bgc_data_type = ', & trim(bgc_data_type) write(nu_diag,*) ' fe_data_type = ', & @@ -1206,31 +1546,17 @@ subroutine input_data write(nu_diag,'(a30,2f8.2)') 'Diagnostic point 2: lat, lon =', & latpnt(2), lonpnt(2) - ! tracers - write(nu_diag,1010) ' tr_iage = ', tr_iage + ! tracer restarts write(nu_diag,1010) ' restart_age = ', restart_age - write(nu_diag,1010) ' tr_FY = ', tr_FY write(nu_diag,1010) ' restart_FY = ', restart_FY - write(nu_diag,1010) ' tr_lvl = ', tr_lvl write(nu_diag,1010) ' restart_lvl = ', restart_lvl - write(nu_diag,1010) ' tr_pond_cesm = ', tr_pond_cesm write(nu_diag,1010) ' restart_pond_cesm = ', restart_pond_cesm - write(nu_diag,1010) ' tr_pond_lvl = ', tr_pond_lvl write(nu_diag,1010) ' restart_pond_lvl = ', restart_pond_lvl - write(nu_diag,1010) ' tr_pond_topo = ', tr_pond_topo write(nu_diag,1010) ' restart_pond_topo = ', restart_pond_topo - write(nu_diag,1010) ' tr_iso = ', tr_iso write(nu_diag,1010) ' restart_iso = ', restart_iso - write(nu_diag,1010) ' tr_aero = ', tr_aero write(nu_diag,1010) ' restart_aero = ', restart_aero - write(nu_diag,1010) ' tr_fsd = ', tr_fsd write(nu_diag,1010) ' restart_fsd = ', restart_fsd - write(nu_diag,1020) ' ncat = ', ncat - write(nu_diag,1020) ' nfsd = ', nfsd - write(nu_diag,1020) ' nilyr = ', nilyr - write(nu_diag,1020) ' nslyr = ', nslyr - write(nu_diag,1020) ' nblyr = ', nblyr write(nu_diag,1020) ' n_iso = ', n_iso write(nu_diag,1020) ' n_aero = ', n_aero write(nu_diag,1020) ' n_zaero = ', n_zaero @@ -1251,7 +1577,7 @@ subroutine input_data grid_type /= 'regional' .and. & grid_type /= 'latlon' ) then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: unknown grid_type=',trim(grid_type) - abort_flag = 20 + abort_list = trim(abort_list)//":20" endif ! check for valid kevp_kernel @@ -1265,22 +1591,23 @@ subroutine input_data if (kevp_kernel == 2) then if (my_task == master_task) write(nu_diag,*) subname//' kevp_kernel=2 not validated, use kevp_kernel=102 for testing until it is validated' endif - abort_flag = 21 + abort_list = trim(abort_list)//":21" endif endif - if (abort_flag /= 0) then + if (abort_list /= "") then call flush_fileunit(nu_diag) endif call ice_barrier() - if (abort_flag /= 0) then - write(nu_diag,*) subname,' ERROR: abort_flag=',abort_flag + if (abort_list /= "") then + write(nu_diag,*) subname,' ERROR: abort_list = ',trim(abort_list) call abort_ice (subname//' ABORTING on input ERRORS', & file=__FILE__, line=__LINE__) endif call icepack_init_parameters(ustar_min_in=ustar_min, albicev_in=albicev, albicei_in=albicei, & - albsnowv_in=albsnowv, albsnowi_in=albsnowi, natmiter_in=natmiter, emissivity_in=emissivity, & + albsnowv_in=albsnowv, albsnowi_in=albsnowi, natmiter_in=natmiter, atmiter_conv_in=atmiter_conv, & + emissivity_in=emissivity, & ahmax_in=ahmax, shortwave_in=shortwave, albedo_type_in=albedo_type, R_ice_in=R_ice, R_pnd_in=R_pnd, & R_snw_in=R_snw, dT_mlt_in=dT_mlt, rsnw_mlt_in=rsnw_mlt, & kstrength_in=kstrength, krdg_partic_in=krdg_partic, krdg_redist_in=krdg_redist, mu_rdg_in=mu_rdg, & @@ -1290,7 +1617,7 @@ subroutine input_data ktherm_in=ktherm, calc_Tsfc_in=calc_Tsfc, conduct_in=conduct, & a_rapid_mode_in=a_rapid_mode, Rac_rapid_mode_in=Rac_rapid_mode, & aspect_rapid_mode_in=aspect_rapid_mode, dSdt_slow_mode_in=dSdt_slow_mode, & - phi_c_slow_mode_in=phi_c_slow_mode, phi_i_mushy_in=phi_i_mushy, & + phi_c_slow_mode_in=phi_c_slow_mode, phi_i_mushy_in=phi_i_mushy, conserv_check_in=conserv_check, & wave_spec_type_in = wave_spec_type, & wave_spec_in=wave_spec, nfreq_in=nfreq, & tfrz_option_in=tfrz_option, kalg_in=kalg, fbot_xfer_type_in=fbot_xfer_type) @@ -1307,10 +1634,14 @@ subroutine input_data file=__FILE__, line=__LINE__) 1000 format (a30,2x,f9.2) ! a30 to align formatted, unformatted statements + 1002 format (a20,1x,f7.2,a) 1005 format (a30,2x,f12.6) ! float + 1006 format (a20,2x,f10.6,a) + 1007 format (a20,2x,f6.2,a) 1010 format (a30,2x,l6) ! logical + 1012 format (a20,2x,l3,1x,a) ! logical 1020 format (a30,2x,i6) ! integer - 1021 format (a30,2x,a8,i6) ! char, int + 1022 format (a20,2x,i3,1x,a) ! integer 1030 format (a30, a8) ! character 1040 format (a30,2x,6i6) ! integer 1050 format (a30,2x,6a6) ! character @@ -1841,9 +2172,6 @@ subroutine set_state_var (nx_block, ny_block, & do n = 1, ncat ! ice volume, snow volume -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells i = indxi(ij) j = indxj(ij) diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index e389adc87..2f1a1c75b 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -182,7 +182,6 @@ subroutine step_therm1 (dt, iblk) logical (kind=log_kind) :: & prescribed_ice ! if .true., use prescribed ice instead of computed #endif - real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -190,7 +189,10 @@ subroutine step_therm1 (dt, iblk) iblk ! block index ! local variables - +#ifdef CICE_IN_NEMO + real (kind=dbl_kind) :: & + raice ! temporary reverse ice concentration +#endif integer (kind=int_kind) :: & ilo,ihi,jlo,jhi, & ! beginning and end of physical domain i, j , & ! horizontal indices @@ -1284,9 +1286,6 @@ subroutine ocean_mixed_layer (dt, iblk) ! Compute ocean fluxes and update SST !----------------------------------------------------------------- -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells i = indxi(ij) j = indxj(ij) diff --git a/cicecore/cicedynB/infrastructure/ice_domain.F90 b/cicecore/cicedynB/infrastructure/ice_domain.F90 index 3be2449f7..3916039b5 100644 --- a/cicecore/cicedynB/infrastructure/ice_domain.F90 +++ b/cicecore/cicedynB/infrastructure/ice_domain.F90 @@ -342,6 +342,7 @@ subroutine init_domain_distribution(KMTG,ULATG) file=__FILE__, line=__LINE__) if (trim(ns_boundary_type) == 'closed') then + call abort_ice(subname//'ERROR: ns_boundary_type = closed not supported') allocate(nocn(nblocks_tot)) nocn = 0 do n=1,nblocks_tot @@ -373,13 +374,14 @@ subroutine init_domain_distribution(KMTG,ULATG) enddo endif if (nocn(n) > 0) then - print*, 'ice: Not enough land cells along ns edge' - call abort_ice(subname//'ERROR: Not enough land cells along ns edge') + write(nu_diag,*) subname,'ns closed, Not enough land cells along ns edge' + call abort_ice(subname//'ERROR: Not enough land cells along ns edge for ns closed') endif enddo deallocate(nocn) endif if (trim(ew_boundary_type) == 'closed') then + call abort_ice(subname//'ERROR: ew_boundary_type = closed not supported') allocate(nocn(nblocks_tot)) nocn = 0 do n=1,nblocks_tot @@ -411,8 +413,8 @@ subroutine init_domain_distribution(KMTG,ULATG) enddo endif if (nocn(n) > 0) then - print*, 'ice: Not enough land cells along ew edge' - call abort_ice(subname//'ERROR: Not enough land cells along ew edge') + write(nu_diag,*) subname,'ew closed, Not enough land cells along ew edge' + call abort_ice(subname//'ERROR: Not enough land cells along ew edge for ew closed') endif enddo deallocate(nocn) diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index 20df6b236..f4b5fef6e 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -133,6 +133,10 @@ module ice_grid real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & rndex_global ! global index for local subdomain (dbl) + logical (kind=log_kind), private :: & + l_readCenter ! If anglet exist in grid file read it otherwise calculate it + + !======================================================================= contains @@ -332,7 +336,6 @@ subroutine init_grid2 real (kind=dbl_kind) :: & angle_0, angle_w, angle_s, angle_sw, & pi, pi2, puny -! real (kind=dbl_kind) :: ANGLET_dum logical (kind=log_kind), dimension(nx_block,ny_block,max_blocks):: & out_of_range @@ -470,11 +473,10 @@ subroutine init_grid2 !----------------------------------------------------------------- ! Compute ANGLE on T-grid !----------------------------------------------------------------- - ANGLET = c0 - if (trim(grid_type) == 'cpom_grid') then ANGLET(:,:,:) = ANGLE(:,:,:) - else + else if (.not. (l_readCenter)) then + ANGLET = c0 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block, & !$OMP angle_0,angle_w,angle_s,angle_sw) @@ -504,7 +506,8 @@ subroutine init_grid2 enddo !$OMP END PARALLEL DO endif ! cpom_grid - if (trim(grid_type) == 'regional') then + if (trim(grid_type) == 'regional' .and. & + (.not. (l_readCenter))) then ! for W boundary extrapolate from interior !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks @@ -531,9 +534,9 @@ subroutine init_grid2 call ice_timer_stop(timer_bound) call makemask ! velocity mask, hemisphere masks - - call Tlatlon ! get lat, lon on the T grid - + if (.not. (l_readCenter)) then + call Tlatlon ! get lat, lon on the T grid + endif !----------------------------------------------------------------- ! bathymetry !----------------------------------------------------------------- @@ -716,6 +719,7 @@ subroutine popgrid_nc field_loc_center, field_loc_NEcorner, & field_type_scalar, field_type_angle use ice_domain_size, only: max_blocks + use netcdf integer (kind=int_kind) :: & i, j, iblk, & @@ -739,6 +743,12 @@ subroutine popgrid_nc type (block) :: & this_block ! block information for current block + + integer(kind=int_kind) :: & + varid + integer (kind=int_kind) :: & + status ! status flag + character(len=*), parameter :: subname = '(popgrid_nc)' @@ -751,7 +761,7 @@ subroutine popgrid_nc call ice_open_nc(kmt_file,fid_kmt) diag = .true. ! write diagnostic info - + l_readCenter = .false. !----------------------------------------------------------------- ! topography !----------------------------------------------------------------- @@ -806,11 +816,37 @@ subroutine popgrid_nc call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! ANGLE call scatter_global(ANGLE, work_g1, master_task, distrb_info, & field_loc_NEcorner, field_type_angle) - ! fix ANGLE: roundoff error due to single precision where (ANGLE > pi) ANGLE = pi where (ANGLE < -pi) ANGLE = -pi + ! if grid file includes anglet then read instead + fieldname='anglet' + if (my_task == master_task) then + status = nf90_inq_varid(fid_grid, trim(fieldname) , varid) + if (status /= nf90_noerr) then + write(nu_diag,*) subname//' CICE will calculate angleT, TLON and TLAT' + else + write(nu_diag,*) subname//' angleT, TLON and TLAT is read from grid file' + l_readCenter = .true. + endif + endif + call broadcast_scalar(l_readCenter,master_task) + if (l_readCenter) then + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) + call scatter_global(ANGLET, work_g1, master_task, distrb_info, & + field_loc_center, field_type_angle) + where (ANGLET > pi) ANGLET = pi + where (ANGLET < -pi) ANGLET = -pi + fieldname="tlon" + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) + call scatter_global(TLON, work_g1, master_task, distrb_info, & + field_loc_center, field_type_scalar) + fieldname="tlat" + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) + call scatter_global(TLAT, work_g1, master_task, distrb_info, & + field_loc_center, field_type_scalar) + endif !----------------------------------------------------------------- ! cell dimensions ! calculate derived quantities from global arrays to preserve @@ -820,7 +856,6 @@ subroutine popgrid_nc fieldname='htn' call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! HTN call primary_grid_lengths_HTN(work_g1) ! dxu, dxt - fieldname='hte' call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! HTE call primary_grid_lengths_HTE(work_g1) ! dyu, dyt @@ -831,7 +866,6 @@ subroutine popgrid_nc call ice_close_nc(fid_grid) call ice_close_nc(fid_kmt) endif - #endif end subroutine popgrid_nc @@ -1737,7 +1771,6 @@ subroutine Tlatlon enddo ! j enddo ! iblk !$OMP END PARALLEL DO - if (trim(grid_type) == 'regional') then ! for W boundary extrapolate from interior !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) @@ -2411,7 +2444,7 @@ subroutine get_bathymetry_popfile ! create thickness profile k1 = min(5,nlevel) do k = 1,k1 - thick(k) = max(10000._dbl_kind/float(nlevel),500.) + thick(k) = max(10000._dbl_kind/float(nlevel),500._dbl_kind) enddo do k = k1+1,nlevel thick(k) = min(thick(k-1)*1.2_dbl_kind,20000._dbl_kind) @@ -2463,7 +2496,6 @@ subroutine read_basalstress_bathy ! use module use ice_read_write - use ice_communicate, only: my_task, master_task use ice_constants, only: field_loc_center, field_type_scalar ! local variables @@ -2491,7 +2523,6 @@ subroutine read_basalstress_bathy if (my_task == master_task) then write(nu_diag,*) 'reading ',TRIM(fieldname) - write(*,*) 'reading ',TRIM(fieldname) call icepack_warnings_flush(nu_diag) endif call ice_read_nc(fid_init,1,fieldname,bathymetry,diag, & diff --git a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 index 5bc945fa2..d3829b9c4 100644 --- a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 @@ -883,7 +883,7 @@ subroutine restartfile_v4 (ice_ic) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - ! creates netcdf if restart_format = 'nc' + ! creates new file filename = trim(restart_dir) // '/iced.converted' call dumpfile(filename) call final_restart diff --git a/cicecore/cicedynB/infrastructure/ice_restoring.F90 b/cicecore/cicedynB/infrastructure/ice_restoring.F90 index 09db9c273..38104315d 100644 --- a/cicecore/cicedynB/infrastructure/ice_restoring.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restoring.F90 @@ -499,9 +499,6 @@ subroutine set_restore_var (nx_block, ny_block, & do n = 1, ncat -!DIR$ CONCURRENT !Cray -!cdir nodep !NEC -!ocl novrec !Fujitsu do ij = 1, icells i = indxi(ij) j = indxj(ij) diff --git a/cicecore/cicedynB/infrastructure/io/io_binary/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_binary/ice_history_write.F90 index dd525df6d..b98e09814 100644 --- a/cicecore/cicedynB/infrastructure/io/io_binary/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_binary/ice_history_write.F90 @@ -62,6 +62,10 @@ subroutine ice_write_hist(ns) integer (kind=int_kind) :: icategory,i_aice + character (len=4) :: & + atype ! format for output array + ! (real/integer, 4-byte/8-byte) + character (char_len) :: current_date,current_time character (len=16) :: c_aice logical (kind=log_kind) :: diag @@ -70,6 +74,15 @@ subroutine ice_write_hist(ns) diag = .false. + ! single precision + atype = 'rda4' + nbits = 32 + if (history_precision == 8) then + ! double precision + atype = 'rda8' + nbits = 64 + endif + if (my_task == master_task) then call construct_filename(ncfile(ns),'da',ns) @@ -85,7 +98,6 @@ subroutine ice_write_hist(ns) !----------------------------------------------------------------- ! create history files !----------------------------------------------------------------- - nbits = 32 ! single precision call ice_open(nu_history, ncfile(ns), nbits) ! direct access open(nu_hdr,file=hdrfile,form='formatted',status='unknown') ! ascii @@ -124,7 +136,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 996) nrec,'tarea','area of T grid cells','m^2' write (nu_hdr, * ) 'History variables: (left column = nrec)' endif ! my_task = master_task - call ice_write(nu_history, nrec, tarea, 'rda4', diag) + call ice_write(nu_history, nrec, tarea, atype, diag) do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns)) then @@ -160,7 +172,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a2D(:,:,n,:), 'rda4', diag) + call ice_write(nu_history, nrec, a2D(:,:,n,:), atype, diag) endif enddo ! num_avail_hist_fields_2D @@ -183,7 +195,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a3Dc(:,:,nn,n-n2D,:), 'rda4', diag) + call ice_write(nu_history, nrec, a3Dc(:,:,nn,n-n2D,:), atype, diag) enddo ! ncat endif @@ -207,7 +219,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a3Dz(:,:,k,n-n3Dccum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a3Dz(:,:,k,n-n3Dccum,:), atype, diag) enddo ! nzilyr endif @@ -231,7 +243,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a3Db(:,:,k,n-n3Dzcum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a3Db(:,:,k,n-n3Dzcum,:), atype, diag) enddo ! nzilyr endif @@ -255,7 +267,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a3Da(:,:,k,n-n3Dbcum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a3Da(:,:,k,n-n3Dbcum,:), atype, diag) enddo ! nzilyr endif @@ -279,7 +291,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a3Df(:,:,k,n-n3Dacum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a3Df(:,:,k,n-n3Dacum,:), atype, diag) enddo ! nfsd_hist endif @@ -304,7 +316,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a4Di(:,:,k,nn,n-n3Dfcum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a4Di(:,:,k,nn,n-n3Dfcum,:), atype, diag) enddo ! nzilyr enddo ! ncat_hist @@ -315,7 +327,7 @@ subroutine ice_write_hist(ns) if (avail_hist_fields(n)%vhistfreq == histfreq(ns)) then do nn = 1, ncat_hist - do k = 1, nzilyr + do k = 1, nzslyr nrec = nrec + 1 if (my_task == master_task) then write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & @@ -330,8 +342,8 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a4Ds(:,:,k,nn,n-n4Dicum,:), 'rda4', diag) - enddo ! nzilyr + call ice_write(nu_history, nrec, a4Ds(:,:,k,nn,n-n4Dicum,:), atype, diag) + enddo ! nzslyr enddo ! ncat_hist endif @@ -356,7 +368,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a4Df(:,:,k,nn,n-n4Dscum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a4Df(:,:,k,nn,n-n4Dscum,:), atype, diag) enddo ! nfsd_hist enddo ! ncat_hist diff --git a/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 index 8ecfeb6f1..b1a2d026b 100644 --- a/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 @@ -11,7 +11,7 @@ module ice_restart use ice_kinds_mod use ice_restart_shared, only: & restart, restart_ext, restart_dir, restart_file, pointer_file, & - runid, runtype, use_restart_time, restart_format, lenstr + runid, runtype, use_restart_time, lenstr use ice_fileunits, only: nu_diag, nu_rst_pointer use ice_fileunits, only: nu_dump, nu_dump_eap, nu_dump_FY, nu_dump_age use ice_fileunits, only: nu_dump_lvl, nu_dump_pond, nu_dump_hbrine diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 index ff16c637b..5b6aa0dd8 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -18,7 +18,7 @@ module ice_history_write - use ice_constants, only: c0, c360, spval + use ice_constants, only: c0, c360, spval, spval_dbl use ice_fileunits, only: nu_diag use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -86,6 +86,8 @@ subroutine ice_write_hist (ns) integer (kind=int_kind) :: ind,boundid + integer (kind=int_kind) :: lprecision + character (char_len) :: start_time,current_date,current_time character (len=8) :: cdate @@ -123,6 +125,9 @@ subroutine ice_write_hist (ns) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) + lprecision = nf90_float + if (history_precision == 8) lprecision = nf90_double + if (my_task == master_task) then ! ltime=time/int(secday) @@ -243,7 +248,7 @@ subroutine ice_write_hist (ns) if (hist_avg) then dimid(1) = boundid dimid(2) = timid - status = nf90_def_var(ncid,'time_bounds',nf90_float,dimid(1:2),varid) + status = nf90_def_var(ncid,'time_bounds',lprecision,dimid(1:2),varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining var time_bounds') status = nf90_put_att(ncid,varid,'long_name', & @@ -344,7 +349,7 @@ subroutine ice_write_hist (ns) dimid(3) = timid do i = 1, ncoord - status = nf90_def_var(ncid, coord_var(i)%short_name, nf90_float, & + status = nf90_def_var(ncid, coord_var(i)%short_name, lprecision, & dimid(1:2), varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining short_name for '//coord_var(i)%short_name) @@ -354,10 +359,18 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'units', coord_var(i)%units) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining units for '//coord_var(i)%short_name) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//coord_var(i)%short_name) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//coord_var(i)%short_name) if (coord_var(i)%short_name == 'ULAT') then @@ -384,7 +397,7 @@ subroutine ice_write_hist (ns) do i = 1, nvarz if (igrdz(i)) then status = nf90_def_var(ncid, var_nz(i)%short_name, & - nf90_float, dimidex(i), varid) + lprecision, dimidex(i), varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining short_name for '//var_nz(i)%short_name) status = nf90_put_att(ncid,varid,'long_name',var_nz(i)%long_name) @@ -398,7 +411,7 @@ subroutine ice_write_hist (ns) ! Attributes for tmask, blkmask defined separately, since they have no units if (igrd(n_tmask)) then - status = nf90_def_var(ncid, 'tmask', nf90_float, dimid(1:2), varid) + status = nf90_def_var(ncid, 'tmask', lprecision, dimid(1:2), varid) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining var tmask') status = nf90_put_att(ncid,varid, 'long_name', 'ocean grid mask') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: tmask long_name') @@ -406,14 +419,22 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: tmask units') status = nf90_put_att(ncid,varid,'comment', '0 = land, 1 = ocean') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: tmask comment') - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining missing_value for tmask') - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining _FillValue for tmask') endif if (igrd(n_blkmask)) then - status = nf90_def_var(ncid, 'blkmask', nf90_float, dimid(1:2), varid) + status = nf90_def_var(ncid, 'blkmask', lprecision, dimid(1:2), varid) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining var blkmask') status = nf90_put_att(ncid,varid, 'long_name', 'ice grid block mask') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: blkmask long_name') @@ -421,16 +442,24 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: blkmask units') status = nf90_put_att(ncid,varid,'comment', 'mytask + iblk/100') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: blkmask comment') - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining missing_value for blkmask') - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining _FillValue for blkmask') endif do i = 3, nvar ! note n_tmask=1, n_blkmask=2 if (igrd(i)) then status = nf90_def_var(ncid, var(i)%req%short_name, & - nf90_float, dimid(1:2), varid) + lprecision, dimid(1:2), varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//var(i)%req%short_name) status = nf90_put_att(ncid,varid, 'long_name', var(i)%req%long_name) @@ -442,10 +471,18 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'coordinates', var(i)%coordinates) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining coordinates for '//var(i)%req%short_name) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//var(i)%req%short_name) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//var(i)%req%short_name) endif @@ -458,7 +495,7 @@ subroutine ice_write_hist (ns) do i = 1, nvar_verts if (f_bounds) then status = nf90_def_var(ncid, var_nverts(i)%short_name, & - nf90_float,dimid_nverts, varid) + lprecision,dimid_nverts, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//var_nverts(i)%short_name) status = nf90_put_att(ncid,varid, 'long_name', var_nverts(i)%long_name) @@ -467,10 +504,18 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'units', var_nverts(i)%units) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining units for '//var_nverts(i)%short_name) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//var_nverts(i)%short_name) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//var_nverts(i)%short_name) endif @@ -479,7 +524,7 @@ subroutine ice_write_hist (ns) do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimid, varid) + lprecision, dimid, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -498,10 +543,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -542,7 +595,7 @@ subroutine ice_write_hist (ns) do n = n2D + 1, n3Dccum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimidz, varid) + lprecision, dimidz, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -561,10 +614,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -593,7 +654,7 @@ subroutine ice_write_hist (ns) do n = n3Dccum + 1, n3Dzcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimidz, varid) + lprecision, dimidz, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -612,10 +673,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -630,7 +699,7 @@ subroutine ice_write_hist (ns) do n = n3Dzcum + 1, n3Dbcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimidz, varid) + lprecision, dimidz, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -649,10 +718,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -667,7 +744,7 @@ subroutine ice_write_hist (ns) do n = n3Dbcum + 1, n3Dacum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimidz, varid) + lprecision, dimidz, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -686,10 +763,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -704,7 +789,7 @@ subroutine ice_write_hist (ns) do n = n3Dacum + 1, n3Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimidz, varid) + lprecision, dimidz, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -723,10 +808,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -742,8 +835,8 @@ subroutine ice_write_hist (ns) do n = n3Dfcum + 1, n4Dicum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! nf90_float, dimidcz, varid) - nf90_float, dimidcz(1:4), varid) ! ferret +! lprecision, dimidcz, varid) + lprecision, dimidcz(1:4), varid) ! ferret if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -762,10 +855,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -795,8 +896,8 @@ subroutine ice_write_hist (ns) do n = n4Dicum + 1, n4Dscum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! nf90_float, dimidcz, varid) - nf90_float, dimidcz(1:4), varid) ! ferret +! lprecision, dimidcz, varid) + lprecision, dimidcz(1:4), varid) ! ferret if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -815,10 +916,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -848,8 +957,8 @@ subroutine ice_write_hist (ns) do n = n4Dscum + 1, n4Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! nf90_float, dimidcz, varid) - nf90_float, dimidcz(1:4), varid) ! ferret +! lprecision, dimidcz, varid) + lprecision, dimidcz(1:4), varid) ! ferret if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -868,10 +977,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) diff --git a/cicecore/cicedynB/infrastructure/io/io_pio/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_pio/ice_history_write.F90 deleted file mode 100644 index 23baeb40a..000000000 --- a/cicecore/cicedynB/infrastructure/io/io_pio/ice_history_write.F90 +++ /dev/null @@ -1,1196 +0,0 @@ -!======================================================================= -! -! Writes history in netCDF format -! -! authors Tony Craig and Bruce Briegleb, NCAR -! Elizabeth C. Hunke and William H. Lipscomb, LANL -! C. M. Bitz, UW -! -! 2004 WHL: Block structure added -! 2006 ECH: Accepted some CESM code into mainstream CICE -! Added ice_present, aicen, vicen; removed aice1...10, vice1...1. -! Added histfreq_n and histfreq='h' options, removed histfreq='w' -! Converted to free source form (F90) -! Added option for binary output instead of netCDF -! 2009 D Bailey and ECH: Generalized for multiple frequency output -! 2010 Alison McLaren and ECH: Added 3D capability -! - module ice_history_write - - use ice_kinds_mod - use ice_fileunits, only: nu_diag - use ice_exit, only: abort_ice - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_query_parameters - - implicit none - private - public :: ice_write_hist - -!======================================================================= - - contains - -!======================================================================= -! -! write average ice quantities or snapshots -! -! author: Elizabeth C. Hunke, LANL - - subroutine ice_write_hist (ns) - -#ifdef ncdf - use ice_blocks, only: nx_block, ny_block - use ice_broadcast, only: broadcast_scalar - use ice_calendar, only: time, sec, idate, idate0, write_ic, & - histfreq, dayyr, days_per_year, use_leap_years - use ice_communicate, only: my_task, master_task - use ice_constants, only: c0, c360, spval, spval_dbl - use ice_domain, only: distrb_info, nblocks - use ice_domain_size, only: nx_global, ny_global, max_blocks, max_nstrm - use ice_gather_scatter, only: gather_global - use ice_grid, only: TLON, TLAT, ULON, ULAT, hm, bm, tarea, uarea, & - dxu, dxt, dyu, dyt, HTN, HTE, ANGLE, ANGLET, tmask, & - lont_bounds, latt_bounds, lonu_bounds, latu_bounds - use ice_history_shared - use ice_arrays_column, only: hin_max, floe_rad_c - use ice_restart_shared, only: runid, lcdf64 - use netcdf -#endif - use ice_pio - use pio - - integer (kind=int_kind), intent(in) :: ns - - ! local variables - -#ifdef ncdf - integer (kind=int_kind) :: i,j,k,ic,n,nn, & - ncid,status,imtid,jmtid,kmtidi,kmtids,kmtidb, cmtid,timid, & - length,nvertexid,ivertex,kmtida,fmtid - integer (kind=int_kind), dimension(2) :: dimid2 - integer (kind=int_kind), dimension(3) :: dimid3 - integer (kind=int_kind), dimension(4) :: dimidz - integer (kind=int_kind), dimension(5) :: dimidcz - integer (kind=int_kind), dimension(3) :: dimid_nverts - integer (kind=int_kind), dimension(6) :: dimidex - real (kind=real_kind) :: ltime - real (kind= dbl_kind) :: ltime2 - character (char_len) :: title - character (char_len_long) :: ncfile(max_nstrm) - - integer (kind=int_kind) :: iyear, imonth, iday - integer (kind=int_kind) :: icategory,ind,i_aice,boundid - - character (char_len) :: start_time,current_date,current_time - character (len=16) :: c_aice - character (len=8) :: cdate - - type(file_desc_t) :: File - type(io_desc_t) :: iodesc2d, & - iodesc3dc, iodesc3dv, iodesc3di, iodesc3db, iodesc3da, & - iodesc3df, & - iodesc4di, iodesc4ds, iodesc4df - type(var_desc_t) :: varid - - ! 4 coordinate variables: TLON, TLAT, ULON, ULAT - INTEGER (kind=int_kind), PARAMETER :: ncoord = 4 - - ! 4 vertices in each grid cell - INTEGER (kind=int_kind), PARAMETER :: nverts = 4 - - ! 4 variables describe T, U grid boundaries: - ! lont_bounds, latt_bounds, lonu_bounds, latu_bounds - INTEGER (kind=int_kind), PARAMETER :: nvar_verts = 4 - - TYPE coord_attributes ! netcdf coordinate attributes - character (len=11) :: short_name - character (len=45) :: long_name - character (len=20) :: units - END TYPE coord_attributes - - TYPE req_attributes ! req'd netcdf attributes - type (coord_attributes) :: req - character (len=20) :: coordinates - END TYPE req_attributes - - TYPE(req_attributes), dimension(nvar) :: var - TYPE(coord_attributes), dimension(ncoord) :: coord_var - TYPE(coord_attributes), dimension(nvar_verts) :: var_nverts - TYPE(coord_attributes), dimension(nvarz) :: var_nz - CHARACTER (char_len), dimension(ncoord) :: coord_bounds - - real (kind=dbl_kind), allocatable :: workr2(:,:,:) - real (kind=dbl_kind), allocatable :: workr3(:,:,:,:) - real (kind=dbl_kind), allocatable :: workr4(:,:,:,:,:) - real (kind=dbl_kind), allocatable :: workr3v(:,:,:,:) - - character(len=char_len_long) :: & - filename - - integer (kind=int_kind), dimension(1) :: & - tim_start,tim_length ! dimension quantities for netCDF - - integer (kind=int_kind), dimension(2) :: & - bnd_start,bnd_length ! dimension quantities for netCDF - - real (kind=dbl_kind) :: secday - real (kind=dbl_kind) :: rad_to_deg - - character(len=*), parameter :: subname = '(ice_write_hist)' - - call icepack_query_parameters(secday_out=secday) - call icepack_query_parameters(rad_to_deg_out=rad_to_deg) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - if (my_task == master_task) then - call construct_filename(ncfile(ns),'nc',ns) - - ! add local directory path name to ncfile - if (write_ic) then - ncfile(ns) = trim(incond_dir)//ncfile(ns) - else - ncfile(ns) = trim(history_dir)//ncfile(ns) - endif - filename = ncfile(ns) - end if - call broadcast_scalar(filename, master_task) - - ! create file - - File%fh=-1 - call ice_pio_init(mode='write', filename=trim(filename), File=File, & - clobber=.true., cdf64=lcdf64) - - call ice_pio_initdecomp(iodesc=iodesc2d) - call ice_pio_initdecomp(ndim3=ncat_hist, iodesc=iodesc3dc) - call ice_pio_initdecomp(ndim3=nzilyr, iodesc=iodesc3di) - call ice_pio_initdecomp(ndim3=nzblyr, iodesc=iodesc3db) - call ice_pio_initdecomp(ndim3=nzalyr, iodesc=iodesc3da) - call ice_pio_initdecomp(ndim3=nfsd_hist, iodesc=iodesc3df) - call ice_pio_initdecomp(ndim3=nverts, inner_dim=.true., iodesc=iodesc3dv) - call ice_pio_initdecomp(ndim3=nzilyr, ndim4=ncat_hist, iodesc=iodesc4di) - call ice_pio_initdecomp(ndim3=nzslyr, ndim4=ncat_hist, iodesc=iodesc4ds) - call ice_pio_initdecomp(ndim3=nzslyr, ndim4=nfsd_hist, iodesc=iodesc4df) - - ltime2 = time/int(secday) - ltime = real(time/int(secday),kind=real_kind) - - !----------------------------------------------------------------- - ! define dimensions - !----------------------------------------------------------------- - - if (hist_avg .and. histfreq(ns) /= '1') then - status = pio_def_dim(File,'d2',2,boundid) - endif - - status = pio_def_dim(File,'ni',nx_global,imtid) - status = pio_def_dim(File,'nj',ny_global,jmtid) - status = pio_def_dim(File,'nc',ncat_hist,cmtid) - status = pio_def_dim(File,'nkice',nzilyr,kmtidi) - status = pio_def_dim(File,'nksnow',nzslyr,kmtids) - status = pio_def_dim(File,'nkbio',nzblyr,kmtidb) - status = pio_def_dim(File,'nkaer',nzalyr,kmtida) - status = pio_def_dim(File,'time',PIO_UNLIMITED,timid) - status = pio_def_dim(File,'nvertices',nverts,nvertexid) - status = pio_def_dim(File,'nf',nfsd_hist,fmtid) - - !----------------------------------------------------------------- - ! define coordinate variables: time, time_bounds - !----------------------------------------------------------------- - -!sgl status = pio_def_var(File,'time',pio_real,(/timid/),varid) - status = pio_def_var(File,'time',pio_double,(/timid/),varid) - status = pio_put_att(File,varid,'long_name','model time') - - write(cdate,'(i8.8)') idate0 - write(title,'(a,a,a,a,a,a,a)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' 00:00:00' - status = pio_put_att(File,varid,'units',trim(title)) - - if (days_per_year == 360) then - status = pio_put_att(File,varid,'calendar','360_day') - elseif (days_per_year == 365 .and. .not.use_leap_years ) then - status = pio_put_att(File,varid,'calendar','NoLeap') - elseif (use_leap_years) then - status = pio_put_att(File,varid,'calendar','Gregorian') - else - call abort_ice(subname//'ERROR: invalid calendar settings') - endif - - if (hist_avg .and. histfreq(ns) /= '1') then - status = pio_put_att(File,varid,'bounds','time_bounds') - endif - - ! Define attributes for time_bounds if hist_avg is true - if (hist_avg .and. histfreq(ns) /= '1') then - dimid2(1) = boundid - dimid2(2) = timid -!sgl status = pio_def_var(File,'time_bounds',pio_real,dimid2,varid) - status = pio_def_var(File,'time_bounds',pio_double,dimid2,varid) - status = pio_put_att(File,varid,'long_name', & - 'boundaries for time-averaging interval') - write(cdate,'(i8.8)') idate0 - write(title,'(a,a,a,a,a,a,a,a)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' 00:00:00' - status = pio_put_att(File,varid,'units',trim(title)) - endif - - !----------------------------------------------------------------- - ! define information for required time-invariant variables - !----------------------------------------------------------------- - - ind = 0 - ind = ind + 1 - coord_var(ind) = coord_attributes('TLON', & - 'T grid center longitude', 'degrees_east') - coord_bounds(ind) = 'lont_bounds' - ind = ind + 1 - coord_var(ind) = coord_attributes('TLAT', & - 'T grid center latitude', 'degrees_north') - coord_bounds(ind) = 'latt_bounds' - ind = ind + 1 - coord_var(ind) = coord_attributes('ULON', & - 'U grid center longitude', 'degrees_east') - coord_bounds(ind) = 'lonu_bounds' - ind = ind + 1 - coord_var(ind) = coord_attributes('ULAT', & - 'U grid center latitude', 'degrees_north') - coord_bounds(ind) = 'latu_bounds' - - var_nz(1) = coord_attributes('NCAT', 'category maximum thickness', 'm') - var_nz(2) = coord_attributes('VGRDi', 'vertical ice levels', '1') - var_nz(3) = coord_attributes('VGRDs', 'vertical snow levels', '1') - var_nz(4) = coord_attributes('VGRDb', 'vertical ice-bio levels', '1') - var_nz(5) = coord_attributes('VGRDa', 'vertical snow-ice-bio levels', '1') - var_nz(6) = coord_attributes('NFSD', 'category floe size (center)', 'm') - - !----------------------------------------------------------------- - ! define information for optional time-invariant variables - !----------------------------------------------------------------- - - var(n_tmask)%req = coord_attributes('tmask', & - 'ocean grid mask', ' ') - var(n_tmask)%coordinates = 'TLON TLAT' - - var(n_blkmask)%req = coord_attributes('blkmask', & - 'ice grid block mask', ' ') - var(n_blkmask)%coordinates = 'TLON TLAT' - - var(n_tarea)%req = coord_attributes('tarea', & - 'area of T grid cells', 'm^2') - var(n_tarea)%coordinates = 'TLON TLAT' - - var(n_uarea)%req = coord_attributes('uarea', & - 'area of U grid cells', 'm^2') - var(n_uarea)%coordinates = 'ULON ULAT' - var(n_dxt)%req = coord_attributes('dxt', & - 'T cell width through middle', 'm') - var(n_dxt)%coordinates = 'TLON TLAT' - var(n_dyt)%req = coord_attributes('dyt', & - 'T cell height through middle', 'm') - var(n_dyt)%coordinates = 'TLON TLAT' - var(n_dxu)%req = coord_attributes('dxu', & - 'U cell width through middle', 'm') - var(n_dxu)%coordinates = 'ULON ULAT' - var(n_dyu)%req = coord_attributes('dyu', & - 'U cell height through middle', 'm') - var(n_dyu)%coordinates = 'ULON ULAT' - var(n_HTN)%req = coord_attributes('HTN', & - 'T cell width on North side','m') - var(n_HTN)%coordinates = 'TLON TLAT' - var(n_HTE)%req = coord_attributes('HTE', & - 'T cell width on East side', 'm') - var(n_HTE)%coordinates = 'TLON TLAT' - var(n_ANGLE)%req = coord_attributes('ANGLE', & - 'angle grid makes with latitude line on U grid', & - 'radians') - var(n_ANGLE)%coordinates = 'ULON ULAT' - var(n_ANGLET)%req = coord_attributes('ANGLET', & - 'angle grid makes with latitude line on T grid', & - 'radians') - var(n_ANGLET)%coordinates = 'TLON TLAT' - - ! These fields are required for CF compliance - ! dimensions (nx,ny,nverts) - var_nverts(n_lont_bnds) = coord_attributes('lont_bounds', & - 'longitude boundaries of T cells', 'degrees_east') - var_nverts(n_latt_bnds) = coord_attributes('latt_bounds', & - 'latitude boundaries of T cells', 'degrees_north') - var_nverts(n_lonu_bnds) = coord_attributes('lonu_bounds', & - 'longitude boundaries of U cells', 'degrees_east') - var_nverts(n_latu_bnds) = coord_attributes('latu_bounds', & - 'latitude boundaries of U cells', 'degrees_north') - - !----------------------------------------------------------------- - ! define attributes for time-invariant variables - !----------------------------------------------------------------- - - dimid2(1) = imtid - dimid2(2) = jmtid - - do i = 1, ncoord - status = pio_def_var(File, trim(coord_var(i)%short_name), pio_real, & - dimid2, varid) - status = pio_put_att(File,varid,'long_name',trim(coord_var(i)%long_name)) - status = pio_put_att(File, varid, 'units', trim(coord_var(i)%units)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - if (coord_var(i)%short_name == 'ULAT') then - status = pio_put_att(File,varid,'comment', & - trim('Latitude of NE corner of T grid cell')) - endif - if (f_bounds) then - status = pio_put_att(File, varid, 'bounds', trim(coord_bounds(i))) - endif - enddo - - ! Extra dimensions (NCAT, NZILYR, NZSLYR, NZBLYR, NZALYR, NFSD) - dimidex(1)=cmtid - dimidex(2)=kmtidi - dimidex(3)=kmtids - dimidex(4)=kmtidb - dimidex(5)=kmtida - dimidex(6)=fmtid - - do i = 1, nvarz - if (igrdz(i)) then - status = pio_def_var(File, trim(var_nz(i)%short_name), pio_real, & - (/dimidex(i)/), varid) - status = pio_put_att(File, varid, 'long_name', var_nz(i)%long_name) - status = pio_put_att(File, varid, 'units' , var_nz(i)%units) - endif - enddo - - ! Attributes for tmask defined separately, since it has no units - if (igrd(n_tmask)) then - status = pio_def_var(File, 'tmask', pio_real, dimid2, varid) - status = pio_put_att(File,varid, 'long_name', 'ocean grid mask') - status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - status = pio_put_att(File,varid,'comment', '0 = land, 1 = ocean') - endif - if (igrd(n_blkmask)) then - status = pio_def_var(File, 'blkmask', pio_real, dimid2, varid) - status = pio_put_att(File,varid, 'long_name', 'ice grid block mask') - status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') - status = pio_put_att(File,varid,'comment', 'mytask + iblk/100') - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - endif - - do i = 3, nvar ! note: n_tmask=1, n_blkmask=2 - if (igrd(i)) then - status = pio_def_var(File, trim(var(i)%req%short_name), & - pio_real, dimid2, varid) - status = pio_put_att(File,varid, 'long_name', trim(var(i)%req%long_name)) - status = pio_put_att(File, varid, 'units', trim(var(i)%req%units)) - status = pio_put_att(File, varid, 'coordinates', trim(var(i)%coordinates)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - endif - enddo - - ! Fields with dimensions (nverts,nx,ny) - dimid_nverts(1) = nvertexid - dimid_nverts(2) = imtid - dimid_nverts(3) = jmtid - do i = 1, nvar_verts - if (f_bounds) then - status = pio_def_var(File, trim(var_nverts(i)%short_name), & - pio_real,dimid_nverts, varid) - status = & - pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)) - status = & - pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - endif - enddo - - !----------------------------------------------------------------- - ! define attributes for time-variant variables - !----------------------------------------------------------------- - - !----------------------------------------------------------------- - ! 2D - !----------------------------------------------------------------- - - dimid3(1) = imtid - dimid3(2) = jmtid - dimid3(3) = timid - - do n=1,num_avail_hist_fields_2D - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimid3, varid) - status = pio_put_att(File,varid,'units', & - trim(avail_hist_fields(n)%vunit)) - status = pio_put_att(File,varid, 'long_name', & - trim(avail_hist_fields(n)%vdesc)) - status = pio_put_att(File,varid,'coordinates', & - trim(avail_hist_fields(n)%vcoord)) - status = pio_put_att(File,varid,'cell_measures', & - trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) - - ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then - if (TRIM(avail_hist_fields(n)%vname)/='sig1' & - .or.TRIM(avail_hist_fields(n)%vname)/='sig2' & - .or.TRIM(avail_hist_fields(n)%vname)/='sistreave' & - .or.TRIM(avail_hist_fields(n)%vname)/='sistremax' & - .or.TRIM(avail_hist_fields(n)%vname)/='sigP') then - status = pio_put_att(File,varid,'cell_methods','time: mean') - endif - endif - - if (histfreq(ns) == '1' .or. .not. hist_avg & - .or. n==n_divu(ns) .or. n==n_shear(ns) & ! snapshots - .or. n==n_sig1(ns) .or. n==n_sig2(ns) & - .or. n==n_sigP(ns) .or. n==n_trsig(ns) & - .or. n==n_sistreave(ns) .or. n==n_sistremax(ns) & - .or. n==n_mlt_onset(ns) .or. n==n_frz_onset(ns) & - .or. n==n_hisnap(ns) .or. n==n_aisnap(ns)) then - status = pio_put_att(File,varid,'time_rep','instantaneous') - else - status = pio_put_att(File,varid,'time_rep','averaged') - endif - endif - enddo ! num_avail_hist_fields_2D - - !----------------------------------------------------------------- - ! 3D (category) - !----------------------------------------------------------------- - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = cmtid - dimidz(4) = timid - - do n = n2D + 1, n3Dccum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) - status = pio_put_att(File,varid,'units', & - trim(avail_hist_fields(n)%vunit)) - status = pio_put_att(File,varid, 'long_name', & - trim(avail_hist_fields(n)%vdesc)) - status = pio_put_att(File,varid,'coordinates', & - trim(avail_hist_fields(n)%vcoord)) - status = pio_put_att(File,varid,'cell_measures', & - trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) - - ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then - status = pio_put_att(File,varid,'cell_methods','time: mean') - endif - - if (histfreq(ns) == '1' .or. .not. hist_avg) then - status = pio_put_att(File,varid,'time_rep','instantaneous') - else - status = pio_put_att(File,varid,'time_rep','averaged') - endif - endif - enddo ! num_avail_hist_fields_3Dc - - !----------------------------------------------------------------- - ! 3D (ice layers) - !----------------------------------------------------------------- - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtidi - dimidz(4) = timid - - do n = n3Dccum + 1, n3Dzcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) - status = pio_put_att(File,varid,'units', & - trim(avail_hist_fields(n)%vunit)) - status = pio_put_att(File,varid, 'long_name', & - trim(avail_hist_fields(n)%vdesc)) - status = pio_put_att(File,varid,'coordinates', & - trim(avail_hist_fields(n)%vcoord)) - status = pio_put_att(File,varid,'cell_measures', & - trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) - - ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then - status = pio_put_att(File,varid,'cell_methods','time: mean') - endif - - if (histfreq(ns) == '1' .or. .not. hist_avg) then - status = pio_put_att(File,varid,'time_rep','instantaneous') - else - status = pio_put_att(File,varid,'time_rep','averaged') - endif - endif - enddo ! num_avail_hist_fields_3Dz - - !----------------------------------------------------------------- - ! 3D (biology ice layers) - !----------------------------------------------------------------- - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtidb - dimidz(4) = timid - - do n = n3Dzcum + 1, n3Dbcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) - status = pio_put_att(File,varid,'units', & - trim(avail_hist_fields(n)%vunit)) - status = pio_put_att(File,varid, 'long_name', & - trim(avail_hist_fields(n)%vdesc)) - status = pio_put_att(File,varid,'coordinates', & - trim(avail_hist_fields(n)%vcoord)) - status = pio_put_att(File,varid,'cell_measures', & - trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) - - ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then - status = pio_put_att(File,varid,'cell_methods','time: mean') - endif - - if (histfreq(ns) == '1' .or. .not. hist_avg) then - status = pio_put_att(File,varid,'time_rep','instantaneous') - else - status = pio_put_att(File,varid,'time_rep','averaged') - endif - endif - enddo ! num_avail_hist_fields_3Db - - !----------------------------------------------------------------- - ! 3D (biology snow layers) - !----------------------------------------------------------------- - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtida - dimidz(4) = timid - - do n = n3Dbcum + 1, n3Dacum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) - status = pio_put_att(File,varid,'units', & - trim(avail_hist_fields(n)%vunit)) - status = pio_put_att(File,varid, 'long_name', & - trim(avail_hist_fields(n)%vdesc)) - status = pio_put_att(File,varid,'coordinates', & - trim(avail_hist_fields(n)%vcoord)) - status = pio_put_att(File,varid,'cell_measures', & - trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) - - ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then - status = pio_put_att(File,varid,'cell_methods','time: mean') - endif - - if (histfreq(ns) == '1' .or. .not. hist_avg) then - status = pio_put_att(File,varid,'time_rep','instantaneous') - else - status = pio_put_att(File,varid,'time_rep','averaged') - endif - endif - enddo ! num_avail_hist_fields_3Da - - !----------------------------------------------------------------- - ! 3D (fsd) - !----------------------------------------------------------------- - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = fmtid - dimidz(4) = timid - - do n = n3Dacum + 1, n3Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) - status = pio_put_att(File,varid,'units', & - trim(avail_hist_fields(n)%vunit)) - status = pio_put_att(File,varid, 'long_name', & - trim(avail_hist_fields(n)%vdesc)) - status = pio_put_att(File,varid,'coordinates', & - trim(avail_hist_fields(n)%vcoord)) - status = pio_put_att(File,varid,'cell_measures', & - trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) - - ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then - status = pio_put_att(File,varid,'cell_methods','time: mean') - endif - - if (histfreq(ns) == '1' .or. .not. hist_avg) then - status = pio_put_att(File,varid,'time_rep','instantaneous') - else - status = pio_put_att(File,varid,'time_rep','averaged') - endif - endif - enddo ! num_avail_hist_fields_3Df - - !----------------------------------------------------------------- - ! define attributes for 4D variables - ! time coordinate is dropped - !----------------------------------------------------------------- - - !----------------------------------------------------------------- - ! 4D (ice categories) - !----------------------------------------------------------------- - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = kmtidi - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n3Dfcum + 1, n4Dicum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidcz, varid) - status = pio_put_att(File,varid,'units', & - trim(avail_hist_fields(n)%vunit)) - status = pio_put_att(File,varid, 'long_name', & - trim(avail_hist_fields(n)%vdesc)) - status = pio_put_att(File,varid,'coordinates', & - trim(avail_hist_fields(n)%vcoord)) - status = pio_put_att(File,varid,'cell_measures', & - trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) - - ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then - status = pio_put_att(File,varid,'cell_methods','time: mean') - endif - - if (histfreq(ns) == '1' .or. .not. hist_avg) then - status = pio_put_att(File,varid,'time_rep','instantaneous') - else - status = pio_put_att(File,varid,'time_rep','averaged') - endif - endif - enddo ! num_avail_hist_fields_4Di - - !----------------------------------------------------------------- - ! 4D (snow layers) - !----------------------------------------------------------------- - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = kmtids - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n4Dicum + 1, n4Dscum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidcz, varid) - status = pio_put_att(File,varid,'units', & - trim(avail_hist_fields(n)%vunit)) - status = pio_put_att(File,varid, 'long_name', & - trim(avail_hist_fields(n)%vdesc)) - status = pio_put_att(File,varid,'coordinates', & - trim(avail_hist_fields(n)%vcoord)) - status = pio_put_att(File,varid,'cell_measures', & - trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) - - ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then - status = pio_put_att(File,varid,'cell_methods','time: mean') - endif - - if (histfreq(ns) == '1' .or. .not. hist_avg) then - status = pio_put_att(File,varid,'time_rep','instantaneous') - else - status = pio_put_att(File,varid,'time_rep','averaged') - endif - endif - enddo ! num_avail_hist_fields_4Ds - - - !----------------------------------------------------------------- - ! 4D (fsd layers) - !----------------------------------------------------------------- - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = fmtid - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n4Dscum + 1, n4Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidcz, varid) - status = pio_put_att(File,varid,'units', & - trim(avail_hist_fields(n)%vunit)) - status = pio_put_att(File,varid, 'long_name', & - trim(avail_hist_fields(n)%vdesc)) - status = pio_put_att(File,varid,'coordinates', & - trim(avail_hist_fields(n)%vcoord)) - status = pio_put_att(File,varid,'cell_measures', & - trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) - - ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then - status = pio_put_att(File,varid,'cell_methods','time: mean') - endif - - if (histfreq(ns) == '1' .or. .not. hist_avg) then - status = pio_put_att(File,varid,'time_rep','instantaneous') - else - status = pio_put_att(File,varid,'time_rep','averaged') - endif - endif - enddo ! num_avail_hist_fields_4Df - - !----------------------------------------------------------------- - ! global attributes - !----------------------------------------------------------------- - ! ... the user should change these to something useful ... - !----------------------------------------------------------------- -#ifdef CESMCOUPLED - status = pio_put_att(File,pio_global,'title',runid) -#else - title = 'sea ice model output for CICE' - status = pio_put_att(File,pio_global,'title',trim(title)) -#endif - title = 'Diagnostic and Prognostic Variables' - status = pio_put_att(File,pio_global,'contents',trim(title)) - - write(title,'(2a)') 'Los Alamos Sea Ice Model, ', trim(version_name) - status = pio_put_att(File,pio_global,'source',trim(title)) - - if (use_leap_years) then - write(title,'(a,i3,a)') 'This year has ',int(dayyr),' days' - else - write(title,'(a,i3,a)') 'All years have exactly ',int(dayyr),' days' - endif - status = pio_put_att(File,pio_global,'comment',trim(title)) - - write(title,'(a,i8.8)') 'File written on model date ',idate - status = pio_put_att(File,pio_global,'comment2',trim(title)) - - write(title,'(a,i6)') 'seconds elapsed into model date: ',sec - status = pio_put_att(File,pio_global,'comment3',trim(title)) - - title = 'CF-1.0' - status = & - pio_put_att(File,pio_global,'conventions',trim(title)) - - call date_and_time(date=current_date, time=current_time) - write(start_time,1000) current_date(1:4), current_date(5:6), & - current_date(7:8), current_time(1:2), & - current_time(3:4) -1000 format('This dataset was created on ', & - a,'-',a,'-',a,' at ',a,':',a) - status = pio_put_att(File,pio_global,'history',trim(start_time)) - - status = pio_put_att(File,pio_global,'io_flavor','io_pio') - - !----------------------------------------------------------------- - ! end define mode - !----------------------------------------------------------------- - - status = pio_enddef(File) - - !----------------------------------------------------------------- - ! write time variable - !----------------------------------------------------------------- - - status = pio_inq_varid(File,'time',varid) -!sgl status = pio_put_var(File,varid,(/1/),ltime) - status = pio_put_var(File,varid,(/1/),ltime2) - - !----------------------------------------------------------------- - ! write time_bounds info - !----------------------------------------------------------------- - - if (hist_avg .and. histfreq(ns) /= '1') then - status = pio_inq_varid(File,'time_bounds',varid) - time_bounds=(/time_beg(ns),time_end(ns)/) - bnd_start = (/1,1/) - bnd_length = (/2,1/) - status = pio_put_var(File,varid,ival=time_bounds, & - start=bnd_start(:),count=bnd_length(:)) - endif - - !----------------------------------------------------------------- - ! write coordinate variables - !----------------------------------------------------------------- - - allocate(workr2(nx_block,ny_block,nblocks)) - - do i = 1,ncoord - status = pio_inq_varid(File, coord_var(i)%short_name, varid) - SELECT CASE (coord_var(i)%short_name) - CASE ('TLON') - ! Convert T grid longitude from -180 -> 180 to 0 to 360 - workr2(:,:,:) = mod(tlon(:,:,1:nblocks)*rad_to_deg + c360, c360) - CASE ('TLAT') - workr2(:,:,:) = tlat(:,:,1:nblocks)*rad_to_deg - CASE ('ULON') - workr2(:,:,:) = ulon(:,:,1:nblocks)*rad_to_deg - CASE ('ULAT') - workr2(:,:,:) = ulat(:,:,1:nblocks)*rad_to_deg - END SELECT - call pio_write_darray(File, varid, iodesc2d, & - workr2, status, fillval=spval_dbl) - enddo - - ! Extra dimensions (NCAT, NFSD, VGRD*) - - do i = 1, nvarz - if (igrdz(i)) then - status = pio_inq_varid(File, var_nz(i)%short_name, varid) - SELECT CASE (var_nz(i)%short_name) - CASE ('NCAT') - status = pio_put_var(File, varid, hin_max(1:ncat_hist)) - CASE ('NFSD') - status = pio_put_var(File, varid, floe_rad_c(1:nfsd_hist)) - CASE ('VGRDi') - status = pio_put_var(File, varid, (/(k, k=1,nzilyr)/)) - CASE ('VGRDs') - status = pio_put_var(File, varid, (/(k, k=1,nzslyr)/)) - CASE ('VGRDb') - status = pio_put_var(File, varid, (/(k, k=1,nzblyr)/)) - CASE ('VGRDa') - status = pio_put_var(File, varid, (/(k, k=1,nzalyr)/)) - END SELECT - endif - enddo - - !----------------------------------------------------------------- - ! write grid masks, area and rotation angle - !----------------------------------------------------------------- - -! if (igrd(n_tmask)) then -! status = pio_inq_varid(File, 'tmask', varid) -! call pio_write_darray(File, varid, iodesc2d, & -! hm(:,:,1:nblocks), status, fillval=spval_dbl) -! endif -! if (igrd(n_blkmask)) then -! status = pio_inq_varid(File, 'blkmask', varid) -! call pio_write_darray(File, varid, iodesc2d, & -! bm(:,:,1:nblocks), status, fillval=spval_dbl) -! endif - - do i = 1, nvar ! note: n_tmask=1, n_blkmask=2 - if (igrd(i)) then - SELECT CASE (var(i)%req%short_name) - CASE ('tmask') - workr2 = hm(:,:,1:nblocks) - CASE ('blkmask') - workr2 = bm(:,:,1:nblocks) - CASE ('tarea') - workr2 = tarea(:,:,1:nblocks) - CASE ('uarea') - workr2 = uarea(:,:,1:nblocks) - CASE ('dxu') - workr2 = dxu(:,:,1:nblocks) - CASE ('dyu') - workr2 = dyu(:,:,1:nblocks) - CASE ('dxt') - workr2 = dxt(:,:,1:nblocks) - CASE ('dyt') - workr2 = dyt(:,:,1:nblocks) - CASE ('HTN') - workr2 = HTN(:,:,1:nblocks) - CASE ('HTE') - workr2 = HTE(:,:,1:nblocks) - CASE ('ANGLE') - workr2 = ANGLE(:,:,1:nblocks) - CASE ('ANGLET') - workr2 = ANGLET(:,:,1:nblocks) - END SELECT - status = pio_inq_varid(File, var(i)%req%short_name, varid) - call pio_write_darray(File, varid, iodesc2d, & - workr2, status, fillval=spval_dbl) - endif - enddo - - !---------------------------------------------------------------- - ! Write coordinates of grid box vertices - !---------------------------------------------------------------- - - if (f_bounds) then - allocate(workr3v(nverts,nx_block,ny_block,nblocks)) - workr3v (:,:,:,:) = c0 - do i = 1, nvar_verts - SELECT CASE (var_nverts(i)%short_name) - CASE ('lont_bounds') - do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = lont_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('latt_bounds') - do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = latt_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('lonu_bounds') - do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = lonu_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('latu_bounds') - do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = latu_bounds(ivertex,:,:,1:nblocks) - enddo - END SELECT - - status = pio_inq_varid(File, var_nverts(i)%short_name, varid) - call pio_write_darray(File, varid, iodesc3dv, & - workr3v, status, fillval=spval_dbl) - enddo - deallocate(workr3v) - endif ! f_bounds - - - !----------------------------------------------------------------- - ! write variable data - !----------------------------------------------------------------- - - ! 2D - do n=1,num_avail_hist_fields_2D - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR getting varid for '//avail_hist_fields(n)%vname) - workr2(:,:,:) = a2D(:,:,n,1:nblocks) - call pio_setframe(varid, int(1,kind=PIO_OFFSET)) - call pio_write_darray(File, varid, iodesc2d,& - workr2, status, fillval=spval_dbl) - endif - enddo ! num_avail_hist_fields_2D - - deallocate(workr2) - - ! 3D (category) - allocate(workr3(nx_block,ny_block,nblocks,ncat_hist)) - do n = n2D + 1, n3Dccum - nn = n - n2D - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - do j = 1, nblocks - do i = 1, ncat_hist - workr3(:,:,j,i) = a3Dc(:,:,i,nn,j) - enddo - enddo - call pio_setframe(varid, int(1,kind=PIO_OFFSET)) - call pio_write_darray(File, varid, iodesc3dc,& - workr3, status, fillval=spval_dbl) - endif - enddo ! num_avail_hist_fields_3Dc - deallocate(workr3) - - ! 3D (vertical ice) - allocate(workr3(nx_block,ny_block,nblocks,nzilyr)) - do n = n3Dccum+1, n3Dzcum - nn = n - n3Dccum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - do j = 1, nblocks - do i = 1, nzilyr - workr3(:,:,j,i) = a3Dz(:,:,i,nn,j) - enddo - enddo - call pio_setframe(varid, int(1,kind=PIO_OFFSET)) - call pio_write_darray(File, varid, iodesc3di,& - workr3, status, fillval=spval_dbl) - endif - enddo ! num_avail_hist_fields_3Dz - deallocate(workr3) - - ! 3D (vertical ice biology) - allocate(workr3(nx_block,ny_block,nblocks,nzblyr)) - do n = n3Dzcum+1, n3Dbcum - nn = n - n3Dzcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - do j = 1, nblocks - do i = 1, nzblyr - workr3(:,:,j,i) = a3Db(:,:,i,nn,j) - enddo - enddo - call pio_setframe(varid, int(1,kind=PIO_OFFSET)) - call pio_write_darray(File, varid, iodesc3db,& - workr3, status, fillval=spval_dbl) - endif - enddo ! num_avail_hist_fields_3Db - deallocate(workr3) - - ! 3D (vertical snow biology) - allocate(workr3(nx_block,ny_block,nblocks,nzalyr)) - do n = n3Dbcum+1, n3Dacum - nn = n - n3Dbcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - do j = 1, nblocks - do i = 1, nzalyr - workr3(:,:,j,i) = a3Da(:,:,i,nn,j) - enddo - enddo - call pio_setframe(varid, int(1,kind=PIO_OFFSET)) -! call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) - call pio_write_darray(File, varid, iodesc3da,& - workr3, status, fillval=spval_dbl) - endif - enddo ! num_avail_hist_fields_3Db - deallocate(workr3) - - ! 3D (fsd) - allocate(workr3(nx_block,ny_block,nblocks,nfsd_hist)) - do n = n3Dacum+1, n3Dfcum - nn = n - n3Dacum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - do j = 1, nblocks - do i = 1, nfsd_hist - workr3(:,:,j,i) = a3Df(:,:,i,nn,j) - enddo - enddo - call pio_setframe(varid, int(1,kind=PIO_OFFSET)) -! call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) - call pio_write_darray(File, varid, iodesc3df,& - workr3, status, fillval=spval_dbl) - endif - enddo ! num_avail_hist_fields_3Df - deallocate(workr3) - - allocate(workr4(nx_block,ny_block,nblocks,ncat_hist,nzilyr)) - ! 4D (categories, fsd) - do n = n3Dfcum+1, n4Dicum - nn = n - n3Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - do j = 1, nblocks - do i = 1, ncat_hist - do k = 1, nzilyr - workr4(:,:,j,i,k) = a4Di(:,:,k,i,nn,j) - enddo ! k - enddo ! i - enddo ! j - call pio_setframe(varid, int(1,kind=PIO_OFFSET)) - call pio_write_darray(File, varid, iodesc4di,& - workr4, status, fillval=spval_dbl) - endif - enddo ! num_avail_hist_fields_4Di - deallocate(workr4) - - allocate(workr4(nx_block,ny_block,nblocks,ncat_hist,nzslyr)) - ! 4D (categories, vertical ice) - do n = n4Dicum+1, n4Dscum - nn = n - n4Dicum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - do j = 1, nblocks - do i = 1, ncat_hist - do k = 1, nzslyr - workr4(:,:,j,i,k) = a4Ds(:,:,k,i,nn,j) - enddo ! k - enddo ! i - enddo ! j - call pio_setframe(varid, int(1,kind=PIO_OFFSET)) -! call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) - call pio_write_darray(File, varid, iodesc4ds,& - workr4, status, fillval=spval_dbl) - endif - enddo ! num_avail_hist_fields_4Di - deallocate(workr4) - - allocate(workr4(nx_block,ny_block,nblocks,ncat_hist,nfsd_hist)) - ! 4D (categories, vertical ice) - do n = n4Dscum+1, n4Dfcum - nn = n - n4Dscum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - do j = 1, nblocks - do i = 1, ncat_hist - do k = 1, nfsd_hist - workr4(:,:,j,i,k) = a4Ds(:,:,k,i,nn,j) - enddo ! k - enddo ! i - enddo ! j - call pio_setframe(varid, int(1,kind=PIO_OFFSET)) -! call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) - call pio_write_darray(File, varid, iodesc4df,& - workr4, status, fillval=spval_dbl) - endif - enddo ! num_avail_hist_fields_4Di - deallocate(workr4) - -! similarly for num_avail_hist_fields_4Db (define workr4b, iodesc4db) - - - !----------------------------------------------------------------- - ! clean-up PIO descriptors - !----------------------------------------------------------------- - - call pio_freedecomp(File,iodesc2d) - call pio_freedecomp(File,iodesc3dv) - call pio_freedecomp(File,iodesc3dc) - call pio_freedecomp(File,iodesc3di) - call pio_freedecomp(File,iodesc3db) - call pio_freedecomp(File,iodesc3da) - call pio_freedecomp(File,iodesc3df) - call pio_freedecomp(File,iodesc4di) - call pio_freedecomp(File,iodesc4ds) - call pio_freedecomp(File,iodesc4df) - - !----------------------------------------------------------------- - ! close output dataset - !----------------------------------------------------------------- - - call pio_closefile(File) - if (my_task == master_task) then - write(nu_diag,*) ' ' - write(nu_diag,*) 'Finished writing ',trim(ncfile(ns)) - endif - -#endif - - end subroutine ice_write_hist - -!======================================================================= - - end module ice_history_write - -!======================================================================= diff --git a/cicecore/cicedynB/infrastructure/io/io_pio/ice_pio.F90 b/cicecore/cicedynB/infrastructure/io/io_pio/ice_pio.F90 deleted file mode 100644 index 5fff64944..000000000 --- a/cicecore/cicedynB/infrastructure/io/io_pio/ice_pio.F90 +++ /dev/null @@ -1,365 +0,0 @@ -!============================================================================ -! Writes netcdf files -! Created by Mariana Vertenstein, June 2009 - - module ice_pio - - use shr_kind_mod, only: r8 => shr_kind_r8, in=>shr_kind_in - use shr_kind_mod, only: cl => shr_kind_cl - use shr_sys_mod , only: shr_sys_flush - use ice_kinds_mod - use ice_blocks - use ice_broadcast - use ice_communicate - use ice_domain, only : nblocks, blocks_ice - use ice_domain_size - use ice_fileunits - use ice_exit, only: abort_ice - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use pio - - implicit none - private - - interface ice_pio_initdecomp - module procedure ice_pio_initdecomp_2d - module procedure ice_pio_initdecomp_3d - module procedure ice_pio_initdecomp_4d - module procedure ice_pio_initdecomp_3d_inner - end interface - - public ice_pio_init - public ice_pio_initdecomp - - type(iosystem_desc_t), pointer, public :: ice_pio_subsystem - -!=============================================================================== - - contains - -!=============================================================================== - -! Initialize the io subsystem -! 2009-Feb-17 - J. Edwards - initial version - - subroutine ice_pio_init(mode, filename, File, clobber, cdf64) - - use shr_pio_mod, only: shr_pio_getiosys, shr_pio_getiotype - - implicit none - character(len=*) , intent(in), optional :: mode - character(len=*) , intent(in), optional :: filename - type(file_desc_t) , intent(inout), optional :: File - logical , intent(in), optional :: clobber - logical , intent(in), optional :: cdf64 - - ! local variables - - integer (int_kind) :: & - nml_error ! namelist read error flag - - integer :: pio_iotype - logical :: exists - logical :: lclobber - logical :: lcdf64 - integer :: status - integer :: nmode - character(len=*), parameter :: subname = '(ice_pio_init)' - logical, save :: first_call = .true. - - ice_pio_subsystem => shr_pio_getiosys(inst_name) - pio_iotype = shr_pio_getiotype(inst_name) - - if (present(mode) .and. present(filename) .and. present(File)) then - - if (trim(mode) == 'write') then - lclobber = .false. - if (present(clobber)) lclobber=clobber - - lcdf64 = .false. - if (present(cdf64)) lcdf64=cdf64 - - if (File%fh<0) then - ! filename not open - inquire(file=trim(filename),exist=exists) - if (exists) then - if (lclobber) then - nmode = pio_clobber - if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) - status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) - if (my_task == master_task) then - write(nu_diag,*) subname,' create file ',trim(filename) - end if - else - nmode = pio_write - status = pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) - if (my_task == master_task) then - write(nu_diag,*) subname,' open file ',trim(filename) - end if - endif - else - nmode = pio_noclobber - if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) - status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) - if (my_task == master_task) then - write(nu_diag,*) subname,' create file ',trim(filename) - end if - endif - else - ! filename is already open, just return - endif - end if - - if (trim(mode) == 'read') then - inquire(file=trim(filename),exist=exists) - if (exists) then - status = pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), pio_nowrite) - else - if(my_task==master_task) then - write(nu_diag,*) 'ice_pio_ropen ERROR: file invalid ',trim(filename) - end if - call abort_ice(subname//'ERROR: aborting with invalid file') - endif - end if - - end if - - end subroutine ice_pio_init - -!================================================================================ - - subroutine ice_pio_initdecomp_2d(iodesc) - - type(io_desc_t), intent(out) :: iodesc - - integer (kind=int_kind) :: & - iblk,ilo,ihi,jlo,jhi,lon,lat,i,j,n,k - - type(block) :: this_block - - integer(kind=int_kind), pointer :: dof2d(:) - character(len=*), parameter :: subname = '(ice_pio_initdecomp_2d)' - - allocate(dof2d(nx_block*ny_block*nblocks)) - - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j=1,ny_block - do i=1,nx_block - n = n+1 - if (j < jlo .or. j>jhi) then - dof2d(n) = 0 - else if (i < ilo .or. i > ihi) then - dof2d(n) = 0 - else - lon = this_block%i_glob(i) - lat = this_block%j_glob(j) - dof2d(n) = (lat-1)*nx_global + lon - endif - enddo !i - enddo !j - end do - - call pio_initdecomp(ice_pio_subsystem, pio_double, (/nx_global,ny_global/), & - dof2d, iodesc) - - deallocate(dof2d) - - end subroutine ice_pio_initdecomp_2d - -!================================================================================ - - subroutine ice_pio_initdecomp_3d (ndim3, iodesc, remap) - - integer(kind=int_kind), intent(in) :: ndim3 - type(io_desc_t), intent(out) :: iodesc - logical, optional :: remap - integer (kind=int_kind) :: & - iblk,ilo,ihi,jlo,jhi,lon,lat,i,j,n,k - - type(block) :: this_block - logical :: lremap - integer(kind=int_kind), pointer :: dof3d(:) - character(len=*), parameter :: subname = '(ice_pio_initdecomp_2d)' - - allocate(dof3d(nx_block*ny_block*nblocks*ndim3)) - lremap=.false. - if (present(remap)) lremap=remap - if (lremap) then - ! Reorder the ndim3 and nblocks loops to avoid a temporary array in restart read/write - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do k=1,ndim3 - do j=1,ny_block - do i=1,nx_block - n = n+1 - if (j < jlo .or. j>jhi) then - dof3d(n)=0 - else if (i < ilo .or. i > ihi) then - dof3d(n) = 0 - else - lon = this_block%i_glob(i) - lat = this_block%j_glob(j) - dof3d(n) = ((lat-1)*nx_global + lon) + (k-1)*nx_global*ny_global - endif - enddo !i - enddo !j - enddo !ndim3 - enddo ! iblk - else - n=0 - do k=1,ndim3 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j=1,ny_block - do i=1,nx_block - n = n+1 - if (j < jlo .or. j>jhi) then - dof3d(n)=0 - else if (i < ilo .or. i > ihi) then - dof3d(n) = 0 - else - lon = this_block%i_glob(i) - lat = this_block%j_glob(j) - dof3d(n) = ((lat-1)*nx_global + lon) + (k-1)*nx_global*ny_global - endif - enddo !i - enddo !j - enddo ! iblk - enddo !ndim3 - endif - - call pio_initdecomp(ice_pio_subsystem, pio_double, (/nx_global,ny_global,ndim3/), & - dof3d, iodesc) - - deallocate(dof3d) - - end subroutine ice_pio_initdecomp_3d - -!================================================================================ - - subroutine ice_pio_initdecomp_3d_inner(ndim3, inner_dim, iodesc) - - integer(kind=int_kind), intent(in) :: ndim3 - logical, intent(in) :: inner_dim - type(io_desc_t), intent(out) :: iodesc - - integer (kind=int_kind) :: & - iblk,ilo,ihi,jlo,jhi,lon,lat,i,j,n,k - - type(block) :: this_block - - integer(kind=int_kind), pointer :: dof3d(:) - - character(len=*), parameter :: subname = '(ice_pio_initdecomp_3d_inner)' - - allocate(dof3d(nx_block*ny_block*nblocks*ndim3)) - - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j=1,ny_block - do i=1,nx_block - do k=1,ndim3 - n = n+1 - if (j < jlo .or. j>jhi) then - dof3d(n) = 0 - else if (i < ilo .or. i > ihi) then - dof3d(n) = 0 - else - lon = this_block%i_glob(i) - lat = this_block%j_glob(j) - dof3d(n) = k + ((lon-1) + (lat-1)*nx_global)*ndim3 - endif - end do !ndim3 - enddo !i - enddo !j - end do !iblk - - call pio_initdecomp(ice_pio_subsystem, pio_double, (/ndim3,nx_global,ny_global/), & - dof3d, iodesc) - - deallocate(dof3d) - - end subroutine ice_pio_initdecomp_3d_inner - -!================================================================================ - - subroutine ice_pio_initdecomp_4d (ndim3, ndim4, iodesc) - - integer(kind=int_kind), intent(in) :: ndim3, ndim4 - type(io_desc_t), intent(out) :: iodesc - - integer (kind=int_kind) :: & - iblk,ilo,ihi,jlo,jhi,lon,lat,i,j,n,k,l - - type(block) :: this_block - - integer(kind=int_kind), pointer :: dof4d(:) - - character(len=*), parameter :: subname = '(ice_pio_initdecomp_4d)' - - allocate(dof4d(nx_block*ny_block*nblocks*ndim3*ndim4)) - - n=0 - do l=1,ndim4 - do k=1,ndim3 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j=1,ny_block - do i=1,nx_block - n = n+1 - if (j < jlo .or. j>jhi) then - dof4d(n)=0 - else if (i < ilo .or. i > ihi) then - dof4d(n) = 0 - else - lon = this_block%i_glob(i) - lat = this_block%j_glob(j) - dof4d(n) = ((lat-1)*nx_global + lon) & - + (k-1)*nx_global*ny_global & - + (l-1)*nx_global*ny_global*ndim3 - endif - enddo !i - enddo !j - enddo ! iblk - enddo !ndim3 - enddo !ndim4 - - call pio_initdecomp(ice_pio_subsystem, pio_double, & - (/nx_global,ny_global,ndim3,ndim4/), dof4d, iodesc) - - deallocate(dof4d) - - end subroutine ice_pio_initdecomp_4d - -!================================================================================ - - end module ice_pio - -!================================================================================ diff --git a/cicecore/cicedynB/infrastructure/io/io_pio/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio/ice_restart.F90 deleted file mode 100644 index c207d5b25..000000000 --- a/cicecore/cicedynB/infrastructure/io/io_pio/ice_restart.F90 +++ /dev/null @@ -1,891 +0,0 @@ -!======================================================================= -! -! Read and write ice model restart files using pio interfaces. -! authors David A Bailey, NCAR - - module ice_restart - - use ice_broadcast - use ice_exit, only: abort_ice - use ice_fileunits, only: nu_diag, nu_restart, nu_rst_pointer - use ice_kinds_mod - use ice_restart_shared, only: & - restart, restart_ext, restart_dir, restart_file, pointer_file, & - runid, runtype, use_restart_time, restart_format, lcdf64, lenstr - use ice_pio - use pio - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_indices - use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_sizes - - implicit none - private - public :: init_restart_write, init_restart_read, & - read_restart_field, write_restart_field, final_restart - - type(file_desc_t) :: File - type(var_desc_t) :: vardesc - - type(io_desc_t) :: iodesc2d - type(io_desc_t) :: iodesc3d_ncat - -!======================================================================= - - contains - -!======================================================================= - -! Sets up restart file for reading. -! author David A Bailey, NCAR - - subroutine init_restart_read(ice_ic) - - use ice_calendar, only: istep0, istep1, time, time_forc, nyr, month, & - mday, sec, npt - use ice_communicate, only: my_task, master_task - use ice_domain_size, only: ncat - use ice_read_write, only: ice_open - - character(len=char_len_long), intent(in), optional :: ice_ic - - ! local variables - - character(len=char_len_long) :: & - filename, filename0 - - integer (kind=int_kind) :: status - - character(len=*), parameter :: subname = '(init_restart_read)' - - if (present(ice_ic)) then - filename = trim(ice_ic) - else - if (my_task == master_task) then - open(nu_rst_pointer,file=pointer_file) - read(nu_rst_pointer,'(a)') filename0 - filename = trim(filename0) - close(nu_rst_pointer) - write(nu_diag,*) 'Read ',pointer_file(1:lenstr(pointer_file)) - endif - call broadcast_scalar(filename, master_task) - endif - - if (my_task == master_task) then - write(nu_diag,*) 'Using restart dump=', trim(filename) - end if - - if (restart_format == 'pio') then - File%fh=-1 - call ice_pio_init(mode='read', filename=trim(filename), File=File) - - call ice_pio_initdecomp(iodesc=iodesc2d) - call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true.) - - if (use_restart_time) then - status = pio_get_att(File, pio_global, 'istep1', istep0) - status = pio_get_att(File, pio_global, 'time', time) - status = pio_get_att(File, pio_global, 'time_forc', time_forc) - call pio_seterrorhandling(File, PIO_BCAST_ERROR) - status = pio_get_att(File, pio_global, 'nyr', nyr) - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) - if (status == PIO_noerr) then - status = pio_get_att(File, pio_global, 'month', month) - status = pio_get_att(File, pio_global, 'mday', mday) - status = pio_get_att(File, pio_global, 'sec', sec) - endif - endif ! use namelist values if use_restart_time = F - endif - - if (my_task == master_task) then - write(nu_diag,*) 'Restart read at istep=',istep0,time,time_forc - endif - - call broadcast_scalar(istep0,master_task) - call broadcast_scalar(time,master_task) - call broadcast_scalar(time_forc,master_task) - call broadcast_scalar(nyr,master_task) - - istep1 = istep0 - - ! if runid is bering then need to correct npt for istep0 - if (trim(runid) == 'bering') then - npt = npt - istep0 - endif - - end subroutine init_restart_read - -!======================================================================= - -! Sets up restart file for writing. -! author David A Bailey, NCAR - - subroutine init_restart_write(filename_spec) - - use ice_calendar, only: sec, month, mday, nyr, istep1, & - time, time_forc, year_init - use ice_communicate, only: my_task, master_task - use ice_domain_size, only: nx_global, ny_global, ncat, nilyr, nslyr, & - n_iso, n_aero, nblyr, n_zaero, n_algae, n_doc, & - n_dic, n_don, n_fed, n_fep, nfsd - use ice_dyn_shared, only: kdyn - use ice_arrays_column, only: oceanmixed_ice - - logical (kind=log_kind) :: & - solve_zsal, skl_bgc, z_tracers - - logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine, & - tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & - tr_bgc_Sil, tr_bgc_DMS, & - tr_bgc_chl, tr_bgc_Am, & - tr_bgc_PON, tr_bgc_DON, & - tr_zaero, tr_bgc_Fe, & - tr_bgc_hum, tr_fsd - - integer (kind=int_kind) :: & - nbtrcr - - character(len=char_len_long), intent(in), optional :: filename_spec - - ! local variables - - integer (kind=int_kind) :: & - iyear, imonth, iday ! year, month, day - - character(len=char_len_long) :: filename - - integer (kind=int_kind) :: dimid_ni, dimid_nj, dimid_ncat, & - dimid_nilyr, dimid_nslyr, dimid_naero - - integer (kind=int_kind), allocatable :: dims(:) - - integer (kind=int_kind) :: & - k, n, & ! loop index - status ! status variable from netCDF routine - - character (len=3) :: nchar, ncharb - - character(len=*), parameter :: subname = '(init_restart_write)' - - call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) - call icepack_query_tracer_flags( & - tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & - tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, tr_brine_out=tr_brine, & - tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, tr_bgc_Nit_out=tr_bgc_Nit, & - tr_bgc_Sil_out=tr_bgc_Sil, tr_bgc_DMS_out=tr_bgc_DMS, & - tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & - tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & - tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & - tr_bgc_hum_out=tr_bgc_hum, tr_fsd_out=tr_fsd) - call icepack_query_parameters(solve_zsal_out=solve_zsal, skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - ! construct path/file - if (present(filename_spec)) then - filename = trim(filename_spec) - else - iyear = nyr + year_init - 1 - imonth = month - iday = mday - - write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & - restart_dir(1:lenstr(restart_dir)), & - restart_file(1:lenstr(restart_file)),'.', & - iyear,'-',month,'-',mday,'-',sec - end if - - if (restart_format /= 'bin') filename = trim(filename) // '.nc' - - ! write pointer (path/file) - if (my_task == master_task) then - open(nu_rst_pointer,file=pointer_file) - write(nu_rst_pointer,'(a)') filename - close(nu_rst_pointer) - endif - - if (restart_format == 'pio') then - - File%fh=-1 - call ice_pio_init(mode='write',filename=trim(filename), File=File, & - clobber=.true., cdf64=lcdf64 ) - - status = pio_put_att(File,pio_global,'istep1',istep1) - status = pio_put_att(File,pio_global,'time',time) - status = pio_put_att(File,pio_global,'time_forc',time_forc) - status = pio_put_att(File,pio_global,'nyr',nyr) - status = pio_put_att(File,pio_global,'month',month) - status = pio_put_att(File,pio_global,'mday',mday) - status = pio_put_att(File,pio_global,'sec',sec) - - status = pio_def_dim(File,'ni',nx_global,dimid_ni) - status = pio_def_dim(File,'nj',ny_global,dimid_nj) - status = pio_def_dim(File,'ncat',ncat,dimid_ncat) - - !----------------------------------------------------------------- - ! 2D restart fields - !----------------------------------------------------------------- - - allocate(dims(2)) - - dims(1) = dimid_ni - dims(2) = dimid_nj - - call define_rest_field(File,'uvel',dims) - call define_rest_field(File,'vvel',dims) - -#ifdef CESMCOUPLED - call define_rest_field(File,'coszen',dims) -#endif - call define_rest_field(File,'scale_factor',dims) - call define_rest_field(File,'swvdr',dims) - call define_rest_field(File,'swvdf',dims) - call define_rest_field(File,'swidr',dims) - call define_rest_field(File,'swidf',dims) - - call define_rest_field(File,'strocnxT',dims) - call define_rest_field(File,'strocnyT',dims) - - call define_rest_field(File,'stressp_1',dims) - call define_rest_field(File,'stressp_2',dims) - call define_rest_field(File,'stressp_3',dims) - call define_rest_field(File,'stressp_4',dims) - - call define_rest_field(File,'stressm_1',dims) - call define_rest_field(File,'stressm_2',dims) - call define_rest_field(File,'stressm_3',dims) - call define_rest_field(File,'stressm_4',dims) - - call define_rest_field(File,'stress12_1',dims) - call define_rest_field(File,'stress12_2',dims) - call define_rest_field(File,'stress12_3',dims) - call define_rest_field(File,'stress12_4',dims) - - call define_rest_field(File,'iceumask',dims) - - if (oceanmixed_ice) then - call define_rest_field(File,'sst',dims) - call define_rest_field(File,'frzmlt',dims) - endif - - if (tr_FY) then - call define_rest_field(File,'frz_onset',dims) - end if - - if (kdyn == 2) then - call define_rest_field(File,'a11_1',dims) - call define_rest_field(File,'a11_2',dims) - call define_rest_field(File,'a11_3',dims) - call define_rest_field(File,'a11_4',dims) - call define_rest_field(File,'a12_1',dims) - call define_rest_field(File,'a12_2',dims) - call define_rest_field(File,'a12_3',dims) - call define_rest_field(File,'a12_4',dims) - endif - - if (tr_pond_lvl) then - call define_rest_field(File,'fsnow',dims) - endif - - if (nbtrcr > 0) then - if (tr_bgc_N) then - do k=1,n_algae - write(nchar,'(i3.3)') k - call define_rest_field(File,'algalN'//trim(nchar),dims) - enddo - endif - if (tr_bgc_C) then - do k=1,n_doc - write(nchar,'(i3.3)') k - call define_rest_field(File,'doc'//trim(nchar),dims) - enddo - do k=1,n_dic - write(nchar,'(i3.3)') k - call define_rest_field(File,'dic'//trim(nchar),dims) - enddo - endif - call define_rest_field(File,'nit' ,dims) - if (tr_bgc_Am) & - call define_rest_field(File,'amm' ,dims) - if (tr_bgc_Sil) & - call define_rest_field(File,'sil' ,dims) - if (tr_bgc_hum) & - call define_rest_field(File,'hum' ,dims) - if (tr_bgc_DMS) then - call define_rest_field(File,'dmsp' ,dims) - call define_rest_field(File,'dms' ,dims) - endif - if (tr_bgc_DON) then - do k=1,n_don - write(nchar,'(i3.3)') k - call define_rest_field(File,'don'//trim(nchar),dims) - enddo - endif - if (tr_bgc_Fe ) then - do k=1,n_fed - write(nchar,'(i3.3)') k - call define_rest_field(File,'fed'//trim(nchar),dims) - enddo - do k=1,n_fep - write(nchar,'(i3.3)') k - call define_rest_field(File,'fep'//trim(nchar),dims) - enddo - endif - if (tr_zaero) then - do k=1,n_zaero - write(nchar,'(i3.3)') k - call define_rest_field(File,'zaeros'//trim(nchar),dims) - enddo - endif - endif !nbtrcr - - if (solve_zsal) call define_rest_field(File,'sss',dims) - - deallocate(dims) - - !----------------------------------------------------------------- - ! 3D restart fields (ncat) - !----------------------------------------------------------------- - - allocate(dims(3)) - - dims(1) = dimid_ni - dims(2) = dimid_nj - dims(3) = dimid_ncat - - call define_rest_field(File,'aicen',dims) - call define_rest_field(File,'vicen',dims) - call define_rest_field(File,'vsnon',dims) - call define_rest_field(File,'Tsfcn',dims) - - if (tr_iage) then - call define_rest_field(File,'iage',dims) - end if - - if (tr_FY) then - call define_rest_field(File,'FY',dims) - end if - - if (tr_lvl) then - call define_rest_field(File,'alvl',dims) - call define_rest_field(File,'vlvl',dims) - end if - - if (tr_pond_cesm) then - call define_rest_field(File,'apnd',dims) - call define_rest_field(File,'hpnd',dims) - end if - - if (tr_pond_topo) then - call define_rest_field(File,'apnd',dims) - call define_rest_field(File,'hpnd',dims) - call define_rest_field(File,'ipnd',dims) - end if - - if (tr_pond_lvl) then - call define_rest_field(File,'apnd',dims) - call define_rest_field(File,'hpnd',dims) - call define_rest_field(File,'ipnd',dims) - call define_rest_field(File,'dhs',dims) - call define_rest_field(File,'ffrac',dims) - end if - - if (tr_brine) then - call define_rest_field(File,'fbrn',dims) - call define_rest_field(File,'first_ice',dims) - endif - - if (skl_bgc) then - do k = 1, n_algae - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_N'//trim(nchar) ,dims) - enddo - if (tr_bgc_C) then - ! do k = 1, n_algae - ! write(nchar,'(i3.3)') k - ! call define_rest_field(File,'bgc_C'//trim(nchar) ,dims) - ! enddo - do k = 1, n_doc - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DOC'//trim(nchar) ,dims) - enddo - do k = 1, n_dic - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DIC'//trim(nchar) ,dims) - enddo - endif - if (tr_bgc_chl) then - do k = 1, n_algae - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_chl'//trim(nchar) ,dims) - enddo - endif - call define_rest_field(File,'bgc_Nit' ,dims) - if (tr_bgc_Am) & - call define_rest_field(File,'bgc_Am' ,dims) - if (tr_bgc_Sil) & - call define_rest_field(File,'bgc_Sil' ,dims) - if (tr_bgc_hum) & - call define_rest_field(File,'bgc_hum' ,dims) - if (tr_bgc_DMS) then - call define_rest_field(File,'bgc_DMSPp',dims) - call define_rest_field(File,'bgc_DMSPd',dims) - call define_rest_field(File,'bgc_DMS' ,dims) - endif - if (tr_bgc_PON) & - call define_rest_field(File,'bgc_PON' ,dims) - if (tr_bgc_DON) then - do k = 1, n_don - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DON'//trim(nchar) ,dims) - enddo - endif - if (tr_bgc_Fe ) then - do k = 1, n_fed - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fed'//trim(nchar) ,dims) - enddo - do k = 1, n_fep - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fep'//trim(nchar) ,dims) - enddo - endif - endif !skl_bgc - if (solve_zsal) & - call define_rest_field(File,'Rayleigh',dims) - - !----------------------------------------------------------------- - ! 4D restart fields, written as layers of 3D - !----------------------------------------------------------------- - - do k=1,nilyr - write(nchar,'(i3.3)') k - call define_rest_field(File,'sice'//trim(nchar),dims) - call define_rest_field(File,'qice'//trim(nchar),dims) - enddo - - do k=1,nslyr - write(nchar,'(i3.3)') k - call define_rest_field(File,'qsno'//trim(nchar),dims) - enddo - - if (tr_fsd) then - do k=1,nfsd - write(nchar,'(i3.3)') k - call define_rest_field(File,'fsd'//trim(nchar),dims) - enddo - endif - - if (tr_iso) then - do k=1,n_iso - write(nchar,'(i3.3)') k - call define_rest_field(File,'isosno'//nchar, dims) - call define_rest_field(File,'isoice'//nchar, dims) - enddo - endif - - if (tr_aero) then - do k=1,n_aero - write(nchar,'(i3.3)') k - call define_rest_field(File,'aerosnossl'//nchar, dims) - call define_rest_field(File,'aerosnoint'//nchar, dims) - call define_rest_field(File,'aeroicessl'//nchar, dims) - call define_rest_field(File,'aeroiceint'//nchar, dims) - enddo - endif - - if (solve_zsal) then - do k = 1, nblyr - write(nchar,'(i3.3)') k - call define_rest_field(File,'zSalinity'//trim(nchar),dims) - enddo - endif - if (z_tracers) then - if (tr_zaero) then - do n = 1, n_zaero - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'zaero'//trim(ncharb)//trim(nchar),dims) - enddo !k - enddo !n - endif !tr_zaero - if (tr_bgc_Nit) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Nit'//trim(nchar),dims) - enddo - endif - if (tr_bgc_N) then - do n = 1, n_algae - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_N'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_C) then - ! do n = 1, n_algae - ! write(ncharb,'(i3.3)') n - ! do k = 1, nblyr+3 - ! write(nchar,'(i3.3)') k - ! call - ! define_rest_field(File,'bgc_C'//trim(ncharb)//trim(nchar),dims) - ! enddo - ! enddo - do n = 1, n_doc - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DOC'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - do n = 1, n_dic - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DIC'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_chl) then - do n = 1, n_algae - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_chl'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_Am) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Am'//trim(nchar),dims) - enddo - endif - if (tr_bgc_Sil) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Sil'//trim(nchar),dims) - enddo - endif - if (tr_bgc_hum) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_hum'//trim(nchar),dims) - enddo - endif - if (tr_bgc_DMS) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DMSPp'//trim(nchar),dims) - call define_rest_field(File,'bgc_DMSPd'//trim(nchar),dims) - call define_rest_field(File,'bgc_DMS'//trim(nchar),dims) - enddo - endif - if (tr_bgc_PON) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_PON'//trim(nchar),dims) - enddo - endif - if (tr_bgc_DON) then - do n = 1, n_don - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DON'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_Fe ) then - do n = 1, n_fed - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fed'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - do n = 1, n_fep - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fep'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - do k = 1, nbtrcr - write(nchar,'(i3.3)') k - call define_rest_field(File,'zbgc_frac'//trim(nchar),dims) - enddo - endif !z_tracers - - deallocate(dims) - status = pio_enddef(File) - - call ice_pio_initdecomp(iodesc=iodesc2d) - call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat, remap=.true.) - - endif - - if (my_task == master_task) then - write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) - endif - - end subroutine init_restart_write - -!======================================================================= - -! Reads a single restart field -! author David A Bailey, NCAR - - subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & - field_loc, field_type) - - use ice_blocks, only: nx_block, ny_block - use ice_communicate, only: my_task, master_task - use ice_constants, only: c0, field_loc_center - use ice_boundary, only: ice_HaloUpdate - use ice_domain, only: halo_info, distrb_info, nblocks - use ice_domain_size, only: max_blocks, ncat - use ice_global_reductions, only: global_minval, global_maxval, global_sum - - integer (kind=int_kind), intent(in) :: & - nu , & ! unit number (not used for netcdf) - ndim3 , & ! third dimension - nrec ! record number (0 for sequential access) - - real (kind=dbl_kind), dimension(nx_block,ny_block,ndim3,max_blocks), intent(inout) :: & - work ! input array (real, 8-byte) - - character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) - - logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output - - character (len=*), intent(in) :: vname - - integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) - - ! local variables - - integer (kind=int_kind) :: & - j, & ! dimension counter - n, & ! number of dimensions for variable - ndims, & ! number of variable dimensions - status ! status variable from netCDF routine - - real (kind=dbl_kind) :: amin,amax,asum - - character(len=*), parameter :: subname = '(read_restart_field)' - - if (restart_format == "pio") then - if (my_task == master_task) & - write(nu_diag,*)'Parallel restart file read: ',vname - - call pio_seterrorhandling(File, PIO_BCAST_ERROR) - - status = pio_inq_varid(File,trim(vname),vardesc) - - if (status /= 0) then - call abort_ice(subname//"ERROR: CICE restart? Missing variable: "//trim(vname)) - endif - - status = pio_inq_varndims(File, vardesc, ndims) - - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) - -! if (ndim3 == ncat .and. ncat>1) then - if (ndim3 == ncat .and. ndims == 3) then - call pio_read_darray(File, vardesc, iodesc3d_ncat, work, status) - if (present(field_loc)) then - do n=1,ndim3 - call ice_HaloUpdate (work(:,:,n,:), halo_info, & - field_loc, field_type) - enddo - endif -! elseif (ndim3 == 1) then - elseif (ndim3 == 1 .and. ndims == 2) then - call pio_read_darray(File, vardesc, iodesc2d, work, status) - if (present(field_loc)) then - call ice_HaloUpdate (work(:,:,1,:), halo_info, & - field_loc, field_type) - endif - else - write(nu_diag,*) "ndim3 not supported ",ndim3 - endif - - if (diag) then - if (ndim3 > 1) then - do n=1,ndim3 - amin = global_minval(work(:,:,n,:),distrb_info) - amax = global_maxval(work(:,:,n,:),distrb_info) - asum = global_sum(work(:,:,n,:), distrb_info, field_loc_center) - if (my_task == master_task) then - write(nu_diag,*) ' min and max =', amin, amax - write(nu_diag,*) ' sum =',asum - endif - enddo - else - amin = global_minval(work(:,:,1,:),distrb_info) - amax = global_maxval(work(:,:,1,:),distrb_info) - asum = global_sum(work(:,:,1,:), distrb_info, field_loc_center) - if (my_task == master_task) then - write(nu_diag,*) ' min and max =', amin, amax - write(nu_diag,*) ' sum =',asum - write(nu_diag,*) '' - endif - endif - - endif - else - call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) - endif - - end subroutine read_restart_field - -!======================================================================= - -! Writes a single restart field. -! author David A Bailey, NCAR - - subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) - - use ice_blocks, only: nx_block, ny_block - use ice_communicate, only: my_task, master_task - use ice_constants, only: c0, field_loc_center - use ice_domain, only: distrb_info, nblocks - use ice_domain_size, only: max_blocks, ncat - use ice_global_reductions, only: global_minval, global_maxval, global_sum - - integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - ndim3 , & ! third dimension - nrec ! record number (0 for sequential access) - - real (kind=dbl_kind), dimension(nx_block,ny_block,ndim3,max_blocks), intent(in) :: & - work ! input array (real, 8-byte) - - character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) - - logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output - - character (len=*), intent(in) :: vname - - ! local variables - - integer (kind=int_kind) :: & - j, & ! dimension counter - n, & ! dimension counter - ndims, & ! number of variable dimensions - status ! status variable from netCDF routine - - real (kind=dbl_kind) :: amin,amax,asum - - character(len=*), parameter :: subname = '(write_restart_field)' - - if (restart_format == "pio") then - if (my_task == master_task) & - write(nu_diag,*)'Parallel restart file write: ',vname - - status = pio_inq_varid(File,trim(vname),vardesc) - - status = pio_inq_varndims(File, vardesc, ndims) - - if (ndims==3) then - call pio_write_darray(File, vardesc, iodesc3d_ncat,work(:,:,:,1:nblocks), & - status, fillval=c0) - elseif (ndims == 2) then - call pio_write_darray(File, vardesc, iodesc2d, work(:,:,1,1:nblocks), & - status, fillval=c0) - else - write(nu_diag,*) "ndims not supported",ndims,ndim3 - endif - - if (diag) then - if (ndim3 > 1) then - do n=1,ndim3 - amin = global_minval(work(:,:,n,:),distrb_info) - amax = global_maxval(work(:,:,n,:),distrb_info) - asum = global_sum(work(:,:,n,:), distrb_info, field_loc_center) - if (my_task == master_task) then - write(nu_diag,*) ' min and max =', amin, amax - write(nu_diag,*) ' sum =',asum - endif - enddo - else - amin = global_minval(work(:,:,1,:),distrb_info) - amax = global_maxval(work(:,:,1,:),distrb_info) - asum = global_sum(work(:,:,1,:), distrb_info, field_loc_center) - if (my_task == master_task) then - write(nu_diag,*) ' min and max =', amin, amax - write(nu_diag,*) ' sum =',asum - endif - endif - endif - else - call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) - endif - - end subroutine write_restart_field - -!======================================================================= - -! Finalize the restart file. -! author David A Bailey, NCAR - - subroutine final_restart() - - use ice_calendar, only: istep1, time, time_forc - use ice_communicate, only: my_task, master_task - - character(len=*), parameter :: subname = '(final_restart)' - - if (restart_format == 'pio') then - call PIO_freeDecomp(File,iodesc2d) - call PIO_freeDecomp(File,iodesc3d_ncat) - call pio_closefile(File) - endif - - if (my_task == master_task) & - write(nu_diag,*) 'Restart read/written ',istep1,time,time_forc - - end subroutine final_restart - -!======================================================================= - -! Defines a restart field -! author David A Bailey, NCAR - - subroutine define_rest_field(File, vname, dims) - - type(file_desc_t) , intent(in) :: File - character (len=*) , intent(in) :: vname - integer (kind=int_kind), intent(in) :: dims(:) - - integer (kind=int_kind) :: & - status ! status variable from netCDF routine - - character(len=*), parameter :: subname = '(define_rest_field)' - - status = pio_def_var(File,trim(vname),pio_double,dims,vardesc) - - end subroutine define_rest_field - -!======================================================================= - - end module ice_restart - -!======================================================================= diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 index 229aa9e51..d030b439b 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 @@ -78,6 +78,7 @@ subroutine ice_write_hist (ns) real (kind= dbl_kind) :: ltime2 character (char_len) :: title character (char_len_long) :: ncfile(max_nstrm) + integer (kind=int_kind) :: iotype integer (kind=int_kind) :: iyear, imonth, iday integer (kind=int_kind) :: icategory,ind,i_aice,boundid @@ -137,6 +138,8 @@ subroutine ice_write_hist (ns) real (kind=dbl_kind) :: secday real (kind=dbl_kind) :: rad_to_deg + integer (kind=int_kind) :: lprecision + character(len=*), parameter :: subname = '(ice_write_hist)' call icepack_query_parameters(secday_out=secday) @@ -160,9 +163,11 @@ subroutine ice_write_hist (ns) ! create file + iotype = PIO_IOTYPE_NETCDF + if (history_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF File%fh=-1 call ice_pio_init(mode='write', filename=trim(filename), File=File, & - clobber=.true., cdf64=lcdf64) + clobber=.true., cdf64=lcdf64, iotype=iotype) call ice_pio_initdecomp(iodesc=iodesc2d) call ice_pio_initdecomp(ndim3=ncat_hist, iodesc=iodesc3dc) @@ -170,14 +175,18 @@ subroutine ice_write_hist (ns) call ice_pio_initdecomp(ndim3=nzblyr, iodesc=iodesc3db) call ice_pio_initdecomp(ndim3=nzalyr, iodesc=iodesc3da) call ice_pio_initdecomp(ndim3=nfsd_hist, iodesc=iodesc3df) - call ice_pio_initdecomp(ndim3=nverts, inner_dim=.true., iodesc=iodesc3dv) - call ice_pio_initdecomp(ndim3=nzilyr, ndim4=ncat_hist, iodesc=iodesc4di) - call ice_pio_initdecomp(ndim3=nzslyr, ndim4=ncat_hist, iodesc=iodesc4ds) - call ice_pio_initdecomp(ndim3=nzslyr, ndim4=nfsd_hist, iodesc=iodesc4df) + call ice_pio_initdecomp(ndim3=nverts, iodesc=iodesc3dv, inner_dim=.true.) + call ice_pio_initdecomp(ndim3=nzilyr, ndim4=ncat_hist, iodesc=iodesc4di) + call ice_pio_initdecomp(ndim3=nzslyr, ndim4=ncat_hist, iodesc=iodesc4ds) + call ice_pio_initdecomp(ndim3=nfsd_hist, ndim4=ncat_hist, iodesc=iodesc4df) ltime2 = time/int(secday) ltime = real(time/int(secday),kind=real_kind) + ! option of turning on double precision history files + lprecision = pio_real + if (history_precision == 8) lprecision = pio_double + !----------------------------------------------------------------- ! define dimensions !----------------------------------------------------------------- @@ -332,12 +341,17 @@ subroutine ice_write_hist (ns) dimid2(2) = jmtid do i = 1, ncoord - status = pio_def_var(File, trim(coord_var(i)%short_name), pio_real, & + status = pio_def_var(File, trim(coord_var(i)%short_name), lprecision, & dimid2, varid) status = pio_put_att(File,varid,'long_name',trim(coord_var(i)%long_name)) status = pio_put_att(File, varid, 'units', trim(coord_var(i)%units)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif if (coord_var(i)%short_name == 'ULAT') then status = pio_put_att(File,varid,'comment', & trim('Latitude of NE corner of T grid cell')) @@ -357,7 +371,7 @@ subroutine ice_write_hist (ns) do i = 1, nvarz if (igrdz(i)) then - status = pio_def_var(File, trim(var_nz(i)%short_name), pio_real, & + status = pio_def_var(File, trim(var_nz(i)%short_name), lprecision, & (/dimidex(i)/), varid) status = pio_put_att(File, varid, 'long_name', var_nz(i)%long_name) status = pio_put_att(File, varid, 'units' , var_nz(i)%units) @@ -366,31 +380,46 @@ subroutine ice_write_hist (ns) ! Attributes for tmask defined separately, since it has no units if (igrd(n_tmask)) then - status = pio_def_var(File, 'tmask', pio_real, dimid2, varid) + status = pio_def_var(File, 'tmask', lprecision, dimid2, varid) status = pio_put_att(File,varid, 'long_name', 'ocean grid mask') status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif status = pio_put_att(File,varid,'comment', '0 = land, 1 = ocean') endif if (igrd(n_blkmask)) then - status = pio_def_var(File, 'blkmask', pio_real, dimid2, varid) + status = pio_def_var(File, 'blkmask', lprecision, dimid2, varid) status = pio_put_att(File,varid, 'long_name', 'ice grid block mask') status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') status = pio_put_att(File,varid,'comment', 'mytask + iblk/100') - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif endif do i = 3, nvar ! note: n_tmask=1, n_blkmask=2 if (igrd(i)) then status = pio_def_var(File, trim(var(i)%req%short_name), & - pio_real, dimid2, varid) + lprecision, dimid2, varid) status = pio_put_att(File,varid, 'long_name', trim(var(i)%req%long_name)) status = pio_put_att(File, varid, 'units', trim(var(i)%req%units)) status = pio_put_att(File, varid, 'coordinates', trim(var(i)%coordinates)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif endif enddo @@ -401,13 +430,18 @@ subroutine ice_write_hist (ns) do i = 1, nvar_verts if (f_bounds) then status = pio_def_var(File, trim(var_nverts(i)%short_name), & - pio_real,dimid_nverts, varid) + lprecision,dimid_nverts, varid) status = & pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)) status = & pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif endif enddo @@ -426,7 +460,7 @@ subroutine ice_write_hist (ns) do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimid3, varid) + lprecision, dimid3, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -435,8 +469,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -475,7 +514,7 @@ subroutine ice_write_hist (ns) do n = n2D + 1, n3Dccum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -484,8 +523,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -512,7 +556,7 @@ subroutine ice_write_hist (ns) do n = n3Dccum + 1, n3Dzcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -521,8 +565,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -549,7 +598,7 @@ subroutine ice_write_hist (ns) do n = n3Dzcum + 1, n3Dbcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -558,8 +607,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -586,7 +640,7 @@ subroutine ice_write_hist (ns) do n = n3Dbcum + 1, n3Dacum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -595,8 +649,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -623,7 +682,7 @@ subroutine ice_write_hist (ns) do n = n3Dacum + 1, n3Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -632,8 +691,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -666,7 +730,7 @@ subroutine ice_write_hist (ns) do n = n3Dfcum + 1, n4Dicum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidcz, varid) + lprecision, dimidcz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -675,8 +739,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -704,7 +773,7 @@ subroutine ice_write_hist (ns) do n = n4Dicum + 1, n4Dscum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidcz, varid) + lprecision, dimidcz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -713,8 +782,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -743,7 +817,7 @@ subroutine ice_write_hist (ns) do n = n4Dscum + 1, n4Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidcz, varid) + lprecision, dimidcz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -752,8 +826,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -810,7 +889,11 @@ subroutine ice_write_hist (ns) a,'-',a,'-',a,' at ',a,':',a) status = pio_put_att(File,pio_global,'history',trim(start_time)) - status = pio_put_att(File,pio_global,'io_flavor','io_pio') + if (history_format == 'pio_pnetcdf') then + status = pio_put_att(File,pio_global,'io_flavor','io_pio pnetcdf') + else + status = pio_put_att(File,pio_global,'io_flavor','io_pio netcdf') + endif !----------------------------------------------------------------- ! end define mode @@ -979,7 +1062,11 @@ subroutine ice_write_hist (ns) if (status /= pio_noerr) call abort_ice(subname// & 'ERROR getting varid for '//avail_hist_fields(n)%vname) workr2(:,:,:) = a2D(:,:,n,1:nblocks) +#ifdef CESM1_PIO + call pio_setframe(varid, int(1,kind=PIO_OFFSET)) +#else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) +#endif call pio_write_darray(File, varid, iodesc2d,& workr2, status, fillval=spval_dbl) endif @@ -1000,7 +1087,11 @@ subroutine ice_write_hist (ns) workr3(:,:,j,i) = a3Dc(:,:,i,nn,j) enddo enddo +#ifdef CESM1_PIO + call pio_setframe(varid, int(1,kind=PIO_OFFSET)) +#else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) +#endif call pio_write_darray(File, varid, iodesc3dc,& workr3, status, fillval=spval_dbl) endif @@ -1020,7 +1111,11 @@ subroutine ice_write_hist (ns) workr3(:,:,j,i) = a3Dz(:,:,i,nn,j) enddo enddo +#ifdef CESM1_PIO + call pio_setframe(varid, int(1,kind=PIO_OFFSET)) +#else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) +#endif call pio_write_darray(File, varid, iodesc3di,& workr3, status, fillval=spval_dbl) endif @@ -1040,7 +1135,11 @@ subroutine ice_write_hist (ns) workr3(:,:,j,i) = a3Db(:,:,i,nn,j) enddo enddo +#ifdef CESM1_PIO + call pio_setframe(varid, int(1,kind=PIO_OFFSET)) +#else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) +#endif call pio_write_darray(File, varid, iodesc3db,& workr3, status, fillval=spval_dbl) endif @@ -1060,7 +1159,11 @@ subroutine ice_write_hist (ns) workr3(:,:,j,i) = a3Da(:,:,i,nn,j) enddo enddo +#ifdef CESM1_PIO + call pio_setframe(varid, int(1,kind=PIO_OFFSET)) +#else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) +#endif call pio_write_darray(File, varid, iodesc3da,& workr3, status, fillval=spval_dbl) endif @@ -1080,7 +1183,11 @@ subroutine ice_write_hist (ns) workr3(:,:,j,i) = a3Df(:,:,i,nn,j) enddo enddo +#ifdef CESM1_PIO + call pio_setframe(varid, int(1,kind=PIO_OFFSET)) +#else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) +#endif call pio_write_darray(File, varid, iodesc3df,& workr3, status, fillval=spval_dbl) endif @@ -1102,7 +1209,11 @@ subroutine ice_write_hist (ns) enddo ! k enddo ! i enddo ! j +#ifdef CESM1_PIO + call pio_setframe(varid, int(1,kind=PIO_OFFSET)) +#else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) +#endif call pio_write_darray(File, varid, iodesc4di,& workr4, status, fillval=spval_dbl) endif @@ -1124,11 +1235,15 @@ subroutine ice_write_hist (ns) enddo ! k enddo ! i enddo ! j +#ifdef CESM1_PIO + call pio_setframe(varid, int(1,kind=PIO_OFFSET)) +#else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) +#endif call pio_write_darray(File, varid, iodesc4ds,& workr4, status, fillval=spval_dbl) endif - enddo ! num_avail_hist_fields_4Di + enddo ! num_avail_hist_fields_4Ds deallocate(workr4) allocate(workr4(nx_block,ny_block,nblocks,ncat_hist,nfsd_hist)) @@ -1142,15 +1257,19 @@ subroutine ice_write_hist (ns) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nfsd_hist - workr4(:,:,j,i,k) = a4Ds(:,:,k,i,nn,j) + workr4(:,:,j,i,k) = a4Df(:,:,k,i,nn,j) enddo ! k enddo ! i enddo ! j +#ifdef CESM1_PIO + call pio_setframe(varid, int(1,kind=PIO_OFFSET)) +#else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) +#endif call pio_write_darray(File, varid, iodesc4df,& workr4, status, fillval=spval_dbl) endif - enddo ! num_avail_hist_fields_4Di + enddo ! num_avail_hist_fields_4Df deallocate(workr4) ! similarly for num_avail_hist_fields_4Db (define workr4b, iodesc4db) diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 index 5fff64944..9c65b2ce1 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 @@ -4,9 +4,6 @@ module ice_pio - use shr_kind_mod, only: r8 => shr_kind_r8, in=>shr_kind_in - use shr_kind_mod, only: cl => shr_kind_cl - use shr_sys_mod , only: shr_sys_flush use ice_kinds_mod use ice_blocks use ice_broadcast @@ -31,7 +28,11 @@ module ice_pio public ice_pio_init public ice_pio_initdecomp - type(iosystem_desc_t), pointer, public :: ice_pio_subsystem +#ifdef CESMCOUPLED + type(iosystem_desc_t), pointer :: ice_pio_subsystem +#else + type(iosystem_desc_t) :: ice_pio_subsystem +#endif !=============================================================================== @@ -42,9 +43,15 @@ module ice_pio ! Initialize the io subsystem ! 2009-Feb-17 - J. Edwards - initial version - subroutine ice_pio_init(mode, filename, File, clobber, cdf64) + subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) +#ifdef CESMCOUPLED use shr_pio_mod, only: shr_pio_getiosys, shr_pio_getiotype +#else +#ifdef GPTL + use perf_mod, only : t_initf +#endif +#endif implicit none character(len=*) , intent(in), optional :: mode @@ -52,12 +59,18 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64) type(file_desc_t) , intent(inout), optional :: File logical , intent(in), optional :: clobber logical , intent(in), optional :: cdf64 + integer , intent(in), optional :: iotype ! local variables integer (int_kind) :: & nml_error ! namelist read error flag + integer :: nprocs + integer :: istride + integer :: basetask + integer :: numiotasks + integer :: rearranger integer :: pio_iotype logical :: exists logical :: lclobber @@ -67,8 +80,64 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64) character(len=*), parameter :: subname = '(ice_pio_init)' logical, save :: first_call = .true. +#ifdef CESMCOUPLED ice_pio_subsystem => shr_pio_getiosys(inst_name) pio_iotype = shr_pio_getiotype(inst_name) +#else + +#ifdef GPTL + !--- initialize gptl + call t_initf('undefined_NLFileName', LogPrint=.false., mpicom=MPI_COMM_ICE, & + MasterTask=.true.) +#endif + + !--- initialize type of io + !pio_iotype = PIO_IOTYPE_PNETCDF + !pio_iotype = PIO_IOTYPE_NETCDF4C + !pio_iotype = PIO_IOTYPE_NETCDF4P + pio_iotype = PIO_IOTYPE_NETCDF + if (present(iotype)) then + pio_iotype = iotype + endif + + !--- initialize ice_pio_subsystem + nprocs = get_num_procs() + istride = 4 + basetask = min(1,nprocs-1) + numiotasks = max((nprocs-basetask)/istride,1) +!--tcraig this should work better but it causes pio2.4.4 to fail for reasons unknown +! numiotasks = 1 + (nprocs-basetask-1)/istride + rearranger = PIO_REARR_BOX + if (my_task == master_task) then + write(nu_diag,*) subname,' nprocs = ',nprocs + write(nu_diag,*) subname,' istride = ',istride + write(nu_diag,*) subname,' basetask = ',basetask + write(nu_diag,*) subname,' numiotasks = ',numiotasks + write(nu_diag,*) subname,' pio_iotype = ',pio_iotype + end if + + call pio_init(my_task, MPI_COMM_ICE, numiotasks, master_task, istride, & + rearranger, ice_pio_subsystem, base=basetask) + !--- initialize rearranger options + !pio_rearr_opt_comm_type = integer (PIO_REARR_COMM_[P2P,COLL]) + !pio_rearr_opt_fcd = integer, flow control (PIO_REARR_COMM_FC_[2D_ENABLE,1D_COMP2IO,1D_IO2COMP,2D_DISABLE]) + !pio_rearr_opt_c2i_enable_hs = logical + !pio_rearr_opt_c2i_enable_isend = logical + !pio_rearr_opt_c2i_max_pend_req = integer + !pio_rearr_opt_i2c_enable_hs = logical + !pio_rearr_opt_i2c_enable_isend = logical + !pio_rearr_opt_c2i_max_pend_req = integer + !ret = pio_set_rearr_opts(ice_pio_subsystem, pio_rearr_opt_comm_type,& + ! pio_rearr_opt_fcd,& + ! pio_rearr_opt_c2i_enable_hs, pio_rearr_opt_c2i_enable_isend,& + ! pio_rearr_opt_c2i_max_pend_req,& + ! pio_rearr_opt_i2c_enable_hs, pio_rearr_opt_i2c_enable_isend,& + ! pio_rearr_opt_i2c_max_pend_req) + !if(ret /= PIO_NOERR) then + ! call abort_ice(subname//'ERROR: aborting in pio_set_rearr_opts') + !end if + +#endif if (present(mode) .and. present(filename) .and. present(File)) then diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 index c207d5b25..5bb880dc5 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -55,6 +55,8 @@ subroutine init_restart_read(ice_ic) integer (kind=int_kind) :: status + integer (kind=int_kind) :: iotype + character(len=*), parameter :: subname = '(init_restart_read)' if (present(ice_ic)) then @@ -74,9 +76,11 @@ subroutine init_restart_read(ice_ic) write(nu_diag,*) 'Using restart dump=', trim(filename) end if - if (restart_format == 'pio') then +! if (restart_format(1:3) == 'pio') then + iotype = PIO_IOTYPE_NETCDF + if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF File%fh=-1 - call ice_pio_init(mode='read', filename=trim(filename), File=File) + call ice_pio_init(mode='read', filename=trim(filename), File=File, iotype=iotype) call ice_pio_initdecomp(iodesc=iodesc2d) call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true.) @@ -94,7 +98,7 @@ subroutine init_restart_read(ice_ic) status = pio_get_att(File, pio_global, 'sec', sec) endif endif ! use namelist values if use_restart_time = F - endif +! endif if (my_task == master_task) then write(nu_diag,*) 'Restart read at istep=',istep0,time,time_forc @@ -160,6 +164,8 @@ subroutine init_restart_write(filename_spec) integer (kind=int_kind), allocatable :: dims(:) + integer (kind=int_kind) :: iotype + integer (kind=int_kind) :: & k, n, & ! loop index status ! status variable from netCDF routine @@ -199,7 +205,7 @@ subroutine init_restart_write(filename_spec) iyear,'-',month,'-',mday,'-',sec end if - if (restart_format /= 'bin') filename = trim(filename) // '.nc' + if (restart_format(1:3) /= 'bin') filename = trim(filename) // '.nc' ! write pointer (path/file) if (my_task == master_task) then @@ -208,11 +214,13 @@ subroutine init_restart_write(filename_spec) close(nu_rst_pointer) endif - if (restart_format == 'pio') then +! if (restart_format(1:3) == 'pio') then + iotype = PIO_IOTYPE_NETCDF + if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF File%fh=-1 call ice_pio_init(mode='write',filename=trim(filename), File=File, & - clobber=.true., cdf64=lcdf64 ) + clobber=.true., cdf64=lcdf64, iotype=iotype) status = pio_put_att(File,pio_global,'istep1',istep1) status = pio_put_att(File,pio_global,'time',time) @@ -631,7 +639,7 @@ subroutine init_restart_write(filename_spec) call ice_pio_initdecomp(iodesc=iodesc2d) call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat, remap=.true.) - endif +! endif ! restart_format if (my_task == master_task) then write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) @@ -688,7 +696,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & character(len=*), parameter :: subname = '(read_restart_field)' - if (restart_format == "pio") then +! if (restart_format(1:3) == "pio") then if (my_task == master_task) & write(nu_diag,*)'Parallel restart file read: ',vname @@ -747,9 +755,9 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & endif endif - else - call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) - endif +! else +! call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) +! endif ! restart_format end subroutine read_restart_field @@ -796,7 +804,7 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) character(len=*), parameter :: subname = '(write_restart_field)' - if (restart_format == "pio") then +! if (restart_format(1:3) == "pio") then if (my_task == master_task) & write(nu_diag,*)'Parallel restart file write: ',vname @@ -835,9 +843,9 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) endif endif endif - else - call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) - endif +! else +! call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) +! endif end subroutine write_restart_field @@ -853,11 +861,9 @@ subroutine final_restart() character(len=*), parameter :: subname = '(final_restart)' - if (restart_format == 'pio') then - call PIO_freeDecomp(File,iodesc2d) - call PIO_freeDecomp(File,iodesc3d_ncat) - call pio_closefile(File) - endif + call PIO_freeDecomp(File,iodesc2d) + call PIO_freeDecomp(File,iodesc3d_ncat) + call pio_closefile(File) if (my_task == master_task) & write(nu_diag,*) 'Restart read/written ',istep1,time,time_forc diff --git a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 index 09cffa0c7..f5e7de02f 100644 --- a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 @@ -374,7 +374,7 @@ subroutine coupling_prep (iblk) fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt, Uref, wind use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & - fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai + fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai, & fnit, fsil, famm, fdmsp, fdms, fhum, fdust, falgalN, & fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn use ice_grid, only: tmask diff --git a/cicecore/drivers/mct/cesm1/ice_import_export.F90 b/cicecore/drivers/mct/cesm1/ice_import_export.F90 index 82780ccd3..d42d3f8a1 100644 --- a/cicecore/drivers/mct/cesm1/ice_import_export.F90 +++ b/cicecore/drivers/mct/cesm1/ice_import_export.F90 @@ -72,7 +72,6 @@ subroutine ice_import( x2i ) logical (kind=log_kind) :: tr_aero, tr_iage, tr_FY, tr_pond logical (kind=log_kind) :: tr_lvl, tr_zaero, tr_bgc_Nit real (kind=dbl_kind) :: tffresh - logical (kind=log_kind) :: first_call = .true. character(len=*), parameter :: subname = '(ice_import)' !----------------------------------------------------- diff --git a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 index 986189f96..adafb3d36 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 @@ -171,10 +171,12 @@ subroutine cice_init(mpi_comm) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - -! call calendar(time) ! determine the initial date - +#ifndef CICE_DMI + call calendar(time) ! determine the initial date +#endif +#ifndef CICE_IN_NEMO call init_forcing_ocn(dt) ! initialize sss and sst from data +#endif call init_state ! initialize the ice state call init_transport ! initialize horizontal transport call ice_HaloRestore_init ! restored boundary conditions @@ -216,7 +218,9 @@ subroutine cice_init(mpi_comm) ! coupler communication or forcing data initialization !-------------------------------------------------------------------- +#ifndef CICE_IN_NEMO call init_forcing_atmo ! initialize atmospheric forcing (standalone) +#endif #ifndef coupled #ifndef CESMCOUPLED diff --git a/cicecore/drivers/nuopc/dmi/cice_cap.info b/cicecore/drivers/nuopc/dmi/cice_cap.info new file mode 100644 index 000000000..49127cc15 --- /dev/null +++ b/cicecore/drivers/nuopc/dmi/cice_cap.info @@ -0,0 +1,1031 @@ +module cice_cap +!--------------- LANL CICE NUOPC CAP ----------------- +! This is the DMI CICE model cap component that is NUOPC compliant. +! Author: Fei.Liu@gmail.com +! 5/10/13 +! This is now acting as a cap/connector between NUOPC driver and LANL CICE code. +! Author: Anthony.Craig@gmail.com +! Added cice grid code to match internal grid representation +! Updated by Till Rasmussen, DMI + +! cice specific + use ice_blocks, only: nx_block, ny_block, nblocks_tot, block, get_block, & + get_block_parameter + use ice_domain_size, only: max_blocks, nx_global, ny_global + use ice_domain, only: nblocks, blocks_ice, distrb_info + use ice_distribution, only: ice_distributiongetblockloc + use icepack_parameters, only: Tffresh, rad_to_deg + use ice_calendar, only: dt + use ice_flux + use ice_grid, only: TLAT, TLON, ULAT, ULON, hm, tarea, ANGLET, ANGLE, & + dxt, dyt, t2ugrid_vector + use ice_state + use CICE_RunMod + use CICE_InitMod + use CICE_FinalMod +!end cice specific + use ESMF + use NUOPC + use mod_nuopc_options, only: esmf_write_diagnostics + use NUOPC_Model, & + model_routine_SS => SetServices, & + model_label_SetClock => label_SetClock, & + model_label_Advance => label_Advance, & + model_label_Finalize => label_Finalize + + implicit none + + private + + public SetServices + +! type cice_internalstate_type +! end type + +! type cice_internalstate_wrapper +! type(cice_internalstate_type), pointer :: ptr +! end type + + integer :: import_slice = 0 + integer :: export_slice = 0 + + type fld_list_type + character(len=64) :: stdname + character(len=64) :: shortname + character(len=64) :: canonicalUnits + character(len=64) :: transferOffer + logical :: assoc ! is the farrayPtr associated with internal data + real(ESMF_KIND_R8), dimension(:,:,:), pointer :: farrayPtr + end type fld_list_type + + integer,parameter :: fldsMax = 50 + integer :: fldsToIce_num = 0 + type (fld_list_type) :: fldsToIce(fldsMax) + integer :: fldsFrIce_num = 0 + type (fld_list_type) :: fldsFrIce(fldsMax) + +!tarnotused integer :: lsize ! local number of gridcells for coupling + character(len=256) :: tmpstr + character(len=2048):: info + logical :: isPresent + integer :: dbrc ! temporary debug rc value + + logical :: profile_memory = .true. + + contains + !----------------------------------------------------------------------------- + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + character(len=*),parameter :: subname='(cice:SetServices)' + rc = ESMF_SUCCESS + + ! the NUOPC model component will register the generic methods + call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! set entry point for methods that require specific implementation + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv00p1"/), userRoutine=InitializeAdvertise, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv00p2"/), userRoutine=InitializeRealize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! attach specializing method(s) + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetClock, & + specRoutine=SetClock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specRoutine=ModelAdvance, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=cice_model_finalize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine + + !----------------------------------------------------------------------------- + + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + ! Local Variables + type(ESMF_VM) :: vm + integer :: mpi_comm + character(len=*),parameter :: subname='(cice_cap:InitializeAdvertise)' + rc = ESMF_SUCCESS + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(vm, mpiCommunicator=mpi_comm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call CICE_FieldsSetup() + call CICE_Initialize(mpi_comm) + + call CICE_AdvertiseFields(importState, fldsToIce_num, fldsToIce, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call CICE_AdvertiseFields(exportState, fldsFrIce_num, fldsFrIce, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + write(info,*) subname,' --- initialization phase 1 completed --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine + + !----------------------------------------------------------------------------- + + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local Variables + type(ESMF_VM) :: vm + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + type(ESMF_DistGrid) :: distgrid + type(ESMF_DistGridConnection), allocatable :: connectionList(:) + integer :: npet + integer :: i,j,iblk, n, i1,j1, DE + integer :: ilo,ihi,jlo,jhi + integer :: ig,jg,cnt + integer :: peID,locID + integer :: peIDCount + integer, pointer :: indexList(:) + integer, pointer :: deLabelList(:) + integer, pointer :: deBlockList(:,:,:) + integer, pointer :: petMap(:) + integer, pointer :: i_glob(:),j_glob(:) + integer :: lbnd(2),ubnd(2) + type(block) :: this_block + type(ESMF_DELayout) :: delayout + real(ESMF_KIND_R8), pointer :: tarray(:,:) + real(ESMF_KIND_R8), pointer :: coordXcenter(:,:) + real(ESMF_KIND_R8), pointer :: coordYcenter(:,:) + real(ESMF_KIND_R8), pointer :: coordXcorner(:,:) + real(ESMF_KIND_R8), pointer :: coordYcorner(:,:) + integer(ESMF_KIND_I4), pointer :: gridmask(:,:) + real(ESMF_KIND_R8), pointer :: gridarea(:,:) + character(len=*),parameter :: subname='(cice_cap:InitializeRealize)' + rc = ESMF_SUCCESS + + ! We can check if npet is 4 or some other value to make sure + ! CICE is configured to run on the correct number of processors. + + ! create a Grid object for Fields + ! we are going to create a single tile displaced pole grid from a gridspec + ! file. We also use the exact decomposition in CICE so that the Fields + ! created can wrap on the data pointers in internal part of CICE + write(tmpstr,'(a,2i8)') subname//' ice nx,ny = ',nx_global,ny_global + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + +! distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nx_global,ny_global/), & +! regDecomp=(/2,2/), rc=rc) + + allocate(deBlockList(2,2,nblocks_tot)) + allocate(petMap(nblocks_tot)) + allocate(deLabelList(nblocks_tot)) + + write(tmpstr,'(a,2i8)') subname//' nblocks = ',nblocks_tot, nblocks + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + peIDCount = 0 + do n = 1, nblocks_tot + deLabelList(n) = n-1 + call get_block_parameter(n,ilo=ilo,ihi=ihi,jlo=jlo,jhi=jhi, & + i_glob=i_glob,j_glob=j_glob) +! deBlockList(1,1,n) = i_glob(ilo) +! deBlockList(1,2,n) = i_glob(ihi) +! deBlockList(2,1,n) = j_glob(jlo) +! deBlockList(2,2,n) = j_glob(jhi) + call ice_distributionGetBlockLoc(distrb_info,n,peID,locID) + if (peID > 0) then + peIDCount = peIDCount+1 + petMap(peIDCount) = peID-1 + deBlockList(1,1,peIDCount) = i_glob(ilo) + deBlockList(1,2,peIDCount) = i_glob(ihi) + deBlockList(2,1,peIDCount) = j_glob(jlo) + deBlockList(2,2,PeIDCount) = j_glob(jhi) + write(tmpstr,'(a,4i8)') subname//' ID2s = ',n,peID, locID, nblocks + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !reducepetmappetMap(n) = max(0,peID - 1) + write(tmpstr,'(a,4i8)') subname//' IDs = ',n,peID, locID, nblocks + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,peIDCount),deBlockList(1,2,peIDCount) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,peIDCount),deBlockList(2,2,peIDCount) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + enddo + write(tmpstr,'(a,1i8)') subname//' npeID ',peIDCount + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +!!!TAR ADDED 141119 + delayout = ESMF_DELayoutCreate(petMap(1:peIDCount), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +!tarnotglobal allocate(connectionList(2)) + ! bipolar boundary condition at top row: nyg +!tarnotglobal call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & +!tarnotglobal tileIndexB=1, positionVector=(/nx_global+1, 2*ny_global+1/), & +!tarnotglobal orientationVector=(/-1, -2/), rc=rc) +!tarnotglobal if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +!tarnotglobal line=__LINE__, & +!tarnotglobal file=__FILE__)) & +!tarnotglobal return ! bail out + ! periodic boundary condition along first dimension +!tarnotglobal call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & +!tarnotglobal tileIndexB=1, positionVector=(/nx_global, 0/), rc=rc) +!tarnotglobal if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +!tarnotglobal line=__LINE__, & +!tarnotglobal file=__FILE__)) & +!tarnotglobal return ! bail out + + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nx_global,ny_global/), & +! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList(:,:,1:peIDCount), & +! deLabelList=deLabelList, & + delayout=delayout, & +!tarnotglobal connectionList=connectionList, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + deallocate(deLabelList) + deallocate(deBlockList) + deallocate(petMap) +!tarnotglobal deallocate(connectionList) + + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(indexList(cnt)) + write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + write(tmpstr,'(a,4i8)') subname//' distgrid list= ',indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + deallocate(IndexList) + + gridIn = ESMF_GridCreate(distgrid=distgrid, & + coordSys = ESMF_COORDSYS_SPH_DEG, & + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do iblk = 1,nblocks + DE = iblk-1 + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + call ESMF_GridGetCoord(gridIn, coordDim=1, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + computationalLBound=lbnd, computationalUBound=ubnd, & + farrayPtr=coordXcenter, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(gridIn, coordDim=2, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=coordYcenter, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(tmpstr,'(a,5i8)') subname//' iblk center bnds ',iblk,lbnd,ubnd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + if (lbnd(1) /= 1 .or. lbnd(2) /= 1 .or. ubnd(1) /= ihi-ilo+1 .or. ubnd(2) /= jhi-jlo+1) then + write(tmpstr,'(a,5i8)') subname//' iblk bnds ERROR ' + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=dbrc) + write(tmpstr,'(a,4i8)') subname//' iblk center bnds 2',ihi, ilo, jhi,jlo + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=gridmask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=gridarea, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do j1 = lbnd(2),ubnd(2) + do i1 = lbnd(1),ubnd(1) + i = i1 + ilo - lbnd(1) + j = j1 + jlo - lbnd(2) + coordXcenter(i1,j1) = TLON(i,j,iblk) * rad_to_deg + coordYcenter(i1,j1) = TLAT(i,j,iblk) * rad_to_deg + gridmask(i1,j1) = nint(hm(i,j,iblk)) + gridarea(i1,j1) = tarea(i,j,iblk) + enddo + enddo + + call ESMF_GridGetCoord(gridIn, coordDim=1, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + computationalLBound=lbnd, computationalUBound=ubnd, & + farrayPtr=coordXcorner, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(gridIn, coordDim=2, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=coordYcorner, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(tmpstr,'(a,5i8)') subname//' iblk corner bnds ',iblk,lbnd,ubnd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + ! ULON and ULAT are upper right hand corner from TLON and TLAT + ! corners in ESMF need to be defined lon lower left corner from center + ! ULON and ULAT have ghost cells, leverage that to fill corner arrays + do j1 = lbnd(2),ubnd(2) + do i1 = lbnd(1),ubnd(1) + i = i1 + ilo - lbnd(1) + j = j1 + jlo - lbnd(2) + coordXcorner(i1,j1) = ULON(i-1,j-1,iblk) * rad_to_deg + coordYcorner(i1,j1) = ULAT(i-1,j-1,iblk) * rad_to_deg + enddo + enddo + + enddo + + call ESMF_GridGetCoord(gridIn, coordDim=1, localDE=0, & + staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=tarray, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,2g15.7)') subname//' gridIn center1 = ',minval(tarray),maxval(tarray) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_GridGetCoord(gridIn, coordDim=2, localDE=0, & + staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=tarray, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,2g15.7)') subname//' gridIn center2 = ',minval(tarray),maxval(tarray) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_GridGetCoord(gridIn, coordDim=1, localDE=0, & + staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=tarray, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,2g15.7)') subname//' gridIn corner1 = ',minval(tarray),maxval(tarray) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_GridGetCoord(gridIn, coordDim=2, localDE=0, & + staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=tarray, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,2g15.7)') subname//' gridIn corner2 = ',minval(tarray),maxval(tarray) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !TAR FOR NOW GRIDS ARE ASSUMED IDENTICAL. THIS MAY change at a later state. Not necessary + gridOut = gridIn ! for now out same as in +! ice_grid_i = gridIn + + call CICE_RealizeFields(importState, gridIn , fldsToIce_num, fldsToIce, "Ice import", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call CICE_RealizeFields(exportState, gridOut, fldsFrIce_num, fldsFrIce, "Ice export", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! Import data to CICE native structures through glue fields. + call CICE_Import(importState,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! Export CICE native structures to data through glue fields. + CALL CICE_export(exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + write(info,*) subname,' --- initialization phase 2 completed --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=dbrc) + + end subroutine + + !----------------------------------------------------------------------------- + + ! CICE model uses same clock as parent gridComp + subroutine SetClock(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_TimeInterval) :: stabilityTimeStep, timestep + character(len=*),parameter :: subname='(cice_cap:SetClock)' + + rc = ESMF_SUCCESS + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! tcraig: dt is the cice thermodynamic timestep in seconds + call ESMF_TimeIntervalSet(timestep, s=nint(dt), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockSet(clock, timestep=timestep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize internal clock + ! here: parent Clock and stability timeStep determine actual model timeStep + call ESMF_TimeIntervalSet(stabilityTimeStep, s=nint(dt), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSetClock(gcomp, clock, stabilityTimeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine + + !----------------------------------------------------------------------------- + + subroutine ModelAdvance(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Field) :: lfield,lfield2d + type(ESMF_Grid) :: grid + real(ESMF_KIND_R8), pointer :: fldptr(:,:,:) + real(ESMF_KIND_R8), pointer :: fldptr2d(:,:) + type(block) :: this_block + character(len=64) :: fldname + integer :: i,j,iblk,n,i1,i2,j1,j2 + integer :: ilo,ihi,jlo,jhi + real(ESMF_KIND_R8) :: ue, vn, ui, vj +! real(ESMF_KIND_R8) :: sigma_r, sigma_l, sigma_c + type(ESMF_StateItem_Flag) :: itemType + character(240) :: msgString + character(len=*),parameter :: subname='(cice_cap:ModelAdvance)' + rc = ESMF_SUCCESS + if(profile_memory) call ESMF_VMLogMemInfo("Entering CICE Model_ADVANCE: ") + write(info,*) subname,' --- run phase 1 called --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + import_slice = import_slice + 1 + export_slice = export_slice + 1 + + ! query the Component for its clock, importState and exportState + call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, & + exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep + + ! Because of the way that the internal Clock was set in SetClock(), + ! its timeStep is likely smaller than the parent timeStep. As a consequence + ! the time interval covered by a single parent timeStep will result in + ! multiple calls to the ModelAdvance() routine. Every time the currTime + ! will come in by one internal timeStep advanced. This goes until the + ! stopTime of the internal Clock has been reached. + + call ESMF_ClockPrint(clock, options="currTime", & + preString="------>Advancing CICE from: ", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, currTime=currTime, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimePrint(currTime + timeStep, & + preString="--------------------------------> to: ", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +!TODO ADD LOGFOUNDERROR + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call CICE_Import(importState,rc) + if (esmf_write_diagnostics >0) then + if (mod(import_slice,esmf_write_diagnostics)==0) then + call nuopc_write(state=importState,filenamePrefix='Import_CICE', & + timeslice=import_slice/esmf_write_diagnostics,rc=rc) + endif + endif ! write_diagnostics + write(info,*) subname,' --- run phase 2 called --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + if(profile_memory) call ESMF_VMLogMemInfo("Before CICE_Run") + call CICE_Run + + if(profile_memory) call ESMF_VMLogMemInfo("After CICE_Run") + write(info,*) subname,' --- run phase 3 called --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + + !---- local modifications to coupling fields ----- + call CICE_Export(exportState,rc=rc) + if (esmf_write_diagnostics >0) then + if (mod(export_slice,esmf_write_diagnostics)==0) then + call nuopc_write(state=exportState,filenamePrefix='Export_CICE', & + timeslice=export_slice/esmf_write_diagnostics,rc=rc) + endif + endif + !------------------------------------------------- + + !call state_diagnose(exportState, 'cice_export', rc) + write(info,*) subname,' --- run phase 4 called --- ',rc + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + if(profile_memory) call ESMF_VMLogMemInfo("Leaving CICE Model_ADVANCE: ") + end subroutine + + subroutine cice_model_finalize(gcomp, rc) + + ! input arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + character(len=*),parameter :: subname='(cice_cap:cice_model_finalize)' + + rc = ESMF_SUCCESS + + write(info,*) subname,' --- finalize called --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call CICE_Finalize + + write(info,*) subname,' --- finalize completed --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine cice_model_finalize + + subroutine CICE_AdvertiseFields(state, nfields, field_defs, rc) + + type(ESMF_State), intent(inout) :: state + integer,intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + integer, intent(inout) :: rc + + integer :: i + character(len=*),parameter :: subname='(cice_cap:CICE_AdvertiseFields)' + + rc = ESMF_SUCCESS + !write(6,*) nfields + do i = 1, nfields + if (.not. NUOPC_FieldDictionaryHasEntry(trim(field_defs(i)%stdname))) then + write(6,*) trim(field_defs(i)%stdname), trim(field_defs(i)%canonicalUnits) + call NUOPC_FieldDictionaryAddEntry( & + standardName=trim(field_defs(i)%stdname), & + canonicalUnits=trim(field_defs(i)%canonicalUnits), & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + call ESMF_LogWrite('Advertise: '//trim(field_defs(i)%stdname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_Advertise(state, & + standardName=field_defs(i)%stdname, & + name=field_defs(i)%shortname, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + enddo + call flush(6) + + end subroutine CICE_AdvertiseFields + + subroutine CICE_RealizeFields(state, grid, nfields, field_defs, tag, rc) + + type(ESMF_State), intent(inout) :: state + type(ESMF_Grid), intent(in) :: grid + integer, intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + character(len=*), intent(in) :: tag + integer, intent(inout) :: rc + + integer :: i + type(ESMF_Field) :: field + integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) + type(ESMF_VM) :: vm + character(len=*),parameter :: subname='(cice_cap:CICE_RealizeFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + if (field_defs(i)%assoc) then + write(info, *) subname, tag, ' Field ', field_defs(i)%shortname, ':', & + lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & + lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2), & + lbound(field_defs(i)%farrayPtr,3), ubound(field_defs(i)%farrayPtr,3) + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + field = ESMF_FieldCreate(grid=grid, & + farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & + ungriddedLBound=(/1/), ungriddedUBound=(/max_blocks/), & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + ungriddedLBound=(/1/), ungriddedUBound=(/max_blocks/), & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + else + call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is not connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + ! TODO: Initialize the value in the pointer to 0 after proper restart is setup + !if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 + ! remove a not connected Field from State + call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + enddo + + + end subroutine CICE_RealizeFields + + !----------------------------------------------------------------------------- + + + !----------------------------------------------------------------------------- + + + !----------------------------------------------------------------------------- + + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:,:) + integer, intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(cice_cap:State_GetFldPtr)' + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr + + subroutine CICE_FieldsSetup + character(len=*),parameter :: subname='(cice_cap:CICE_FieldsSetup)' + +!--------- import fields to Sea Ice ------------- + !tartmpwrite(6,*) subname +! tcraig, don't point directly into cice data YET (last field is optional in interface) +! instead, create space for the field when it's "realized". +!TODO REMOVE FIELDS NOT USED TAR +! WILL PROVIDE means that field has its own grid. Can be changed to accept grid from outside + call fld_list_add(fldsToIce_num, fldsToIce, "sea_surface_temperature" ,"K" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "sea_surface_salinity" ,"1" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "sea_level" ,"m" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "sea_surface_slope_zonal" ,"1" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "sea_surface_slope_merid" ,"1" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "ocn_current_zonal" ,"m/s" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "ocn_current_merid" ,"m/s" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "freezing_melting_potential" ,"1" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "mixed_layer_depth" ,"m" , "will provide") +! fields for export + call fld_list_add(fldsFrIce_num, fldsFrIce, "sea_ice_fraction" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "stress_on_ocn_ice_zonal" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "stress_on_ocn_ice_merid" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "sea_ice_temperature" ,"1" , "will provide") +! call fld_list_add(fldsFrIce_num, fldsFrIce, "ice_mask" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "mean_sw_pen_to_ocn" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "mean_fresh_water_to_ocean_rate" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "mean_salt_rate" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "net_heat_flx_to_ocn" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "mean_ice_volume" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "mean_snow_volume" ,"1" , "will provide") + + end subroutine CICE_FieldsSetup + + !----------------------------------------------------------------------------- + + subroutine fld_list_add(num, fldlist, stdname, canonicalUnits, transferOffer, data, shortname) + ! ---------------------------------------------- + ! Set up a list of field information + ! ---------------------------------------------- + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: canonicalUnits + character(len=*), intent(in) :: transferOffer + real(ESMF_KIND_R8), dimension(:,:,:), optional, target :: data + character(len=*), intent(in),optional :: shortname + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(cice_cap:fld_list_add)' + ! fill in the new entry + + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num gt fldsMax "//trim(stdname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + return + endif + + fldlist(num)%stdname = trim(stdname) + fldlist(num)%canonicalUnits = trim(canonicalUnits) + if (present(shortname)) then + fldlist(num)%shortname = trim(shortname) + else + fldlist(num)%shortname = trim(stdname) + endif + fldlist(num)%transferOffer = trim(transferOffer) + if (present(data)) then + fldlist(num)%assoc = .true. + fldlist(num)%farrayPtr => data + else + fldlist(num)%assoc = .false. + endif + + end subroutine fld_list_add + + !----------------------------------------------------------------------------- + subroutine CICE_Import(st,rc) + type(ESMF_State) :: st + logical :: initflag + integer, intent(out) :: rc + real(kind=ESMF_KIND_R8), pointer :: dataPtr_sst(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_sss(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_ssh(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_sssz(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_sssm(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_ocncz(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_ocncm(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_fmpot(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_mld(:,:,:) + integer :: ilo,ihi,jlo,jhi + integer :: i,j,iblk,n,i1,i2,j1,j2 + real(kind=ESMF_KIND_R8) :: ue, vn, AngT_s + type(block) :: this_block + character(len=*),parameter :: subname='(cice_cap:CICE_Import)' + + call State_getFldPtr(st,'sea_surface_temperature',dataPtr_sst,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_surface_salinity',dataPtr_sss,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_level',dataPtr_ssh,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_surface_slope_zonal',dataPtr_sssz,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_surface_slope_merid',dataPtr_sssm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'ocn_current_zonal',dataPtr_ocncz,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'ocn_current_merid',dataPtr_ocncm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'freezing_melting_potential',dataPtr_fmpot,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mixed_layer_depth',dataPtr_mld,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + do iblk = 1,nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo,jhi + do i = ilo,ihi + i1 = i - ilo + 1 + j1 = j - jlo + 1 + sss (i,j,iblk) = dataPtr_sss (i1,j1,iblk) ! sea surface salinity (maybe for mushy layer) + sst (i,j,iblk) = dataPtr_sst (i1,j1,iblk) - Tffresh ! sea surface temp (may not be needed?) + + frzmlt (i,j,iblk) = dataPtr_fmpot (i1,j1,iblk) + ue = dataPtr_ocncz (i1,j1,iblk) + vn = dataPtr_ocncm (i1,j1,iblk) + AngT_s = ANGLET(i,j,iblk) + uocn (i,j,iblk) = ue*cos(AngT_s) - vn*sin(AngT_s) + vocn (i,j,iblk) = ue*sin(AngT_s) + vn*cos(AngT_s) + ue = dataPtr_sssz (i1,j1,iblk) + vn = dataPtr_sssm (i1,j1,iblk) + ss_tltx(i,j,iblk) = ue*cos(AngT_s) - vn*sin(AngT_s) + ss_tlty(i,j,iblk) = ue*sin(AngT_s) + vn*cos(AngT_s) + enddo + enddo + call t2ugrid_vector(ss_tltx) + call t2ugrid_vector(ss_tlty) + call t2ugrid_vector(uocn) + call t2ugrid_vector(vocn) + enddo + + end subroutine + subroutine CICE_Export(st,rc) + type(ESMF_State) :: st + integer, intent(out) :: rc +! real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_itemp(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_strocnxT(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_strocnyT(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fhocn(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fresh(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fsalt(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_vice(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_vsno(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fswthru(:,:,:) + + integer :: ilo,ihi,jlo,jhi + integer :: i,j,iblk,n,i1,i2,j1,j2 + real(kind=ESMF_KIND_R8) :: ui, vj, angT + + type(block) :: this_block + character(len=*),parameter :: subname='(cice_cap:CICE_Export)' +!TODO clean up fields +! call State_getFldPtr(st,'ice_mask',dataPtr_mask,rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_ice_fraction',dataPtr_ifrac,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_ice_temperature',dataPtr_itemp,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'stress_on_ocn_ice_zonal',dataPtr_strocnxT,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'stress_on_ocn_ice_merid',dataPtr_strocnyT,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'net_heat_flx_to_ocn',dataPtr_fhocn,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mean_fresh_water_to_ocean_rate',dataPtr_fresh,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mean_salt_rate',dataPtr_fsalt,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mean_ice_volume',dataPtr_vice,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mean_snow_volume',dataPtr_vsno,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mean_sw_pen_to_ocn',dataPtr_fswthru,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + + write(info, *) subname//' ifrac size :', & + lbound(dataPtr_ifrac,1), ubound(dataPtr_ifrac,1), & + lbound(dataPtr_ifrac,2), ubound(dataPtr_ifrac,2), & + lbound(dataPtr_ifrac,3), ubound(dataPtr_ifrac,3) + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + dataPtr_ifrac = 0._ESMF_KIND_R8 + dataPtr_itemp = 0._ESMF_KIND_R8 +! dataPtr_mask = 0._ESMF_KIND_R8 + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + do iblk = 1,nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo,jhi + do i = ilo,ihi + i1 = i - ilo + 1 + j1 = j - jlo + 1 +! if (hm(i,j,iblk) > 0.5) dataPtr_mask(i1,j1,iblk) = 1._ESMF_KIND_R8 + dataPtr_ifrac (i1,j1,iblk) = aice(i,j,iblk) ! ice fraction (0-1) + dataPtr_fhocn (i1,j1,iblk) = fhocn(i,j,iblk) ! heat exchange with ocean + dataPtr_fresh (i1,j1,iblk) = fresh(i,j,iblk) ! fresh water to ocean + dataPtr_fsalt (i1,j1,iblk) = fsalt(i,j,iblk) ! salt to ocean + dataPtr_vice (i1,j1,iblk) = vice(i,j,iblk) ! sea ice volume + dataPtr_vsno (i1,j1,iblk) = vsno(i,j,iblk) ! snow volume + dataPtr_fswthru (i1,j1,iblk) = fswthru(i,j,iblk) ! short wave penetration through ice + ui = strocnxT(i,j,iblk) + vj = strocnyT(i,j,iblk) + angT = ANGLET(i,j,iblk) + dataPtr_strocnxT(i1,j1,iblk) = ui*cos(-angT) + vj*sin(angT) ! ice ocean stress + dataPtr_strocnyT(i1,j1,iblk) = -ui*sin(angT) + vj*cos(-angT) ! ice ocean stress + enddo + enddo + enddo +! write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + + + end subroutine + +end module cice_cap diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index fbcc8413b..b41e71aa1 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -1937,6 +1937,7 @@ subroutine count_tracers nbtrcr = 0 nbtrcr_sw = 0 + nt_zbgc_frac = 0 ! vectors of size icepack_max_algae nlt_bgc_N(:) = 0 @@ -2184,7 +2185,6 @@ subroutine count_tracers enddo ! mm endif ! tr_zaero - nt_zbgc_frac = 0 if (nbtrcr > 0) then nt_zbgc_frac = ntrcr + 1 ntrcr = ntrcr + nbtrcr diff --git a/cicecore/version.txt b/cicecore/version.txt index 18921f221..43f856223 100644 --- a/cicecore/version.txt +++ b/cicecore/version.txt @@ -1 +1 @@ -CICE 6.1.1 +CICE 6.1.2 diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 73e50bf47..54a2be711 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -1,9 +1,9 @@ -#! /bin/csh -f +#!/bin/csh -f if ( $1 != "" ) then - echo ${0:t} ${1} + echo "running cice.batch.csh (creating ${1})" else - echo ${0:t} + echo "running cice.batch.csh" endif #source ./cice.settings @@ -91,7 +91,7 @@ cat >> ${jobfile} << EOFB #PBS -l walltime=${batchtime} EOFB -else if (${ICE_MACHINE} =~ thunder* || ${ICE_MACHINE} =~ gordon* || ${ICE_MACHINE} =~ conrad* || ${ICE_MACHINE} =~ gaffney* || ${ICE_MACHINE} =~ koehr*) then +else if (${ICE_MACHINE} =~ gordon* || ${ICE_MACHINE} =~ conrad* || ${ICE_MACHINE} =~ gaffney* || ${ICE_MACHINE} =~ koehr* || ${ICE_MACHINE} =~ mustang) then cat >> ${jobfile} << EOFB #PBS -N ${shortcase} #PBS -q ${queue} @@ -99,6 +99,7 @@ cat >> ${jobfile} << EOFB #PBS -l select=${nnodes}:ncpus=${maxtpn}:mpiprocs=${taskpernode} #PBS -l walltime=${batchtime} #PBS -j oe +#PBS -W umask=022 ###PBS -M username@domain.com ###PBS -m be EOFB @@ -145,18 +146,6 @@ cat >> ${jobfile} << EOFB #SBATCH --qos=standby EOFB -else if (${ICE_MACHINE} =~ loft*) then -cat >> ${jobfile} << EOFB -#PBS -N ${shortcase} -#PBS -q ${queue} -#PBS -A ${acct} -#PBS -l select=${nnodes}:ncpus=${maxtpn}:mpiprocs=${taskpernode} -#PBS -l walltime=${batchtime} -#PBS -j oe -###PBS -M username@domain.com -###PBS -m be -EOFB - else if (${ICE_MACHINE} =~ fram*) then cat >> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} @@ -204,35 +193,36 @@ cat >> ${jobfile} << EOFB #PBS -l walltime=${batchtime} EOFB -else if (${ICE_MACHINE} =~ theia*) then +else if (${ICE_MACHINE} =~ hera*) then cat >> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} -#SBATCH -t ${batchtime} -#SBATCH -q batch -#SBATCH -A marine-cpu -#SBATCH -N ${nnodes} +#SBATCH --partition=hera +#SBATCH --qos=${queue} +#SBATCH -A ${acct} +#SBATCH --time=${batchtime} +#SBATCH --nodes=${nnodes} +#SBATCH --ntasks-per-node=${taskpernodelimit} +#SBATCH --cpus-per-task=${nthrds} #SBATCH -e slurm%j.err #SBATCH -o slurm%j.out -#SBATCH --mail-type FAIL -#SBATCH --mail-user=robert.grumbine@noaa.gov +##SBATCH --mail-type FAIL +##SBATCH --mail-user=xxx@noaa.gov EOFB -else if (${ICE_MACHINE} =~ hera*) then +else if (${ICE_MACHINE} =~ orion*) then cat >> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} -#SBATCH -t `echo ${batchtime} | cut -f1-2 -d:` -#SBATCH -q batch -#SBATCH -A marine-cpu -#SBATCH -N ${nnodes} +#SBATCH --partition=orion +#SBATCH --qos=${queue} +#SBATCH -A ${acct} +#SBATCH --time=${batchtime} +#SBATCH --nodes=${nnodes} +#SBATCH --ntasks-per-node=${taskpernodelimit} +#SBATCH --cpus-per-task=${nthrds} #SBATCH -e slurm%j.err #SBATCH -o slurm%j.out -#SBATCH --mail-type FAIL -#SBATCH --mail-user=robert.grumbine@noaa.gov -EOFB - -else if (${ICE_MACHINE} =~ phase2*) then -cat >> ${jobfile} << EOFB -# nothing to do +##SBATCH --mail-type FAIL +##SBATCH --mail-user=xxx@noaa.gov EOFB else if (${ICE_MACHINE} =~ phase3*) then diff --git a/configuration/scripts/cice.build b/configuration/scripts/cice.build index eaa920ac4..b51484201 100755 --- a/configuration/scripts/cice.build +++ b/configuration/scripts/cice.build @@ -1,4 +1,4 @@ -#! /bin/csh -f +#!/bin/csh -f #==================================== # If the cice binary is passed via the --exe argument and the file exists, @@ -96,12 +96,12 @@ endif source ./cice.settings source ${ICE_CASEDIR}/env.${ICE_MACHCOMP} || exit 2 -if (${ICE_MACHINE} != ${ICE_MACHINE_ENVNAME}) then - echo "WARNING, is ICE_MACHINE setting OK, ${ICE_MACHINE}, ${ICE_MACHINE_ENVNAME}" +if (${ICE_MACHINE} != ${ICE_MACHINE_MACHNAME}) then + echo "WARNING, is ICE_MACHINE setting OK, ${ICE_MACHINE}, ${ICE_MACHINE_MACHNAME}" endif -if (${ICE_COMPILER} != ${ICE_MACHINE_COMPILER}) then - echo "WARNING, is ICE_COMPILER setting OK, ${ICE_COMPILER}, ${ICE_MACHINE_COMPILER}" +if (${ICE_ENVNAME} != ${ICE_MACHINE_ENVNAME}) then + echo "WARNING, is ICE_ENVNAME setting OK, ${ICE_ENVNAME}, ${ICE_MACHINE_ENVNAME}" endif echo " " @@ -115,13 +115,11 @@ if !(-d ${ICE_RUNDIR}) mkdir -p ${ICE_RUNDIR} if !(-d ${ICE_OBJDIR}) mkdir -p ${ICE_OBJDIR} cd ${ICE_OBJDIR} -setenv ICE_CPPDEFS " " - if (${ICE_IOTYPE} == 'netcdf') then set IODIR = io_netcdf setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" -else if (${ICE_IOTYPE} == 'pio') then - set IODIR = io_pio +else if (${ICE_IOTYPE} =~ pio*) then + set IODIR = io_pio2 setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" else set IODIR = io_binary diff --git a/configuration/scripts/cice.codecov.csh b/configuration/scripts/cice.codecov.csh new file mode 100644 index 000000000..51cce4ac7 --- /dev/null +++ b/configuration/scripts/cice.codecov.csh @@ -0,0 +1,20 @@ + +#--- cice.codecov.csh --- + +#if ( ${use_curl} == 1 ) then +# bash -c "bash <(curl -s https://codecov.io/bash) -n '${report_name}' -y ./codecov.yml " +#else +# bash -c "bash <(wget -O - https://codecov.io/bash) -n '${report_name}' -y ./codecov.yml " +#endif + +if ( ${use_curl} == 1 ) then + curl https://codecov.io/bash -o codecov.bash +else + wget https://codecov.io/bash -O codecov.bash +endif +chmod +x codecov.bash +sed -i.sedbak 's|mktemp /tmp/|mktemp ./|g' codecov.bash +bash -c "bash ./codecov.bash -n '${report_name}' -y ./codecov.yml" + +sleep 10 +rm -r -f ./*/codecov_output diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index 48d6c0062..dfbffd6ab 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -1,4 +1,4 @@ -#! /bin/csh -f +#!/bin/csh -f #echo ${0} echo "running cice.launch.csh" @@ -46,19 +46,7 @@ EOFR endif #======= -else if (${ICE_MACHINE} =~ thunder*) then -if (${ICE_COMMDIR} =~ serial*) then -cat >> ${jobfile} << EOFR -./cice >&! \$ICE_RUNLOG_FILE -EOFR -else -cat >> ${jobfile} << EOFR -mpiexec_mpt -np ${ntasks} omplace ./cice >&! \$ICE_RUNLOG_FILE -EOFR -endif - -#======= -else if (${ICE_MACHINE} =~ gaffney* || ${ICE_MACHINE} =~ koehr*) then +else if (${ICE_MACHINE} =~ gaffney* || ${ICE_MACHINE} =~ koehr* || ${ICE_MACHINE} =~ mustang*) then if (${ICE_COMMDIR} =~ serial*) then cat >> ${jobfile} << EOFR ./cice >&! \$ICE_RUNLOG_FILE @@ -105,17 +93,6 @@ mpirun -np ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE EOFR endif -#======= -else if (${ICE_MACHINE} =~ loft*) then -if (${ICE_COMMDIR} =~ serial*) then -cat >> ${jobfile} << EOFR -./cice >&! \$ICE_RUNLOG_FILE -EOFR -else -cat >> ${jobfile} << EOFR -aprun -n ${ntasks} -N ${taskpernodelimit} -d ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE -EOFR -endif #======= else if (${ICE_MACHINE} =~ fram*) then if (${ICE_COMMDIR} =~ serial*) then @@ -165,21 +142,19 @@ EOFR endif #======= -else if (${ICE_MACHINE} =~ theia*) then +else if (${ICE_MACHINE} =~ hera*) then cat >> ${jobfile} << EOFR -#mpirun -np ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE srun -n ${ntasks} -c ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE -#./cice >&! \$ICE_RUNLOG_FILE EOFR + #======= -else if (${ICE_MACHINE} =~ high_Sierra*) then +else if (${ICE_MACHINE} =~ orion*) then cat >> ${jobfile} << EOFR -mpirun -np ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE -#./cice >&! \$ICE_RUNLOG_FILE +srun -n ${ntasks} -c ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE EOFR #======= -else if (${ICE_MACHINE} =~ phase2*) then +else if (${ICE_MACHINE} =~ high_Sierra*) then cat >> ${jobfile} << EOFR mpirun -np ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE #./cice >&! \$ICE_RUNLOG_FILE @@ -191,26 +166,13 @@ cat >> ${jobfile} << EOFR mpirun -np ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE #./cice >&! \$ICE_RUNLOG_FILE EOFR + #======= else if (${ICE_MACHINE} =~ testmachine*) then cat >> ${jobfile} << EOFR ./cice >&! \$ICE_RUNLOG_FILE EOFR -#======= -else if (${ICE_MACHINE} =~ phase3*) then -cat >> ${jobfile} << EOFR -mpirun -np ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE -EOFR - -#======= -else if (${ICE_MACHINE} =~ phase2*) then -cat >> ${jobfile} << EOFR -mpirun -np ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE -EOFR - -======= - #======= else if (${ICE_MACHINE} =~ travisCI*) then if (${ICE_COMMDIR} =~ serial*) then diff --git a/configuration/scripts/cice.lcov.csh b/configuration/scripts/cice.lcov.csh new file mode 100644 index 000000000..0274e0eac --- /dev/null +++ b/configuration/scripts/cice.lcov.csh @@ -0,0 +1,46 @@ + +#--- cice.lcov.csh --- + +echo ${lcovalist} +lcov ${lcovalist} -o total.info + +set lcovrepo = apcraig.github.io +set lcovhtmldir = lcov_cice_${report_name} +genhtml -o ./${lcovhtmldir} --precision 2 -t "${report_name}" total.info + +git clone https://github.com/apcraig/${lcovrepo} +cp -p -r ${lcovhtmldir} ${lcovrepo}/ + +cd ${lcovrepo} +set covp0 = `grep message coverage.json | cut -d : -f 2 | cut -d \" -f 2 | cut -d % -f 1` +set covp = `grep -i headerCovTableEntryLo ${lcovhtmldir}/index.html | head -1 | cut -d \> -f 2 | cut -d % -f 1` +set covpi = `echo $covp | cut -d . -f 1` + +set lcovhtmlname = "${covpi}%:${report_name}" +set oline = `grep -n "add_cice_entry_here" index.html | head -1 | cut -d : -f 1` +@ nline = ${oline} +sed -i "$nline a