[cdftools] 93/228: JMM : Commit CDFTOOLS_3.0 on the trunk
Alastair McKinstry
mckinstry at moszumanska.debian.org
Fri Jun 12 08:21:33 UTC 2015
This is an automated email from the git hooks/post-receive script.
mckinstry pushed a commit to branch master
in repository cdftools.
commit 92c21a5931bf9d67d41b3627a60818955b85b497
Author: molines <molines at 1055176f-818a-41d9-83e1-73fbe5b947c5>
Date: Mon Jul 11 10:33:35 2011 +0000
JMM : Commit CDFTOOLS_3.0 on the trunk
git-svn-id: http://servforge.legi.grenoble-inp.fr/svn/CDFTOOLS/trunk@539 1055176f-818a-41d9-83e1-73fbe5b947c5
---
DEV_TOOLS/liste | 194 +++
DEV_TOOLS/tagfunction.tpl | 9 +
DEV_TOOLS/tagmodule.tpl | 16 +
DEV_TOOLS/tagprogram.tpl | 21 +
DEV_TOOLS/tagroutine.tpl | 10 +
DEV_TOOLS/tagusage.tpl | 24 +
JOBS/MKMTL/gib.ksh | 34 -
JOBS/MKMTL/heat.ksh | 78 -
JOBS/MKMTL/ice.ksh | 37 -
JOBS/MKMTL/ice_month.ksh | 65 -
JOBS/MKMTL/maxmoc.ksh | 72 -
JOBS/MKMTL/maxmoc40.ksh | 49 -
JOBS/MKMTL/mkmtl.ksh | 66 -
JOBS/MKMTL/nino.ksh | 9 -
JOBS/MKMTL/profile.ksh | 69 -
JOBS/MKMTL/profile_lev.ksh | 93 -
JOBS/MKMTL/section.ksh | 57 -
JOBS/MKMTL/trc.ksh | 75 -
JOBS/MKMTL/trpsig.ksh | 40 -
JOBS/cdf16bit.ll | 24 -
JOBS/cdfbn2.ll | 45 -
JOBS/cdfbuoyflx.ksh | 33 -
JOBS/cdfeke-inter.ll | 42 -
JOBS/cdfeke.ll | 43 -
JOBS/cdfets.ll | 45 -
JOBS/cdfflxconv.ll | 100 --
JOBS/cdfgib.ll | 55 -
JOBS/cdfhflx.ll | 45 -
JOBS/cdfice.ll | 54 -
JOBS/cdfmaxmoc.ll | 72 -
JOBS/cdfmaxmoc40.ll | 27 -
JOBS/cdfmeanvar.ll | 57 -
JOBS/cdfmeanvar.log | 10 -
JOBS/cdfmhst-full.ll | 50 -
JOBS/cdfmhst.ll | 50 -
JOBS/cdfmoc-full.ll | 45 -
JOBS/cdfmoc-inter.ll | 49 -
JOBS/cdfmoc.ll | 49 -
JOBS/cdfmoy-ets.ll | 46 -
JOBS/cdfmoy-inter.ll | 257 ---
JOBS/cdfmoy-inter_month.ll | 158 --
JOBS/cdfmoy.ll | 323 ----
JOBS/cdfmoy_jade_new.ksh | 124 --
JOBS/cdfmoy_multiple.ksh | 78 -
JOBS/cdfmoy_skel_new.ksh | 116 --
JOBS/cdfmoy_skel_vargas.ksh | 80 -
JOBS/cdfmoy_trc_skel_new.ksh | 102 --
JOBS/cdfmoymxl.ll | 48 -
JOBS/cdfmoyvt_jade_new.ksh | 139 --
JOBS/cdfmoyvt_skel_new.ksh | 328 ----
JOBS/cdfmxl.ll | 44 -
JOBS/cdfpsi-inter.ll | 44 -
JOBS/cdfpsi.ll | 49 -
JOBS/cdfrms.ll | 51 -
JOBS/cdfsigma0.ll | 43 -
JOBS/cdfsigtrp_1month.ll | 82 -
JOBS/cdfsstconv.ll | 101 --
JOBS/cdfstrconv.ll | 86 -
JOBS/cdftransportiz-full.ll | 52 -
JOBS/cdftransportiz.ll | 56 -
JOBS/cdftrc.ll | 81 -
JOBS/cdfvT-inter.ll | 57 -
JOBS/cdfvT.ll | 108 --
JOBS/cdfvT_jade_new.ksh | 129 --
JOBS/cdfvT_skel_new.ksh | 116 --
JOBS/cdfvT_skel_vargas.ksh | 80 -
JOBS/cdfvhst-full.ll | 56 -
JOBS/cdfvhst.ll | 57 -
JOBS/cdfvsig_skel.ksh | 92 -
JOBS/cdfwflx.ksh | 30 -
JOBS/config_def_ORCA025_zahir.ksh | 23 -
JOBS/config_def_SKEL_brodie.ksh | 24 -
JOBS/config_def_SKEL_jade.ksh | 33 -
JOBS/config_def_SKEL_mirage.ksh | 24 -
JOBS/config_def_SKEL_zahir.ksh | 24 -
JOBS/convclipper2nc.ksh | 53 -
JOBS/cpmoyvt_jade.ksh | 27 -
JOBS/example_polymask | 15 -
JOBS/function_def_jade.ksh | 123 --
JOBS/function_def_mirage.ksh | 82 -
JOBS/function_def_vargas.ksh | 84 -
JOBS/function_def_zahir.ksh | 84 -
JOBS/icemonth.ksh | 61 -
JOBS/meta-moy-mon.skel.ll | 34 -
JOBS/metamon | 72 -
JOBS/metamon_skel_vargas.ksh | 79 -
JOBS/metamoy.ksh | 36 -
JOBS/mkmoy_jade.ksh | 39 -
JOBS/mkordre | 32 -
JOBS/mkordremean | 32 -
JOBS/mkvt_jade.ksh | 39 -
JOBS/monitor.csh | 365 ----
JOBS/monitor_noheat.csh | 255 ---
JOBS/monitor_prod.ksh | 642 -------
JOBS/monitor_prod_jade.ksh | 553 ------
JOBS/monitor_prod_kiel.ksh | 955 ----------
JOBS/monitor_prod_work.ksh | 765 --------
JOBS/monitor_testOK_jade.ksh | 7 -
JOBS/testOK.ksh | 7 -
JOBS/trpsig_postproc.ksh | 90 -
License/CDFTOOLSCeCILL.txt | 36 +
macro.g95 => Macrolib/macro.g95 | 0
Macrolib/macro.gfortran | 14 +
macro.gorgon => Macrolib/macro.gorgon | 0
macro.ifort => Macrolib/macro.ifort | 2 +-
macro.ifort_ursus => Macrolib/macro.ifort_ursus | 0
macro.jade => Macrolib/macro.jade | 0
macro.mac => Macrolib/macro.mac | 0
macro.meolkara => Macrolib/macro.meolkara | 4 +-
macro.meolkerg => Macrolib/macro.meolkerg | 11 +-
macro.mirage => Macrolib/macro.mirage | 0
macro.nymphea => Macrolib/macro.nymphea | 0
macro.p630 => Macrolib/macro.p630 | 0
macro.pgi => Macrolib/macro.pgi | 0
macro.porzig => Macrolib/macro.porzig | 0
macro.rhodes => Macrolib/macro.rhodes | 0
macro.sx8 => Macrolib/macro.sx8 | 0
macro.vargas => Macrolib/macro.vargas | 2 +-
macro.zahir => Macrolib/macro.zahir | 0
Makefile | 485 ++----
Makefile_ursus | 241 ---
bimgcaltrans.f90 | 68 -
bimgmoy4.f90 | 334 ----
cdf16bit.f90 | 798 ++++-----
cdf2matlab.f90 | 238 +--
cdfbathy.f90 | 694 +++++---
cdfbci.f90 | 256 +--
cdfbn2-full.f90 | 153 --
cdfbn2.f90 | 291 ++--
cdfbottom.f90 | 241 +--
cdfbottomsig.f90 | 166 ++
cdfbottomsig0.f90 | 114 --
cdfbottomsigi.f90 | 117 --
cdfbti.f90 | 431 ++---
cdfbuoyflx.f90 | 528 +++---
cdfcensus.f90 | 591 ++++---
cdfclip.f90 | 355 ++--
cdfcofpoint.f90 => cdfcoastline.f90 | 36 +-
cdfcofdis.f90 | 223 ++-
cdfcoloc.f90 | 803 ++++++---
cdfcoloc2.f90 | 332 ----
cdfcoloc2D.f90 | 239 ---
cdfcoloc3.f90 | 345 ----
cdfconvert.f90 | 840 ++++-----
cdfcsp.f90 | 172 +-
cdfcurl.f90 | 231 +--
cdfdifmask.f90 | 162 +-
cdfeke.f90 | 215 ++-
cdfets.f90 | 330 ++--
cdffindij.f90 | 113 +-
cdffixtime.f90 | 414 +++--
cdfflxconv.f90 | 84 +-
cdffracinv.f90 | 188 +-
cdfgeo-uv.f90 | 315 ++--
cdfhdy.f90 | 342 ++--
cdfhdy3d.f90 | 360 ++--
cdfheatc-full.f90 | 171 --
cdfheatc.f90 | 312 ++--
cdfhflx.f90 | 402 ++---
cdficediags.f90 | 387 +++--
cdfimprovechk.f90 | 231 +--
cdfinfo.f90 | 119 +-
cdfio.f90 | 2104 ++++++++++++-----------
cdfisopsi.f90 | 734 ++++----
cdfisopycdep.f90 | 182 --
cdfkempemekeepe.f90 | 193 ++-
cdflinreg.f90 | 406 ++---
cdflspv.f90 | 157 --
cdfmaskdmp.f90 | 251 +--
cdfmasstrp-full.f90 | 469 -----
cdfmasstrp.f90 | 469 -----
cdfmax-test.f90 | 285 ---
cdfmax.f90 | 368 ++--
cdfmax_sp.f90 | 288 ----
cdfmaxmoc.f90 | 352 ++--
cdfmean-full.f90 | 173 --
cdfmean.f90 | 682 +++++---
cdfmeanvar.f90 | 184 --
cdfmhst-full.f90 | 359 ----
cdfmhst.f90 | 719 ++++----
cdfmht_gsop.f90 | 106 +-
cdfmkmask-zone.f90 | 142 --
cdfmkmask.f90 | 265 ++-
cdfmltmask.f90 | 214 ++-
cdfmoc-full.f90 | 201 ---
cdfmoc.f90 | 778 +++++++--
cdfmoc_gsop.f90 | 424 -----
cdfmoc_gsop_x.f90 | 507 ------
cdfmocatl.f90 | 156 --
cdfmocsig-full.f90 | 247 ---
cdfmocsig.f90 | 623 ++++---
cdfmoy.f90 | 545 ++++--
cdfmoy3.f90 | 261 ---
cdfmoy_annual.f90 | 143 --
cdfmoy_chsp.f90 | 198 ---
cdfmoy_freq.f90 | 278 +--
cdfmoy_mpp.f90 | 282 ---
cdfmoy_sal2_temp2.f90 | 169 --
cdfmoy_sp.f90 | 196 ---
cdfmoy_weighted.f90 | 290 ++--
cdfmoyt.f90 | 430 +++--
cdfmoyuv.f90 | 193 ---
cdfmoyuvwt.f90 | 608 +++----
cdfmppini.f90 | 180 +-
cdfmsk.f90 | 105 +-
cdfmsksal.f90 | 78 -
cdfmxl-full.f90 | 181 --
cdfmxl.f90 | 360 ++--
cdfmxlhcsc.f90 | 498 +++---
cdfmxlheatc-full.f90 | 138 --
cdfmxlheatc.f90 | 271 +--
cdfmxlsaltc.f90 | 283 +--
cdfnamelist.f90 | 108 ++
cdfnan.f90 | 228 +--
cdfnorth_unfold.f90 | 370 ++--
cdfnrjcomp.f90 | 254 +--
cdfovide.f90 | 351 ++--
cdfpendep.f90 | 226 ++-
cdfpolymask.f90 | 243 +--
cdfprobe.f90 | 78 +-
cdfprofile.f90 | 201 ++-
cdfpsi-austral-ssh.f90 | 232 ---
cdfpsi-full.f90 | 155 --
cdfpsi-open-zap.f90 | 182 --
cdfpsi-open.f90 | 197 ---
cdfpsi-open_AM.f90 | 151 --
cdfpsi.f90 | 513 ++++--
cdfpsi_level.f90 | 22 +-
cdfpv.f90 | 205 ---
cdfpvor-full.f90 | 239 ---
cdfpvor.f90 | 504 +++---
cdfrhoproj.f90 | 437 +++--
cdfrichardson.f90 | 224 +++
cdfrmsssh.f90 | 205 ++-
cdfsig0.f90 | 187 +-
cdfsigi.f90 | 195 ++-
cdfsiginsitu.f90 | 188 +-
cdfsigintegr.f90 | 568 +++---
cdfsigitrp.f90 | 461 -----
cdfsigtrp-full.f90 | 449 -----
cdfsigtrp.f90 | 1114 +++++++-----
cdfsigtrp2.f90 | 394 -----
cdfsmooth.f90 | 823 +++++----
cdfspeed.f90 | 259 +--
cdfspice.f90 | 228 ++-
cdfsstconv.f90 | 84 +-
cdfstatcoord.f90 | 147 +-
cdfstd.f90 | 285 +--
cdfstdevts.f90 | 230 ++-
cdfstdevw.f90 | 201 ++-
cdfstrconv.f90 | 28 +-
cdfsum.f90 | 319 ++--
cdftemptrp-full.f90 | 425 -----
cdftools.f90 | 592 ++++---
cdftransig_xy3d.f90 | 629 ++++---
cdftransport.f90 | 1120 ++++++++++++
cdftransportiz-full.f90 | 506 ------
cdftransportiz.f90 | 641 -------
cdftransportiz_magda.f90 | 661 -------
cdftransportiz_noheat.f90 | 511 ------
cdftransportiz_noheat_obc.f90 | 656 -------
cdftransportizpm.f90 | 549 ------
cdftrp_bathy.f90 | 153 --
cdftrp_gaelle.f90 | 364 ----
cdfvT.f90 | 317 ++--
cdfvar.f90 | 372 ----
cdfvertmean.f90 | 365 ++--
cdfvhst-full.f90 | 172 --
cdfvhst.f90 | 334 ++--
cdfvita.f90 | 352 ++--
cdfvsig.f90 | 494 +++---
cdfvtrp.f90 | 333 ++--
cdfw.f90 | 291 ++--
cdfweight.f90 | 829 ++++-----
cdfweight2D.f90 | 516 ------
cdfwflx.f90 | 202 ++-
cdfwhereij.f90 | 158 +-
cdfzeromean.f90 | 239 ---
cdfzonalintdeg.f90 | 287 ----
cdfzonalmean.f90 | 449 ++---
cdfzonalout.f90 | 156 +-
cdfzonalsum.f90 | 491 +++---
cdfzoom.f90 | 330 ++--
coordinates2hgr.f90 | 277 ---
coordinates2hgr_karine.f90 | 282 ---
coordinates2zgr.f90 | 239 ---
coordinates2zgr_karine.f90 | 244 ---
eos.f90 | 748 ++++----
modcdfnames.f90 | 290 ++++
modpoly.f90 | 360 ++--
modutils.f90 | 90 +
section.dat | 57 -
tag | 4 -
293 files changed, 24087 insertions(+), 44529 deletions(-)
diff --git a/DEV_TOOLS/liste b/DEV_TOOLS/liste
new file mode 100644
index 0000000..d6c2adc
--- /dev/null
+++ b/DEV_TOOLS/liste
@@ -0,0 +1,194 @@
+Programs
+cdf16bit.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfbathy.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add cdfvar capability. keep link cdfvar -> cdfbathy in Makefile *
+cdfbci.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfbn2.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfbottom.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfbottomsig.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfbti.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfbuoyflx.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfcensus.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfclip.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfcofdis.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfcsp.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfdifmask.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfeke.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfets.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdffindij.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfmoy.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfmoy_chsp (-spval0 option ) **
+ ** merge with cdfmoy3 (-cub -zeromean options) **
+cdfhdy.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfhdy3d.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfzoom.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdficediags.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfcurl.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfinfo.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdflinreg.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfnan.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfspeed.f90: !! CDFTOOLS_3.0 , MEOM 2011 ** bug fixed in 3.0 ** chk
+cdfvita.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfsmooth.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfsum.f90: !! CDFTOOLS_3.0 , MEOM 2011 ** need clarifications for forcing vs model file ** chk
+cdfmean.f90: !! CDFTOOLS_3.0 , MEOM 2011 ** now also deal with full step, using -full option,
+ and variance with -var option
+ and zeromean with -zeromean option ** chk
+cdfstatcoord.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfmax.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfprobe.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfprofile.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfwhereij.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfmsk.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** not that important ! **
+cdfmkmask.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merged with cdfmkmask-zone by adding -zoom option **
+cdfpolymask.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfmltmask.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfnorth_unfold.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfimprovechk.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfsig0.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfsigi.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfsiginsitu.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfspice.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfmaskdmp.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfnrjcomp.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfkempemekeepe.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfpendep.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdffracinv.f90 !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfvertmean.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add -full option **
+cdfmxlheatc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add -full option **
+cdfmxl.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfgeo-uv.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** bug fix for fmask and ff **
+cdfmxlsaltc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add -full option **
+cdfmxlhcsc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** improved and optimized **
+cdfheatc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add -full option **
+cdfhflx.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfmppini.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfw.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfstd.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfnamelist.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** NEW tool !
+cdf2matlab.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfisopsi.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** check effect of double precision **
+cdfweight.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfweight2D **
+cdfcoloc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfcoloc2, cdfcoloc3, cdfcoloc2D **
+cdfmaxmoc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfmoc.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfmoc_full, and with cdfmoc_gsop ! **
+cdfmocsig.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfmocsig_full. Improve interface **
+cdftransport.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with full, Magdalena version
+ , add new options -noheat -time -plus_minus (-pm)
+ and -obc for obc input files. **
+
+cdffixtime.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** NEW tool !
+cdfvhst.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with -full version **
+cdfvT.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk **
+cdfvsig.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk **
+cdfmoy_weighted.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfmoy_annual with -old5d option **
+cdfmoyt.f90 !! CDFTOOLS_3.0 , MEOM 2011 chk ** to be tested **
+cdfwflx.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfrichardson.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** NEW tool !
+cdfvtrp.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdftrp_bathy **
+cdfmhst.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfmhst-full **
+cdfzonalmean.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** improvement to be done for partial steps ... **
+cdfzonalout.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfzonalsum.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** very similar to cdfzonalmean.
+ Merge cdfzonalintdeg as an option (-pdeg) **
+cdfstdevw.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfrmsssh.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfstdevts.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfconvert.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfpsi.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merged with variant of cdfspi-open **
+cdfpvor.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merged with -full and cdfpv, cdflspv **
+cdfrhoproj.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk
+cdfmoyuvwt.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merged/replace cdfmoyuv **
+cdfsigtrp.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merged with cdfsigitrp, cdfsigtrp-full **
+cdfsigintegr.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** add -full **
+cdfmoy_freq.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** in work ... **
+cdftransig_xy3d.f90 !! CDFTOOLS_3.0 , MEOM 2011 chk ** same algo than original but options instead of editing program **
+
+Modules
+cdfio.f90: !! CDFTOOLS_3.0 , MEOM 2011
+cdftools.f90: !! CDFTOOLS_3.0 , MEOM 2011
+eos.f90: !! CDFTOOLS_3.0 , MEOM 2011
+modcdfnames.f90: !! CDFTOOLS_3.0 , MEOM 2011
+modpoly.f90: !! CDFTOOLS_3.0 , MEOM 2011
+modutils.f90 !! CDFTOOLS_3.0 , MEOM 2011 ** new module for general utilities **
+
+TO DO ...
+#--------
+cdfmht_gsop.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $
+
+cdfpsi_level.f90: !! $Date: 2009-07-21 17:49:27 +0200 (mar. 21 juil. 2009) $
+
+cdfsections.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ! Nicolas Jourdain work
+
+cdftempvol-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** to be generalized for volume of
+
+cdfflxconv.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $
+cdfsstconv.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $
+cdfstrconv.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $
+
+# new since rev 355
+
+# sans Id
+cdfcoastline.f90
+cdfovide : working on it for simplification
+
+# REMOVED
+cdfmean-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** obsolete (see cdfmean) **
+cdfmeanvar.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** obsolete (see cdfmean) **
+cdfzeromean.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** obsolete (see cdfmean) **
+cdfmax_sp.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** obsolete (see cdfmax) **
+cdfmax-test.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** obsolete (removed) **
+cdfbn2-full.f90: !! CDFTOOLS_3.0 , MEOM 2011 ** obsolete option -full coded in cdfbn2 **
+cdfmsksal.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** removed see cdfmkmask **
+cdfmkmask-zone.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** removed see cdfmkmask **
+cdfmxlheatc-full.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** see cdfmxlheatc -full **
+cdfmxl-full.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** see cdfmxl **
+cdfheatc-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** cdf cdfheatc **
+cdfvar.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfbathy **
+cdfmoy_chsp.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmoy -spval0 **
+cdfmoy_sp.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmoy -spval0 (with some diff) **
+cdfweight2D.f90: !! $Date: 2007-12-14 09:21:24 +0100 (Fri, 14 Dec 2007) $ ** merged with cdfweight -2d **
+cdfcoloc2.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfcoloc.f90 **
+cdfcoloc2D.f90: !! $Date: 2007-05-18 16:31:17 +0200 (Fri, 18 May 2007) $ ** merged with cdfcoloc.f90 **
+cdfcoloc3.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfcoloc.f90 **
+cdfmoc-full.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmoc.f90 [-full] option **
+cdfmocatl.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** use cdfmoc w/o basin mask file **
+cdfmoc_gsop.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** use cdfmoc with -decomp
+cdfmoc_gsop_x.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** obsolete **
+cdfmocsig-full.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** use cdfmocdig -full **
+cdftransportiz.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ! Magdalena Alonso Balmaseda version
+cdftransportiz-old.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdftransport **
+cdftransportiz-full.f90:!! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdftransport **
+cdftransportiz_noheat.f90: !! $Date: 2010-06-08 17:51:34 +0200 (Tue, 08 Jun 2010) $ ** merged with cdftransport **
+cdfmasstrp.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdftransport **
+cdfmasstrp-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdftransport **
+cdfvhst-full.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfvhst **
+cdfbottomsigi.f90: !! CDFTOOLS_3.0 , MEOM 2011 chk ** merge with cdfbottomsig cdfbottomsig0 **
+cdfmoy_annual.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmoy_weighted -old5d **
+cdfmoy_sal2_temp2.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** use cdfmoy and modify cdf namelist
+cdftrp_bathy.f90: !! $Date: 2010-12-15 00:26:11 +0100 (Wed, 15 Dec 2010) $ ** merged with cdfvtrp **
+cdftrp_gaelle.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** a variant of cdfsigtrp with many bugs ... remove !
+cdfmhst-full.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmhst **
+cdfzonalintdeg.f90: !! $Date: 2009-07-21 17:49:27 +0200 (mar 21 jui 2009) $ ** merged with cdfzonalsum, option -pdeg **
+cdfpsi-full.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfpsi **
+cdfpsi-open.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfpsi **
+cdfpsi-open_AM.f90 NO ID angelique ** merged with cdfpsi **
+cdfpsi-open-zap.f90 NO ID zapiola ** merged with cdfpsi **
+cdfpv.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfpvor **
+cdfpvor-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfpvor **
+cdflspv.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfpvor **
+cdfisopycdep.f90: !! $Date: 2010-12-14 23:45:48 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfrhoproj, -isodep option **
+cdfmoyuv.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** obsolete, cdfmoyuvwt does the same **
+cdfsigtrp2.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** obsolete **
+cdfsigtrp-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfsigtrp **
+cdfsigitrp.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merged with cdfsigitrp **
+cdfmoy3.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merged with cdfmoy **
+cdfmoy_mpp.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** never used .. !**
+cdftransportizpm.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merge with cdftransport -pm option **
+cdftemptrp-full.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** merges with cdfsigtrp with -temp option **
+cdftransportiz_noheat_obc.f90:!! $Date: 2009-09-08 17:49:35 +0200 (Tue, 08 Sep 2009) $ ** included with -obc option in cdftransport **
+bimgcaltrans.f90: !! $Date: 2009-08-06 10:45:06 +0200 (Thu, 06 Aug 2009) $ ** obsolete, netcdf file are now used in cdfsigtrp
+bimgmoy4.f90: !! $Date: 2009-04-28 19:33:08 +0200 (Tue, 28 Apr 2009) $ ** obsolete, netcdf file are now used in cdfsigtrp
+coordinates2hgr.f90: !! $Date: 2010-11-23 13:57:24 +0100 (Tue, 23 Nov 2010) $ ** kept in 2.1,erased from 3.0
+coordinates2hgr_karine.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** kept in 2.1,erased from 3.0
+coordinates2zgr.f90: !! $Date: 2010-11-23 13:57:24 +0100 (Tue, 23 Nov 2010) $ ** kept in 2.1,erased from 3.0
+coordinates2zgr_karine.f90: !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $ ** kept in 2.1,erased from 3.0
+cdfpsi-austral-ssh.f90: !! $Date: 2010-12-14 22:18:44 +0100 (Tue, 14 Dec 2010) $ ** merge with cdfpsi option -ssh Tfile **
diff --git a/DEV_TOOLS/tagfunction.tpl b/DEV_TOOLS/tagfunction.tpl
new file mode 100644
index 0000000..ca758d5
--- /dev/null
+++ b/DEV_TOOLS/tagfunction.tpl
@@ -0,0 +1,9 @@
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION <function> ***
+ !!
+ !! ** Purpose :
+ !!
+ !! ** Method :
+ !!
+ !!----------------------------------------------------------------------
+
diff --git a/DEV_TOOLS/tagmodule.tpl b/DEV_TOOLS/tagmodule.tpl
new file mode 100644
index 0000000..a3f6e3b
--- /dev/null
+++ b/DEV_TOOLS/tagmodule.tpl
@@ -0,0 +1,16 @@
+ !!======================================================================
+ !! *** MODULE <module> ***
+ !! < short_description>
+ !!=====================================================================
+ !! History : <ver ! date name action
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
diff --git a/DEV_TOOLS/tagprogram.tpl b/DEV_TOOLS/tagprogram.tpl
new file mode 100644
index 0000000..5a2ac2a
--- /dev/null
+++ b/DEV_TOOLS/tagprogram.tpl
@@ -0,0 +1,21 @@
+ !!======================================================================
+ !! *** PROGRAM <module> ***
+ !!=====================================================================
+ !! ** Purpose :
+ !!
+ !! ** Method :
+ !!
+ !! History : 2.1 : 11/2006 : J.M. Molines : Original code
+ !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !!----------------------------------------------------------------------
+
+
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
diff --git a/DEV_TOOLS/tagroutine.tpl b/DEV_TOOLS/tagroutine.tpl
new file mode 100644
index 0000000..ef29733
--- /dev/null
+++ b/DEV_TOOLS/tagroutine.tpl
@@ -0,0 +1,10 @@
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE <routine> ***
+ !!
+ !! ** Purpose :
+ !!
+ !! ** Method :
+ !!
+ !! References :
+ !!----------------------------------------------------------------------
+
diff --git a/DEV_TOOLS/tagusage.tpl b/DEV_TOOLS/tagusage.tpl
new file mode 100644
index 0000000..2e9dbb0
--- /dev/null
+++ b/DEV_TOOLS/tagusage.tpl
@@ -0,0 +1,24 @@
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage :
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_out),' ( )'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,'
+ PRINT *,' '
+ STOP
+ ENDIF
diff --git a/JOBS/MKMTL/gib.ksh b/JOBS/MKMTL/gib.ksh
deleted file mode 100755
index 5306eed..0000000
--- a/JOBS/MKMTL/gib.ksh
+++ /dev/null
@@ -1,34 +0,0 @@
-#!/bin/ksh
-
-# gib.ksh : create a matlab file with
-# 1rst line = depth
-# 2nd line = Tlevitus
-# 3rd line = Slevitus
-# then a pair of lines (T S ) foreach year. First column gives the year
-dir=$( basename `pwd` )
-CONFIG=${dir%-DIAGS}
-if [ ! -d ../${CONFIG}-MONITOR ] ; then mkdir ../${CONFIG}-MONITOR ; fi
-
-\rm -f ${CONFIG}_gib.mtl
-# if no *TGIB.txt files in the dir, skip
- ls *TGIB.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no gib files to deal with ... ; exit ; fi
-
-dep=$( cat LEVITUS_y0000_TGIB.txt | grep 'Mean value at level' | awk '{ printf "%8.1f",$7 }' )
-Tlev=$( cat LEVITUS_y0000_TGIB.txt | grep 'Mean value at level' | awk '{ printf "%8.4f", $9 }' )
-Slev=$( cat LEVITUS_y0000_SGIB.txt | grep 'Mean value at level' | awk '{ printf "%8.4f", $9 }' )
-
-echo 0000 $dep > ${CONFIG}_gib.mtl
-echo 0000 $Tlev >> ${CONFIG}_gib.mtl
-echo 0000 $Slev >> ${CONFIG}_gib.mtl
-
-for tfile in ${CONFIG}_y????_TGIB.txt ; do
- sfile=$( echo $tfile | sed -e 's/TGIB/SGIB/' )
- year=$( head -1 $tfile )
- Tcur=$( cat $tfile | grep 'Mean value at level' | awk '{ printf "%8.4f", $9 }' )
- Scur=$( cat $sfile | grep 'Mean value at level' | awk '{ printf "%8.4f", $9 }' )
- echo $year $Tcur >> ${CONFIG}_gib.mtl
- echo $year $Scur >> ${CONFIG}_gib.mtl
-done
-
-mv ${CONFIG}_gib.mtl ../${CONFIG}-MONITOR/
diff --git a/JOBS/MKMTL/heat.ksh b/JOBS/MKMTL/heat.ksh
deleted file mode 100755
index 7a2f0d6..0000000
--- a/JOBS/MKMTL/heat.ksh
+++ /dev/null
@@ -1,78 +0,0 @@
-#!/bin/ksh
-# This script scan the years of hflx and heat diags
-dir=$( basename `pwd` )
-CONFIG=${dir%-DIAGS}
-
- \rm -f heat.mtl
-# if no heattrp.dat files in the dir, skip
- ls *heattrp.dat 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no heattrp to deal with ... ; exit ; fi
- ls *hflx.dat 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no hflx to deal with ... ; exit ; fi
-
-n=0
-for f in ${CONFIG}_y????_heattrp.dat ; do
- n=$(( n + 1 ))
- year=$( echo $f | sed -e "s/${CONFIG}_y//" -e 's/_heattrp.dat//' )
- flx=$( echo $f | sed -e 's/heattrp/hflx/' )
-
-if [ $n == 1 ] ; then
-# output latitude (North to South) on the first row
- echo -n 0000 >> heat.mtl
- cat $f |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $2} \
- }\
- END{ printf "\n" }' >> heat.mtl
-fi
-
-# Global Ocean
- echo -n $year >> heat.mtl
- cat $f |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $3} \
- }\
- END{ printf "\n" }' >> heat.mtl
-
- echo -n $year >> heat.mtl
- cat $flx |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $3} \
- }\
- END{ printf "\n" }' >> heat.mtl
-
-
-# Atlantic Ocean
- echo -n $year >> heat.mtl
- cat $f |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $4} \
- }\
- END{ printf "\n" }' >> heat.mtl
-
- echo -n $year >> heat.mtl
- cat $flx |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $4} \
- }\
- END{ printf "\n" }' >> heat.mtl
-
-# Indo-Pacific Ocean
- echo -n $year >> heat.mtl
- cat $f |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $5 + $6 } \
- }\
- END{ printf "\n" }' >> heat.mtl
-
- echo -n $year >> heat.mtl
- cat $flx |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $5 } \
- }\
- END{ printf "\n" }' >> heat.mtl
-
-done
-
-mv heat.mtl ../${CONFIG}-MONITOR/${CONFIG}_heat.mtl
-
diff --git a/JOBS/MKMTL/ice.ksh b/JOBS/MKMTL/ice.ksh
deleted file mode 100755
index 4ce06d7..0000000
--- a/JOBS/MKMTL/ice.ksh
+++ /dev/null
@@ -1,37 +0,0 @@
-#!/bin/ksh
-# ice.ksh : build a line of matlab file for ice output
-#set -x
-dir=$( basename `pwd` )
-CONFIG=${dir%-DIAGS}
-
-if [ ! -d ../${CONFIG}-MONITOR ] ; then mkdir ../${CONFIG}-MONITOR ; fi
-
-\rm -f ${CONFIG}_ice.mtl
-
-# if no ice.txt files in the dir, skip
- ls *ice.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no ice to deal with ... ; exit ; fi
-n=0
-
-for file in *ice.txt
-do
-n=$(( $n +1 ))
-year=$( head -1 $file | awk '{ print $2}' )
-nvol=$( cat $file | grep -e 'NVolume' | grep -v NVolumet | awk '{ printf "%.0f ", $4}' )
-svol=$( cat $file | grep -e 'SVolume' | grep -v SVolumet | awk '{ printf "%.0f ", $4}' )
-narea=$( cat $file | grep -e 'NArea' | awk '{ printf "%.0f ", $4}' )
-sarea=$( cat $file | grep -e 'SArea' | awk '{ printf "%.0f ", $4}' )
-nextent=$( cat $file | grep -e 'NExtend' | awk '{ printf "%.0f ", $4}' )
-sextent=$( cat $file | grep -e 'SExtend' | awk '{ printf "%.0f ", $4}' )
-
-if [ $n == 1 ] ; then
- echo 0000 02 03 08 09 02 03 08 09 02 03 08 09 02 03 08 09 02 03 08 09 02 03 08 09 > ${CONFIG}_ice.mtl
-fi
-
-echo $year $nvol $svol $narea $sarea $nextent $sextent >> ${CONFIG}_ice.mtl
-
-done
-
-mv ${CONFIG}_ice.mtl ../${CONFIG}-MONITOR/
-
-
diff --git a/JOBS/MKMTL/ice_month.ksh b/JOBS/MKMTL/ice_month.ksh
deleted file mode 100755
index 7320da0..0000000
--- a/JOBS/MKMTL/ice_month.ksh
+++ /dev/null
@@ -1,65 +0,0 @@
-#!/bin/ksh
-# ice.ksh : build a line of matlab file for ice output
-#set -x
-dir=$( basename `pwd` )
-CONFIG=${dir%-DIAGS}
-
-if [ ! -d ../${CONFIG}-MONITOR ] ; then mkdir ../${CONFIG}-MONITOR ; fi
-
-\rm -f ${CONFIG}_icemonth.mtl
-# if no icemonth.txt files in the dir, skip
- ls *icemonth.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no icemonth to deal with ... ; exit ; fi
-
-n=0
-
-
-for file in *icemonth.txt
-do
-n=$(( $n +1 ))
-year=$( head -1 $file | awk '{ print $2}' )
-nvol=$( cat $file | grep -e 'NVolume' | grep -v NVolumet | awk '{ printf "%.0f ", $4}' )
-svol=$( cat $file | grep -e 'SVolume' | grep -v SVolumet | awk '{ printf "%.0f ", $4}' )
-narea=$( cat $file | grep -e 'NArea' | awk '{ printf "%.0f ", $4}' )
-sarea=$( cat $file | grep -e 'SArea' | awk '{ printf "%.0f ", $4}' )
-#nextent=$( cat $file | grep -e 'NExtend' | awk '{ printf "%.0f ", $4}' )
-#sextent=$( cat $file | grep -e 'SExtend' | awk '{ printf "%.0f ", $4}' )
-nexnsidc=$( cat $file | grep -e 'NExnsidc' | awk '{ printf "%.0f ", $4}' )
-sexnsidc=$( cat $file | grep -e 'SExnsidc' | awk '{ printf "%.0f ", $4}' )
-
-if [ $n == 1 ] ; then
-echo "% Ice diags for " $CONFIG > ${CONFIG}_icemonth.mtl
-printf "%s" "% yr < --------------- ICE VOLUME ARCTIC ------------------------------------------> " >> ${CONFIG}_icemonth.mtl
-printf "%s" "<------------------- ICE VOLUME ANTARCTIC ---------------------------------------> " >> ${CONFIG}_icemonth.mtl
-printf "%s" "<------------------- ICE AREA ARCTIC ---------------------------------------------> " >> ${CONFIG}_icemonth.mtl
-printf "%s" "<------------------- ICE AREA ANTARCTIC ------------------------------------------> " >> ${CONFIG}_icemonth.mtl
-#printf "%s" "<------------------- ICE EXTENT ARCTIC -------------------------------------------> " >> ${CONFIG}_icemonth.mtl
-#printf "%s" "<------------------- ICE EXTENT ANTARCTIC ----------------------------------------> " >> ${CONFIG}_icemonth.mtl
-printf "%s" "<------------------- ICE EXTENT NSIDC ARCTIC -------------------------------------> " >> ${CONFIG}_icemonth.mtl
-printf "%s\n" "<------------------- ICE EXTENT NSIDC ANTARCTIC ----------------------------------> " >> ${CONFIG}_icemonth.mtl
-printf "%04d " 0000 >> ${CONFIG}_icemonth.mtl
-for h in N S ; do
- for v in V A E2 ; do
- m=1
- while (( $m <= 12 )) ; do
- printf " %02d " $m >> ${CONFIG}_icemonth.mtl
- m=$(( m + 1 ))
- done
- done
-done
-printf "\n" >> ${CONFIG}_icemonth.mtl
-fi
-printf "%04d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d " $year $nvol >> ${CONFIG}_icemonth.mtl
-printf "% 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d " $svol >> ${CONFIG}_icemonth.mtl
-printf "% 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d " $narea >> ${CONFIG}_icemonth.mtl
-printf "% 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d " $sarea >> ${CONFIG}_icemonth.mtl
-#printf "% 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d " $nextent >> ${CONFIG}_icemonth.mtl
-#printf "% 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d " $sextent >> ${CONFIG}_icemonth.mtl
-printf "% 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d " $nexnsidc >> ${CONFIG}_icemonth.mtl
-printf "% 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d % 6d \n" $sexnsidc >> ${CONFIG}_icemonth.mtl
-
-done
-
-mv ${CONFIG}_icemonth.mtl ../${CONFIG}-MONITOR/
-
-
diff --git a/JOBS/MKMTL/maxmoc.ksh b/JOBS/MKMTL/maxmoc.ksh
deleted file mode 100755
index 9f9b9d4..0000000
--- a/JOBS/MKMTL/maxmoc.ksh
+++ /dev/null
@@ -1,72 +0,0 @@
-#!/bin/ksh
-
-dir=$( basename `pwd` )
-CONFIGCASE=${dir%-DIAGS}
-
-if [ ! -d ../${CONFIGCASE}-MONITOR ] ; then mkdir ../${CONFIGCASE}-MONITOR ; fi
-
-CONFIG=${CONFIGCASE%-*}
-CASE=${CONFIGCASE#*-}
-
-\rm -f -r ${CONFIGCASE}_maxmoc.mtl
-# if no minmaxmoc.txt files in the dir, skip
- ls *minmaxmoc.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no minmaxmoc to deal with ... ; exit ; fi
- ls *heattrp.dat 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no heattrp to deal with ... ; exit ; fi
-touch ${CONFIGCASE}_maxmoc.mtl
-
-for file in *_minmaxmoc.txt
-do
- year=$( head -1 $file )
- mht=${CONFIGCASE}_y${year}_heattrp.dat
-
- # GLO
- maxglo=$( cat $file | grep -e '^Glo' | grep Max | awk '{ printf "%8.3f" , $3 }' )
-# maxglolat=$( cat $file | grep -e '^Glo' | grep Max | awk '{ printf "%8.2f" , $6 }' )
-# maxglodep=$( cat $file | grep -e '^Glo' | grep Max | awk '{ printf "%8.2f" , $9 }' )
-
- minglo=$( cat $file | grep -e '^Glo' | grep Min | awk '{ printf "%8.3f" , $3 }' )
-# minglolat=$( cat $file | grep -e '^Glo' | grep Min | awk '{ printf "%8.2f" , $6 }' )
-# minglodep=$( cat $file | grep -e '^Glo' | grep Min | awk '{ printf "%8.2f" , $9 }' )
-
- # ATL
- maxatl=$( cat $file | grep -e '^Atl' | grep Max | awk '{ printf "%8.3f" , $3 }' )
-# maxatllat=$( cat $file | grep -e '^Atl' | grep Max | awk '{ printf "%8.2f" , $6 }' )
-# maxatldep=$( cat $file | grep -e '^Atl' | grep Max | awk '{ printf "%8.2f" , $9 }' )
-
- minatl=$( cat $file | grep -e '^Atl' | grep Min | awk '{ printf "%8.3f" , $3 }' )
-# minatllat=$( cat $file | grep -e '^Atl' | grep Min | awk '{ printf "%8.2f" , $6 }' )
-# minatldep=$( cat $file | grep -e '^Atl' | grep Min | awk '{ printf "%8.2f" , $9 }' )
-
- # INP : attention we have 2 Minimum for INP mininp1 and mininp2
- tmp=$( cat $file | grep -e '^Inp' | grep Min | awk '{ printf "%8.3f" , $3 }' )
-# mininplat=$( cat $file | grep -e '^Inp' | grep Min | awk '{ printf "%8.2f" , $6 }' )
-# mininpdep=$( cat $file | grep -e '^Inp' | grep Min | awk '{ printf "%8.2f" , $9 }' )
- mininp1=$( echo $tmp | awk '{print $1}' )
- mininp2=$( echo $tmp | awk '{print $2}' )
-
- # AUS
- maxaus=$( cat $file | grep -e '^Aus' | grep Max | awk '{ printf "%8.3f" , $3 }' )
-# maxauslat=$( cat $file | grep -e '^Aus' | grep Max | awk '{ printf "%8.2f" , $6 }' )
-# maxausdep=$( cat $file | grep -e '^Aus' | grep Max | awk '{ printf "%8.2f" , $9 }' )
-
- minaus=$( cat $file | grep -e '^Aus' | grep Min | awk '{ printf "%8.3f" , $3 }' )
-# minauslat=$( cat $file | grep -e '^Aus' | grep Min | awk '{ printf "%8.2f" , $6 }' )
-# minausdep=$( cat $file | grep -e '^Aus' | grep Min | awk '{ printf "%8.2f" , $9 }' )
-
- # heattrp at 20 N
- heattrp=$( cat $mht | awk '{ if ( $2 >= 20 ) { atlmht=$4 ; glomht=$3 } } END { printf "%6.3f %6.3f ", glomht, atlmht }' )
- mhtglo=$( echo $heattrp | awk '{print $1}' )
- mhtatl=$( echo $heattrp | awk '{print $2}' )
-
-# echo $year $maxglo $maxglolat $maxglodep $minglo $minglolat $minglodep \
-# $maxatl $maxatllat $maxatldep $minatl $minatllat $minatldep \
-# $maxinp $maxinplat $maxinpdep $mininp $mininplat $mininpdep \
-# $maxaus $maxauslat $maxausdep $minaus $minauslat $minausdep >> ${CONFIGCASE}_maxmoc.mtl
-
- echo $year $maxglo $minglo $mhtglo $maxatl $minatl $mhtatl $mininp1 $mininp2 0000 \
- $maxaus $minaus 0000 >> ${CONFIGCASE}_maxmoc.mtl
-
-done
-mv ${CONFIGCASE}_maxmoc.mtl ../${CONFIGCASE}-MONITOR
diff --git a/JOBS/MKMTL/maxmoc40.ksh b/JOBS/MKMTL/maxmoc40.ksh
deleted file mode 100755
index 2fa07b5..0000000
--- a/JOBS/MKMTL/maxmoc40.ksh
+++ /dev/null
@@ -1,49 +0,0 @@
-#!/bin/ksh
-
-dir=$( basename `pwd` )
-CONFIGCASE=${dir%-DIAGS}
-
-if [ ! -d ../${CONFIGCASE}-MONITOR ] ; then mkdir ../${CONFIGCASE}-MONITOR ; fi
-
-CONFIG=${CONFIGCASE%-*}
-CASE=${CONFIGCASE#*-}
-
-# if no maxmoc40.txt files in the dir, skip
- ls *maxmoc40.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no maxmoc40 to deal with ... ; exit ; fi
- ls *heattrp.dat 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no heattrp to deal with ... ; exit ; fi
-
-\rm -f ${CONFIGCASE}_maxmoc40.mtl
-touch ${CONFIGCASE}_maxmoc40.mtl
-
-for file in *_maxmoc40.txt
-do
- year=$( head -1 $file )
- mht=${CONFIGCASE}_y${year}_heattrp.dat
-
- # GLO max a 40 et -30
- tmp=$( cat $file | grep -e '^Glo' | grep Max | awk '{ printf "%8.3f" , $3 }' )
- maxglo40n=$( echo $tmp | awk '{print $1}' )
- maxglo30s=$( echo $tmp | awk '{print $2}' )
-
- # ATL max a 40 et -30
- tmp=$( cat $file | grep -e '^Atl' | grep Max | awk '{ printf "%8.3f" , $3 }' )
- maxatl40n=$( echo $tmp | awk '{print $1}' )
- maxatl30s=$( echo $tmp | awk '{print $2}' )
-
- # INP : 1 Min at -30 S
- mininp30s=$( cat $file | grep -e '^Inp' | grep Min | awk '{ printf "%8.3f" , $3 }' )
-
- # AUS 1 max at -50 S
- maxaus50s=$( cat $file | grep -e '^Aus' | grep Max | awk '{ printf "%8.3f" , $3 }' )
-
- # heattrp at 20 N
-# heattrp=$( cat $mht | awk '{ if ( $2 >= 20 ) { atlmht=$4 ; glomht=$3 } } END { printf "%6.3f %6.3f ", glomht, atlmht }' )
-# mhtglo=$( echo $heattrp | awk '{print $1}' )
-# mhtatl=$( echo $heattrp | awk '{print $2}' )
-
- echo $year $maxglo40n $maxglo30s $maxatl40n $maxatl30s $mininp30s $maxaus50s >> ${CONFIGCASE}_maxmoc40.mtl
-
-done
-mv ${CONFIGCASE}_maxmoc40.mtl ../${CONFIGCASE}-MONITOR
diff --git a/JOBS/MKMTL/mkmtl.ksh b/JOBS/MKMTL/mkmtl.ksh
deleted file mode 100755
index e6b47b7..0000000
--- a/JOBS/MKMTL/mkmtl.ksh
+++ /dev/null
@@ -1,66 +0,0 @@
-#!/bin/ksh
-# This script (mkmtl.ksh) is supposed to be used in the -DIAGS dir of a config.
-# it retrieve the CONFIG CASE name from the directory name
-# it build the mtl files from the annual info kept in -DIAGS after the monitoring
-# it put the mtl files in the -MONITOR directory for the given CONFIG-CASE
-#----------------------------------------------------------------------------------
-# in order to be launched from the production machine, the absolute path of the
-# formatting scripts is used.
-#----------------------------------------------------------------------------------
-dir=$( basename `pwd` )
-CONFCASE=${dir%-DIAGS}
-CONFIG=${CONFCASE%-*}
-CASE=${CONFCASE#*-}
-
-bindir=~/MKMTL
-
-echo Transport across section \.\.\.
-$bindir/section.ksh
-
-echo T S Profiles \.\.\.
-$bindir/profile.ksh
-
-echo T S Profiles + Levitus \.\.\.
-$bindir/profile_lev.ksh
-
-echo Ice Diags \.\.\.
-$bindir/ice.ksh
-
-echo Ice Month Diags \.\.\.
-$bindir/ice_month.ksh
-
-echo Gib Diags \.\.\.
-$bindir/gib.ksh
-
-echo El Nino Diags \.\.\.
-$bindir/nino.ksh
-
-echo Meridional Heat Transport Diags \.\.\.
-$bindir/heat.ksh
-
-echo Max Overturning \.\.\.
-$bindir/maxmoc.ksh
-
-echo Max Overturning at fixed latitude \.\.\.
-$bindir/maxmoc40.ksh
-
-echo DCT monitoring \.\.\.
-$bindir/trpsig.ksh
-
-echo TRACER \.\.\.
-$bindir/trc.ksh
-
-cd ../${CONFCASE}-MONITOR/
-
-echo 'Update web site .........'
-# check if ad hoc directories exists :
-ssh meolipc.hmg.inpg.fr -l drakkar " if [ ! -d DRAKKAR/$CONFIG ] ; then mkdir DRAKKAR/$CONFIG ; fi "
-ssh meolipc.hmg.inpg.fr -l drakkar " if [ ! -d DRAKKAR/$CONFIG/$CONFCASE ] ; then mkdir DRAKKAR/$CONFIG/$CONFCASE ; fi "
-ssh meolipc.hmg.inpg.fr -l drakkar " if [ ! -d DRAKKAR/$CONFIG/$CONFCASE/DATA ] ; then mkdir DRAKKAR/$CONFIG/$CONFCASE/DATA ; fi "
-
-
-scp *mtl drakkar at meolipc.hmg.inpg.fr:DRAKKAR/$CONFIG/$CONFCASE/DATA/
-
-echo Done.
-
-
diff --git a/JOBS/MKMTL/nino.ksh b/JOBS/MKMTL/nino.ksh
deleted file mode 100755
index cbead37..0000000
--- a/JOBS/MKMTL/nino.ksh
+++ /dev/null
@@ -1,9 +0,0 @@
-#!/bin/ksh
-dir=$( basename `pwd` )
-CONFIG=${dir%-DIAGS}
-
-# if no NINO.txt files in the dir, skip
- ls *NINO* 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no nino to deal with ... ; exit ; fi
-
-cat *NINO* > ../${CONFIG}-MONITOR/${CONFIG}_nino.mtl
diff --git a/JOBS/MKMTL/profile.ksh b/JOBS/MKMTL/profile.ksh
deleted file mode 100755
index be6ce6c..0000000
--- a/JOBS/MKMTL/profile.ksh
+++ /dev/null
@@ -1,69 +0,0 @@
-#!/bin/ksh
-# section.ksh : build a line of matlab file for section output
-#set -x
-dir=$( basename `pwd` )
-CONFIG=${dir%-DIAGS}
-
-if [ ! -d ../${CONFIG}-MONITOR ] ; then mkdir ../${CONFIG}-MONITOR ; fi
-
-# if no TMEAN.txt files in the dir, skip
- ls *TMEAN.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no TMEAN to deal with ... ; exit ; fi
- ls *SMEAN.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no SMEAN to deal with ... ; exit ; fi
- ls *SSHMEAN.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no SSHMEAN to deal with ... ; exit ; fi
-n=0
-
-for file in ${CONFIG}*TMEAN.txt ; do
- n=$(( $n +1 ))
- year=$( head -1 $file )
- dep=$( cat $file | grep -e 'Mean value at level' | awk '{ printf "%10.1f" , $7 }' )
- mean=$( cat $file | grep -e 'over' | awk '{ printf "%10.4f" , $6 }' )
- tem=$( cat $file | grep -e 'Mean value at level' | awk '{ printf "%10.4f" , $9 }' )
-
- f=${CONFIG}_y${year}_SSHMEAN.txt
- sshmean=$( cat $f | grep ocean | awk '{ printf " %8.4f " , $6 }' )
-
- if [ $n = 1 ] ; then
- echo "% T SSH mean diags for " $CONFIG > ${CONFIG}_TMEAN.mtl
- echo "% yr ssh Tmean <----------------------- depth ------ ...... " >> ${CONFIG}_TMEAN.mtl
- echo 0 0 0 | awk '{ printf "%04d % 8.4f % 8.4f ",$1,$2,$3 }' >> ${CONFIG}_TMEAN.mtl
- echo $dep | awk '{ for ( i=1 ; i <= NF ; i++ ) printf "% 8.1f ", $i }' >> ${CONFIG}_TMEAN.mtl
- printf "\n" >> ${CONFIG}_TMEAN.mtl
- fi
- printf "%04d " $year >> ${CONFIG}_TMEAN.mtl
- echo $sshmean $mean | awk '{ printf "% 8.4f % 8.4f ", $1, $2 }' >> ${CONFIG}_TMEAN.mtl
- echo $tem | awk '{ for ( i=1 ; i <= NF ; i++ ) printf "% 8.4f " ,$i }' >> ${CONFIG}_TMEAN.mtl
- printf "\n" >> ${CONFIG}_TMEAN.mtl
-done
-
-
-mv ${CONFIG}_TMEAN.mtl ../${CONFIG}-MONITOR/
-
-n=0
-for file in ${CONFIG}*SMEAN.txt ; do
- n=$(( $n +1 ))
- year=$( head -1 $file )
- dep=$( cat $file | grep -e 'Mean value at level' | awk '{ printf "%10.1f" , $7 }' )
- mean=$( cat $file | grep -e 'over' | awk '{ printf "%10.4f" , $6 }' )
- tem=$( cat $file | grep -e 'Mean value at level' | awk '{ printf "%10.4f" , $9 }' )
-
- f=${CONFIG}_y${year}_SSHMEAN.txt
- sshmean=$( cat $f | grep ocean | awk '{ printf " %8.4f " , $6 }' )
-
- if [ $n = 1 ] ; then
- echo "% S SSH mean diags for " $CONFIG > ${CONFIG}_SMEAN.mtl
- echo "% yr ssh Smean <----------------------- depth ------ ...... " >> ${CONFIG}_SMEAN.mtl
- echo 0 0 0 | awk '{ printf "%04d % 8.4f % 8.4f ",$1,$2,$3 }' >> ${CONFIG}_SMEAN.mtl
- echo $dep | awk '{ for ( i=1 ; i <= NF ; i++ ) printf "% 8.1f ", $i }' >> ${CONFIG}_SMEAN.mtl
- printf "\n" >> ${CONFIG}_SMEAN.mtl
- fi
- printf "%04d " $year >> ${CONFIG}_SMEAN.mtl
- echo $sshmean $mean | awk '{ printf "% 8.4f % 8.4f ", $1, $2 }' >> ${CONFIG}_SMEAN.mtl
- echo $tem | awk '{ for ( i=1 ; i <= NF ; i++ ) printf "% 8.4f " ,$i }' >> ${CONFIG}_SMEAN.mtl
- printf "\n" >> ${CONFIG}_SMEAN.mtl
-done
-
-mv ${CONFIG}_SMEAN.mtl ../${CONFIG}-MONITOR/
-
diff --git a/JOBS/MKMTL/profile_lev.ksh b/JOBS/MKMTL/profile_lev.ksh
deleted file mode 100755
index 3eb4ff1..0000000
--- a/JOBS/MKMTL/profile_lev.ksh
+++ /dev/null
@@ -1,93 +0,0 @@
-#!/bin/ksh
-# section.ksh : build a line of matlab file for section output
-#set -x
-dir=$( basename `pwd` )
-CONFIG=${dir%-DIAGS}
-
-if [ ! -d ../${CONFIG}-MONITOR ] ; then mkdir ../${CONFIG}-MONITOR ; fi
- SLEV=LEVITUS_y0000_SMEAN.txt
- TLEV=LEVITUS_y0000_TMEAN.txt
-
-# if no TMEAN.txt files in the dir, skip
- ls *TMEAN.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no TMEAN to deal with ... ; exit ; fi
- ls *SMEAN.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no SMEAN to deal with ... ; exit ; fi
- ls *SSHMEAN.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no SSHMEAN to deal with ... ; exit ; fi
- ls $TLEV 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no TLEV to deal with ... ; exit ; fi
- ls $SLEV 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no SLEV to deal with ... ; exit ; fi
-
-n=0
-
- meanlev=$( cat $TLEV | grep -e 'over' | awk '{ printf "%10.4f" , $6 }' )
- temlev=$( cat $TLEV | grep -e 'Mean value at level' | awk '{ printf "%10.4f" , $9 }' )
-
-for file in ${CONFIG}*TMEAN.txt ; do
- n=$(( $n +1 ))
- year=$( head -1 $file )
- dep=$( cat $file | grep -e 'Mean value at level' | awk '{ printf "%10.1f" , $7 }' )
- mean=$( cat $file | grep -e 'over' | awk '{ printf "%10.4f" , $6 }' )
- tem=$( cat $file | grep -e 'Mean value at level' | awk '{ printf "%10.4f" , $9 }' )
-
- f=${CONFIG}_y${year}_SSHMEAN.txt
- sshmean=$( cat $f | grep ocean | awk '{ printf " %8.4f " , $6 }' )
-
- if [ $n = 1 ] ; then
- echo "% T SSH mean diags for " $CONFIG > ${CONFIG}_TMEAN_lev.mtl
- echo "% yr ssh Tmean <----------------------- depth ------ ...... " >> ${CONFIG}_TMEAN_lev.mtl
- echo 0 0 0 | awk '{ printf "%04d % 8.4f % 8.4f ",$1,$2,$3 }' >> ${CONFIG}_TMEAN_lev.mtl
- echo $dep | awk '{ for ( i=1 ; i <= NF ; i++ ) printf "% 8.1f ", $i }' >> ${CONFIG}_TMEAN_lev.mtl
- printf "\n" >> ${CONFIG}_TMEAN_lev.mtl
-
- printf "%04d " 0 >> ${CONFIG}_TMEAN_lev.mtl
- echo 0 $meanlev | awk '{ printf "% 8.4f % 8.4f ", $1, $2 }' >> ${CONFIG}_TMEAN_lev.mtl
- echo $temlev | awk '{ for ( i=1 ; i <= NF ; i++ ) printf "% 8.4f " ,$i }' >> ${CONFIG}_TMEAN_lev.mtl
- printf "\n" >> ${CONFIG}_TMEAN_lev.mtl
-
- fi
- printf "%04d " $year >> ${CONFIG}_TMEAN_lev.mtl
- echo $sshmean $mean | awk '{ printf "% 8.4f % 8.4f ", $1, $2 }' >> ${CONFIG}_TMEAN_lev.mtl
- echo $tem | awk '{ for ( i=1 ; i <= NF ; i++ ) printf "% 8.4f " ,$i }' >> ${CONFIG}_TMEAN_lev.mtl
- printf "\n" >> ${CONFIG}_TMEAN_lev.mtl
-done
-
-
-mv ${CONFIG}_TMEAN_lev.mtl ../${CONFIG}-MONITOR/
-
-n=0
- meanlev=$( cat $SLEV | grep -e 'over' | awk '{ printf "%10.4f" , $6 }' )
- temlev=$( cat $SLEV | grep -e 'Mean value at level' | awk '{ printf "%10.4f" , $9 }' )
-for file in ${CONFIG}*SMEAN.txt ; do
- n=$(( $n +1 ))
- year=$( head -1 $file )
- dep=$( cat $file | grep -e 'Mean value at level' | awk '{ printf "%10.1f" , $7 }' )
- mean=$( cat $file | grep -e 'over' | awk '{ printf "%10.4f" , $6 }' )
- tem=$( cat $file | grep -e 'Mean value at level' | awk '{ printf "%10.4f" , $9 }' )
-
- f=${CONFIG}_y${year}_SSHMEAN.txt
- sshmean=$( cat $f | grep ocean | awk '{ printf " %8.4f " , $6 }' )
-
- if [ $n = 1 ] ; then
- echo "% S SSH mean diags for " $CONFIG > ${CONFIG}_SMEAN_lev.mtl
- echo "% yr ssh Smean <----------------------- depth ------ ...... " >> ${CONFIG}_SMEAN_lev.mtl
- echo 0 0 0 | awk '{ printf "%04d % 8.4f % 8.4f ",$1,$2,$3 }' >> ${CONFIG}_SMEAN_lev.mtl
- echo $dep | awk '{ for ( i=1 ; i <= NF ; i++ ) printf "% 8.1f ", $i }' >> ${CONFIG}_SMEAN_lev.mtl
- printf "\n" >> ${CONFIG}_SMEAN_lev.mtl
-
- printf "%04d " 0 >> ${CONFIG}_SMEAN_lev.mtl
- echo 0 $meanlev | awk '{ printf "% 8.4f % 8.4f ", $1, $2 }' >> ${CONFIG}_SMEAN_lev.mtl
- echo $temlev | awk '{ for ( i=1 ; i <= NF ; i++ ) printf "% 8.4f " ,$i }' >> ${CONFIG}_SMEAN_lev.mtl
- printf "\n" >> ${CONFIG}_SMEAN_lev.mtl
-
- fi
- printf "%04d " $year >> ${CONFIG}_SMEAN_lev.mtl
- echo $sshmean $mean | awk '{ printf "% 8.4f % 8.4f ", $1, $2 }' >> ${CONFIG}_SMEAN_lev.mtl
- echo $tem | awk '{ for ( i=1 ; i <= NF ; i++ ) printf "% 8.4f " ,$i }' >> ${CONFIG}_SMEAN_lev.mtl
- printf "\n" >> ${CONFIG}_SMEAN_lev.mtl
-done
-
-mv ${CONFIG}_SMEAN_lev.mtl ../${CONFIG}-MONITOR/
-
diff --git a/JOBS/MKMTL/section.ksh b/JOBS/MKMTL/section.ksh
deleted file mode 100755
index 0cbcc04..0000000
--- a/JOBS/MKMTL/section.ksh
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/bin/ksh
-# section.ksh : build a line of matlab file for section output
-dir=$( basename `pwd` )
-CONFIG=${dir%-DIAGS}
-
-if [ ! -d ../${CONFIG}-MONITOR ] ; then mkdir ../${CONFIG}-MONITOR ; fi
-
-\rm -f ${CONFIG}_matrix.mtl
-# if no section_monitor.txt files in the dir, skip
- ls *section_monitor.txt 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no sections to deal with ... ; exit ; fi
-
-n=1
-for file in *section_monitor.txt ; do
- year=$( head -1 $file )
- mass=$( cat $file | grep Mass | awk '{ printf "%8.3f" , $4 }' )
- heat=$( cat $file | grep Heat | awk '{ printf "%8.3f" , $4 }' )
- salt=$( cat $file | grep Salt | awk '{ printf "%8.1f" , $4 *1. }' )
- if (( $n == 1 )) ; then
- ns=$( echo $mass | wc -w )
- secname=$( cat $file | grep -e "^ [0-9][0-9]_" )
- echo "% Transport across section for " $CONFIG " MASS HEAT SALT "> ${CONFIG}_matrix.mtl
- echo "% " $ns " sections "$secname >> ${CONFIG}_matrix.mtl
- printf "%s" "% year " >> ${CONFIG}_matrix.mtl
- for typ in M H S ; do
- sect=1
- for i in $mass ; do
- printf " %02d " $sect >> ${CONFIG}_matrix.mtl
- sect=$(( sect + 1 ))
- done
- done
- printf "%s\n" " SSHMEAN TMEAN SMEAN " >> ${CONFIG}_matrix.mtl
- n=$(( n + 1 ))
- fi
-
- f=${CONFIG}_y${year}_SSHMEAN.txt
- sshmean=$( cat $f | grep ocean | awk '{ printf " %8.4f " , $6 }' )
-
- f=${CONFIG}_y${year}_TMEAN.txt
- tmean=$( cat $f | grep ocean | awk '{ printf " %8.4f " , $6 }' )
-
- f=${CONFIG}_y${year}_SMEAN.txt
- smean=$( cat $f | grep ocean | awk '{ printf " %8.4f " , $6 }' )
-# add MOC min max for years ATL INP GLO
-# add cdf mean SSH
-
-printf "%4d " $year >> ${CONFIG}_matrix.mtl
-echo $mass | awk '{ for ( i=1 ; i<= NF ; i++ ) printf "% 11.4f ", $i }' >> ${CONFIG}_matrix.mtl
-echo $heat | awk '{ for ( i=1 ; i<= NF ; i++ ) printf "% 11.4f ", $i }' >> ${CONFIG}_matrix.mtl
-echo $salt | awk '{ for ( i=1 ; i<= NF ; i++ ) printf "% 11.4f ", $i }' >> ${CONFIG}_matrix.mtl
-echo $sshmean $tmean $smean | awk '{ for ( i=1 ; i<= NF ; i++ ) printf "% 11.4f ", $i }' >> ${CONFIG}_matrix.mtl
-printf "\n" >> ${CONFIG}_matrix.mtl
-
-done
-
-mv ${CONFIG}_matrix.mtl ../${CONFIG}-MONITOR/
-
diff --git a/JOBS/MKMTL/trc.ksh b/JOBS/MKMTL/trc.ksh
deleted file mode 100755
index f9fa78f..0000000
--- a/JOBS/MKMTL/trc.ksh
+++ /dev/null
@@ -1,75 +0,0 @@
-#!/bin/ksh
-# This script scan the years of TRC*.dat diags
-#set -x
-dir=$( basename `pwd` )
-CONFIG=${dir%-DIAGS}
-
-firstline() { cat $1 | grep -n J | awk -F: '{print $1+1}' ; }
-# if no TRCmean.dat files in the dir, skip
- ls *TRCmean.dat 1> /dev/null 2>&1
- if [ $? != 0 ] ; then echo no TRCmean.dat with ... ; exit ; fi
-
- \rm -f trc_cfc.mtl
- \rm -f trc_c14.mtl
-
-n=0
-for f in ${CONFIG}_y????_TRCmean.dat ; do
- n=$(( n + 1 ))
- zonalmean=$( echo $f | sed -e 's/TRCmean/TRCzonalmean/' )
- zonalsum=$( echo $f | sed -e 's/TRCmean/TRCzonalsum/' )
- zonalsurf=$( echo $f | sed -e 's/TRCmean/TRCzonalsurf/' )
-
- year=$( cat $f | awk '{ print $1}' )
- cfcmean=$( cat $f | awk '{ print $2}' )
- c14mean=$( cat $f | awk '{ print $3}' )
-
-if [ $n == 1 ] ; then
- echo "% CFC monitoring file for " $CONFIG >> trc_cfc.mtl
- echo "% Each year is represented by 3 raws of data (latitude) zonal mean/int : CFC inv , CFC inv (integral), CFC conc (surf)" >> trc_cfc.mtl
- echo "% yr Total <----------- latitude ----------------------------------------------- .... ----------> " >> trc_cfc.mtl
-
- echo "% B-C14 monitoring file for " $CONFIG >> trc_c14.mtl
- echo "% Each year is represented by 3 raws of data (latitude) zonal mean/int : C14 inv , C14 inv (integral), C14 conc (surf)" >> trc_c14.mtl
- echo "% yr Total <----------- latitude ----------------------------------------------- .... ----------> " >> trc_c14.mtl
-
- deb=$(firstline $zonalmean)
- lat=$( cat $zonalmean | awk '{ if ( NR >= deb ) {print $2 }} END {printf "\n" }' deb=$deb )
-
- echo 0 0 | awk '{ printf "%04d % 13.6e " , $1 ,$2 }'>> trc_cfc.mtl
- echo 0 0 | awk '{ printf "%04d % 13.6e " , $1 ,$2 }'>> trc_c14.mtl
- echo $lat >> trc_cfc.mtl
- echo $lat >> trc_c14.mtl
-fi
-
- deb=$(firstline $zonalmean)
- cfcinv=$( cat $zonalmean | awk '{ if ( NR >= deb ) {print $3 }} END {printf "\n" }' deb=$deb )
- c14inv=$( cat $zonalmean | awk '{ if ( NR >= deb ) {print $4 }} END {printf "\n" }' deb=$deb )
-
- deb=$(firstline $zonalsum)
- cfcint=$( cat $zonalsum | awk '{ if ( NR >= deb ) {print $3 }} END {printf "\n" }' deb=$deb )
- c14int=$( cat $zonalsum | awk '{ if ( NR >= deb ) {print $4 }} END {printf "\n" }' deb=$deb )
-
- deb=$(firstline $zonalsurf)
- cfcsurf=$( cat $zonalsurf | awk '{ if ( NR >= deb ) {print $3 }} END {printf "\n" }' deb=$deb )
- c14surf=$( cat $zonalsurf | awk '{ if ( NR >= deb ) {print $4 }} END {printf "\n" }' deb=$deb )
-
- echo $year $cfcmean | awk '{ printf "%04d % 13.6e " , $1 ,$2 }'>> trc_cfc.mtl
- echo $cfcinv >> trc_cfc.mtl
- echo $year $cfcmean | awk '{ printf "%04d % 13.6e " , $1 ,$2 }'>> trc_cfc.mtl
- echo $cfcint >> trc_cfc.mtl
- echo $year $cfcmean | awk '{ printf "%04d % 13.6e " , $1 ,$2 }'>> trc_cfc.mtl
- echo $cfcsurf >> trc_cfc.mtl
-
- echo $year $c14mean | awk '{ printf "%04d % 13.6e " , $1 ,$2 }'>> trc_c14.mtl
- echo $c14inv >> trc_c14.mtl
- echo $year $c14mean | awk '{ printf "%04d % 13.6e " , $1 ,$2 }'>> trc_c14.mtl
- echo $c14int >> trc_c14.mtl
- echo $year $c14mean | awk '{ printf "%04d % 13.6e " , $1 ,$2 }'>> trc_c14.mtl
- echo $c14surf >> trc_c14.mtl
-
-
-done
-
-mv trc_cfc.mtl ../${CONFIG}-MONITOR/${CONFIG}_trc_cfc.mtl
-mv trc_c14.mtl ../${CONFIG}-MONITOR/${CONFIG}_trc_c14.mtl
-
diff --git a/JOBS/MKMTL/trpsig.ksh b/JOBS/MKMTL/trpsig.ksh
deleted file mode 100755
index 6a4ba21..0000000
--- a/JOBS/MKMTL/trpsig.ksh
+++ /dev/null
@@ -1,40 +0,0 @@
-#!/bin/ksh
-#set -x
-
-dir=$( basename `pwd` )
-CONFCASE=${dir%-DIAGS}
-
-CONFIG=${CONFCASE%-*}
-CASE=${CONFCASE#*-}
-
-
-if [ ! -d ../${CONFCASE}-MONITOR ] ; then mkdir ../${CONFCASE}-MONITOR ; fi
-
-n=0
-# mini and maxi of sigma0
- mini=25.2 ; maxi=28.5
-
-cd TRPSIG
-
-for file in ${CONFCASE}*_01_Denmark_strait_trpsig.txt ; do
- tmp=${file#*_y}
- year=${tmp%%_*.txt}
- fil2=$( echo $file | sed -e 's/01_Denmark_strait/02_Faoes_Bank_Channel/' )
- n=$(( $n +1 ))
- #awk '{ if ( FNR > 10 && FNR < 20 ) { print } }'
- sig=$( cat $file | grep -v -e '^#' | awk '{ if ( $1 > 25.2 && $1 < 28.5 ) {printf "%8.3f" , $1 }}' mini=$mini maxi=$maxi )
- trp01=$( cat $file | grep -v -e '^#' | awk '{ if ( $1 > 25.2 && $1 < 28.5 ) {printf "%13.4e" , $2 } }' mini=$mini maxi=$maxi)
- trp02=$( cat $fil2 | grep -v -e '^#' | awk '{ if ( $1 > 25.2 && $1 < 28.5 ) {printf "%13.4e" , $2 } }' mini=$mini maxi=$maxi)
-
- if [ $n = 1 ] ; then
- echo 000000 $sig > ../${CONFCASE}_TRPSIG.mtl
- fi
- echo $year $trp01 >> ../${CONFCASE}_TRPSIG.mtl
- echo $year $trp02 >> ../${CONFCASE}_TRPSIG.mtl
-
-done
-
-cd ../
-mv ${CONFCASE}_TRPSIG.mtl ../${CONFCASE}-MONITOR
-
-
diff --git a/JOBS/cdf16bit.ll b/JOBS/cdf16bit.ll
deleted file mode 100755
index 0998a4c..0000000
--- a/JOBS/cdf16bit.ll
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/bin/ksh
-# @ cpu_limit = 7200
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdf16bit
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-CONFIG=ORCA025
-CASE=G70
-YEAR=1980
-
-CONFCASE=${CONFIG}-${CASE}
-
-for f in *gridU.nc ; do
- cdf16bit $f -check >> log
- mv cdf16bit.nc ${f}16
- mfput ${f}16 $CONFIG/$CONFCASE-MEAN16/$YEAR/
- mfput log $CONFIG/$CONFCASE-MEAN16/$YEAR/log.gridU
-done
diff --git a/JOBS/cdfbn2.ll b/JOBS/cdfbn2.ll
deleted file mode 100755
index 68a5893..0000000
--- a/JOBS/cdfbn2.ll
+++ /dev/null
@@ -1,45 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfbn2
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-
-set YEAR=0010
-#
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-set CASE=G22
- set CONFCASE=${CONFIG}-${CASE}
-
- cd $TMPDIR
- cp $CDFTOOLS/att.txt .
- cp $CDFTOOLS/cdfbn2 .
- chmod 755 cdfbn2
- mfget $CONFIG/${CONFIG}-I/${CONFIG}_PS_mesh_hgr.nc mesh_hgr.nc
- mfget $CONFIG/${CONFIG}-I/${CONFIG}_PS_mesh_zgr.nc mesh_zgr.nc
-
- rsh gaya mkdir $CONFIG/${CONFCASE}-DIAGS/
- rsh gaya mkdir $CONFIG/${CONFCASE}-DIAGS/$YEAR
-
-foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}\*gridT.nc ` )
- mfget $f ./
- set g=`basename $f | sed -e 's/gridT/N2/' `
-
- ./cdfbn2 `basename $f`
-
- mfput bn2.nc $CONFIG/${CONFCASE}-DIAGS/$YEAR/$g
- \rm `basename $f` bn2.nc
-
-end
-
diff --git a/JOBS/cdfbuoyflx.ksh b/JOBS/cdfbuoyflx.ksh
deleted file mode 100755
index 60aede1..0000000
--- a/JOBS/cdfbuoyflx.ksh
+++ /dev/null
@@ -1,33 +0,0 @@
-#!/bin/ksh
- ## $Rev$
- ## $Date$
- ## $Id$
-
-CONFIG=ORCA025
-CASE=G70
-TAG=y1980-2004
-CDFTOOLS=~molines/CDFTOOLS-2.1
-
-CONFCASE=${CONFIG}-${CASE}
-m=1
-while (( m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- f=${CONFCASE}_${TAG}m${mm}_gridT.nc
- r=runoff_m${mm}.nc
- buoyflx=$(echo $f | sed -e "s/gridT/buoyflx/" )
- $CDFTOOLS/cdfbuoyflx $f $r
- mv buoyflx.nc $buoyflx
-
- m=$(( m + 1 ))
-done
-# concatenations of monthly files
-
-ncrcat -h -a ${CONFCASE}_${TAG}m??_buoyflx.nc ${CONFCASE}_${TAG}_1m_buoyflx.nc
-
-# ANNUAL
- f=${CONFCASE}_${TAG}_gridT.nc
- r=runoff_ANNUAL.nc
- buoyflx=$(echo $f | sed -e "s/gridT/buoyflx/" )
-
- $CDFTOOLS/cdfbuoyflx $f $r
- mv buoyflx.nc $buoyflx
diff --git a/JOBS/cdfeke-inter.ll b/JOBS/cdfeke-inter.ll
deleted file mode 100755
index 9ef3bf1..0000000
--- a/JOBS/cdfeke-inter.ll
+++ /dev/null
@@ -1,42 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = EKE_int
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-
-set YEAR=0008-0010
-#
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-foreach CASE ( G42 )
- set CONFCASE=${CONFIG}-${CASE}
-
- cd $TMPDIR
- cp $CDFTOOLS/att.txt .
- cp $CDFTOOLS/cdfeke .
- chmod 755 cdfeke
-
- foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_grid\[UV\]\*nc ` )
- mfget $f ./
- end
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_gridT2.nc ./
-
- ./cdfeke ${CONFCASE}_y${YEAR}_gridU.nc ${CONFCASE}_y${YEAR}_gridU2.nc ${CONFCASE}_y${YEAR}_gridV.nc ${CONFCASE}_y${YEAR}_gridV2.nc ${CONFCASE}_y${YEAR}_gridT2.nc
-
- mv eke.nc ${CONFCASE}_y${YEAR}_EKE.nc
- mfput ${CONFCASE}_y${YEAR}_EKE.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/
-
- \rm *${YEAR}* *EKE*
-end
-
diff --git a/JOBS/cdfeke.ll b/JOBS/cdfeke.ll
deleted file mode 100755
index 94a3852..0000000
--- a/JOBS/cdfeke.ll
+++ /dev/null
@@ -1,43 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfeke
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-
-set YEAR=0005
-#
-set CASE=G32
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-#foreach CASE ( G22 G23 G03 )
-foreach YEAR ( 0010 )
- set CONFCASE=${CONFIG}-${CASE}
-
- cd $TMPDIR
- cp $CDFTOOLS/att.txt .
- cp $CDFTOOLS/cdfeke .
- chmod 755 cdfeke
-
- foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_grid\[UV\]\*nc ` )
- mfget $f ./
- end
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc ./
-
- ./cdfeke ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
-
- mv eke.nc ${CONFCASE}_y${YEAR}_EKE.nc
- mfput ${CONFCASE}_y${YEAR}_EKE.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/
-
- \rm *ANNUAL* *EKE*
-end
-
diff --git a/JOBS/cdfets.ll b/JOBS/cdfets.ll
deleted file mode 100755
index cb22085..0000000
--- a/JOBS/cdfets.ll
+++ /dev/null
@@ -1,45 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfets
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-
-set YEAR=0010
-#
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-set CASE=G22
- set CONFCASE=${CONFIG}-${CASE}
-
- cd $TMPDIR
- cp $CDFTOOLS/att.txt .
- cp $CDFTOOLS/cdfets .
- chmod 755 cdfets
- mfget $CONFIG/${CONFIG}-I/${CONFIG}_PS_mesh_hgr.nc mesh_hgr.nc
- mfget $CONFIG/${CONFIG}-I/${CONFIG}_PS_mesh_zgr.nc mesh_zgr.nc
-
- rsh gaya mkdir $CONFIG/${CONFCASE}-DIAGS/
- rsh gaya mkdir $CONFIG/${CONFCASE}-DIAGS/$YEAR
-
-foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}\*gridT.nc ` )
- mfget $f ./
- set g=`basename $f | sed -e 's/gridT/ETS/' `
-
- ./cdfets `basename $f`
-
- mfput ets.nc $CONFIG/${CONFCASE}-DIAGS/$YEAR/$g
- \rm `basename $f` ets.nc
-
-end
-
diff --git a/JOBS/cdfflxconv.ll b/JOBS/cdfflxconv.ll
deleted file mode 100644
index f2595fe..0000000
--- a/JOBS/cdfflxconv.ll
+++ /dev/null
@@ -1,100 +0,0 @@
-#!/bin/ksh
-# @ cpu_limit = 4200
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfflxconv
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-#set -x
-#
-# Define some functions to get/put file from/to gaya (can be easily customized)
-
-# rapatrie : Usage: rapatrie remote_file directory local_file
-# if local_file already here do nothing, else mfget it from gaya,
-# directory/remote_file
-rapatrie() { if [ ! -f $3 ] ; then mfget $2/$1 $3 ; else echo $3 is already \
- downloaded ; fi ; }
-
-# expatrie : Usage: expatrie local_file directory remote_file
-# put local file on gaya in directory/remote_file
-#
-expatrie() { mfput $1 $2/$3 ; }
-
-# chkfile : Usage: chkfile gaya_file
-# check if a file exists on gaya, return present or absent.
-chkfile() { rsh gaya " if [ -f $1 ] ; then echo present ;
- else echo absent ; fi " ; }
-
-# chkdirg : Usage: chkdirg gaya_directory
-# check the existence of a directory on gaya. Create it if not present
-chkdirg() { rsh gaya " if [ ! -d $1 ] ; then mkdir $1 ; fi " ; }
-
-# chkdirw : Usage: chkdirw web_site_directory
-# check the existence of a dir. on the web site. Create it if not present
-chkdirw() { rsh meolipc.hmg.inpg.fr -l apache " if [ ! -d web/DRAKKAR/$1 ] ;
- then mkdir web/DRAKKAR/$1 ; fi " ; }
-
-# chkdir : Usage: chkdir local_dir
-# check the existence of a directory. Create it if not present
-chkdir() { if [ ! -d $1 ] ; then mkdir $1 ; fi ; }
-
-
-CDFTOOLS=CDFTOOLS-2.1
-CONFIG=ATL3
-DIRCOO=/cache2/rost011/CLIPPER/GRID
-COORD=coordinates.${CONFIG}
-IDIR=/cache3/rost005/rcli007/${CONFIG}-I
-IDIRNC=${CONFIG}/${CONFIG}-I
-
-chkdirg $CONFIG
-chkdirg $IDIRNC
-
-cd $TMPDIR
-
-cp ~/$CDFTOOLS/cdfflxconv ./
-# coordinates.diags
-rapatrie $COORD $DIRCOO coordinates.diags
-
-year=1986
-year2=2000
-while (( $year <= $year2 )) ; do
- emp=ECMWF_emp_1d_${year}.${CONFIG}.nc
- if [ $(chkfile $IDIRNC/$emp ) == absent ] ; then
- # get fluxes and STRESS monthly files
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- flx=ECMWF.Y${year}.M${mm}.FLUX.${CONFIG}.dimg
- str=ECMWF.Y${year}.M${mm}.STRESS.${CONFIG}.dimg
- rapatrie $flx $IDIR $flx
- rapatrie $str $IDIR $str
- m=$(( m + 1 ))
- done
- # get SST for year -1 year and year+1
- ym1=$(( year - 1 ))
- yp1=$(( year + 1 ))
- y=$ym1
- while (( $y <= $yp1 )) ; do
- sst=REYNOLDS.Y${y}.SST.${CONFIG}.dimg
- if (( $y <= 2000 )) ; then
- rapatrie $sst $IDIR $sst
- fi
- y=$(( y + 1 ))
- done
- ./cdfflxconv $year $CONFIG
- for f in *.nc ; do
- expatrie $f $IDIRNC $f
- # clean unnecessary files from tmpdir
- \rm $f
- done
- \rm ECMWF*.dimg REYNOLDS.Y${ym1}.SST.${CONFIG}.dimg
- fi
- year=$(( year + 1 ))
-done
-
-
-
diff --git a/JOBS/cdfgib.ll b/JOBS/cdfgib.ll
deleted file mode 100644
index 0be031e..0000000
--- a/JOBS/cdfgib.ll
+++ /dev/null
@@ -1,55 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3600
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = gibraltar
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-
-set CASE=G70
-set MESH_MASK_ID='ORCA025-G70'
-#
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-set CONFCASE=${CONFIG}-${CASE}
-
-# limit for ORCA025
-set GIB=(1094 1109 653 674 )
-
-
-cd $TMPDIR
-
- cp $CDFTOOLS/att.txt .
- cp $CDFTOOLS/cdfmean .
-
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
-foreach YEAR ( 1958 1959 1960 1961 1962 1963 1964 1965 )
- mfget ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc ./
-
- \rm -f ${CONFCASE}_y${YEAR}_TGIB.txt
- echo $YEAR > ${CONFCASE}_y${YEAR}_TGIB.txt
- ./cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc votemper T $GIB 0 0 >> ${CONFCASE}_y${YEAR}_TGIB.txt
- \rm -f ${CONFCASE}_y${YEAR}_SGIB.txt
- echo $YEAR > ${CONFCASE}_y${YEAR}_SGIB.txt
- ./cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc vosaline T $GIB 0 0 >> ${CONFCASE}_y${YEAR}_SGIB.txt
-
-mfput ${CONFCASE}_y${YEAR}_TGIB.txt ${CONFIG}/${CONFCASE}-DIAGS
-mfput ${CONFCASE}_y${YEAR}_SGIB.txt ${CONFIG}/${CONFCASE}-DIAGS
-
-# clean the space
- \rm ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
-
-end
-
diff --git a/JOBS/cdfhflx.ll b/JOBS/cdfhflx.ll
deleted file mode 100755
index b30041e..0000000
--- a/JOBS/cdfhflx.ll
+++ /dev/null
@@ -1,45 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfhflx
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-set CONFIG=ORCA025
-set CASE=G50
-
-set YEARS=(1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 )
-set MESH_MASK_ID='ORCA025-G50'
-
-
-set CONFCASE=${CONFIG}-${CASE}
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-cd $TMPDIR
-cp $CDFTOOLS/cdfhflx .
-mfget ${CONFIG}/${CONFIG}-I/new_maskglo.nc new_maskglo.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
-foreach year ( $YEARS )
-set CONFCASE=${CONFIG}-${CASE}
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/
-
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_ANNUAL_T.nc .
-
-./cdfhflx ${CONFCASE}_y${year}_ANNUAL_T.nc
-mv hflx.out ${CONFCASE}_y${year}_hflx.dat
-
-mfput ${CONFCASE}_y${year}_hflx.dat ${CONFIG}/${CONFCASE}-DIAGS/
-
-\rm -f *.dat ${CONFCASE}_y${year}_ANNUAL_T.nc
-
-end
diff --git a/JOBS/cdfice.ll b/JOBS/cdfice.ll
deleted file mode 100755
index dc579d5..0000000
--- a/JOBS/cdfice.ll
+++ /dev/null
@@ -1,54 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfice
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-set CONFIG=ORCA025
-set CASE=G50
-
-set YEARS=(1949 1950 1951 )
-set MESH_MASK_ID='ORCA025-G45b'
-
-
-#
-set CONFCASE=${CONFIG}-${CASE}
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-cd $TMPDIR
-
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-
-cp $CDFTOOLS/cdficediags .
-chmod 755 cdficediags
-
-foreach YEAR ( $YEARS )
-# ice control for m02 m03 m08 m09
-
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m02_icemod.nc ./
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m03_icemod.nc ./
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m08_icemod.nc ./
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m09_icemod.nc ./
-
-echo '###' $YEAR 02 > ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m02_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-echo '###' $YEAR 03 >> ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m03_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-echo '###' $YEAR 08 >> ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m08_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-echo '###' $YEAR 09 >> ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m09_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-
-mfput ${CONFCASE}_y${YEAR}_ice.txt ${CONFIG}/${CONFCASE}-DIAGS
-
-
-end
diff --git a/JOBS/cdfmaxmoc.ll b/JOBS/cdfmaxmoc.ll
deleted file mode 100755
index 2487c47..0000000
--- a/JOBS/cdfmaxmoc.ll
+++ /dev/null
@@ -1,72 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3600
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = maxmoc
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set CONFIG=ORCA025
-set CASE=G32
-
-set year=0001
-set yrfin=0010
-
-#-----------------------------------------------------------------------------
-set CONFCASE=${CONFIG}-${CASE}
-set CDFTOOLS=$HOME/CDFTOOLS-2.0/
-
-cd $TMPDIR
-
-cp $CDFTOOLS/cdfmaxmoc .
-while ( $year < $yrfin )
-set year=`printf "%04d" $year
-
-
-# MAX and MIN of MOC
-#-------------------
-set f=${CONFCASE}_y${year}_MOC.nc
-mfget ${CONFIG}/${CONFIG}-${CASE}-DIAGS/$f ./
-set outfile=${CONFCASE}_y${year}_minmaxmoc.txt
- echo $year > $outfile
-# GLO
-printf "%s" 'Glo ' >> $outfile ; ./cdfmaxmoc $f glo 20 60 500 2000 | grep Maximum >> $outfile
-printf "%s" 'Glo ' >> $outfile ; ./cdfmaxmoc $f glo -40 30 2000 5500 | grep Minimum >> $outfile
-# ATL
-printf "%s" 'Atl ' >> $outfile ; ./cdfmaxmoc $f atl 0 60 500 2000 | grep Maximum >> $outfile
-printf "%s" 'Atl ' >> $outfile ; ./cdfmaxmoc $f atl -20 40 2000 5500 | grep Minimum >> $outfile
-#INP
-printf "%s" 'Inp ' >> $outfile ; ./cdfmaxmoc $f inp 15 50 100 1000 | grep Minimum >> $outfile
-printf "%s" 'Inp ' >> $outfile ; ./cdfmaxmoc $f inp -30 20 1000 5500 | grep Minimum >> $outfile
-#AUS
-printf "%s" 'Aus ' >> $outfile ; ./cdfmaxmoc $f glo -70 0 0 2000 | grep Maximum >> $outfile
-printf "%s" 'Aus ' >> $outfile ; ./cdfmaxmoc $f glo -70 0 2000 5500 | grep Minimum >> $outfile
-
-mfput $outfile ${CONFIG}/${CONFCASE}-DIAGS/
-
-# Max and Min of MOC at some specific latitudes
-set f=${CONFCASE}_y${year}_MOC.nc
-set outfile=${CONFIG}-${CASE}_y${year}_maxmoc40.txt
- \rm -f $outfile
-
- echo $year > $outfile
-# GLO MAX at 40 N and 30S
-printf "%s" 'Glo ' >> $outfile ; cdfmaxmoc $f glo 40 40 500 2000 | grep Maximum >> $outfile
-printf "%s" 'Glo ' >> $outfile ; cdfmaxmoc $f glo -30 -30 500 5500 | grep Maximum >> $outfile
-# ATL MAX at 40N and 30S
-printf "%s" 'Atl ' >> $outfile ; cdfmaxmoc $f atl 40 40 500 2000 | grep Maximum >> $outfile
-printf "%s" 'Atl ' >> $outfile ; cdfmaxmoc $f atl -30 -30 500 5000 | grep Maximum >> $outfile
-#INP Min at 30 S
-printf "%s" 'Inp ' >> $outfile ; cdfmaxmoc $f inp -30 -30 1000 5500 | grep Minimum >> $outfile
-#AUS MAX at 50 S
-printf "%s" 'Aus ' >> $outfile ; cdfmaxmoc $f glo -50 -50 0 2000 | grep Maximum >> $outfile
-
-mfput $outfile ${CONFIG}/${CONFIG}-${CASE}-DIAGS/
-
-@ year ++
-end
-
diff --git a/JOBS/cdfmaxmoc40.ll b/JOBS/cdfmaxmoc40.ll
deleted file mode 100755
index 4158fbf..0000000
--- a/JOBS/cdfmaxmoc40.ll
+++ /dev/null
@@ -1,27 +0,0 @@
-#!/bin/ksh
-
-cd $tmpdir
-for f in *MOC* ; do
- CONFIG=${f%-*}
- tmp=${f#*-} ; CASE=${tmp%%_*}
- tmp=${f%_*} ; year=${tmp#*_y}
- echo $CONFIG $CASE $year
- outfile=${CONFIG}-${CASE}_y${year}_maxmoc40.txt
- \rm -f $outfile
-
- echo $year > $outfile
-# GLO
-printf "%s" 'Glo ' >> $outfile ; cdfmaxmoc $f glo 40 40 500 2000 | grep Maximum >> $outfile
-printf "%s" 'Glo ' >> $outfile ; cdfmaxmoc $f glo -30 -30 2000 5500 | grep Maximum >> $outfile
-# ATL
-printf "%s" 'Atl ' >> $outfile ; cdfmaxmoc $f atl 40 40 500 2000 | grep Maximum >> $outfile
-printf "%s" 'Atl ' >> $outfile ; cdfmaxmoc $f atl -30 -30 500 2000 | grep Maximum >> $outfile
-#INP
-printf "%s" 'Inp ' >> $outfile ; cdfmaxmoc $f inp -30 -30 1000 5500 | grep Minimum >> $outfile
-#AUS
-printf "%s" 'Aus ' >> $outfile ; cdfmaxmoc $f glo -50 -50 0 2000 | grep Maximum >> $outfile
-
-mfput $outfile ${CONFIG}/${CONFIG}-${CASE}-DIAGS/
-done
-
-
diff --git a/JOBS/cdfmeanvar.ll b/JOBS/cdfmeanvar.ll
deleted file mode 100755
index c02682d..0000000
--- a/JOBS/cdfmeanvar.ll
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfmoc
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-#set echo
-
-
-set CONFIG=ORCA2
-set CASE=G70
-
-set YEARS=(1990 1991 1992 1993 1994 1995 1996 1997 1998 )
-#set YEARS=(1990 )
-set MESH_MASK_ID='ORCA2-G70'
-
-set usergaya=/u/rech/cli/rcli544
-
-#
-
-set CONFCASE=${CONFIG}-${CASE}
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.1
-
-
-cd $TMPDIR
-mfget $usergaya/${CONFIG}/${CONFIG}-I/new_maskglo.nc
-mfget $usergaya/${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget $usergaya/${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget $usergaya/${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
-
-set CONFCASE=${CONFIG}-${CASE}
-rsh gaya mkdir ${CONFIG}
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/
-
-foreach year ( $YEARS )
- echo $year > ${CONFCASE}_y${year}_meanvar.txt
- foreach vfile ( ` rsh gaya " ls $usergaya/${CONFIG}/${CONFCASE}-S/$year/${CONFCASE}_y${year}m??d??_gridV.nc" ` )
- echo $vfile
- mfget $vfile ./
- set vf=`basename $vfile `
- ncdump -v time_counter $vf | grep time | tail -1 | awk '{ printf "%f ", $3/86400. }' >> ${CONFCASE}_y${year}_meanvar.txt
-
- cdfmeanvar $vf vomecrty V | grep over | awk '{ printf "%s ", $NF}' >> ${CONFCASE}_y${year}_meanvar.txt
- printf "\n" >> ${CONFCASE}_y${year}_meanvar.txt
-
- mfput ${CONFCASE}_y${year}_meanvar.txt ${CONFIG}/${CONFCASE}-DIAGS/
- \rm $vf
- end
-
-end
diff --git a/JOBS/cdfmeanvar.log b/JOBS/cdfmeanvar.log
deleted file mode 100644
index 885fc6f..0000000
--- a/JOBS/cdfmeanvar.log
+++ /dev/null
@@ -1,10 +0,0 @@
-netCDF version 3.5.0 (NETCDF, PATH, MANPATH).
-VERSION DU DCM : /homegpfs/rech/cli/rcli002/NEMODRAK_1.12
-./new_maskglo.nc : 542696 bytes received in 0.5127 seconds (1034 Kbytes/s) - transfer Ok.
-mask.nc : 27119644 bytes received in 2.286 seconds (1.158e+04 Kbytes/s) - transfer Ok.
-mesh_hgr.nc : 3907708 bytes received in 0.1969 seconds (1.938e+04 Kbytes/s) - transfer Ok.
-mesh_zgr.nc : 27772088 bytes received in 0.6718 seconds (4.037e+04 Kbytes/s) - transfer Ok.
-UX:mkdir: ERROR: Cannot create directory "ORCA2": File exists
-UX:mkdir: ERROR: Cannot create directory "ORCA2/ORCA2-G70-DIAGS": File exists
-/u/rech/cli/rcli544/ORCA2/ORCA2-G70-S/1990/ORCA2-G70_y1990m01d05_gridV.nc
-.//ORCA2-G70_y1990m01d05_gridV.nc : 3690044 bytes received in 0.2082 seconds (1.731e+04 Kbytes/s) - transfer Ok.
diff --git a/JOBS/cdfmhst-full.ll b/JOBS/cdfmhst-full.ll
deleted file mode 100755
index a632708..0000000
--- a/JOBS/cdfmhst-full.ll
+++ /dev/null
@@ -1,50 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfmhst-full
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-set CASE=G03
-
-#
-
-set CONFCASE=${CONFIG}-${CASE}
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-cd $TMPDIR
-cp $CDFTOOLS/cdfmhst-full .
-mfget ${CONFIG}/${CONFIG}-I/ORCA025-G30_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/ORCA025-G30_mesh_zgr.nc mesh_zgr.nc
-mfget ${CONFIG}/${CONFIG}-I/ORCA025-G30_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/new_maskglo.nc .
-
-foreach year ( 0001 0002 0003 0004 )
-set CONFCASE=${CONFIG}-${CASE}
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/
-
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_ANNUAL_VT.nc .
-
-./cdfmhst-full ${CONFCASE}_y${year}_ANNUAL_VT.nc
-mv zonal_heat_trp.dat ${CONFCASE}_y${year}_heattrp.dat
-mv zonal_salt_trp.dat ${CONFCASE}_y${year}_salttrp.dat
-
-mfput ${CONFCASE}_y${year}_heattrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-cp ${CONFCASE}_y${year}_heattrp.dat $WORKDIR/${CONFCASE}-S/
-
-mfput ${CONFCASE}_y${year}_salttrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-cp ${CONFCASE}_y${year}_salttrp.dat $WORKDIR/${CONFCASE}-S/
-
-\rm -f *.dat ${CONFCASE}_y${year}_ANNUAL_VT.nc
-
-end
-
diff --git a/JOBS/cdfmhst.ll b/JOBS/cdfmhst.ll
deleted file mode 100755
index abb3049..0000000
--- a/JOBS/cdfmhst.ll
+++ /dev/null
@@ -1,50 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfmhst
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-set CONFIG=ORCA025
-set CASE=G70
-
-set YEARS=(1958)
-set MESH_MASK_ID='ORCA025-G70'
-
-
-set CONFCASE=${CONFIG}-${CASE}
-
-set CDFTOOLS=~rcli858/DEV/CDFTOOLS-2.1-DEV
-cd $TMPDIR
-cp $CDFTOOLS/cdfmhst .
-mfget ../../cache1/rcli002/${CONFIG}/${CONFIG}-I/new_maskglo.nc new_maskglo.nc
-mfget ../../cache1/rcli002/${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget ../../cache1/rcli002/${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ../../cache1/rcli002/${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
-foreach year ( $YEARS )
-set CONFCASE=${CONFIG}-${CASE}
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/
-
-mfget ../../cache1/rcli002/${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_ANNUAL_VT.nc .
-
-./cdfmhst ${CONFCASE}_y${year}_ANNUAL_VT.nc
-mv zonal_heat_trp.dat ${CONFCASE}_y${year}_heattrp.dat
-mv zonal_salt_trp.dat ${CONFCASE}_y${year}_salttrp.dat
-
-mfput ${CONFCASE}_y${year}_heattrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-cp ${CONFCASE}_y${year}_heattrp.dat $WORKDIR/${CONFCASE}-S/
-
-mfput ${CONFCASE}_y${year}_salttrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-cp ${CONFCASE}_y${year}_salttrp.dat $WORKDIR/${CONFCASE}-S/
-
-\rm -f *.dat ${CONFCASE}_y${year}_ANNUAL_VT.nc
-
-end
diff --git a/JOBS/cdfmoc-full.ll b/JOBS/cdfmoc-full.ll
deleted file mode 100755
index 27851ed..0000000
--- a/JOBS/cdfmoc-full.ll
+++ /dev/null
@@ -1,45 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfmoc-full
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-set echo
-
-set CONFIG=ORCA025
-set CASE=G03
-set YEARS=(0002 0003 0004 0005)
-set MESH_MASK_ID='ORCA025-G03'
-
-#
-
-set CONFCASE=${CONFIG}-${CASE}
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-
-cd $TMPDIR
-cp $CDFTOOLS/cdfmoc-full .
-cp $CDFTOOLS/att.txt .
-mfget ${CONFIG}/${CONFIG}-I/new_maskglo.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
-set CONFCASE=${CONFIG}-${CASE}
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/
-
-foreach year ( $YEARS )
-
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_ANNUAL_gridV.nc .
-
-./cdfmoc-full ${CONFCASE}_y${year}_ANNUAL_gridV.nc
-mv moc.nc ${CONFCASE}_y${year}_MOC.nc
-mfput ${CONFCASE}_y${year}_MOC.nc ${CONFIG}/${CONFCASE}-DIAGS/
-
-end
diff --git a/JOBS/cdfmoc-inter.ll b/JOBS/cdfmoc-inter.ll
deleted file mode 100755
index f1a69be..0000000
--- a/JOBS/cdfmoc-inter.ll
+++ /dev/null
@@ -1,49 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfmoc-inter
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-set CASE=G45b
-
-set YEARS=(0008-0010 )
-set MESH_MASK_ID='ORCA025-G45b'
-
-#
-
-set CONFCASE=${CONFIG}-${CASE}
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-
-cd $TMPDIR
-cp $CDFTOOLS/cdfmoc .
-cp $CDFTOOLS/att.txt .
-mfget ${CONFIG}/${CONFIG}-I/new_maskglo.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
-
-set CONFCASE=${CONFIG}-${CASE}
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/
-
-foreach year ( $YEARS )
-
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_gridV.nc .
-
-./cdfmoc ${CONFCASE}_y${year}_gridV.nc
-mv moc.nc ${CONFCASE}_y${year}_MOC.nc
-mfput ${CONFCASE}_y${year}_MOC.nc ${CONFIG}/${CONFCASE}-DIAGS/
-
-end
diff --git a/JOBS/cdfmoc.ll b/JOBS/cdfmoc.ll
deleted file mode 100755
index 3f9a73a..0000000
--- a/JOBS/cdfmoc.ll
+++ /dev/null
@@ -1,49 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfmoc
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-set CASE=G44
-
-set YEARS=(0002 0003 0004 0005)
-set MESH_MASK_ID='ORCA025-G44'
-
-#
-
-set CONFCASE=${CONFIG}-${CASE}
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-
-cd $TMPDIR
-cp $CDFTOOLS/cdfmoc .
-cp $CDFTOOLS/att.txt .
-mfget ${CONFIG}/${CONFIG}-I/new_maskglo.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
-
-set CONFCASE=${CONFIG}-${CASE}
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/
-
-foreach year ( $YEARS )
-
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_ANNUAL_gridV.nc .
-
-./cdfmoc ${CONFCASE}_y${year}_ANNUAL_gridV.nc
-mv moc.nc ${CONFCASE}_y${year}_MOC.nc
-mfput ${CONFCASE}_y${year}_MOC.nc ${CONFIG}/${CONFCASE}-DIAGS/
-
-end
diff --git a/JOBS/cdfmoy-ets.ll b/JOBS/cdfmoy-ets.ll
deleted file mode 100755
index ece679e..0000000
--- a/JOBS/cdfmoy-ets.ll
+++ /dev/null
@@ -1,46 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfmoy-ets
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-set CASE=G22
-
-set YEAR=0010
-#
-
-set CONFCASE=${CONFIG}-${CASE}
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-
-cd $TMPDIR
-mkdir MONTHLY
-
-cp $CDFTOOLS/att.txt .
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-MEAN/$YEAR/
-
-foreach month (01 02 03 04 05 06 07 08 09 10 11 12 )
- foreach f ( `rsh gaya ls ${CONFIG}/${CONFCASE}-DIAGS/$YEAR/${CONFCASE}_y${YEAR}m${month}\*_ETS.nc `)
- mfget $f ./
- end
-
- set list=''
- foreach f ( ${CONFCASE}_y${YEAR}m${month}d??_ETS.nc )
- set list=($list $f )
- end
- $CDFTOOLS/cdfmoy_sp $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_ETS.nc
- \rm $list cdfmoy.nc cdfmoy2.nc
-
-end
diff --git a/JOBS/cdfmoy-inter.ll b/JOBS/cdfmoy-inter.ll
deleted file mode 100755
index b63beaa..0000000
--- a/JOBS/cdfmoy-inter.ll
+++ /dev/null
@@ -1,257 +0,0 @@
-#!/bin/csh
-# @ wall_clock_limit = 20:00:00
-# @ as_limit = 1gb
-# @ job_name = cdfmoy-inter
-# @ output = $(job_name).$(jobid)
-# @ error = $(job_name).$(jobid)
-# @ notify_user = molines at hmg.inpg.fr
-# @ notification = error
-# @ queue
-
-
-
-set echo
-
-set INTER=1980-2004
-set CONFIG=ORCA025.L75
-set CASELIST=( G85 )
-
-set CDFTOOLS=~/CDFTOOLS-2.1
-
-#######################
-set tmp=`echo $INTER | sed -e 's/-/ /'`
-set year1=`echo $tmp[1] | awk '{printf "%04d", $1 }'`
-set year2=`echo $tmp[2] | awk '{printf "%04d", $1 }'`
-
-set nyear=`expr $year2 - $year1 + 1 `
-set year=$year1
-set n=1
-set YEARLIST=''
-while ( $n <= $nyear )
- set YEARLIST=($YEARLIST $year)
- set year=`expr $year + 1 `
- set year=`echo $year | awk '{printf "%04d", $1 }'`
- @ n ++
-end
-
- cd $TMPDIR
-
-foreach CASE ( $CASELIST )
- set CONFCASE=${CONFIG}-${CASE}
- rsh gaya mkdir $CONFIG/${CONFCASE}-MEAN/$INTER
-
-
-### GRID T ###
-###############
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridT.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
- set list=($list ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridT.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-
-### GRID T2 ###
-###############
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridT2.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
- set list=($list ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridT2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-
-### GRID U ###
-###############
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridU.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc
- set list=($list ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridU.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-### GRID U2 ###
-################
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridU2.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc
- set list=($list ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridU2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-
-### GRID V ###
-###############
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridV.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
- set list=($list ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridV.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-### GRID V2 ###
-################
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridV2.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc
- set list=($list ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridV2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-
-### GRID W ###
-###############
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridW.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc
- set list=($list ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridW.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-### GRID W2 ###
-################
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridW2.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc
- set list=($list ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_gridW2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-### ICEMOD ###
-###############
-
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_icemod.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_icemod.nc
- set list=($list ${CONFCASE}_y${YEAR}_ANNUAL_icemod.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_icemod.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
- ## m03 ##
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m03_icemod.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m03_icemod.nc
- set list=($list ${CONFCASE}_y${YEAR}m03_icemod.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m03_icemod.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-
- ## m09 ##
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m09_icemod.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m09_icemod.nc
- set list=($list ${CONFCASE}_y${YEAR}m09_icemod.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m09_icemod.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-
-### EKE ###
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_EKE.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_EKE.nc
- set list=($list ${CONFCASE}_y${YEAR}_EKE.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_EKE.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-### MOC ###
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_MOC.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_MOC.nc
- set list=($list ${CONFCASE}_y${YEAR}_MOC.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_MOC.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-### PSI ###
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_PSI.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_PSI.nc
- set list=($list ${CONFCASE}_y${YEAR}_PSI.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_PSI.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-
-### MXL ###
-
- ## m03 ##
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m03_MXL.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m03_MXL.nc
- set list=($list ${CONFCASE}_y${YEAR}m03_MXL.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m03_MXL.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-
- ## m09 ##
- set list=''
- if ( ! -f $HOMEGAYA/${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m09_MXL.nc ) then
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m09_MXL.nc
- set list=($list ${CONFCASE}_y${YEAR}m09_MXL.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m09_MXL.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
- endif
-
-end
diff --git a/JOBS/cdfmoy-inter_month.ll b/JOBS/cdfmoy-inter_month.ll
deleted file mode 100755
index f17d2e8..0000000
--- a/JOBS/cdfmoy-inter_month.ll
+++ /dev/null
@@ -1,158 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 7200
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfmoy-inter
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-set INTER=1990-2000
-set CONFIG=ORCA025
-set CASELIST=( G70 )
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.1
-
-#######################
-set tmp=`echo $INTER | sed -e 's/-/ /'`
-set year1=`echo $tmp[1] | awk '{printf "%04d", $1 }'`
-set year2=`echo $tmp[2] | awk '{printf "%04d", $1 }'`
-
-set nyear=`expr $year2 - $year1 + 1 `
-set year=$year1
-set n=1
-set YEARLIST=''
-while ( $n <= $nyear )
- set YEARLIST=($YEARLIST $year)
- set year=`expr $year + 1 `
- set year=`echo $year | awk '{printf "%04d", $1 }'`
- @ n ++
-end
-
- cd $TMPDIR
-
-foreach CASE ( $CASELIST )
- set CONFCASE=${CONFIG}-${CASE}
- rsh gaya mkdir $CONFIG/${CONFCASE}-MEAN/$INTER
-
-
-### GRID T ###
-###############
- foreach month ( 01 02 03 04 05 06 07 08 09 10 11 12 )
- set list=''
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridT.nc
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridT.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m${month}_gridT.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-### GRID T2 ###
-###############
- set list=''
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridT2.nc
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridT2.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m${month}_gridT2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-### GRID U ###
-###############
- set list=''
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridU.nc
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridU.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m${month}_gridU.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-### GRID U2 ###
-################
- set list=''
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridU2.nc
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridU2.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m${month}_gridU2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-
-### GRID V ###
-###############
- set list=''
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridV.nc
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridV.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m${month}_gridV.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-### GRID V2 ###
-################
- set list=''
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridV2.nc
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridV2.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m${month}_gridV2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-
-### GRID W ###
-###############
- set list=''
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridW.nc
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridW.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m${month}_gridW.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-### GRID W2 ###
-################
- set list=''
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridW2.nc
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridW2.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m${month}_gridW2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-### ICEMOD ###
-###############
-
- set list=''
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_icemod.nc
- set list=($list ${CONFCASE}_y${YEAR}m${month}_icemod.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}m${month}_icemod.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-end
-
-end
diff --git a/JOBS/cdfmoy.ll b/JOBS/cdfmoy.ll
deleted file mode 100755
index 8637b15..0000000
--- a/JOBS/cdfmoy.ll
+++ /dev/null
@@ -1,323 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 4200
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfmoy
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-set CASE=G33
-
-set YEAR=0001
-#
-
-set CONFCASE=${CONFIG}-${CASE}
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0/
-
-
-cd $TMPDIR
-mkdir MONTHLY
-
-cp $CDFTOOLS/att.txt .
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-MEAN/$YEAR/
-
-#goto annual
-#goto quarterly
-# Monthly mean
-#
-foreach month (01 02 03 04 05 06 07 08 09 10 11 12 )
- foreach f ( `rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m${month}\*_gridT.nc `)
- mfget $f ./
- end
-
- set list=''
- foreach f ( ${CONFCASE}_y${YEAR}m${month}d??_gridT.nc )
- set list=($list $f )
- end
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridT.nc
- mfput cdfmoy2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridT2.nc
- \rm $list cdfmoy.nc cdfmoy2.nc
-
- foreach f ( `rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m${month}\*_gridU.nc `)
- mfget $f ./
- end
-
- set list=''
- foreach f ( ${CONFCASE}_y${YEAR}m${month}d??_gridU.nc )
- set list=($list $f )
- end
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridU.nc
- mfput cdfmoy2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridU2.nc
- \rm $list cdfmoy.nc cdfmoy2.nc
-
- foreach f ( `rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m${month}\*_gridV.nc `)
- mfget $f ./
- end
-
- set list=''
- foreach f ( ${CONFCASE}_y${YEAR}m${month}d??_gridV.nc )
- set list=($list $f )
- end
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridV.nc
- mfput cdfmoy2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridV2.nc
- \rm $list cdfmoy.nc cdfmoy2.nc
-
- foreach f ( `rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m${month}\*_gridW.nc `)
- mfget $f ./
- end
-
- set list=''
- foreach f ( ${CONFCASE}_y${YEAR}m${month}d??_gridW.nc )
- set list=($list $f )
- end
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridW.nc
- mfput cdfmoy2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_gridW2.nc
- \rm $list cdfmoy.nc cdfmoy2.nc
-
- foreach f ( `rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m${month}\*_icemod.nc `)
- mfget $f ./
- end
-
- set list=''
- foreach f ( ${CONFCASE}_y${YEAR}m${month}d??_icemod.nc )
- set list=($list $f )
- end
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_icemod.nc
- \rm $list cdfmoy.nc cdfmoy2.nc
-
- end
-
-quarterly:
-# Quarterly mean
- cd $TMPDIR
- mkdir QUARTERLY
- cd MONTHLY
-
- foreach season ( WINT SPRI SUMM FALL )
- switch ($season)
- case WINT:
- set smon=(01 02 03 )
- breaksw
- case SPRI:
- set smon=(04 05 06 )
- breaksw
- case SUMM:
- set smon=(07 08 09 )
- breaksw
- case FALL:
- set smon=(10 11 12 )
- breaksw
- default:
- echo error ; exit 1
- breaksw
- endsw
-
- ln -s ../att.txt .
-
- set list=''
- foreach month ( $smon )
- mfget $CONFIG/${CONFCASE}-MEAN/${YEAR}/${CONFCASE}_y${YEAR}m${month}_gridT.nc ./
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridT.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_${season}_gridT.nc
- mfput ${CONFCASE}_y${YEAR}_${season}_gridT.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_${season}_gridT.nc
- mv ${CONFCASE}_y${YEAR}_${season}_gridT.nc ../QUARTERLY
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach month ( $smon )
- mfget $CONFIG/${CONFCASE}-MEAN/${YEAR}/${CONFCASE}_y${YEAR}m${month}_gridT2.nc ./
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridT2.nc )
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_${season}_gridT2.nc
- mfput ${CONFCASE}_y${YEAR}_${season}_gridT2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_${season}_gridT2.nc
- mv ${CONFCASE}_y${YEAR}_${season}_gridT2.nc ../QUARTERLY
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach month ( $smon )
- mfget $CONFIG/${CONFCASE}-MEAN/${YEAR}/${CONFCASE}_y${YEAR}m${month}_gridU.nc ./
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridU.nc )
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_${season}_gridU.nc
- mfput ${CONFCASE}_y${YEAR}_${season}_gridU.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_${season}_gridU.nc
- mv ${CONFCASE}_y${YEAR}_${season}_gridU.nc ../QUARTERLY
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach month ( $smon )
- mfget $CONFIG/${CONFCASE}-MEAN/${YEAR}/${CONFCASE}_y${YEAR}m${month}_gridU2.nc ./
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridU2.nc )
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_${season}_gridU2.nc
- mfput ${CONFCASE}_y${YEAR}_${season}_gridU2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_${season}_gridU2.nc
- mv ${CONFCASE}_y${YEAR}_${season}_gridU2.nc ../QUARTERLY
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach month ( $smon )
- mfget $CONFIG/${CONFCASE}-MEAN/${YEAR}/${CONFCASE}_y${YEAR}m${month}_gridV.nc ./
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridV.nc )
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_${season}_gridV.nc
- mfput ${CONFCASE}_y${YEAR}_${season}_gridV.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_${season}_gridV.nc
- mv ${CONFCASE}_y${YEAR}_${season}_gridV.nc ../QUARTERLY
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach month ( $smon )
- mfget $CONFIG/${CONFCASE}-MEAN/${YEAR}/${CONFCASE}_y${YEAR}m${month}_gridV2.nc ./
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridV2.nc )
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_${season}_gridV2.nc
- mfput ${CONFCASE}_y${YEAR}_${season}_gridV2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_${season}_gridV2.nc
- mv ${CONFCASE}_y${YEAR}_${season}_gridV2.nc ../QUARTERLY
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach month ( $smon )
- mfget $CONFIG/${CONFCASE}-MEAN/${YEAR}/${CONFCASE}_y${YEAR}m${month}_gridW.nc ./
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridW.nc )
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_${season}_gridW.nc
- mfput ${CONFCASE}_y${YEAR}_${season}_gridW.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_${season}_gridW.nc
- mv ${CONFCASE}_y${YEAR}_${season}_gridW.nc ../QUARTERLY
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach month ( $smon )
- mfget $CONFIG/${CONFCASE}-MEAN/${YEAR}/${CONFCASE}_y${YEAR}m${month}_gridW2.nc ./
- set list=($list ${CONFCASE}_y${YEAR}m${month}_gridW2.nc )
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_${season}_gridW2.nc
- mfput ${CONFCASE}_y${YEAR}_${season}_gridW2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_${season}_gridW2.nc
- mv ${CONFCASE}_y${YEAR}_${season}_gridW2.nc ../QUARTERLY
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach month ( $smon )
- mfget $CONFIG/${CONFCASE}-MEAN/${YEAR}/${CONFCASE}_y${YEAR}m${month}_icemod.nc ./
- set list=($list ${CONFCASE}_y${YEAR}m${month}_icemod.nc )
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_${season}_icemod.nc
- mfput ${CONFCASE}_y${YEAR}_${season}_icemod.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_${season}_icemod.nc
- mv ${CONFCASE}_y${YEAR}_${season}_icemod.nc ../QUARTERLY
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- end
-
-
-annual:
-# ANNUAL
- cd $TMPDIR
- cd QUARTERLY
- ln -s ../att.txt .
-
- set list=''
- foreach season ( WINT SPRI SUMM FALL )
- set list=($list ${CONFCASE}_y${YEAR}_${season}_gridT.nc)
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
- mfput ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach season ( WINT SPRI SUMM FALL )
- set list=($list ${CONFCASE}_y${YEAR}_${season}_gridT2.nc)
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
- mfput ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-
- set list=''
- foreach season ( WINT SPRI SUMM FALL )
- set list=($list ${CONFCASE}_y${YEAR}_${season}_gridU.nc)
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc
- mfput ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach season ( WINT SPRI SUMM FALL )
- set list=($list ${CONFCASE}_y${YEAR}_${season}_gridU2.nc)
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc
- mfput ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-
- set list=''
- foreach season ( WINT SPRI SUMM FALL )
- set list=($list ${CONFCASE}_y${YEAR}_${season}_gridV.nc)
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
- mfput ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach season ( WINT SPRI SUMM FALL )
- set list=($list ${CONFCASE}_y${YEAR}_${season}_gridV2.nc)
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc
- mfput ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-
- set list=''
- foreach season ( WINT SPRI SUMM FALL )
- set list=($list ${CONFCASE}_y${YEAR}_${season}_gridW.nc)
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc
- mfput ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- set list=''
- foreach season ( WINT SPRI SUMM FALL )
- set list=($list ${CONFCASE}_y${YEAR}_${season}_gridW2.nc)
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc
- mfput ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-
- set list=''
- foreach season ( WINT SPRI SUMM FALL )
- set list=($list ${CONFCASE}_y${YEAR}_${season}_icemod.nc)
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_ANNUAL_icemod.nc
- mfput ${CONFCASE}_y${YEAR}_ANNUAL_icemod.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_icemod.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
diff --git a/JOBS/cdfmoy_jade_new.ksh b/JOBS/cdfmoy_jade_new.ksh
deleted file mode 100755
index f981314..0000000
--- a/JOBS/cdfmoy_jade_new.ksh
+++ /dev/null
@@ -1,124 +0,0 @@
-#!/bin/ksh
-# @ wall_clock_limit = 10:00:00
-# @ job_name = moy-YYYY
-# @ as_limit = 1gb
-# @ output = $(job_name).$(jobid)
-# @ error = $(job_name).$(jobid)
-# @ notify_user = molines at hmg.inpg.fr
-# @ notification = error
-# @ queue
-
-### OAR is valid on ZEPHIR
-#OAR -n metamoy
-#OAR -l /nodes=1/cpu=1,walltime=5:00:00
-#OAR -E METAMOY.%jobid%
-#OAR -O METAMOY.%jobid%
-
-### PBS is valid on JADE
-#PBS -N metamoy_jade
-#PBS -l select=1:ncpus=8:mpiprocs=1
-#PBS -l walltime=02:00:00
-#PBS -l place=scatter:excl
-#PBS -M molines at hmg.inpg.fr
-#PBS -mb -me
-
-#################################################################################
-# This script is used to compute time mean averages for DRAKKAR model output.
-# It replaces an older script which was also computing quarterly means.
-# All customisable variable are set in Part I.
-# This script must be launched from metamoy.ksh which edit the years
-#
-# $Rev: 229 $
-# $Date: 2009-03-24 09:34:51 +0100 (mar, 24 mar 2009) $
-# $Id: cdfmoy_skel_new.ksh 229 2009-03-24 08:34:51Z rcli002 $
-################################################################################
-
-set -x
-cd
-pwd
-. $HOME/.profile
-P_CDF_DIR=RUN_CCOONNFF/CCOONNFF-CCAASSEE/CTL/CDF
-. $P_CDF_DIR/config_def.ksh
-. $P_CDF_DIR/function_def.ksh
-
-chkdir $TMPDIR
-
-#test network
-login_node=service1
-chknet $login_node
-echo "$login_node $NET"
-if [ $NET = KO ] ; then
-login_node=service2
-chknet $login_node
-echo "$login_node $NET"
-fi;
-if [ $NET = KO ] ; then
-login_node=service3
-chknet $login_node
-echo "$login_node $NET"
-fi;
-if [ $NET = KO ] ; then
-echo network is KO
-date
-exit
-fi
-
- scp $USER@${login_node}:$P_CDF_DIR/config_def.ksh $TMPDIR/.
- scp $USER@${login_node}:$P_CDF_DIR/function_def.ksh $TMPDIR/.
-if [ ! -f $TMPDIR/cdfmoy ] ; then scp $USER@${login_node}:$CDFTOOLS/cdfmoy $TMPDIR/. ; fi ;
-if [ ! -f $TMPDIR/cdfmoy_annual ] ; then scp $USER@${login_node}:$CDFTOOLS/cdfmoy_annual $TMPDIR/. ; fi ;
-
-cd $TMPDIR
-
-# Part I : setup config dependent names
-#--------------------------------------
-. ./config_def.ksh # this file (or a link) must exist in the current directory
-#
-# Part II define some usefull functions
-#---------------------------------------
-. ./function_def.ksh # this file (or a link) must exist in the current directory
-
-# Part III : main loops : no more customization below
-#-----------------------------------------------------
-# set up list of years to process
-# Metamoy meta script will subtitute YYYY and YYYE with correct begining and ending years
-YEARS=YYYY
-YEARE=YYYE
-
-YEARLST=""
-y=$YEARS
-while (( $y <= $YEARE )) ; do
- YEARLST="$YEARLST $y "
- y=$(( y + 1 ))
-done
-
-#
-CONFCASE=${CONFIG}-${CASE}
-
-# always work in TMPDIR ! not in the data dir as file will be erased at the end of the script !
-
-for YEAR in $YEARLST ; do
-cd $TMPDIR
-SDIR=$PREF/${CONFIG}/${CONFCASE}-S/$YEAR
- MDIR=$PREF/${CONFIG}/${CONFCASE}-MEAN/$YEAR
- chkdirg $MDIR
- chkdir $YEAR
- cd $YEAR
- # Monthly mean
- #
- for grid in gridT gridU gridV gridW icemod ; do
- for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month $grid
-
- ../cdfmoy ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
- mv -f cdfmoy.nc ${CONFCASE}_y${YEAR}m${month}_$grid.nc
- mv -f cdfmoy2.nc ${CONFCASE}_y${YEAR}m${month}_${grid}2.nc
- \rm ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
- done
-
- ../cdfmoy_annual ${CONFCASE}_y${YEAR}m??_$grid.nc
- mv -f cdfmoy_annual.nc ${CONFCASE}_y${YEAR}_ANNUAL_$grid.nc
- ../cdfmoy_annual ${CONFCASE}_y${YEAR}m??_${grid}2.nc #; putannual ${grid}2 ;;
- mv -f cdfmoy_annual.nc ${CONFCASE}_y${YEAR}_ANNUAL_${grid}2.nc
- done
-done
diff --git a/JOBS/cdfmoy_multiple.ksh b/JOBS/cdfmoy_multiple.ksh
deleted file mode 100755
index 67cfff3..0000000
--- a/JOBS/cdfmoy_multiple.ksh
+++ /dev/null
@@ -1,78 +0,0 @@
-#!/bin/ksh
-
-CONFCASE=$1
-YEAR=$2
-
-CONFIG=${CONFCASE%-*}
-CASE=${CONFCASE#*-}
-
-# main script cp cdfmoy to the tmpdir. So, CDFTOOLS path is now set to ../
-CDFTOOLS=../
-
- rsh gaya mkdir ${CONFIG}/${CONFCASE}-MEAN0/$YEAR/
-# gridT files
- for f in $( rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m??d??\*_gridT.nc ) ; do
- mfget $f ./
- done
-
- $CDFTOOLS/cdfmoy *gridT.nc
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN0/$YEAR/${CONFCASE}_y${YEAR}_gridT.nc
- mfput cdfmoy2.nc ${CONFIG}/${CONFCASE}-MEAN0/$YEAR/${CONFCASE}_y${YEAR}_gridT2.nc
- \rm $list cdfmoy.nc cdfmoy2.nc *gridT.nc
-
-# gridU files
- for f in $( rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m??d??\*_gridU.nc ) ; do
- mfget $f ./
- done
-
- $CDFTOOLS/cdfmoy *gridU.nc
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN0/$YEAR/${CONFCASE}_y${YEAR}_gridU.nc
- mfput cdfmoy2.nc ${CONFIG}/${CONFCASE}-MEAN0/$YEAR/${CONFCASE}_y${YEAR}_gridU2.nc
- \rm $list cdfmoy.nc cdfmoy2.nc *gridU.nc
-
-# gridV files
- for f in $( rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m??d??\*_gridV.nc ) ; do
- mfget $f ./
- done
-
- $CDFTOOLS/cdfmoy *gridV.nc
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN0/$YEAR/${CONFCASE}_y${YEAR}_gridV.nc
- mfput cdfmoy2.nc ${CONFIG}/${CONFCASE}-MEAN0/$YEAR/${CONFCASE}_y${YEAR}_gridV2.nc
- \rm $list cdfmoy.nc cdfmoy2.nc *gridV.nc
-
-
-
-# gridW files
- for f in $( rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m??d??\*_gridW.nc ) ; do
- mfget $f ./
- done
-
- $CDFTOOLS/cdfmoy *gridW.nc
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN0/$YEAR/${CONFCASE}_y${YEAR}_gridW.nc
- mfput cdfmoy2.nc ${CONFIG}/${CONFCASE}-MEAN0/$YEAR/${CONFCASE}_y${YEAR}_gridW2.nc
- \rm $list cdfmoy.nc cdfmoy2.nc *gridW.nc
-
-
-# icemod files
- for f in $( rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m??d??\*_icemod.nc ) ; do
- mfget $f ./
- done
-
- $CDFTOOLS/cdfmoy *icemod.nc
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN0/$YEAR/${CONFCASE}_y${YEAR}_icemod.nc
- \rm $list cdfmoy.nc cdfmoy2.nc *icemod.nc
-
-# TRC files
- for f in $( rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m??d??\*_ptrcT.nc ) ; do
- mfget $f ./
- done
-
- $CDFTOOLS/cdfmoy *ptrcT.nc
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN0/$YEAR/${CONFCASE}_y${YEAR}_ptrcT.nc
- \rm $list cdfmoy.nc cdfmoy2.nc *ptrcT.nc
-
-# All is finished : touch a done file in ../
-
-touch ../$YEAR.done
-
-
diff --git a/JOBS/cdfmoy_skel_new.ksh b/JOBS/cdfmoy_skel_new.ksh
deleted file mode 100755
index 15e6392..0000000
--- a/JOBS/cdfmoy_skel_new.ksh
+++ /dev/null
@@ -1,116 +0,0 @@
-#!/bin/ksh
-# @ wall_clock_limit = 10:00:00
-# @ job_name = moy-YYYY
-# @ as_limit = 1gb
-# @ output = $(job_name).$(jobid)
-# @ error = $(job_name).$(jobid)
-# @ notify_user = molines at hmg.inpg.fr
-# @ notification = error
-# @ queue
-
-### OAR is valid on ZEPHIR
-#OAR -n metamoy
-#OAR -l /nodes=1/cpu=1,walltime=5:00:00
-#OAR -E METAMOY.%jobid%
-#OAR -O METAMOY.%jobid%
-
-### PBS is valid on JADE
-#PBS -N metamoy_jade
-#PBS -l select=1:ncpus=8:mpiprocs=8
-#PBS -l walltime=02:00:00
-#PBS -l place=scatter:excl
-#PBS -M molines at hmg.inpg.fr
-#PBS -mb -me
-#PBS -v NB_NODES=1,NB_NPROC=8
-
-#################################################################################
-# This script is used to compute time mean averages for DRAKKAR model output.
-# It replaces an older script which was also computing quarterly means.
-# All customisable variable are set in Part I.
-# This script must be launched from metamoy.ksh which edit the years
-#
-# $Rev$
-# $Date$
-# $Id$
-################################################################################
-
-set -x
-. $HOME/.profile
-P_CDF_DIR=$PDIR/RUN_CCOONNFF/CCOONNFF-CCAASSEE/CTL/CDF
-. $P_CDF_DIR/config_def.ksh
-
-cp $P_CDF_DIR/config_def.ksh $TMPDIR
-cp $P_CDF_DIR/function_def.ksh $TMPDIR
-cd $TMPDIR
-
-
-# Part I : setup config dependent names
-#--------------------------------------
-. ./config_def.ksh # this file (or a link) must exist in the current directory
-#
-# Part II define some usefull functions
-#---------------------------------------
-. ./function_def.ksh # this file (or a link) must exist in the current directory
-
-# Part III : main loops : no more customization below
-#-----------------------------------------------------
-# set up list of years to process
-# Metamoy meta script will subtitute YYYY and YYYE with correct begining and ending years
-YEARS=YYYY
-YEARE=YYYE
-LOCAL_SAVE=${LOCAL_SAVE:=0}
-
-YEARLST=""
-y=$YEARS
-while (( $y <= $YEARE )) ; do
- YEARLST="$YEARLST $y "
- y=$(( y + 1 ))
-done
-
-#
-CONFCASE=${CONFIG}-${CASE}
-
-# always work in TMPDIR ! not in the data dir as file will be erased at the end of the script !
-cd $TMPDIR
-mkdir MONTHLY
- if [ $LOCAL_SAVE = 1 ] ; then
- chkdir $WORKDIR/$CONFIG
- chkdir $WORKDIR/$CONFIG/${CONFCASE}-MEAN
- fi
-
-for YEAR in $YEARLST ; do
- SDIR=${CONFIG}/${CONFCASE}-S/$YEAR
- MDIR=$PREF/${CONFIG}/${CONFCASE}-MEAN/$YEAR
- chkdirg $MDIR
- if [ $LOCAL_SAVE = 1 ] ; then
- chkdir $WORKDIR/$CONFIG/${CONFCASE}-MEAN/$YEAR
- fi
-
- # Monthly mean
- #
- for grid in gridT gridU gridV gridW icemod ; do
- for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month $grid
- $CDFTOOLS/cdfmoy ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
- case $grid in
- icemod) putmonth $month $grid ;;
- *) putmonth $month $grid ;
- putmonth2 $month ${grid}2 ;;
- esac
-# \rm ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
- done
-
-
- # all monthes done for given grid, can compute annual mean ...for grid and grid2
- # suppose 5 day averages when creating monthly mean
- cd MONTHLY
- case $grid in
- icemod) $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_$grid.nc ; putannual $grid ;;
- *) $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_$grid.nc ; putannual $grid ;
- $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_${grid}2.nc ; putannual ${grid}2 ;;
- esac
- # clean MONTHLY from grid and grid2 files
- \rm ${CONFCASE}_y${YEAR}m??_$grid.nc ; \rm ${CONFCASE}_y${YEAR}m??_${grid}2.nc
- cd $TMPDIR
- done
-done
diff --git a/JOBS/cdfmoy_skel_vargas.ksh b/JOBS/cdfmoy_skel_vargas.ksh
deleted file mode 100755
index ba23a68..0000000
--- a/JOBS/cdfmoy_skel_vargas.ksh
+++ /dev/null
@@ -1,80 +0,0 @@
-#!/bin/ksh
-
-set -x
-P_CDF_DIR=$HOME/RUN_CCOONNFF/CCOONNFF-CCAASSEE/CTL/CDF
-cd $P_CDF_DIR
-
-# Part I : setup config dependent names
-#--------------------------------------
-. ./config_def.ksh # this file (or a link) must exist in the current directory
-
-cd $TMPDIR
-if [ ! -d MOY ] ; then mkdir MOY ; fi
-
-MOYDIR=$TMPDIR/MOY
-cd $MOYDIR
-cp $P_CDF_DIR/config_def.ksh $MOYDIR
-cp $P_CDF_DIR/function_def.ksh $MOYDIR
-
-# probably not necessary to repeat config_def ... but no harm ...
-. ./config_def.ksh # this file (or a link) must exist in the current directory
-#
-# Part II define some usefull functions
-#---------------------------------------
-. ./function_def.ksh # this file (or a link) must exist in the current directory
-
-# Part III : main loops : no more customization below
-#-----------------------------------------------------
-# set up list of years to process
-# Metamoy meta script will subtitute YYYY and YYYE with correct begining and ending years
-YEARS=YYYY
-YEARE=YYYE
-
-YEARLST=""
-y=$YEARS
-while (( $y <= $YEARE )) ; do
- YEARLST="$YEARLST $y "
- y=$(( y + 1 ))
-done
-
-#
-CONFCASE=${CONFIG}-${CASE}
-
-# always work in MOYDIR ! not in the data dir as file will be erased at the end of the script !
-cd $MOYDIR
-mkdir MONTHLY
-
-for YEAR in $YEARLST ; do
- SDIR=${CONFIG}/${CONFCASE}-S/$YEAR
- MDIR=$PREF/${CONFIG}/${CONFCASE}-MEAN/$YEAR
- chkdirg $MDIR
-
- # Monthly mean
- #
- for grid in gridT gridU gridV gridW icemod ; do
- for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month $grid
- $CDFTOOLS/cdfmoy ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
- case $grid in
- icemod) putmonth $month $grid ;;
- *) putmonth $month $grid ;
- putmonth2 $month ${grid}2 ;;
- esac
- \rm ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
- done
-
- # all monthes done for given grid, can compute annual mean ...for grid and grid2
- # suppose 5 day averages when creating monthly mean
- cd MONTHLY
- case $grid in
- icemod) $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_$grid.nc ; putannual $grid ;;
- *) $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_$grid.nc ; putannual $grid ;
- $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_${grid}2.nc ; putannual ${grid}2 ;;
- esac
- # clean MONTHLY from grid and grid2 files
- mv ${CONFCASE}_y${YEAR}m??_$grid.nc $TMPDIR ; mv ${CONFCASE}_y${YEAR}m??_${grid}2.nc $TMPDIR
- mv ${CONFCASE}_y${YEAR}_ANNUAL*nc $TMPDIR
- cd $MOYDIR
- done
-done
-
diff --git a/JOBS/cdfmoy_trc_skel_new.ksh b/JOBS/cdfmoy_trc_skel_new.ksh
deleted file mode 100755
index 77ccb1a..0000000
--- a/JOBS/cdfmoy_trc_skel_new.ksh
+++ /dev/null
@@ -1,102 +0,0 @@
-#!/bin/ksh
-# @ wall_clock_limit = 10:00:00
-# @ job_name = trc-YYYY
-# @ as_limit = 1gb
-# @ output = $(job_name).$(jobid)
-# @ error = $(job_name).$(jobid)
-# @ notify_user = molines at hmg.inpg.fr
-# @ notification = error
-# @ queue
-
-#################################################################################
-# This script is used to compute time mean averages for DRAKKAR model output.
-# It replaces an older script which was also computing quarterly means.
-# All customisable variable are set in Part I.
-# This script must be launched from metamoy.ksh which edit the years
-#
-# $Rev: 117 $
-# $Date: 2007-11-15 14:45:14 +0100 (Thu, 15 Nov 2007) $
-# $Id: cdfmoy_skel_new.ksh 117 2007-11-15 13:45:14Z molines $
-################################################################################
-
-set -x
-. $HOME/.profile
-P_CDF_DIR=$HOME/RUN_CCOONNFF/CCOONNFF-CCAASSEE/CTL/CDF
-
-cp $P_CDF_DIR/config_def.ksh $TMPDIR
-cp $P_CDF_DIR/function_def.ksh $TMPDIR
-cd $TMPDIR
-
-
-# Part I : setup config dependent names
-#--------------------------------------
-. ./config_def.ksh # this file (or a link) must exist in the current directory
-#
-# Part II define some usefull functions
-#---------------------------------------
-. ./function_def.ksh # this file (or a link) must exist in the current directory
-
-# Part III : main loops : no more customization below
-#-----------------------------------------------------
-# set up list of years to process
-# Metamoy meta script will subtitute YYYY and YYYE with correct begining and ending years
-YEARS=YYYY
-YEARE=YYYE
-LOCAL_SAVE=${LOCAL_SAVE:=0}
-
-YEARLST=""
-y=$YEARS
-while (( $y <= $YEARE )) ; do
- YEARLST="$YEARLST $y "
- y=$(( y + 1 ))
-done
-
-#
-CONFCASE=${CONFIG}-${CASE}
-
-# always work in TMPDIR ! not in the data dir as file will be erased at the end of the script !
-cd $TMPDIR
-mkdir MONTHLY
- if [ $LOCAL_SAVE = 1 ] ; then
- chkdir $WORKDIR/$CONFIG
- chkdir $WORKDIR/$CONFIG/${CONFCASE}-MEAN
- fi
-
-
-for YEAR in $YEARLST ; do
- SDIR=${CONFIG}/${CONFCASE}-S/$YEAR
- MDIR=$PREF/${CONFIG}/${CONFCASE}-MEAN/$YEAR
- chkdirg $MDIR
- if [ $LOCAL_SAVE = 1 ] ; then
- chkdir $WORKDIR/$CONFIG/${CONFCASE}-MEAN/$YEAR
- fi
-
- # Monthly mean
- #
- for grid in ptrcT ; do
- for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month $grid
- $CDFTOOLS/cdfmoy ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
- case $grid in
- icemod) putmonth $month $grid ;;
- ptrcT) putmonth $month $grid ;;
- *) putmonth $month $grid ;
- putmonth2 $month ${grid}2 ;;
- esac
- \rm ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
- done
-
- # all monthes done for given grid, can compute annual mean ...for grid and grid2
- # suppose 5 day averages when creating monthly mean
- cd MONTHLY
- case $grid in
- icemod) $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_$grid.nc ; putannual $grid ;;
- ptrcT) $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_$grid.nc ; putannual $grid ;;
- *) $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_$grid.nc ; putannual $grid ;
- $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_${grid}2.nc ; putannual ${grid}2 ;;
- esac
- # clean MONTHLY from grid and grid2 files
- \rm ${CONFCASE}_y${YEAR}m??_$grid.nc ; \rm ${CONFCASE}_y${YEAR}m??_${grid}2.nc
- cd $TMPDIR
- done
-done
diff --git a/JOBS/cdfmoymxl.ll b/JOBS/cdfmoymxl.ll
deleted file mode 100755
index 66cd849..0000000
--- a/JOBS/cdfmoymxl.ll
+++ /dev/null
@@ -1,48 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 4200
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfmoymxl
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-set CASE=G43b
-
-set YEAR=0004
-#
-
-set CONFCASE=${CONFIG}-${CASE}
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0/
-
-
-cd $TMPDIR
-mkdir MONTHLY
-
-cp $CDFTOOLS/att.txt .
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/$YEAR/
-
-#goto annual
-#goto quarterly
-# Monthly mean
-#
-foreach month (01 02 03 04 05 06 07 08 09 10 11 12 )
- foreach f ( `rsh gaya ls ${CONFIG}/${CONFCASE}-DIAGS/$YEAR/${CONFCASE}_y${YEAR}m${month}\*_MXL.nc `)
- mfget $f ./
- end
-
- set list=''
- foreach f ( ${CONFCASE}_y${YEAR}m${month}d??_MXL.nc )
- set list=($list $f )
- end
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-DIAGS/$YEAR/${CONFCASE}_y${YEAR}m${month}_MXL.nc
- \rm $list cdfmoy.nc cdfmoy2.nc
-end
diff --git a/JOBS/cdfmoyvt_jade_new.ksh b/JOBS/cdfmoyvt_jade_new.ksh
deleted file mode 100755
index e299f72..0000000
--- a/JOBS/cdfmoyvt_jade_new.ksh
+++ /dev/null
@@ -1,139 +0,0 @@
-#!/bin/ksh
-# @ wall_clock_limit = 10:00:00
-# @ job_name = moy-YYYY
-# @ as_limit = 1gb
-# @ output = $(job_name).$(jobid)
-# @ error = $(job_name).$(jobid)
-# @ notify_user = molines at hmg.inpg.fr
-# @ notification = error
-# @ queue
-
-### OAR is valid on ZEPHIR
-#OAR -n metamoy
-#OAR -l /nodes=1/cpu=1,walltime=5:00:00
-#OAR -E METAMOY.%jobid%
-#OAR -O METAMOY.%jobid%
-
-### PBS is valid on JADE
-#PBS -N metamoyvt_jade
-#PBS -l select=1:ncpus=8:mpiprocs=8
-#PBS -l walltime=4:30:00
-#PBS -M molines at hmg.inpg.fr
-#PBS -mb -me
-
-#################################################################################
-# This script is used to compute time mean averages for DRAKKAR model output.
-# It replaces an older script which was also computing quarterly means.
-# All customisable variable are set in Part I.
-# This script must be launched from metamoy.ksh which edit the years
-#
-# $Rev: 229 $
-# $Date: 2009-03-24 09:34:51 +0100 (mar, 24 mar 2009) $
-# $Id: cdfmoy_skel_new.ksh 229 2009-03-24 08:34:51Z rcli002 $
-################################################################################
-
-set -x
-cd
-pwd
-. $HOME/.profile
-P_CDF_DIR=RUN_CCOONNFF/CCOONNFF-CCAASSEE/CTL/CDF
-. $P_CDF_DIR/config_def.ksh
-. $P_CDF_DIR/function_def.ksh
-
-chkdir $TMPDIR
-
-#test network
-login_node=service1
-chknet $login_node
-echo "$login_node $NET"
-if [ $NET = KO ] ; then
-login_node=service2
-chknet $login_node
-echo "$login_node $NET"
-fi;
-if [ $NET = KO ] ; then
-login_node=service3
-chknet $login_node
-echo "$login_node $NET"
-fi;
-if [ $NET = KO ] ; then
-echo network is KO
-date
-exit
-fi
-
- scp $USER@${login_node}:$P_CDF_DIR/config_def.ksh $TMPDIR/.
- scp $USER@${login_node}:$P_CDF_DIR/function_def.ksh $TMPDIR/.
- scp $USER@${login_node}:$CDFTOOLS/JOBS/mkmoy_jade.ksh $TMPDIR/mkmoy.ksh
- scp $USER@${login_node}:$CDFTOOLS/JOBS/mkvt_jade.ksh $TMPDIR/mkvt.ksh
- scp $USER@${login_node}:$CDFTOOLS/JOBS/testOK.ksh $TMPDIR/testOK.ksh
- chmod 755 $TMPDIR/testOK.ksh
-
-if [ ! -f $TMPDIR/cdfmoy ] ; then scp $USER@${login_node}:$CDFTOOLS/cdfmoy $TMPDIR/. ; fi ;
-if [ ! -f $TMPDIR/cdfmoy_annual ] ; then scp $USER@${login_node}:$CDFTOOLS/cdfmoy_annual $TMPDIR/. ; fi ;
-if [ ! -f $TMPDIR/cdfvT ] ; then scp $USER@${login_node}:$CDFTOOLS/cdfvT $TMPDIR/. ; fi ;
-
-cd $TMPDIR
-
-# Part I : setup config dependent names
-#--------------------------------------
-. ./config_def.ksh # this file (or a link) must exist in the current directory
-#
-# Part II define some usefull functions
-#---------------------------------------
-. ./function_def.ksh # this file (or a link) must exist in the current directory
-
-# Part III : main loops : no more customization below
-#-----------------------------------------------------
-# set up list of years to process
-# Metamoy meta script will subtitute YYYY and YYYE with correct begining and ending years
-YEARS=YYYY
-YEARE=YYYE
-
-YEARLST=""
-y=$YEARS
-while (( $y <= $YEARE )) ; do
- YEARLST="$YEARLST $y "
- y=$(( y + 1 ))
-done
-
-#
-CONFCASE=${CONFIG}-${CASE}
-
-# always work in TMPDIR ! not in the data dir as file will be erased at the end of the script !
-
-for YEAR in $YEARLST ; do
- SDIR=$PREF/${CONFIG}/${CONFCASE}-S/$YEAR
- MDIR=$PREF/${CONFIG}/${CONFCASE}-MEAN/$YEAR
- chkdirg $MDIR
- chkdir $YEAR
- rm -f $YEAR/OK?
- # Monthly mean
- #
- for grid in gridT gridU gridV gridW icemod ; do
-############### CDFMOY CDFVT #####################################
- if [ $grid = gridT ]; then NP=0 ; fi ;
- if [ $grid = gridU ]; then NP=1 ; fi ;
- if [ $grid = gridV ]; then NP=2 ; fi ;
- if [ $grid = gridW ]; then NP=3 ; fi ;
- if [ $grid = icemod ]; then NP=4 ; fi ;
-##################
- cd $TMPDIR
- cat mkmoy.ksh | sed -e "s/YYEEAARR/$YEAR/g" -e "s/GGRRIIDD/$grid/g" -e "s/NNPP/$NP/g" > $YEAR/tmp_mkmoy_$grid.ksh
- cd $YEAR
- chmod u+x tmp_mkmoy_$grid.ksh
- dplace -c$NP tmp_mkmoy_$grid.ksh > log_$grid 2>&1 &
- done
- NP=5
- cd $TMPDIR
- cat mkvt.ksh | sed -e "s/YYEEAARR/$YEAR/g" -e "s/NNPP/$NP/g" > $YEAR/tmp_mkvt.ksh
- cd $YEAR
- chmod u+x tmp_mkvt.ksh
- dplace -c$NP tmp_mkvt.ksh > log_VT 2>&1 & #dplace -c$NP
- dplace -c6 ../testOK.ksh > log_test1 2>&1
- dplace -c7 ../testOK.ksh > log_test2 2>&1
-cd $TMPDIR
- # clean directory for eventually next year:
-################# CDFVT #####################################
-done
-
diff --git a/JOBS/cdfmoyvt_skel_new.ksh b/JOBS/cdfmoyvt_skel_new.ksh
deleted file mode 100755
index 37f61c3..0000000
--- a/JOBS/cdfmoyvt_skel_new.ksh
+++ /dev/null
@@ -1,328 +0,0 @@
-#!/bin/ksh
-# @ wall_clock_limit = 10:00:00
-# @ job_name = moy-YYYY
-# @ as_limit = 1gb
-# @ output = $(job_name).$(step_name).$(jobid)
-# @ error = $(output)
-# @ notify_user = molines at hmg.inpg.fr
-# @ notification = error
-
-# @ step_name = cdfmoy1
-# @ job_type = serial
-# @ wall_clock_limit = 7200
-# @ data_limit = 0.8Gb
-# @ queue
-
-# @ step_name = cdfvt2
-# @ job_type = serial
-# @ wall_clock_limit = 7200
-# @ data_limit = 0.8Gb
-# @ queue
-
-# @ step_name = monitor3
-# @ dependency = (cdfmoy1 == 0 && cdfvt2 == 0 )
-# @ job_type = serial
-# @ wall_clock_limit = 7200
-# @ data_limit = 0.8Gb
-# @ queue
-
-# @ step_name = clean4
-# @ dependency = (monitor3 == 0 )
-# @ job_type = serial
-# @ wall_clock_limit = 7200
-# @ data_limit = 0.8Gb
-# @ queue
-
-
-### OAR is valid on ZEPHIR
-#OAR -n metamoy
-#OAR -l /nodes=1/cpu=1,walltime=5:00:00
-#OAR -E METAMOY.%jobid%
-#OAR -O METAMOY.%jobid%
-
-
-#################################################################################
-# This script is used to compute time mean averages for DRAKKAR model output.
-# It replaces an older script which was also computing quarterly means.
-# All customisable variable are set in Part I.
-# This script must be launched from metamoy.ksh which edit the years
-#
-# $Rev: 262 $
-# $Date: 2009-08-08 11:25:10 +0200 (Sat, 08 Aug 2009) $
-# $Id: cdfmoy_skel_new.ksh 262 2009-08-08 09:25:10Z rcli002 $
-################################################################################
-
-jobid=${TMPDIR##*.}
-
-TMPDIR0=$WORKDIR/METAMOY.$jobid
-if [ ! -d $TMPDIR0 ] ; then mkdir $TMPDIR0 ;fi
-
-
-set -x
-
-case $LOADL_STEP_NAME in
- cdfmoy1 )
- TMPDIR=$TMPDIR0/CDFMOY
- if [ ! -d $TMPDIR ] ; then mkdir $TMPDIR ;fi
-. $HOME/.profile
-P_CDF_DIR=$PDIR/RUN_CCOONNFF/CCOONNFF-CCAASSEE/CTL/CDF
-. $P_CDF_DIR/config_def.ksh
-
-cp $P_CDF_DIR/config_def.ksh $TMPDIR
-cp $P_CDF_DIR/function_def.ksh $TMPDIR
-cd $TMPDIR
-
-
-# Part I : setup config dependent names
-#--------------------------------------
-. ./config_def.ksh # this file (or a link) must exist in the current directory
-#
-# Part II define some usefull functions
-#---------------------------------------
-. ./function_def.ksh # this file (or a link) must exist in the current directory
-
-# Part III : main loops : no more customization below
-#-----------------------------------------------------
-# set up list of years to process
-# Metamoy meta script will subtitute YYYY and YYYE with correct begining and ending years
-YEARS=YYYY
-YEARE=YYYE
-LOCAL_SAVE=${LOCAL_SAVE:=0}
-
-YEARLST=""
-y=$YEARS
-while (( $y <= $YEARE )) ; do
- YEARLST="$YEARLST $y "
- y=$(( y + 1 ))
-done
-
-#
-CONFCASE=${CONFIG}-${CASE}
-
-# always work in TMPDIR ! not in the data dir as file will be erased at the end of the script !
-cd $TMPDIR
-mkdir MONTHLY
- if [ $LOCAL_SAVE = 1 ] ; then
- chkdir $WORKDIR/$CONFIG
- chkdir $WORKDIR/$CONFIG/${CONFCASE}-MEAN
- fi
-
-for YEAR in $YEARLST ; do
- SDIR=${CONFIG}/${CONFCASE}-S/$YEAR
- MDIR=$PREF/${CONFIG}/${CONFCASE}-MEAN/$YEAR
- chkdirg $MDIR
- if [ $LOCAL_SAVE = 1 ] ; then
- chkdir $WORKDIR/$CONFIG/${CONFCASE}-MEAN/$YEAR
- fi
-
- # Monthly mean
- #
- for grid in gridT gridU gridV gridW icemod ; do
- for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month $grid
- $CDFTOOLS/cdfmoy ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
- case $grid in
- icemod) putmonth $month $grid ;;
- *) putmonth $month $grid ;
- putmonth2 $month ${grid}2 ;;
- esac
-# \rm ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
- done
-
-
- # all monthes done for given grid, can compute annual mean ...for grid and grid2
- # suppose 5 day averages when creating monthly mean
- cd MONTHLY
- case $grid in
- icemod) $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_$grid.nc ; putannual $grid ;;
- *) $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_$grid.nc ; putannual $grid ;
- $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_${grid}2.nc ; putannual ${grid}2 ;;
- esac
- # clean MONTHLY from grid and grid2 files
- \rm ${CONFCASE}_y${YEAR}m??_$grid.nc ; \rm ${CONFCASE}_y${YEAR}m??_${grid}2.nc
- cd $TMPDIR
- done
-done
- ;;
-
-cdfvt2 )
-
- TMPDIR=$TMPDIR0/CDFVT
- if [ ! -d $TMPDIR ] ; then mkdir $TMPDIR ;fi
-set -x
-. $HOME/.profile
-P_CDF_DIR=$PDIR/RUN_CCOONNFF/CCOONNFF-CCAASSEE/CTL/CDF
-. $P_CDF_DIR/config_def.ksh
-
-cp $P_CDF_DIR/config_def.ksh $TMPDIR
-cp $P_CDF_DIR/function_def.ksh $TMPDIR
-cd $TMPDIR
-
-
-# Part I : setup config dependent names
-#--------------------------------------
-. ./config_def.ksh # config_def.ksh may be a link to an existing configuration file
-
-# Part II define some usefull functions
-#---------------------------------------
-. ./function_def.ksh # function_def.ksh may be a link to customizable function file
-
-# Part III : main loops : no more customization below
-#-----------------------------------------------------
-# set up list of years to process
-# Metamoy meta script will subtitute YYYY and YYYE with correct begining and ending years
-YEARS=YYYY
-YEARE=YYYE
-LOCAL_SAVE=${LOCAL_SAVE:=0}
-
-YEARLST=""
-y=$YEARS
-
-while (( $y <= $YEARE )) ; do
- YEARLST="$YEARLST $y "
- y=$(( y + 1 ))
-done
-
-#
-CONFCASE=${CONFIG}-${CASE}
-
-# always work in TMPDIR ! not in the data dir as file will be erased at the end of the script !
-cd $TMPDIR
-mkdir MONTHLY
- if [ $LOCAL_SAVE = 1 ] ; then
- chkdir $WORKDIR/$CONFIG
- chkdir $WORKDIR/$CONFIG/${CONFCASE}-MEAN
- fi
-
-for YEAR in $YEARLST ; do
- SDIR=${CONFIG}/${CONFCASE}-S/$YEAR
- MDIR=$PREF/${CONFIG}/${CONFCASE}-MEAN/$YEAR
- chkdirg $MDIR
- if [ $LOCAL_SAVE = 1 ] ; then
- chkdir $WORKDIR/$CONFIG/${CONFCASE}-MEAN/$YEAR
- fi
-
- # Monthly mean
- #
- for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month gridT
- getmonth $month gridU
- getmonth $month gridV
-
- list=''
- for f in ${CONFCASE}_y${YEAR}m${month}d??_gridT.nc ; do
- tag=$( echo $f | awk -F_ '{print $2}' )
- list="$list $tag"
- done
-
- $CDFTOOLS/cdfvT $CONFCASE $list
- putvtmonth $month
- \rm ${CONFCASE}_y${YEAR}m${month}d??_grid[UVT].nc
- done
-
- # annual mean (uses a ponderation to compute the exact annual mean ). ! suppose 5 day averages when creating monthly mean
- cd $TMPDIR/MONTHLY
- $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_VT.nc
- putvtannual
-
- # clean directory for eventually next year:
- \rm ${CONFCASE}_y${YEAR}m??_VT.nc
- cd $TMPDIR
-done
- ;;
-
-monitor3 )
-set -x
- TMPDIR=$TMPDIR0/MONITOR
- if [ ! -d $TMPDIR ] ; then mkdir $TMPDIR ;fi
-
-. ./config_def.ksh # config_def.ksh may be a link to an existing configuration file
-
-# set the list of years you want to monitor 'at once'
-yinit=YYYY # initial year
-yend=YYYE # last year
-
-YEARS=''
-while (( $yinit <= $yend )) ; do
- YEARS="$YEARS $yinit "
- yinit=$(( yinit + 1 ))
-done
-
-MESH_MASK_ID='ORCA05-G70.112-no-caspian' # root part of the mesh-mask files
- # (they must be in the -I directory ( $CONFIG/${CONFIG}-I)
- # Standard name is thus : ${MESH_MASK_ID}_byte_mask.nc
- # ${MESH_MASK_ID}_mesh_hgr.nc
- # ${MESH_MASK_ID}_mesh_zgr.nc
-#
-TSCLIM='' # can be either '' -> default to Levitus_p2.1
- # Gouretski
- # Levitus_p2.1
-
-CDFTOOLS=~rcli002/CDFTOOLS-2.1 # PATH for the cdftools executables
-
-# define the I-J window for GIB diags and El NINO DIAG
-if [ $CONFIG = 'NATL025' ] ; then
- GIBWIN='338 353 239 260'
- # NOT RELEVANT FOR NATL025. Here for compatibility
- NINO12='790 830 459 499'
- NINO3='550 790 479 519 '
- NINO4='350 550 479 519 '
- NINO34='470 670 479 519 '
-elif [ $CONFIG = 'ORCA025.L75' ] ; then
- GIBWIN='1094 1109 653 674 '
- NINO12='790 830 459 499'
- NINO3='550 790 479 519 '
- NINO4='350 550 479 519 '
- NINO34='470 670 479 519 '
-elif [ $CONFIG = 'ORCA05' ] ; then
- GIBWIN='547 554 326 337 '
- NINO12='395 415 229 249'
- NINO3='275 395 239 259'
- NINO4='175 275 239 259'
- NINO34='235 335 239 259'
-else
- echo GIBWIN and NINO boxes not defined for config $CONFIG
- exit 1
-fi
-
-
-# menu (set to 1 if you want it, to anything else if you do not !)
-EKE=1 # compute EKE
-RMSSSH=1 # compute RMS ssh and w
-TSMEAN=1 # compute TSMEAN and ssh drift
-ICE=0 # compute ice volume, area and extent
-ICEMONTH=1 # compute ice volume, area and extent
-GIB=1 # compute Gibraltar diags (restoring zone)
-ELNINO=1 # compute El Nino monitoring SSTs
-TRP=1 # compute barotropic transport accross section as given in section.dat (CTL dir)
-MHT=1 # compute Meridional Heat Transport (advective and from surface fluxes)
-MOC=1 # compute MOC ( need a sub basin mask file called new_maskglo.nc)
-MAXMOC=1 # diagnose the min and max of MOC
-BSF=1 # compute the BSF (psi) from U and V
-DCT=1 # compute density class transports for section given in dens_section.dat (CTL dir)
-MXL=1 # Compute mixed layer depth from 3 criteria for month 03 and 09
-TRACER=0 # Compute passive Tracer statistics
-
-#--------------------- nothing to touch below -----------------------------------------
-# copy config and function to the working directory.
-cp config_def.ksh $TMPDIR
-cp function_def.ksh $TMPDIR
-
-CONFCASE=${CONFIG}-${CASE}
-cd $TMPDIR
-. ./config_def.ksh
-
-for YEAR in $YEARS ; do
- . $CDFTOOLS/JOBS/monitor_prod.ksh
- cd $WORKDIR/$CONFIG/${CONFCASE}-MEAN/
- \rm -r $YEAR
- cd $TMPDIR
-done
- rsh gaya "cd $CONFIG/${CONFCASE}-DIAGS ; ~/bin/mkmtl.ksh "
-
- ;;
-clean4)
- cd $WORKDIR
- \rm -rf $TMPDIR0
- ;;
-esac
diff --git a/JOBS/cdfmxl.ll b/JOBS/cdfmxl.ll
deleted file mode 100755
index 347b263..0000000
--- a/JOBS/cdfmxl.ll
+++ /dev/null
@@ -1,44 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfmxl
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-set CASE=G42
-set YEAR=0005
-set MESH_ZGR=ORCA025-G42_mesh_zgr.nc
-#
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
- set CONFCASE=${CONFIG}-${CASE}
-
- cd $TMPDIR
- cp $CDFTOOLS/att.txt .
- cp $CDFTOOLS/cdfmxl .
- chmod 755 cdfsig0
- mfget $CONFIG/${CONFIG}-I/$MESH_ZGR mesh_zgr.nc
-
- rsh gaya mkdir $CONFIG/${CONFCASE}-DIAGS/
- rsh gaya mkdir $CONFIG/${CONFCASE}-DIAGS/$YEAR
-
-foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}\*gridT.nc ` )
- mfget $f ./
- set g=`basename $f | sed -e 's/gridT/MXL/' `
-
- ./cdfmxl `basename $f`
-
- mfput mxl.nc $CONFIG/${CONFCASE}-DIAGS/$YEAR/$g
- \rm `basename $f` mxl.nc
-
-end
-
diff --git a/JOBS/cdfpsi-inter.ll b/JOBS/cdfpsi-inter.ll
deleted file mode 100755
index 4f2ddd4..0000000
--- a/JOBS/cdfpsi-inter.ll
+++ /dev/null
@@ -1,44 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfpsi-inter
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-set CONFIG=ORCA025
-set CASE=G42
-set YEAR=0008-0010
-
-#
- set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-cd $TMPDIR
-
-mfget $CONFIG/${CONFIG}-I/${CONFIG}-${CASE}_mesh_hgr.nc mesh_hgr.nc
-mfget $CONFIG/${CONFIG}-I/${CONFIG}-${CASE}_mesh_zgr.nc mesh_zgr.nc
-mfget $CONFIG/${CONFIG}-I/${CONFIG}-${CASE}_byte_mask.nc mask.nc
-
- set CONFCASE=${CONFIG}-${CASE}
-
- cp $CDFTOOLS/att.txt .
- cp $CDFTOOLS/cdfpsi .
- chmod 755 cdfpsi
-
- foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_grid\[UV\].nc ` )
- mfget $f ./
- end
-
- ./cdfpsi ${CONFCASE}_y${YEAR}_gridU.nc ${CONFCASE}_y${YEAR}_gridV.nc
-
- mv psi.nc ${CONFCASE}_y${YEAR}_PSI.nc
- mfput ${CONFCASE}_y${YEAR}_PSI.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/
-
- \rm *PSI*
-
diff --git a/JOBS/cdfpsi.ll b/JOBS/cdfpsi.ll
deleted file mode 100755
index 60f7697..0000000
--- a/JOBS/cdfpsi.ll
+++ /dev/null
@@ -1,49 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfpsi
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-set CONFIG=ORCA025
-set CASE=G50
-
-set YEARS=(1948 1949 1950 1951 )
-set MESH_MASK_ID='ORCA025-G45b'
-
-
-#
-set CONFCASE=${CONFIG}-${CASE}
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-cd $TMPDIR
-cp $CDFTOOLS/att.txt .
-cp $CDFTOOLS/cdfpsi .
-chmod 755 cdfpsi
-
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
-foreach YEAR ( $YEARS )
-
-
- foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_grid\[UV\].nc ` )
- mfget $f ./
- end
-
- ./cdfpsi ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- mv psi.nc ${CONFCASE}_y${YEAR}_PSI.nc
- mfput ${CONFCASE}_y${YEAR}_PSI.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/
-
- \rm *ANNUAL* *PSI*
-end
-
diff --git a/JOBS/cdfrms.ll b/JOBS/cdfrms.ll
deleted file mode 100755
index 3a84f4a..0000000
--- a/JOBS/cdfrms.ll
+++ /dev/null
@@ -1,51 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfrms
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA05
-
-set YEAR=0008-0010
-#
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-#foreach CASE ( G22 G23 G03 )
-foreach CASE ( G32 )
- set CONFCASE=${CONFIG}-${CASE}
-
- cd $TMPDIR
- cp $CDFTOOLS/att.txt .
- cp $CDFTOOLS/cdfrmsssh ./
- chmod 755 cdfrmsssh
- cp $CDFTOOLS/cdfstdevw ./
- chmod 755 cdfstdevw
-
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_gridT.nc ./
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_gridT2.nc ./
-
- ./cdfrmsssh ${CONFCASE}_y${YEAR}_gridT.nc ${CONFCASE}_y${YEAR}_gridT2.nc
-
- mfput rms.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_RMSSSH.nc
- \rm rms.nc
-
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_gridW.nc ./
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_gridW2.nc ./
-
- ./cdfstdevw ${CONFCASE}_y${YEAR}_gridW.nc ${CONFCASE}_y${YEAR}_gridW2.nc
-
- mfput rmsw.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_STDEVW.nc
- \rm rmsw.nc
-
-
-end
-
diff --git a/JOBS/cdfsigma0.ll b/JOBS/cdfsigma0.ll
deleted file mode 100755
index c3961ab..0000000
--- a/JOBS/cdfsigma0.ll
+++ /dev/null
@@ -1,43 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfsigma0
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-
-set YEAR=0010
-#
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-set CASE=G22
- set CONFCASE=${CONFIG}-${CASE}
-
- cd $TMPDIR
- cp $CDFTOOLS/att.txt .
- cp $CDFTOOLS/cdfsig0 .
- chmod 755 cdfsig0
-
- rsh gaya mkdir $CONFIG/${CONFCASE}-DIAGS/
- rsh gaya mkdir $CONFIG/${CONFCASE}-DIAGS/$YEAR
-
-foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}\*gridT.nc ` )
- mfget $f ./
- set g=`basename $f | sed -e 's/gridT/SIG0/' `
-
- ./cdfsig0 `basename $f`
-
- mfput sig0.nc $CONFIG/${CONFCASE}-DIAGS/$YEAR/$g
- \rm `basename $f` sig0.nc
-
-end
-
diff --git a/JOBS/cdfsigtrp_1month.ll b/JOBS/cdfsigtrp_1month.ll
deleted file mode 100755
index 45ea194..0000000
--- a/JOBS/cdfsigtrp_1month.ll
+++ /dev/null
@@ -1,82 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 7200
-# @ data_limit = 2gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfsigtrp1m
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA05
-set CASE=G50
-
-set YEARS=( 1949 \
- 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 \
- 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 \
- 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 \
- 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 \
- 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 \
- 2000 2001 2002 2003 2004 )
-set MESH_MASK_ID='ORCA05-G50'
-
-set CONFCASE=${CONFIG}-${CASE}
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-set P_CTL=$HOME/RUN_${CONFIG}/${CONFCASE}/CTL
-
-
-cd $TMPDIR
-cp $CDFTOOLS/cdfsigtrp ./
-cp $CDFTOOLS/att.txt .
-cp $P_CTL/dens_section.dat .
-
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
-foreach year ( $YEARS )
-
- rsh gaya mkdir ${CONFIG}/${CONFCASE}-TRPSIG/$year/
-
- foreach tfich (`rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$year/\*m\?\?_gridT.nc ` )
- set ufich=`echo $tfich | sed -e 's/gridT/gridU/' `
- set vfich=`echo $tfich | sed -e 's/gridT/gridV/' `
-
- mfget $tfich ./
- mfget $ufich ./
- mfget $vfich ./
-
- set tfich=`basename $tfich`
- set ufich=`basename $ufich`
- set vfich=`basename $vfich`
-
- set tag=`echo $tfich | sed -e "s/${CONFCASE}_//" -e 's/_gridT.nc//'`
-
-
-
- echo $tag > ${CONFCASE}_${tag}_trpsig_monitor.lst
-
-
- ./cdfsigtrp $tfich $ufich $vfich 21 30 180 -bimg -print >> ${CONFCASE}_y${tag}_trpsig_monitor.lst
-
- mfput ${CONFCASE}_y${tag}_trpsig_monitor.lst ${CONFIG}/${CONFCASE}-TRPSIG/$year/
- foreach b (*.bimg)
- mv $b ${CONFCASE}_y${tag}_$b
- mfput ${CONFCASE}_y${tag}_$b ${CONFIG}/${CONFCASE}-TRPSIG/$year/
- end
-
- \rm *.bimg
- mv trpsig.txt ${CONFCASE}_y${tag}_trpsig.txt
- mfput ${CONFCASE}_y${tag}_trpsig.txt ${CONFIG}/${CONFCASE}-TRPSIG/$year/
-
- end
-
-end
-
-
-#
diff --git a/JOBS/cdfsstconv.ll b/JOBS/cdfsstconv.ll
deleted file mode 100644
index 3d7601e..0000000
--- a/JOBS/cdfsstconv.ll
+++ /dev/null
@@ -1,101 +0,0 @@
-#!/bin/ksh
-# @ cpu_limit = 4200
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfsstconv
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-set -x
-#
-# Define some functions to get/put file from/to gaya (can be easily customized)
-
-# rapatrie : Usage: rapatrie remote_file directory local_file
-# if local_file already here do nothing, else mfget it from gaya,
-# directory/remote_file
-rapatrie() { if [ ! -f $3 ] ; then mfget $2/$1 $3 ; else echo $3 is already \
- downloaded ; fi ; }
-
-# expatrie : Usage: expatrie local_file directory remote_file
-# put local file on gaya in directory/remote_file
-#
-expatrie() { mfput $1 $2/$3 ; }
-
-# chkfile : Usage: chkfile gaya_file
-# check if a file exists on gaya, return present or absent.
-chkfile() { rsh gaya " if [ -f $1 ] ; then echo present ;
- else echo absent ; fi " ; }
-
-# chkdirg : Usage: chkdirg gaya_directory
-# check the existence of a directory on gaya. Create it if not present
-chkdirg() { rsh gaya " if [ ! -d $1 ] ; then mkdir $1 ; fi " ; }
-
-# chkdirw : Usage: chkdirw web_site_directory
-# check the existence of a dir. on the web site. Create it if not present
-chkdirw() { rsh meolipc.hmg.inpg.fr -l apache " if [ ! -d web/DRAKKAR/$1 ] ;
- then mkdir web/DRAKKAR/$1 ; fi " ; }
-
-# chkdir : Usage: chkdir local_dir
-# check the existence of a directory. Create it if not present
-chkdir() { if [ ! -d $1 ] ; then mkdir $1 ; fi ; }
-
-
-CDFTOOLS=CDFTOOLS-2.1
-CONFIG=ATL3
-DIRCOO=/cache2/rost011/CLIPPER/GRID
-COORD=coordinates.${CONFIG}
-IDIR=/cache3/rost005/rcli007/${CONFIG}-I
-IDIRNC=${CONFIG}/${CONFIG}-I
-
-chkdirg $CONFIG
-chkdirg $IDIRNC
-
-cd $TMPDIR
-
-cp ~/$CDFTOOLS/cdfsstconv ./
-# coordinates.diags
-rapatrie $COORD $DIRCOO coordinates.diags
-
-year=1992
-year2=1995
-while (( $year <= $year2 )) ; do
- emp=ECMWF_emp_1d_${year}.${CONFIG}.nc
- sst0=REYNOLDS_sst_1d_${year}.${CONFIG}.nc
- if [ $(chkfile $IDIRNC/$sst0 ) == absent ] ; then
- # get fluxes and STRESS monthly files
- m=1
-# while (( $m <= 12 )) ; do
-# mm=$( printf "%02d" $m )
-# flx=ECMWF.Y${year}.M${mm}.FLUX.${CONFIG}.dimg
-# str=ECMWF.Y${year}.M${mm}.STRESS.${CONFIG}.dimg
-# rapatrie $flx $IDIR $flx
-# rapatrie $str $IDIR $str
-# m=$(( m + 1 ))
-# done
- # get SST for year -1 year and year+1
- ym1=$(( year - 1 ))
- yp1=$(( year + 1 ))
- y=$ym1
- while (( $y <= $yp1 )) ; do
- sst=REYNOLDS.Y${y}.SST.${CONFIG}.dimg
- if (( $y <= 2000 )) ; then
- rapatrie $sst $IDIR $sst
- fi
- y=$(( y + 1 ))
- done
- ./cdfsstconv $year $CONFIG
- for f in *.nc ; do
- expatrie $f $IDIRNC $f
- # clean unnecessary files from tmpdir
- \rm $f
- done
- \rm -f ECMWF*.dimg REYNOLDS.Y${ym1}.SST.${CONFIG}.dimg
- fi
- year=$(( year + 1 ))
-done
-
-
-
diff --git a/JOBS/cdfstrconv.ll b/JOBS/cdfstrconv.ll
deleted file mode 100644
index c9d8208..0000000
--- a/JOBS/cdfstrconv.ll
+++ /dev/null
@@ -1,86 +0,0 @@
-#!/bin/ksh
-# @ cpu_limit = 4200
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfstrconv
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-#set -x
-#
-# Define some functions to get/put file from/to gaya (can be easily customized)
-
-# rapatrie : Usage: rapatrie remote_file directory local_file
-# if local_file already here do nothing, else mfget it from gaya,
-# directory/remote_file
-rapatrie() { if [ ! -f $3 ] ; then mfget $2/$1 $3 ; else echo $3 is already \
- downloaded ; fi ; }
-
-# expatrie : Usage: expatrie local_file directory remote_file
-# put local file on gaya in directory/remote_file
-#
-expatrie() { mfput $1 $2/$3 ; }
-
-# chkfile : Usage: chkfile gaya_file
-# check if a file exists on gaya, return present or absent.
-chkfile() { rsh gaya " if [ -f $1 ] ; then echo present ;
- else echo absent ; fi " ; }
-
-# chkdirg : Usage: chkdirg gaya_directory
-# check the existence of a directory on gaya. Create it if not present
-chkdirg() { rsh gaya " if [ ! -d $1 ] ; then mkdir $1 ; fi " ; }
-
-# chkdirw : Usage: chkdirw web_site_directory
-# check the existence of a dir. on the web site. Create it if not present
-chkdirw() { rsh meolipc.hmg.inpg.fr -l apache " if [ ! -d web/DRAKKAR/$1 ] ;
- then mkdir web/DRAKKAR/$1 ; fi " ; }
-
-# chkdir : Usage: chkdir local_dir
-# check the existence of a directory. Create it if not present
-chkdir() { if [ ! -d $1 ] ; then mkdir $1 ; fi ; }
-
-
-CDFTOOLS=CDFTOOLS-2.1
-CONFIG=ATL3
-DIRCOO=/cache2/rost011/CLIPPER/GRID
-COORD=coordinates.${CONFIG}
-IDIR=/cache3/rost005/rcli007/${CONFIG}-I
-IDIRNC=${CONFIG}/${CONFIG}-I
-
-chkdirg $CONFIG
-chkdirg $IDIRNC
-
-cd $TMPDIR
-
-cp ~/$CDFTOOLS/cdfstrconv ./
-# coordinates.diags
-rapatrie $COORD $DIRCOO coordinates.diags
-
-year=1993
-year2=1995
-while (( $year <= $year2 )) ; do
- str=ECMWF_taux_1d_${year}.${CONFIG}.nc
- if [ $(chkfile $IDIRNC/$str ) == absent ] ; then
- # get STRESS monthly files
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- str=ECMWF.Y${year}.M${mm}.STRESS.${CONFIG}.dimg
- rapatrie $str $IDIR $str
- m=$(( m + 1 ))
- done
- ./cdfstrconv $year $CONFIG
- for f in *.nc ; do
- expatrie $f $IDIRNC $f
- # clean unnecessary files from tmpdir
- \rm $f
- done
- fi
- year=$(( year + 1 ))
-done
-
-
-
diff --git a/JOBS/cdftransportiz-full.ll b/JOBS/cdftransportiz-full.ll
deleted file mode 100755
index 81d3e60..0000000
--- a/JOBS/cdftransportiz-full.ll
+++ /dev/null
@@ -1,52 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdftransportiz-full
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-
-set year=0008-0010
-#
-
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-
-cd $TMPDIR
-cp $CDFTOOLS/cdftransportiz-full .
-cp $CDFTOOLS/att.txt .
-cp $CDFTOOLS/section.dat .
-mfget ${CONFIG}/${CONFIG}-I/ORCA025_PS_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/ORCA025_PS_mesh_zgr.nc mesh_zgr.nc
-
-foreach CASE (G03 G04 )
-
-set CONFCASE=${CONFIG}-${CASE}
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/
-
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_VT.nc .
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_gridU.nc .
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_gridV.nc .
-
-./cdftransportiz-full ${CONFCASE}_y${year}_VT.nc \
- ${CONFCASE}_y${year}_gridU.nc \
- ${CONFCASE}_y${year}_gridV.nc 1250 3500 < section.dat > ${CONFCASE}_sections.txt
-
- grep -v Give ${CONFCASE}_sections.txt > tmp
-mv -f tmp ${CONFCASE}_sections.txt
-mfput ${CONFCASE}_sections.txt ${CONFIG}/${CONFCASE}-DIAGS/
-
-
-end
-
-
diff --git a/JOBS/cdftransportiz.ll b/JOBS/cdftransportiz.ll
deleted file mode 100755
index b09af4d..0000000
--- a/JOBS/cdftransportiz.ll
+++ /dev/null
@@ -1,56 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdftransportiz
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-set CASE=G50
-
-set YEARS=( 1948 1949 1950 1951 )
-set MESH_MASK_ID='ORCA025-G45b'
-
-set CONFCASE=${CONFIG}-${CASE}
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-
-cd $TMPDIR
-cp $CDFTOOLS/cdftransportiz .
-cp $CDFTOOLS/att.txt .
-cp $CDFTOOLS/section.dat .
-
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
-foreach year ( $YEARS )
-
-set CONFCASE=${CONFIG}-${CASE}
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/
-
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_ANNUAL_VT.nc .
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_ANNUAL_gridU.nc .
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_ANNUAL_gridV.nc .
-
-./cdftransportiz ${CONFCASE}_y${year}_VT.nc \
- ${CONFCASE}_y${year}_gridU.nc \
- ${CONFCASE}_y${year}_gridV.nc 1250 3500 < section.dat > ${CONFCASE}_sections.txt
-
- grep -v Give ${CONFCASE}_sections.txt > tmp
-mv -f tmp ${CONFCASE}_sections.txt
-mfput ${CONFCASE}_sections.txt ${CONFIG}/${CONFCASE}-DIAGS/
-
-
-end
-
-
-#
diff --git a/JOBS/cdftrc.ll b/JOBS/cdftrc.ll
deleted file mode 100755
index d4f8565..0000000
--- a/JOBS/cdftrc.ll
+++ /dev/null
@@ -1,81 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3600
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdftrc
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-set CONFIG=ORCA025
-set CASE=G50
-
-set YEARS=(1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965)
-#set YEARS=(1963)
-set MESH_MASK_ID='ORCA025-G50'
-
-
-#
-set CONFCASE=${CONFIG}-${CASE}
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-cd $TMPDIR
-cp $CDFTOOLS/att.txt .
-cp $CDFTOOLS/cdfmean .
-cp $CDFTOOLS/cdfzonalmean .
-cp $CDFTOOLS/cdfzonalsum .
-cp $CDFTOOLS/cdfzonalout .
-
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
-foreach YEAR ( $YEARS )
-# Absolute mean of concentration
- echo -n $YEAR ' ' > ${CONFCASE}_y${YEAR}_TRCmean.dat
-
- mfget ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m12d31_ptrcT.nc ./
-
- \rm -f tmp1
- ./cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invcfc T > tmp1
- set area=`cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}'`
- set mean=`cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}'`
- set total=` echo $mean $area | awk '{print $1 * $2 }' `
- echo -n $total ' ' >> ${CONFCASE}_y${YEAR}_TRCmean.dat
-
- \rm -f tmp1
- ./cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invc14 T > tmp1
- set area=`cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}'`
- set mean=`cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}'`
- set total=` echo $mean $area | awk '{print $1 * $2 }' `
- echo $total ' ' >> ${CONFCASE}_y${YEAR}_TRCmean.dat
-
- mfput ${CONFCASE}_y${YEAR}_TRCmean.dat ${CONFIG}/${CONFCASE}-DIAGS
-
-# zonal integral of inventories
- ./cdfzonalsum ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
-# zonal means
- ./cdfzonalmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
- ncks -F -d deptht,1,1 -v zocfc11_glo,zobc14_glo,nav_lon,nav_lat zonalmean.nc zonalsurf.nc
-
-# put in ascii format the 1D profiles
- ./cdfzonalout zonalmean.nc > zonalmean.dat
- ./cdfzonalout zonalsum.nc > zonalsum.dat
- ./cdfzonalout zonalsurf.nc > zonalsurf.dat
-
-mfput zonalmean.nc ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalmean.nc
-mfput zonalsum.nc ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalsum.nc
-
-mfput zonalmean.dat ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalmean.dat
-mfput zonalsum.dat ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalsum.dat
-mfput zonalsurf.dat ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalsurf.dat
-
-
-end
diff --git a/JOBS/cdfvT-inter.ll b/JOBS/cdfvT-inter.ll
deleted file mode 100755
index fbc26da..0000000
--- a/JOBS/cdfvT-inter.ll
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfvt-inter
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-set INTER=0008-0010
-set CONFIG=ORCA025
-set CASELIST=( G32 )
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-#######################
-set tmp=`echo $INTER | sed -e 's/-/ /'`
-set year1=`echo $tmp[1] | awk '{printf "%04d", $1 }'`
-set year2=`echo $tmp[2] | awk '{printf "%04d", $1 }'`
-
-set nyear=`expr $year2 - $year1 + 1 `
-set year=$year1
-set n=1
-set YEARLIST=''
-while ( $n <= $nyear )
- set YEARLIST=($YEARLIST $year)
- set year=`expr $year + 1 `
- set year=`echo $year | awk '{printf "%04d", $1 }'`
- @ n ++
-end
-
- cd $TMPDIR
- cp $CDFTOOLS/att.txt .
-
-foreach CASE ( $CASELIST )
- set CONFCASE=${CONFIG}-${CASE}
- rsh gaya mkdir $CONFIG/${CONFCASE}-MEAN/$INTER
-
-
-### VT ###
-###############
- set list=''
- foreach YEAR ( $YEARLIST )
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
- set list=($list ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mfput cdfmoy.nc ${CONFIG}/${CONFCASE}-MEAN/$INTER/${CONFCASE}_y${INTER}_VT.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
-end
diff --git a/JOBS/cdfvT.ll b/JOBS/cdfvT.ll
deleted file mode 100755
index 6d35a33..0000000
--- a/JOBS/cdfvT.ll
+++ /dev/null
@@ -1,108 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3600
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfvt
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-set CASE=G32
-
-set YEAR=0010
-#
-
-set CONFCASE=${CONFIG}-${CASE}
-
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-
-cd $TMPDIR
-mkdir MONTHLY
-
-cp $CDFTOOLS/att.txt .
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-MEAN/$YEAR/
-
-#goto annual
-#goto quarterly
-# Monthly mean
-
-foreach month (01 02 03 04 05 06 07 08 09 10 11 12 )
- foreach f ( `rsh gaya ls ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m${month}\*_gridT.nc ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m${month}\*_gridU.nc ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m${month}\*_gridV.nc `)
- mfget $f ./
- end
-
- set list=''
- foreach f ( ${CONFCASE}_y${YEAR}m${month}d??_gridT.nc )
- set tag=`echo $f | sed -e "s/${CONFCASE}_//" -e 's/_gridT.nc//'`
- set list=($list $tag )
- end
- $CDFTOOLS/cdfvT $CONFCASE $list
- mfput vt.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${month}_VT.nc
- \rm vt.nc ${CONFCASE}_y${YEAR}m${month}*_grid[TUV].nc
- end
-
-quarterly:
-# Quarterly mean
- cd $TMPDIR
- mkdir QUARTERLY
- cd MONTHLY
-
- foreach season ( WINT SPRI SUMM FALL )
- switch ($season)
- case WINT:
- set smon=(01 02 03 )
- breaksw
- case SPRI:
- set smon=(04 05 06 )
- breaksw
- case SUMM:
- set smon=(07 08 09 )
- breaksw
- case FALL:
- set smon=(10 11 12 )
- breaksw
- default:
- echo error ; exit 1
- breaksw
- endsw
-
- ln -s ../att.txt .
-
- set list=''
- foreach month ( $smon )
- mfget $CONFIG/${CONFCASE}-MEAN/${YEAR}/${CONFCASE}_y${YEAR}m${month}_VT.nc ./
- set list=($list ${CONFCASE}_y${YEAR}m${month}_VT.nc )
- end
-
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_${season}_VT.nc
- mfput ${CONFCASE}_y${YEAR}_${season}_VT.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_${season}_VT.nc
- mv ${CONFCASE}_y${YEAR}_${season}_VT.nc ../QUARTERLY
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
- end
-
-
-annual:
-# ANNUAL
- cd $TMPDIR
- cd QUARTERLY
- ln -s ../att.txt .
-
- set list=''
- foreach season ( WINT SPRI SUMM FALL )
- set list=($list ${CONFCASE}_y${YEAR}_${season}_VT.nc)
- end
- $CDFTOOLS/cdfmoy $list
- mv cdfmoy.nc ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
- mfput ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
- \rm -f cdfmoy.nc cdfmoy2.nc $list
-
diff --git a/JOBS/cdfvT_jade_new.ksh b/JOBS/cdfvT_jade_new.ksh
deleted file mode 100755
index 63b8059..0000000
--- a/JOBS/cdfvT_jade_new.ksh
+++ /dev/null
@@ -1,129 +0,0 @@
-#!/bin/ksh
-# @ wall_clock_limit = 10:00:00
-# @ job_name = vt-YYYY
-# @ as_limit = 1gb
-# @ output = $(job_name).$(jobid)
-# @ error = $(job_name).$(jobid)
-# @ notify_user = molines at hmg.inpg.fr
-# @ notification = error
-# @ queue
-
-### OAR is valid on ZEPHIR
-#OAR -n metavt
-#OAR -l /nodes=1/cpu=1,walltime=5:00:00
-#OAR -E METAVT.%jobid%
-#OAR -O METAVT.%jobid%
-
-### QSUB is valid on JADE
-#PBS -N metavt
-#PBS -l select=1:ncpus=8:mpiprocs=1
-#PBS -l walltime=02:00:00
-#PBS -l place=scatter:excl
-#PBS -M molines at hmg.inpg.fr
-#PBS -mb -me
-
-#################################################################################
-# This script is used to compute time mean averages for DRAKKAR model output.
-# It replaces an older script which was also computing quarterly means.
-# In this script mean quadratic terms US UT VS VT are computed from 5 days averages
-# All customisable variable are set in Part I.
-#
-# $Rev: 229 $
-# $Date: 2009-03-24 09:34:51 +0100 (mar, 24 mar 2009) $
-# $Id: cdfvT_skel_new.ksh 229 2009-03-24 08:34:51Z rcli002 $
-################################################################################
-
-set -x
-. $HOME/.profile
-P_CDF_DIR=$PDIR/RUN_CCOONNFF/CCOONNFF-CCAASSEE/CTL/CDF
-. $P_CDF_DIR/config_def.ksh
-. $P_CDF_DIR/function_def.ksh
-
-chkdir $TMPDIR
-
-#test network
-login_node=service1
-chknet $login_node
-echo "$login_node $NET"
-if [ $NET = KO ] ; then
-login_node=service2
-chknet $login_node
-echo "$login_node $NET"
-fi;
-if [ $NET = KO ] ; then
-login_node=service3
-chknet $login_node
-echo "$login_node $NET"
-fi;
-if [ $NET = KO ] ; then
-echo network is KO
-date
-exit
-fi
-
-scp $USER@${login_node}:$P_CDF_DIR/config_def.ksh $TMPDIR/.
-scp $USER@${login_node}:$P_CDF_DIR/function_def.ksh $TMPDIR/.
-if [ ! -f $TMPDIR/cdfvT ] ; then scp $USER@${login_node}:$CDFTOOLS/cdfvT $TMPDIR/. ; fi ;
-if [ ! -f $TMPDIR/cdfmoy_annual ] ; then scp $USER@${login_node}:$CDFTOOLS/cdfmoy_annual $TMPDIR/. ; fi ;
-
-
-cd $TMPDIR
-# Part I : setup config dependent names
-#--------------------------------------
-. ./config_def.ksh # config_def.ksh may be a link to an existing configuration file
-
-# Part II define some usefull functions
-#---------------------------------------
-. ./function_def.ksh # function_def.ksh may be a link to customizable function file
-
-# Part III : main loops : no more customization below
-#-----------------------------------------------------
-# set up list of years to process
-# Metamoy meta script will subtitute YYYY and YYYE with correct begining and ending years
-YEARS=YYYY
-YEARE=YYYE
-
-YEARLST=""
-y=$YEARS
-
-while (( $y <= $YEARE )) ; do
- YEARLST="$YEARLST $y "
- y=$(( y + 1 ))
-done
-
-#
-CONFCASE=${CONFIG}-${CASE}
-
-# always work in TMPDIR ! not in the data dir as file will be erased at the end of the script !
-
-for YEAR in $YEARLST ; do
-cd $TMPDIR
- SDIR=$PREF/${CONFIG}/${CONFCASE}-S/$YEAR
- MDIR=$PREF/${CONFIG}/${CONFCASE}-MEAN/$YEAR
- chkdirg $MDIR
- chkdir $YEAR
- cd $YEAR
-
- # Monthly mean
- #
- for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month gridT
- getmonth $month gridU
- getmonth $month gridV
-
- list=''
- for f in ${CONFCASE}_y${YEAR}m${month}d??_gridT.nc ; do
- tag=$( echo $f | awk -F_ '{print $2}' )
- list="$list $tag"
- done
-
- ../cdfvT $CONFCASE $list
- mv -f vt.nc ${CONFCASE}_y${YEAR}m${month}_VT.nc
- \rm ${CONFCASE}_y${YEAR}m${month}d??_grid[UVT].nc
- done
-
- # annual mean (uses a ponderation to compute the exact annual mean ). ! suppose 5 day averages when creating monthly mean
- ../cdfmoy_annual ${CONFCASE}_y${YEAR}m??_VT.nc
- mv -f cdfmoy_annual.nc ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
- # clean directory for eventually next year:
-done
diff --git a/JOBS/cdfvT_skel_new.ksh b/JOBS/cdfvT_skel_new.ksh
deleted file mode 100755
index ec389b0..0000000
--- a/JOBS/cdfvT_skel_new.ksh
+++ /dev/null
@@ -1,116 +0,0 @@
-#!/bin/ksh
-# @ wall_clock_limit = 10:00:00
-# @ job_name = vt-YYYY
-# @ as_limit = 1gb
-# @ output = $(job_name).$(jobid)
-# @ error = $(job_name).$(jobid)
-# @ notify_user = molines at hmg.inpg.fr
-# @ notification = error
-# @ queue
-
-### OAR is valid on ZEPHIR
-#OAR -n metavt
-#OAR -l /nodes=1/cpu=1,walltime=5:00:00
-#OAR -E METAVT.%jobid%
-#OAR -O METAVT.%jobid%
-
-### QSUB is valid on JADE
-#PBS -N metavt
-#PBS -l select=1:ncpus=8:mpiprocs=1
-#PBS -l walltime=02:00:00
-#PBS -l place=scatter:excl
-#PBS -M molines at hmg.inpg.fr
-#PBS -mb -me
-
-#################################################################################
-# This script is used to compute time mean averages for DRAKKAR model output.
-# It replaces an older script which was also computing quarterly means.
-# In this script mean quadratic terms US UT VS VT are computed from 5 days averages
-# All customisable variable are set in Part I.
-#
-# $Rev$
-# $Date$
-# $Id$
-################################################################################
-
-set -x
-. $HOME/.profile
-P_CDF_DIR=$PDIR/RUN_CCOONNFF/CCOONNFF-CCAASSEE/CTL/CDF
-. $P_CDF_DIR/config_def.ksh
-chkdir $TMPDIR
-
-cp $P_CDF_DIR/config_def.ksh $TMPDIR
-cp $P_CDF_DIR/function_def.ksh $TMPDIR
-cd $TMPDIR
-
-
-# Part I : setup config dependent names
-#--------------------------------------
-. ./config_def.ksh # config_def.ksh may be a link to an existing configuration file
-
-# Part II define some usefull functions
-#---------------------------------------
-. ./function_def.ksh # function_def.ksh may be a link to customizable function file
-
-# Part III : main loops : no more customization below
-#-----------------------------------------------------
-# set up list of years to process
-# Metamoy meta script will subtitute YYYY and YYYE with correct begining and ending years
-YEARS=YYYY
-YEARE=YYYE
-LOCAL_SAVE=${LOCAL_SAVE:=0}
-
-YEARLST=""
-y=$YEARS
-
-while (( $y <= $YEARE )) ; do
- YEARLST="$YEARLST $y "
- y=$(( y + 1 ))
-done
-
-#
-CONFCASE=${CONFIG}-${CASE}
-
-# always work in TMPDIR ! not in the data dir as file will be erased at the end of the script !
-cd $TMPDIR
-mkdir MONTHLY
- if [ $LOCAL_SAVE = 1 ] ; then
- chkdir $WORKDIR/$CONFIG
- chkdir $WORKDIR/$CONFIG/${CONFCASE}-MEAN
- fi
-
-for YEAR in $YEARLST ; do
- SDIR=${CONFIG}/${CONFCASE}-S/$YEAR
- MDIR=$PREF/${CONFIG}/${CONFCASE}-MEAN/$YEAR
- chkdirg $MDIR
- if [ $LOCAL_SAVE = 1 ] ; then
- chkdir $WORKDIR/$CONFIG/${CONFCASE}-MEAN/$YEAR
- fi
-
- # Monthly mean
- #
- for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month gridT
- getmonth $month gridU
- getmonth $month gridV
-
- list=''
- for f in ${CONFCASE}_y${YEAR}m${month}d??_gridT.nc ; do
- tag=$( echo $f | awk -F_ '{print $2}' )
- list="$list $tag"
- done
-
- $CDFTOOLS/cdfvT $CONFCASE $list
- putvtmonth $month
- \rm ${CONFCASE}_y${YEAR}m${month}d??_grid[UVT].nc
- done
-
- # annual mean (uses a ponderation to compute the exact annual mean ). ! suppose 5 day averages when creating monthly mean
- cd $TMPDIR/MONTHLY
- $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_VT.nc
- putvtannual
-
- # clean directory for eventually next year:
- \rm ${CONFCASE}_y${YEAR}m??_VT.nc
- cd $TMPDIR
-done
diff --git a/JOBS/cdfvT_skel_vargas.ksh b/JOBS/cdfvT_skel_vargas.ksh
deleted file mode 100755
index 1b18d0f..0000000
--- a/JOBS/cdfvT_skel_vargas.ksh
+++ /dev/null
@@ -1,80 +0,0 @@
-#!/bin/ksh
-
-set -x
-P_CDF_DIR=$HOME/RUN_CCOONNFF/CCOONNFF-CCAASSEE/CTL/CDF
-cd $P_CDF_DIR
-
-# Part I : setup config dependent names
-#--------------------------------------
-. ./config_def.ksh # config_def.ksh may be a link to an existing configuration file
-
-cd $TMPDIR
-mkdir VT
-VTDIR=$TMPDIR/VT
-cd $VTDIR
-
-cp $P_CDF_DIR/config_def.ksh $VTDIR
-cp $P_CDF_DIR/function_def.ksh $VTDIR
-
-
-. ./config_def.ksh # config_def.ksh may be a link to an existing configuration file
-
-# Part II define some usefull functions
-#---------------------------------------
-. ./function_def.ksh # function_def.ksh may be a link to customizable function file
-
-# Part III : main loops : no more customization below
-#-----------------------------------------------------
-# set up list of years to process
-# Metamoy meta script will subtitute YYYY and YYYE with correct begining and ending years
-YEARS=YYYY
-YEARE=YYYE
-
-YEARLST=""
-y=$YEARS
-
-while (( $y <= $YEARE )) ; do
- YEARLST="$YEARLST $y "
- y=$(( y + 1 ))
-done
-
-#
-CONFCASE=${CONFIG}-${CASE}
-
-# always work in VTDIR ! not in the data dir as file will be erased at the end of the script !
-cd $VTDIR
-mkdir MONTHLY
-
-for YEAR in $YEARLST ; do
- SDIR=${CONFIG}/${CONFCASE}-S/$YEAR
- MDIR=$PREF/${CONFIG}/${CONFCASE}-MEAN/$YEAR
- chkdirg $MDIR
-
- # Monthly mean
- #
- for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month gridT
- getmonth $month gridU
- getmonth $month gridV
-
- list=''
- for f in ${CONFCASE}_y${YEAR}m${month}d??_gridT.nc ; do
- tag=$( echo $f | awk -F_ '{print $2}' )
- list="$list $tag"
- done
-
- $CDFTOOLS/cdfvT $CONFCASE $list
- putvtmonth $month
- \rm ${CONFCASE}_y${YEAR}m${month}d??_grid[UVT].nc
- done
-
- # annual mean (uses a ponderation to compute the exact annual mean ). ! suppose 5 day averages when creating monthly mean
- cd $VTDIR/MONTHLY
- $CDFTOOLS/cdfmoy_annual ${CONFCASE}_y${YEAR}m??_VT.nc
- putvtannual
-
- # move to TMPDIR for monitoring
- mv ${CONFCASE}_y${YEAR}m??_VT.nc $TMPDIR
- mv ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc $TMPDIR
- cd $VTDIR
-done
diff --git a/JOBS/cdfvhst-full.ll b/JOBS/cdfvhst-full.ll
deleted file mode 100755
index 9482846..0000000
--- a/JOBS/cdfvhst-full.ll
+++ /dev/null
@@ -1,56 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfvhst-full
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-set CASE=G03
-
-#
-
-set CONFCASE=${CONFIG}-${CASE}
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-
-cd $TMPDIR
-cp $CDFTOOLS/cdfvhst-full .
-cp $CDFTOOLS/att.txt .
-mfget ${CONFIG}/${CONFIG}-I/ORCA025-G30_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/ORCA025-G30_mesh_zgr.nc mesh_zgr.nc
-mfget ${CONFIG}/${CONFIG}-I/ORCA025-G30_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/new_maskglo.nc .
-
-foreach year ( 0008-0010 )
-set CONFCASE=${CONFIG}-${CASE}
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/
-
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_VT.nc .
-
-./cdfvhst-full ${CONFCASE}_y${year}_VT.nc
-mv zonal_heat_trp.dat ${CONFCASE}_y${year}_heattrp.dat
-mv zonal_salt_trp.dat ${CONFCASE}_y${year}_salttrp.dat
-mv trp.nc ${CONFCASE}_y${year}_trp.nc
-
-mfput ${CONFCASE}_y${year}_trp.nc ${CONFIG}/${CONFCASE}-DIAGS/
-
-mfput ${CONFCASE}_y${year}_heattrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-cp ${CONFCASE}_y${year}_heattrp.dat $WORKDIR/${CONFCASE}-S/
-
-mfput ${CONFCASE}_y${year}_salttrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-cp ${CONFCASE}_y${year}_salttrp.dat $WORKDIR/${CONFCASE}-S/
-
-\rm -f *.dat ${CONFCASE}_y${year}_VT.nc ${CONFCASE}_y${year}_trp.nc
-
-
-end
-
diff --git a/JOBS/cdfvhst.ll b/JOBS/cdfvhst.ll
deleted file mode 100755
index 3dd13bc..0000000
--- a/JOBS/cdfvhst.ll
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/bin/csh
-# @ cpu_limit = 3500
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = cdfvhst
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-set echo
-
-
-set CONFIG=ORCA025
-set CASE=G30
-
-set YEAR=0008-0010
-#
-
-set CONFCASE=${CONFIG}-${CASE}
-set CDFTOOLS=~rcli002/CDFTOOLS-2.0
-
-
-cd $TMPDIR
-cp $CDFTOOLS/cdfvhst .
-cp $CDFTOOLS/att.txt .
-mfget ${CONFIG}/${CONFIG}-I/ORCA025-G30_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/ORCA025-G30_mesh_zgr.nc mesh_zgr.nc
-mfget ${CONFIG}/${CONFIG}-I/ORCA025-G30_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/new_maskglo.nc .
-
-foreach year ( 0008-0010 )
-set CONFCASE=${CONFIG}-${CASE}
-rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/
-
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_VT.nc .
-
-./cdfvhst ${CONFCASE}_y${year}_VT.nc
-mv zonal_heat_trp.dat ${CONFCASE}_y${year}_heattrp.dat
-mv zonal_salt_trp.dat ${CONFCASE}_y${year}_salttrp.dat
-mv trp.nc ${CONFCASE}_y${year}_trp.nc
-
-mfput ${CONFCASE}_y${year}_trp.nc ${CONFIG}/${CONFCASE}-DIAGS/
-
-mfput ${CONFCASE}_y${year}_heattrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-cp ${CONFCASE}_y${year}_heattrp.dat $WORKDIR/${CONFCASE}-S/
-
-mfput ${CONFCASE}_y${year}_salttrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-cp ${CONFCASE}_y${year}_salttrp.dat $WORKDIR/${CONFCASE}-S/
-
-\rm -f *.dat ${CONFCASE}_y${year}_VT.nc ${CONFCASE}_y${year}_trp.nc
-
-
-end
-
diff --git a/JOBS/cdfvsig_skel.ksh b/JOBS/cdfvsig_skel.ksh
deleted file mode 100755
index 07dccbc..0000000
--- a/JOBS/cdfvsig_skel.ksh
+++ /dev/null
@@ -1,92 +0,0 @@
-#!/bin/ksh
-# @ cpu_limit = 3600
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = vsig-YYYY
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-# Example of script for time-average computation for U x sigma0 terms
-# This script produce annual mean.
-# This works for DRAKKAR output ( 5day average, no leap year).
-
-# $Rev$
-# $Date$
-# $Id$
-
-
-set -x
-
-CONFIG=ORCA025
-CASE=G70
-MESH_MASK_ID=ORCA025-G70
-
-YEARS=YYYY
-YEARE=YYYE
-#
-YEARLST=""
-y=$YEARS
-
-while (( $y <= $YEARE )) ; do
- YEARLST="$YEARLST $y "
- y=$(( y + 1 ))
-done
-
-# define some usefull functions
-chkdirg() { rsh gaya " if [ ! -d $1 ] ; then mkdir $1 ; fi " ; }
-getmonth() { for f in $( rsh gaya ls $SDIR/${CONFCASE}_y${YEAR}m${1}\*_$2.nc ) ; do
- mfget $f ./
- done ; }
-putannual() { mfput $1 $MDIR/$1 ; }
-
-getmask () { mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc ; }
-#
-CONFCASE=${CONFIG}-${CASE}
-CDFTOOLS=~rcli002/CDFTOOLS-2.1/
-cd $TMPDIR
-mkdir MONTHLY
-getmask
-
-for YEAR in $YEARLST ; do
- SDIR=${CONFIG}/${CONFCASE}-S/$YEAR
- MDIR=${CONFIG}/${CONFCASE}-MEAN/$YEAR
- chkdirg $MDIR
-
- # Monthly mean
- #
- for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month gridT
- getmonth $month gridU
- getmonth $month gridV
- getmonth $month gridW
- done
-
- # perform cdfvsig on the whole year
-
- list=''
- for f in ${CONFCASE}_y${YEAR}m??d??_gridT.nc ; do
- tag=$( echo $f | awk -F_ '{print $2}' )
- list="$list $tag"
- done
-
- $CDFTOOLS/cdfvsig $CONFCASE $list
- mv usig.nc ${CONFCASE}_y${YEAR}_USIG.nc
- mv vsig.nc ${CONFCASE}_y${YEAR}_VSIG.nc
- mv wsig.nc ${CONFCASE}_y${YEAR}_WSIG.nc
-
- putannual ${CONFCASE}_y${YEAR}_USIG.nc
- putannual ${CONFCASE}_y${YEAR}_VSIG.nc
- putannual ${CONFCASE}_y${YEAR}_WSIG.nc
-
- \rm *gridT*
- \rm *gridU*
- \rm *gridV*
- \rm *gridW*
- \rm *SIG.nc
-
- cd $TMPDIR
-
-done
diff --git a/JOBS/cdfwflx.ksh b/JOBS/cdfwflx.ksh
deleted file mode 100755
index 842eacf..0000000
--- a/JOBS/cdfwflx.ksh
+++ /dev/null
@@ -1,30 +0,0 @@
-#!/bin/ksh
- ## $Rev$
- ## $Date$
- ## $Id$
-
-CONFIG=ORCA025
-CASE=G70
-TAG=y1980-2004
-CDFTOOLS=~molines/CDFTOOLS-2.1
-
-CONFCASE=${CONFIG}-${CASE}
-m=1
-while (( m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- f=${CONFCASE}_${TAG}m${mm}_gridT.nc
- r=runoff_m${mm}.nc
- wflx=$(echo $f | sed -e "s/gridT/wflx/" )
- $CDFTOOLS/cdfwflx $f $r
- mv wflx.nc $wflx
-
- m=$(( m + 1 ))
-done
-
-# ANNUAL
- f=${CONFCASE}_${TAG}_gridT.nc
- r=runoff_ANNUAL.nc
- wflx=$(echo $f | sed -e "s/gridT/wflx/" )
-
- $CDFTOOLS/cdfwflx $f $r
- mv wflx.nc $wflx
diff --git a/JOBS/config_def_ORCA025_zahir.ksh b/JOBS/config_def_ORCA025_zahir.ksh
deleted file mode 100644
index abae873..0000000
--- a/JOBS/config_def_ORCA025_zahir.ksh
+++ /dev/null
@@ -1,23 +0,0 @@
-#!/bin/ksh
-
-# this is the config file for ORCA025 on zahir
-
-
-# $Rev$
-# $Date$
-# $Id$
-
-
-# Name of CONFIG and CASE
-CONFIG=ORCA025
-CASE=G70
-
-# check gaya .rhosts file !!!
-# these variables are used only in the generic functions defined in Part II
-#
-LOCAL_SAVE=0 # set to 1 for using local storage instead of gaya for monitoring
-USER=rcli300 ; REMOTE_USER=rcli002 ; PREF=/u/rech/cli/$REMOTE_USER # PREF is the home of REMOTE_USER on remote machine
-
-# Directory with the CDFTOOLS executable
-CDFTOOLS=~rcli002/CDFTOOLS-2.1/
-
diff --git a/JOBS/config_def_SKEL_brodie.ksh b/JOBS/config_def_SKEL_brodie.ksh
deleted file mode 100644
index 9b5351c..0000000
--- a/JOBS/config_def_SKEL_brodie.ksh
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/bin/ksh
-
-# this is the config file for ORCA025 on zahir
-
-
-# $Rev$
-# $Date$
-# $Id$
-
-
-# Name of CONFIG and CASE
-CONFIG=ORCA025
-CASE=G70
-
-# check gaya .rhosts file !!!
-# these variables are used only in the generic functions defined in Part II
-#
-USER=rcli300 ; REMOTE_USER=rcli002 ; PREF=/u/rech/cli/$REMOTE_USER # PREF is the home of REMOTE_USER on remote machine
-
-# Directory with the CDFTOOLS executable
-CDFTOOLS=~rcli002/CDFTOOLS-2.1/
-P_CDF_DIR=$HOME/RUN_${CONFIG}/${CONFIG}-${CASE}/CTL/CDF
-SUB=qsub
-
diff --git a/JOBS/config_def_SKEL_jade.ksh b/JOBS/config_def_SKEL_jade.ksh
deleted file mode 100644
index 2d21a23..0000000
--- a/JOBS/config_def_SKEL_jade.ksh
+++ /dev/null
@@ -1,33 +0,0 @@
-#!/bin/ksh
-
-# this is the config file for ORCA025 on zahir
-
-
-# $Rev: 101 $
-# $Date: 2007-10-02 16:23:47 +0200 (Tue, 02 Oct 2007) $
-# $Id: config_def_ORCA025_zahir.ksh 101 2007-10-02 14:23:47Z molines $
-
-
-# Name of CONFIG and CASE
-CONFIG=ORCA025
-CASE=G70
-MACHINE=jade
-# check gaya .rhosts file !!!
-# these variables are used only in the generic functions defined in Part II
-#
-USER=rcli300 ; REMOTE_USER=rcli002 ; PREF=/u/rech/cli/$REMOTE_USER # PREF is the home of REMOTE_USER on remote machine
-
-# Directory with the CDFTOOLS executable
-CDFTOOLS=~rcli002/CDFTOOLS-2.1/
-P_CDF_DIR=$HOME/RUN_${CONFIG}/${CONFIG}-${CASE}/CTL/CDF
-SUB=llsubmit
-TMPDIR=/scratch/${USER}/MONITOR_$CONFIG-$CASE/
-SDIR=/data/${USER}/
-BIN=/scratch/$USER/bin # on jade you need to install CDFTOOLS HERE
-
-MESH_MASK_ID='PERIANT05' # root part of the mesh-mask files
- # (they must be in the -I directory ( $CONFIG/${CONFIG}-I)
- # Standard name is thus : ${MESH_MASK_ID}_byte_mask.nc # ${MESH_MASK_ID}_mesh_hgr.nc
- # ${MESH_MASK_ID}_mesh_zgr.nc
-#
-
diff --git a/JOBS/config_def_SKEL_mirage.ksh b/JOBS/config_def_SKEL_mirage.ksh
deleted file mode 100644
index 215ea4c..0000000
--- a/JOBS/config_def_SKEL_mirage.ksh
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/bin/ksh
-
-# this is the config file for ORCA025 on zahir
-
-
-# $Rev$
-# $Date$
-# $Id$
-
-
-# Name of CONFIG and CASE
-CONFIG=ROSS
-CASE=MAR
-
-# check gaya .rhosts file !!!
-# these variables are used only in the generic functions defined in Part II
-#
- PREF=./ # PREF is the home of REMOTE_USER on remote machine
-
-# Directory with the CDFTOOLS executable
-CDFTOOLS=$HOME/DEV/CDFTOOLS-2.1dev/
-P_CDF_TOOLS=$HOME/RUN_${CONFIG}/${CONFIG}-${CASE}/CTL/CDF
-SUB='oarsub -S'
-
diff --git a/JOBS/config_def_SKEL_zahir.ksh b/JOBS/config_def_SKEL_zahir.ksh
deleted file mode 100644
index 923332c..0000000
--- a/JOBS/config_def_SKEL_zahir.ksh
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/bin/ksh
-
-# this is the config file for ORCA025 on zahir
-
-
-# $Rev: 101 $
-# $Date: 2007-10-02 16:23:47 +0200 (Tue, 02 Oct 2007) $
-# $Id: config_def_ORCA025_zahir.ksh 101 2007-10-02 14:23:47Z molines $
-
-
-# Name of CONFIG and CASE
-CONFIG=ORCA025
-CASE=G70
-
-# check gaya .rhosts file !!!
-# these variables are used only in the generic functions defined in Part II
-#
-USER=rcli300 ; REMOTE_USER=rcli002 ; PREF=/u/rech/cli/$REMOTE_USER # PREF is the home of REMOTE_USER on remote machine
-
-# Directory with the CDFTOOLS executable
-CDFTOOLS=~rcli002/CDFTOOLS-2.1/
-P_CDF_DIR=$HOME/RUN_${CONFIG}/${CONFIG}-${CASE}/CTL/CDF
-SUB=llsubmit
-
diff --git a/JOBS/convclipper2nc.ksh b/JOBS/convclipper2nc.ksh
deleted file mode 100755
index f2ddc96..0000000
--- a/JOBS/convclipper2nc.ksh
+++ /dev/null
@@ -1,53 +0,0 @@
-#!/bin/ksh
-# @ cpu_limit = 36000
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = convclipp
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-
-GAYA=/cache2/rost011
-CONFIG=ATL6
-CASE=V6
-
-CONFCASE=${CONFIG}-${CASE}
-
-MEANDIR=${GAYA}/${CONFIG}/${CONFCASE}-MEAN
-MEANNCDIR=${GAYA}/${CONFIG}/${CONFCASE}NC-MEAN
-IDIR=${GAYA}/${CONFIG}/${CONFIG}-V0-I/
-
-cd $TMPDIR
-
-y1=1980
-y2=2000
-
-y=$y1
-
-mfget $IDIR/${CONFCASE}_mesh_hgr.nc mesh_hgr.nc
-mfget $IDIR/${CONFCASE}_mesh_zgr.nc mesh_zgr.nc
-
-while (( $y <= $y2 )) ; do
- # list 2D files in MEANDIR/y
- lst=$( rsh gaya ls $MEANDIR/$y/\*2D\*dimg )
- for f in $lst ; do
- g=$( basename $f )
- tag=$( echo $g | awk -F_ '{ print $3}' | sed -e 's/.dimg//' )
- u=$( echo $f | sed -e 's/_2D_/_U_/' )
- v=$( echo $f | sed -e 's/_2D_/_V_/' )
- t=$( echo $f | sed -e 's/_2D_/_T_/' )
- s=$( echo $f | sed -e 's/_2D_/_S_/' )
- ssh=$( echo $f | sed -e 's/_2D_/_SSH_/' )
- uu=$( echo $f | sed -e 's/_2D_/_UU_/' )
- vv=$( echo $f | sed -e 's/_2D_/_VV_/' )
- mfget $f ; mfget $u ; mfget $v ; mfget $t ; mfget $s ; mfget $ssh ; mfget $uu ; mfget $vv
- cdfconvert $tag $CONFCASE
- rcp ${CONFCASE}_${tag}_*.nc rost011 at gaya:$MEANNCDIR/
- \rm ${CONFCASE}_${tag}_*.nc *.dimg
- done
- y=$(( y + 1 ))
-done
-
diff --git a/JOBS/cpmoyvt_jade.ksh b/JOBS/cpmoyvt_jade.ksh
deleted file mode 100644
index 0641a8b..0000000
--- a/JOBS/cpmoyvt_jade.ksh
+++ /dev/null
@@ -1,27 +0,0 @@
-#!/bin/ksh
-. config_def.ksh
-
-run=1
-while (( $run==1 )); do
-sleep 3
-qstat -u $USER | grep -q metamoyvt || run=0
-echo "run = $run"
-done
-
-for year in `ls -d ???? `
-do
-echo $year
-nfilenc=$( ls -l $year/*.nc | wc -l )
-echo "nfilenc = $nfilenc"
-nfileok=$( ls -l $year/OK? | wc -l )
-echo "nfileok = $nfileok"
-if [ $nfilenc -eq 130 -a $nfileok -eq 6 ]; then
-echo "cp file for year "
-if [ ! -d /scratch/$USER/${CONFIG}-${CASE}-MEAN/ ] ; then mkdir /scratch/$USER/${CONFIG}-${CASE}-MEAN/ ; fi;
-if [ ! -d /data/$USER/$CONFIG/${CONFIG}-${CASE}-MEAN/$year ] ; then mkdir /data/$USER/$CONFIG/${CONFIG}-${CASE}-MEAN/$year ; fi;
-if [ ! -d /scratch/$USER/${CONFIG}-${CASE}-MEAN/$year ] ; then mkdir /scratch/$USER/${CONFIG}-${CASE}-MEAN/$year ; fi;
-cp -f $year/*.nc /data/${USER}/$CONFIG/${CONFIG}-${CASE}-MEAN/$year/.
-mv -f $year/*.nc /scratch/${USER}/${CONFIG}-${CASE}-MEAN/$year/.
-fi
-done
-echo "end"
diff --git a/JOBS/example_polymask b/JOBS/example_polymask
deleted file mode 100644
index 7132c44..0000000
--- a/JOBS/example_polymask
+++ /dev/null
@@ -1,15 +0,0 @@
-nom_du_polygone # pour lisibilite du fichier
-nombre de segments, (1/0) suivant si on coupe la ligne de changement de date ou pas
-i,j du polygone (nfois)
-attention : pas de ligne vides a la fin
-
-exemple (carre entre (1,1) et (100,100):
-
-### debut du fichier
-carre_simple
-4 0
-1 1
-1 100
-100 100
-100 1
-### fin du fichier
diff --git a/JOBS/function_def_jade.ksh b/JOBS/function_def_jade.ksh
deleted file mode 100644
index c0a0509..0000000
--- a/JOBS/function_def_jade.ksh
+++ /dev/null
@@ -1,123 +0,0 @@
-#!/bin/ksh
-# function_def.ksh file for zahir and gaya. To be used with cdfmoy and cdfvT jobs
-
-
-# $Rev: 207 $
-# $Date: 2008-11-21 15:26:12 +0100 (Fri, 21 Nov 2008) $
-# $Id: function_def_zahir.ksh 207 2008-11-21 14:26:12Z rcli002 $
-
-# FROM CDFMOY and CDFVT suite
-#############################
-# TEST network between service and scratch in batch
-chknet() { NET=KO ; ping -c 1 $1 | grep "1 packets transmitted, 1 received, 0% packet loss" && NET=OK ; }
-# chkdirg path : check existence of directory path on (remote) archiving machine. If it does not exist, create it.
-chkdirg() { ssh $REMOTE_USER@${login_node} " if [ ! -d $1 ] ; then mkdir $1 ; fi " ; }
-# getmonth mm type : retrieve all 5 days average files for month mm and grid type 'type', corresponding to current year, current confcase.A
-# ex: getmonth 04 gridU : retrieve all april files for gridU
-##########################################################################
-getmonth() { for f in $( ssh $REMOTE_USER@${login_node} " ls $SDIR/$SDIRY/${CONFCASE}_y${YEAR}m${1}d*_$2.nc " ) ; do
- file=`basename $f` ; if [ ! -f $file ] ; then if [ ! -f $WORKDIR/${CONFCASE}-S/$YEAR/$file ] ; then scp $REMOTE_USER@${login_node}:$f . ; else if [ -f $WORKDIR/${CONFCASE}-S/$YEAR/$file ] ; then ln -sf $WORKDIR/${CONFCASE}-S/$YEAR/$file . ; else echo 'file not found exit' ; exit ; fi ; fi ; else echo 'file is here'; fi ;
- done ; }
-# get monhtly mean file
-getmonthlymean() { for f in $( ssh $REMOTE_USER@${login_node} " ls $SDIR/$MEANY/${CONFCASE}_y${YEAR}m$2_$1.nc " ) ; do
- file=`basename $f` ; if [ ! -f $file ] ; then if [ ! -f $WORKDIR/${CONFCASE}-MEAN/$YEAR/$file ] ; then scp $REMOTE_USER@${login_node}:$f . ; else ln -sf $WORKDIR/${CONFCASE}-MEAN/$YEAR/$file . ; fi ; else echo 'file is here'; fi ;
- done ; }
-# getannual file
-getannualmean() { for f in $( ssh $REMOTE_USER@${login_node} " ls $SDIR/$MEANY/${CONFCASE}_y${YEAR}_ANNUAL_$1.nc " ) ; do
- file=`basename $f` ; if [ ! -f $file ] ; then if [ ! -f $WORKDIR/${CONFCASE}-MEAN/$YEAR/$file ] ; then scp $REMOTE_USER@${login_node}:$f . ; else ln -sf $WORKDIR/${CONFCASE}-MEAN/$YEAR/$file . ; fi ; else echo 'file is here'; fi ;
- done ; }
-#########################################################################
-# getmask file
-getmask() { file=$1 ; if [ ! -f $file ] ; then if [ ! -f $WORKDIR/$CONFIG-I/$file ] ; then scp $REMOTE_USER@${login_node}:$SDIR/$IDIR/$file mask.nc ; else ln -sf $WORKDIR/${CONFCASE}-I/$file mask.nc ; fi ; else echo 'file is here'; fi ; }
-# getmesh_hgr file
-getmesh_hgr() { file=$1 ; if [ ! -f $file ] ; then if [ ! -f $WORKDIR/$CONFIG-I/$file ] ; then scp $REMOTE_USER@${login_node}:$SDIR/$IDIR/$file mesh_hgr.nc ; else ln -sf $WORKDIR/${CONFCASE}-I/$file mesh_hgr.nc ; fi ; else echo 'file is here'; fi ; }
-#getmesh_zgr file
-getmesh_zgr() { file=$1 ; if [ ! -f $file ] ; then if [ ! -f $WORKDIR/$CONFIG-I/$file ] ; then scp $REMOTE_USER@${login_node}:$SDIR/$IDIR/$file mesh_zgr.nc ; else ln -sf $WORKDIR/${CONFCASE}-I/$file mesh_zgr.nc ; fi ; else echo 'file is here'; fi ; }
-#############################################################################
-# get levitus file
-getlevitus() { file=$1_Levitus-${CONFIG}.nc ; if [ ! -f $file ] ; then if [ ! -f $WORKDIR/$CONFIG-I/$file ] ; then scp $REMOTE_USER@${login_node}:$SDIR/$IDIR/INITIAL/$file levitus.nc ; else cp -f $WORKDIR/${CONFIG}-I/$file levitus.nc ; fi ; else echo 'file is here'; fi;
-if [ $1 = votemper ] ; then flevitus=$T_levitus ; fi ;
-if [ $1 = vosaline ] ; then flevitus=$S_levitus ; fi ;
-$BIN/cdfmoy levitus.nc ; $BIN/cdfmltmask cdfmoy.nc mask.nc $1 T
-mv cdfmoy.nc_masked $flevitus ; rm cdfmoy.nc cdfmoy2.nc ; }
-#############################################################################
-# rm annual file
-rmannualmean() { rm -f ${CONFCASE}_y${YEAR}_ANNUAL_$1.nc ; }
-# rm monthly file
-rmmonthlymean() { rm -f ${CONFCASE}_y${YEAR}m${2}_$1.nc ; }
-# rm mask file
-rmmask() { rm -f mask.nc ; }
-# rm meshhgr file
-rmmesh_hgr() { rm -f mesh_hgr.nc ; }
-# rm meshzgr file
-rmmesh_zgr() { rm -f mesh_zgr.nc ; }
-# chkfile : Usage: chkfile gaya_file
-############################################################################
-#save file (for big file, used ssh+cp and not scp)
-savemeanfile() { ssh $USER@$login_node " cd $R_MONITOR/$YEAR ; cp $1 $SDIR/$MEANY/$1 " ; }
-savediagfile() { scp $1 $USER@$login_node:$SDIR/$DIAGS/$1 ; }
-############################################################################
-# check if a file exists on gaya, return present or absent.
-chkfile() { ssh $REMOTE_USER@$login_node " if [ -f $1 ] ; then echo present ;\
- else echo absent ; fi " ; }
-# chkdir : Usage: chkdir local_dir
-# check the existence of a directory. Create it if not present
-chkdir() { if [ ! -d $1 ] ; then mkdir $1 ; fi ; }
-############################################################################
-#function for TRPSIG
-reorganize() {
-# for f in *.bimg ; do
-# tmp=${f#${CONFCASE}_y????m??_} ; dir=${tmp%_*.bimg}
-# if [ ! -d $dir ] ; then mkdir $dir ; fi
-# mv $f $dir
-# done
- if [ ! -d LST ] ; then mkdir LST ; fi
- if [ ! -d TRPSIG ] ; then mkdir TRPSIG ; fi
- mv *.lst LST/. ; mv *trpsig.txt TRPSIG/. ; mv *.bimg TRPSIG/.
- cd TRPSIG
- for f in *.bimg ; do
- tmp=${f#${CONFCASE}_y????m??_} ; dir=${tmp%_*.bimg}
- if [ ! -d $dir ] ; then mkdir $dir ; fi
- mv $f $dir
- done
- cd ..
-}
-# we suppose that section name starts with 2 digits 01_ 02_ 03_ etc ...
-mean() {
-# section name are codes as 2 digit_Capitalized_Name (eg: 01_Denmark_Strait or 07_Bab_el_Mandeb )
-cd TRPSIG
-for stnam in [0-9][0-9]_[a-zA-Z]* ; do
- cd $stnam
- #printf "%s" "Working for station $stnam "
- echo "Working for station $stnam "
- # note that bimgmoy4 and bimgcaltrans exec are in cdftools-2.0 (extension ...)
- #for d in ???? ; do
- #printf "%4d " $(( YEAR ))
- echo $YEAR
- $BIN/bimgmoy4 ${CONFCASE}_y*trpsig.bimg > /dev/null
- mv moy.bimg ${CONFCASE}_y${YEAR}_${stnam}_trpsig.bimg
- # (2.2) : translate results into txt file foreach section
- $BIN/bimgcaltrans ${CONFCASE}_y${YEAR}_${stnam}_trpsig.bimg > ${CONFCASE}_y${YEAR}_${stnam}_trpsig.txt
- mv ${CONFCASE}_y${YEAR}_${stnam}_trpsig.txt ../.
- cd ../
- done
-cd ..
- #printf "\n"
-}
-#mkvt() { }
-# FROM gaya monitor.ksh
-#############################################################################
-# cptoweb : Usage: cptoweb file.mtl
-# rcp the matlab file to the corresponding DATA dir of the website
-cptoweb() { rcp $1 \
- apache at meolipc.hmg.inpg.fr:web/DRAKKAR/$CONFIG/$CONFCASE/DATA/ ; }
-
-# chkdirw : Usage: chkdirw web_site_directory
-# check the existence of a dir. on the web site. Create it if not present
-chkdirw() { rsh meolipc.hmg.inpg.fr -l apache " if [ ! -d web/DRAKKAR/$1 ] ; \
- then mkdir web/DRAKKAR/$1 ; fi " ; }
-
-
-
-
-
diff --git a/JOBS/function_def_mirage.ksh b/JOBS/function_def_mirage.ksh
deleted file mode 100644
index ac9a723..0000000
--- a/JOBS/function_def_mirage.ksh
+++ /dev/null
@@ -1,82 +0,0 @@
-#!/bin/ksh
-# function_def.ksh file for mirage. To be used with cdfmoy and cdfvT jobs
-
-
-# $Rev$
-# $Date$
-# $Id$
-
-
-# FROM CDFMOY suite
-#####################
-# chkdirg path : check existence of directory path on (remote) archiving machine. If it does not exist, create it.
-chkdirg() { if [ ! -d $STOCKDIR/$1 ] ; then mkdir $STOCKDIR/$1 ; fi ; }
-
-# getmonth mm type : retrieve all 5 days average files for month mm and grid type 'type', corresponding to current year, current confcase.A
-# ex: getmonth 04 gridU : retrieve all april files for gridU
-getmonth() { for f in $STOCKDIR/$SDIR/${CONFCASE}_y${YEAR}m${1}\*_$2.nc ; do
- cp $f ./
- done ; }
-# putmonth mm type : write back monthly mean for month mm type 'type' on remote machine in -MEAN/YEAR/ directory.
-# also move the localfile to local MONTHLY dir for further annual mean computing
-
-putmonth() { cp cdfmoy.nc $STOCKDIR/$MDIR/${CONFCASE}_y${YEAR}m${1}_$2.nc ;\
- mv cdfmoy.nc MONTHLY/${CONFCASE}_y${YEAR}m${1}_$2.nc ; \rm ${CONFCASE}_y${YEAR}m${1}d??_$2.nc ; }
-
-# putmonth2 mm type : write back monthly quadratic mean for month mm type 'type' on remote machine in -MEAN/YEAR/ directory.
-# also move the localfile to local MONTHLY dir for further annual mean computing
-putmonth2() { cp cdfmoy2.nc $STOCKDIR/$MDIR/${CONFCASE}_y${YEAR}m${1}_$2.nc ; \
- mv cdfmoy2.nc MONTHLY/${CONFCASE}_y${YEAR}m${1}_$2.nc ; }
-
-# putannual type : write annual MEAN to remote -MEAN dir, in the corresponding year. Clean local files
-putannual() { cp cdfmoy_annual.nc $STOCKDIR/$MDIR/${CONFCASE}_y${YEAR}_ANNUAL_$1.nc ; \rm cdfmoy_annual.nc ;}
-
-# putvtmonth mm : write back monthly mean for month mm type 'VT' on remote machine in -MEAN/YEAR/ directory.
-# also move the localfile to local MONTHLY dir for further annual mean computing
-putvtmonth() { cp vt.nc $STOCKDIR/$MDIR/${CONFCASE}_y${YEAR}m${1}_VT.nc ; \
- mv vt.nc MONTHLY/${CONFCASE}_y${YEAR}m${1}_VT.nc ; \rm ${CONFCASE}_y${YEAR}m${month}d??_grid[UVT].nc ; }
-
-# putvtannual type : write annual MEAN to remote -MEAN dir, in the corresponding year. Clean local files
-putvtannual() { cp cdfmoy_annual.nc $STOCKDIR/$MDIR/${CONFCASE}_y${YEAR}_ANNUAL_VT.nc ; \rm cdfmoy_annual.nc ; }
-#
-
-
-# FROM MONITOR_PROD suite
-###########################
-# rapatrie : Usage: rapatrie remote_file directory local_file
-# if local_file already here do nothing, else mfget it from gaya,
-# directory/remote_file
-rapatrie() { if [ ! -f $3 ] ; then cp $STOCKDIR/$PREF/$2/$1 $3 ; else echo $3 is already \
- downloaded ; fi ; }
-
-# expatrie : Usage: expatrie local_file directory remote_file
-# put local file on gaya in directory/remote_file
-#
-expatrie() { cp $1 $STOCKDIR/$PREF/$2/$3 ; }
-
-# chkfile : Usage: chkfile gaya_file
-# check if a file exists on gaya, return present or absent.
-chkfile() { if [ -f $STOCKDIR/$1 ] ; then echo present ;\
- else echo absent ; fi ; }
-
-# chkdir : Usage: chkdir local_dir
-# check the existence of a directory. Create it if not present
-chkdir() { if [ ! -d $1 ] ; then mkdir $1 ; fi ; }
-
-
-# FROM gaya monitor.ksh
-########################
-# cptoweb : Usage: cptoweb file.mtl
-# rcp the matlab file to the corresponding DATA dir of the website
-cptoweb() { rcp $1 \
- apache at meolipc.hmg.inpg.fr:web/DRAKKAR/$CONFIG/$CONFCASE/DATA/ ; }
-
-# chkdirw : Usage: chkdirw web_site_directory
-# check the existence of a dir. on the web site. Create it if not present
-chkdirw() { rsh meolipc.hmg.inpg.fr -l apache " if [ ! -d web/DRAKKAR/$1 ] ; \
- then mkdir web/DRAKKAR/$1 ; fi " ; }
-
-
-
-
-
diff --git a/JOBS/function_def_vargas.ksh b/JOBS/function_def_vargas.ksh
deleted file mode 100755
index 3ab0abf..0000000
--- a/JOBS/function_def_vargas.ksh
+++ /dev/null
@@ -1,84 +0,0 @@
-#!/bin/ksh
-# function_def.ksh file for zahir and gaya. To be used with cdfmoy and cdfvT jobs
-
-
-# $Rev: 102 $
-# $Date: 2007-10-02 17:17:29 +0200 (Tue, 02 Oct 2007) $
-# $Id: function_def_zahir.ksh 102 2007-10-02 15:17:29Z molines $
-
-
-# FROM CDFMOY suite
-#####################
-# chkdirg path : check existence of directory path on (remote) archiving machine. If it does not exist, create it.
-chkdirg() { rsh gaya -l $REMOTE_USER " if [ ! -d $1 ] ; then mkdir $1 ; fi " ; }
-
-# getmonth mm type : retrieve all 5 days average files for month mm and grid type 'type', corresponding to current year, current confcase.A
-# ex: getmonth 04 gridU : retrieve all april files for gridU
-getmonth() { for f in $( rsh gaya -l $REMOTE_USER ls $SDIR/${CONFCASE}_y${YEAR}m${1}\*_$2.nc ) ; do
- mfget -u $REMOTE_USER $f ./
- done ; }
-# putmonth mm type : write back monthly mean for month mm type 'type' on remote machine in -MEAN/YEAR/ directory.
-# also move the localfile to local MONTHLY dir for further annual mean computing
-
-putmonth() { mfput -u $REMOTE_USER cdfmoy.nc $MDIR/${CONFCASE}_y${YEAR}m${1}_$2.nc ;\
- mv cdfmoy.nc MONTHLY/${CONFCASE}_y${YEAR}m${1}_$2.nc ; \rm ${CONFCASE}_y${YEAR}m${1}d??_$2.nc ; }
-
-# putmonth2 mm type : write back monthly quadratic mean for month mm type 'type' on remote machine in -MEAN/YEAR/ directory.
-# also move the localfile to local MONTHLY dir for further annual mean computing
-putmonth2() { mfput -u $REMOTE_USER cdfmoy2.nc $MDIR/${CONFCASE}_y${YEAR}m${1}_$2.nc ; \
- mv cdfmoy2.nc MONTHLY/${CONFCASE}_y${YEAR}m${1}_$2.nc ; }
-
-# putannual type : write annual MEAN to remote -MEAN dir, in the corresponding year.
-putannual() { mv cdfmoy_annual.nc ${CONFCASE}_y${YEAR}_ANNUAL_$1.nc
- mfput -u $REMOTE_USER ${CONFCASE}_y${YEAR}_ANNUAL_$1.nc $MDIR/${CONFCASE}_y${YEAR}_ANNUAL_$1.nc ;}
-
-# putvtmonth mm : write back monthly mean for month mm type 'VT' on remote machine in -MEAN/YEAR/ directory.
-# also move the localfile to local MONTHLY dir for further annual mean computing
-putvtmonth() { mfput -u $REMOTE_USER vt.nc $MDIR/${CONFCASE}_y${YEAR}m${1}_VT.nc ; \
- mv vt.nc MONTHLY/${CONFCASE}_y${YEAR}m${1}_VT.nc ; \rm ${CONFCASE}_y${YEAR}m${month}d??_grid[UVT].nc ; }
-
-# putvtannual type : write annual MEAN to remote -MEAN dir, in the corresponding year.
-putvtannual() { mv cdfmoy_annual.nc ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc ;
- mfput -u $REMOTE_USER ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc $MDIR/${CONFCASE}_y${YEAR}_ANNUAL_VT.nc ; }
-#
-
-
-# FROM MONITOR_PROD suite
-###########################
-# rapatrie : Usage: rapatrie remote_file directory local_file
-# if local_file already here do nothing, else mfget it from gaya,
-# directory/remote_file
-rapatrie() { if [ ! -f $3 ] ; then mfget -u $REMOTE_USER $PREF/$2/$1 $3 ; else echo $3 is already \
- downloaded ; fi ; }
-
-# expatrie : Usage: expatrie local_file directory remote_file
-# put local file on gaya in directory/remote_file
-#
-expatrie() { mfput -u $REMOTE_USER $1 $PREF/$2/$3 ; }
-
-# chkfile : Usage: chkfile gaya_file
-# check if a file exists on gaya, return present or absent.
-chkfile() { rsh gaya -l $REMOTE_USER " if [ -f $1 ] ; then echo present ;\
- else echo absent ; fi " ; }
-
-# chkdir : Usage: chkdir local_dir
-# check the existence of a directory. Create it if not present
-chkdir() { if [ ! -d $1 ] ; then mkdir $1 ; fi ; }
-
-
-# FROM gaya monitor.ksh
-########################
-# cptoweb : Usage: cptoweb file.mtl
-# rcp the matlab file to the corresponding DATA dir of the website
-cptoweb() { rcp $1 \
- apache at meolipc.hmg.inpg.fr:web/DRAKKAR/$CONFIG/$CONFCASE/DATA/ ; }
-
-# chkdirw : Usage: chkdirw web_site_directory
-# check the existence of a dir. on the web site. Create it if not present
-chkdirw() { rsh meolipc.hmg.inpg.fr -l apache " if [ ! -d web/DRAKKAR/$1 ] ; \
- then mkdir web/DRAKKAR/$1 ; fi " ; }
-
-
-
-
-
diff --git a/JOBS/function_def_zahir.ksh b/JOBS/function_def_zahir.ksh
deleted file mode 100644
index 65ded81..0000000
--- a/JOBS/function_def_zahir.ksh
+++ /dev/null
@@ -1,84 +0,0 @@
-#!/bin/ksh
-# function_def.ksh file for zahir and gaya. To be used with cdfmoy and cdfvT jobs
-
-
-# $Rev$
-# $Date$
-# $Id$
-
-
-# FROM CDFMOY suite
-#####################
-# chkdirg path : check existence of directory path on (remote) archiving machine. If it does not exist, create it.
-chkdirg() { rsh gaya -l $REMOTE_USER " if [ ! -d $1 ] ; then mkdir $1 ; fi " ; }
-
-# getmonth mm type : retrieve all 5 days average files for month mm and grid type 'type', corresponding to current year, current confcase.A
-# ex: getmonth 04 gridU : retrieve all april files for gridU
-getmonth() { for f in $( rsh gaya -l $REMOTE_USER ls $SDIR/${CONFCASE}_y${YEAR}m${1}\*_$2.nc ) ; do
- mfget -u $REMOTE_USER $f ./
- done ; }
-# putmonth mm type : write back monthly mean for month mm type 'type' on remote machine in -MEAN/YEAR/ directory.
-# also move the localfile to local MONTHLY dir for further annual mean computing
-
-putmonth() { mfput -u $REMOTE_USER cdfmoy.nc $MDIR/${CONFCASE}_y${YEAR}m${1}_$2.nc ;\
- mv cdfmoy.nc MONTHLY/${CONFCASE}_y${YEAR}m${1}_$2.nc ; \rm ${CONFCASE}_y${YEAR}m${1}d??_$2.nc ; }
-
-# putmonth2 mm type : write back monthly quadratic mean for month mm type 'type' on remote machine in -MEAN/YEAR/ directory.
-# also move the localfile to local MONTHLY dir for further annual mean computing
-putmonth2() { mfput -u $REMOTE_USER cdfmoy2.nc $MDIR/${CONFCASE}_y${YEAR}m${1}_$2.nc ; \
- mv cdfmoy2.nc MONTHLY/${CONFCASE}_y${YEAR}m${1}_$2.nc ; }
-
-# putannual type : write annual MEAN to remote -MEAN dir, in the corresponding year.
-putannual() { mv cdfmoy_annual.nc ${CONFCASE}_y${YEAR}_ANNUAL_$1.nc
- mfput -u $REMOTE_USER ${CONFCASE}_y${YEAR}_ANNUAL_$1.nc $MDIR/${CONFCASE}_y${YEAR}_ANNUAL_$1.nc ;}
-
-# putvtmonth mm : write back monthly mean for month mm type 'VT' on remote machine in -MEAN/YEAR/ directory.
-# also move the localfile to local MONTHLY dir for further annual mean computing
-putvtmonth() { mfput -u $REMOTE_USER vt.nc $MDIR/${CONFCASE}_y${YEAR}m${1}_VT.nc ; \
- mv vt.nc MONTHLY/${CONFCASE}_y${YEAR}m${1}_VT.nc ; \rm ${CONFCASE}_y${YEAR}m${month}d??_grid[UVT].nc ; }
-
-# putvtannual type : write annual MEAN to remote -MEAN dir, in the corresponding year.
-putvtannual() { mv cdfmoy_annual.nc ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc ;
- mfput -u $REMOTE_USER ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc $MDIR/${CONFCASE}_y${YEAR}_ANNUAL_VT.nc ; }
-#
-
-
-# FROM MONITOR_PROD suite
-###########################
-# rapatrie : Usage: rapatrie remote_file directory local_file
-# if local_file already here do nothing, else mfget it from gaya,
-# directory/remote_file
-rapatrie() { if [ ! -f $3 ] ; then mfget -u $REMOTE_USER $PREF/$2/$1 $3 ; else echo $3 is already \
- downloaded ; fi ; }
-
-# expatrie : Usage: expatrie local_file directory remote_file
-# put local file on gaya in directory/remote_file
-#
-expatrie() { mfput -u $REMOTE_USER $1 $PREF/$2/$3 ; }
-
-# chkfile : Usage: chkfile gaya_file
-# check if a file exists on gaya, return present or absent.
-chkfile() { rsh gaya -l $REMOTE_USER " if [ -f $1 ] ; then echo present ;\
- else echo absent ; fi " ; }
-
-# chkdir : Usage: chkdir local_dir
-# check the existence of a directory. Create it if not present
-chkdir() { if [ ! -d $1 ] ; then mkdir $1 ; fi ; }
-
-
-# FROM gaya monitor.ksh
-########################
-# cptoweb : Usage: cptoweb file.mtl
-# rcp the matlab file to the corresponding DATA dir of the website
-cptoweb() { rcp $1 \
- apache at meolipc.hmg.inpg.fr:web/DRAKKAR/$CONFIG/$CONFCASE/DATA/ ; }
-
-# chkdirw : Usage: chkdirw web_site_directory
-# check the existence of a dir. on the web site. Create it if not present
-chkdirw() { rsh meolipc.hmg.inpg.fr -l apache " if [ ! -d web/DRAKKAR/$1 ] ; \
- then mkdir web/DRAKKAR/$1 ; fi " ; }
-
-
-
-
-
diff --git a/JOBS/icemonth.ksh b/JOBS/icemonth.ksh
deleted file mode 100644
index 6f77f35..0000000
--- a/JOBS/icemonth.ksh
+++ /dev/null
@@ -1,61 +0,0 @@
-# Ice Volume area and extent for all months: input file : icemod, and mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $ICEMONTH == 1 ] ; then
- # get icemod files
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- rapatrie ${CONFCASE}_y${YEAR}m${mm}_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m${mm}_icemod.nc
- m=$(( m + 1 ))
- done
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii output file:
- fice=${CONFCASE}_y${YEAR}_icemonth.txt
-
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- case $mm in
- 01) echo '###' $YEAR $mm > $fice ;;
- *) echo '###' $YEAR $mm >> $fice ;;
- esac
- cdficediags ${CONFCASE}_y${YEAR}m${mm}_icemod.nc >> $fice
- m=$(( m + 1 ))
- done
-
- expatrie $fice $DIAGS $fice
-
-#### Append corresponding lines to matlab file for time series
- #ice
- month='01 02 03 04 05 06 07 08 09 10 11'
- if [ $(chkfile $MONITOR/${CONFCASE}_icemonth.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_icemonth.mtl $MONITOR ${CONFCASE}_icemonth.mtl
- else
- # first time: create file and add header
- echo 0000 $month $month $month $month $month $month > ${CONFCASE}_icemonth.mtl
- fi
-
- year=$( head -1 $fice | awk '{ print $2}' )
- nvol=$( cat $fice | grep -e 'NVolume' | grep -v NVolumet | awk '{ printf "%.0f ", $4}' )
- svol=$( cat $fice | grep -e 'SVolume' | grep -v SVolumet | awk '{ printf "%.0f ", $4}' )
- narea=$( cat $fice | grep -e 'NArea' | awk '{ printf "%.0f ", $4}' )
- sarea=$( cat $fice | grep -e 'SArea' | awk '{ printf "%.0f ", $4}' )
- nextent=$( cat $fice | grep -e 'NExtend' | awk '{ printf "%.0f ", $4}' )
- sextent=$( cat $fice | grep -e 'SExtend' | awk '{ printf "%.0f ", $4}' )
-
- echo $year $nvol $svol $narea $sarea $nextent $sextent >> ${CONFCASE}_icemonth.mtl
-
- expatrie ${CONFCASE}_icemonth.mtl $MONITOR ${CONFCASE}_icemonth.mtl
-
-#### cp to web site
- cptoweb ${CONFCASE}_icemonth.mtl
-
- # clean up a little bit
- \rm ${CONFCASE}_icemonth.mtl
- fi
-
diff --git a/JOBS/meta-moy-mon.skel.ll b/JOBS/meta-moy-mon.skel.ll
deleted file mode 100644
index a03c97e..0000000
--- a/JOBS/meta-moy-mon.skel.ll
+++ /dev/null
@@ -1,34 +0,0 @@
-#!/bin/ksh
-## Multistep job:
-## step 1 : retrieve the restarts and forcing, run the model (186 procs)
-## step 2 : build nc file and save them on gaya ( 16 procs)
-#########################################################################
-## title of the run
-# @ job_name = mmm
-
-## Output listing location
-# @ output = $(job_name)-$(step_name).$(jobid)
-# @ error = $(output)
-
-# @ step_name = p1
-# @ job_type = serial
-# @ cpu_limit = 36000
-# @ data_limit = 1.3gb
-# @ executable = ./CDFMOY
-# @ queue
-
-# @ step_name = p2
-## @ dependency = (p1 == 0)
-# @ job_type = serial
-# @ cpu_limit = 36000
-# @ data_limit = 1.3gb
-# @ executable = ./CDFVT
-# @ queue
-
-# @ step_name = p3
-# @ dependency = (p1 == 0 && p2 == 0 )
-# @ job_type = serial
-# @ cpu_limit = 7600
-# @ data_limit = 0.3gb
-# @ executable = ./MONITOR
-# @ queue
diff --git a/JOBS/metamon b/JOBS/metamon
deleted file mode 100644
index fa4c652..0000000
--- a/JOBS/metamon
+++ /dev/null
@@ -1,72 +0,0 @@
-#!/bin/ksh
-# @ cpu_limit = 36000
-# @ data_limit = 1gb
-# Nom du travail LoadLeveler
-# @ job_name = moni05
-# Fichier de sortie standard du travail
-# @ output = $(job_name).$(jobid)
-# Fichier de sortie d'erreur du travail
-# @ error = $(job_name).$(jobid)
-# @ queue
-
-set -x
-
-CONFIG=ORCA05 # set the name of the config
-CASE=G82 # set the case of the config
-
-# set the list of years you want to monitor 'at once'
-yinit=2002 # initial year
-yend=2004 # last year
-
-YEARS=''
-while (( $yinit <= $yend )) ; do
- YEARS="$YEARS $yinit "
- yinit=$(( yinit + 1 ))
-done
-
-MESH_MASK_ID='ORCA05-G70.112-no-caspian' # root part of the mesh-mask files
- # (they must be in the -I directory ( $CONFIG/${CONFIG}-I)
- # Standard name is thus : ${MESH_MASK_ID}_byte_mask.nc
- # ${MESH_MASK_ID}_mesh_hgr.nc
- # ${MESH_MASK_ID}_mesh_zgr.nc
-#
-
-# define the I-J window for GIB diags
-GIBWIN='547 554 326 337 '
-
-# define the I-J windows for EL NINO diags
-NINO12='395 415 229 249'
-NINO3='275 395 239 259'
-NINO4='175 275 239 259'
-NINO34='235 335 239 259'
-
-
-# menu (set to 1 if you want it, to anything else if you do not !)
-EKE=1 # compute EKE
-RMSSSH=1 # compute RMS ssh and w
-TSMEAN=1 # compute TSMEAN and ssh drift
-ICE=0 # compute ice volume, area and extent
-ICEMONTH=1 # compute ice volume, area and extent
-GIB=1 # compute Gibraltar diags (restoring zone)
-ELNINO=1 # compute El Nino monitoring SSTs
-TRP=1 # compute barotropic transport accross section as given in section.dat (CTL dir)
-MHT=1 # compute Meridional Heat Transport (advective and from surface fluxes)
-MOC=1 # compute MOC ( need a sub basin mask file called new_maskglo.nc)
-MAXMOC=1 # diagnose the min and max of MOC
-BSF=1 # compute the BSF (psi) from U and V
-DCT=1 # compute density class transports for section given in dens_section.dat (CTL dir)
-MXL=1 # Compute mixed layer depth from 3 criteria for month 03 and 09
-TRACER=0 # Compute passive Tracer statistics
-
-#--------------------- nothing to touch below -----------------------------------------
-# copy config and function to the working directory.
-cp config_def.ksh $TMPDIR
-cp function_def.ksh $TMPDIR
-
-CONFCASE=${CONFIG}-${CASE}
-cd $TMPDIR
-. ./config_def.ksh
-
-for YEAR in $YEARS ; do
- . $CDFTOOLS/JOBS/monitor_prod.ksh
-done
diff --git a/JOBS/metamon_skel_vargas.ksh b/JOBS/metamon_skel_vargas.ksh
deleted file mode 100644
index 7f457cd..0000000
--- a/JOBS/metamon_skel_vargas.ksh
+++ /dev/null
@@ -1,79 +0,0 @@
-#!/bin/ksh
-set -x
-
-CONFIG=CCOONNFF # set the name of the config
-CASE=CCAASSEE # set the case of the config
-
-# set the list of years you want to monitor 'at once'
-yinit=YYYY # initial year
-yend=YYYE # last year
-
-YEARS=''
-while (( $yinit <= $yend )) ; do
- YEARS="$YEARS $yinit "
- yinit=$(( yinit + 1 ))
-done
-
-MESH_MASK_ID='ORCA025-G70_noBS_noRS_noPG_noMCBO' # root part of the mesh-mask files
- # (they must be in the -I directory ( $CONFIG/${CONFIG}-I)
- # Standard name is thus : ${MESH_MASK_ID}_byte_mask.nc
- # ${MESH_MASK_ID}_mesh_hgr.nc
- # ${MESH_MASK_ID}_mesh_zgr.nc
-#
-
-# define the I-J window for GIB diags and El NINO DIAG
-if [ $CONFIG = 'NATL025' ] ; then
- GIBWIN='338 353 239 260'
- # NOT RELEVANT FOR NATL025. Here for compatibility
- NINO12='790 830 459 499'
- NINO3='550 790 479 519 '
- NINO4='350 550 479 519 '
- NINO34='470 670 479 519 '
-elif [ $CONFIG = 'ORCA025' ] ; then
- GIBWIN='1094 1109 653 674 '
- NINO12='790 830 459 499'
- NINO3='550 790 479 519 '
- NINO4='350 550 479 519 '
- NINO34='470 670 479 519 '
-else
- echo GIBWIN and NINO boxes not defined for config $CONFIG
- exit 1
-fi
-
-
-# menu (set to 1 if you want it, to anything else if you do not !)
-EKE=1 # compute EKE
-RMSSSH=1 # compute RMS ssh and w
-TSMEAN=1 # compute TSMEAN and ssh drift
-ICE=0 # compute ice volume, area and extent
-ICEMONTH=1 # compute ice volume, area and extent
-GIB=1 # compute Gibraltar diags (restoring zone)
-ELNINO=1 # compute El Nino monitoring SSTs
-TRP=1 # compute barotropic transport accross section as given in section.dat (CTL dir)
-MHT=1 # compute Meridional Heat Transport (advective and from surface fluxes)
-MOC=1 # compute MOC ( need a sub basin mask file called new_maskglo.nc)
-MAXMOC=1 # diagnose the min and max of MOC
-BSF=1 # compute the BSF (psi) from U and V
-DCT=1 # compute density class transports for section given in dens_section.dat (CTL dir)
-MXL=1 # Compute mixed layer depth from 3 criteria for month 03 and 09
-TRACER=0 # Compute passive Tracer statistics
-
-#--------------------- nothing to touch below -----------------------------------------
-# copy config and function to the working directory.
-. ./config_def.ksh
-
-cp config_def.ksh $TMPDIR
-cp function_def.ksh $TMPDIR
-
-CONFCASE=${CONFIG}-${CASE}
-cd $TMPDIR
-. ./config_def.ksh
-
-for YEAR in $YEARS ; do
- . $CDFTOOLS/JOBS/monitor_prod.ksh
- # clean the TMPDIR (on WORDIR in fact) from all files for YEAR
- cd $TMPDIR
- find . -name "*${YEAR}*" -exec \rm -rf {} \;
-done
- # experimental: build the mtl files by mkmtl.ksh on gaya (which send them on the meolipc web site)
- rsh gaya "cd $CONFIG/${CONFCASE}-DIAGS/ ; /u/rech/cli/rcli600/bin/mkmtl.ksh "
diff --git a/JOBS/metamoy.ksh b/JOBS/metamoy.ksh
deleted file mode 100755
index 2da3cdc..0000000
--- a/JOBS/metamoy.ksh
+++ /dev/null
@@ -1,36 +0,0 @@
-#!/bin/ksh
-
-# metamoy.ksh script : to launch both cdfmoy and cdfvT on 2 separated jobs for a given year (argument)
-
-# $Rev$
-# $Date$
-# $Id$
-
-set -x
-
-if [ $# == 0 ] ; then
- echo USAGE: metamoy.ksh year
- exit 0
-fi
-
-year=$1
-
-. ./config_def.ksh # CDFTOOLS is set in this script (which is sourced now)
-
-cat $CDFTOOLS/JOBS/cdfmoy_skel_new.ksh | sed -e "s/YYYY/$year/g" -e "s/YYYE/$year/g" -e "s/CCOONNFF/$CONFIG/g" -e "s/CCAASSEE/$CASE/g" \
- > cdfmoytmp.$$.ll
-
-chmod u+x cdfmoytmp.$$.ll
-$SUB cdfmoytmp.$$.ll
-
-cat $CDFTOOLS/JOBS/cdfvT_skel_new.ksh | sed -e "s/YYYY/$year/g" -e "s/YYYE/$year/g" -e "s/CCOONNFF/$CONFIG/g" -e "s/CCAASSEE/$CASE/g" \
- > cdfvTtmp.$$.ll
-chmod u+x cdfvTtmp.$$.ll
-$SUB cdfvTtmp.$$.ll
-
-#if (( $year > 1958 )) ; then
-# cat $CDFTOOLS/JOBS/cdfmoy_trc_skel_new.ksh | sed -e "s/YYYY/$year/g" -e "s/YYYE/$year/g" -e "s/CCOONNFF/$CONFIG/g" -e "s/CCAASSEE/$CASE/g" \
-# > cdfTRCtmp.$$.ll
-#chmod u+x cdfTRCtmp.$$.ll
-# $SUB cdfTRCtmp.$$.ll
-#fi
diff --git a/JOBS/mkmoy_jade.ksh b/JOBS/mkmoy_jade.ksh
deleted file mode 100644
index 11ef116..0000000
--- a/JOBS/mkmoy_jade.ksh
+++ /dev/null
@@ -1,39 +0,0 @@
-#!/bin/ksh
-set -x
-cd ..
-
-. config_def.ksh
-. function_def.ksh
-
-CONFCASE=${CONFIG}-${CASE}
-
-login_node=service1
-
-YEAR=YYEEAARR
-grid=GGRRIIDD
-NP=NNPP
-
-cd $YEAR
-
-MEANY=$CONFIG/${CONFIG}-${CASE}-MEAN/$YEAR
-SDIRY=$CONFIG/${CONFIG}-${CASE}-S/$YEAR
-
-mkdir $grid; cd $grid;
-for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month $grid
-
- ../../cdfmoy ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
- mv -f cdfmoy.nc ${CONFCASE}_y${YEAR}m${month}_$grid.nc
- if [ $grid != icemod ] ; then
- mv -f cdfmoy2.nc ${CONFCASE}_y${YEAR}m${month}_${grid}2.nc
- fi
- rm -f ${CONFCASE}_y${YEAR}m${month}d??_$grid.nc
-done
-../../cdfmoy_annual ${CONFCASE}_y${YEAR}m??_$grid.nc
-mv -f cdfmoy_annual.nc ${CONFCASE}_y${YEAR}_ANNUAL_$grid.nc
-if [ $grid != icemod ] ; then
- ../../cdfmoy_annual ${CONFCASE}_y${YEAR}m??_${grid}2.nc
- mv -f cdfmoy_annual.nc ${CONFCASE}_y${YEAR}_ANNUAL_${grid}2.nc
-fi
-mv -f ${CONFCASE}_y${YEAR}*_${grid}*.nc ../.
-cd .. ; rm -rf $grid ; touch OK$NP ;
diff --git a/JOBS/mkordre b/JOBS/mkordre
deleted file mode 100755
index 3184b1c..0000000
--- a/JOBS/mkordre
+++ /dev/null
@@ -1,32 +0,0 @@
-#!/bin/ksh
-#set -xv
-# Shell functions
-# check existence and eventually create directory
-chkdir() { if [ ! -d $1 ] ; then mkdir $1 ; fi ; }
-
-# Checck if the current dir is a xxx-xx-S directory
-here=$(basename $( pwd ) )
-ext=$( echo $here | sed -e 's/-/ /g' | awk '{print $3}' )
-
-if [ ${ext:-none} != 'S' ] ; then
- echo 'you are not in an -S directory. You cannot mkordre :('
- exit 1
-fi
-
-# Move annex tarfiles to ANNEX
-ls *anne* 2> /dev/null && { chkdir ANNEX ; mv *anne* ANNEX ; }
-
-# Scan the different types of files and send then to the YEAR directory
-for type in gridT gridU gridV gridW icemod ptrcT trends dynT flxT; do
- ls *${type}.nc 2> /dev/null && { \
- for f in *_${type}.nc ; do
- tag=$( echo $f | sed -e 's/_/ /g' | awk '{print $2}' )
- year=$( echo $tag | sed -e's/m/ /' | awk '{print $1}' | tr -d 'y' )
-
- chkdir $year
- mv $f $year
- done ; }
-done
-
-
-
diff --git a/JOBS/mkordremean b/JOBS/mkordremean
deleted file mode 100755
index 773d059..0000000
--- a/JOBS/mkordremean
+++ /dev/null
@@ -1,32 +0,0 @@
-#!/bin/ksh
-#set -xv
-# Shell functions
-# check existence and eventually create directory
-chkdir() { if [ ! -d $1 ] ; then mkdir $1 ; fi ; }
-
-# Checck if the current dir is a xxx-xx-S directory
-here=$(basename $( pwd ) )
-ext=$( echo $here | sed -e 's/-/ /g' | awk '{print $3}' )
-
-if [ ${ext:-none} != 'MEAN' ] ; then
- echo 'you are not in an -MEAN directory. You cannot mkordre :('
- exit 1
-fi
-
-# Move annex tarfiles to ANNEX
-ls *anne* 2> /dev/null && { chkdir ANNEX ; mv *anne* ANNEX ; }
-
-# Scan the different types of files and send then to the YEAR directory
-for type in gridT gridU gridV gridW icemod ptrcT; do
- ls *${type}.nc 2> /dev/null && { \
- for f in *_${type}.nc ; do
- tag=$( echo $f | sed -e 's/_/ /g' | awk '{print $2}' )
- year=$( echo $tag | sed -e's/m/ /' | awk '{print $1}' | tr -d 'y' )
-
- chkdir $year
- mv $f $year
- done ; }
-done
-
-
-
diff --git a/JOBS/mkvt_jade.ksh b/JOBS/mkvt_jade.ksh
deleted file mode 100644
index 94b8919..0000000
--- a/JOBS/mkvt_jade.ksh
+++ /dev/null
@@ -1,39 +0,0 @@
-#!/bin/ksh
-set -x
-cd ..
-. config_def.ksh
-. function_def.ksh
-
-CONFCASE=${CONFIG}-${CASE}
-
-login_node=service1
-
-YEAR=YYEEAARR
-grid=GGRRIIDD
-NP=NNPP
-
-cd $YEAR
-
-MEANY=$CONFIG/${CONFIG}-${CASE}-MEAN/$YEAR
-SDIRY=$CONFIG/${CONFIG}-${CASE}-S/$YEAR
-
-mkdir VT; cd VT ;
-for month in 01 02 03 04 05 06 07 08 09 10 11 12 ; do
- getmonth $month gridT
- getmonth $month gridU
- getmonth $month gridV
- #####################
- list=''
- for f in ${CONFCASE}_y${YEAR}m${month}d??_gridT.nc ; do
- tag=$( echo $f | awk -F_ '{print $2}' )
- list="$list $tag"
- done
- ../../cdfvT $CONFCASE $list
- mv -f vt.nc ${CONFCASE}_y${YEAR}m${month}_VT.nc
- rm -f ${CONFCASE}_y${YEAR}m${month}d??_grid?.nc
-done
- # annual mean (uses a ponderation to compute the exact annual mean ). ! suppose 5 day averages when creating monthly mean
-../../cdfmoy_annual ${CONFCASE}_y${YEAR}m??_VT.nc
-mv -f cdfmoy_annual.nc ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
-mv -f ${CONFCASE}_y${YEAR}*_VT.nc ../.
-cd .. ; rmdir VT ; touch OK$NP
diff --git a/JOBS/monitor.csh b/JOBS/monitor.csh
deleted file mode 100755
index 02947af..0000000
--- a/JOBS/monitor.csh
+++ /dev/null
@@ -1,365 +0,0 @@
-#!/bin/csh
-# This script is intended to be sourced from a main script. Not Stand Alone
-
-# EKE
-#-----
- cp $CDFTOOLS/att.txt .
- cp $CDFTOOLS/cdfrmsssh ./
- cp $CDFTOOLS/cdfeke .
- cp $CDFTOOLS/cdfstdevw ./
- chmod 755 cdfeke cdfrmsssh cdfstdevw
-
-
- foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_grid\[UV\]\*nc ` )
- mfget $f ./
- end
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc ./
-
- ./cdfeke ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
-
- mv eke.nc ${CONFCASE}_y${YEAR}_EKE.nc
- mfput ${CONFCASE}_y${YEAR}_EKE.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/
-
-
-# RMS SSH and W
-#--------------
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc ./
-
- ./cdfrmsssh ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
-
- mfput rms.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_RMSSSH.nc
- \rm rms.nc
-
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc ./
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc ./
-
- ./cdfstdevw ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc
-
- mfput rmsw.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_STDEVW.nc
- \rm rmsw.nc
-
-# Global MEANS
-#--------------
-
-cp $CDFTOOLS/cdfmean .
-chmod 755 cdfmean
-
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
- echo $YEAR > ${CONFCASE}_y${YEAR}_SSHMEAN.txt
- echo $YEAR > ${CONFCASE}_y${YEAR}_TMEAN.txt
- echo $YEAR > ${CONFCASE}_y${YEAR}_SMEAN.txt
-
- mfget ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc ./
- ./cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc sossheig T >> ${CONFCASE}_y${YEAR}_SSHMEAN.txt
- ./cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc votemper T >> ${CONFCASE}_y${YEAR}_TMEAN.txt
- ./cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc vosaline T >> ${CONFCASE}_y${YEAR}_SMEAN.txt
-
- mfput ${CONFCASE}_y${YEAR}_SSHMEAN.txt ${CONFIG}/${CONFCASE}-DIAGS
- mfput ${CONFCASE}_y${YEAR}_TMEAN.txt ${CONFIG}/${CONFCASE}-DIAGS
- mfput ${CONFCASE}_y${YEAR}_SMEAN.txt ${CONFIG}/${CONFCASE}-DIAGS
-
-# Ice Volume area and extent for m02 m03 m08 m09
-#--------------------------------------------------
-
-cp $CDFTOOLS/cdficediags .
-chmod 755 cdficediags
-
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m02_icemod.nc ./
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m03_icemod.nc ./
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m08_icemod.nc ./
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m09_icemod.nc ./
-
-echo '###' $YEAR 02 > ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m02_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-echo '###' $YEAR 03 >> ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m03_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-echo '###' $YEAR 08 >> ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m08_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-echo '###' $YEAR 09 >> ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m09_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-
-mfput ${CONFCASE}_y${YEAR}_ice.txt ${CONFIG}/${CONFCASE}-DIAGS
-
-# Vertical T-S profiles off the coast of Portugal for Gib monitoring
-#-------------------------------------------------------------------
- \rm -f ${CONFCASE}_y${YEAR}_TGIB.txt
- echo $YEAR > ${CONFCASE}_y${YEAR}_TGIB.txt
- ./cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc votemper T $GIB 0 0 >> ${CONFCASE}_y${YEAR}_TGIB.txt
- \rm -f ${CONFCASE}_y${YEAR}_SGIB.txt
- echo $YEAR > ${CONFCASE}_y${YEAR}_SGIB.txt
- ./cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc vosaline T $GIB 0 0 >> ${CONFCASE}_y${YEAR}_SGIB.txt
-
-mfput ${CONFCASE}_y${YEAR}_TGIB.txt ${CONFIG}/${CONFCASE}-DIAGS
-mfput ${CONFCASE}_y${YEAR}_SGIB.txt ${CONFIG}/${CONFCASE}-DIAGS
-
-# El nino indexes
-#----------------
- \rm -f ${CONFCASE}_y${YEAR}_NINO.txt
-
-foreach m ( 01 02 03 04 05 06 07 08 09 10 11 12 )
- foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${m}_gridT.nc ` )
-
- mfget $f ./
- set g=`basename $f`
-
- echo -n $YEAR $m >>! ${CONFCASE}_y${YEAR}_NINO.txt
-
-# nino 1+2 [ -90 W -- -80 W, -10 S -- 10 N ]
- ./cdfmean $g votemper T $NINO12 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> ${CONFCASE}_y${YEAR}_NINO.txt
-# nino 3 [ -150 W -- -90 W, -5 S -- 5 N ]
- ./cdfmean $g votemper T $NINO3 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> ${CONFCASE}_y${YEAR}_NINO.txt
-# nino 4 [ -200 W -- -150 W, -5 S -- 5 N ]
- ./cdfmean $g votemper T $NINO4 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> ${CONFCASE}_y${YEAR}_NINO.txt
-# nino 3.4 [ -170 W -- -120 W, -% S -- % N ]
- ./cdfmean $g votemper T $NINO34 1 1 | tail -1 | awk '{ printf " %8.5f 0.00\n", $6 }' >> ${CONFCASE}_y${YEAR}_NINO.txt
-
-
-\rm $g
-
-
-
- end
-end
-
- mfput ${CONFCASE}_y${YEAR}_NINO.txt ${CONFIG}/${CONFCASE}-DIAGS
-
-
-# Transport
-#----------
-set P_CTL=$HOME/RUN_${CONFIG}/${CONFCASE}/CTL
-
-cp $CDFTOOLS/cdftransportiz .
-cp $P_CTL/section.dat .
-
-set year=$YEAR
-
-mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_ANNUAL_VT.nc .
-
-echo $year > ${CONFCASE}_y${year}_section_monitor.txt
-
-./cdftransportiz ${CONFCASE}_y${year}_ANNUAL_VT.nc \
- ${CONFCASE}_y${year}_ANNUAL_gridU.nc \
- ${CONFCASE}_y${year}_ANNUAL_gridV.nc < section.dat >> ${CONFCASE}_y${year}_section_monitor.txt
-
- grep -v Give ${CONFCASE}_y${year}_section_monitor.txt | grep -v level | grep -v IMAX | grep -v FROM > tmp
-mv -f tmp ${CONFCASE}_y${year}_section_monitor.txt
-mfput ${CONFCASE}_y${year}_section_monitor.txt ${CONFIG}/${CONFCASE}-DIAGS/
-
-# Heat and Salt Meridional Transport
-#------------------------------------
-
-cp $CDFTOOLS/cdfmhst .
-mfget ${CONFIG}/${CONFIG}-I/new_maskglo.nc new_maskglo.nc
-
-./cdfmhst ${CONFCASE}_y${year}_ANNUAL_VT.nc
-mv zonal_heat_trp.dat ${CONFCASE}_y${year}_heattrp.dat
-mv zonal_salt_trp.dat ${CONFCASE}_y${year}_salttrp.dat
-
-mfput ${CONFCASE}_y${year}_heattrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-mfput ${CONFCASE}_y${year}_salttrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-
-# heat transport from surface fluxes
-#____________________________________
-cp $CDFTOOLS/cdfhflx .
-./cdfhflx ${CONFCASE}_y${year}_ANNUAL_gridT.nc
-mv hflx.out ${CONFCASE}_y${year}_hflx.dat
-
-mfput ${CONFCASE}_y${year}_hflx.dat ${CONFIG}/${CONFCASE}-DIAGS/
-
-# MOC
-#----
-
-cp $CDFTOOLS/cdfmoc .
-
-./cdfmoc ${CONFCASE}_y${year}_ANNUAL_gridV.nc
-mv moc.nc ${CONFCASE}_y${year}_MOC.nc
-mfput ${CONFCASE}_y${year}_MOC.nc ${CONFIG}/${CONFCASE}-MEAN/${year}/
-rsh rhodes "cd bin ; cat ovtplot.csh | sed -e ""s/YYYY/$year/"" -e""s/CCCC/$CASE/"" -e ""s/FFFF/$CONFIG/""> moctmp.csh ; ./moctmp.csh "
-
-
-# MAX and MIN of MOC
-#-------------------
-cp $CDFTOOLS/cdfmaxmoc .
-set f=${CONFCASE}_y${year}_MOC.nc
-set outfile=${CONFCASE}_y${year}_minmaxmoc.txt
- echo $year > $outfile
-# GLO
-printf "%s" 'Glo ' >> $outfile ; ./cdfmaxmoc $f glo 20 60 500 2000 | grep Maximum >> $outfile
-printf "%s" 'Glo ' >> $outfile ; ./cdfmaxmoc $f glo -40 30 2000 5500 | grep Minimum >> $outfile
-# ATL
-printf "%s" 'Atl ' >> $outfile ; ./cdfmaxmoc $f atl 0 60 500 2000 | grep Maximum >> $outfile
-printf "%s" 'Atl ' >> $outfile ; ./cdfmaxmoc $f atl -20 40 2000 5500 | grep Minimum >> $outfile
-#INP
-printf "%s" 'Inp ' >> $outfile ; ./cdfmaxmoc $f inp 15 50 100 1000 | grep Minimum >> $outfile
-printf "%s" 'Inp ' >> $outfile ; ./cdfmaxmoc $f inp -30 20 1000 5500 | grep Minimum >> $outfile
-#AUS
-printf "%s" 'Aus ' >> $outfile ; ./cdfmaxmoc $f glo -70 0 0 2000 | grep Maximum >> $outfile
-printf "%s" 'Aus ' >> $outfile ; ./cdfmaxmoc $f glo -70 0 2000 5500 | grep Minimum >> $outfile
-
-mfput $outfile ${CONFIG}/${CONFCASE}-DIAGS/
-
-# Max and Min of MOC at some specific latitudes
-set f=${CONFCASE}_y${year}_MOC.nc
-set outfile=${CONFIG}-${CASE}_y${year}_maxmoc40.txt
- \rm -f $outfile
-
- echo $year > $outfile
-# GLO MAX at 40 N and 30S
-printf "%s" 'Glo ' >> $outfile ; cdfmaxmoc $f glo 40 40 500 2000 | grep Maximum >> $outfile
-printf "%s" 'Glo ' >> $outfile ; cdfmaxmoc $f glo -30 -30 500 5500 | grep Maximum >> $outfile
-# ATL MAX at 40N and 30S
-printf "%s" 'Atl ' >> $outfile ; cdfmaxmoc $f atl 40 40 500 2000 | grep Maximum >> $outfile
-printf "%s" 'Atl ' >> $outfile ; cdfmaxmoc $f atl -30 -30 500 5000 | grep Maximum >> $outfile
-#INP Min at 30 S
-printf "%s" 'Inp ' >> $outfile ; cdfmaxmoc $f inp -30 -30 1000 5500 | grep Minimum >> $outfile
-#AUS MAX at 50 S
-printf "%s" 'Aus ' >> $outfile ; cdfmaxmoc $f glo -50 -50 0 2000 | grep Maximum >> $outfile
-
-mfput $outfile ${CONFIG}/${CONFIG}-${CASE}-DIAGS/
-
-
-# Barotropic Transport
-#---------------------
-cp $CDFTOOLS/cdfpsi .
-chmod 755 cdfpsi
- ./cdfpsi ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- mv psi.nc ${CONFCASE}_y${YEAR}_PSI.nc
- mfput ${CONFCASE}_y${YEAR}_PSI.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/
-
-DCT:
- if ( $DCT == 1 ) then
-# Density Class transport
-#-------------------------
-cp $CDFTOOLS/cdfsigtrp ./
-cp $P_CTL/dens_section.dat .
-cp $CDFTOOLS/JOBS/trpsig_postproc.ksh ./
-
- rsh gaya mkdir ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
- rsh gaya mkdir ${CONFIG}/${CONFCASE}-DIAGS/TRPSIG/
-
- if ( ! -d ${CONFIG} ) mkdir ${CONFIG}
- if ( ! -d ${CONFIG}/${CONFCASE}-TRPSIG ) mkdir ${CONFIG}/${CONFCASE}-TRPSIG
- if ( ! -d ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/ ) mkdir ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
-
- foreach tfich (`rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$YEAR/\*m\?\?_gridT.nc ` )
- set ufich=`echo $tfich | sed -e 's/gridT/gridU/' `
- set vfich=`echo $tfich | sed -e 's/gridT/gridV/' `
-
- mfget $tfich ./
- mfget $ufich ./
- mfget $vfich ./
-
- set tfich=`basename $tfich`
- set ufich=`basename $ufich`
- set vfich=`basename $vfich`
-
- set tag=`echo $tfich | sed -e "s/${CONFCASE}_//" -e 's/_gridT.nc//'`
-
- echo $tag > ${CONFCASE}_y${tag}_trpsig_monitor.lst
-
-
- ./cdfsigtrp $tfich $ufich $vfich 21 30 180 -bimg -print >> ${CONFCASE}_y${tag}_trpsig_monitor.lst
-
- mfput ${CONFCASE}_y${tag}_trpsig_monitor.lst ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
- mv ${CONFCASE}_y${tag}_trpsig_monitor.lst ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
-
- foreach b (*.bimg)
- mv $b ${CONFCASE}_y${tag}_$b
- mfput ${CONFCASE}_y${tag}_$b ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
- mv ${CONFCASE}_y${tag}_$b ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
- end
-
- \rm *.bimg $tfich $ufich $vfich
-
- mv trpsig.txt ${CONFCASE}_y${tag}_trpsig.txt
- mfput ${CONFCASE}_y${tag}_trpsig.txt ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
- mv ${CONFCASE}_y${tag}_trpsig.txt ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
-
- end
-# Launch post processing ( ex range2.ksh sur rhodes)
-
- cd ${CONFIG}/${CONFCASE}-TRPSIG
- $TMPDIR/trpsig_postproc.ksh
- cd $TMPDIR
-
-# save results on gaya
- mfput ${CONFCASE}_y*_trpsig.txt $CONFIG/${CONFCASE}-DIAGS/TRPSIG/
-
-# Erase the TRPSIG tree for this current year
- \rm -r ${CONFIG} \rm ${CONFCASE}_y*_trpsig.txt
-
- endif
-
-
-# MXL Diagnostics
-#-----------------
- cp $CDFTOOLS/cdfmxl .
- chmod 755 cdfmxl
-
- rsh gaya mkdir $CONFIG/${CONFCASE}-DIAGS/$YEAR
-
-foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m0\[39\]_gridT.nc ` )
- mfget $f ./
- set g=`basename $f | sed -e 's/gridT/MXL/' `
-
- ./cdfmxl `basename $f`
-
- mfput mxl.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/$g
-
-end
-
- if ( $TRACER == 1 ) then
-# TRACER DIAGS (31/12 of each year)
-#-------------
-
-cp $CDFTOOLS/cdfzonalmean .
-cp $CDFTOOLS/cdfzonalsum .
-cp $CDFTOOLS/cdfzonalout .
-
-# Absolute mean of concentration
- echo -n $YEAR ' ' > ${CONFCASE}_y${YEAR}_TRCmean.dat
-
- mfget ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m12d31_ptrcT.nc ./
-
- \rm -f tmp1
- ./cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invcfc T > tmp1
- set area=`cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}'`
- set mean=`cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}'`
- set total=` echo $mean $area | awk '{print $1 * $2 }' `
- echo -n $total ' ' >> ${CONFCASE}_y${YEAR}_TRCmean.dat
-
- \rm -f tmp1
- ./cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invc14 T > tmp1
- set area=`cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}'`
- set mean=`cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}'`
- set total=` echo $mean $area | awk '{print $1 * $2 }' `
- echo $total ' ' >> ${CONFCASE}_y${YEAR}_TRCmean.dat
-
- mfput ${CONFCASE}_y${YEAR}_TRCmean.dat ${CONFIG}/${CONFCASE}-DIAGS
-
-# zonal integral of inventories
- ./cdfzonalsum ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
-# zonal means
- ./cdfzonalmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
- ncks -F -d deptht,1,1 -v zocfc11_glo,zobc14_glo,nav_lon,nav_lat zonalmean.nc zonalsurf.nc
-
-# put in ascii format the 1D profiles
- ./cdfzonalout zonalmean.nc > zonalmean.dat
- ./cdfzonalout zonalsum.nc > zonalsum.dat
- ./cdfzonalout zonalsurf.nc > zonalsurf.dat
-
-mfput zonalmean.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_TRCzonalmean.nc
-mfput zonalsum.nc ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_TRCzonalsum.nc
-
-mfput zonalmean.dat ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalmean.dat
-mfput zonalsum.dat ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalsum.dat
-mfput zonalsurf.dat ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalsurf.dat
-
- endif
diff --git a/JOBS/monitor_noheat.csh b/JOBS/monitor_noheat.csh
deleted file mode 100755
index 1ed7040..0000000
--- a/JOBS/monitor_noheat.csh
+++ /dev/null
@@ -1,255 +0,0 @@
-#!/bin/csh
-# This script is intended to be sourced from a main script. Not Stand Alone
-
-# EKE
-#-----
- cp $CDFTOOLS/att.txt .
- cp $CDFTOOLS/cdfrmsssh ./
- cp $CDFTOOLS/cdfeke .
- cp $CDFTOOLS/cdfstdevw ./
- chmod 755 cdfeke cdfrmsssh cdfstdevw
-
-
- foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_grid\[UV\]\*nc ` )
- mfget $f ./
- end
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc ./
-
- ./cdfeke ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
-
- mv eke.nc ${CONFCASE}_y${YEAR}_EKE.nc
- mfput ${CONFCASE}_y${YEAR}_EKE.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/
-
-
-# RMS SSH and W
-#--------------
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc ./
-
- ./cdfrmsssh ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
-
- mfput rms.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_RMSSSH.nc
- \rm rms.nc
-
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc ./
- mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc ./
-
- ./cdfstdevw ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc
-
- mfput rmsw.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_STDEVW.nc
- \rm rmsw.nc
-
-# Global MEANS
-#--------------
-
-cp $CDFTOOLS/cdfmean .
-chmod 755 cdfmean
-
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_byte_mask.nc mask.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_hgr.nc mesh_hgr.nc
-mfget ${CONFIG}/${CONFIG}-I/${MESH_MASK_ID}_mesh_zgr.nc mesh_zgr.nc
-
- echo $YEAR > ${CONFCASE}_y${YEAR}_SSHMEAN.txt
- echo $YEAR > ${CONFCASE}_y${YEAR}_TMEAN.txt
- echo $YEAR > ${CONFCASE}_y${YEAR}_SMEAN.txt
-
- mfget ${CONFIG}/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc ./
- ./cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc sossheig T >> ${CONFCASE}_y${YEAR}_SSHMEAN.txt
- ./cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc votemper T >> ${CONFCASE}_y${YEAR}_TMEAN.txt
- ./cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc vosaline T >> ${CONFCASE}_y${YEAR}_SMEAN.txt
-
- mfput ${CONFCASE}_y${YEAR}_SSHMEAN.txt ${CONFIG}/${CONFCASE}-DIAGS
- mfput ${CONFCASE}_y${YEAR}_TMEAN.txt ${CONFIG}/${CONFCASE}-DIAGS
- mfput ${CONFCASE}_y${YEAR}_SMEAN.txt ${CONFIG}/${CONFCASE}-DIAGS
-
-# Ice Volume area and extent for m02 m03 m08 m09
-#--------------------------------------------------
-
-cp $CDFTOOLS/cdficediags .
-chmod 755 cdficediags
-
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m02_icemod.nc ./
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m03_icemod.nc ./
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m08_icemod.nc ./
-mfget $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m09_icemod.nc ./
-
-echo '###' $YEAR 02 > ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m02_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-echo '###' $YEAR 03 >> ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m03_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-echo '###' $YEAR 08 >> ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m08_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-echo '###' $YEAR 09 >> ${CONFCASE}_y${YEAR}_ice.txt
-./cdficediags ${CONFCASE}_y${YEAR}m09_icemod.nc >> ${CONFCASE}_y${YEAR}_ice.txt
-
-mfput ${CONFCASE}_y${YEAR}_ice.txt ${CONFIG}/${CONFCASE}-DIAGS
-
-# El nino indexes
-#----------------
- \rm -f ${CONFCASE}_y${YEAR}_NINO.txt
-
-foreach m ( 01 02 03 04 05 06 07 08 09 10 11 12 )
- foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m${m}_gridT.nc ` )
-
- mfget $f ./
- set g=`basename $f`
-
- echo -n $YEAR $m >>! ${CONFCASE}_y${YEAR}_NINO.txt
-
-# nino 1+2 [ -90 W -- -80 W, -10 S -- 10 N ]
- ./cdfmean $g votemper T $NINO12 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> ${CONFCASE}_y${YEAR}_NINO.txt
-# nino 3 [ -150 W -- -90 W, -5 S -- 5 N ]
- ./cdfmean $g votemper T $NINO3 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> ${CONFCASE}_y${YEAR}_NINO.txt
-# nino 4 [ -200 W -- -150 W, -5 S -- 5 N ]
- ./cdfmean $g votemper T $NINO4 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> ${CONFCASE}_y${YEAR}_NINO.txt
-# nino 3.4 [ -170 W -- -120 W, -% S -- % N ]
- ./cdfmean $g votemper T $NINO34 1 1 | tail -1 | awk '{ printf " %8.5f 0.00\n", $6 }' >> ${CONFCASE}_y${YEAR}_NINO.txt
-
-
-\rm $g
-
-
-
- end
-end
-
- mfput ${CONFCASE}_y${YEAR}_NINO.txt ${CONFIG}/${CONFCASE}-DIAGS
-
-
-# Transport
-#----------
-set P_CTL=$HOME/RUN_${CONFIG}/${CONFCASE}/CTL
-
-cp $CDFTOOLS/cdfmasstrp .
-cp $P_CTL/section.dat .
-
-set year=$YEAR
-
-#mfget ${CONFIG}/${CONFCASE}-MEAN/$year/${CONFCASE}_y${year}_ANNUAL_VT.nc .
-
-echo $year > ${CONFCASE}_y${year}_section_monitor.txt
-
-./cdfmasstrp \
- ${CONFCASE}_y${year}_ANNUAL_gridU.nc \
- ${CONFCASE}_y${year}_ANNUAL_gridV.nc < section.dat >> ${CONFCASE}_y${year}_section_monitor.txt
-
- grep -v Give ${CONFCASE}_y${year}_section_monitor.txt | grep -v level | grep -v IMAX | grep -v FROM > tmp
-mv -f tmp ${CONFCASE}_y${year}_section_monitor.txt
-mfput ${CONFCASE}_y${year}_section_monitor.txt ${CONFIG}/${CONFCASE}-DIAGS/
-
-# Heat and Salt Meridional Transport
-#------------------------------------
-
-#cp $CDFTOOLS/cdfmhst .
-#mfget ${CONFIG}/${CONFIG}-I/new_maskglo.nc new_maskglo.nc
-
-#./cdfmhst ${CONFCASE}_y${year}_ANNUAL_VT.nc
-#mv zonal_heat_trp.dat ${CONFCASE}_y${year}_heattrp.dat
-#mv zonal_salt_trp.dat ${CONFCASE}_y${year}_salttrp.dat
-#
-#mfput ${CONFCASE}_y${year}_heattrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-#mfput ${CONFCASE}_y${year}_salttrp.dat ${CONFIG}/${CONFCASE}-DIAGS/
-
-# heat transport from surface fluxes
-#____________________________________
-cp $CDFTOOLS/cdfhflx .
-./cdfhflx ${CONFCASE}_y${year}_ANNUAL_gridT.nc
-mv hflx.out ${CONFCASE}_y${year}_hflx.dat
-
-mfput ${CONFCASE}_y${year}_hflx.dat ${CONFIG}/${CONFCASE}-DIAGS/
-
-
-# MOC
-#----
-
-cp $CDFTOOLS/cdfmoc .
-
-./cdfmoc ${CONFCASE}_y${year}_ANNUAL_gridV.nc
-mv moc.nc ${CONFCASE}_y${year}_MOC.nc
-mfput ${CONFCASE}_y${year}_MOC.nc ${CONFIG}/${CONFCASE}-DIAGS/
-rsh rhodes "cd bin ; cat ovtplot.csh | sed -e ""s/YYYY/$year/"" -e""s/CCCC/$CASE/"" -e ""s/FFFF/$CONFIG/""> moctmp.csh ; ./moctmp.csh "
-
-
-# MAX and MIN of MOC
-#-------------------
-
-# to be done
-
-
-# Barotropic Transport
-#---------------------
-cp $CDFTOOLS/cdfpsi .
-chmod 755 cdfpsi
- ./cdfpsi ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- mv psi.nc ${CONFCASE}_y${YEAR}_PSI.nc
- mfput ${CONFCASE}_y${YEAR}_PSI.nc $CONFIG/${CONFCASE}-MEAN/$YEAR/
-
-
-# MXL Diagnostics
-#-----------------
- cp $CDFTOOLS/cdfmxl .
- chmod 755 cdfmxl
-
- rsh gaya mkdir $CONFIG/${CONFCASE}-DIAGS/$YEAR
-
-foreach f ( `rsh gaya ls $CONFIG/${CONFCASE}-MEAN/$YEAR/${CONFCASE}_y${YEAR}m0\[39\]_gridT.nc ` )
- mfget $f ./
- set g=`basename $f | sed -e 's/gridT/MXL/' `
-
- ./cdfmxl `basename $f`
-
- mfput mxl.nc $CONFIG/${CONFCASE}-DIAGS/$YEAR/$g
-
-end
-
- if ( $TRACER == 1 ) then
-# TRACER DIAGS (31/12 of each year)
-#-------------
-
-cp $CDFTOOLS/cdfzonalmean .
-cp $CDFTOOLS/cdfzonalsum .
-cp $CDFTOOLS/cdfzonalout .
-
-# Absolute mean of concentration
- echo -n $YEAR ' ' > ${CONFCASE}_y${YEAR}_TRCmean.dat
-
- mfget ${CONFIG}/${CONFCASE}-S/$YEAR/${CONFCASE}_y${YEAR}m12d31_ptrcT.nc ./
-
- \rm -f tmp1
- ./cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invcfc T > tmp1
- set area=`cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}'`
- set mean=`cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}'`
- set total=` echo $mean $area | awk '{print $1 * $2 }' `
- echo -n $total ' ' >> ${CONFCASE}_y${YEAR}_TRCmean.dat
-
- \rm -f tmp1
- ./cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invc14 T > tmp1
- set area=`cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}'`
- set mean=`cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}'`
- set total=` echo $mean $area | awk '{print $1 * $2 }' `
- echo $total ' ' >> ${CONFCASE}_y${YEAR}_TRCmean.dat
-
- mfput ${CONFCASE}_y${YEAR}_TRCmean.dat ${CONFIG}/${CONFCASE}-DIAGS
-
-# zonal integral of inventories
- ./cdfzonalsum ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
-# zonal means
- ./cdfzonalmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
- ncks -F -d deptht,1,1 -v zocfc11_glo,zobc14_glo,nav_lon,nav_lat zonalmean.nc zonalsurf.nc
-
-# put in ascii format the 1D profiles
- ./cdfzonalout zonalmean.nc > zonalmean.dat
- ./cdfzonalout zonalsum.nc > zonalsum.dat
- ./cdfzonalout zonalsurf.nc > zonalsurf.dat
-
-mfput zonalmean.nc ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalmean.nc
-mfput zonalsum.nc ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalsum.nc
-
-mfput zonalmean.dat ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalmean.dat
-mfput zonalsum.dat ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalsum.dat
-mfput zonalsurf.dat ${CONFIG}/${CONFCASE}-DIAGS/${CONFCASE}_y${YEAR}_TRCzonalsurf.dat
-
- endif
diff --git a/JOBS/monitor_prod.ksh b/JOBS/monitor_prod.ksh
deleted file mode 100755
index 8678bde..0000000
--- a/JOBS/monitor_prod.ksh
+++ /dev/null
@@ -1,642 +0,0 @@
-#!/bin/ksh
-set -x
-# This script is intended to be sourced from a main script. Not Stand Alone
-# Basically it runs on the production machine, once the MEAN fields
-# have been computed (monthly, annual) and disposed on the respective
-# CONFIG-CASE-MEAN/YEAR/ directory.
-
-# Each block corresponds to a particular monitoring task. Each block is supposed
-# to be independant from the other (in particular, required file are downloaded
-# via the rapatrie function, which does the job only if necessary.
-
-# The different tasks are performed with the cdftools programs. CDFTOOLS is
-# added to the PATH.
-
-#-------------------------------------------------------------------------------
-# $Rev$
-# $Date$
-# $Id$
-#-------------------------------------------------------------------------------
-# define some config dependent variable
-. ./config_def.ksh # can be a link
-# Define some functions to get/put file from/to gaya (can be easily customized)
-
-. ./function_def.ksh # can be a link
-
-#------------------------------------------------------------------------------
-# directory name frequently used:
-#------------------------------------------------------------------------------
- # on gaya
- MEANY=$CONFIG/${CONFCASE}-MEAN/$YEAR
- SDIRY=$CONFIG/${CONFCASE}-S/$YEAR
- DIAGS=${CONFIG}/${CONFCASE}-DIAGS
- IDIR=$CONFIG/${CONFIG}-I
- LOCAL_SAVE=${LOCAL_SAVE:=0}
-
- # on zahir
- P_CTL=$HOME/RUN_${CONFIG}/${CONFCASE}/CTL
-
- # check existence of some required directories
- # ... on gaya
- chkdirg $DIAGS
-
-#------------------------------------------------------------------------------
-# PATH:
-#-----------------------------------------------------------------------------
- export PATH=$CDFTOOLS/:$PATH
-
-# check if required cdftools are available, exit if missing
- err=0
- for cdfprog in cdfeke cdfmean cdfrmsssh cdfstdevw cdficediags cdftransportiz\
- cdfmhst cdfhflx cdfmoc cdfmaxmoc cdfpsi cdfsigtrp cdfmxl \
- cdfzonalmean cdfzonalsum cdfzonalout bimgmoy4 bimgcaltrans ; do
- if [ ! -x $CDFTOOLS/$cdfprog ] ; then
- err=$(( err + 1 ))
- echo $cdfprog executable missing. Check your $CDFTOOLS installation
- fi
- done
-
- if [ $err != 0 ] ; then
- echo " monitoring cannot be performed, sorry !" ; exit 1
- fi
-#=============================================================================
-# PART I: Derived quantities, to be added to the -MEAN/YEAR directory
-#=============================================================================
- # check if we have a NATL config or a ORCA config (to be improved ....)
- atl=$( echo 1 | awk '{ ii=index (config,"NATL") ; print ii }' config=$CONFIG )
-
-# EKE : Eddy Kinetic Energy: Input files gridU, gridV gridU2, gridV2
-#^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $EKE == 1 ] ; then
- # retrieve U and V ANNUAL mean files and squared mean
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc
-
- # retrieve a T file needed for headers only (EKE is computed on the T-point)
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
-
- cdfeke ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
-
- # dispose file on the MEAN directory
- expatrie eke.nc $MEANY ${CONFCASE}_y${YEAR}_EKE.nc
- \rm eke.nc
- fi
-
-
-# RMS SSH and StdDev W : Input files : gridT, gridT2 gridW, gridW2
-#^^^^^^^^^^^^^^^^^^^^^^^
- if [ $RMSSSH == 1 ] ; then
- # RMSSSH :get gridT gridT2
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
- cdfrmsssh ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
-
- # dispose file on the MEAN directory
- expatrie rms.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_RMSSSH.nc
- \rm rms.nc
-
- # StdDev W :get gridW and gridW2 files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc
-
- cdfstdevw ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc
-
- # dispose file on the MEAN directory
- expatrie rmsw.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_STDEVW.nc
- \rm rmsw.nc
- fi
-
-# Barotropic Transport: Input file: gridU, gridV mesh mask
-#^^^^^^^^^^^^^^^^^^^^^
- if [ $BSF == 1 ] ; then
- # get gridU gridV files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- cdfpsi ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- # dispose and rename on the MEAN directory
- expatrie psi.nc $MEANY ${CONFCASE}_y${YEAR}_PSI.nc
- fi
-
-# MOC Meridional Overturning Circulation: Input file: gridV, mesh mask, mask_glo
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MOC == 1 ] ; then
- # get gridV files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- # get mesh mask files + new_maskglo
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
- if (( $atl == 0 )) ; then rapatrie new_maskglo.nc $IDIR new_maskglo.nc ; fi
-
- cdfmoc ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- # dispose on gaya MEAN/YEAR directory
- expatrie moc.nc $MEANY ${CONFCASE}_y${YEAR}_MOC.nc
- fi
-
-# Mixed Layer Diagnostics : Input file : gridT for month 03 and 09 mesh_hgr, mesh_zgr
-#^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MXL == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- for m in 3 9 ; do
- f=${CONFCASE}_y${YEAR}m0${m}_gridT.nc
- g=$(echo $f | sed -e 's/gridT/MXL/')
-
- rapatrie $f $MEANY $f
-
- cdfmxl $f
-
- # dispose on gaya, MEAN/YEAR directory
- expatrie mxl.nc $MEANY $g
- done
- fi
-
-#=============================================================================
-# PART II: Time series: compute some integral quantities relevant for monitor
-# the ocean variability, and the behaviour of the on going run.
-# Output is basically a small ASCII file, from which a matlab
-# suitable input file (.mtl) is derived.
-#=============================================================================
-# Global MEANS: T S SSH Input files: gridT , mesh_hgr, mesh_zgr, mask
-#^^^^^^^^^^^^^^
- if [ $TSMEAN == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # get gridT files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
-
- # set header on the output file (ASCII)
- fsshmean=${CONFCASE}_y${YEAR}_SSHMEAN.txt
- ftmean=${CONFCASE}_y${YEAR}_TMEAN.txt
- fsmean=${CONFCASE}_y${YEAR}_SMEAN.txt
- echo $YEAR > $fsshmean ; echo $YEAR > $ftmean ; echo $YEAR > $fsmean
-
- # 3D means
- cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc sossheig T >> $fsshmean
- cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc votemper T >> $ftmean
- cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc vosaline T >> $fsmean
-
- # dispose ASCII file in the -DIAGS directory
- expatrie $fsshmean $DIAGS $fsshmean
- expatrie $ftmean $DIAGS $ftmean
- expatrie $fsmean $DIAGS $fsmean
- if [ $(chkfile $DIAGS/LEVITUS_y0000_TMEAN.txt ) == absent ] ; then
- # first time : Create header with Levitus equivalent
- # requires LEVITUS 'same' diags (from the ANNUAL mean )
- # !!! NEW !!!
- # get non-masked levitus then mask it with the same mask as the model
- levitus=${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_$( echo $CONFIG | tr 'A-Z' 'a-z').nc
- rapatrie $levitus $IDIR $levitus
- cdfmltmask $levitus mask.nc votemper T # votemper --> $levitus_masked
- cdfmltmask ${levitus}_masked mask.nc vosaline T # vosaline --> $levitus_masked_masked
- mv ${levitus}_masked_masked ${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_masked_$( echo $CONFIG | tr 'A-Z' 'a-z').nc # simplify name
- levitus=${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_masked_$( echo $CONFIG | tr 'A-Z' 'a-z').nc # will be ready for GIB DIAG
- #
- cdfmean $levitus votemper T > LEVITUS_y0000_TMEAN.txt
- cdfmean $levitus vosaline T > LEVITUS_y0000_SMEAN.txt
- expatrie LEVITUS_y0000_TMEAN.txt $DIAGS LEVITUS_y0000_TMEAN.txt
- expatrie LEVITUS_y0000_SMEAN.txt $DIAGS LEVITUS_y0000_SMEAN.txt
- fi
- fi
-
-
-# Ice Volume area and extent for m02 m03 m08 m09: input file : icemod, and mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $ICE == 1 ] ; then
- # get icemod file for the month 02 03 and 08 09
- rapatrie ${CONFCASE}_y${YEAR}m02_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m02_icemod.nc
- rapatrie ${CONFCASE}_y${YEAR}m03_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m03_icemod.nc
- rapatrie ${CONFCASE}_y${YEAR}m08_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m08_icemod.nc
- rapatrie ${CONFCASE}_y${YEAR}m09_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m09_icemod.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii output file:
- fice=${CONFCASE}_y${YEAR}_ice.txt
-
- echo '###' $YEAR 02 > $fice
- cdficediags ${CONFCASE}_y${YEAR}m02_icemod.nc >> $fice
- echo '###' $YEAR 03 >> $fice
- cdficediags ${CONFCASE}_y${YEAR}m03_icemod.nc >> $fice
- echo '###' $YEAR 08 >> $fice
- cdficediags ${CONFCASE}_y${YEAR}m08_icemod.nc >> $fice
- echo '###' $YEAR 09 >> $fice
- cdficediags ${CONFCASE}_y${YEAR}m09_icemod.nc >> $fice
-
- expatrie $fice $DIAGS $fice
- fi
-
-# Ice Volume area and extent for all months: input file : icemod, and mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $ICEMONTH == 1 ] ; then
- # get icemod files
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- rapatrie ${CONFCASE}_y${YEAR}m${mm}_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m${mm}_icemod.nc
- m=$(( m + 1 ))
- done
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii output file:
- fice=${CONFCASE}_y${YEAR}_icemonth.txt
-
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- case $mm in
- 01) echo '###' $YEAR $mm > $fice ;;
- *) echo '###' $YEAR $mm >> $fice ;;
- esac
- cdficediags ${CONFCASE}_y${YEAR}m${mm}_icemod.nc >> $fice
- m=$(( m + 1 ))
- done
-
- expatrie $fice $DIAGS $fice
-
- fi
-
-# Vertical T-S profiles off the coast of Portugal for Gib monitoring: input file: gridT, mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $GIB == 1 ] ; then
- # get gridT file
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii output files:
- ftgib=${CONFCASE}_y${YEAR}_TGIB.txt
- fsgib=${CONFCASE}_y${YEAR}_SGIB.txt
-
- echo $YEAR > $ftgib
- cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc votemper T $GIBWIN 0 0 >> $ftgib
- echo $YEAR > $fsgib
- cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc vosaline T $GIBWIN 0 0 >> $fsgib
-
- expatrie $ftgib $DIAGS $ftgib
- expatrie $fsgib $DIAGS $fsgib
-
- if [ $(chkfile $DIAGS/LEVITUS_y0000_TGIB.txt ) == absent ] ; then
- # first time : Create header with Levitus equivalent
- # requires LEVITUS 'same' diags (from the ANNUAL mean )
- levitus=${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_masked_$( echo $CONFIG | tr 'A-Z' 'a-z').nc
- if [ ! -f $levitus ] ; then
- # need to build a masked LEvitus with proper mask
- levitus=${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_$( echo $CONFIG | tr 'A-Z' 'a-z').nc
- rapatrie $levitus $IDIR $levitus
- cdfmltmask $levitus mask.nc votemper T # votemper --> $levitus_masked
- cdfmltmask ${levitus}_masked mask.nc vosaline T # vosaline --> $levitus_masked_masked
- mv ${levitus}_masked_masked ${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_masked_$( echo $CONFIG | tr 'A-Z' 'a-z').nc # simplify name
- levitus=${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_masked_$( echo $CONFIG | tr 'A-Z' 'a-z').nc # will be ready for GIB DIAG
- fi
- cdfmean $levitus votemper T $GIBWIN 0 0 > LEVITUS_y0000_TGIB.txt
- cdfmean $levitus vosaline T $GIBWIN 0 0 > LEVITUS_y0000_SGIB.txt
- expatrie LEVITUS_y0000_TGIB.txt $DIAGS LEVITUS_y0000_TGIB.txt
- expatrie LEVITUS_y0000_SGIB.txt $DIAGS LEVITUS_y0000_SGIB.txt
- fi
- fi
-
-# El nino indexes : Input files : monthly gridT, mesh mask
-#^^^^^^^^^^^^^^^^^^
- if [ $ELNINO == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii outputfile
- fnino=${CONFCASE}_y${YEAR}_NINO.txt
-
- # get monthly mean gridT files and compute mean SST on each NINO box
- for m in 1 2 3 4 5 6 7 8 9 10 11 12 ; do
- mm=$(printf "%02d" $m)
- f=${CONFCASE}_y${YEAR}m${mm}_gridT.nc
-
- rapatrie $f $MEANY $f
-
- # header
- printf "%04d %02d" $YEAR $m >> $fnino
-
- # nino 1+2 [ -90 W -- -80 W, -10 S -- 10 N ]
- cdfmean $f votemper T $NINO12 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> $fnino
- # nino 3 [ -150 W -- -90 W, -5 S -- 5 N ]
- cdfmean $f votemper T $NINO3 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> $fnino
- # nino 4 [ -200 W -- -150 W, -5 S -- 5 N ]
- cdfmean $f votemper T $NINO4 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> $fnino
- # nino 3.4 [ -170 W -- -120 W, -% S -- % N ]
- cdfmean $f votemper T $NINO34 1 1 | tail -1 | awk '{ printf " %8.5f 0.00\n", $6 }' >> $fnino
-
- done
-
- expatrie $fnino $DIAGS $fnino
- fi
-
-# Transport: Input files: VT, gridU, gridV, mesh mask, section.dat
-#^^^^^^^^^^^
- if [ $TRP == 1 ] ; then
- # section.dat describes the position (I,J) of the sections to monitor
- cp $P_CTL/section.dat .
-
- # get VT , gridU, gridV files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii output file:
- fsection=${CONFCASE}_y${YEAR}_section_monitor.txt
-
- echo $YEAR > $fsection
-
- cdftransportiz ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc < section.dat >> $fsection
-
- # eliminate garbage from txt file ...
- grep -v Give $fsection | grep -v level | grep -v IMAX | grep -v FROM > tmp
- mv -f tmp $fsection
-
- expatrie $fsection $DIAGS $fsection
- fi
-
-# Heat and Salt Meridional Transport : Input files : VT, mesh mask, new_maskglo
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MHT == 1 ] ; then
-# (a) From advection:
-#--------------------
- # get VT files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
-
- # get mesh mask files + new_maskglo
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
- if (( $atl == 0 )) ; then rapatrie new_maskglo.nc $IDIR new_maskglo.nc ; fi
-
- # Ascii output file:
- fheat=${CONFCASE}_y${YEAR}_heattrp.dat
- fsalt=${CONFCASE}_y${YEAR}_salttrp.dat
-
- cdfmhst ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
-
- expatrie zonal_heat_trp.dat $DIAGS ${CONFCASE}_y${YEAR}_heattrp.dat
- expatrie zonal_salt_trp.dat $DIAGS ${CONFCASE}_y${YEAR}_salttrp.dat
-
- # needed below with the correct name
- cp zonal_heat_trp.dat ${CONFCASE}_y${YEAR}_heattrp.dat
-
-# (b) from Surface Heat fluxes
-#-----------------------------
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
- cdfhflx ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
-
- expatrie hflx.out $DIAGS ${CONFCASE}_y${YEAR}_hflx.dat
- fi
-
-
-# MAX and MIN of MOC: requires that MOC files already exists
-#^^^^^^^^^^^^^^^^^^^^
- if [ $MAXMOC == 1 ] ; then
- f=moc.nc
- rapatrie ${CONFCASE}_y${YEAR}_MOC.nc $MEANY $f
-
- # Ascii output file
- fmaxmoc=${CONFCASE}_y${YEAR}_minmaxmoc.txt
- echo $YEAR > $fmaxmoc
- fmaxmoc40=${CONFIG}-${CASE}_y${YEAR}_maxmoc40.txt
- echo $YEAR > $fmaxmoc40
-
- if (( atl == 0 )) ; then
- # GLO
- printf "%s" 'Glo ' >> $fmaxmoc ; cdfmaxmoc $f glo 20 60 500 2000 | grep Maximum >> $fmaxmoc
- printf "%s" 'Glo ' >> $fmaxmoc ; cdfmaxmoc $f glo -40 30 2000 5500 | grep Minimum >> $fmaxmoc
- # ATL
- printf "%s" 'Atl ' >> $fmaxmoc ; cdfmaxmoc $f atl 0 60 500 2000 | grep Maximum >> $fmaxmoc
- printf "%s" 'Atl ' >> $fmaxmoc ; cdfmaxmoc $f atl -20 40 2000 5500 | grep Minimum >> $fmaxmoc
- #INP
- printf "%s" 'Inp ' >> $fmaxmoc ; cdfmaxmoc $f inp 15 50 100 1000 | grep Minimum >> $fmaxmoc
- printf "%s" 'Inp ' >> $fmaxmoc ; cdfmaxmoc $f inp -30 20 1000 5500 | grep Minimum >> $fmaxmoc
- #AUS
- printf "%s" 'Aus ' >> $fmaxmoc ; cdfmaxmoc $f glo -70 0 0 2000 | grep Maximum >> $fmaxmoc
- printf "%s" 'Aus ' >> $fmaxmoc ; cdfmaxmoc $f glo -70 0 2000 5500 | grep Minimum >> $fmaxmoc
-
- expatrie $fmaxmoc $DIAGS $fmaxmoc
-
- # Max and Min of MOC at some specific latitudes
- # GLO MAX at 40 N and 30S
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo 40 40 500 2000 | grep Maximum >> $fmaxmoc40
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo -30 -30 500 5500 | grep Maximum >> $fmaxmoc40
- # ATL MAX at 40N and 30S
- printf "%s" 'Atl ' >> $fmaxmoc40 ; cdfmaxmoc $f atl 40 40 500 2000 | grep Maximum >> $fmaxmoc40
- printf "%s" 'Atl ' >> $fmaxmoc40 ; cdfmaxmoc $f atl -30 -30 500 5000 | grep Maximum >> $fmaxmoc40
- #INP Min at 30 S
- printf "%s" 'Inp ' >> $fmaxmoc40 ; cdfmaxmoc $f inp -30 -30 1000 5500 | grep Minimum >> $fmaxmoc40
- #AUS MAX at 50 S
- printf "%s" 'Aus ' >> $fmaxmoc40 ; cdfmaxmoc $f glo -50 -50 0 2000 | grep Maximum >> $fmaxmoc40
-
- expatrie $fmaxmoc40 $DIAGS $fmaxmoc40
-
- else # NATL configuration
- # GLO
- printf "%s" 'Glo ' >> $fmaxmoc ; cdfmaxmoc $f glo 20 60 500 2000 | grep Maximum >> $fmaxmoc
- printf "%s" 'Glo ' >> $fmaxmoc ; cdfmaxmoc $f glo -40 30 2000 5500 | grep Minimum >> $fmaxmoc
- expatrie $fmaxmoc $DIAGS $fmaxmoc
-
- # Max and Min of MOC at some specific latitudes
- # GLO MAX at 40 N and 30S
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo 40 40 500 2000 | grep Maximum >> $fmaxmoc40
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo -15 -15 500 5500 | grep Maximum >> $fmaxmoc40
-
- expatrie $fmaxmoc40 $DIAGS $fmaxmoc40
-
- # clean for next year
- \rm moc.nc
- fi
- fi
-
-
-# DCT :Density Class transport: Input files : gridT, gridU gridV, mesh mask, dens_section.dat
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $DCT == 1 ] ; then
- # dens_section.dat describe the sections (either zonal or meridional) where the DCT is computed
- cp $P_CTL/dens_section.dat .
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Required post_processing script: DCT are computed on monthly means, then average is performed
- # for annual values. This process is still done through temporary bimg/dimg files (remnant of the
- # old Clipper times). By the way, 2 bimgtools are required: bimgmoy4 and bimgcaltrans
- # In-lining of this script may be confusing. I leave it as an external module.
- cp $CDFTOOLS/JOBS/trpsig_postproc.ksh ./
-
- # due to the large amount of files that are produced by this diags, we prefer to keep them
- # on a separate directory
- chkdirg ${CONFIG}/${CONFCASE}-TRPSIG/
- chkdirg ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
- chkdirg $DIAGS/$YEAR/
- chkdirg $DIAGS/TRPSIG/
-
- # also need temporary directories in the actual tmpdir:
- chkdir ${CONFIG}
- chkdir ${CONFIG}/${CONFCASE}-TRPSIG
- chkdir ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
-
- TRPSIGY=${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
-
- for m in 1 2 3 4 5 6 7 8 9 10 11 12 ; do
- mm=$(printf "%02d" $m)
- tfich=${CONFCASE}_y${YEAR}m${mm}_gridT.nc
- ufich=$(echo $tfich | sed -e 's/gridT/gridU/' )
- vfich=$(echo $tfich | sed -e 's/gridT/gridV/' )
-
- #get files on gaya
- rapatrie $tfich $MEANY $tfich
- rapatrie $ufich $MEANY $ufich
- rapatrie $vfich $MEANY $vfich
-
- #retrieve tag time from file name
- tag=$(echo $tfich | sed -e "s/${CONFCASE}_//" -e 's/_gridT.nc//')
-
- echo $tag > ${CONFCASE}_y${tag}_trpsig_monitor.lst
-
- cdfsigtrp $tfich $ufich $vfich 21 30 180 -bimg -print >> ${CONFCASE}_y${tag}_trpsig_monitor.lst
-
- # save the monthly log file on gaya for an (improbable) eventual post processing ...
-# expatrie ${CONFCASE}_y${tag}_trpsig_monitor.lst $TRPSIGY ${CONFCASE}_y${tag}_trpsig_monitor.lst
- # and create a mirror on the local tmpdir
- mv ${CONFCASE}_y${tag}_trpsig_monitor.lst $TRPSIGY
-
- # Idem : save temporary bimg files on gaya and create local mirror
- for b in *bimg ; do
- mv $b ${CONFCASE}_y${tag}_$b
-# expatrie ${CONFCASE}_y${tag}_$b $TRPSIGY ${CONFCASE}_y${tag}_$b
- mv ${CONFCASE}_y${tag}_$b $TRPSIGY
- done
-
- # Idem: for txt files
- mv trpsig.txt ${CONFCASE}_y${tag}_trpsig.txt
-# expatrie ${CONFCASE}_y${tag}_trpsig.txt $TRPSIGY ${CONFCASE}_y${tag}_trpsig.txt
- mv ${CONFCASE}_y${tag}_trpsig.txt $TRPSIGY
-
- # erase useless files ( monthly averages ) Keep tfich which can be used for MXL
- \rm *.bimg $ufich $vfich
-
- # end of month loop
- done
-
- # Launch post processing ( by itself a complex script ...)
- # This script retrieve CONFIG name and CASE from the directory name where it runs...
- cd ${CONFIG}/${CONFCASE}-TRPSIG
-
- . $TMPDIR/trpsig_postproc.ksh
-
- cd $TMPDIR
-
- # save results on gaya ( as many files as sections in dens_section.dat)
- for f in ${CONFCASE}_y*_trpsig.txt ; do
- expatrie $f $DIAGS/TRPSIG/ $f
- done
-
- # return to tmpdir
- cd $TMPDIR
- # Erase the TRPSIG tree for this current year
- \rm -r ${CONFIG} \rm ${CONFCASE}_y*_trpsig.txt *.mtl
- fi
-
-# TRACER DIAGS (31/12 of each year) : Input files : ptrcT, mesh mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $TRACER == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
- if (( $atl == 0 )) ; then rapatrie new_maskglo.nc $IDIR new_maskglo.nc ; fi
-
- # get tracer file from gaya: note that this is from -S dir (5 day average ... to discuss ...)
- rapatrie ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc $SDIRY ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc
-
- # Ascii output file:
- ftrc=${CONFCASE}_y${YEAR}_TRCmean.dat
-
- # Number of mol in the ocean ...
- printf "%04d " $YEAR > $ftrc
-
- # CFC11
- \rm -f tmp1
- cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invcfc T > tmp1
- area=$(cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}')
- mean=$(cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}')
- total=$(echo $mean $area | awk '{print $1 * $2 }' )
- printf "%s " $total >> $ftrc
-
- # B-C14
- \rm -f tmp1
- cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invc14 T > tmp1
- area=$(cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}')
- mean=$(cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}')
- total=$(echo $mean $area | awk '{print $1 * $2 }' )
- printf "%s \n" $total >> $ftrc
-
- expatrie $ftrc $DIAGS $ftrc
-
- # zonal integral of inventories
- cdfzonalsum ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
- # zonal means
- cdfzonalmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
- # ncks is required on the prod machine ... !! not standard !!
- # it is used to take only the interesting variables from the results
- ncks -F -d deptht,1,1 -v zocfc11_glo,zobc14_glo,nav_lon,nav_lat zonalmean.nc zonalsurf.nc
-
- # put in ascii format the 1D profiles
- cdfzonalout zonalmean.nc > zonalmean.dat
- cdfzonalout zonalsum.nc > zonalsum.dat
- cdfzonalout zonalsurf.nc > zonalsurf.dat
-
- expatrie zonalmean.nc $MEANY ${CONFCASE}_y${YEAR}_TRCzonalmean.nc
- expatrie zonalsum.nc $MEANY ${CONFCASE}_y${YEAR}_TRCzonalsum.nc
-
- expatrie zonalmean.dat $DIAGS ${CONFCASE}_y${YEAR}_TRCzonalmean.dat
- expatrie zonalsum.dat $DIAGS ${CONFCASE}_y${YEAR}_TRCzonalsum.dat
- expatrie zonalsurf.dat $DIAGS ${CONFCASE}_y${YEAR}_TRCzonalsurf.dat
- \rm zonalsurf.nc
-
- fi
diff --git a/JOBS/monitor_prod_jade.ksh b/JOBS/monitor_prod_jade.ksh
deleted file mode 100755
index 9812da0..0000000
--- a/JOBS/monitor_prod_jade.ksh
+++ /dev/null
@@ -1,553 +0,0 @@
-#!/bin/ksh
-set -x
-# This script is intended to be sourced from a main script. Not Stand Alone
-# Basically it runs on the production machine, once the MEAN fields
-# have been computed (monthly, annual) and disposed on the respective
-# CONFIG-CASE-MEAN/YEAR/ directory.
-
-# Each block corresponds to a particular monitoring task. Each block is supposed
-# to be independant from the other (in particular, required file are downloaded
-# via the rapatrie function, which does the job only if necessary.
-
-# The different tasks are performed with the cdftools programs. BIN is
-# added to the PATH.
-
-#-------------------------------------------------------------------------------
-# $Rev: 231 $
-# $Date: 2009-03-24 11:25:04 +0100 (mar, 24 mar 2009) $
-# $Id: monitor_prod.ksh 231 2009-03-24 10:25:04Z molines $
-#-------------------------------------------------------------------------------
-YEAR=$1
-# define some config dependent variable
-. ./config_def.ksh # can be a link
-# Define some functions to get/put file from/to gaya (can be easily customized)
-. ./function_def.ksh # can be a link
-login_node=service3
-CONFCASE=$CONFIG-$CASE
-#------------------------------------------------------------------------------
-# directory name frequently used:
-#------------------------------------------------------------------------------
- # on gaya
- MEANY=$CONFIG/${CONFIG}-${CASE}-MEAN/$YEAR
- SDIRY=$CONFIG/${CONFIG}-${CASE}-S/$YEAR
- DIAGS=${CONFIG}/${CONFIG}-${CASE}-DIAGS
- IDIR=$CONFIG/${CONFIG}-I
- BIN=/scratch/$USER/bin
- # on zahir
- P_CTL=$HOME/RUN_${CONFIG}/${CONFIG}-${CASE}/CTL
- # check existence of some required directories
- # ... on WORKDIR
-
- chkdir ../${CONFIG}-${CASE}-DIAGS
- chkdirg $SDIR/$DIAGS
-
- R_MONITOR=`pwd`
- cd $YEAR
-#-----------------------------------------------------------------------------
-# MENU SKEL
-#-----------------------------------------------------------------------------
-EKE=EEKKEE # compute EKE
-RMSSSH=RRMMSS # compute RMS ssh and w
-TSMEAN=TTSSMMEEAANN # compute TSMEAN and ssh drift
-ICE=IICCEE # compute ice volume, area and extent
-ICEMONTH=IICCEEMM # compute ice volume, area and extent
-GIB=0 # compute Gibraltar diags (restoring zone)
-ELNINO=0 # compute El Nino monitoring SSTs
-TRP=TTRRPP # compute barotropic transport accross section as given in section.dat (CTL dir)
-MHT=MMHHTT # compute Meridional Heat Transport (advective and from surface fluxes)
-MOC=MMOOCC # compute MOC ( need a sub basin mask file called new_maskglo.nc)
-MAXMOC=MMAAXXMOC # diagnose the min and max of MOC
-BSF=BBSSFF # compute the BSF (psi) from U and V
-DCT=DDCCTT # compute density class transports for section given in dens_section.dat (CTL dir)
-MXL=MMXXLL # Compute mixed layer depth from 3 criteria for month 03 and 09
-TRACER=TTRRCC # Compute passive Tracer statistics
-LSPV=LLSSPPVV # compute large scale potential vorticity in March and September
-#-----------------------------------------------------------------------------
-# PATH:
-#-----------------------------------------------------------------------------
-
-# check if required cdftools are available, exit if missing
- err=0
- for cdfprog in cdfeke cdfmean cdfrmsssh cdfstdevw cdficediags cdftransportiz\
- cdfmhst cdfhflx cdfmoc cdfmaxmoc cdfpsi cdfsigtrp cdfmxl \
- cdfzonalmean cdfzonalsum cdfzonalout bimgmoy4 bimgcaltrans cdfmoy ; do
- if [ ! -x /scratch/$USER/bin/$cdfprog ] ; then
- err=$(( err + 1 ))
- echo $cdfprog executable missing. Check your ~/bin for BIN installation
- fi
- done
-
- if [ $err != 0 ] ; then
- echo " monitoring cannot be performed, sorry !" ; exit 1
- fi
-#=============================================================================
-# PART I: Derived quantities, to be added to the -MEAN/YEAR directory
-#=============================================================================
- # check if we have a NATL config or a ORCA config (to be improved ....)
- atl=$( echo 1 | awk '{ ii=index (config,"NATL") ; print ii }' config=$CONFIG )
-############################################################################################
-############################################################################################
-# EKE : Eddy Kinetic Energy: Input files gridU, gridV gridU2, gridV2
-#^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $EKE == 1 ] ; then
- # retrieve U and V ANNUAL mean files and squared mean
- getannualmean gridU
- getannualmean gridV
- getannualmean gridU2
- getannualmean gridV2
- # retrieve a T file needed for headers only (EKE is computed on the T-point)
- getannualmean gridT2
- # run cdfeke
- $BIN/cdfeke ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
- mv eke.nc ${CONFCASE}_y${YEAR}_ANNUAL_EKE.nc
- # dispose file on the MEAN directory
- savemeanfile ${CONFCASE}_y${YEAR}_ANNUAL_EKE.nc
- fi
-############################################################################################
-############################################################################################
-# RMS SSH and StdDev W : Input files : gridT, gridT2 gridW, gridW2
-#^^^^^^^^^^^^^^^^^^^^^^^
- if [ $RMSSSH == 1 ] ; then
- # RMSSSH :get gridT gridT2
- getannualmean gridT
- getannualmean gridT2
- # run cdfrmsssh
- $BIN/cdfrmsssh ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
- mv rms.nc ${CONFCASE}_y${YEAR}_ANNUAL_RMSSSH.nc
- # dispose file on the MEAN directory
- savemeanfile ${CONFCASE}_y${YEAR}_ANNUAL_RMSSSH.nc
- #####################################################
- # StdDev W :get gridW and gridW2 files
- getannualmean gridW
- getannualmean gridW2
- # run cdfstdevw
- $BIN/cdfstdevw ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc
- mv rmsw.nc ${CONFCASE}_y${YEAR}_ANNUAL_STDEVW.nc
- # dispose file on the MEAN directory
- savemeanfile ${CONFCASE}_y${YEAR}_ANNUAL_STDEVW.nc
- fi
-############################################################################################
-############################################################################################
-# Barotropic Transport: Input file: gridU, gridV mesh mask
-#^^^^^^^^^^^^^^^^^^^^^
- if [ $BSF == 1 ] ; then
- # get gridU gridV files
- getannualmean gridU
- getannualmean gridV
- # get mesh mask files
- getmask ${MESH_MASK_ID}_byte_mask.nc
- getmesh_hgr ${MESH_MASK_ID}_mesh_hgr.nc
- getmesh_zgr ${MESH_MASK_ID}_mesh_zgr.nc
- # run cdfpsi
- $BIN/cdfpsi ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
- mv psi.nc ${CONFCASE}_y${YEAR}_ANNUAL_PSI.nc
- # dispose and rename on the MEAN directory
- savemeanfile ${CONFCASE}_y${YEAR}_ANNUAL_PSI.nc
- fi
-############################################################################################
-############################################################################################
-# MOC Meridional Overturning Circulation: Input file: gridV, mesh mask, mask_glo
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MOC == 1 ] ; then
- # get gridV files
- getannualmean gridV
- # get mesh mask files
- getmask ${MESH_MASK_ID}_byte_mask.nc
- getmesh_hgr ${MESH_MASK_ID}_mesh_hgr.nc
- getmesh_zgr ${MESH_MASK_ID}_mesh_zgr.nc
- if (( $atl == 0 )) ; then rapatrie new_maskglo.nc $IDIR new_maskglo.nc ; fi
- # run cdfmoc
- $BIN/cdfmoc ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
- mv moc.nc ${CONFCASE}_y${YEAR}_ANNUAL_MOC.nc
- # dispose on gaya MEAN/YEAR directory
- savemeanfile ${CONFCASE}_y${YEAR}_ANNUAL_MOC.nc
- fi
-############################################################################################
-############################################################################################
-# Mixed Layer Diagnostics : Input file : gridT for month 03 and 09 mesh_hgr, mesh_zgr
-#^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MXL == 1 ] ; then
- # get mesh mask files
- getmesh_hgr ${MESH_MASK_ID}_mesh_hgr.nc
- getmesh_zgr ${MESH_MASK_ID}_mesh_zgr.nc
- # get mean file and run cdfmxl
- getmonthlymean gridT 03
- $BIN/cdfmxl ${CONFCASE}_y${YEAR}m03_gridT.nc
- mv mxl.nc ${CONFCASE}_y${YEAR}m03_MXL.nc
- getmonthlymean gridT 09
- $BIN/cdfmxl ${CONFCASE}_y${YEAR}m09_gridT.nc
- mv mxl.nc ${CONFCASE}_y${YEAR}m09_MXL.nc
- # dispose on gaya, MEAN/YEAR directory
- savemeanfile ${CONFCASE}_y${YEAR}m03_MXL.nc
- savemeanfile ${CONFCASE}_y${YEAR}m09_MXL.nc
- fi
-# Large scale potential vorticity for m03 m09: input file : gridT, and mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $LSPV == 1 ] ; then
- # get gridT file for the month 03 and 09
- getmonthlymean gridT 03
- getmonthlymean gridT 09
-
- # get mesh mask files
- getmask ${MESH_MASK_ID}_byte_mask.nc
- getmesh_hgr ${MESH_MASK_ID}_mesh_hgr.nc
- getmesh_zgr ${MESH_MASK_ID}_mesh_zgr.nc
-
- # compute lspv and dispose file on the MEAN directory
- $BIN/cdflspv ${CONFCASE}_y${YEAR}m03_gridT.nc
- mv lspv.nc ${CONFCASE}_y${YEAR}m03_LSPV.nc
- savemeanfile ${CONFCASE}_y${YEAR}m03_LSPV.nc
-
- \rm lspv.nc
- $BIN/cdflspv ${CONFCASE}_y${YEAR}m09_gridT.nc
- mv lspv.nc ${CONFCASE}_y${YEAR}m09_LSPV.nc
- savemeanfile ${CONFCASE}_y${YEAR}m09_LSPV.nc
- \rm lspv.nc
- fi
-
-############################################################################################
-############################################################################################
-#=============================================================================
-# PART II: Time series: compute some integral quantities relevant for monitor
-# the ocean variability, and the behaviour of the on going run.
-# Output is basically a small ASCII file, from which a matlab
-# suitable input file (.mtl) is derived.
-#=====================================================================
-# Global MEANS: T S SSH Input files: gridT , mesh_hgr, mesh_zgr, mask
-#^^^^^^^^^^^^^^
- if [ $TSMEAN == 1 ] ; then
- # get mesh mask files
- getmask ${MESH_MASK_ID}_byte_mask.nc
- getmesh_hgr ${MESH_MASK_ID}_mesh_hgr.nc
- getmesh_zgr ${MESH_MASK_ID}_mesh_zgr.nc
- # get gridT files
- getannualmean gridT
- # set header on the output file (ASCII)
- fsshmean=${CONFCASE}_y${YEAR}_SSHMEAN.txt
- ftmean=${CONFCASE}_y${YEAR}_TMEAN.txt
- fsmean=${CONFCASE}_y${YEAR}_SMEAN.txt
- echo $YEAR > $fsshmean ; echo $YEAR > $ftmean ; echo $YEAR > $fsmean
- # 3D means
- $BIN/cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc sossheig T >> $fsshmean
- $BIN/cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc votemper T >> $ftmean
- $BIN/cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc vosaline T >> $fsmean
-
- # dispose ASCII file in the -DIAGS directory
- savediagfile ${CONFCASE}_y${YEAR}_SSHMEAN.txt
- savediagfile ${CONFCASE}_y${YEAR}_TMEAN.txt
- savediagfile ${CONFCASE}_y${YEAR}_SMEAN.txt
-
- if [ $(chkfile $DIAGS/LEVITUS_y0000_TMEAN.txt ) == absent ] ; then
- # first time : Create header with Levitus equivalent
- # requires LEVITUS 'same' diags (from the ANNUAL mean )
- T_levitus=Levitus_annual_votemper.nc
- S_levitus=Levitus_annual_vosaline.nc
-
- getlevitus votemper
- getlevitus vosaline
-## rapatrie $levitus $IDIR $levitus
- $BIN/cdfmean ${T_levitus} votemper T > LEVITUS_y0000_TMEAN.txt
- $BIN/cdfmean ${S_levitus} vosaline T > LEVITUS_y0000_SMEAN.txt
- savediagfile LEVITUS_y0000_TMEAN.txt
- savediagfile LEVITUS_y0000_SMEAN.txt
- fi
- fi
-############################################################################################
-############################################################################################
-# Ice Volume area and extent for m02 m03 m08 m09: input file : icemod, and mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $ICE == 1 ] ; then
- # get icemod file for the month 02 03 and 08 09
- getmonthlymean icemod 02
- getmonthlymean icemod 03
- getmonthlymean icemod 08
- getmonthlymean icemod 09
- # get mesh mask files
- getmask ${MESH_MASK_ID}_byte_mask.nc
- getmesh_hgr ${MESH_MASK_ID}_mesh_hgr.nc
- getmesh_zgr ${MESH_MASK_ID}_mesh_zgr.nc
- # Ascii output file:
- fice=${CONFCASE}_y${YEAR}_ice.txt
- echo '###' $YEAR 02 > $fice
- $BIN/cdficediags ${CONFCASE}_y${YEAR}m02_icemod.nc >> $fice
- echo '###' $YEAR 03 >> $fice
- $BIN/cdficediags ${CONFCASE}_y${YEAR}m03_icemod.nc >> $fice
- echo '###' $YEAR 08 >> $fice
- $BIN/cdficediags ${CONFCASE}_y${YEAR}m08_icemod.nc >> $fice
- echo '###' $YEAR 09 >> $fice
- $BIN/cdficediags ${CONFCASE}_y${YEAR}m09_icemod.nc >> $fice
- # save ascii file for plot
- savediagfile ${CONFCASE}_y${YEAR}_ice.txt
- fi
-############################################################################################
-############################################################################################
-# Ice Volume area and extent for all months: input file : icemod, and mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $ICEMONTH == 1 ] ; then
- # get icemod files
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- getmonthlymean icemod $mm
- m=$(( m + 1 ))
- done
- # get mesh mask files
- getmask ${MESH_MASK_ID}_byte_mask.nc
- getmesh_hgr ${MESH_MASK_ID}_mesh_hgr.nc
- getmesh_zgr ${MESH_MASK_ID}_mesh_zgr.nc
- # Ascii output file:
- fice=${CONFCASE}_y${YEAR}_icemonth.txt
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- case $mm in
- 01) echo '###' $YEAR $mm > $fice ;;
- *) echo '###' $YEAR $mm >> $fice ;;
- esac
- $BIN/cdficediags ${CONFCASE}_y${YEAR}m${mm}_icemod.nc >> $fice
- m=$(( m + 1 ))
- done
- rm -f out.txt
- # save file txt for plot
- savediagfile ${CONFCASE}_y${YEAR}_icemonth.txt
- fi
-############################################################################################
-############################################################################################
-#
-#
-#
-#
-#
-#
-# ADD GIB PART
-# ADD NINO PART
-#
-#
-#
-#
-#
-#
-#
-############################################################################################
-############################################################################################
-# Transport: Input files: VT, gridU, gridV, mesh mask, section.dat
-#^^^^^^^^^^^
- if [ $TRP == 1 ] ; then
- # section.dat describes the position (I,J) of the sections to monitor
- scp $USER@$login_node:$P_CTL/section.dat .
- # get VT , gridU, gridV files
- getannualmean VT
- getannualmean gridU
- getannualmean gridV
- # get mesh mask files
- getmask ${MESH_MASK_ID}_byte_mask.nc
- getmesh_hgr ${MESH_MASK_ID}_mesh_hgr.nc
- getmesh_zgr ${MESH_MASK_ID}_mesh_zgr.nc
- # Ascii output file:
- fsection=${CONFCASE}_y${YEAR}_section_monitor.txt
- echo $YEAR > $fsection
- $BIN/cdftransportiz ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc < section.dat >> $fsection
- # eliminate garbage from txt file ...
- grep -v Give $fsection | grep -v level | grep -v IMAX | grep -v FROM > tmp
- mv -f tmp $fsection
- rm -f strp.txt vtrp.txt htrp.txt
- # save txt file for plot
- savediagfile ${CONFCASE}_y${YEAR}_section_monitor.txt
- fi
-############################################################################################
-############################################################################################
-# Heat and Salt Meridional Transport : Input files : VT, mesh mask, new_maskglo
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MHT == 1 ] ; then
-# (a) From advection:
-#--------------------
- # get VT files
- getannualmean VT
- # get mesh mask files
- getmask ${MESH_MASK_ID}_byte_mask.nc
- getmesh_hgr ${MESH_MASK_ID}_mesh_hgr.nc
- getmesh_zgr ${MESH_MASK_ID}_mesh_zgr.nc
-#
-#
-#
-#
-#
-# need ADD MASKGLO
-#
-#
-#
-#
-#
-#
- # Ascii output file:
- fheat=${CONFCASE}_y${YEAR}_heattrp.dat
- fsalt=${CONFCASE}_y${YEAR}_salttrp.dat
- # run cdfmhst
- $BIN/cdfmhst ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
- cp zonal_heat_trp.dat ${CONFCASE}_y${YEAR}_heattrp.dat
- cp zonal_salt_trp.dat ${CONFCASE}_y${YEAR}_salttrp.dat
-
-# (b) from Surface Heat fluxes
-#-----------------------------
- getannualmean gridT
- # run cdfhflx
- $BIN/cdfhflx ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
- mv hflx.out ${CONFCASE}_y${YEAR}_hflx.dat
- rm -f mhst.nc
- # save dat file for plot
- savediagfile ${CONFCASE}_y${YEAR}_hflx.dat
- savediagfile ${CONFCASE}_y${YEAR}_salttrp.dat
- savediagfile ${CONFCASE}_y${YEAR}_heattrp.dat
- fi
-############################################################################################
-############################################################################################
-# MAX and MIN of MOC: requires that MOC files already exists
-#^^^^^^^^^^^^^^^^^^^^
- if [ $MAXMOC == 1 ] ; then
- getannualmean MOC
- f=${CONFCASE}_y${YEAR}_ANNUAL_MOC.nc
- # Ascii output file
- fmaxmoc=${CONFCASE}_y${YEAR}_minmaxmoc.txt
- echo $YEAR > $fmaxmoc
- fmaxmoc40=${CONFIG}-${CASE}_y${YEAR}_maxmoc40.txt
- echo $YEAR > $fmaxmoc40
-
- if (( atl == 0 )) ; then
- # GLO
- printf "%s" 'Glo ' >> $fmaxmoc ; $BIN/cdfmaxmoc $f glo 20 60 500 2000 | grep Maximum >> $fmaxmoc
- printf "%s" 'Glo ' >> $fmaxmoc ; $BIN/cdfmaxmoc $f glo -40 30 2000 5500 | grep Minimum >> $fmaxmoc
- # ATL
- printf "%s" 'Atl ' >> $fmaxmoc ; $BIN/cdfmaxmoc $f atl 0 60 500 2000 | grep Maximum >> $fmaxmoc
- printf "%s" 'Atl ' >> $fmaxmoc ; $BIN/cdfmaxmoc $f atl -20 40 2000 5500 | grep Minimum >> $fmaxmoc
- #INP
- printf "%s" 'Inp ' >> $fmaxmoc ; $BIN/cdfmaxmoc $f inp 15 50 100 1000 | grep Minimum >> $fmaxmoc
- printf "%s" 'Inp ' >> $fmaxmoc ; $BIN/cdfmaxmoc $f inp -30 20 1000 5500 | grep Minimum >> $fmaxmoc
- #AUS
- printf "%s" 'Aus ' >> $fmaxmoc ; $BIN/cdfmaxmoc $f glo -70 0 0 2000 | grep Maximum >> $fmaxmoc
- printf "%s" 'Aus ' >> $fmaxmoc ; $BIN/cdfmaxmoc $f glo -70 0 2000 5500 | grep Minimum >> $fmaxmoc
- # save file for plot
- savediagfile $fmaxmoc
-
- # Max and Min of MOC at some specific latitudes
- # GLO MAX at 40 N and 30S
- printf "%s" 'Glo ' >> $fmaxmoc40 ; $BIN/cdfmaxmoc $f glo 40 40 500 2000 | grep Maximum >> $fmaxmoc40
- printf "%s" 'Glo ' >> $fmaxmoc40 ; $BIN/cdfmaxmoc $f glo -30 -30 500 5500 | grep Maximum >> $fmaxmoc40
- # ATL MAX at 40N and 30S
- printf "%s" 'Atl ' >> $fmaxmoc40 ; $BIN/cdfmaxmoc $f atl 40 40 500 2000 | grep Maximum >> $fmaxmoc40
- printf "%s" 'Atl ' >> $fmaxmoc40 ; $BIN/cdfmaxmoc $f atl -30 -30 500 5000 | grep Maximum >> $fmaxmoc40
- #INP Min at 30 S
- printf "%s" 'Inp ' >> $fmaxmoc40 ; $BIN/cdfmaxmoc $f inp -30 -30 1000 5500 | grep Minimum >> $fmaxmoc40
- #AUS MAX at 50 S
- printf "%s" 'Aus ' >> $fmaxmoc40 ; $BIN/cdfmaxmoc $f glo -50 -50 0 2000 | grep Maximum >> $fmaxmoc40
- savediagfile $fmaxmoc40
-
- else # NATL configuration
- # GLO
- printf "%s" 'Glo ' >> $fmaxmoc ; $BIN/cdfmaxmoc $f glo 20 60 500 2000 | grep Maximum >> $fmaxmoc
- printf "%s" 'Glo ' >> $fmaxmoc ; $BIN/cdfmaxmoc $f glo -40 30 2000 5500 | grep Minimum >> $fmaxmoc
- savediagfile $fmaxmoc
-
- # Max and Min of MOC at some specific latitudes
- # GLO MAX at 40 N and 30S
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo 40 40 500 2000 | grep Maximum >> $fmaxmoc40
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo -15 -15 500 5500 | grep Maximum >> $fmaxmoc40
- savediagfile $fmaxmoc40
- fi
- fi
-
-############################################################################################
-############################################################################################
-# DCT :Density Class transport: Input files : gridT, gridU gridV, mesh mask, dens_section.dat
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $DCT == 1 ] ; then
- # dens_section.dat describe the sections (either zonal or meridional) where the DCT is computed
- scp $USER@$login_node:$P_CTL/dens_section.dat .
- scp $USER@$login_node:$CDFTOOLS/JOBS/trpsig_postproc_$MACHINE.ksh trpsig_postproc.ksh
- # get mesh mask files
- getmask ${MESH_MASK_ID}_byte_mask.nc
- getmesh_hgr ${MESH_MASK_ID}_mesh_hgr.nc
- getmesh_zgr ${MESH_MASK_ID}_mesh_zgr.nc
-
- # Required post_processing script: DCT are computed on monthly means, then average is performed
- # for annual values. This process is still done through temporary bimg/dimg files (remnant of the
- # old Clipper times). By the way, 2 bimgtools are required: bimgmoy4 and bimgcaltrans
- # In-lining of this script may be confusing. I leave it as an external module.
-
- # due to the large amount of files that are produced by this diags, we prefer to keep them
- # on a separate directory
- chkdirg $SDIR/$DIAGS/TRPSIG/
- # also need temporary directories in the actual tmpdir:
- for m in 1 2 3 4 5 6 7 8 9 10 11 12 ; do
- mm=$(printf "%02d" $m)
- tfich=${CONFCASE}_y${YEAR}m${mm}_gridT.nc
- ufich=$(echo $tfich | sed -e 's/gridT/gridU/' )
- vfich=$(echo $tfich | sed -e 's/gridT/gridV/' )
- #get files on gaya
- getmonthlymean gridT $mm
- getmonthlymean gridU $mm
- getmonthlymean gridV $mm
- #retrieve tag time from file name
- tag=$(echo $tfich | sed -e "s/${CONFCASE}_//" -e 's/_gridT.nc//')
- echo $tag > ${CONFCASE}_${tag}_trpsig_monitor.lst
- # run cdfsigtrp
- $BIN/cdfsigtrp $tfich $ufich $vfich 21 30 180 -bimg -print >> ${CONFCASE}_${tag}_trpsig_monitor.lst
- # rename file
- for b in [0-9][0-9]*bimg ; do
- mv $b ${CONFCASE}_${tag}_$b
- done
- # Idem: for txt files
- mv trpsig.txt ${CONFCASE}_${tag}_trpsig.txt
- done
- # use function def in function_def
- reorganize
- mean
- # save results on gaya ( as many files as sections in dens_section.dat)
- for f in TRPSIG/${CONFCASE}_y*_trpsig.txt ; do
- savediagfile $f
- done
- fi
-# TRACER DIAGS (31/12 of each year) : Input files : ptrcT, mesh mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-#
-#
-#
-# NOT IMPEMENTED FOR JADE
-#
-#
-#
-#
-#################################################################
-# cleaning of directory
-rmannualmean gridW
-rmannualmean gridW2
-rmannualmean gridU
-rmannualmean gridU2
-rmannualmean gridV
-rmannualmean gridV2
-rmannualmean gridT
-rmannualmean gridT2
-
-rmmonthlymean gridU ??
-rmmonthlymean gridU2 ??
-rmmonthlymean gridV ??
-rmmonthlymean gridV2 ??
-rmmonthlymean gridT ??
-rmmonthlymean gridT2 ??
-rmmonthlymean icemod ??
-rmmonthlymean gridW ??
-
-rmmask
-rmmesh_hgr
-rmmesh_zgr
-#######################################################################
-#save data on /data and keep it here also for plot
-# touch OK file for dplace function
-pwd
-touch OK_MONITOR
-
diff --git a/JOBS/monitor_prod_kiel.ksh b/JOBS/monitor_prod_kiel.ksh
deleted file mode 100755
index cc3e88c..0000000
--- a/JOBS/monitor_prod_kiel.ksh
+++ /dev/null
@@ -1,955 +0,0 @@
-#!/bin/ksh
-set -x
-# This script is intended to be sourced from a main script. Not Stand Alone
-# Basically it runs on the production machine, once the MEAN fields
-# have been computed (monthly, annual) and disposed on the respective
-# CONFIG-CASE-MEAN/YEAR/ directory.
-
-# Each block corresponds to a particular monitoring task. Each block is supposed
-# to be independant from the other (in particular, required file are downloaded
-# via the rapatrie function, which does the job only if necessary.
-
-# The different tasks are performed with the cdftools programs. CDFTOOLS is
-# added to the PATH.
-
-#-------------------------------------------------------------------------------
-# Define some functions to get/put file from/to gaya (can be easily customized)
-
-# rapatrie : Usage: rapatrie remote_file directory local_file
-# if local_file already here do nothing, else mfget it from gaya,
-# directory/remote_file
-rapatrie() { if [ ! -f $3 ] ; then ln -s $HOMEGAYA/$2/$1 $3 ; else echo $3 is already \
- downloaded ; fi ; }
-
-# expatrie : Usage: expatrie local_file directory remote_file
-# put local file on gaya in directory/remote_file
-#
-expatrie() { cp $1 $HOMEGAYA/$2/$3 ; }
-
-# cptoweb : Usage: cptoweb file.mtl
-# rcp the matlab file to the corresponding DATA dir of the website
-#cptoweb() { rcp $1 \
-# apache at meolipc.hmg.inpg.fr:web/DRAKKAR/$CONFIG/$CONFCASE/DATA/ ; }
-cptoweb() { echo dummy cptoweb ; }
-
-# chkfile : Usage: chkfile gaya_file
-# check if a file exists on gaya, return present or absent.
-chkfile() { if [ -f $HOMEGAYA/$1 ] ; then echo present ;\
- else echo absent ; fi ; }
-
-# chkdirg : Usage: chkdirg gaya_directory
-# check the existence of a directory on gaya. Create it if not present
-chkdirg() { if [ ! -d $HOMEGAYA/$1 ] ; then mkdir $HOMEGAYA/$1 ; fi ; }
-
-# chkdirw : Usage: chkdirw web_site_directory
-# check the existence of a dir. on the web site. Create it if not present
-chkdirw() { echo dummy chkdirw ; }
-#chkdirw() { rsh meolipc.hmg.inpg.fr -l apache " if [ ! -d web/DRAKKAR/$1 ] ; \
-# then mkdir web/DRAKKAR/$1 ; fi " ; }
-
-# chkdir : Usage: chkdir local_dir
-# check the existence of a directory. Create it if not present
-chkdir() { if [ ! -d $1 ] ; then mkdir $1 ; fi ; }
-
-#------------------------------------------------------------------------------
-# directory name frequently used:
-#------------------------------------------------------------------------------
- # on gaya
- MEANY=$CONFIG/${CONFCASE}-MEAN/$YEAR
- SDIRY=$CONFIG/${CONFCASE}-S/$YEAR
- DIAGS=${CONFIG}/${CONFCASE}-DIAGS
- MONITOR=${CONFIG}/${CONFCASE}-MONITORTEST
- IDIR=$CONFIG/${CONFIG}-I
-
- # on zahir
- P_CTL=$HOME/RUN_${CONFIG}/${CONFCASE}/CTL
-
- # check existence of some required directories
- # ... on gaya
- chkdirg $MONITOR
- chkdirg $DIAGS
-
- # ... on the web site
- chkdirw $CONFIG/
- chkdirw $CONFIG/$CONFCASE
- chkdirw $CONFIG/$CONFCASE/DATA/
-
-#------------------------------------------------------------------------------
-# PATH:
-#-----------------------------------------------------------------------------
- export PATH=$CDFTOOLS/:$PATH
-
-# check if required cdftools are available, exit if missing
- err=0
- for cdfprog in cdfeke cdfmean cdfrmsssh cdfstdevw cdficediags cdftransportiz_noheat\
- cdfmhst cdfhflx cdfmoc cdfmaxmoc cdfpsi cdfsigtrp cdfmxl \
- cdfzonalmean cdfzonalsum cdfzonalout bimgmoy4 bimgcaltrans ; do
- if [ ! -x $CDFTOOLS/$cdfprog ] ; then
- err=$(( err + 1 ))
- echo $cdfprog executable missing. Check your $CDFTOOLS installation
- fi
- done
-
- if [ $err != 0 ] ; then
- echo " monitoring cannot be performed, sorry !" ; exit 1
- fi
-#=============================================================================
-# PART I: Derived quantities, to be added to the -MEAN/YEAR directory
-#=============================================================================
-
-# EKE : Eddy Kinetic Energy: Input files gridU, gridV gridU2, gridV2
-#^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $EKE == 1 ] ; then
- # retrieve U and V ANNUAL mean files and squared mean
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc
-
- # retrieve a T file needed for headers only (EKE is computed on the T-point)
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
-
- cdfeke ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridU2.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridV2.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
-
- # dispose file on the MEAN directory
- expatrie eke.nc $MEANY ${CONFCASE}_y${YEAR}_EKE.nc
- \rm eke.nc
- fi
-
-
-# RMS SSH and StdDev W : Input files : gridT, gridT2 gridW, gridW2
-#^^^^^^^^^^^^^^^^^^^^^^^
- if [ $RMSSSH == 1 ] ; then
- # RMSSSH :get gridT gridT2
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
- cdfrmsssh ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridT2.nc
-
- # dispose file on the MEAN directory
- expatrie rms.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_RMSSSH.nc
- \rm rms.nc
-
- # StdDev W :get gridW and gridW2 files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc
-
- cdfstdevw ${CONFCASE}_y${YEAR}_ANNUAL_gridW.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridW2.nc
-
- # dispose file on the MEAN directory
- expatrie rmsw.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_STDEVW.nc
- \rm rmsw.nc
- fi
-
-# Barotropic Transport: Input file: gridU, gridV mesh mask
-#^^^^^^^^^^^^^^^^^^^^^
- if [ $BSF == 1 ] ; then
- # get gridU gridV files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- cdfpsi ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- # dispose and rename on the MEAN directory
- expatrie psi.nc $MEANY ${CONFCASE}_y${YEAR}_PSI.nc
- fi
-
-# MOC Meridional Overturning Circulation: Input file: gridV, mesh mask, mask_glo
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MOC == 1 ] ; then
- # get gridV files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- # get mesh mask files + new_maskglo
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
- rapatrie new_maskglo.nc $IDIR new_maskglo.nc
-
- cdfmoc ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- # dispose on gaya MEAN/YEAR directory
- expatrie moc.nc $MEANY ${CONFCASE}_y${YEAR}_MOC.nc
- fi
-
-# Mixed Layer Diagnostics : Input file : gridT for month 03 and 09 mesh_hgr, mesh_zgr
-#^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MXL == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- for m in 3 9 ; do
- f=${CONFCASE}_y${YEAR}m0${m}_gridT.nc
- g=$(echo $f | sed -e 's/gridT/MXL/')
-
- rapatrie $f $MEANY $f
-
- cdfmxl $f
-
- # dispose on gaya, MEAN/YEAR directory
- expatrie mxl.nc $MEANY $g
- done
- fi
-
-#=============================================================================
-# PART II: Time series: compute some integral quantities relevant for monitor
-# the ocean variability, and the behaviour of the on going run.
-# Output is basically a small ASCII file, from which a matlab
-# suitable input file (.mtl) is derived.
-#=============================================================================
-# Global MEANS: T S SSH Input files: gridT , mesh_hgr, mesh_zgr, mask
-#^^^^^^^^^^^^^^
- if [ $TSMEAN == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # get gridT files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
-
- # set header on the output file (ASCII)
- fsshmean=${CONFCASE}_y${YEAR}_SSHMEAN.txt
- ftmean=${CONFCASE}_y${YEAR}_TMEAN.txt
- fsmean=${CONFCASE}_y${YEAR}_SMEAN.txt
- echo $YEAR > $fsshmean ; echo $YEAR > $ftmean ; echo $YEAR > $fsmean
-
- # 3D means
- cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc sossheig T >> $fsshmean
- cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc votemper T >> $ftmean
- cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc vosaline T >> $fsmean
-
- # dispose ASCII file in the -DIAGS directory
- expatrie $fsshmean $DIAGS $fsshmean
- expatrie $ftmean $DIAGS $ftmean
- expatrie $fsmean $DIAGS $fsmean
-
-#### Append corresponding line to the matlab files. If it does not exists, create it with header
- # TMEAN
- if [ $(chkfile $MONITOR/${CONFCASE}_TMEAN.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_TMEAN.mtl $MONITOR ${CONFCASE}_TMEAN.mtl
- else
- # first time : header
- dep=$( cat $ftmean | grep -e 'Mean value at level' | awk '{ printf "%10.1f" , $7 }' )
- echo 0000 0000 0000 $dep > ${CONFCASE}_TMEAN.mtl
- fi
- year=$( head -1 $ftmean )
- mean=$( cat $ftmean | grep -e 'over' | awk '{ printf "%10.4f" , $6 }' )
- tem=$( cat $ftmean | grep -e 'Mean value at level' | awk '{ printf "%10.4f" , $9 }' )
- sshmean=$( cat $fsshmean | grep ocean | awk '{ printf " %8.4f " , $6 }' )
-
- echo $year $sshmean $mean $tem >> ${CONFCASE}_TMEAN.mtl
- expatrie ${CONFCASE}_TMEAN.mtl $MONITOR ${CONFCASE}_TMEAN.mtl
-
- # SMEAN
- if [ $(chkfile $MONITOR/${CONFCASE}_SMEAN.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_SMEAN.mtl $MONITOR ${CONFCASE}_SMEAN.mtl
- else
- # first time
- dep=$( cat $fsmean | grep -e 'Mean value at level' | awk '{ printf "%10.1f" , $7 }' )
- echo 0000 0000 0000 $dep > ${CONFCASE}_SMEAN.mtl
- fi
- year=$( head -1 $fsmean )
- mean=$( cat $fsmean | grep -e 'over' | awk '{ printf "%10.4f" , $6 }' )
- sal=$( cat $fsmean | grep -e 'Mean value at level' | awk '{ printf "%10.4f" , $9 }' )
-
- echo $year $sshmean $mean $sal >> ${CONFCASE}_SMEAN.mtl
- expatrie ${CONFCASE}_SMEAN.mtl $MONITOR ${CONFCASE}_SMEAN.mtl
-
-#### cp to web site
- cptoweb ${CONFCASE}_TMEAN.mtl
- cptoweb ${CONFCASE}_SMEAN.mtl
-
- # clean up a little bit
- \rm ${CONFCASE}_[TS]MEAN.mtl
- fi
-
-
-# Ice Volume area and extent for m02 m03 m08 m09: input file : icemod, and mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $ICE == 1 ] ; then
- # get icemod file for the month 02 03 and 08 09
- rapatrie ${CONFCASE}_y${YEAR}m02_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m02_icemod.nc
- rapatrie ${CONFCASE}_y${YEAR}m03_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m03_icemod.nc
- rapatrie ${CONFCASE}_y${YEAR}m08_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m08_icemod.nc
- rapatrie ${CONFCASE}_y${YEAR}m09_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m09_icemod.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii output file:
- fice=${CONFCASE}_y${YEAR}_ice.txt
-
- echo '###' $YEAR 02 > $fice
- cdficediags ${CONFCASE}_y${YEAR}m02_icemod.nc >> $fice
- echo '###' $YEAR 03 >> $fice
- cdficediags ${CONFCASE}_y${YEAR}m03_icemod.nc >> $fice
- echo '###' $YEAR 08 >> $fice
- cdficediags ${CONFCASE}_y${YEAR}m08_icemod.nc >> $fice
- echo '###' $YEAR 09 >> $fice
- cdficediags ${CONFCASE}_y${YEAR}m09_icemod.nc >> $fice
-
- expatrie $fice $DIAGS $fice
-
-#### Append corresponding lines to matlab file for time series
- #ice
- month='02 03 08 09 '
- if [ $(chkfile $MONITOR/${CONFCASE}_ice.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_ice.mtl $MONITOR ${CONFCASE}_ice.mtl
- else
- # first time: create file and add header
- echo 0000 $month $month $month $month $month $month > ${CONFCASE}_ice.mtl
- fi
-
- year=$( head -1 $fice | awk '{ print $2}' )
- nvol=$( cat $fice | grep -e 'NVolume' | grep -v NVolumet | awk '{ printf "%.0f ", $4}' )
- svol=$( cat $fice | grep -e 'SVolume' | grep -v SVolumet | awk '{ printf "%.0f ", $4}' )
- narea=$( cat $fice | grep -e 'NArea' | awk '{ printf "%.0f ", $4}' )
- sarea=$( cat $fice | grep -e 'SArea' | awk '{ printf "%.0f ", $4}' )
- nextent=$( cat $fice | grep -e 'NExtend' | awk '{ printf "%.0f ", $4}' )
- sextent=$( cat $fice | grep -e 'SExtend' | awk '{ printf "%.0f ", $4}' )
-
- echo $year $nvol $svol $narea $sarea $nextent $sextent >> ${CONFCASE}_ice.mtl
-
- expatrie ${CONFCASE}_ice.mtl $MONITOR ${CONFCASE}_ice.mtl
-
-#### cp to web site
- cptoweb ${CONFCASE}_ice.mtl
-
- # clean up a little bit
- \rm ${CONFCASE}_ice.mtl
- fi
-
-# Ice Volume area and extent for all months: input file : icemod, and mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $ICEMONTH == 1 ] ; then
- # get icemod files
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- rapatrie ${CONFCASE}_y${YEAR}m${mm}_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m${mm}_icemod.nc
- m=$(( m + 1 ))
- done
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii output file:
- fice=${CONFCASE}_y${YEAR}_icemonth.txt
-
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- case $mm in
- 01) echo '###' $YEAR $mm > $fice ;;
- *) echo '###' $YEAR $mm >> $fice ;;
- esac
- cdficediags ${CONFCASE}_y${YEAR}m${mm}_icemod.nc >> $fice
- m=$(( m + 1 ))
- done
-
- expatrie $fice $DIAGS $fice
-
-#### Append corresponding lines to matlab file for time series
- #ice
- month='01 02 03 04 05 06 07 08 09 10 11'
- if [ $(chkfile $MONITOR/${CONFCASE}_icemonth.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_icemonth.mtl $MONITOR ${CONFCASE}_icemonth.mtl
- else
- # first time: create file and add header
- echo 0000 $month $month $month $month $month $month > ${CONFCASE}_icemonth.mtl
- fi
-
- year=$( head -1 $fice | awk '{ print $2}' )
- nvol=$( cat $fice | grep -e 'NVolume' | grep -v NVolumet | awk '{ printf "%.0f ", $4}' )
- svol=$( cat $fice | grep -e 'SVolume' | grep -v SVolumet | awk '{ printf "%.0f ", $4}' )
- narea=$( cat $fice | grep -e 'NArea' | awk '{ printf "%.0f ", $4}' )
- sarea=$( cat $fice | grep -e 'SArea' | awk '{ printf "%.0f ", $4}' )
- nextent=$( cat $fice | grep -e 'NExtend' | awk '{ printf "%.0f ", $4}' )
- sextent=$( cat $fice | grep -e 'SExtend' | awk '{ printf "%.0f ", $4}' )
-
- echo $year $nvol $svol $narea $sarea $nextent $sextent >> ${CONFCASE}_icemonth.mtl
-
- expatrie ${CONFCASE}_icemonth.mtl $MONITOR ${CONFCASE}_icemonth.mtl
-
-#### cp to web site
- cptoweb ${CONFCASE}_icemonth.mtl
-
- # clean up a little bit
- \rm ${CONFCASE}_icemonth.mtl
- fi
-
-# Vertical T-S profiles off the coast of Portugal for Gib monitoring: input file: gridT, mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $GIB == 1 ] ; then
- # get gridT file
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii output files:
- ftgib=${CONFCASE}_y${YEAR}_TGIB.txt
- fsgib=${CONFCASE}_y${YEAR}_SGIB.txt
-
- echo $YEAR > $ftgib
- cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc votemper T $GIBWIN 0 0 >> $ftgib
- echo $YEAR > $fsgib
- cdfmean ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc vosaline T $GIBWIN 0 0 >> $fsgib
-
- expatrie $ftgib $DIAGS $ftgib
- expatrie $fsgib $DIAGS $fsgib
-
-#### Append corresponding lines to matlab file for time series
- #GIB
- if [ $(chkfile $MONITOR/${CONFCASE}_gib.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_gib.mtl $MONITOR ${CONFCASE}_gib.mtl
- else
- # first time : Create header with Levitus equivalent
- # requires LEVITUS 'same' diags (from the ANNUAL mean )
- levitus=Levitus_p2.1_ANNUAL_TS_masked_$( echo $CONFIG | tr 'A-Z' 'a-z').nc
- rapatrie $levitus $IDIR $levitus
- cdfmean $levitus votemper T $GIBWIN 0 0 > LEVITUS_y0000_TGIB.txt
- cdfmean $levitus vosaline T $GIBWIN 0 0 > LEVITUS_y0000_SGIB.txt
- expatrie LEVITUS_y0000_TGIB.txt $DIAGS LEVITUS_y0000_TGIB.txt
- expatrie LEVITUS_y0000_SGIB.txt $DIAGS LEVITUS_y0000_SGIB.txt
-
- dep=$( cat LEVITUS_y0000_TGIB.txt | grep 'Mean value at level' | awk '{ printf "%8.1f",$7 }' )
- Tlev=$( cat LEVITUS_y0000_TGIB.txt | grep 'Mean value at level' | awk '{ printf "%8.4f", $9 }' )
- Slev=$( cat LEVITUS_y0000_SGIB.txt | grep 'Mean value at level' | awk '{ printf "%8.4f", $9 }' )
-
- echo 0000 $dep > ${CONFCASE}_gib.mtl
- echo 0000 $Tlev >> ${CONFCASE}_gib.mtl
- echo 0000 $Slev >> ${CONFCASE}_gib.mtl
- fi
-
- year=$( head -1 $ftgib )
- Tcur=$( cat $ftgib | grep 'Mean value at level' | awk '{ printf "%8.4f", $9 }' )
- Scur=$( cat $fsgib | grep 'Mean value at level' | awk '{ printf "%8.4f", $9 }' )
- echo $year $Tcur >> ${CONFCASE}_gib.mtl
- echo $year $Scur >> ${CONFCASE}_gib.mtl
-
- expatrie ${CONFCASE}_gib.mtl $MONITOR ${CONFCASE}_gib.mtl
-
-#### cp to web site
- cptoweb ${CONFCASE}_gib.mtl
-
- # clean up a little bit
- \rm ${CONFCASE}_gib.mtl
- fi
-
-# El nino indexes : Input files : monthly gridT, mesh mask
-#^^^^^^^^^^^^^^^^^^
- if [ $ELNINO == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii outputfile
- fnino=${CONFCASE}_y${YEAR}_NINO.txt
-
- # get monthly mean gridT files and compute mean SST on each NINO box
- for m in 1 2 3 4 5 6 7 8 9 10 11 12 ; do
- mm=$(printf "%02d" $m)
- f=${CONFCASE}_y${YEAR}m${mm}_gridT.nc
-
- rapatrie $f $MEANY $f
-
- # header
- printf "%04d %02d" $YEAR $m >> $fnino
-
- # nino 1+2 [ -90 W -- -80 W, -10 S -- 10 N ]
- cdfmean $f votemper T $NINO12 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> $fnino
- # nino 3 [ -150 W -- -90 W, -5 S -- 5 N ]
- cdfmean $f votemper T $NINO3 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> $fnino
- # nino 4 [ -200 W -- -150 W, -5 S -- 5 N ]
- cdfmean $f votemper T $NINO4 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> $fnino
- # nino 3.4 [ -170 W -- -120 W, -% S -- % N ]
- cdfmean $f votemper T $NINO34 1 1 | tail -1 | awk '{ printf " %8.5f 0.00\n", $6 }' >> $fnino
-
- \rm $f
- done
-
- expatrie $fnino $DIAGS $fnino
-
-#### Append corresponding lines to matlab file for time series
- #NINO
- if [ $(chkfile $MONITOR/${CONFCASE}_nino.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_nino.mtl $MONITOR ${CONFCASE}_nino.mtl
- fi
-
- cat $fnino >> ${CONFCASE}_nino.mtl
- expatrie ${CONFCASE}_nino.mtl $MONITOR ${CONFCASE}_nino.mtl
-
-#### cp to web site
- cptoweb ${CONFCASE}_nino.mtl
-
- # clean up a little bit
- \rm ${CONFCASE}_nino.mtl
- fi
-
-# Transport: Input files: VT, gridU, gridV, mesh mask, section.dat
-#^^^^^^^^^^^
- if [ $TRP == 1 ] ; then
- # section.dat describes the position (I,J) of the sections to monitor
- cp $P_CTL/section.dat .
-
- # get VT , gridU, gridV files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii output file:
- fsection=${CONFCASE}_y${YEAR}_section_monitor.txt
-
- echo $YEAR > $fsection
-
- cdftransportiz_noheat ${CONFCASE}_y${YEAR}_ANNUAL_gridU.nc \
- ${CONFCASE}_y${YEAR}_ANNUAL_gridV.nc < section.dat >> $fsection
-
- # eliminate garbage from txt file ...
- grep -v Give $fsection | grep -v level | grep -v IMAX | grep -v FROM > tmp
- mv -f tmp $fsection
-
- expatrie $fsection $DIAGS $fsection
-
-#### Append corresponding lines to matlab file for time series
- #sections
- if [ $(chkfile $MONITOR/${CONFCASE}_matrix.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_matrix.mtl $MONITOR ${CONFCASE}_matrix.mtl
- fi
-
- year=$( head -1 $fsection )
- mass=$( cat $fsection | grep Mass | awk '{ printf "%8.3f" , $4 }' )
- heat=$( cat $fsection | grep Heat | awk '{ printf "%8.3f" , $4 }' )
- salt=$( cat $fsection | grep Salt | awk '{ printf "%8.1f" , $4 *1. }' )
-
- echo $year $mass $heat $salt >> ${CONFCASE}_matrix.mtl
- # JMM remark: previous monitoring added sshmean, tmean smean at the end of the
- # line but it is not used in the matlab script so I skip it
-
- expatrie ${CONFCASE}_matrix.mtl $MONITOR ${CONFCASE}_matrix.mtl
-
-#### cp to web site
- cptoweb ${CONFCASE}_matrix.mtl
-
- # clean up a little bit
- \rm ${CONFCASE}_matrix.mtl
- fi
-
-# Heat and Salt Meridional Transport : Input files : VT, mesh mask, new_maskglo
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MHT == 1 ] ; then
-# (a) From advection:
-#--------------------
- # get VT files
- rapatrie ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc $MEANY ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
-
- # get mesh mask files + new_maskglo
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
- rapatrie new_maskglo.nc $IDIR new_maskglo.nc
-
- # Ascii output file:
- fheat=${CONFCASE}_y${YEAR}_heattrp.dat
- fsalt=${CONFCASE}_y${YEAR}_salttrp.dat
-
- cdfmhst ${CONFCASE}_y${YEAR}_ANNUAL_VT.nc
-
- expatrie zonal_heat_trp.dat $DIAGS ${CONFCASE}_y${YEAR}_heattrp.dat
- expatrie zonal_salt_trp.dat $DIAGS ${CONFCASE}_y${YEAR}_salttrp.dat
-
- # needed below with the correct name
- cp zonal_heat_trp.dat ${CONFCASE}_y${YEAR}_heattrp.dat
-
-# (b) from Surface Heat fluxes
-#-----------------------------
- cdfhflx ${CONFCASE}_y${YEAR}_ANNUAL_gridT.nc
-
- expatrie hflx.out $DIAGS ${CONFCASE}_y${YEAR}_hflx.dat
-
-#### Append corresponding lines to matlab file for time series
- # Heat/salt transport
- if [ $(chkfile $MONITOR/${CONFCASE}_heat.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_heat.mtl $MONITOR ${CONFCASE}_heat.mtl
- else
- # first time
- # output latitude (North to South) on the first row
- printf "%04d " 0000 > ${CONFCASE}_heat.mtl
- cat zonal_heat_trp.dat |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $2} \
- }\
- END{ printf "\n" }' >> ${CONFCASE}_heat.mtl
- fi
-
- # Global Ocean
- printf "%04d " $YEAR >> ${CONFCASE}_heat.mtl
- cat zonal_heat_trp.dat |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $3} \
- }\
- END{ printf "\n" }' >> ${CONFCASE}_heat.mtl
-
- printf "%04d " $YEAR >> ${CONFCASE}_heat.mtl
- cat hflx.out |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $3} \
- }\
- END{ printf "\n" }' >> ${CONFCASE}_heat.mtl
-
- # Atlantic Ocean
- printf "%04d " $YEAR >> ${CONFCASE}_heat.mtl
- cat zonal_heat_trp.dat |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $4} \
- }\
- END{ printf "\n" }' >> ${CONFCASE}_heat.mtl
-
- printf "%04d " $YEAR >> ${CONFCASE}_heat.mtl
- cat hflx.out |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $4} \
- }\
- END{ printf "\n" }' >> ${CONFCASE}_heat.mtl
-
- # Indo-Pacific Ocean
- printf "%04d " $YEAR >> ${CONFCASE}_heat.mtl
- cat zonal_heat_trp.dat |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $5 + $6 } \
- }\
- END{ printf "\n" }' >> ${CONFCASE}_heat.mtl
-
- printf "%04d " $YEAR >> ${CONFCASE}_heat.mtl
- cat hflx.out |\
- awk 'BEGIN{s=0} \
- { if (NR > 2) {printf " %8.3f ", $5 } \
- }\
- END{ printf "\n" }' >> ${CONFCASE}_heat.mtl
-
- expatrie ${CONFCASE}_heat.mtl $MONITOR ${CONFCASE}_heat.mtl
-
-#### cp to website
- cptoweb ${CONFCASE}_heat.mtl
-
- # clean
- \rm ${CONFCASE}_heat.mtl
- fi
-
-
-# MAX and MIN of MOC: requires that MOC files already exists
-#^^^^^^^^^^^^^^^^^^^^
- if [ $MAXMOC == 1 ] ; then
- f=moc.nc
- rapatrie ${CONFCASE}_y${YEAR}_MOC.nc $DIAGS $f
-
- # Ascii output file
- fmaxmoc=${CONFCASE}_y${YEAR}_minmaxmoc.txt
- echo $YEAR > $fmaxmoc
- # GLO
- printf "%s" 'Glo ' >> $fmaxmoc ; cdfmaxmoc $f glo 20 60 500 2000 | grep Maximum >> $fmaxmoc
- printf "%s" 'Glo ' >> $fmaxmoc ; cdfmaxmoc $f glo -40 30 2000 5500 | grep Minimum >> $fmaxmoc
- # ATL
- printf "%s" 'Atl ' >> $fmaxmoc ; cdfmaxmoc $f atl 0 60 500 2000 | grep Maximum >> $fmaxmoc
- printf "%s" 'Atl ' >> $fmaxmoc ; cdfmaxmoc $f atl -20 40 2000 5500 | grep Minimum >> $fmaxmoc
- #INP
- printf "%s" 'Inp ' >> $fmaxmoc ; cdfmaxmoc $f inp 15 50 100 1000 | grep Minimum >> $fmaxmoc
- printf "%s" 'Inp ' >> $fmaxmoc ; cdfmaxmoc $f inp -30 20 1000 5500 | grep Minimum >> $fmaxmoc
- #AUS
- printf "%s" 'Aus ' >> $fmaxmoc ; cdfmaxmoc $f glo -70 0 0 2000 | grep Maximum >> $fmaxmoc
- printf "%s" 'Aus ' >> $fmaxmoc ; cdfmaxmoc $f glo -70 0 2000 5500 | grep Minimum >> $fmaxmoc
-
- expatrie $fmaxmoc $DIAGS $fmaxmoc
-
- # Max and Min of MOC at some specific latitudes
- fmaxmoc40=${CONFIG}-${CASE}_y${YEAR}_maxmoc40.txt
-
- echo $YEAR > $fmaxmoc40
- # GLO MAX at 40 N and 30S
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo 40 40 500 2000 | grep Maximum >> $fmaxmoc40
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo -30 -30 500 5500 | grep Maximum >> $fmaxmoc40
- # ATL MAX at 40N and 30S
- printf "%s" 'Atl ' >> $fmaxmoc40 ; cdfmaxmoc $f atl 40 40 500 2000 | grep Maximum >> $fmaxmoc40
- printf "%s" 'Atl ' >> $fmaxmoc40 ; cdfmaxmoc $f atl -30 -30 500 5000 | grep Maximum >> $fmaxmoc40
- #INP Min at 30 S
- printf "%s" 'Inp ' >> $fmaxmoc40 ; cdfmaxmoc $f inp -30 -30 1000 5500 | grep Minimum >> $fmaxmoc40
- #AUS MAX at 50 S
- printf "%s" 'Aus ' >> $fmaxmoc40 ; cdfmaxmoc $f glo -50 -50 0 2000 | grep Maximum >> $fmaxmoc40
-
- expatrie $fmaxmoc40 $DIAGS $fmaxmoc40
-
-#### Append to matlab file
- # maxmoc
- if [ $(chkfile $MONITOR/${CONFCASE}_maxmoc.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_maxmoc.mtl $MONITOR ${CONFCASE}_maxmoc.mtl
- fi
-
- year=$( head -1 $fmaxmoc )
- mht=${CONFCASE}_y${YEAR}_heattrp.dat
- # get mht file if necessary
- rapatrie $mht $DIAGS $mht
-
- # GLO
- maxglo=$( cat $fmaxmoc | grep -e '^Glo' | grep Max | awk '{ printf "%8.3f" , $3 }' )
- minglo=$( cat $fmaxmoc | grep -e '^Glo' | grep Min | awk '{ printf "%8.3f" , $3 }' )
-
- # ATL
- maxatl=$( cat $fmaxmoc | grep -e '^Atl' | grep Max | awk '{ printf "%8.3f" , $3 }' )
- minatl=$( cat $fmaxmoc | grep -e '^Atl' | grep Min | awk '{ printf "%8.3f" , $3 }' )
-
- # INP : attention we have 2 Minimum for INP mininp1 and mininp2
- tmp=$( cat $fmaxmoc | grep -e '^Inp' | grep Min | awk '{ printf "%8.3f" , $3 }' )
- mininp1=$( echo $tmp | awk '{print $1}' )
- mininp2=$( echo $tmp | awk '{print $2}' )
-
- # AUS
- maxaus=$( cat $fmaxmoc | grep -e '^Aus' | grep Max | awk '{ printf "%8.3f" , $3 }' )
- minaus=$( cat $fmaxmoc | grep -e '^Aus' | grep Min | awk '{ printf "%8.3f" , $3 }' )
-
- # heattrp at 20 N
- heattrp=$( cat $mht | awk '{ if ( $2 >= 20 ) { atlmht=$4 ; glomht=$3 } } END { printf "%6.3f %6.3f ", glomht, atlmht }')
- mhtglo=$( echo $heattrp | awk '{print $1}' )
- mhtatl=$( echo $heattrp | awk '{print $2}' )
-
-
- echo $year $maxglo $minglo $mhtglo $maxatl $minatl $mhtatl $mininp1 $mininp2 0000 \
- $maxaus $minaus 0000 >> ${CONFCASE}_maxmoc.mtl
-
- expatrie ${CONFCASE}_maxmoc.mtl $MONITOR ${CONFCASE}_maxmoc.mtl
-
-#### send it to web site
- cptoweb ${CONFCASE}_maxmoc.mtl
-
- #maxmoc40
- if [ $(chkfile $MONITOR/${CONFCASE}_maxmoc40.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_maxmoc40.mtl $MONITOR ${CONFCASE}_maxmoc40.mtl
- fi
-
- year=$( head -1 $fmaxmoc40 )
-
- # GLO max a 40 et -30
- tmp=$( cat $fmaxmoc40 | grep -e '^Glo' | grep Max | awk '{ printf "%8.3f" , $3 }' )
- maxglo40n=$( echo $tmp | awk '{print $1}' )
- maxglo30s=$( echo $tmp | awk '{print $2}' )
-
- # ATL max a 40 et -30
- tmp=$( cat $fmaxmoc40 | grep -e '^Atl' | grep Max | awk '{ printf "%8.3f" , $3 }' )
- maxatl40n=$( echo $tmp | awk '{print $1}' )
- maxatl30s=$( echo $tmp | awk '{print $2}' )
-
- # INP : 1 Min at -30 S
- mininp30s=$( cat $fmaxmoc40 | grep -e '^Inp' | grep Min | awk '{ printf "%8.3f" , $3 }' )
-
- # AUS 1 max at -50 S
- maxaus50s=$( cat $fmaxmoc40 | grep -e '^Aus' | grep Max | awk '{ printf "%8.3f" , $3 }' )
-
- echo $year $maxglo40n $maxglo30s $maxatl40n $maxatl30s $mininp30s $maxaus50s >> ${CONFCASE}_maxmoc40.mtl
-
- expatrie ${CONFCASE}_maxmoc40.mtl $MONITOR ${CONFCASE}_maxmoc40.mtl
-
-#### send it to web site
- cptoweb ${CONFCASE}_maxmoc40.mtl
- fi
-
-
-# DCT :Density Class transport: Input files : gridT, gridU gridV, mesh mask, dens_section.dat
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $DCT == 1 ] ; then
- # dens_section.dat describe the sections (either zonal or meridional) where the DCT is computed
- cp $P_CTL/dens_section.dat .
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Required post_processing script: DCT are computed on monthly means, then average is performed
- # for annual values. This process is still done through temporary bimg/dimg files (remnant of the
- # old Clipper times). By the way, 2 bimgtools are required: bimgmoy4 and bimgcaltrans
- # In-lining of this script may be confusing. I leave it as an external module.
- cp $CDFTOOLS/JOBS/trpsig_postproc.ksh ./
-
- # due to the large amount of files that are produced by this diags, we prefer to keep them
- # on a separate directory
- chkdirg ${CONFIG}/${CONFCASE}-TRPSIG/
- chkdirg ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
- chkdirg $DIAGS/$YEAR/
- chkdirg $DIAGS/TRPSIG/
-
- # also need temporary directories in the actual tmpdir:
- chkdir ${CONFIG}
- chkdir ${CONFIG}/${CONFCASE}-TRPSIG
- chkdir ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
-
- TRPSIGY=${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
-
- for m in 1 2 3 4 5 6 7 8 9 10 11 12 ; do
- mm=$(printf "%02d" $m)
- tfich=${CONFCASE}_y${YEAR}m${mm}_gridT.nc
- ufich=$(echo $tfich | sed -e 's/gridT/gridU/' )
- vfich=$(echo $tfich | sed -e 's/gridT/gridV/' )
-
- #get files on gaya
- rapatrie $tfich $MEANY $tfich
- rapatrie $ufich $MEANY $ufich
- rapatrie $vfich $MEANY $vfich
-
- #retrieve tag time from file name
- tag=$(echo $tfich | sed -e "s/${CONFCASE}_//" -e 's/_gridT.nc//')
-
- echo $tag > ${CONFCASE}_y${tag}_trpsig_monitor.lst
-
- cdfsigtrp $tfich $ufich $vfich 21 30 180 -bimg -print >> ${CONFCASE}_y${tag}_trpsig_monitor.lst
-
- # save the monthly log file on gaya for an (improbable) eventual post processing ...
- expatrie ${CONFCASE}_y${tag}_trpsig_monitor.lst $TRPSIGY ${CONFCASE}_y${tag}_trpsig_monitor.lst
- # and create a mirror on the local tmpdir
- mv ${CONFCASE}_y${tag}_trpsig_monitor.lst $TRPSIGY
-
- # Idem : save temporary bimg files on gaya and create local mirror
- for b in *bimg ; do
- mv $b ${CONFCASE}_y${tag}_$b
- expatrie ${CONFCASE}_y${tag}_$b $TRPSIGY ${CONFCASE}_y${tag}_$b
- mv ${CONFCASE}_y${tag}_$b $TRPSIGY
- done
-
- # Idem: for txt files
- mv trpsig.txt ${CONFCASE}_y${tag}_trpsig.txt
- expatrie ${CONFCASE}_y${tag}_trpsig.txt $TRPSIGY ${CONFCASE}_y${tag}_trpsig.txt
- mv ${CONFCASE}_y${tag}_trpsig.txt $TRPSIGY
-
- # erase useless files ( monthly averages ) Keep tfich which can be used for MXL
- \rm *.bimg $ufich $vfich
-
- # end of month loop
- done
-
- # Launch post processing ( by itself a complex script ...)
- # This script retrieve CONFIG name and CASE from the directory name where it runs...
- cd ${CONFIG}/${CONFCASE}-TRPSIG
- $TMPDIR/trpsig_postproc.ksh
- cd $TMPDIR
-
- # save results on gaya ( as many files as sections in dens_section.dat)
- for f in ${CONFCASE}_y*_trpsig.txt ; do
- expatrie $f $DIAGS/TRPSIG/ $f
- done
-
-#### Append results to mtl file for denmark strait and faroes bank channel
- #trpsig
-
- # mini and maxi of sigma0
- mini=25.2 ; maxi=28.5 # selected range convenient for DS and FBC
- file=${CONFCASE}_y${YEAR}_01_Denmark_strait_trpsig.txt
- fil2=$( echo $file | sed -e 's/01_Denmark_strait/02_Faoes_Bank_Channel/' )
-
- sig=$( cat $file | grep -v -e '^#' | awk '{ if ( $1 > mini && $1 < maxi ) {printf "%8.3f" , $1 } }' mini=$mini maxi=$maxi)
- trp01=$( cat $file | grep -v -e '^#' | awk '{ if ( $1 > mini && $1 < maxi ) {printf "%13.4e" , $2 } }' mini=$mini maxi=$maxi)
- trp02=$( cat $fil2 | grep -v -e '^#' | awk '{ if ( $1 > mini && $1 < maxi ) {printf "%13.4e" , $2 } }' mini=$mini maxi=$maxi)
-
- if [ $(chkfile $MONITOR/${CONFCASE}_TRPSIG.mtl ) == present ] ; then
- rapatrie ${CONFCASE}_TRPSIG.mtl $MONITOR ${CONFCASE}_TRPSIG.mtl
- else
- #first time : add header with sigma classes
- echo 000000 $sig > ${CONFCASE}_TRPSIG.mtl
- fi
- echo $YEAR $trp01 >> ${CONFCASE}_TRPSIG.mtl
- echo $YEAR $trp02 >> ${CONFCASE}_TRPSIG.mtl
-
- expatrie ${CONFCASE}_TRPSIG.mtl $MONITOR ${CONFCASE}_TRPSIG.mtl
-
-#### cp to web site
- cptoweb ${CONFCASE}_TRPSIG.mtl
-
- # return to tmpdir
- cd $TMPDIR
- # Erase the TRPSIG tree for this current year
- \rm -r ${CONFIG} \rm ${CONFCASE}_y*_trpsig.txt *.mtl
-
- fi
-
-# TRACER DIAGS (31/12 of each year) : Input files : ptrcT, mesh mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $TRACER == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
- rapatrie new_maskglo.nc $IDIR new_maskglo.nc
-
- # get tracer file from gaya: note that this is from -S dir (5 day average ... to discuss ...)
- rapatrie ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc $SDIRY ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc
-
- # Ascii output file:
- ftrc=${CONFCASE}_y${YEAR}_TRCmean.dat
-
- # Number of mol in the ocean ...
- printf "%04d " $YEAR ' ' > $ftrc
-
- # CFC11
- \rm -f tmp1
- cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invcfc T > tmp1
- area=$(cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}')
- mean=$(cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}')
- total=$(echo $mean $area | awk '{print $1 * $2 }' )
- printf "%s " $total >> $ftrc
-
- # B-C14
- \rm -f tmp1
- cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invc14 T > tmp1
- area=$(cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}')
- mean=$(cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}')
- total=$(echo $mean $area | awk '{print $1 * $2 }' )
- printf "%s " $total >> $ftrc
-
- expatrie $ftrc $DIAGS $ftrc
-
- # zonal integral of inventories
- cdfzonalsum ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
- # zonal means
- cdfzonalmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
- # ncks is required on the prod machine ... !! not standard !!
- # it is used to take only the interesting variables from the results
- ncks -F -d deptht,1,1 -v zocfc11_glo,zobc14_glo,nav_lon,nav_lat zonalmean.nc zonalsurf.nc
-
- # put in ascii format the 1D profiles
- cdfzonalout zonalmean.nc > zonalmean.dat
- cdfzonalout zonalsum.nc > zonalsum.dat
- cdfzonalout zonalsurf.nc > zonalsurf.dat
-
- expatrie zonalmean.nc $MEANY ${CONFCASE}_y${YEAR}_TRCzonalmean.nc
- expatrie zonalsum.nc $MEANY ${CONFCASE}_y${YEAR}_TRCzonalsum.nc
-
- expatrie zonalmean.dat $DIAGS ${CONFCASE}_y${YEAR}_TRCzonalmean.dat
- expatrie zonalsum.dat $DIAGS ${CONFCASE}_y${YEAR}_TRCzonalsum.dat
- expatrie zonalsurf.dat $DIAGS ${CONFCASE}_y${YEAR}_TRCzonalsurf.dat
-
-#### append to matlab file
- # Not done already
-
- fi
diff --git a/JOBS/monitor_prod_work.ksh b/JOBS/monitor_prod_work.ksh
deleted file mode 100755
index ad1ddaa..0000000
--- a/JOBS/monitor_prod_work.ksh
+++ /dev/null
@@ -1,765 +0,0 @@
-#!/bin/ksh
-set -x
-# This script is intended to be sourced from a main script. Not Stand Alone
-# Basically it runs on the production machine, once the MEAN fields
-# have been computed (monthly, annual) and disposed on the respective
-# CONFIG-CASE-MEAN/YEAR/ directory.
-
-# Each block corresponds to a particular monitoring task. Each block is supposed
-# to be independant from the other (in particular, required file are downloaded
-# via the rapatrie function, which does the job only if necessary.
-
-# The different tasks are performed with the cdftools programs. CDFTOOLS is
-# added to the PATH.
-
-#-------------------------------------------------------------------------------
-# $Rev: 263 $
-# $Date: 2009-08-08 11:25:10 +0200 (Sat, 08 Aug 2009) $
-# $Id: monitor_prod.ksh 263 2009-08-08 09:25:10Z rcli002 $
-#-------------------------------------------------------------------------------
-# define some config dependent variable
-. ./config_def.ksh # can be a link
-# Define some functions to get/put file from/to gaya (can be easily customized)
-
-. ./function_def.ksh # can be a link
-
-#------------------------------------------------------------------------------
-# directory name frequently used:
-#------------------------------------------------------------------------------
- # on the storage machine : path relative to the root of S-machine
- MEANY=$CONFIG/${CONFCASE}-MEAN/$YEAR
- SDIRY=$CONFIG/${CONFCASE}-S/$YEAR
- DIAGS=${CONFIG}/${CONFCASE}-DIAGS
- IDIR=$CONFIG/${CONFIG}-I
- LOCAL_SAVE=${LOCAL_SAVE:=0}
-
- # on zahir
- P_CTL=$HOME/RUN_${CONFIG}/${CONFCASE}/CTL
-
- # check existence of some required directories
- # ... on gaya
- chkdirg $DIAGS
- chkdirg $DIAGS/TXT # for ASCII diag files (to become obsolete)
- chkdirg $DIAGS/NC # for NetCdf diag files
-
-#------------------------------------------------------------------------------
-# PATH:
-#-----------------------------------------------------------------------------
- export PATH=$CDFTOOLS/:$PATH
-
-# check if required cdftools are available, exit if missing
- err=0
- for cdfprog in cdfeke cdfmean cdfrmsssh cdfstdevw cdficediags cdftransportiz\
- cdfmhst cdfhflx cdfmoc cdfmaxmoc cdfpsi cdfsigtrp cdfmxl \
- cdfzonalmean cdfzonalsum cdfzonalout bimgmoy4 bimgcaltrans ; do
- if [ ! -x $CDFTOOLS/$cdfprog ] ; then
- err=$(( err + 1 ))
- echo $cdfprog executable missing. Check your $CDFTOOLS installation
- fi
- done
-
- if [ $err != 0 ] ; then
- echo " monitoring cannot be performed, sorry !" ; exit 1
- fi
-#=============================================================================
-# PART I: Derived quantities, to be added to the -MEAN/YEAR directory
-#=============================================================================
- # check if we have a NATL config or a ORCA config (to be improved ....)
- atl=$( echo 1 | awk '{ ii=index (config,"NATL") ; print ii }' config=$CONFIG )
-
-# EKE : Eddy Kinetic Energy: Input files gridU, gridV gridU2, gridV2
-#^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $EKE == 1 ] ; then
- # retrieve U and V ANNUAL mean files and squared mean
- rapatrie ${CONFCASE}_y${YEAR}_gridU.nc $MEANY ${CONFCASE}_y${YEAR}_gridU.nc
- rapatrie ${CONFCASE}_y${YEAR}_gridU2.nc $MEANY ${CONFCASE}_y${YEAR}_gridU2.nc
- rapatrie ${CONFCASE}_y${YEAR}_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_gridV.nc
- rapatrie ${CONFCASE}_y${YEAR}_gridV2.nc $MEANY ${CONFCASE}_y${YEAR}_gridV2.nc
-
- # retrieve a T file needed for headers only (EKE is computed on the T-point)
- rapatrie ${CONFCASE}_y${YEAR}_gridT2.nc $MEANY ${CONFCASE}_y${YEAR}_gridT2.nc
-
- cdfeke ${CONFCASE}_y${YEAR}_gridU.nc \
- ${CONFCASE}_y${YEAR}_gridU2.nc \
- ${CONFCASE}_y${YEAR}_gridV.nc \
- ${CONFCASE}_y${YEAR}_gridV2.nc \
- ${CONFCASE}_y${YEAR}_gridT2.nc
-
- # dispose file on the MEAN directory
- expatrie eke.nc $MEANY ${CONFCASE}_y${YEAR}_EKE.nc
- \rm eke.nc
- fi
-
-# RMS SSH and StdDev W : Input files : gridT, gridT2 gridW, gridW2
-#^^^^^^^^^^^^^^^^^^^^^^^
- if [ $RMSSSH == 1 ] ; then
- # RMSSSH :get gridT gridT2
- rapatrie ${CONFCASE}_y${YEAR}_gridT.nc $MEANY ${CONFCASE}_y${YEAR}_gridT.nc
- rapatrie ${CONFCASE}_y${YEAR}_gridT2.nc $MEANY ${CONFCASE}_y${YEAR}_gridT2.nc
- cdfrmsssh ${CONFCASE}_y${YEAR}_gridT.nc ${CONFCASE}_y${YEAR}_gridT2.nc
-
- # dispose file on the MEAN directory
- expatrie rms.nc $MEANY ${CONFCASE}_y${YEAR}_RMSSSH.nc
- \rm rms.nc
-
- # StdDev W :get gridW and gridW2 files
- rapatrie ${CONFCASE}_y${YEAR}_gridW.nc $MEANY ${CONFCASE}_y${YEAR}_gridW.nc
- rapatrie ${CONFCASE}_y${YEAR}_gridW2.nc $MEANY ${CONFCASE}_y${YEAR}_gridW2.nc
-
- cdfstdevw ${CONFCASE}_y${YEAR}_gridW.nc ${CONFCASE}_y${YEAR}_gridW2.nc
-
- # dispose file on the MEAN directory
- expatrie rmsw.nc $MEANY ${CONFCASE}_y${YEAR}_STDEVW.nc
- \rm rmsw.nc
- fi
-
-# Barotropic Transport: Input file: gridU, gridV mesh mask
-#^^^^^^^^^^^^^^^^^^^^^
- if [ $BSF == 1 ] ; then
- # get gridU gridV files
- rapatrie ${CONFCASE}_y${YEAR}_gridU.nc $MEANY ${CONFCASE}_y${YEAR}_gridU.nc
- rapatrie ${CONFCASE}_y${YEAR}_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_gridV.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- cdfpsi ${CONFCASE}_y${YEAR}_gridU.nc ${CONFCASE}_y${YEAR}_gridV.nc
-
- # dispose and rename on the MEAN directory
- expatrie psi.nc $MEANY ${CONFCASE}_y${YEAR}_PSI.nc
- fi
-
-# MOC Meridional Overturning Circulation: Input file: gridV, mesh mask, mask_glo
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MOC == 1 ] ; then
- # get gridV files
- rapatrie ${CONFCASE}_y${YEAR}_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_gridV.nc
-
- # get mesh mask files + new_maskglo
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
- if (( $atl == 0 )) ; then rapatrie new_maskglo.nc $IDIR new_maskglo.nc ; fi
-
- cdfmoc ${CONFCASE}_y${YEAR}_gridV.nc
-
- # dispose on gaya MEAN/YEAR directory
- expatrie moc.nc $MEANY ${CONFCASE}_y${YEAR}_MOC.nc
- fi
-
-# Mixed Layer Diagnostics : Input file : gridT for month 03 and 09 mesh_hgr, mesh_zgr
-#^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MXL == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- for m in 3 9 ; do
- f=${CONFCASE}_y${YEAR}m0${m}_gridT.nc
- g=$(echo $f | sed -e 's/gridT/MXL/')
-
- rapatrie $f $MEANY $f
-
- cdfmxl $f
-
- # dispose on gaya, MEAN/YEAR directory
- expatrie mxl.nc $MEANY $g
- done
- fi
-
-# Large scale potential vorticity for m03 m09: input file : gridT, and mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $LSPV == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- for m in 3 9 ; do
- f=${CONFCASE}_y${YEAR}m0${m}_gridT.nc
- g=$(echo $f | sed -e 's/gridT/LSPV/')
-
- rapatrie $f $MEANY $f
- # compute LSPV
- cdflspv $f
- # dispose on gaya, MEAN/YEAR directory
- expatrie lspv.nc $MEANY $g
- done
- fi
-
-#=============================================================================
-# PART II: Time series: compute some integral quantities relevant for monitor
-# the ocean variability, and the behaviour of the on going run.
-# Output is basically a small ASCII file, from which a matlab
-# suitable input file (.mtl) is derived.
-#=============================================================================
-# Global MEANS: T S SSH Input files: gridT , mesh_hgr, mesh_zgr, mask
-#^^^^^^^^^^^^^^
- if [ $TSMEAN == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # get gridT files
- rapatrie ${CONFCASE}_y${YEAR}_gridT.nc $MEANY ${CONFCASE}_y${YEAR}_gridT.nc
-
- # output file name ascii and nc
- fsshmean=${CONFCASE}_y${YEAR}_SSHMEAN.txt ; fsshmean_nc=${CONFCASE}_y${YEAR}_SSHMEAN.nc
- ftmean=${CONFCASE}_y${YEAR}_TMEAN.txt ; ftmean_nc=${CONFCASE}_y${YEAR}_TMEAN.nc
- fsmean=${CONFCASE}_y${YEAR}_SMEAN.txt ; fsmean_nc=${CONFCASE}_y${YEAR}_SMEAN.nc
- # set header on the output file (ASCII)
- echo $YEAR > $fsshmean ; echo $YEAR > $ftmean ; echo $YEAR > $fsmean
-
- # 3D means
- cdfmean ${CONFCASE}_y${YEAR}_gridT.nc sossheig T >> $fsshmean ; mv cdfmean.nc $fsshmean_nc
- cdfmean ${CONFCASE}_y${YEAR}_gridT.nc votemper T >> $ftmean ; mv cdfmean.nc $ftmean_nc
- cdfmean ${CONFCASE}_y${YEAR}_gridT.nc vosaline T >> $fsmean ; mv cdfmean.nc $fsmean_nc
-
- # dispose ASCII file in the -DIAGS directory
- expatrie $fsshmean $DIAGS/TXT $fsshmean
- expatrie $ftmean $DIAGS/TXT $ftmean
- expatrie $fsmean $DIAGS/TXT $fsmean
-
- # dispose ASCII file in the -DIAGS/NC directory
- expatrie $fsshmean_nc $DIAGS/NC $fsshmean_nc
- expatrie $ftmean_nc $DIAGS/NC $ftmean_nc
- expatrie $fsmean_nc $DIAGS/NC $fsmean_nc
-
- if [ $(chkfile $DIAGS/TXT/LEVITUS_y0000_TMEAN.txt ) == absent ] ; then
- # first time : Create header with Levitus equivalent
- # requires LEVITUS 'same' diags (from the ANNUAL mean )
- # !!! NEW !!!
- # get non-masked levitus then mask it with the same mask as the model
- levitus=${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_$( echo $CONFIG | tr 'A-Z' 'a-z').nc
- rapatrie $levitus $IDIR $levitus
- cdfmltmask $levitus mask.nc votemper T # votemper --> $levitus_masked
- cdfmltmask ${levitus}_masked mask.nc vosaline T # vosaline --> $levitus_masked_masked
- mv ${levitus}_masked_masked ${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_masked_$( echo $CONFIG | tr 'A-Z' 'a-z').nc # simplify name
- levitus=${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_masked_$( echo $CONFIG | tr 'A-Z' 'a-z').nc # will be ready for GIB DIAG
- #
- cdfmean $levitus votemper T > LEVITUS_y0000_TMEAN.txt ; mv cdfmean.nc LEVITUS_y0000_TMEAN.nc
- cdfmean $levitus vosaline T > LEVITUS_y0000_SMEAN.txt ; mv cdfmean.nc LEVITUS_y0000_SMEAN.nc
-
- expatrie LEVITUS_y0000_TMEAN.txt $DIAGS/TXT LEVITUS_y0000_TMEAN.txt
- expatrie LEVITUS_y0000_SMEAN.txt $DIAGS/TXT LEVITUS_y0000_SMEAN.txt
- expatrie LEVITUS_y0000_TMEAN.nc $DIAGS/NC LEVITUS_y0000_TMEAN.nc
- expatrie LEVITUS_y0000_SMEAN.nc $DIAGS/NC LEVITUS_y0000_SMEAN.nc
- fi
- fi
-
-# Ice Volume area and extent for m02 m03 m08 m09: input file : icemod, and mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $ICE == 1 ] ; then
- # get icemod file for the month 02 03 and 08 09
- rapatrie ${CONFCASE}_y${YEAR}m02_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m02_icemod.nc
- rapatrie ${CONFCASE}_y${YEAR}m03_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m03_icemod.nc
- rapatrie ${CONFCASE}_y${YEAR}m08_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m08_icemod.nc
- rapatrie ${CONFCASE}_y${YEAR}m09_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m09_icemod.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii/nc output file:
- fice=${CONFCASE}_y${YEAR}_ice.txt
- fice_nc=${CONFCASE}_y${YEAR}_ice.nc
-
- echo '###' $YEAR 02 > $fice
- cdficediags ${CONFCASE}_y${YEAR}m02_icemod.nc >> $fice ; mv icediags.nc $fice_nc
- echo '###' $YEAR 03 >> $fice
- cdficediags ${CONFCASE}_y${YEAR}m03_icemod.nc >> $fice ; nrcat -A $fice_nc icediags.nc -o $fice_nc
- echo '###' $YEAR 08 >> $fice
- cdficediags ${CONFCASE}_y${YEAR}m08_icemod.nc >> $fice ; nrcat -A $fice_nc icediags.nc -o $fice_nc
- echo '###' $YEAR 09 >> $fice
- cdficediags ${CONFCASE}_y${YEAR}m09_icemod.nc >> $fice ; nrcat -A $fice_nc icediags.nc -o $fice_nc
-
- expatrie $fice $DIAGS/TXT $fice
- expatrie $fice_nc $DIAGS/NC $fice_nc
- fi
-
-# Ice Volume area and extent for all months: input file : icemod, and mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $ICEMONTH == 1 ] ; then
- # get icemod files
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
- rapatrie ${CONFCASE}_y${YEAR}m${mm}_icemod.nc $MEANY ${CONFCASE}_y${YEAR}m${mm}_icemod.nc
- m=$(( m + 1 ))
- done
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii/nc output file:
- fice=${CONFCASE}_y${YEAR}_icemonth.txt
- fice_nc=${CONFCASE}_y${YEAR}_icemonth.nc
-
- m=1
- while (( $m <= 12 )) ; do
- mm=$( printf "%02d" $m )
-
- case $mm in
- 01) echo '###' $YEAR $mm > $fice ;;
- *) echo '###' $YEAR $mm >> $fice ;;
- esac
-
- cdficediags ${CONFCASE}_y${YEAR}m${mm}_icemod.nc cdfout >> $fice ; ncks -A icediags.nc $fice_nc
-
- case $mm in
- 01) mv icediags.nc $fice_nc ;;
- *) ncrcat -A $fice_nc icediags.nc -o $fice_nc ;;
- esac
-
- m=$(( m + 1 ))
- done
-
- expatrie $fice $DIAGS/TXT $fice
- expatrie $fice_nc $DIAGS/NC $fice_nc
-
- fi
-
-# Vertical T-S profiles off the coast of Portugal for Gib monitoring: input file: gridT, mesh_mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $GIB == 1 ] ; then
- # get gridT file
- rapatrie ${CONFCASE}_y${YEAR}_gridT.nc $MEANY ${CONFCASE}_y${YEAR}_gridT.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii output files:
- ftgib=${CONFCASE}_y${YEAR}_TGIB.txt
- fsgib=${CONFCASE}_y${YEAR}_SGIB.txt
- # nc output files
- ftgib_nc=${CONFCASE}_y${YEAR}_TGIB.nc
- fsgib_nc=${CONFCASE}_y${YEAR}_SGIB.nc
-
- echo $YEAR > $ftgib
- cdfmean ${CONFCASE}_y${YEAR}_gridT.nc votemper T $GIBWIN 0 0 >> $ftgib ; mv cdfmean.nc $ftgib_nc
- echo $YEAR > $fsgib
- cdfmean ${CONFCASE}_y${YEAR}_gridT.nc vosaline T $GIBWIN 0 0 >> $fsgib ; mv cdfmean.nc $fsgib_nc
-
- expatrie $ftgib $DIAGS/TXT $ftgib
- expatrie $fsgib $DIAGS/TXT $fsgib
- expatrie $ftgib_nc $DIAGS/NC $ftgib_nc
- expatrie $fsgib_nc $DIAGS/NC $fsgib_nc
-
- if [ $(chkfile $DIAGS/TXT/LEVITUS_y0000_TGIB.txt ) == absent ] ; then
- # first time : Create header with Levitus equivalent
- # requires LEVITUS 'same' diags (from the ANNUAL mean )
- levitus=${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_masked_$( echo $CONFIG | tr 'A-Z' 'a-z').nc
- if [ ! -f $levitus ] ; then
- # need to build a masked LEvitus with proper mask
- levitus=${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_$( echo $CONFIG | tr 'A-Z' 'a-z').nc
- rapatrie $levitus $IDIR $levitus
- cdfmltmask $levitus mask.nc votemper T # votemper --> $levitus_masked
- cdfmltmask ${levitus}_masked mask.nc vosaline T # vosaline --> $levitus_masked_masked
- mv ${levitus}_masked_masked ${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_masked_$( echo $CONFIG | tr 'A-Z' 'a-z').nc # simplify name
- levitus=${TSCLIM:=Levitus_p2.1}_ANNUAL_TS_masked_$( echo $CONFIG | tr 'A-Z' 'a-z').nc # will be ready for GIB DIAG
- fi
- cdfmean $levitus votemper T $GIBWIN 0 0 > LEVITUS_y0000_TGIB.txt ; mv cdfmean.nc LEVITUS_y0000_TGIB.nc
- cdfmean $levitus vosaline T $GIBWIN 0 0 > LEVITUS_y0000_SGIB.txt ; mv cdfmean.nc LEVITUS_y0000_SGIB.nc
- expatrie LEVITUS_y0000_TGIB.txt $DIAGS/TXT LEVITUS_y0000_TGIB.txt
- expatrie LEVITUS_y0000_SGIB.txt $DIAGS/TXT LEVITUS_y0000_SGIB.txt
- expatrie LEVITUS_y0000_TGIB.nc $DIAGS/NC LEVITUS_y0000_TGIB.nc
- expatrie LEVITUS_y0000_SGIB.nc $DIAGS/NC LEVITUS_y0000_SGIB.nc
- fi
- fi
-
-# El nino indexes : Input files : monthly gridT, mesh mask
-#^^^^^^^^^^^^^^^^^^
- if [ $ELNINO == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii outputfile
- fnino=${CONFCASE}_y${YEAR}_NINO.txt
- # nc outputfile
- fnino12_nc=${CONFCASE}_y${YEAR}_NINO12.nc
- fnino3_nc=${CONFCASE}_y${YEAR}_NINO3.nc
- fnino4_nc=${CONFCASE}_y${YEAR}_NINO4.nc
- fnino34_nc=${CONFCASE}_y${YEAR}_NINO34.nc
-
- # special function for concatenation of Netcdf output
- cdfmean_concat() { case $mm in
- 01) mv cdfmean.nc $1 ;;
- *) ncrcat -A $1 cdfmean.nc -o $1 ;;
- esac ; }
-
- # get monthly mean gridT files and compute mean SST on each NINO box
- for m in 1 2 3 4 5 6 7 8 9 10 11 12 ; do
- mm=$(printf "%02d" $m)
- f=${CONFCASE}_y${YEAR}m${mm}_gridT.nc
-
- rapatrie $f $MEANY $f
-
- # header
- printf "%04d %02d" $YEAR $m >> $fnino
-
- # nino 1+2 [ -90 W -- -80 W, -10 S -- 10 N ]
- cdfmean $f votemper T $NINO12 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> $fnino
- cdfmean_concat $fnino12_nc
-
- # nino 3 [ -150 W -- -90 W, -5 S -- 5 N ]
- cdfmean $f votemper T $NINO3 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> $fnino
- cdfmean_concat $fnino3_nc
-
- # nino 4 [ -200 W -- -150 W, -5 S -- 5 N ]
- cdfmean $f votemper T $NINO4 1 1 | tail -1 | awk '{ printf " %8.5f 0.00", $6 }' >> $fnino
- cdfmean_concat $fnino4_nc
-
- # nino 3.4 [ -170 W -- -120 W, -% S -- % N ]
- cdfmean $f votemper T $NINO34 1 1 | tail -1 | awk '{ printf " %8.5f 0.00\n", $6 }' >> $fnino
- cdfmean_concat $fnino34_nc
-
- done
-
- expatrie $fnino $DIAGS/TXT $fnino
- expatrie $fnino12_nc $DIAGS/NC $fnino12_nc
- expatrie $fnino3_nc $DIAGS/NC $fnino3_nc
- expatrie $fnino4_nc $DIAGS/NC $fnino4_nc
- expatrie $fnino34_nc $DIAGS/NC $fnino34_nc
- fi
-
-# Transport: Input files: VT, gridU, gridV, mesh mask, section.dat
-#^^^^^^^^^^^
- if [ $TRP == 1 ] ; then
- # section.dat describes the position (I,J) of the sections to monitor
- cp $P_CTL/section.dat .
-
- # get VT , gridU, gridV files
- rapatrie ${CONFCASE}_y${YEAR}_VT.nc $MEANY ${CONFCASE}_y${YEAR}_VT.nc
- rapatrie ${CONFCASE}_y${YEAR}_gridU.nc $MEANY ${CONFCASE}_y${YEAR}_gridU.nc
- rapatrie ${CONFCASE}_y${YEAR}_gridV.nc $MEANY ${CONFCASE}_y${YEAR}_gridV.nc
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Ascii output file:
- fsection=${CONFCASE}_y${YEAR}_section_monitor.txt
-
- echo $YEAR > $fsection
-
- cdftransportiz ${CONFCASE}_y${YEAR}_VT.nc \
- ${CONFCASE}_y${YEAR}_gridU.nc \
- ${CONFCASE}_y${YEAR}_gridV.nc < section.dat >> $fsection
-
- # eliminate garbage from txt file ...
- grep -v Give $fsection | grep -v level | grep -v IMAX | grep -v FROM > tmp
- mv -f tmp $fsection
-
- expatrie $fsection $DIAGS/TXT $fsection
-
- # save x_transports.nc file
- listfiles=$( ls | grep transports.nc )
-
- for file in $listfiles ; do
- mv $file ${CONFCASE}_y${YEAR}_$file
- expatrie ${CONFCASE}_y${YEAR}_$file $DIAGS/NC ${CONFCASE}_y${YEAR}_$file
- done
-
- fi
-
-# Heat and Salt Meridional Transport : Input files : VT, mesh mask, new_maskglo
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $MHT == 1 ] ; then
-# (a) From advection:
-#--------------------
- # get VT files
- rapatrie ${CONFCASE}_y${YEAR}_VT.nc $MEANY ${CONFCASE}_y${YEAR}_VT.nc
-
- # get mesh mask files + new_maskglo
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
- if (( $atl == 0 )) ; then rapatrie new_maskglo.nc $IDIR new_maskglo.nc ; fi
-
- # Ascii output files:
- fheat=${CONFCASE}_y${YEAR}_heattrp.dat
- fsalt=${CONFCASE}_y${YEAR}_salttrp.dat
- # Netcdf output files: (both head and salt in 2 separated variables)
-
- cdfmhst ${CONFCASE}_y${YEAR}_VT.nc MST # Save Meridional salt transport as well
- mv mhst.nc ${CONFCASE}_y${YEAR}_mhst.nc
-
- expatrie zonal_heat_trp.dat $DIAGS/TXT $fheat
- expatrie zonal_salt_trp.dat $DIAGS/TXT $fsalt
- expatrie ${CONFCASE}_y${YEAR}_mhst.nc $DIAGS/NC ${CONFCASE}_y${YEAR}_mhst.nc
-
- # needed below with the correct name
- cp zonal_heat_trp.dat ${CONFCASE}_y${YEAR}_heattrp.dat
-
-# (b) from Surface Heat fluxes
-#-----------------------------
- rapatrie ${CONFCASE}_y${YEAR}_gridT.nc $MEANY ${CONFCASE}_y${YEAR}_gridT.nc
- cdfhflx ${CONFCASE}_y${YEAR}_gridT.nc
-
- expatrie hflx.out $DIAGS/TXT ${CONFCASE}_y${YEAR}_hflx.dat
- expatrie cdfhflx.nc $DIAGS/NC ${CONFCASE}_y${YEAR}_hflx.nc
- fi
-
-
-# MAX and MIN of MOC: requires that MOC files already exists
-#^^^^^^^^^^^^^^^^^^^^
- if [ $MAXMOC == 1 ] ; then
- f=moc.nc
- rapatrie ${CONFCASE}_y${YEAR}_MOC.nc $MEANY $f
-
- # Ascii output file
- fmaxmoc=${CONFCASE}_y${YEAR}_minmaxmoc.txt
- echo $YEAR > $fmaxmoc
- fmaxmoc40=${CONFIG}-${CASE}_y${YEAR}_maxmoc40.txt
- echo $YEAR > $fmaxmoc40
-
- if (( atl == 0 )) ; then
- # GLO
- printf "%s" 'Glo ' >> $fmaxmoc ; cdfmaxmoc $f glo 20 60 500 2000 | grep Maximum >> $fmaxmoc
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Glo_maxmoc.nc
- printf "%s" 'Glo ' >> $fmaxmoc ; cdfmaxmoc $f glo -40 30 2000 5500 | grep Minimum >> $fmaxmoc
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Glo_minmoc.nc
- # ATL
- printf "%s" 'Atl ' >> $fmaxmoc ; cdfmaxmoc $f atl 0 60 500 2000 | grep Maximum >> $fmaxmoc
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Atl_maxmoc.nc
- printf "%s" 'Atl ' >> $fmaxmoc ; cdfmaxmoc $f atl -20 40 2000 5500 | grep Minimum >> $fmaxmoc
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Atl_minmoc.nc
- #INP
- printf "%s" 'Inp ' >> $fmaxmoc ; cdfmaxmoc $f inp 15 50 100 1000 | grep Minimum >> $fmaxmoc
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Inp_minmoc.nc
- printf "%s" 'Inp ' >> $fmaxmoc ; cdfmaxmoc $f inp -30 20 1000 5500 | grep Minimum >> $fmaxmoc
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Inp_minmoc2.nc
- #AUS
- printf "%s" 'Aus ' >> $fmaxmoc ; cdfmaxmoc $f glo -70 0 0 2000 | grep Maximum >> $fmaxmoc
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Aus_maxmoc.nc
- printf "%s" 'Aus ' >> $fmaxmoc ; cdfmaxmoc $f glo -70 0 2000 5500 | grep Minimum >> $fmaxmoc
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Aus_minmoc.nc
-
- expatrie $fmaxmoc $DIAGS/TXT $fmaxmoc
-
- # Max and Min of MOC at some specific latitudes
- # GLO MAX at 40 N and 30S
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo 40 40 500 2000 | grep Maximum >> $fmaxmoc40
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Glo_maxmoc40N.nc
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo -30 -30 500 5500 | grep Maximum >> $fmaxmoc40
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Glo_maxmoc30S.nc
- # ATL MAX at 40N and 30S
- printf "%s" 'Atl ' >> $fmaxmoc40 ; cdfmaxmoc $f atl 40 40 500 2000 | grep Maximum >> $fmaxmoc40
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Atl_maxmoc40N.nc
- printf "%s" 'Atl ' >> $fmaxmoc40 ; cdfmaxmoc $f atl -30 -30 500 5000 | grep Maximum >> $fmaxmoc40
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Atl_maxmoc30S.nc
- #INP Min at 30 S
- printf "%s" 'Inp ' >> $fmaxmoc40 ; cdfmaxmoc $f inp -30 -30 1000 5500 | grep Minimum >> $fmaxmoc40
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Inp_minmoc30S.nc
- #AUS MAX at 50 S
- printf "%s" 'Aus ' >> $fmaxmoc40 ; cdfmaxmoc $f glo -50 -50 0 2000 | grep Maximum >> $fmaxmoc40
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Aus_maxmoc50S.nc
-
- expatrie $fmaxmoc40 $DIAGS/TXT $fmaxmoc40
-
- else # NATL configuration
- # GLO
- printf "%s" 'Glo ' >> $fmaxmoc ; cdfmaxmoc $f glo 20 60 500 2000 | grep Maximum >> $fmaxmoc
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Glo_maxmoc.nc
- printf "%s" 'Glo ' >> $fmaxmoc ; cdfmaxmoc $f glo -40 30 2000 5500 | grep Minimum >> $fmaxmoc
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Glo_minmoc.nc
- expatrie $fmaxmoc $DIAGS/TXT $fmaxmoc
-
- # Max and Min of MOC at some specific latitudes
- # GLO MAX at 40 N and 30S
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo 40 40 500 2000 | grep Maximum >> $fmaxmoc40
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Glo_maxmoc40N.nc
- printf "%s" 'Glo ' >> $fmaxmoc40 ; cdfmaxmoc $f glo -15 -15 500 5500 | grep Maximum >> $fmaxmoc40
- expatrie maxmoc.nc $DIAGS/NC ${CONFIG}-${CASE}_y${YEAR}_Glo_maxmoc15S.nc
-
- expatrie $fmaxmoc40 $DIAGS/TXT $fmaxmoc40
-
- # clean for next year
- \rm moc.nc
- fi
- fi
-
-
-# DCT :Density Class transport: Input files : gridT, gridU gridV, mesh mask, dens_section.dat
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $DCT == 1 ] ; then
- # dens_section.dat describe the sections (either zonal or meridional) where the DCT is computed
- cp $P_CTL/dens_section.dat .
-
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
-
- # Required post_processing script: DCT are computed on monthly means, then average is performed
- # for annual values. This process is still done through temporary bimg/dimg files (remnant of the
- # old Clipper times). By the way, 2 bimgtools are required: bimgmoy4 and bimgcaltrans
- # In-lining of this script may be confusing. I leave it as an external module.
-# cp $CDFTOOLS/JOBS/trpsig_postproc.ksh ./
-
- # due to the large amount of files that are produced by this diags, we prefer to keep them
- # on a separate directory
- chkdirg ${CONFIG}/${CONFCASE}-TRPSIG/
- chkdirg ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
- chkdirg $DIAGS/TXT/$YEAR/
- chkdirg $DIAGS/TXT/TRPSIG/
-
- # also need temporary directories in the actual tmpdir:
- chkdir ${CONFIG}
- chkdir ${CONFIG}/${CONFCASE}-TRPSIG
- chkdir ${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
-
- TRPSIGY=${CONFIG}/${CONFCASE}-TRPSIG/$YEAR/
-
- for m in 1 2 3 4 5 6 7 8 9 10 11 12 ; do
- mm=$(printf "%02d" $m)
- tfich=${CONFCASE}_y${YEAR}m${mm}_gridT.nc
- ufich=$(echo $tfich | sed -e 's/gridT/gridU/' )
- vfich=$(echo $tfich | sed -e 's/gridT/gridV/' )
-
- #get files on gaya
- rapatrie $tfich $MEANY $tfich
- rapatrie $ufich $MEANY $ufich
- rapatrie $vfich $MEANY $vfich
-
- #retrieve tag time from file name
- tag=$(echo $tfich | sed -e "s/${CONFCASE}_//" -e 's/_gridT.nc//')
-
- echo $tag > ${CONFCASE}_y${tag}_trpsig_monitor.lst
-
- cdfsigtrp $tfich $ufich $vfich 21 30 180 -print >> ${CONFCASE}_y${tag}_trpsig_monitor.lst
- # save netcdf files
- listfiles=$( ls | grep trpsig.nc )
-
- for file in $listfiles ; do
- expatrie $file $DIAGS/NC ${CONFCASE}_${tag}_$file
- mv $file $TRPSIGY/${CONFCASE}_${tag}_$file
- done
-
- # save the monthly log file on gaya for an (improbable) eventual post processing ...
-# expatrie ${CONFCASE}_y${tag}_trpsig_monitor.lst $TRPSIGY ${CONFCASE}_y${tag}_trpsig_monitor.lst
- # and create a mirror on the local tmpdir
- mv ${CONFCASE}_y${tag}_trpsig_monitor.lst $TRPSIGY
-
- # Idem : save temporary bimg files on gaya and create local mirror
-# for b in *bimg ; do
-# mv $b ${CONFCASE}_y${tag}_$b
-## expatrie ${CONFCASE}_y${tag}_$b $TRPSIGY ${CONFCASE}_y${tag}_$b
-# mv ${CONFCASE}_y${tag}_$b $TRPSIGY
-# done
-
- # Idem: for txt files
-# mv trpsig.txt ${CONFCASE}_y${tag}_trpsig.txt
-## expatrie ${CONFCASE}_y${tag}_trpsig.txt $TRPSIGY ${CONFCASE}_y${tag}_trpsig.txt
-# mv ${CONFCASE}_y${tag}_trpsig.txt $TRPSIGY
-
- # erase useless files ( monthly averages ) Keep tfich which can be used for MXL
- \rm *.bimg $ufich $vfich
-
- # end of month loop
- done
-
- # Launch post processing ( by itself a complex script ...)
- # This script retrieve CONFIG name and CASE from the directory name where it runs...
- cd $TRPSIGY
- # compute mean nc files : all sections are mixed in this dir with 12 months each
- # isolate sections from m01 files : NATL025-GRD83_y1999m01_01_Denmark_strait_trpsig.nc
- section_list=''
- for f in *m01_*trpsig.nc ; do
- section=${f%_trpsig.nc} ; section=${section#*m01_}
- section_list="$section_list $section"
- done
-
- for section in $section_list ; do
- cdfmoy_weighted ${CONFCASE}_y${YEAR}m??_${section}_trpsig.nc
- froot=${CONFCASE}_y${YEAR}_${section}_trpsig
- mv cdfmoy_weighted.nc $froot.nc
- expatrie $froot.nc $DIAGS/NC $froot.nc
- ncks -v sigtrp $froot.nc | \
- sed -e 's/=/ /g' | grep -e '^time_counter\[' | grep -e lev | \
- awk '{printf " %07.4f %+14.9e\n", $4, $8/1.e6}' > $froot.txt
- expatrie $froot.txt $DIAGS/TXT/TRPSIG/ $froot.txt
- done
-
- # return to tmpdir
- cd $TMPDIR
- # Erase the TRPSIG tree for this current year
- \rm -r ${CONFIG} \rm ${CONFCASE}_y*_trpsig.txt *.mtl
- fi
-
-# TRACER DIAGS (31/12 of each year) : Input files : ptrcT, mesh mask
-#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- if [ $TRACER == 1 ] ; then
- # get mesh mask files
- rapatrie ${MESH_MASK_ID}_byte_mask.nc $IDIR mask.nc
- rapatrie ${MESH_MASK_ID}_mesh_hgr.nc $IDIR mesh_hgr.nc
- rapatrie ${MESH_MASK_ID}_mesh_zgr.nc $IDIR mesh_zgr.nc
- if (( $atl == 0 )) ; then rapatrie new_maskglo.nc $IDIR new_maskglo.nc ; fi
-
- # get tracer file from gaya: note that this is from -S dir (5 day average ... to discuss ...)
- rapatrie ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc $SDIRY ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc
-
- # Ascii output file:
- ftrc=${CONFCASE}_y${YEAR}_TRCmean.dat
- ftrc_nc=${CONFCASE}_y${YEAR}_TRCmean.nc
-
- # Number of mol in the ocean ...
- printf "%04d " $YEAR > $ftrc
-
- # CFC11
- \rm -f tmp1
- cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invcfc T > tmp1
- area=$(cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}')
- mean=$(cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}')
- total=$(echo $mean $area | awk '{print $1 * $2 }' )
- printf "%s " $total >> $ftrc
- mv cdfmean.nc $ftrc_nc
-
- # B-C14
- \rm -f tmp1
- cdfmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc invc14 T > tmp1
- area=$(cat tmp1 | grep -e 'Mean value at level' | awk ' {print $12}')
- mean=$(cat tmp1 | grep -e 'Mean value over the ocean' | awk ' {print $6}')
- total=$(echo $mean $area | awk '{print $1 * $2 }' )
- printf "%s \n" $total >> $ftrc
- # append cdfmean.nc variable to the already existing nc file
- ncks -A cdfmean.nc $ftrc_nc
-
- expatrie $ftrc $DIAGS/TXT $ftrc
- expatrie $ftrc_nc $DIAGS/NC $ftrc_nc
-
- # zonal integral of inventories
- cdfzonalsum ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
- # zonal means
- cdfzonalmean ${CONFCASE}_y${YEAR}m12d31_ptrcT.nc T
-
- # ncks is required on the prod machine ... !! not standard !!
- # it is used to take only the interesting variables from the results
- ncks -F -d deptht,1,1 -v zocfc11_glo,zobc14_glo,nav_lon,nav_lat zonalmean.nc zonalsurf.nc
-
- # put in ascii format the 1D profiles
- cdfzonalout zonalmean.nc > zonalmean.dat
- cdfzonalout zonalsum.nc > zonalsum.dat
- cdfzonalout zonalsurf.nc > zonalsurf.dat
-
- expatrie zonalmean.nc $MEANY ${CONFCASE}_y${YEAR}_TRCzonalmean.nc
- expatrie zonalsum.nc $MEANY ${CONFCASE}_y${YEAR}_TRCzonalsum.nc
-
- expatrie zonalmean.dat $DIAGS/TXT ${CONFCASE}_y${YEAR}_TRCzonalmean.dat
- expatrie zonalsum.dat $DIAGS/TXT ${CONFCASE}_y${YEAR}_TRCzonalsum.dat
- expatrie zonalsurf.dat $DIAGS/TXT ${CONFCASE}_y${YEAR}_TRCzonalsurf.dat
- \rm zonalsurf.nc
-
- fi
diff --git a/JOBS/monitor_testOK_jade.ksh b/JOBS/monitor_testOK_jade.ksh
deleted file mode 100755
index 5055d4b..0000000
--- a/JOBS/monitor_testOK_jade.ksh
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/bin/ksh
-set -x
-n=0
-while (( $n < $1 )) ; do
- sleep 3
- n=$( ls -l ????/OK_MONITOR 2> /dev/null | wc -l )
-done
diff --git a/JOBS/testOK.ksh b/JOBS/testOK.ksh
deleted file mode 100644
index 41b2968..0000000
--- a/JOBS/testOK.ksh
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/bin/ksh
-set -x
-n=0
-while (( $n < 6 )) ; do
- sleep 3
- n=$( ls -l OK? 2> /dev/null | wc -l )
-done
diff --git a/JOBS/trpsig_postproc.ksh b/JOBS/trpsig_postproc.ksh
deleted file mode 100755
index 062c6d5..0000000
--- a/JOBS/trpsig_postproc.ksh
+++ /dev/null
@@ -1,90 +0,0 @@
-#!/bin/ksh
-#-------------------------------------------------------------------------------
-# $Rev$
-# $Date$
-# $Id$
-#-------------------------------------------------------------------------------
-#set -x
-
-# This script is used to perform the computation of Density Class Transport after
-# their computation on zahir with monthly mean
-# (1) It first reorganize the results on a section/year basis.
-# (2) Then it computes the mean of 12 months for trpsig
-# (3) finally it translates the mean results in a txt file for each section
-
-### (1) : reorganization of the results.
-here=$( basename `pwd` )
-
-if [ ${here##*-} != TRPSIG ] ; then
- echo this script mus be run in a -TRPSIG directory.
- exit 1
-fi
-
-CONFCASE=${here%-TRPSIG}
-
-# Fonction reorganize : put the files in the right position
-reorganize() {
-
-for year in $( ls -d ???? ) ; do
- cd $year
-
- for f in *.bimg ; do
- tmp=${f#${CONFCASE}_yy????m??_}
- dir=${tmp%_*.bimg}
- if [ ! -d ../$dir ] ; then
- mkdir ../$dir
- fi
-
- if [ ! -d ../$dir/$year ] ; then
- mkdir ../$dir/$year
- fi
- mv $f ../$dir/$year
- done
-
- if [ ! -d ../LST ] ; then mkdir ../LST ; fi
- if [ ! -d ../TRPSIG ] ; then mkdir ../TRPSIG ; fi
-
- mv *.lst ../LST
- mv *.txt ../TRPSIG
- cd ../
- rmdir $year
-
-done
-
-}
-
-### (2) : now compute the mean foreach year and sections
-# we suppose that section name starts with 2 digits 01_ 02_ 03_ etc ...
-mean() {
-# section name are codes as 2 digit_Capitalized_Name (eg: 01_Denmark_Strait or 07_Bab_el_Mandeb )
-for stnam in [0-9][0-9]_[a-zA-Z]* ; do
- cd $stnam
- printf "%s" "Working for station $stnam "
-
- # note that bimgmoy4 and bimgcaltrans exec are in cdftools-2.0 (extension ...)
- for d in ???? ; do
- printf "%4d " $(( d ))
- cd $d
- bimgmoy4 ${CONFCASE}_y*trpsig.bimg > /dev/null
- mv moy.bimg ${CONFCASE}_y${d}_${stnam}_trpsig.bimg
- # (2.2) : translate results into txt file foreach section
- bimgcaltrans ${CONFCASE}_y${d}_${stnam}_trpsig.bimg > $TMPDIR/${CONFCASE}_y${d}_${stnam}_trpsig.txt
-
- \rm [mv]*bimg
- cd ../
- done
- printf "\n"
- cd ../
-done
-
-}
-
-##################### Main script: call functions
-
-reorganize
-
-
-mean
-
-
-
diff --git a/License/CDFTOOLSCeCILL.txt b/License/CDFTOOLSCeCILL.txt
new file mode 100644
index 0000000..7ab7c02
--- /dev/null
+++ b/License/CDFTOOLSCeCILL.txt
@@ -0,0 +1,36 @@
+The following licence information concerns ONLY the CDFTOOLS package
+=======================================================================
+
+Copyright � LEGI-MEOM (Jean-Marc.Molines at legi.grenoble-inp.fr )
+Contributors : F. Castruccio, C. Dufour, R. Dussin, A. Lecointre,
+P. Mathiot, A. Melet.
+
+This software is a computer program for analysis of NEMO model output
+produced in the frame of the DRAKKAR project. It is designed for the
+treatment of the NetCdf files produced by NEMO-DRAKKAR.
+
+This software is governed by the CeCILL license under French law and
+abiding by the rules of distribution of free software. You can use,
+modify and/ or redistribute the software under the terms of the CeCILL
+license as circulated by CEA, CNRS and INRIA at the following URL
+"http://www.cecill.info".
+
+As a counterpart to the access to the source code and rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty and the software's author, the holder of the
+economic rights, and the successive licensors have only limited
+liability.
+
+In this respect, the user's attention is drawn to the risks associated
+with loading, using, modifying and/or developing or reproducing the
+software by the user in light of its specific status of free software,
+that may mean that it is complicated to manipulate, and that also
+therefore means that it is reserved for developers and experienced
+professionals having in-depth computer knowledge. Users are therefore
+encouraged to load and test the software's suitability as regards their
+requirements in conditions enabling the security of their systems and/or
+data to be ensured and, more generally, to use and operate it in the
+same conditions as regards security.
+
+The fact that you are presently reading this means that you have had
+knowledge of the CeCILL license and that you accept its terms.
diff --git a/macro.g95 b/Macrolib/macro.g95
similarity index 100%
rename from macro.g95
rename to Macrolib/macro.g95
diff --git a/Macrolib/macro.gfortran b/Macrolib/macro.gfortran
new file mode 100644
index 0000000..e898ff7
--- /dev/null
+++ b/Macrolib/macro.gfortran
@@ -0,0 +1,14 @@
+# Makefile for CDFTOOLS
+# $Rev: 522 $
+# $Date: 2011-06-17 12:50:13 +0200 (Fri, 17 Jun 2011) $
+# --------------------------------------------------------------
+#
+#NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf
+NCDF = -I/usr/include -lnetcdff -lnetcdf
+
+F90=gfortran -v
+MPF90=
+FFLAGS= -O $(NCDF) -fno-second-underscore
+LMPI=-lmpich
+
+INSTALL=$(HOME)/bin
diff --git a/macro.gorgon b/Macrolib/macro.gorgon
similarity index 100%
rename from macro.gorgon
rename to Macrolib/macro.gorgon
diff --git a/macro.ifort b/Macrolib/macro.ifort
similarity index 82%
rename from macro.ifort
rename to Macrolib/macro.ifort
index eabb24b..281cd5e 100644
--- a/macro.ifort
+++ b/Macrolib/macro.ifort
@@ -10,7 +10,7 @@ NCDF = -I/usr/local/netcdf-3.6.1/ifort/include -L /usr/local/netcdf-3.6.1/ifort/
F90=ifort
MPF90=mpif90
-FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian
+FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian -CB -fpe0 -g -traceback -ftrapuv
LMPI=-lmpich
INSTALL=$(HOME)/bin
diff --git a/macro.ifort_ursus b/Macrolib/macro.ifort_ursus
similarity index 100%
rename from macro.ifort_ursus
rename to Macrolib/macro.ifort_ursus
diff --git a/macro.jade b/Macrolib/macro.jade
similarity index 100%
rename from macro.jade
rename to Macrolib/macro.jade
diff --git a/macro.mac b/Macrolib/macro.mac
similarity index 100%
rename from macro.mac
rename to Macrolib/macro.mac
diff --git a/macro.meolkara b/Macrolib/macro.meolkara
similarity index 86%
rename from macro.meolkara
rename to Macrolib/macro.meolkara
index a40e82d..605f9c3 100644
--- a/macro.meolkara
+++ b/Macrolib/macro.meolkara
@@ -9,7 +9,7 @@ NCDF_ROOT=/opt/netcdf/4.1.1
#HDF5_ROOT=/opt/hdf5/1.8.4
#ZLIB_ROOT=opt/zlib/1.2.3
-NCDF = -I$(NCDF_ROOT)/include -L $(NETCDF_ROOT)/lib/ \
+NCDF = -I$(NCDF_ROOT)/include -L $(NCDF_ROOT)/lib/ \
-lnetcdf
#HDF5 = -I$(HDF5_ROOT)/include -L$(HDF5_ROOT)/lib -lhdf5_hl -lhdf5
@@ -22,4 +22,4 @@ FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian
LMPI=-lmpich
-INSTALL=/usr/local/cdftools-2.1/bin
+INSTALL=$(HOME)/bin
diff --git a/macro.meolkerg b/Macrolib/macro.meolkerg
similarity index 61%
rename from macro.meolkerg
rename to Macrolib/macro.meolkerg
index 5bef4fc..2c5d87e 100644
--- a/macro.meolkerg
+++ b/Macrolib/macro.meolkerg
@@ -5,10 +5,13 @@
#
NCDF = -I/opt/netcdf-4.1/include -L /opt/netcdf-4.1/lib/ \
-lnetcdf
-#HDF5 = -I/opt/hdf5-1.8.4/include -L/opt/hdf5-1.8.4/lib -lhdf5_hl -lhdf5
-#ZLIB = -I/opt/zlib-1.2.3/include -L/opt/zlib-1.2.3/lib -lz
-HDF5 = -L/opt/hdf5-1.8.4/lib -lhdf5_hl -lhdf5
-ZLIB = -L/opt/zlib-1.2.3/lib -lz
+HDF5 = -I/opt/hdf5-1.8.4/include -L/opt/hdf5-1.8.4/lib -lhdf5_hl -lhdf5
+ZLIB = -I/opt/zlib-1.2.3/include -L/opt/zlib-1.2.3/lib -lz
+
+#NCDF = -I/opt/netcdf-4.1.1-ifort/include -L /opt/netcdf-4.1.1-ifort/lib/ \
+# -lnetcdf
+#HDF5 =
+#ZLIB =
F90=ifort
MPF90=mpif90
diff --git a/macro.mirage b/Macrolib/macro.mirage
similarity index 100%
rename from macro.mirage
rename to Macrolib/macro.mirage
diff --git a/macro.nymphea b/Macrolib/macro.nymphea
similarity index 100%
rename from macro.nymphea
rename to Macrolib/macro.nymphea
diff --git a/macro.p630 b/Macrolib/macro.p630
similarity index 100%
rename from macro.p630
rename to Macrolib/macro.p630
diff --git a/macro.pgi b/Macrolib/macro.pgi
similarity index 100%
rename from macro.pgi
rename to Macrolib/macro.pgi
diff --git a/macro.porzig b/Macrolib/macro.porzig
similarity index 100%
rename from macro.porzig
rename to Macrolib/macro.porzig
diff --git a/macro.rhodes b/Macrolib/macro.rhodes
similarity index 100%
rename from macro.rhodes
rename to Macrolib/macro.rhodes
diff --git a/macro.sx8 b/Macrolib/macro.sx8
similarity index 100%
rename from macro.sx8
rename to Macrolib/macro.sx8
diff --git a/macro.vargas b/Macrolib/macro.vargas
similarity index 81%
rename from macro.vargas
rename to Macrolib/macro.vargas
index 8e571f8..42aeff6 100644
--- a/macro.vargas
+++ b/Macrolib/macro.vargas
@@ -4,7 +4,7 @@
# !! $Id: macro.zahir 82 2007-07-17 08:24:09Z molines $
# !!--------------------------------------------------------------
#
-NCDF= -I/usr/local/pub/NetCDF/3.6.2/include -L/usr/local/pub/NetCDF/3.6.2/lib -lnetcdf
+NCDF= -I/usr/local/pub/NetCDF/3.5.1/include -L/usr/local/pub/NetCDF/3.5.1/lib -lnetcdf
F90=xlf90
MPF90=mpxlf90_r
diff --git a/macro.zahir b/Macrolib/macro.zahir
similarity index 100%
rename from macro.zahir
rename to Macrolib/macro.zahir
diff --git a/Makefile b/Makefile
index 386d805..1980f91 100644
--- a/Makefile
+++ b/Makefile
@@ -1,539 +1,387 @@
-# Makefile for CDFTOOLS
+# Makefile for CDFTOOLS_3.0
# ( make.macro is a link that points to the file macro.xxx where
# xxx is representative of your machine )
-# !! $Rev$
-# !! $Date$
-# !! $Id$
-# !!--------------------------------------------------------------
-
+# !!----------------------------------------------------------------------
+# !! CDFTOOLS_3.0 , MEOM 2011
+# !! $Id$
+# !! Copyright (c) 2010, J.-M. Molines
+# !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+# !!----------------------------------------------------------------------
include make.macro
+BINDIR = ./bin
-CDFTOOLS=CDFTOOLS-2.1
+VPATH = $(BINDIR)
-EXEC = cdfmoy cdfmoyt cdfmoy_sp cdfstd cdfmoy_sal2_temp2 cdfmoy_annual cdfmoy_weighted cdfmoy_chsp cdfmoy_freq cdfvT \
+EXEC = cdfmoy cdfmoyt cdfstd cdfmoy_weighted cdfmoy_freq cdfvT \
cdfvsig cdfspeed cdfsum\
- cdfmoyuv cdfmoyuvwt \
+ cdfmoyuvwt \
cdfeke cdfrmsssh cdfstdevw cdfstdevts cdflinreg cdfimprovechk\
- cdfbn2 cdfbn2-full cdfsig0 cdfsigi cdfsiginsitu cdfbottomsig0 cdfbottomsigi cdfspice\
- cdfbottom cdfets cdfcurl cdfw cdfgeo-uv cdfmxl cdfmxl-full\
- cdfrhoproj cdfisopycdep cdfsigintegr cdfpv cdflspv cdfpvor cdfpvor-full\
- cdfmhst cdfmhst-full cdfvhst cdfvhst-full cdftransportiz cdftransportiz_noheat cdftransportiz_noheat_obc cdftransportiz-full \
- cdftransportizpm \
- cdfmasstrp cdfmasstrp-full \
- cdfsigtrp cdfsigitrp cdfsigtrp-full cdftemptrp-full cdftempvol-full\
- cdfpsi cdfpsi-full cdfpsi-open cdfmoc cdfmoc-full cdfmocatl cdfmocsig cdfmean cdfmeanvar cdfmean-full cdfzeromean \
- cdfheatc cdfheatc-full cdfzonalmean cdfhflx cdfwflx cdfbuoyflx\
- cdfmxlheatc cdfmxlheatc-full cdfmxlsaltc cdfmxlhcsc cdfvertmean\
+ cdfbn2 cdfrichardson cdfsig0 cdfsigi cdfsiginsitu cdfbottomsig cdfspice\
+ cdfbottom cdfets cdfcurl cdfw cdfgeo-uv cdfmxl \
+ cdfrhoproj cdfsigintegr cdfpvor \
+ cdfmhst cdfvhst cdfvtrp cdftransport \
+ cdfsigtrp cdftempvol-full\
+ cdfpsi cdfmoc cdfmocsig cdfmean \
+ cdfheatc cdfzonalmean cdfhflx cdfwflx cdfbuoyflx\
+ cdfmxlheatc cdfmxlsaltc cdfmxlhcsc cdfvertmean\
cdfpendep cdfzonalsum cdficediags cdfzonalout\
- cdfprofile cdfwhereij cdffindij cdfweight cdfmaxmoc cdfcensus cdfzoom cdfmax cdfmax_sp cdfprobe cdfinfo \
- bimgmoy4 bimgcaltrans cdf16bit cdfvita cdfconvert cdfflxconv cdfclip cdfsstconv cdfstrconv cdfbathy cdfvar cdfmkmask-zone\
+ cdfprofile cdfwhereij cdffindij cdfweight cdfmaxmoc cdfcensus cdfzoom cdfmax cdfprobe cdfinfo \
+ cdf16bit cdfvita cdfconvert cdfflxconv cdfclip cdfsstconv cdfstrconv cdfbathy cdfvar \
cdfcsp cdfcoloc cdfmltmask cdfstatcoord cdfpolymask cdfsmooth cdfmkmask cdfdifmask\
cdfkempemekeepe cdfbci cdfbti cdfnrjcomp cdfcofdis cdfsections cdfnorth_unfold cdfovide cdfmppini\
- cdfpsi_level cdfhdy cdfhdy3d cdffracinv cdfzonalintdeg cdfmaskdmp cdfisopsi cdf2matlab cdffixtime
+ cdfpsi_level cdfhdy cdfhdy3d cdffracinv cdfmaskdmp cdfnan cdfnamelist \
+ cdfisopsi cdf2matlab cdffixtime
all: $(EXEC)
## Statistical programs
cdfmoy: cdfio.o cdfmoy.f90
- $(F90) cdfmoy.f90 -o cdfmoy cdfio.o $(FFLAGS)
-
-cdfmoy3: cdfio.o cdfmoy3.f90
- $(F90) cdfmoy3.f90 -o cdfmoy3 cdfio.o $(FFLAGS)
+ $(F90) cdfmoy.f90 -o $(BINDIR)/cdfmoy cdfio.o modcdfnames.o $(FFLAGS)
cdfmoyt: cdfio.o cdfmoyt.f90
- $(F90) cdfmoyt.f90 -o cdfmoyt cdfio.o $(FFLAGS)
-
-cdfmoy_mpp: cdfio.o cdfmoy_mpp.f90
- $(MPF90) cdfmoy_mpp.f90 -o cdfmoy_mpp cdfio.o $(FFLAGS) $(LMPI)
-
-cdfmoy_sal2_temp2: cdfio.o cdfmoy_sal2_temp2.f90
- $(F90) cdfmoy_sal2_temp2.f90 -o cdfmoy_sal2_temp2 cdfio.o $(FFLAGS)
-
-cdfmoy_sp: cdfio.o cdfmoy_sp.f90
- $(F90) cdfmoy_sp.f90 -o cdfmoy_sp cdfio.o $(FFLAGS)
-
-cdfmoy_chsp: cdfio.o cdfmoy_chsp.f90
- $(F90) cdfmoy_chsp.f90 -o cdfmoy_chsp cdfio.o $(FFLAGS)
+ $(F90) cdfmoyt.f90 -o $(BINDIR)/cdfmoyt cdfio.o modcdfnames.o $(FFLAGS)
cdfmoy_freq: cdfio.o cdfmoy_freq.f90
- $(F90) cdfmoy_freq.f90 -o cdfmoy_freq cdfio.o $(FFLAGS)
-
-cdfmoyuv: cdfio.o cdfmoyuv.f90
- $(F90) cdfmoyuv.f90 -o cdfmoyuv cdfio.o $(FFLAGS)
+ $(F90) cdfmoy_freq.f90 -o $(BINDIR)/cdfmoy_freq cdfio.o modcdfnames.o $(FFLAGS)
cdfmoyuvwt: cdfio.o cdfmoyuvwt.f90
- $(F90) cdfmoyuvwt.f90 -o cdfmoyuvwt cdfio.o $(FFLAGS)
+ $(F90) cdfmoyuvwt.f90 -o $(BINDIR)/cdfmoyuvwt cdfio.o modcdfnames.o $(FFLAGS)
cdfstd: cdfio.o cdfstd.f90
- $(F90) cdfstd.f90 -o cdfstd cdfio.o $(FFLAGS)
-
-cdfmoy_annual: cdfio.o cdfmoy_annual.f90
- $(F90) cdfmoy_annual.f90 -o cdfmoy_annual cdfio.o $(FFLAGS)
+ $(F90) cdfstd.f90 -o $(BINDIR)/cdfstd cdfio.o modcdfnames.o $(FFLAGS)
cdfmoy_weighted: cdfio.o cdfmoy_weighted.f90
- $(F90) cdfmoy_weighted.f90 -o cdfmoy_weighted cdfio.o $(FFLAGS)
+ $(F90) cdfmoy_weighted.f90 -o $(BINDIR)/cdfmoy_weighted cdfio.o modcdfnames.o $(FFLAGS)
cdfeke: cdfio.o cdfeke.f90
- $(F90) cdfeke.f90 -o cdfeke cdfio.o $(FFLAGS)
+ $(F90) cdfeke.f90 -o $(BINDIR)/cdfeke cdfio.o modcdfnames.o $(FFLAGS)
cdfrmsssh: cdfio.o cdfrmsssh.f90
- $(F90) cdfrmsssh.f90 -o cdfrmsssh cdfio.o $(FFLAGS)
+ $(F90) cdfrmsssh.f90 -o $(BINDIR)/cdfrmsssh cdfio.o modcdfnames.o $(FFLAGS)
cdfstdevw: cdfio.o cdfstdevw.f90
- $(F90) cdfstdevw.f90 -o cdfstdevw cdfio.o $(FFLAGS)
+ $(F90) cdfstdevw.f90 -o $(BINDIR)/cdfstdevw cdfio.o modcdfnames.o $(FFLAGS)
cdfstdevts: cdfio.o cdfstdevts.f90
- $(F90) cdfstdevts.f90 -o cdfstdevts cdfio.o $(FFLAGS)
+ $(F90) cdfstdevts.f90 -o $(BINDIR)/cdfstdevts cdfio.o modcdfnames.o $(FFLAGS)
-cdfvT: cdfio.o cdfvT.f90
- $(F90) cdfvT.f90 -o cdfvT cdfio.o $(FFLAGS)
+cdfvT: cdfio.o modutils.o cdfvT.f90
+ $(F90) cdfvT.f90 -o $(BINDIR)/cdfvT cdfio.o modcdfnames.o modutils.o $(FFLAGS)
-cdfvsig: cdfio.o eos.o cdfvsig.f90
- $(F90) cdfvsig.f90 -o cdfvsig cdfio.o eos.o $(FFLAGS)
+cdfvsig: cdfio.o eos.o modutils.o cdfvsig.f90
+ $(F90) cdfvsig.f90 -o $(BINDIR)/cdfvsig cdfio.o eos.o modcdfnames.o modutils.o $(FFLAGS)
cdfspeed: cdfio.o cdfspeed.f90
- $(F90) cdfspeed.f90 -o cdfspeed cdfio.o $(FFLAGS)
+ $(F90) cdfspeed.f90 -o $(BINDIR)/cdfspeed cdfio.o modcdfnames.o $(FFLAGS)
cdfimprovechk: cdfio.o cdfimprovechk.f90
- $(F90) cdfimprovechk.f90 -o cdfimprovechk cdfio.o $(FFLAGS)
+ $(F90) cdfimprovechk.f90 -o $(BINDIR)/cdfimprovechk cdfio.o modcdfnames.o $(FFLAGS)
cdflinreg: cdfio.o cdflinreg.f90
- $(F90) cdflinreg.f90 -o cdflinreg cdfio.o $(FFLAGS)
+ $(F90) cdflinreg.f90 -o $(BINDIR)/cdflinreg cdfio.o modcdfnames.o $(FFLAGS)
## Derived quantities programs
cdfbn2: cdfio.o eos.o cdfbn2.f90
- $(F90) cdfbn2.f90 -o cdfbn2 cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfbn2.f90 -o $(BINDIR)/cdfbn2 cdfio.o eos.o modcdfnames.o $(FFLAGS)
-cdfbn2-full: cdfio.o eos.o cdfbn2-full.f90
- $(F90) cdfbn2-full.f90 -o cdfbn2-full cdfio.o eos.o $(FFLAGS)
+cdfrichardson: cdfio.o eos.o cdfrichardson.f90
+ $(F90) cdfrichardson.f90 -o $(BINDIR)/cdfrichardson cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfsig0: cdfio.o eos.o cdfsig0.f90
- $(F90) cdfsig0.f90 -o cdfsig0 cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfsig0.f90 -o $(BINDIR)/cdfsig0 cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfspice: cdfio.o eos.o cdfspice.f90
- $(F90) cdfspice.f90 -o cdfspice cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfspice.f90 -o $(BINDIR)/cdfspice cdfio.o modcdfnames.o $(FFLAGS)
cdfsigi: cdfio.o eos.o cdfsigi.f90
- $(F90) cdfsigi.f90 -o cdfsigi cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfsigi.f90 -o $(BINDIR)/cdfsigi cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfsiginsitu: cdfio.o eos.o cdfsiginsitu.f90
- $(F90) cdfsiginsitu.f90 -o cdfsiginsitu cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfsiginsitu.f90 -o $(BINDIR)/cdfsiginsitu cdfio.o eos.o modcdfnames.o $(FFLAGS)
-cdfbottomsig0: cdfio.o eos.o cdfbottomsig0.f90
- $(F90) cdfbottomsig0.f90 -o cdfbottomsig0 cdfio.o eos.o $(FFLAGS)
-
-cdfbottomsigi: cdfio.o eos.o cdfbottomsigi.f90
- $(F90) cdfbottomsigi.f90 -o cdfbottomsigi cdfio.o eos.o $(FFLAGS)
+cdfbottomsig: cdfio.o eos.o cdfbottomsig.f90
+ $(F90) cdfbottomsig.f90 -o $(BINDIR)/cdfbottomsig cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfbottom: cdfio.o cdfbottom.f90
- $(F90) cdfbottom.f90 -o cdfbottom cdfio.o $(FFLAGS)
+ $(F90) cdfbottom.f90 -o $(BINDIR)/cdfbottom cdfio.o modcdfnames.o $(FFLAGS)
cdfets: cdfio.o eos.o cdfets.f90
- $(F90) cdfets.f90 -o cdfets cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfets.f90 -o $(BINDIR)/cdfets cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfmsk: cdfio.o cdfmsk.f90
- $(F90) cdfmsk.f90 -o cdfmsk cdfio.o $(FFLAGS)
-
-cdfmsksal: cdfio.o cdfmsksal.f90
- $(F90) cdfmsksal.f90 -o cdfmsksal cdfio.o $(FFLAGS)
+ $(F90) cdfmsk.f90 -o $(BINDIR)/cdfmsk cdfio.o modcdfnames.o $(FFLAGS)
cdfmkmask: cdfio.o cdfmkmask.f90
- $(F90) cdfmkmask.f90 -o cdfmkmask cdfio.o $(FFLAGS)
-
-cdfmkmask-zone: cdfio.o cdfmkmask-zone.f90
- $(F90) cdfmkmask-zone.f90 -o cdfmkmask-zone cdfio.o $(FFLAGS)
+ $(F90) cdfmkmask.f90 -o $(BINDIR)/cdfmkmask cdfio.o modcdfnames.o $(FFLAGS)
cdfmltmask: cdfio.o cdfmltmask.f90
- $(F90) cdfmltmask.f90 -o cdfmltmask cdfio.o $(FFLAGS)
-
-cdfmltmask2: cdfio.o cdfmltmask2.f90
- $(F90) cdfmltmask2.f90 -o cdfmltmask2 cdfio.o $(FFLAGS)
+ $(F90) cdfmltmask.f90 -o $(BINDIR)/cdfmltmask cdfio.o modcdfnames.o $(FFLAGS)
cdfdifmask: cdfio.o cdfdifmask.f90
- $(F90) cdfdifmask.f90 -o cdfdifmask cdfio.o $(FFLAGS)
+ $(F90) cdfdifmask.f90 -o $(BINDIR)/cdfdifmask cdfio.o modcdfnames.o $(FFLAGS)
cdfcurl: cdfio.o cdfcurl.f90
- $(F90) cdfcurl.f90 -o cdfcurl cdfio.o $(FFLAGS)
+ $(F90) cdfcurl.f90 -o $(BINDIR)/cdfcurl cdfio.o modcdfnames.o $(FFLAGS)
cdfw: cdfio.o cdfw.f90
- $(F90) cdfw.f90 -o cdfw cdfio.o $(FFLAGS)
+ $(F90) cdfw.f90 -o $(BINDIR)/cdfw cdfio.o modcdfnames.o $(FFLAGS)
cdfgeo-uv: cdfio.o cdfgeo-uv.f90
- $(F90) cdfgeo-uv.f90 -o cdfgeo-uv cdfio.o $(FFLAGS)
+ $(F90) cdfgeo-uv.f90 -o $(BINDIR)/cdfgeo-uv cdfio.o modcdfnames.o $(FFLAGS)
cdfmxl: cdfio.o eos.o cdfmxl.f90
- $(F90) cdfmxl.f90 -o cdfmxl cdfio.o eos.o $(FFLAGS)
-
-cdfmxl-full: cdfio.o eos.o cdfmxl-full.f90
- $(F90) cdfmxl-full.f90 -o cdfmxl-full cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfmxl.f90 -o $(BINDIR)/cdfmxl cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfrhoproj: cdfio.o cdfrhoproj.f90
- $(F90) cdfrhoproj.f90 -o cdfrhoproj cdfio.o $(FFLAGS)
-
-cdfisopycdep: cdfio.o cdfisopycdep.f90
- $(F90) cdfisopycdep.f90 -o cdfisopycdep cdfio.o $(FFLAGS)
-
-cdfsigintegr: cdfio.o cdfsigintegr.f90
- $(F90) cdfsigintegr.f90 -o cdfsigintegr cdfio.o $(FFLAGS)
+ $(F90) cdfrhoproj.f90 -o $(BINDIR)/cdfrhoproj cdfio.o modcdfnames.o $(FFLAGS)
-cdfpv: cdfio.o cdfpv.f90
- $(F90) cdfpv.f90 -o cdfpv cdfio.o eos.o $(FFLAGS)
+cdfsigintegr: cdfio.o modutils.o cdfsigintegr.f90
+ $(F90) cdfsigintegr.f90 -o $(BINDIR)/cdfsigintegr cdfio.o modcdfnames.o modutils.o $(FFLAGS)
-cdflspv: cdfio.o cdflspv.f90
- $(F90) cdflspv.f90 -o cdflspv cdfio.o eos.o $(FFLAGS)
+cdfisopsi: cdfio.o eos.o cdfisopsi.f90
+ $(F90) cdfisopsi.f90 -o $(BINDIR)/cdfisopsi cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfpvor: eos.o cdfio.o cdfpvor.f90
- $(F90) cdfpvor.f90 -o cdfpvor cdfio.o eos.o $(FFLAGS)
-
-cdfpvor-full: eos.o cdfio.o cdfpvor-full.f90
- $(F90) cdfpvor-full.f90 -o cdfpvor-full cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfpvor.f90 -o $(BINDIR)/cdfpvor cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfkempemekeepe: cdfio.o cdfkempemekeepe.f90
- $(F90) cdfkempemekeepe.f90 -o cdfkempemekeepe cdfio.o $(FFLAGS)
+ $(F90) cdfkempemekeepe.f90 -o $(BINDIR)/cdfkempemekeepe cdfio.o modcdfnames.o $(FFLAGS)
cdfbci: cdfio.o cdfbci.f90
- $(F90) cdfbci.f90 -o cdfbci cdfio.o $(FFLAGS)
+ $(F90) cdfbci.f90 -o $(BINDIR)/cdfbci cdfio.o modcdfnames.o $(FFLAGS)
cdfbti: cdfio.o cdfbti.f90
- $(F90) cdfbti.f90 -o cdfbti cdfio.o $(FFLAGS)
+ $(F90) cdfbti.f90 -o $(BINDIR)/cdfbti cdfio.o modcdfnames.o $(FFLAGS)
cdfnrjcomp: cdfio.o cdfnrjcomp.f90
- $(F90) cdfnrjcomp.f90 -o cdfnrjcomp cdfio.o $(FFLAGS)
+ $(F90) cdfnrjcomp.f90 -o $(BINDIR)/cdfnrjcomp cdfio.o modcdfnames.o $(FFLAGS)
cdfhdy: cdfio.o eos.o cdfhdy.f90
- $(F90) cdfhdy.f90 -o cdfhdy cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfhdy.f90 -o $(BINDIR)/cdfhdy cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfhdy3d: cdfio.o eos.o cdfhdy3d.f90
- $(F90) cdfhdy3d.f90 -o cdfhdy3d cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfhdy3d.f90 -o $(BINDIR)/cdfhdy3d cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfmaskdmp: cdfio.o eos.o cdfmaskdmp.f90
- $(F90) cdfmaskdmp.f90 -o cdfmaskdmp cdfio.o eos.o $(FFLAGS)
-
-cdfisopsi: cdfio.o eos.o cdfisopsi.f90
- $(F90) cdfisopsi.f90 -o cdfisopsi cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfmaskdmp.f90 -o $(BINDIR)/cdfmaskdmp cdfio.o eos.o modcdfnames.o $(FFLAGS)
## Transport programs
cdfmhst: cdfio.o cdfmhst.f90
- $(F90) cdfmhst.f90 -o cdfmhst cdfio.o $(FFLAGS)
-
-cdfmhst-full: cdfio.o cdfmhst-full.f90
- $(F90) cdfmhst-full.f90 -o cdfmhst-full cdfio.o $(FFLAGS)
+ $(F90) cdfmhst.f90 -o $(BINDIR)/cdfmhst cdfio.o modcdfnames.o $(FFLAGS)
cdfvhst: cdfio.o cdfvhst.f90
- $(F90) cdfvhst.f90 -o cdfvhst cdfio.o $(FFLAGS)
+ $(F90) cdfvhst.f90 -o $(BINDIR)/cdfvhst cdfio.o modcdfnames.o $(FFLAGS)
cdfvtrp: cdfio.o cdfvtrp.f90
- $(F90) cdfvtrp.f90 -o cdfvtrp cdfio.o $(FFLAGS)
-
-cdfvhst-full: cdfio.o cdfvhst-full.f90
- $(F90) cdfvhst-full.f90 -o cdfvhst-full cdfio.o $(FFLAGS)
-
-cdfpsi: cdfio.o cdfpsi.f90
- $(F90) cdfpsi.f90 -o cdfpsi cdfio.o $(FFLAGS)
-
-cdfpsi-full: cdfio.o cdfpsi-full.f90
- $(F90) cdfpsi-full.f90 -o cdfpsi-full cdfio.o $(FFLAGS)
-
-cdfpsi-open: cdfio.o cdfpsi-open.f90
- $(F90) cdfpsi-open.f90 -o cdfpsi-open cdfio.o $(FFLAGS)
-
-cdfpsi-open-zap: cdfio.o cdfpsi-open-zap.f90
- $(F90) cdfpsi-open-zap.f90 -o cdfpsi-open-zap cdfio.o $(FFLAGS)
+ $(F90) cdfvtrp.f90 -o $(BINDIR)/cdfvtrp cdfio.o modcdfnames.o $(FFLAGS)
-cdfpsi-open_AM: cdfio.o cdfpsi-open_AM.f90
- $(F90) cdfpsi-open_AM.f90 -o cdfpsi-open_AM cdfio.o $(FFLAGS)
-
-cdfpsi-austral: cdfio.o cdfpsi-austral.f90
- $(F90) cdfpsi-austral.f90 -o cdfpsi-austral cdfio.o $(FFLAGS)
-
-cdfpsi-austral-ssh: cdfio.o cdfpsi-austral-ssh.f90
- $(F90) cdfpsi-austral-ssh.f90 -o cdfpsi-austral-ssh cdfio.o $(FFLAGS)
+cdfpsi: cdfio.o modutils.o cdfpsi.f90
+ $(F90) cdfpsi.f90 -o $(BINDIR)/cdfpsi cdfio.o modcdfnames.o modutils.o $(FFLAGS)
cdfpsi_level: cdfio.o cdfpsi_level.f90
- $(F90) cdfpsi_level.f90 -o cdfpsi_level cdfio.o $(FFLAGS)
-
-cdftransportiz: cdfio.o cdftransportiz.f90
- $(F90) cdftransportiz.f90 -o cdftransportiz cdfio.o $(FFLAGS)
-
-cdftransportiz_magda: cdfio.o cdftransportiz_magda.f90
- $(F90) cdftransportiz_magda.f90 -o cdftransportiz_magda cdfio.o $(FFLAGS)
-
-cdftransportizpm: cdfio.o cdftransportizpm.f90
- $(F90) cdftransportizpm.f90 -o cdftransportizpm cdfio.o $(FFLAGS)
-
-cdftransportiz_noheat: cdfio.o cdftransportiz_noheat.f90
- $(F90) cdftransportiz_noheat.f90 -o cdftransportiz_noheat cdfio.o $(FFLAGS)
-
-cdftransportiz_noheat_obc: cdfio.o cdftransportiz_noheat_obc.f90
- $(F90) cdftransportiz_noheat_obc.f90 -o cdftransportiz_noheat_obc cdfio.o $(FFLAGS)
+ $(F90) cdfpsi_level.f90 -o $(BINDIR)/cdfpsi_level cdfio.o modcdfnames.o $(FFLAGS)
-cdftransportiz-full: cdfio.o cdftransportiz-full.f90
- $(F90) cdftransportiz-full.f90 -o cdftransportiz-full cdfio.o $(FFLAGS)
+cdftransport: cdfio.o modutils.o cdftransport.f90
+ $(F90) cdftransport.f90 -o $(BINDIR)/cdftransport cdfio.o modcdfnames.o modutils.o $(FFLAGS)
-cdfmasstrp: cdfio.o cdfmasstrp.f90
- $(F90) cdfmasstrp.f90 -o cdfmasstrp cdfio.o $(FFLAGS)
+cdfsigtrp: cdfio.o eos.o modutils.o cdfsigtrp.f90
+ $(F90) cdfsigtrp.f90 -o $(BINDIR)/cdfsigtrp cdfio.o eos.o modcdfnames.o modutils.o $(FFLAGS)
-cdfmasstrp-full: cdfio.o cdfmasstrp-full.f90
- $(F90) cdfmasstrp-full.f90 -o cdfmasstrp-full cdfio.o $(FFLAGS)
-
-cdfmasstrp-julien: cdfio.o cdfmasstrp-julien.f90
- $(F90) cdfmasstrp-julien.f90 -o cdfmasstrp-julien cdfio.o $(FFLAGS)
-
-cdfsigtrp: cdfio.o cdfsigtrp.f90
- $(F90) cdfsigtrp.f90 -o cdfsigtrp cdfio.o eos.o $(FFLAGS)
-
-cdfsigitrp: cdfio.o cdfsigitrp.f90
- $(F90) cdfsigitrp.f90 -o cdfsigitrp cdfio.o eos.o $(FFLAGS)
-
-cdfsigtrp-full: cdfio.o cdfsigtrp-full.f90
- $(F90) cdfsigtrp-full.f90 -o cdfsigtrp-full cdfio.o eos.o $(FFLAGS)
-
-cdftemptrp-full: cdfio.o cdftemptrp-full.f90
- $(F90) cdftemptrp-full.f90 -o cdftemptrp-full cdfio.o $(FFLAGS)
+cdftransig_xy3d: cdfio.o eos.o modutils.o cdftransig_xy3d.f90
+ $(F90) cdftransig_xy3d.f90 -o $(BINDIR)/cdftransig_xy3d cdfio.o eos.o modcdfnames.o modutils.o $(FFLAGS)
cdftempvol-full: cdfio.o cdftempvol-full.f90
- $(F90) cdftempvol-full.f90 -o cdftempvol-full cdfio.o $(FFLAGS)
-
-cdfmoc: cdfio.o cdfmoc.f90
- $(F90) cdfmoc.f90 -o cdfmoc cdfio.o $(FFLAGS)
+ $(F90) cdftempvol-full.f90 -o $(BINDIR)/cdftempvol-full cdfio.o modcdfnames.o $(FFLAGS)
-cdfmoc_gsop: cdfio.o eos.o cdfmoc_gsop.f90
- $(F90) cdfmoc_gsop.f90 -o cdfmoc_gsop cdfio.o eos.o $(FFLAGS)
+cdfmoc: cdfio.o eos.o cdfmoc.f90
+ $(F90) cdfmoc.f90 -o $(BINDIR)/cdfmoc cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfmht_gsop: cdfio.o eos.o cdfmht_gsop.f90
- $(F90) cdfmht_gsop.f90 -o cdfmht_gsop cdfio.o eos.o $(FFLAGS)
-
-cdfmoc_gsop_x: cdfio.o eos.o cdfmoc_gsop_x.f90
- $(F90) cdfmoc_gsop_x.f90 -o cdfmoc_gsop_x cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfmht_gsop.f90 -o $(BINDIR)/cdfmht_gsop cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfmoc_rapid_26N_r8_ORCA025: cdfio.o eos.o cdfmoc_rapid_26N_r8_ORCA025.f90
- $(F90) cdfmoc_rapid_26N_r8_ORCA025.f90 -o cdfmoc_rapid_26N_r8_ORCA025 cdfio.o eos.o $(FFLAGS)
-
-cdfmocsig: cdfio.o eos.o cdfmocsig.f90
- $(F90) cdfmocsig.f90 -o cdfmocsig cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfmoc_rapid_26N_r8_ORCA025.f90 -o $(BINDIR)/cdfmoc_rapid_26N_r8_ORCA025 cdfio.o eos.o $(FFLAGS)
-cdfmoc-full: cdfio.o cdfmoc-full.f90
- $(F90) cdfmoc-full.f90 -o cdfmoc-full cdfio.o $(FFLAGS)
-
-cdfmocatl: cdfio.o cdfmocatl.f90
- $(F90) cdfmocatl.f90 -o cdfmocatl cdfio.o $(FFLAGS)
+cdfmocsig: cdfio.o eos.o modutils.o cdfmocsig.f90
+ $(F90) cdfmocsig.f90 -o $(BINDIR)/cdfmocsig cdfio.o eos.o modcdfnames.o modutils.o $(FFLAGS)
cdfmean: cdfio.o cdfmean.f90
- $(F90) cdfmean.f90 -o cdfmean cdfio.o $(FFLAGS)
+ $(F90) cdfmean.f90 -o $(BINDIR)/cdfmean cdfio.o modcdfnames.o $(FFLAGS)
cdfsum: cdfio.o cdfsum.f90
- $(F90) cdfsum.f90 -o cdfsum cdfio.o $(FFLAGS)
-
-cdfvertmean: cdfio.o cdfvertmean.f90
- $(F90) cdfvertmean.f90 -o cdfvertmean cdfio.o $(FFLAGS)
-
-cdfmeanvar: cdfio.o cdfmeanvar.f90
- $(F90) cdfmeanvar.f90 -o cdfmeanvar cdfio.o $(FFLAGS)
-
-cdfmean-full: cdfio.o cdfmean-full.f90
- $(F90) cdfmean-full.f90 -o cdfmean-full cdfio.o $(FFLAGS)
+ $(F90) cdfsum.f90 -o $(BINDIR)/cdfsum cdfio.o modcdfnames.o $(FFLAGS)
-cdfzeromean: cdfio.o cdfzeromean.f90
- $(F90) cdfzeromean.f90 -o cdfzeromean cdfio.o $(FFLAGS)
+cdfvertmean: cdfio.o modutils.o cdfvertmean.f90
+ $(F90) cdfvertmean.f90 -o $(BINDIR)/cdfvertmean cdfio.o modcdfnames.o modutils.o $(FFLAGS)
-cdfheatc: cdfio.o cdfheatc.f90
- $(F90) cdfheatc.f90 -o cdfheatc cdfio.o $(FFLAGS)
+cdfheatc: cdfio.o modutils.o cdfheatc.f90
+ $(F90) cdfheatc.f90 -o $(BINDIR)/cdfheatc cdfio.o modcdfnames.o modutils.o $(FFLAGS)
-cdfheatc-full: cdfio.o cdfheatc-full.f90
- $(F90) cdfheatc-full.f90 -o cdfheatc-full cdfio.o $(FFLAGS)
+cdfmxlheatc: cdfio.o modutils.o cdfmxlheatc.f90
+ $(F90) cdfmxlheatc.f90 -o $(BINDIR)/cdfmxlheatc cdfio.o modcdfnames.o modutils.o $(FFLAGS)
-cdfmxlheatc: cdfio.o cdfmxlheatc.f90
- $(F90) cdfmxlheatc.f90 -o cdfmxlheatc cdfio.o $(FFLAGS)
-
-cdfmxlheatc-full: cdfio.o cdfmxlheatc-full.f90
- $(F90) cdfmxlheatc-full.f90 -o cdfmxlheatc-full cdfio.o $(FFLAGS)
-
-cdfmxlsaltc: cdfio.o cdfmxlsaltc.f90
- $(F90) cdfmxlsaltc.f90 -o cdfmxlsaltc cdfio.o $(FFLAGS)
+cdfmxlsaltc: cdfio.o modutils.o cdfmxlsaltc.f90
+ $(F90) cdfmxlsaltc.f90 -o $(BINDIR)/cdfmxlsaltc cdfio.o modcdfnames.o modutils.o $(FFLAGS)
cdfmxlhcsc: cdfio.o eos.o cdfmxlhcsc.f90
- $(F90) cdfmxlhcsc.f90 -o cdfmxlhcsc cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfmxlhcsc.f90 -o $(BINDIR)/cdfmxlhcsc cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdficediags: cdfio.o cdficediags.f90
- $(F90) cdficediags.f90 -o cdficediags cdfio.o $(FFLAGS)
+ $(F90) cdficediags.f90 -o $(BINDIR)/cdficediags cdfio.o modcdfnames.o $(FFLAGS)
cdfzonalmean: cdfio.o cdfzonalmean.f90
- $(F90) cdfzonalmean.f90 -o cdfzonalmean cdfio.o $(FFLAGS)
+ $(F90) cdfzonalmean.f90 -o $(BINDIR)/cdfzonalmean cdfio.o modcdfnames.o $(FFLAGS)
cdfzonalsum: cdfio.o cdfzonalsum.f90
- $(F90) cdfzonalsum.f90 -o cdfzonalsum cdfio.o $(FFLAGS)
+ $(F90) cdfzonalsum.f90 -o $(BINDIR)/cdfzonalsum cdfio.o modcdfnames.o $(FFLAGS)
cdfzonalout: cdfio.o cdfzonalout.f90
- $(F90) cdfzonalout.f90 -o cdfzonalout cdfio.o $(FFLAGS)
-
-cdfzonalintdeg: cdfio.o cdfzonalintdeg.f90
- $(F90) cdfzonalintdeg.f90 -o cdfzonalintdeg cdfio.o $(FFLAGS)
+ $(F90) cdfzonalout.f90 -o $(BINDIR)/cdfzonalout cdfio.o modcdfnames.o $(FFLAGS)
cdfhflx: cdfio.o cdfhflx.f90
- $(F90) cdfhflx.f90 -o cdfhflx cdfio.o $(FFLAGS)
+ $(F90) cdfhflx.f90 -o $(BINDIR)/cdfhflx cdfio.o modcdfnames.o $(FFLAGS)
cdfwflx: cdfio.o cdfwflx.f90
- $(F90) cdfwflx.f90 -o cdfwflx cdfio.o $(FFLAGS)
+ $(F90) cdfwflx.f90 -o $(BINDIR)/cdfwflx cdfio.o modcdfnames.o $(FFLAGS)
cdfbuoyflx: cdfio.o eos.o cdfbuoyflx.f90
- $(F90) cdfbuoyflx.f90 -o cdfbuoyflx cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfbuoyflx.f90 -o $(BINDIR)/cdfbuoyflx cdfio.o eos.o modcdfnames.o $(FFLAGS)
## Extracting tools, information tools
cdfprofile: cdfio.o cdfprofile.f90
- $(F90) cdfprofile.f90 -o cdfprofile cdfio.o $(FFLAGS)
+ $(F90) cdfprofile.f90 -o $(BINDIR)/cdfprofile cdfio.o modcdfnames.o $(FFLAGS)
cdfwhereij:cdfio.o cdfwhereij.f90
- $(F90) cdfwhereij.f90 -o cdfwhereij cdfio.o $(FFLAGS)
+ $(F90) cdfwhereij.f90 -o $(BINDIR)/cdfwhereij cdfio.o modcdfnames.o $(FFLAGS)
-cdffindij: cdftools.o cdffindij.f90
- $(F90) cdffindij.f90 -o cdffindij cdfio.o cdftools.o $(FFLAGS)
+cdffindij: cdfio.o cdftools.o cdffindij.f90
+ $(F90) cdffindij.f90 -o $(BINDIR)/cdffindij cdfio.o cdftools.o modcdfnames.o $(FFLAGS)
cdf_use_lib: cdftools.o cdf_use_lib.f90
- $(F90) cdf_use_lib.f90 -o cdf_use_lib cdfio.o cdftools.o $(FFLAGS)
+ $(F90) cdf_use_lib.f90 -o $(BINDIR)/cdf_use_lib cdfio.o cdftools.o $(FFLAGS)
-cdfweight: cdfio.o cdfweight.f90
- $(F90) cdfweight.f90 -o cdfweight cdfio.o $(FFLAGS)
+cdfweight: cdfio.o cdftools.o cdfweight.f90
+ $(F90) cdfweight.f90 -o $(BINDIR)/cdfweight cdfio.o cdftools.o modcdfnames.o $(FFLAGS)
cdfweight2D: cdfio.o cdfweight2D.f90
- $(F90) cdfweight2D.f90 -o cdfweight2D cdfio.o $(FFLAGS)
+ $(F90) cdfweight2D.f90 -o $(BINDIR)/cdfweight2D cdfio.o $(FFLAGS)
cdfcoloc: cdfio.o cdfcoloc.f90
- $(F90) cdfcoloc.f90 -o cdfcoloc cdfio.o $(FFLAGS)
+ $(F90) cdfcoloc.f90 -o $(BINDIR)/cdfcoloc cdfio.o modcdfnames.o $(FFLAGS)
cdfcoloc2D: cdfio.o cdfcoloc2D.f90
- $(F90) cdfcoloc2D.f90 -o cdfcoloc2D cdfio.o $(FFLAGS)
+ $(F90) cdfcoloc2D.f90 -o $(BINDIR)/cdfcoloc2D cdfio.o $(FFLAGS)
cdfcoloc2: cdfio.o cdfcoloc2.f90
- $(F90) cdfcoloc2.f90 -o cdfcoloc2 cdfio.o $(FFLAGS)
+ $(F90) cdfcoloc2.f90 -o $(BINDIR)/cdfcoloc2 cdfio.o $(FFLAGS)
cdfcoloc3: cdfio.o cdfcoloc3.f90
- $(F90) cdfcoloc3.f90 -o cdfcoloc3 cdfio.o $(FFLAGS)
+ $(F90) cdfcoloc3.f90 -o $(BINDIR)/cdfcoloc3 cdfio.o $(FFLAGS)
cdfstatcoord: cdfio.o cdfstatcoord.f90
- $(F90) cdfstatcoord.f90 -o cdfstatcoord cdfio.o $(FFLAGS)
+ $(F90) cdfstatcoord.f90 -o $(BINDIR)/cdfstatcoord cdfio.o modcdfnames.o $(FFLAGS)
-cdfmaxmoc: cdfio.o cdfmaxmoc.f90
- $(F90) cdfmaxmoc.f90 -o cdfmaxmoc cdfio.o $(FFLAGS)
+cdfmaxmoc: cdfio.o cdfmaxmoc.f90
+ $(F90) cdfmaxmoc.f90 -o $(BINDIR)/cdfmaxmoc cdfio.o modcdfnames.o $(FFLAGS)
cdfcensus: cdfio.o eos.o cdfcensus.f90
- $(F90) cdfcensus.f90 -o cdfcensus cdfio.o eos.o $(FFLAGS)
+ $(F90) cdfcensus.f90 -o $(BINDIR)/cdfcensus cdfio.o eos.o modcdfnames.o $(FFLAGS)
cdfzoom: cdfio.o cdfzoom.f90
- $(F90) cdfzoom.f90 -o cdfzoom cdfio.o $(FFLAGS)
+ $(F90) cdfzoom.f90 -o $(BINDIR)/cdfzoom cdfio.o modcdfnames.o $(FFLAGS)
cdfmax: cdfio.o cdfmax.f90
- $(F90) cdfmax.f90 -o cdfmax cdfio.o $(FFLAGS)
-
-cdfmax_sp: cdfio.o cdfmax_sp.f90
- $(F90) cdfmax_sp.f90 -o cdfmax_sp cdfio.o $(FFLAGS)
+ $(F90) cdfmax.f90 -o $(BINDIR)/cdfmax cdfio.o modcdfnames.o $(FFLAGS)
cdfprobe: cdfio.o cdfprobe.f90
- $(F90) cdfprobe.f90 -o cdfprobe cdfio.o $(FFLAGS)
+ $(F90) cdfprobe.f90 -o $(BINDIR)/cdfprobe cdfio.o modcdfnames.o $(FFLAGS)
cdfinfo: cdfio.o cdfinfo.f90
- $(F90) cdfinfo.f90 -o cdfinfo cdfio.o $(FFLAGS)
+ $(F90) cdfinfo.f90 -o $(BINDIR)/cdfinfo cdfio.o modcdfnames.o $(FFLAGS)
cdfclip: cdfio.o cdfclip.f90
- $(F90) cdfclip.f90 -o cdfclip cdfio.o $(FFLAGS)
+ $(F90) cdfclip.f90 -o $(BINDIR)/cdfclip cdfio.o modcdfnames.o $(FFLAGS)
cdfsmooth: cdfio.o cdfsmooth.f90
- $(F90) cdfsmooth.f90 -o cdfsmooth cdfio.o $(FFLAGS)
+ $(F90) cdfsmooth.f90 -o $(BINDIR)/cdfsmooth cdfio.o modcdfnames.o $(FFLAGS)
cdfpendep: cdfio.o cdfpendep.f90
- $(F90) cdfpendep.f90 -o cdfpendep cdfio.o $(FFLAGS)
+ $(F90) cdfpendep.f90 -o $(BINDIR)/cdfpendep cdfio.o modcdfnames.o $(FFLAGS)
cdffracinv: cdfio.o cdffracinv.f90
- $(F90) cdffracinv.f90 -o cdffracinv cdfio.o $(FFLAGS)
+ $(F90) cdffracinv.f90 -o $(BINDIR)/cdffracinv cdfio.o modcdfnames.o $(FFLAGS)
cdfzgrv3: cdfio.o cdfzgrv3.f90
- $(F90) cdfzgrv3.f90 -o cdfzgrv3 cdfio.o $(FFLAGS)
-
-cdf2matlab: cdfio.o cdf2matlab.f90
- $(F90) cdf2matlab.f90 -o cdf2matlab cdfio.o $(FFLAGS)
+ $(F90) cdfzgrv3.f90 -o $(BINDIR)/cdfzgrv3 cdfio.o $(FFLAGS)
## reformating programs
cdf16bit: cdfio.o cdf16bit.f90
- $(F90) cdf16bit.f90 -o cdf16bit cdfio.o $(FFLAGS)
+ $(F90) cdf16bit.f90 -o $(BINDIR)/cdf16bit cdfio.o modcdfnames.o $(FFLAGS)
-cdfvita: cdfio.o cdfvita.f90
- $(F90) cdfvita.f90 -o cdfvita cdfio.o $(FFLAGS)
+cdf2matlab: cdfio.o cdf2matlab.f90
+ $(F90) cdf2matlab.f90 -o $(BINDIR)/cdf2matlab cdfio.o modcdfnames.o $(FFLAGS)
-cdftrp_bathy: cdfio.o cdftrp_bathy.f90
- $(F90) cdftrp_bathy.f90 -o cdftrp_bathy cdfio.o $(FFLAGS)
+cdfvita: cdfio.o cdfvita.f90
+ $(F90) cdfvita.f90 -o $(BINDIR)/cdfvita cdfio.o modcdfnames.o $(FFLAGS)
cdfconvert: cdfio.o cdfconvert.f90
- $(F90) cdfconvert.f90 -o cdfconvert cdfio.o $(FFLAGS)
+ $(F90) cdfconvert.f90 -o $(BINDIR)/cdfconvert cdfio.o modcdfnames.o $(FFLAGS)
cdfflxconv: cdfio.o cdfflxconv.f90
- $(F90) cdfflxconv.f90 -o cdfflxconv cdfio.o $(FFLAGS)
+ $(F90) cdfflxconv.f90 -o $(BINDIR)/cdfflxconv cdfio.o modcdfnames.o $(FFLAGS)
cdfsstconv: cdfio.o cdfsstconv.f90
- $(F90) cdfsstconv.f90 -o cdfsstconv cdfio.o $(FFLAGS)
+ $(F90) cdfsstconv.f90 -o $(BINDIR)/cdfsstconv cdfio.o modcdfnames.o $(FFLAGS)
cdfstrconv: cdfio.o cdfstrconv.f90
- $(F90) cdfstrconv.f90 -o cdfstrconv cdfio.o $(FFLAGS)
+ $(F90) cdfstrconv.f90 -o $(BINDIR)/cdfstrconv cdfio.o modcdfnames.o $(FFLAGS)
cdfbathy: cdfio.o cdfbathy.f90
- $(F90) cdfbathy.f90 -o cdfbathy cdfio.o $(FFLAGS)
+ $(F90) cdfbathy.f90 -o $(BINDIR)/cdfbathy cdfio.o modcdfnames.o $(FFLAGS)
cdfcofdis: cdfio.o cdfcofdis.f90
- $(F90) cdfcofdis.f90 -o cdfcofdis cdfio.o $(FFLAGS)
+ $(F90) cdfcofdis.f90 -o $(BINDIR)/cdfcofdis cdfio.o modcdfnames.o $(FFLAGS)
cdfcoastline: cdfio.o cdfcoastline.f90
- $(F90) cdfcoastline.f90 -o cdfcoastline cdfio.o $(FFLAGS)
+ $(F90) cdfcoastline.f90 -o $(BINDIR)/cdfcoastline cdfio.o modcdfnames.o $(FFLAGS)
-cdfvar: cdfio.o cdfvar.f90
- $(F90) cdfvar.f90 -o cdfvar cdfio.o $(FFLAGS)
+cdfvar: cdfbathy
+ ln -sf cdfbathy $(BINDIR)/cdfvar
cdfcsp: cdfio.o cdfcsp.f90
- $(F90) cdfcsp.f90 -o cdfcsp cdfio.o $(FFLAGS)
+ $(F90) cdfcsp.f90 -o $(BINDIR)/cdfcsp cdfio.o modcdfnames.o $(FFLAGS)
cdfnan: cdfio.o cdfnan.f90
- $(F90) cdfnan.f90 -o cdfnan cdfio.o $(FFLAGS)
+ $(F90) cdfnan.f90 -o $(BINDIR)/cdfnan cdfio.o modcdfnames.o $(FFLAGS)
cdfnorth_unfold: cdfio.o cdfnorth_unfold.f90
- $(F90) cdfnorth_unfold.f90 -o cdfnorth_unfold cdfio.o $(FFLAGS)
+ $(F90) cdfnorth_unfold.f90 -o $(BINDIR)/cdfnorth_unfold cdfio.o modcdfnames.o $(FFLAGS)
cdfpolymask: cdfio.o modpoly.o cdfpolymask.f90
- $(F90) cdfpolymask.f90 -o cdfpolymask cdfio.o modpoly.o $(FFLAGS)
+ $(F90) cdfpolymask.f90 -o $(BINDIR)/cdfpolymask cdfio.o modpoly.o modcdfnames.o $(FFLAGS)
cdfovide: cdfio.o cdfovide.f90
- $(F90) cdfovide.f90 -o cdfovide cdfio.o $(FFLAGS)
+ $(F90) cdfovide.f90 -o $(BINDIR)/cdfovide cdfio.o modcdfnames.o $(FFLAGS)
cdfmppini: cdfio.o cdfmppini.f90
- $(F90) cdfmppini.f90 -o cdfmppini cdfio.o $(FFLAGS)
+ $(F90) cdfmppini.f90 -o $(BINDIR)/cdfmppini cdfio.o modcdfnames.o $(FFLAGS)
cdffixtime: cdfio.o cdffixtime.f90
- $(F90) cdffixtime.f90 -o cdffixtime cdfio.o $(FFLAGS)
+ $(F90) cdffixtime.f90 -o $(BINDIR)/cdffixtime cdfio.o modcdfnames.o $(FFLAGS)
+
+cdfnamelist: modcdfnames.o cdfnamelist.f90
+ $(F90) cdfnamelist.f90 -o $(BINDIR)/cdfnamelist modcdfnames.o $(FFLAGS)
# OLD bimg/dimg stuff: use by the trpsig monitoring....
cdfsections: eos.o cdfsections.f90
- $(F90) cdfsections.f90 -o cdfsections eos.o $(FFLAGS)
-
-bimgmoy4: bimgmoy4.f90
- $(F90) bimgmoy4.f90 -o bimgmoy4 $(FFLAGS)
-
-bimgcaltrans: bimgcaltrans.f90
- $(F90) bimgcaltrans.f90 -o bimgcaltrans $(FFLAGS)
-
-coordinates2hgr: coordinates2hgr.f90
- $(F90) coordinates2hgr.f90 -o coordinates2hgr $(FFLAGS)
-
-coordinates2zgr: coordinates2zgr.f90
- $(F90) coordinates2zgr.f90 -o coordinates2zgr $(FFLAGS)
-
-coordinates2hgr_karine: coordinates2hgr_karine.f90
- $(F90) coordinates2hgr_karine.f90 -o coordinates2hgr_karine $(FFLAGS)
-
-coordinates2zgr_karine: coordinates2zgr_karine.f90
- $(F90) coordinates2zgr_karine.f90 -o coordinates2zgr_karine $(FFLAGS)
+ $(F90) cdfsections.f90 -o $(BINDIR)/cdfsections eos.o modcdfnames.o $(FFLAGS)
## Modules
-cdfio.o: cdfio.f90
+cdfio.o: cdfio.f90 modcdfnames.o
$(F90) -c cdfio.f90 $(FFLAGS)
eos.o: eos.f90
@@ -545,17 +393,18 @@ cdftools.o: cdfio.o cdftools.f90
modpoly.o: modpoly.f90
$(F90) -c modpoly.f90 $(FFLAGS)
-## Utilities
-tar:
- ( cd ../ ; tar cf cdftools-2.1.tar $(CDFTOOLS)/*90 $(CDFTOOLS)/Make* \
- $(CDFTOOLS)/section.dat $(CDFTOOLS)/JOBS $(CDFTOOLS)/DOC \
- $(CDFTOOLS)/macro.* )
+modcdfnames.o: modcdfnames.f90
+ $(F90) -c modcdfnames.f90 $(FFLAGS)
+
+modutils.o: cdfio.o modutils.f90
+ $(F90) -c modutils.f90 $(FFLAGS)
+## Utilities
clean:
\rm -f *.mod *.o *~
cleanexe: clean
- \rm -f $(EXEC)
+ ( cd $(BINDIR) ; \rm -f $(EXEC) )
install:
\cp $(EXEC) $(INSTALL)
diff --git a/Makefile_ursus b/Makefile_ursus
deleted file mode 100644
index fa33133..0000000
--- a/Makefile_ursus
+++ /dev/null
@@ -1,241 +0,0 @@
-# Makefile for CDFTOOLS
-
-# ( make.macro is a link that points to the file macro.xxx where
-# xxx is representative of your machine )
-
-# !! $Rev$
-# !! $Date$
-# !! $Id$
-# !!--------------------------------------------------------------
-
-include make.macro
-
-
-CDFTOOLS=CDFTOOLS-2.1
-
-EXEC = cdfmoy cdfmoy_sp cdfmoy_sal2_temp2 cdfvT cdfeke cdfrmsssh cdfstdevw cdfstdevts cdfimprovechk\
- cdfbn2 cdfsig0 cdfbottomsig0 cdfbottom cdfets cdfcurl cdfw cdfmxl \
- cdfrhoproj cdfpv cdfpvor\
- cdfmhst cdfmhst-full cdfvhst cdfvhst-full cdftransportiz cdftransportiz-full cdftransportiz_noheat cdfmasstrp \
- cdfsigtrp cdfsigtrp-full\
- cdfpsi cdfpsi-full cdfmoc cdfmoc-full cdfmocatl cdfmocsig cdfmean cdfmeanvar cdfmean-full\
- cdfheatc cdfzonalmean cdfhflx\
- cdfmxlheatc cdfmxlsaltc \
- cdfzonalsum cdficediags cdfzonalout\
- cdfprofile cdfwhereij cdffindij cdfmaxmoc cdfcensus cdfzoom cdfmax \
- bimgmoy4 bimgcaltrans cdf16bit cdfvita
-
-
-all: $(EXEC)
-
-## Statistical programs
-cdfmoy: cdfio.o cdfmoy.f90
- $(F90) cdfmoy.f90 -o cdfmoy cdfio.o $(FFLAGS)
-
-cdfmoy_sal2_temp2: cdfio.o cdfmoy_sal2_temp2.f90
- $(F90) cdfmoy_sal2_temp2.f90 -o cdfmoy_sal2_temp2 cdfio.o $(FFLAGS)
-
-cdfmoy_sp: cdfio.o cdfmoy_sp.f90
- $(F90) cdfmoy_sp.f90 -o cdfmoy_sp cdfio.o $(FFLAGS)
-
-cdfeke: cdfio.o cdfeke.f90
- $(F90) cdfeke.f90 -o cdfeke cdfio.o $(FFLAGS)
-
-cdfrmsssh: cdfio.o cdfrmsssh.f90
- $(F90) cdfrmsssh.f90 -o cdfrmsssh cdfio.o $(FFLAGS)
-
-cdfstdevw: cdfio.o cdfstdevw.f90
- $(F90) cdfstdevw.f90 -o cdfstdevw cdfio.o $(FFLAGS)
-
-cdfstdevts: cdfio.o cdfstdevts.f90
- $(F90) cdfstdevts.f90 -o cdfstdevts cdfio.o $(FFLAGS)
-
-cdfvT: cdfio.o cdfvT.f90
- $(F90) cdfvT.f90 -o cdfvT cdfio.o $(FFLAGS)
-
-cdfimprovechk: cdfio.o cdfimprovechk.f90
- $(F90) cdfimprovechk.f90 -o cdfimprovechk cdfio.o $(FFLAGS)
-
-## Derived quantities programs
-cdfbn2: cdfio.o eos.o cdfbn2.f90
- $(F90) cdfbn2.f90 -o cdfbn2 cdfio.o eos.o $(FFLAGS)
-
-cdfsig0: cdfio.o eos.o cdfsig0.f90
- $(F90) cdfsig0.f90 -o cdfsig0 cdfio.o eos.o $(FFLAGS)
-
-cdfbottomsig0: cdfio.o eos.o cdfbottomsig0.f90
- $(F90) cdfbottomsig0.f90 -o cdfbottomsig0 cdfio.o eos.o $(FFLAGS)
-
-cdfbottom: cdfio.o cdfbottom.f90
- $(F90) cdfbottom.f90 -o cdfbottom cdfio.o $(FFLAGS)
-
-cdfets: cdfio.o eos.o cdfets.f90
- $(F90) cdfets.f90 -o cdfets cdfio.o eos.o $(FFLAGS)
-
-cdfmsk: cdfio.o cdfmsk.f90
- $(F90) cdfmsk.f90 -o cdfmsk cdfio.o $(FFLAGS)
-
-cdfmsksal: cdfio.o cdfmsksal.f90
- $(F90) cdfmsksal.f90 -o cdfmsksal cdfio.o $(FFLAGS)
-
-cdfcurl: cdfio.o cdfcurl.f90
- $(F90) cdfcurl.f90 -o cdfcurl cdfio.o $(FFLAGS)
-
-cdfw: cdfio.o cdfw.f90
- $(F90) cdfw.f90 -o cdfw cdfio.o $(FFLAGS)
-
-cdfmxl: cdfio.o eos.o cdfmxl.f90
- $(F90) cdfmxl.f90 -o cdfmxl cdfio.o eos.o $(FFLAGS)
-
-cdfrhoproj: cdfio.o cdfrhoproj.f90
- $(F90) cdfrhoproj.f90 -o cdfrhoproj cdfio.o $(FFLAGS)
-
-cdfpv: cdfio.o cdfpv.f90
- $(F90) cdfpv.f90 -o cdfpv cdfio.o eos.o $(FFLAGS)
-
-cdfpvor: cdfio.o cdfpvor.f90
- $(F90) cdfpvor.f90 -o cdfpvor cdfio.o eos.o $(FFLAGS)
-
-## Transport programs
-cdfmhst: cdfio.o cdfmhst.f90
- $(F90) cdfmhst.f90 -o cdfmhst cdfio.o $(FFLAGS)
-
-cdfmhst-full: cdfio.o cdfmhst-full.f90
- $(F90) cdfmhst-full.f90 -o cdfmhst-full cdfio.o $(FFLAGS)
-
-cdfvhst: cdfio.o cdfvhst.f90
- $(F90) cdfvhst.f90 -o cdfvhst cdfio.o $(FFLAGS)
-
-cdfvhst-full: cdfio.o cdfvhst-full.f90
- $(F90) cdfvhst-full.f90 -o cdfvhst-full cdfio.o $(FFLAGS)
-
-cdfpsi: cdfio.o cdfpsi.f90
- $(F90) cdfpsi.f90 -o cdfpsi cdfio.o $(FFLAGS)
-
-cdfpsi-full: cdfio.o cdfpsi-full.f90
- $(F90) cdfpsi-full.f90 -o cdfpsi-full cdfio.o $(FFLAGS)
-
-cdftransportiz: cdfio.o cdftransportiz.f90
- $(F90) cdftransportiz.f90 -o cdftransportiz cdfio.o $(FFLAGS)
-
-cdftransportiz_noheat: cdfio.o cdftransportiz_noheat.f90
- $(F90) cdftransportiz_noheat.f90 -o cdftransportiz_noheat cdfio.o $(FFLAGS)
-
-cdftransportiz-full: cdfio.o cdftransportiz-full.f90
- $(F90) cdftransportiz-full.f90 -o cdftransportiz-full cdfio.o $(FFLAGS)
-
-cdfmasstrp: cdfio.o cdfmasstrp.f90
- $(F90) cdfmasstrp.f90 -o cdfmasstrp cdfio.o $(FFLAGS)
-
-cdfmasstrp-julien: cdfio.o cdfmasstrp-julien.f90
- $(F90) cdfmasstrp-julien.f90 -o cdfmasstrp-julien cdfio.o $(FFLAGS)
-
-cdfsigtrp: cdfio.o cdfsigtrp.f90
- $(F90) cdfsigtrp.f90 -o cdfsigtrp cdfio.o eos.o $(FFLAGS)
-
-cdfsigtrp-full: cdfio.o cdfsigtrp-full.f90
- $(F90) cdfsigtrp-full.f90 -o cdfsigtrp-full cdfio.o eos.o $(FFLAGS)
-
-cdfmoc: cdfio.o cdfmoc.f90
- $(F90) cdfmoc.f90 -o cdfmoc cdfio.o $(FFLAGS)
-
-cdfmocsig: cdfio.o eos.o cdfmocsig.f90
- $(F90) cdfmocsig.f90 -o cdfmocsig cdfio.o eos.o $(FFLAGS)
-
-cdfmoc-full: cdfio.o cdfmoc-full.f90
- $(F90) cdfmoc-full.f90 -o cdfmoc-full cdfio.o $(FFLAGS)
-
-cdfmocatl: cdfio.o cdfmocatl.f90
- $(F90) cdfmocatl.f90 -o cdfmocatl cdfio.o $(FFLAGS)
-
-cdfmean: cdfio.o cdfmean.f90
- $(F90) cdfmean.f90 -o cdfmean cdfio.o $(FFLAGS)
-
-cdfmeanvar: cdfio.o cdfmeanvar.f90
- $(F90) cdfmeanvar.f90 -o cdfmeanvar cdfio.o $(FFLAGS)
-
-cdfmean-full: cdfio.o cdfmean-full.f90
- $(F90) cdfmean-full.f90 -o cdfmean-full cdfio.o $(FFLAGS)
-
-cdfheatc: cdfio.o cdfheatc.f90
- $(F90) cdfheatc.f90 -o cdfheatc cdfio.o $(FFLAGS)
-
-cdfmxlheatc: cdfio.o cdfmxlheatc.f90
- $(F90) cdfmxlheatc.f90 -o cdfmxlheatc cdfio.o $(FFLAGS)
-
-cdfmxlsaltc: cdfio.o cdfmxlsaltc.f90
- $(F90) cdfmxlsaltc.f90 -o cdfmxlsaltc cdfio.o $(FFLAGS)
-
-cdficediags: cdfio.o cdficediags.f90
- $(F90) cdficediags.f90 -o cdficediags cdfio.o $(FFLAGS)
-
-cdfzonalmean: cdfio.o cdfzonalmean.f90
- $(F90) cdfzonalmean.f90 -o cdfzonalmean cdfio.o $(FFLAGS)
-
-cdfzonalsum: cdfio.o cdfzonalsum.f90
- $(F90) cdfzonalsum.f90 -o cdfzonalsum cdfio.o $(FFLAGS)
-
-cdfzonalout: cdfio.o cdfzonalout.f90
- $(F90) cdfzonalout.f90 -o cdfzonalout cdfio.o $(FFLAGS)
-
-cdfhflx: cdfio.o cdfhflx.f90
- $(F90) cdfhflx.f90 -o cdfhflx cdfio.o $(FFLAGS)
-
-## Extracting tools, information tools
-cdfprofile: cdfio.o cdfprofile.f90
- $(F90) cdfprofile.f90 -o cdfprofile cdfio.o $(FFLAGS)
-
-cdfwhereij: cdfio.o cdfwhereij.f90
- $(F90) cdfwhereij.f90 -o cdfwhereij cdfio.o $(FFLAGS)
-
-cdffindij: cdfio.o cdffindij.f90
- $(F90) cdffindij.f90 -o cdffindij cdfio.o $(FFLAGS)
-
-cdfmaxmoc: cdfio.o cdfmaxmoc.f90
- $(F90) cdfmaxmoc.f90 -o cdfmaxmoc cdfio.o $(FFLAGS)
-
-cdfcensus: cdfio.o eos.o cdfcensus.f90
- $(F90) cdfcensus.f90 -o cdfcensus cdfio.o eos.o $(FFLAGS)
-
-cdfzoom: cdfio.o cdfzoom.f90
- $(F90) cdfzoom.f90 -o cdfzoom cdfio.o $(FFLAGS)
-
-cdfmax: cdfio.o cdfmax.f90
- $(F90) cdfmax.f90 -o cdfmax cdfio.o $(FFLAGS)
-
-## reformating programs
-cdf16bit: cdfio.o cdf16bit.f90
- $(F90) cdf16bit.f90 -o cdf16bit cdfio.o $(FFLAGS)
-
-cdfvita: cdfio.o cdfvita.f90
- $(F90) cdfvita.f90 -o cdfvita cdfio.o $(FFLAGS)
-
-
-# OLD bimg/dimg stuff: use by the trpsig monitoring....
-bimgmoy4: bimgmoy4.f90
- $(F90) bimgmoy4.f90 -o bimgmoy4 $(FFLAGS)
-
-bimgcaltrans: bimgcaltrans.f90
- $(F90) bimgcaltrans.f90 -o bimgcaltrans $(FFLAGS)
-
-## Modules
-
-cdfio.o: cdfio.f90
- $(F90) -c cdfio.f90 $(FFLAGS)
-
-eos.o: eos.f90
- $(F90) -c eos.f90 $(FFLAGS)
-## Utilities
-tar:
- ( cd ../ ; tar cf cdftools-2.1.tar $(CDFTOOLS)/*90 $(CDFTOOLS)/Make* \
- $(CDFTOOLS)/section.dat $(CDFTOOLS)/JOBS $(CDFTOOLS)/DOC \
- $(CDFTOOLS)/macro.* )
-
-clean:
- \rm -f *.mod *.o *~
-
-cleanexe: clean
- \rm -f $(EXEC)
-
-install:
- \cp $(EXEC) $(INSTALL)
diff --git a/bimgcaltrans.f90 b/bimgcaltrans.f90
deleted file mode 100644
index 0d7d390..0000000
--- a/bimgcaltrans.f90
+++ /dev/null
@@ -1,68 +0,0 @@
-PROGRAM bimgcaltrans
- !!--------------------------------------------------------------
- !! *** PROGRAM bimgcaltrans ***
- !!
- !! ** Purpose: Compute density class transport from bimg files
- !! produced by cdfsigtrp
- !!
- !! History :
- !! Original : J.M. Molines (22/03/2006)
- !!--------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- IMPLICIT NONE
- INTEGER :: npi,npj,npk,npt, npdim
- INTEGER :: ji,jj,jdim
- INTEGER :: narg, iargc
- INTEGER :: numin=10
-
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: v2d
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: sig
- REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: trp
- REAL(KIND=4) :: x1, sigmin, dx,dsig,spval, bidon
-
- CHARACTER(LEN=80) :: cfile, comm
-
- !!
- narg=iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' USAGE : bimgcaltrans bimg-file'
- STOP
- ENDIF
-
- CALL getarg(1,cfile)
- OPEN(numin,FILE=cfile,FORM='UNFORMATTED')
- READ(numin) comm
- READ(numin) comm
- READ(numin) comm
- READ(numin) comm
- READ(numin) npi,npj,npk,npt,npdim
-
- ALLOCATE ( v2d(npi,npj), sig(npj), trp(npj) )
- READ(numin) x1,sigmin, dx,dsig,spval
- READ(numin) ! skip h
- READ(numin) ! skip t
- READ(numin) ! skip 1rst dim = hiso
- READ(numin) ((v2d(ji,jj),ji=1,npi), jj=1,npj)
-
- !! Build sig
- sig(1)=-sigmin
- DO jj=2,npj
- sig(jj)=sig(1)-(jj-1)*dsig
- END DO
-
- trp(:)=0.d0
- DO jj=1,npj
- trp(jj)=SUM(v2d(:,jj))
- END DO
-
- DO jj=npj,1,-1
- PRINT 9004, sig(jj),trp(jj)
- END DO
-
-9004 FORMAT(f9.4, 20e16.7)
-
-END PROGRAM bimgcaltrans
-
diff --git a/bimgmoy4.f90 b/bimgmoy4.f90
deleted file mode 100644
index 2bbc684..0000000
--- a/bimgmoy4.f90
+++ /dev/null
@@ -1,334 +0,0 @@
-PROGRAM bimgmoy4
-!!
-!!! ----------------------------------------------------------
-!!! PROGRAM BIMGMOY4
-!!! ****************
-!!!
-!!! PURPOSE:
-!!! --------
-!!! This program read a list of bimg files (either sequential
-!!! or direct files) and compute the mean value which is dumped
-!!! to the file named moy.bimg (or moy.dimg). It also computes the
-!!! second order moment (ie the mean square of the files), and the
-!!! variance.
-!!!
-!! METHOD:
-!! -------
-!! This program assume that all the files have the same geometry.
-!! It also assumes that if the first file is a direct file all
-!! files are direct. The variance is computed as
-!! var = (mean_squared) - (mean) squared
-!! File can contain time frames (as many as you want) BUT
-!! they must be 3D files, ie you cannot have both nk AND ndim non zero.
-!!
-!! USAGE:
-!! ------
-!! bimgmoy2 'file list'
-!!
-!! OUTPUT:
-!! -------
-!! On moy.bimg/moy.dimg , moy2.bimg/moy2.dimg AND var.bimg/var.dimg
-!!
-!! EXTERNAL:
-!! --------
-!! isdirect : normally in libbimg.a
-!! iargc, getarg : libU77
-!!
-!! AUTHOR:
-!! ------
-!! J.M. Molines, May 1998
-!!!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-!! 0.0 Declarations:
-!! -----------------
- IMPLICIT NONE
-!
- INTEGER narg, iargc, nrecl
- INTEGER ni, nj, nk, ndim, icod, nt, irec, nk2, nt2, nframe
- INTEGER ji, jj, jk, jt, jfich, irecl
-!
- CHARACTER*80 cline1, cline2, cline3, cline4
- CHARACTER*80 clfil1
- CHARACTER*4 VER
-!
- REAL(KIND=4),DIMENSION(:,:), ALLOCATABLE :: v2d
- REAL(KIND=4),DIMENSION(:), ALLOCATABLE :: h1d, time_tag
- REAL x1, y1, dx, dy, spval, time_tag1,time_mean
-!
-! ... REAL*8 are necessary on workstations to avoid truncation error
-! in the variance computation.
- REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: v3d
-!
- LOGICAL lbimgflag
-!!
-!! 1.0 Initialisations:
-!! --------------------
- narg=iargc()
- IF (narg .LT. 1) THEN
- print *,'USAGE: bimgmoy4 file* [-bimg]'
- print *,' sortie sur moy.bimg | moy.dimg'
- print *,' sortie sur moy2.bimg|moy2.dimg'
- print *,' If -bimg is specified (optional) the output '
- print *,' is forced to be bimg regardless of the input format'
- STOP
- END IF
- lbimgflag = .false.
-! ... check for -bimg option
- CALL getarg(narg,clfil1)
- IF (clfil1 .EQ. '-bimg' ) THEN
- narg = narg - 1
- lbimgflag = .true.
- END IF
- CALL getarg(1,clfil1)
-
- nrecl=ISDIRECT(clfil1)
- IF ( nrecl .EQ. 0 ) THEN
-
- OPEN(10,FILE=clfil1,FORM='UNFORMATTED')
- READ(10) cline1
- READ(10) cline2
- READ(10) cline3
- READ(10) cline4
-!
- READ(10) ni,nj,nk,nt,ndim,icod
- PRINT *, ni,nj,nk,nt,ndim,icod
- CLOSE(10)
- ELSE
- OPEN(10,FILE=clfil1,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=nrecl)
- READ(10,REC=1) VER,cline1,irecl, ni,nj,nk,nt,ndim
- CLOSE(10)
- ENDIF
- nk=max(nk,ndim)
-
-
-! ALLOCATE ARRAYS
- ALLOCATE( v2d(ni,nj), v3d(ni,nj,nk), h1d(nk), time_tag(nt) )
-
-! v3d=0.d0
- time_mean = 0.
- nframe = 0
-!
-!! 2.0 Loop on files, accumulate values and squared values
-!! -------------------------------------------------------
-!!
- DO jfich = 1, narg
- CALL getarg(jfich,clfil1)
- PRINT *, ni,nj,nk,nt,ndim,icod
- print *,trim(clfil1)
-! ... check if the file is direct or not
- nrecl=ISDIRECT(clfil1)
- IF ( nrecl .EQ. 0 ) THEN
-!
-! ... The file is a bimg file ...
-!
- OPEN(10,FILE=clfil1,FORM='UNFORMATTED')
- rewind(10)
- READ(10) cline1
- READ(10) cline2
- READ(10) cline3
- READ(10) cline4
- print *, trim(cline1)
- print *, trim(cline2)
- print *, trim(cline3)
- print *, trim(cline4)
-!
-!
- READ(10) ni,nj,nk,nt,ndim,icod
-! ... Stop if the file hold more than 1 time frame or more than 1 dim
- IF ( (ndim .NE. 1) .AND. (nk .NE. 1)) THEN
- print *,' This program only works with files'
- print *,' having both nk and ndim not zero'
- print *,' Sorry .... :( '
- STOP
- END IF
- IF (ndim .NE. 1) THEN
- nk = ndim
- nk2=1
- ELSE
- nk2=nk
- ENDIF
-!
- READ(10) x1,y1,dx,dy,spval
- READ(10) (h1d(jk),jk=1,nk2)
- DO jt =1,nt
- READ(10) time_tag(jt)
- IF (jt .EQ. 1 .AND. jfich .EQ. 1 ) time_tag1=time_tag(1)
- time_mean = time_mean + time_tag(jt)/nt
-!
- DO jk=1,nk
- READ(10)((v2d(ji,jj),ji=1,ni),jj=1,nj)
- DO ji=1,ni
- DO jj=1,nj
- IF (v2d(ji,jj) .NE. spval) THEN
- v3d (ji,jj,jk) = v3d (ji,jj,jk) + dble(v2d(ji,jj))
- ELSE
- v3d (ji,jj,jk) = dble(spval)
- END IF
- END DO
- END DO
- END DO
- nframe = nframe + 1
- END DO
- CLOSE(10)
- ELSE
-!
-! ... The file is a dimg file
-!
- OPEN(10,FILE=clfil1,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=nrecl)
- READ(10,REC=1) VER,cline1,irecl, &
- & ni,nj,nk,nt,ndim, &
- & x1,y1,dx,dy,spval, &
- & (h1d(jk),jk=1,nk), &
- & (time_tag(jt),jt=1,nt)
- IF ( (ndim .NE. 1) .AND. (nk .NE. 1)) THEN
- print *,' This program only works with files'
- print *,' having both nk and ndim not zero'
- print *,' Sorry .... :( '
- STOP
- END IF
- IF (ndim .NE. 1) nk = ndim
-
- DO jt = 1, nt
- IF (jt .EQ. 1 .AND. jfich .EQ. 1 ) time_tag1=time_tag(1)
- time_mean = time_mean + time_tag(jt)/nt
- DO jk=1,nk
- irec = 2 + (jt -1)*nk + (jk -1 )
- READ(10,REC=irec)((v2d(ji,jj),ji=1,ni),jj=1,nj)
- DO ji=1,ni
- DO jj=1,nj
- IF (v2d(ji,jj) .NE. spval) THEN
- v3d (ji,jj,jk) = v3d (ji,jj,jk) + dble(v2d(ji,jj))
- ELSE
- v3d (ji,jj,jk) = dble(spval)
- END IF
- END DO
- END DO
- END DO
- nframe = nframe + 1
- END DO
- CLOSE(10)
- END IF
-! ... Loop on files
- END DO
-!
-!!
-!! 3.0 Compute mean value and mean squared value, and Variance
-!! ---------------------------------------------
- DO jk=1,nk
- DO ji=1,ni
- DO jj=1,nj
- IF(v3d(ji,jj,jk) .NE. spval) THEN
- v3d (ji,jj,jk)=v3d (ji,jj,jk) / float(nframe)
- END IF
- END DO
- END DO
- END DO
-!!
-!! 4.0 Output to bimg or dimg file (depending of the input files)
-!! The bimg format can be forced by the option -bimg
-!! --------------------------------------------------------------
- IF (ndim .NE. 1 ) THEN
- nk = 1
- nk2 = ndim
- ELSE
- nk2 = nk
- END IF
-! ... There is only one time frame in the output
- nt2 = nt
- nt = 1
- time_mean=time_mean/narg
- cline3=cline3(2:)
- IF (nrecl .EQ. 0 .OR. lbimgflag ) THEN
- OPEN(10,FILE='moy.bimg',FORM='UNFORMATTED')
-!
-! ... Mean file
-!
- WRITE(cline1,100) nframe
-100 FORMAT('MEAN values from ',i3.3,' dumps')
- WRITE(cline2,101) time_tag1, time_tag(nt2)
-101 FORMAT('computed between day ',f8.0,' and day ',f8.0)
- WRITE(cline4,'(16hMade by bimgmoy2)')
- WRITE(10) cline1
- WRITE(10) cline2
- WRITE(10) cline3
- WRITE(10) cline4
- WRITE(10) ni,nj,nk,nt,ndim,icod
- WRITE(10) x1,y1,dx,dy,spval
- WRITE(10)(h1d(jk),jk=1,nk)
- WRITE(10) time_mean
- DO jk=1,nk2
- WRITE(10)((REAL(v3d(ji,jj,jk)),ji=1,ni),jj=1,nj)
- END DO
- CLOSE(10)
-
- ELSE
-! ... DIMG file
- OPEN(10,FILE='moy.dimg',FORM='UNFORMATTED', ACCESS='DIRECT', RECL = nrecl)
-!
-! ... Mean file
-!
- WRITE(cline1,103) nframe,time_tag1, time_tag(nt2)
-103 FORMAT('MEAN values from ',i3.3,' dumps (',f8.0,'->',f8.0,')')
- WRITE(10,REC=1) VER,cline1,nrecl, &
- & ni,nj,nk,nt,ndim, &
- & x1,y1,dx,dy,spval, &
- & (h1d(jk),jk=1,nk), &
- & (time_mean,jt=1,nt)
- DO jk=1,nk2
- irec = jk+1
- WRITE(10,REC=irec)((REAL(v3d(ji,jj,jk)),ji=1,ni),jj=1,nj)
- END DO
- CLOSE(10)
- ENDIF
-
- print *,' bimgmoy2 successfull!'
-
- CONTAINS
- FUNCTION isdirect(clname)
-!!! -------------------------------------------------------------------------
-!!! FUNCTION ISDIRECT
-!!! *****************
-!!!
-!!! PURPOSE : This integer function returns the record length if clname
-!!! is a valid dimg file, it returns 0 either.
-!!!
-!!! METHOD : Open the file and look for the key characters (@!01) for
-!!! identification.
-!!!
-!!! AUTHOR : Jean-Marc Molines (Apr. 1998)
-!!! -------------------------------------------------------------------------
-!! 1.0 Declarations:
-!! -----------------
- IMPLICIT NONE
- INTEGER isdirect
- CHARACTER*(*) clname
- CHARACTER*4 VER
- CHARACTER*80 clheader
-!
- INTEGER irecl
-!!
-!! 2.0 Look for VER:
-!! ----------------
-!!
- OPEN(100,FILE=clname, &
- & FORM ='UNFORMATTED', &
- & ACCESS ='DIRECT', &
- & RECL =88)
- READ(100,REC=1) VER,clheader,irecl
- print *,'VER',VER
- CLOSE(100)
-!
- IF (VER .EQ. '@!01' ) THEN
- isdirect=irecl
- ELSE
- isdirect=0
- END IF
-!
- END FUNCTION isdirect
-
- END PROGRAM bimgmoy4
-
-
diff --git a/cdf16bit.f90 b/cdf16bit.f90
index d7dbf4e..f7c5fd5 100644
--- a/cdf16bit.f90
+++ b/cdf16bit.f90
@@ -1,536 +1,560 @@
PROGRAM cdf16bit
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdf16bit ***
+ !!======================================================================
+ !! *** PROGRAM cdf16bit ***
+ !!======================================================================
+ !! ** Purpose : Transform the 32bit precision input file into a 16bit prec.
+ !! Uses constant scale_factor and add_offset.
!!
- !! ** Purpose: Transform the 32bit precision input file into a 16bit prec.
- !! Uses constant scale_factor and add_offset
- !! Store the results on a 'cdf16bit.nc' file similar to the input file.
+ !! ** Method : Store the results on a 'cdf16bit.nc' file similar to the input file.
!! Scale factor and offset are pre-defined for authorized cdf varname
!!
- !! ** Method: read, transform and write
- !! Optional checks can be performed.
- !!
- !! history :
- !! Original code : J.M. Molines (Nov 2006 )
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Module used
+ !! History : 2.1 ! 11/2006 J.M. Molines : Original code
+ !! 3.0 ! 12/2010 J.M. Molines : Full Doctor form + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! sf_ao : Scale Factor Add Offset
+ !! check_scaling : verify that the sf_ao do not produce saturation
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv, jarg !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout !: cdf id for varout
- INTEGER(KIND=2),DIMENSION(:,:), ALLOCATABLE :: i2d !: 16 bit 2D array fro conversion
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: v2d !: Array to read a layer of data
- REAL(KIND=4), DIMENSION(1) :: tim !: time of file
- REAL(KIND=4) :: sf, ao !: scale_factor, add_offset
- REAL(KIND=4) :: zchkmax, zchkmin !: scale_factor, add_offset checking values
- REAL(KIND=4),DIMENSION(:), ALLOCATABLE ::zmax, zmin !: min and max of the field at level(jk)
- REAL(KIND=4) :: zzmax, zzmin !: min and max of the full 3D field
- REAL(KIND=4) :: spval !: missing value, fill_value, spval ...
-
- CHARACTER(LEN=256) :: cfile ,cfileout, cdum !: file name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar !: Type variable is defined in cdfio.
- !: It is used for attributes
- INTEGER :: ncout
- INTEGER :: istatus
-
- LOGICAL :: l_chk=.false., l_verbose=.false. !: logical flags to save line options
- LOGICAL, DIMENSION(:,:), ALLOCATABLE :: lmask !: 2D logical land/sea mask (true on ocean)
- !!
- !! Read command line
- narg= iargc()
+ INTEGER(KIND=4) :: jk, jt, jvar, jv ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc, ijarg !
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvars ! Number of variables in a file
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of var id's
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! arrays of var id's
+ INTEGER(KIND=2), DIMENSION(:,:), ALLOCATABLE :: i2d ! 16 bit 2D array fro conversion
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! Array to read a layer of data
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zmax, zmin ! min and max of the field at level(jk)
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time of file
+ REAL(KIND=4) :: sf, ao ! scale_factor, add_offset
+ REAL(KIND=4) :: zchkmax, zchkmin ! scale_factor, add_offset checking values
+ REAL(KIND=4) :: zzmax, zzmin ! min and max of the full 3D field
+ REAL(KIND=4) :: spval ! missing value, fill_value, spval ...
+
+ CHARACTER(LEN=256) :: cf_in ! input file
+ CHARACTER(LEN=256) :: cf_out='cdf16bit.nc' ! outputfile
+ CHARACTER(LEN=256) :: cldum ! dummy string
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! Type variable is defined in cdfio.
+
+ LOGICAL :: l_chk=.false. ! logical flags to save line options
+ LOGICAL :: l_verbose=.false. ! logical flags to save line options
+ LOGICAL, DIMENSION(:,:), ALLOCATABLE :: lmask ! 2D logical land/sea mask (true on ocean)
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdf16bit 32bit_file [ -check ] [ -verbose]'
- PRINT *,' If -check is used, control than the scale factors are adequate'
- PRINT *,' If -verbose is used, give information level by level.'
+ PRINT *,' usage : cdf16bit 32BIT-file [ -check ] [ -verbose]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Convert input 32 bit precision file into 16 bit'
+ PRINT *,' precision file using add_offset and scale_factor'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' 32BIT-file : input 32 bit file to be converted'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ -check ] : control than the scale factors are adequate'
+ PRINT *,' [ -verbose ] : give information level by level.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none '
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : same names than in input file'
STOP
ENDIF
!!
- CALL getarg (1, cfile)
+ ijarg = 1
+ CALL getarg (ijarg, cf_in) ; ijarg = ijarg + 1
+ IF ( chkfile(cf_in) ) STOP ! missing file
! Check for options and reflect options on logical flags
- IF (narg > 1 ) THEN
- DO jarg=2,narg
- CALL getarg(jarg,cdum)
- IF ( cdum == '-check' ) THEN
+ DO WHILE ( ijarg <= narg)
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1
+
+ SELECT CASE ( cldum ) ! Analyse option
+ CASE ( '-check' ) ! control if the scale factors are OK
l_chk=.true.
- ELSE IF ( cdum == '-verbose' ) THEN
+ CASE ( '-verbose' ) ! information will be given level by level
l_chk=.true. ; l_verbose=.true.
- ELSE
- PRINT *,' OPTION ',TRIM(cdum),' not supported.' ; STOP
- ENDIF
- END DO
- ENDIF
+ CASE DEFAULT
+ PRINT *,' OPTION ',TRIM(cldum),' not supported.' ; STOP
+ END SELECT
+ END DO
! get domain dimension from input file
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',kstatus=istatus)
+ npiglo = getdim (cf_in, cn_x)
+ npjglo = getdim (cf_in, cn_y)
+ npk = getdim (cf_in, cn_z, kstatus=ierr)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',kstatus=istatus)
- IF (istatus /= 0 ) STOP 'depth dimension name not suported'
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'z',kstatus=ierr)
+ IF (ierr /= 0 ) STOP 'depth dimension name not suported'
ENDIF
+ npt = getdim (cf_in, cn_t)
! Allocate memory
ALLOCATE( v2d(npiglo,npjglo), i2d(npiglo,npjglo), lmask(npiglo, npjglo) )
- ALLOCATE( zmin(npk) , zmax(npk) )
+ ALLOCATE( zmin(npk) , zmax(npk) , tim(npt))
! Get the number of variables held in the file, allocate arrays
- nvars = getnvar(cfile)
+ nvars = getnvar(cf_in)
PRINT *,' nvars =', nvars
- ALLOCATE (cvarname(nvars) )
- ALLOCATE (typvar(nvars) )
+ ALLOCATE (cv_names(nvars) )
+ ALLOCATE (stypvar(nvars) )
ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars) )
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ ! get list of variable names and collect attributes in stypvar (optional)
+ cv_names(:)=getvarname(cf_in,nvars,stypvar)
id_var(:) = (/(jv, jv=1,nvars)/)
! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars)
+ ipk(:) = getipk (cf_in,nvars)
! flags variable not to be treated by changing their name to none
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
+ WHERE( ipk == 0 ) cv_names='none'
+ stypvar(:)%cname=cv_names
! create output fileset
- cfileout='cdf16bit.nc'
-
! fills the scale_factor and add_offset attribute according to variable name
! if the variable is not documented, then, sf=1, ao=0. and no conversion
! is performed for this variable (It stays in REAL*4 )
DO jvar=1,nvars
- IF (cvarname(jvar) /= 'none' ) CALL sf_ao(jvar)
+ IF (cv_names(jvar) /= 'none' ) CALL sf_ao(jvar)
END DO
- ! create output file taking the sizes in cfile
- ncout =create(cfileout, cfile,npiglo,npjglo,npk)
+ ! create output file taking the sizes in cf_in
+ ncout =create(cf_out, cf_in,npiglo,npjglo,npk)
! The variables are created as FLOAT or SHORT depending on the scale_factor AND add_offset attribute
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk)
+ ierr= createvar(ncout , stypvar, nvars, ipk, id_varout )
+ ierr= putheadervar(ncout , cf_in, npiglo, npjglo, npk)
- ! Get time and write time
- tim=getvar1d(cfile,'time_counter',1) ; ierr=putvar1d(ncout,tim,1,'T')
+ ! Get time and write time
+ tim=getvar1d(cf_in,cn_vtimec,npt) ; ierr=putvar1d(ncout,tim,npt,'T')
! Loop on all variables of the file
DO jvar = 1,nvars
- IF (cvarname(jvar) == 'none' ) THEN
+ IF (cv_names(jvar) == 'none' ) THEN
! skip these variable they are copied in ncout by putheader above
ELSE
- sf=typvar(jvar)%scale_factor
- ao=typvar(jvar)%add_offset
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar), sf, ao
- spval=typvar(jvar)%missing_value
- DO jk = 1, ipk(jvar)
- v2d(:,:)= getvar(cfile, cvarname(jvar), jk ,npiglo, npjglo )
- IF ( sf == 1. .AND. ao == 0 ) THEN
- ! write FLOATS
- IF ( typvar(jvar)%savelog10 == 1 ) THEN
- WHERE ( v2d /= spval )
- v2d(:,:)= log10(v2d)
- ELSEWHERE
- v2d = 0.
- END WHERE
- ENDIF
- ierr = putvar(ncout, id_varout(jvar) ,v2d, jk, npiglo, npjglo)
- ! skip remaining of the do-loop, treat next level
- CYCLE
- ENDIF
- IF ( typvar(jvar)%savelog10 == 0 ) THEN
- ! take care of not converting 'special values'
- WHERE( v2d /= spval )
- i2d(:,:)=NINT((v2d(:,:)-ao)/sf)
- ELSEWHERE
- i2d(:,:)=0
- END WHERE
- ELSE ! store log10 ao and sf refer to the log10 of the variable
- WHERE( v2d /= spval )
- i2d(:,:)=NINT((log10(v2d(:,:))-ao)/sf)
- ELSEWHERE
- i2d(:,:)=0
- END WHERE
- ENDIF
- CALL checkscaling
- ! write SHORT to the file
- ierr = putvar(ncout, id_varout(jvar) ,i2d, jk, npiglo, npjglo)
- END DO ! loop to next level
+ sf=stypvar(jvar)%scale_factor
+ ao=stypvar(jvar)%add_offset
+ PRINT *,' Working with ', TRIM(cv_names(jvar)), ipk(jvar), sf, ao
+ spval=stypvar(jvar)%rmissing_value
+ DO jt = 1, npt
+ DO jk = 1, ipk(jvar)
+ v2d(:,:)= getvar(cf_in, cv_names(jvar), jk ,npiglo, npjglo, ktime=jt )
+ IF ( sf == 1. .AND. ao == 0 ) THEN
+ ! write FLOATS
+ IF ( stypvar(jvar)%savelog10 == 1 ) THEN
+ WHERE ( v2d /= spval )
+ v2d(:,:)= log10(v2d)
+ ELSEWHERE
+ v2d = 0.
+ END WHERE
+ ENDIF
+ ierr = putvar(ncout, id_varout(jvar) ,v2d, jk, npiglo, npjglo, ktime=jt)
+ ! skip remaining of the do-loop, treat next level
+ CYCLE
+ ENDIF
+ IF ( stypvar(jvar)%savelog10 == 0 ) THEN
+ ! take care of not converting 'special values'
+ WHERE( v2d /= spval )
+ i2d(:,:)=NINT((v2d(:,:)-ao)/sf)
+ ELSEWHERE
+ i2d(:,:)=0
+ END WHERE
+ ELSE ! store log10 ao and sf refer to the log10 of the variable
+ WHERE( v2d /= spval )
+ i2d(:,:)=NINT((log10(v2d(:,:))-ao)/sf)
+ ELSEWHERE
+ i2d(:,:)=0
+ END WHERE
+ ENDIF
+ CALL checkscaling
+ ! write SHORT to the file
+ ierr = putvar(ncout, id_varout(jvar) ,i2d, jk, npiglo, npjglo, ktime=jt)
+ END DO ! loop to next level
+ END DO ! next time loop
END IF
END DO ! loop to next var in file
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
+
+CONTAINS
- CONTAINS
SUBROUTINE sf_ao (kvar)
- !! --------------------------------------------------------------------------------
- !! *** Subroutine sfao ***
- !!
- !! ** Purpose : set the scale_factor and add_offset for the variable kvar
- !! Also set the flag savelog10 when the log10 of the variable
- !! is stored, instead of the proper variable.
- !!
- !! ** Method : recognize the variable name and set pre-defined values.
- !! Give the min and max value for a given variable, and remap
- !! it on -32000 +32000 (Integer*2. The max I2 is 32767 (2^15 -1)
- !! Taking 32000 leaves allows a slight overshoot ( 1%).
- !!
- !!
- !! history:
- !! Original : J.M. MOLINES (Nov. 2006)
- !! --------------------------------------------------------------------------------
- !* Arguments
- INTEGER :: kvar !: variable number
-
- ! * Local variables
- CHARACTER(LEN=256) :: clvarname
- REAL(KIND=4) :: zvmin, zvmax
-
- clvarname=cvarname(kvar)
- SELECT CASE (clvarname)
- ! gridT
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE sf_ao ***
+ !!
+ !! ** Purpose : Set the scale_factor and add_offset for the variable kvar
+ !! Also set the flag savelog10 when the log10 of the variable
+ !! is stored, instead of the proper variable.
+ !!
+ !! ** Method : Recognize the variable name and set pre-defined values.
+ !! Give the min and max value for a given variable, and remap
+ !! it on -32000 +32000 (Integer*2. The max I2 is 32767 (2^15 -1)
+ !! Taking 32000 leaves allows a slight overshoot ( 1%)
+ !!
+ !! ** Comments : With select case (which gives a much more readable code,
+ !! the CASE statement requires a constant matching pattern,
+ !! thus avoiding the use of dynamically adjusted names as
+ !! defined in modcdfnames ...
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kvar ! variable number
+
+ CHARACTER(LEN=256) :: clvarname
+ REAL(KIND=4) :: zvmin, zvmax
+ !!----------------------------------------------------------------------
+
+ clvarname=cv_names(kvar)
+ SELECT CASE (clvarname)
+ ! gridT
CASE ('votemper') ! Potential temperature (Deg C)
- zvmin= -3. ; zvmax = 42.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -3. ; zvmax = 42.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('vosaline') ! Salinity (PSU)
- zvmin= 0. ; zvmax = 42.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= 0. ; zvmax = 42.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('sossheig') ! Sea Surface Heigh (m)
- zvmin= -2.5 ; zvmax = 2.5
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -2.5 ; zvmax = 2.5
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('somxl010') ! Mixed layer depth (m)
- zvmin= 0. ; zvmax = 5000.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= 0. ; zvmax = 5000.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('sohefldo') ! Total Heat flux Down (W/m2)
- zvmin= -1500. ; zvmax = 500.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -1500. ; zvmax = 500.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('soshfldo') ! Solar Heat flux Down (W/m2)
- zvmin= -0.1 ; zvmax = 500.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -0.1 ; zvmax = 500.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('sowaflup') ! Evaporation - Precipitation Up ( kg/m2/s)
- zvmin= -0.1 ; zvmax = 0.1
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -0.1 ; zvmax = 0.1
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('sowafldp') ! SSS damping term Up (kg/m2/s )
- zvmin= -10. ; zvmax = 15.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -10. ; zvmax = 15.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iowaflup') ! ???
- zvmin= -1. ; zvmax = 0.1
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -1. ; zvmax = 0.1
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('sowaflcd') ! Concentration Dilution water flux (kg/m2/s)
- zvmin=-1. ; zvmax = 15.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin=-1. ; zvmax = 15.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('solhflup') ! Latent Heat Flux Up (W/m2)
- zvmin=-800. ; zvmax = 150.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin=-800. ; zvmax = 150.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('solwfldo') ! Long Wave radiation Heat flux Down (W/m2)
- zvmin=-200. ; zvmax = 50.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin=-200. ; zvmax = 50.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('sosbhfup') ! Sensible Heat Flux Up (W/m2)
- zvmin=-800. ; zvmax = 100.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin=-800. ; zvmax = 100.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
- ! gridU
+ ! gridU
CASE ('vozocrtx') ! Zonal Velocity U (m/s)
- zvmin= -3.0 ; zvmax = 3.0
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -3.0 ; zvmax = 3.0
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('sozotaux') ! Zonal Wind Stress (N/m2)
- zvmin= -1.5 ; zvmax = 1.5
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -1.5 ; zvmax = 1.5
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
- ! gridV
+ ! gridV
CASE ('vomecrty') ! Meridional Velocity V (m/s)
- zvmin= -3.0 ; zvmax = 3.0
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -3.0 ; zvmax = 3.0
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('sometauy') ! Meridional Wind Stress (N/m2)
- zvmin= -1.5 ; zvmax = 1.5
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -1.5 ; zvmax = 1.5
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
- ! gridW
+ ! gridW
CASE ('vovecrtz') ! Vertical Velocity W (m/s)
- zvmin= -1.e-2 ; zvmax = 1.e-2
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -1.e-2 ; zvmax = 1.e-2
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('votkeavt') ! Vertical mixing coef log(avt) log(m2/s)
- zvmin= -8. ; zvmax = 2.0
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=1.
+ zvmin= -8. ; zvmax = 2.0
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=1.
- !icemod
+ !icemod
CASE ('isnowthi') ! Snow Thickness (m)
- zvmin=0. ; zvmax = 5.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin=0. ; zvmax = 5.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iicethic') ! Ice Thickness (m)
- zvmin=0. ; zvmax = 15.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin=0. ; zvmax = 15.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iiceprod') ! Ice Production (m/kt) (step ice)
- zvmin=-0.05 ; zvmax = 0.05
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin=-0.05 ; zvmax = 0.05
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('ileadfra') ! Ice Lead Fraction (%) (In fact, ice concentration)
- zvmin= 0 ; zvmax = 1.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= 0 ; zvmax = 1.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iicetemp') ! Ice Temperature (Deg C )
- zvmin= -50. ; zvmax = 0.1
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -50. ; zvmax = 0.1
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('ioceflxb') !Ocean Ice flux (W/m2)
- zvmin= -100. ; zvmax = 2500.0
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -100. ; zvmax = 2500.0
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iicevelu') ! Zonal Ice Velocity (m/s) (at U point)
- zvmin= -2. ; zvmax = 2.0
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -2. ; zvmax = 2.0
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iicevelv') ! Meridional Ice Velocity (m/s) (at V point)
- zvmin= -2. ; zvmax = 2.0
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -2. ; zvmax = 2.0
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('isstempe') ! Sea Surface Temperature (Deg C)
- zvmin= -3. ; zvmax = 42.0
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -3. ; zvmax = 42.0
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('isssalin') ! Sea Surface Salinity (PSU)
- zvmin= 0. ; zvmax = 42.0
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= 0. ; zvmax = 42.0
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iocetflx') ! Total Flux at Ocean Surface (W/m2)
- zvmin= -1500. ; zvmax = 500.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -1500. ; zvmax = 500.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iocesflx') ! Solar Flux at Ocean Surface (W/m2)
- zvmin= 0. ; zvmax = 500.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= 0. ; zvmax = 500.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iocwnsfl') ! Non Solar Flux at Ocean surface (W/m2)
- zvmin= -1500. ; zvmax = 200.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -1500. ; zvmax = 200.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iocesafl') ! Salt Flux at Ocean Surface (kg/m2/kt)
- zvmin= -300. ; zvmax = 300.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -300. ; zvmax = 300.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iocestru') ! Zonal Ice Ocean Stress (N/m2)
- zvmin= -1.5 ; zvmax = 1.5
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -1.5 ; zvmax = 1.5
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iocestrv') ! Meridional Ice Ocean Stress (N/m2)
- zvmin= -1.5 ; zvmax = 1.5
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -1.5 ; zvmax = 1.5
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iicesflx') ! Solar FLux at ice/ocean Surface (W/m2)
- zvmin= -1.0 ; zvmax = 500.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -1.0 ; zvmax = 500.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('iicenflx') ! Non Solar FLux at ice/ocean Surface (W/m2)
- zvmin= -1500. ; zvmax = 300.
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= -1500. ; zvmax = 300.
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
CASE ('isnowpre') ! Snow Precipitation (kg/day)
- zvmin= 0. ; zvmax = 0.0001
- typvar(kvar)%add_offset=(zvmin + zvmax) /2.
- typvar(kvar)%scale_factor= (zvmax-typvar(kvar)%add_offset)/32000.
- typvar(kvar)%savelog10=0.
+ zvmin= 0. ; zvmax = 0.0001
+ stypvar(kvar)%add_offset=(zvmin + zvmax) /2.
+ stypvar(kvar)%scale_factor= (zvmax-stypvar(kvar)%add_offset)/32000.
+ stypvar(kvar)%savelog10=0.
- ! TRC
+ ! TRC
CASE ('cfc11') ! Concentration tracer 1
- zvmin= 0. ; zvmax = 0.0001
- typvar(kvar)%add_offset=0.
- typvar(kvar)%scale_factor= 1.
- typvar(kvar)%savelog10=1.
+ zvmin= 0. ; zvmax = 0.0001
+ stypvar(kvar)%add_offset=0.
+ stypvar(kvar)%scale_factor= 1.
+ stypvar(kvar)%savelog10=1.
CASE ('bombc14') ! Concentration tracer 1
- zvmin= 0. ; zvmax = 0.0001
- typvar(kvar)%add_offset=0.
- typvar(kvar)%scale_factor= 1.
- typvar(kvar)%savelog10=1.
+ zvmin= 0. ; zvmax = 0.0001
+ stypvar(kvar)%add_offset=0.
+ stypvar(kvar)%scale_factor= 1.
+ stypvar(kvar)%savelog10=1.
CASE DEFAULT
- PRINT *, TRIM(clvarname),' is not recognized !'
- PRINT *, 'No conversion will be performed'
- typvar(kvar)%scale_factor=1.0
- typvar(kvar)%add_offset=0.
- typvar(kvar)%savelog10=0.
- END SELECT
+ PRINT *, TRIM(clvarname),' is not recognized !'
+ PRINT *, 'No conversion will be performed'
+ stypvar(kvar)%scale_factor=1.0
+ stypvar(kvar)%add_offset=0.
+ stypvar(kvar)%savelog10=0.
+ END SELECT
+
END SUBROUTINE sf_ao
- SUBROUTINE checkscaling
- !!---------------------------------------------------------------------------
- !! *** Subroutine checkscaling ***
- !!
- !! * Purpose : Check if the scale_factor and add_offset are ok for the current v2d field
- !!
- !! * Method : - Needs -check and/or -verbose line option to be activated.
- !! - Find the min and max of 3D field (called every level, and determine min/max)
- !! - if -verbose option set, give details at every levels
- !! - When last level is done, give the diagnostics in case of conflict
- !!
- !! history:
- !! Original : J.M. Molines ( Nov. 2006)
- !!---------------------------------------------------------------------------
- !! * All variables are global from the main program
- !!
- IF ( l_chk ) THEN ! with this option, check if the max value of the field can be
- !mapped on I2 with actual values of Scale_factor and Add_offset
+ SUBROUTINE checkscaling()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE checkscaling ***
+ !!
+ !! ** Purpose : Check if the scale_factor and add_offset are ok for
+ !! the current v2d field
+ !!
+ !! ** Method : - Needs -check and/or -verbose line option to be activated.
+ !! - Find the min and max of 3D field (called every level, and determine min/max)
+ !! - if -verbose option set, give details at every levels
+ !! - When last level is done, give the diagnostics in case of conflict
+ !!
+ !!----------------------------------------------------------------------
+ IF ( l_chk ) THEN ! with this option, check if the max value of the field can be
+ !mapped on I2 with actual values of Scale_factor and Add_offset
lmask=.true. ; WHERE (v2d == spval ) lmask=.false.
! Works with log10 of v2d in case of savelog10=1
- IF (typvar(jvar)%savelog10 == 1 ) THEN
- WHERE( v2d /= 0. ) v2d=LOG10(v2d)
+ IF (stypvar(jvar)%savelog10 == 1 ) THEN
+ WHERE( v2d /= 0. ) v2d=LOG10(v2d)
ENDIF
zmax(jk)=MAXVAL(v2d,lmask) ; zmin(jk)=MINVAL(v2d,lmask)
-
+
! Additional output if verbose mode
IF ( l_verbose ) THEN
- zchkmax=(zmax(jk) - ao )/sf ; zchkmin = (zmin(jk) -ao ) /sf
- IF ( zchkmax >= 2**15 ) THEN
- PRINT *,TRIM(cvarname(jvar)), ' LEVEL ', jk ,' MIN = ',zmin(jk),' MAX = ', zmax(jk)
- PRINT *,' W A R N I N G ! : maximum too high for (sf,ao) pair.', TRIM(cfile)
- PRINT *,' Optimal value for this level AO = ', (zmin(jk) + zmax(jk) )/2.,' [ ', &
- & typvar(jvar)%add_offset,']'
- PRINT *,' Optimal value for this level SF = ', (zmax(jk) - (zmin(jk) + zmax(jk) )/2. )/32000., &
- & ' [ ',typvar(jvar)%scale_factor,' ] '
- END IF
-
- IF ( zchkmin < -2**15 ) THEN
- PRINT *,TRIM(cvarname(jvar)), ' LEVEL ', jk ,' MIN = ',zmin(jk),' MAX = ', zmax(jk)
- PRINT *,' W A R N I N G ! : minimum too low for (sf,ao) pair.', TRIM(cfile)
- PRINT *,' Optimal value for this level AO = ', (zmin(jk) + zmax(jk) )/2.,' [ ', &
- & typvar(jvar)%add_offset,']'
- PRINT *,' Optimal value for this level SF = ', (zmax(jk) - (zmin(jk) + zmax(jk) )/2. )/32000., &
- & ' [ ',typvar(jvar)%scale_factor,' ] '
- END IF
+ zchkmax=(zmax(jk) - ao )/sf ; zchkmin = (zmin(jk) -ao ) /sf
+ IF ( zchkmax >= 2**15 ) THEN
+ PRINT *,TRIM(cv_names(jvar)), ' LEVEL ', jk ,' MIN = ',zmin(jk),' MAX = ', zmax(jk)
+ PRINT *,' W A R N I N G ! : maximum too high for (sf,ao) pair.', TRIM(cf_in)
+ PRINT *,' Optimal value for this level AO = ', (zmin(jk) + zmax(jk) )/2.,' [ ', &
+ & stypvar(jvar)%add_offset,']'
+ PRINT *,' Optimal value for this level SF = ', (zmax(jk) - (zmin(jk) + zmax(jk) )/2. )/32000., &
+ & ' [ ',stypvar(jvar)%scale_factor,' ] '
+ END IF
+
+ IF ( zchkmin < -2**15 ) THEN
+ PRINT *,TRIM(cv_names(jvar)), ' LEVEL ', jk ,' MIN = ',zmin(jk),' MAX = ', zmax(jk)
+ PRINT *,' W A R N I N G ! : minimum too low for (sf,ao) pair.', TRIM(cf_in)
+ PRINT *,' Optimal value for this level AO = ', (zmin(jk) + zmax(jk) )/2.,' [ ', &
+ & stypvar(jvar)%add_offset,']'
+ PRINT *,' Optimal value for this level SF = ', (zmax(jk) - (zmin(jk) + zmax(jk) )/2. )/32000., &
+ & ' [ ',stypvar(jvar)%scale_factor,' ] '
+ END IF
END IF ! verbose mode
! Print a warning if necessary after the last level of var has been processed
IF ( jk == ipk(jvar) ) THEN
- zzmax=MAXVAL(zmax(1:ipk(jvar))) ; zzmin=MINVAL(zmin(1:ipk(jvar)))
- zchkmax=(zzmax - ao )/sf ; zchkmin = (zzmin -ao ) /sf
- IF ( zchkmax >= 2**15 ) THEN
- PRINT *,' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '
- PRINT *,TRIM(cvarname(jvar)), ' MIN = ',zzmin,' MAX = ',zzmax,TRIM(cfile)
- PRINT *,' WARNING ! : maximum too high for (sf,ao) pair.'
- PRINT *,' Optimal value for this level AO = ', (zzmin + zzmax )/2.,' [ ', &
- & typvar(jvar)%add_offset,']'
- PRINT *,' Optimal value for this level SF = ', (zzmax - (zzmin + zzmax )/2. )/32000., &
- & ' [ ',typvar(jvar)%scale_factor,' ] '
- PRINT *,' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
- END IF
-
- IF ( zchkmin < -2**15 ) THEN
- PRINT *,' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '
- PRINT *,TRIM(cvarname(jvar)), ' MIN = ',zzmin,' MAX = ', zzmax,TRIM(cfile)
- PRINT *,' WARNING ! : minimum too low for (sf,ao) pair.'
- PRINT *,' Optimal value for AO = ', (zzmin + zzmax )/2.,' [ ', &
- & typvar(jvar)%add_offset,']'
- PRINT *,' Optimal value for SF = ', (zzmax - (zzmin + zzmax )/2. )/32000., &
- & ' [ ',typvar(jvar)%scale_factor,' ] '
- PRINT *,' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
- ENDIF
+ zzmax=MAXVAL(zmax(1:ipk(jvar))) ; zzmin=MINVAL(zmin(1:ipk(jvar)))
+ zchkmax=(zzmax - ao )/sf ; zchkmin = (zzmin -ao ) /sf
+ IF ( zchkmax >= 2**15 ) THEN
+ PRINT *,' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '
+ PRINT *,TRIM(cv_names(jvar)), ' MIN = ',zzmin,' MAX = ',zzmax,TRIM(cf_in)
+ PRINT *,' WARNING ! : maximum too high for (sf,ao) pair.'
+ PRINT *,' Optimal value for this level AO = ', (zzmin + zzmax )/2.,' [ ', &
+ & stypvar(jvar)%add_offset,']'
+ PRINT *,' Optimal value for this level SF = ', (zzmax - (zzmin + zzmax )/2. )/32000., &
+ & ' [ ',stypvar(jvar)%scale_factor,' ] '
+ PRINT *,' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
+ END IF
+
+ IF ( zchkmin < -2**15 ) THEN
+ PRINT *,' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '
+ PRINT *,TRIM(cv_names(jvar)), ' MIN = ',zzmin,' MAX = ', zzmax,TRIM(cf_in)
+ PRINT *,' WARNING ! : minimum too low for (sf,ao) pair.'
+ PRINT *,' Optimal value for AO = ', (zzmin + zzmax )/2.,' [ ', &
+ & stypvar(jvar)%add_offset,']'
+ PRINT *,' Optimal value for SF = ', (zzmax - (zzmin + zzmax )/2. )/32000., &
+ & ' [ ',stypvar(jvar)%scale_factor,' ] '
+ PRINT *,' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
+ ENDIF
END IF ! last level
- END IF ! check mode
+ END IF ! check mode
END SUBROUTINE checkscaling
END PROGRAM cdf16bit
diff --git a/cdf2matlab.f90 b/cdf2matlab.f90
index 3e3e896..1026948 100644
--- a/cdf2matlab.f90
+++ b/cdf2matlab.f90
@@ -1,127 +1,149 @@
PROGRAM cdf2matlab
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdf2matlab ***
+ !!======================================================================
+ !! *** PROGRAM cdf2matlab ***
+ !!=====================================================================
+ !! ** Purpose : Reshapes ORCA grids to be matlab-friendly
!!
- !! ** Purpose: Reshapes ORCA grids to be matlab-friendly
- !!
- !! ** Method: Try to avoid 3 d arrays
+ !! ** Method : transform input file with monotonically increasing
+ !! longitudes.
!!
- !! history :
- !! Original : R. Dussin (Jan 2011 )
- !!
- !!-------------------------------------------------------------------
- !! $Rev: 256 $
- !! $Date: 2009-07-21 17:49:27 +0200 (mar. 21 juil. 2009) $
- !! $Id: cdf2matlab.f90 256 2009-07-21 15:49:27Z molines $
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 01/2011 : R. Dussin : Original code
+ !! 3.0 : 03/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji, jj
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo, npjglo, npk, npiglox2 !: size of the domain
- INTEGER :: zlev , zindex, ztmp
- INTEGER, DIMENSION(3) :: ipk, id_varout
- REAL(KIND=4) , DIMENSION(:,:), ALLOCATABLE :: zlon, zlat, zvar ! input arrays
- REAL(KIND=4) , DIMENSION(:,:), ALLOCATABLE :: zlonout, zlatout, zvarout ! output arrays
- REAL(KIND=4) , DIMENSION(:,:), ALLOCATABLE :: zlonwork, zlatwork, zvarwork ! working arrays arrays
- REAL(KIND=4) , DIMENSION(1) :: timean
-
- CHARACTER(LEN=256) :: cfile, cvarin, cdum, cfileout='output.nc' !: file name
- TYPE(variable), DIMENSION(3) :: typvar !: structure for attribute
+ INTEGER(KIND=4) :: ji, jj ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc !
+ INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain
+ INTEGER(KIND=4) :: npiglox2 ! new model size in x
+ INTEGER(KIND=4) :: ilev, iindex, itmp
+ INTEGER(KIND=4) :: ncout
+ INTEGER(KIND=4) :: ierr
+ INTEGER(KIND=4), DIMENSION(3) :: ipk, id_varout
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zlon, zlat, zvar ! input arrays
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zlonout, zlatout ! output arrays
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zlonwork, zlatwork ! working arrays arrays
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvarout, zvarwork ! working arrays arrays
+ REAL(KIND=4), DIMENSION(1) :: tim
+
+ CHARACTER(LEN=256) :: cf_in ! input file name
+ CHARACTER(LEN=256) :: cf_out='output.nc' ! output file name
+ CHARACTER(LEN=256) :: cv_in ! input variable name
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+
+ TYPE(variable), DIMENSION(3) :: stypvar ! structure for attribute
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- INTEGER :: ncout
- INTEGER :: istatus, ierr
-
- !! Read command line
narg= iargc()
IF ( narg /= 3 ) THEN
- PRINT *,' Usage : cdf2matlab file variable level '
- PRINT *,' Output on output.nc '
+ PRINT *,' usage : cdf2matlab IN-file IN-var level '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Convert global nemo input file (ORCA configurations) into'
+ PRINT *,' a file with monotonically increasing longitudes.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : input model file.'
+ PRINT *,' IN-var : netcdf variable name to process.'
+ PRINT *,' level : level to process.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : same name than in input file.'
STOP
ENDIF
!!
!! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
- CALL getarg (2, cvarin)
- CALL getarg (3, cdum) ; READ(cdum,*) zlev
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth')
-
- ipk(:) = 1
- typvar(1)%name= 'lon'
- typvar(1)%units='degrees'
- typvar(1)%valid_min= -180.
- typvar(1)%valid_max= 540.
- typvar(1)%long_name='longitude'
- typvar(1)%short_name='lon'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='YX'
-
- typvar(2)%name= 'lat'
- typvar(2)%units='degrees'
- typvar(2)%missing_value=0.
- typvar(2)%valid_min= -90.
- typvar(2)%valid_max= 90.
- typvar(2)%long_name='latitude'
- typvar(2)%short_name='lat'
- typvar(2)%online_operation='N/A'
- typvar(2)%axis='YX'
-
- typvar(3)%name= cvarin
- typvar(3)%units=''
- typvar(3)%missing_value=0.
- typvar(3)%long_name=''
- typvar(3)%short_name=cvarin
- typvar(3)%online_operation='N/A'
- typvar(3)%axis='TYX'
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ CALL getarg (1, cf_in)
+ CALL getarg (2, cv_in)
+ CALL getarg (3, cldum) ; READ(cldum,*) ilev
+
+ IF ( chkfile (cf_in) ) STOP ! missing file
+
+ npiglo = getdim (cf_in,cn_x)
+ npjglo = getdim (cf_in,cn_y)
+ npk = getdim (cf_in,cn_z)
+
+ ipk(:) = 1
+ stypvar(1)%cname = 'lon'
+ stypvar(1)%cunits = 'degrees'
+ stypvar(1)%valid_min = -180.
+ stypvar(1)%valid_max = 540.
+ stypvar(1)%clong_name = 'longitude'
+ stypvar(1)%cshort_name = 'lon'
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'YX'
+
+ stypvar(2)%cname = 'lat'
+ stypvar(2)%cunits = 'degrees'
+ stypvar(2)%rmissing_value = 0.
+ stypvar(2)%valid_min = -90.
+ stypvar(2)%valid_max = 90.
+ stypvar(2)%clong_name = 'latitude'
+ stypvar(2)%cshort_name = 'lat'
+ stypvar(2)%conline_operation = 'N/A'
+ stypvar(2)%caxis = 'YX'
+
+ stypvar(3)%cname = cv_in
+ stypvar(3)%cunits = ''
+ stypvar(3)%rmissing_value = 0.
+ stypvar(3)%clong_name = ''
+ stypvar(3)%cshort_name = cv_in
+ stypvar(3)%conline_operation = 'N/A'
+ stypvar(3)%caxis = 'TYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
npiglox2 = 2 * npiglo
ALLOCATE( zvar(npiglo,npjglo), zlon(npiglo,npjglo), zlat(npiglo,npjglo) )
- ALLOCATE( zvarout(npiglox2,npjglo),zlonout(npiglox2,npjglo),zlatout(npiglox2,npjglo) )
+ ALLOCATE( zvarout(npiglox2,npjglo), zlonout(npiglox2,npjglo), zlatout(npiglox2,npjglo) )
- ncout =create(cfileout, cfile,npiglox2,npjglo,1)
- ierr= createvar(ncout ,typvar,3, ipk,id_varout )
+ ncout = create (cf_out, cf_in, npiglox2, npjglo, 1 )
+ ierr = createvar (ncout, stypvar, 3, ipk, id_varout )
- zlon(:,:) = getvar(cfile,'nav_lon',1, npiglo, npjglo)
- zlat(:,:) = getvar(cfile,'nav_lat',1, npiglo, npjglo)
- zvar(:,:) = getvar(cfile,cvarin,zlev, npiglo, npjglo)
+ zlon(:,:) = getvar(cf_in, cn_vlon2d, 1, npiglo, npjglo)
+ zlat(:,:) = getvar(cf_in, cn_vlat2d, 1, npiglo, npjglo)
+ zvar(:,:) = getvar(cf_in, cv_in, ilev, npiglo, npjglo)
DO jj=1,npjglo
+ iindex = MINLOC( ABS(zlon(:,jj) + 180 ),1 ) ! find the discontinuity in lon array
+ itmp = npiglo - iindex + 1
- zindex = MINLOC( ABS(zlon(:,jj) + 180 ),1 ) ! find the discontinuity in lon array
- ztmp = npiglo - zindex + 1
-
- zlonout(1:ztmp,jj) = zlon(zindex:npiglo,jj) ; zlonout(ztmp+1:npiglo,jj) = zlon(1:zindex-1,jj)
- zlonout(npiglo+1:npiglo+ztmp,jj) = zlon(zindex:npiglo,jj) + 360.
- zlonout(npiglo+ztmp+1:npiglox2,jj) = zlon(1:zindex-1,jj) + 360.
+ zlonout(1:itmp,jj) = zlon(iindex:npiglo,jj) ; zlonout(itmp+1:npiglo,jj) = zlon(1:iindex-1,jj)
+ zlonout(npiglo+1:npiglo+itmp ,jj) = zlon(iindex:npiglo,jj) + 360.
+ zlonout(npiglo+itmp+1:npiglox2,jj) = zlon(1:iindex-1, jj) + 360.
- zlatout(1:ztmp,jj) = zlat(zindex:npiglo,jj) ; zlatout(ztmp+1:npiglo,jj) = zlat(1:zindex-1,jj)
- zlatout(npiglo+1:npiglo+ztmp,jj) = zlat(zindex:npiglo,jj)
- zlatout(npiglo+ztmp+1:npiglox2,jj) = zlat(1:zindex-1,jj)
-
- zvarout(1:ztmp,jj) = zvar(zindex:npiglo,jj) ; zvarout(ztmp+1:npiglo,jj) = zvar(1:zindex-1,jj)
- zvarout(npiglo+1:npiglo+ztmp,jj) = zvar(zindex:npiglo,jj)
- zvarout(npiglo+ztmp+1:npiglox2,jj) = zvar(1:zindex-1,jj)
+ zlatout(1:itmp,jj) = zlat(iindex:npiglo,jj) ; zlatout(itmp+1:npiglo,jj) = zlat(1:iindex-1,jj)
+ zlatout(npiglo+1:npiglo+itmp, jj) = zlat(iindex:npiglo,jj)
+ zlatout(npiglo+itmp+1:npiglox2,jj) = zlat(1:iindex-1, jj)
+ zvarout(1:itmp,jj) = zvar(iindex:npiglo,jj) ; zvarout(itmp+1:npiglo,jj) = zvar(1:iindex-1,jj)
+ zvarout(npiglo+1:npiglo+itmp, jj) = zvar(iindex:npiglo,jj)
+ zvarout(npiglo+itmp+1:npiglox2,jj) = zvar(1:iindex-1, jj)
END DO
! Special treatement for ORCA2
- IF ( ( npiglo .EQ. 182 ) .AND. ( npjglo .EQ. 149 ) ) THEN
- PRINT *, 'Assuming that config is ORCA2'
+ IF ( ( npiglo == 182 ) .AND. ( npjglo == 149 ) ) THEN
+ PRINT *, 'Assuming that this config is ORCA2 !'
- ALLOCATE( zvarwork(npiglox2,npjglo),zlonwork(npiglox2,npjglo),zlatwork(npiglox2,npjglo) )
+ ALLOCATE( zvarwork(npiglox2,npjglo), zlonwork(npiglox2,npjglo), zlatwork(npiglox2,npjglo) )
!! init the arryas
zlonwork(:,:) = zlonout(:,:)
@@ -137,20 +159,20 @@ PROGRAM cdf2matlab
zlatwork(130,:) = zlatout(131,:) ; zlatwork(npiglo+130,:) = zlatout(npiglo+131,:)
zvarwork(130,:) = zvarout(131,:) ; zvarwork(npiglo+130,:) = zvarout(npiglo+131,:)
- !! swapping the arrays
- zlonout(:,:) = zlonwork(:,:)
- zlatout(:,:) = zlatwork(:,:)
- zvarout(:,:) = zvarwork(:,:)
-
- ENDIF
+ !! swapping the arrays
+ zlonout(:,:) = zlonwork(:,:)
+ zlatout(:,:) = zlatwork(:,:)
+ zvarout(:,:) = zvarwork(:,:)
- ierr=putvar(ncout,id_varout(1), zlonout, 1, npiglox2, npjglo)
- ierr=putvar(ncout,id_varout(2), zlatout, 1, npiglox2, npjglo)
- ierr=putvar(ncout,id_varout(3), zvarout, 1, npiglox2, npjglo)
-
- timean=getvar1d(cfile,'time_counter',1)
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
+ ENDIF
+
+ ierr = putvar(ncout,id_varout(1), zlonout, 1, npiglox2, npjglo)
+ ierr = putvar(ncout,id_varout(2), zlatout, 1, npiglox2, npjglo)
+ ierr = putvar(ncout,id_varout(3), zvarout, 1, npiglox2, npjglo)
+
+ tim = getvar1d(cf_in, cn_vtimec, 1 )
+ ierr = putvar1d(ncout, tim, 1, 'T')
+ ierr = closeout(ncout)
PRINT *, 'Tip : in matlab, do not plot the last line (e.g. maximum northern latitude) '
diff --git a/cdfbathy.f90 b/cdfbathy.f90
index 0451e3a..25a7325 100644
--- a/cdfbathy.f90
+++ b/cdfbathy.f90
@@ -1,211 +1,311 @@
PROGRAM cdfbathy
- !!----------------------------------------------------------------------------
- !! *** PROGRAM cdfbathy ***
+ !!======================================================================
+ !! *** PROGRAM cdfbathy ***
+ !!=====================================================================
+ !! ** Purpose : Utility to modify a bathymetric file according to
+ !! specific option (eg : fill an area, modify points ...)
+ !! Using -var option and -lev, can also edit any file with
+ !! the same tool, except the specific actions dedicated to
+ !! the bathymetry (eg : zstep like ...)
!!
- !! ** Purpose: Locally transform a bathy_meter file into a z-step like bathy
+ !! ** Method : All modifications are save in a fortran file ready to be
+ !! used to replay all the modif at once.
!!
- !! ** Method: Use OPA9 routine to look for zps. Locally force the depth to give
- !! full depth. Save the modifs as source fortran code.
- !!
- !! ** Usage : cdfbathy -f file -zoom imin imax jmin jmax
- !!
- !! History:
- !! 2007 : J-M Molines : Original
- !!
- !!----------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- ! * Module used
+ !! History : 2.1 : 11/2007 : J.M. Molines : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! zgr_zps
+ !! zgr_read
+ !! prlog
+ !! fillzone
+ !! raz_zone
+ !! raz_below
+ !! set_below
+ !! dumpzone
+ !! nicedumpzone
+ !! replacezone
+ !!----------------------------------------------------------------------
USE cdfio
-
- ! * Local Variable
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
!
- INTEGER :: numin,jk,ji,jj,jt,jl, jd, jarg
- INTEGER :: narg, iargc
- INTEGER :: imin, imax, jmin, jmax, istatus
- INTEGER :: npiglo, npjglo, npk
- INTEGER, DIMENSION(:), ALLOCATABLE :: level
- INTEGER, DIMENSION (:,:), ALLOCATABLE :: mbathy, mask
- ! REAL(KIND=4) :: e3zps_min=25, e3zps_rat=0.2
- REAL(KIND=4) :: e3zps_min=1000, e3zps_rat=1, depmin=600., depfill=0.
- REAL(KIND=4) :: scale_factor=1. ! divide by scale factor when reading
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept, gdepw, e3t, e3w
- !
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: h, rtime
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: bathyin,bathy, e3_bot
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! browse command line
+ INTEGER(KIND=4) :: iimin, iimax ! selected area
+ INTEGER(KIND=4) :: ijmin, ijmax ! selected area
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4) :: iklev ! selected level
+ INTEGER(KIND=4) :: itime ! selected time
+ INTEGER(KIND=4) :: npiglo, npjglo ! domain size
+ INTEGER(KIND=4) :: npk, npt ! domaine size
+ INTEGER(KIND=4) :: iversion=1 ! version counter for working copy
+ INTEGER(KIND=4) :: iostat, ipos ! used for version control
+ INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: mbathy ! map of wet model level
+
+ REAL(KIND=4) :: e3zps_min=25. ! minimum thickness of bottom cell
+ REAL(KIND=4) :: e3zps_rat=0.2 ! minimum ratio e3bot/e3_0
+ REAL(KIND=4) :: rdepmin=600. ! default value for depmin (full step like)
+ REAL(KIND=4) :: rdepfill=0. ! default filling value
+ REAL(KIND=4) :: scale_factor=1. ! divide by scale factor when reading
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e3t, e3w ! vertical metrics
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept, gdepw ! depth at T and W points
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3_bot ! bottom depth (partial steps)
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: bathyin ! initial data value
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: bathy ! modified data value
!
- CHARACTER(LEN=256) :: cfilein, cline1, cline2, ctmp, cfileroot, creplace, cdump
- CHARACTER(LEN=256) :: cdim, cvar='Bathymetry'
+ CHARACTER(LEN=256) :: cf_in ! original input file name
+ CHARACTER(LEN=256) :: cf_root ! root part of the file name
+ CHARACTER(LEN=256) :: cf_dump ! dump txt file name (out)
+ CHARACTER(LEN=256) :: cf_replace ! replace txt file name (in)
+ CHARACTER(LEN=80) :: cf_batfile = 'zgrbat.txt' ! txt file giving vertical mesh
+ CHARACTER(LEN=80) :: cf_log = 'log.f90' ! default log file
+ CHARACTER(LEN=80) :: cv_in ! variable name
+ CHARACTER(LEN=256) :: cwkc ! filename of working copy
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ LOGICAL :: lexist = .TRUE., lfill = .FALSE. ! all required flags for options
+ LOGICAL :: lfullstep = .FALSE., lappend = .FALSE. ! all required flags for options
+ LOGICAL :: lreplace = .FALSE., ldump = .FALSE. ! all required flags for options
+ LOGICAL :: lmodif = .FALSE., loverwrite = .FALSE. ! all required flags for options
+ LOGICAL :: lraz = .FALSE., ldumpn = .FALSE. ! all required flags for options
+ LOGICAL :: lrazb = .FALSE., lsetb = .FALSE. ! all required flags for options
+ LOGICAL :: lchk = .FALSE. ! all required flags for options
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- LOGICAL :: lexist=.TRUE., lfill=.FALSE., lfullstep=.FALSE., lappend=.FALSE., lreplace=.FALSE.
- LOGICAL :: ldump = .FALSE., lmodif=.FALSE., loverwrite=.false., lraz=.false., ldumpn=.false.
- LOGICAL :: lrazb=.false., lsetb=.false.
- INTEGER :: iversion=1, iostat, ipos
- !!
- !! 1. Initializations:
- !! -------------------
- !!
narg = iargc()
- IF (narg == 0) THEN
- PRINT 9999,'USAGE :cdfbathy -f file '// &
- '-zoom imin imax jmin jmax -fillzone -fullstep depmin'
- PRINT 9999,' -replace ''file'' -dumpzone ''file'' -a -o '
- PRINT 9999
- PRINT 9999, ' DESCRIPTION OF OPTIONS '
- PRINT 9999, ' ---------------------- '
- PRINT 9999, ' -file (or -f ) : name of bathy file '
- PRINT 9999, ' -var (or -v ) : name of cdf variable [default: Bathymetry]'
- PRINT 9999, ' -scale s : use s as a scale factor (divide when read the file)'
- PRINT 9999, ' -zoom (or -z ) : sub area of the bathy file to work with (imin imax jmin jmax)'
- PRINT 9999, ' -fillzone (or -fz ) : sub area will be filled with 0 up to the first coast line '
+
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfbathy/cdfvar -f IN-file [options]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Allow manual modification of the input file. Very convenient'
+ PRINT *,' for bathymetric files, can also be used with any model file'
+ PRINT *,' Keep a log.f90 file of the modifications for automatic reprocessing'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : original input file. The program works on a copy of the'
+ PRINT *,' original file (default)'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT 9999, ' -file (or -f ) : name of input file '
+ PRINT 9999, ' -var (or -v ) : name of cdf variable [default: Bathymetry]'
+ PRINT 9999, ' -lev (or -l ) : level to work with '
+ PRINT 9999, ' -time (or -t ) : time to work with '
+ PRINT 9999, ' -scale s : use s as a scale factor (divide when read the file)'
+ PRINT 9999, ' -zoom (or -z ) : sub area of the bathy file to work with (imin imax jmin jmax)'
+ PRINT 9999, ' -fillzone (or -fz ) : sub area will be filled with 0 up to the first coast line '
PRINT 9999, ' -raz_zone (or -raz ) : sub area will be filled with 0 up '
- PRINT 9999, ' -raz_below depmin (or -rb depmin ) : any depth less than depmin in subarea will be replaced by 0 '
- PRINT 9999, ' -set_below depmin (or -sb depmin ) : any depth less than depmin in subarea will be replaced by depmin '
- PRINT 9999, ' -fullstep (or -fs ) : sub area will be reshaped as full-step, below depmin'
- PRINT 9999, ' requires the presence of the file zgr_bat.txt (from ocean.output, eg )'
- PRINT 9999, ' -dumpzone (or -d ): sub area will be output to an ascii file, which can be used by -replace'
- PRINT 9999, ' after manual editing '
- PRINT 9999, ' -nicedumpzone (or -nd ): sub area will be output to an ascii file (nice output)'
- PRINT 9999, ' -replace (or -r ) : sub area defined by the file will replace the original bathy'
- PRINT 9999, ' -append (or -a ) : fortran log file (log.f90) will be append with actual modif'
- PRINT 9999, ' Standard behaviour is to overwrite/create log file'
- PRINT 9999, ' -overwrite (or -o ): input bathy file will be used as output.'
- PRINT 9999, ' Standard behaviour is to use a work copy of the original file'
- PRINT 9999, ' (indexed from 01 to 99 if necessary ) '
+ PRINT 9999, ' -raz_below depmin : any depth less than depmin in subarea will be replaced by 0 '
+ PRINT 9999, ' (or -rb depmin ) '
+ PRINT 9999, ' -set_below depmin : any depth less than depmin in subarea will be replaced by depmin '
+ PRINT 9999, ' (or -sb depmin ) '
+ PRINT 9999, ' -fullstep depmin : sub area will be reshaped as full-step, below depmin'
+ PRINT 9999, ' (or -fs depmin ) requires the presence of the file zgr_bat.txt (from ocean.output, eg )'
+ PRINT 9999, ' -dumpzone (or -d ) : sub area will be output to an ascii file, which can be used by -replace'
+ PRINT 9999, ' after manual editing '
+ PRINT 9999, ' -nicedumpzone : sub area will be output to an ascii file (nice output)'
+ PRINT 9999, ' (or -nd )'
+ PRINT 9999, ' -replace (or -r ) : sub area defined by the file will replace the original bathy'
+ PRINT 9999, ' -append (or -a ) : fortran log file (log.f90) will be append with actual modif'
+ PRINT 9999, ' Standard behaviour is to overwrite/create log file'
+ PRINT 9999, ' -overwrite (or -o ) : input bathy file will be used as output.'
+ PRINT 9999, ' Standard behaviour is to use a work copy of the original file'
+ PRINT 9999, ' (indexed from 01 to 99 if necessary ) '
+ PRINT 9999, ' -log logfile : log file for change (default is log.f90) '
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT 9999, ' netcdf file : according to used options, if the original file is to be modified'
+ PRINT 9999, ' a sequence number is added at the end of the input file name, to keep'
+ PRINT 9999, ' modifications.'
+ PRINT *,' variables : same as input file'
STOP
- END IF
-9999 FORMAT(a)
- ! Read command line
- jarg=1
- imin=-10 ; imax=-10 ; jmin=-10 ; jmax=-10
- DO WHILE (jarg <= narg)
- CALL getarg(jarg,cline1) ; jarg = jarg + 1
- IF (cline1 == '-file ' .OR. cline1 == '-f') THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- cfilein=cline2
- ELSE IF (cline1 == '-var' .OR. cline1 == '-v') THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- cvar=cline2
- ELSE IF (cline1 == '-scale' ) THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) scale_factor
- ELSE IF (cline1 == '-zoom' .OR. cline1 == '-z') THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) imin
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) imax
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) jmin
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) jmax
- ELSE IF (cline1 == '-fillzone' .OR. cline1 == '-fz' ) THEN
+ ENDIF
+9999 FORMAT(5x,a)
+
+ ijarg = 1
+ iimin=-10 ; iimax=-10 ; ijmin=-10 ; ijmax=-10
+
+ cv_in = cn_bathymet ! default value
+ iklev = 1
+ itime = 1
+
+ DO WHILE (ijarg <= narg)
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ !
+ CASE ( '-file' , '-f' ) ! name of input file
+ CALL getarg(ijarg, cf_in) ; ijarg = ijarg + 1
+ lchk = ( lchk .OR. chkfile (cf_in) )
+ !
+ CASE ( '-var' , '-v' ) ! name of netcdf variable
+ CALL getarg(ijarg, cv_in) ; ijarg = ijarg + 1
+ !
+ CASE ( '-lev' , '-k' ) ! level to work with
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iklev
+ !
+ CASE ( '-time' , '-t' ) ! time frame to work with
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itime
+ !
+ CASE ( '-scale' ) ! dividing scale factor
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) scale_factor
+ !
+ CASE ( '-zoom' , '-z' ) ! specify zoomed area
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimin
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax
+
+ CASE ( '-fillzone' , '-fz' ) ! Fill the area specified with zoom
+ ! with 0 till a coast is encountered in the East
lfill=.TRUE. ; lmodif=.TRUE.
- ELSE IF (cline1 == '-raz_zone' .OR. cline1 == '-raz' ) THEN
+ !
+ CASE ( '-raz_zone' , '-raz' ) ! Set a zoomed area to 0
lraz=.TRUE. ; lmodif=.TRUE.
- ELSE IF (cline1 == '-raz_below' .OR. cline1 == '-rb' ) THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) depfill
+ !
+ CASE ( '-raz_below' , '-rb' ) ! Area below this value are set to 0
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rdepfill
lrazb=.TRUE. ; lmodif=.TRUE.
- ELSE IF (cline1 == '-set_below' .OR. cline1 == '-sb' ) THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) depfill
+ !
+ CASE ( '-set_below' , '-sb' ) ! Area below this value are set to values
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rdepfill
lsetb=.TRUE. ; lmodif=.TRUE.
- ELSE IF (cline1 == '-fullstep' .OR. cline1 == '-fs' ) THEN
+ !
+ CASE ( '-fullstep' , '-fs' ) ! Create a full-step like bathy in zoomed area
lfullstep=.TRUE. ; lmodif=.TRUE.
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) depmin
- ELSE IF (cline1 == '-append' .OR. cline1 == '-a' ) THEN
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rdepmin
+ !
+ CASE ( '-append' , '-a' ) ! Append modification to the f90 log file
lappend=.TRUE.
- ELSE IF (cline1 == '-overwrite' .OR. cline1 == '-o' ) THEN
+ !
+ CASE ( '-overwrite' , '-o' ) ! Overwrite modifications in f90 log file
loverwrite=.TRUE.
- ELSE IF (cline1 == '-replace' .OR. cline1 == '-r') THEN
+ !
+ CASE ( '-replace' , '-r' ) ! Replace zoomed area by values in ascii file
lreplace=.TRUE. ; lmodif=.TRUE.
- CALL getarg(jarg,creplace) ; jarg = jarg +1
- ELSE IF (cline1 == '-dumpzone' .OR. cline1 == '-d') THEN
+ CALL getarg(ijarg, cf_replace) ; ijarg = ijarg +1
+ lchk = ( lchk .OR. chkfile (cf_replace) )
+ !
+ CASE ( '-log' ) ! log file name
+ CALL getarg(ijarg, cf_log) ; ijarg = ijarg +1
+ !
+ CASE ( '-dumpzone' , '-d' ) ! output the zoomed area in a formatted file
ldump=.TRUE.
- CALL getarg(jarg,cdump) ; jarg = jarg +1
- ELSE IF (cline1 == '-nicedumpzone' .OR. cline1 == '-nd') THEN
+ CALL getarg(ijarg, cf_dump) ; ijarg = ijarg +1
+ !
+ CASE ( '-nicedumpzone' , '-nd' ) ! idem dumpzone above but with nicer format
ldumpn=.TRUE.
- CALL getarg(jarg,cdump) ; jarg = jarg +1
- ELSE
- PRINT *, cline1,' : unknown option '
+ CALL getarg(ijarg, cf_dump) ; ijarg = ijarg +1
+ !
+ CASE DEFAULT
+ PRINT *, cldum,' : unknown option '
STOP
- END IF
+ END SELECT
END DO
+
+ IF ( lchk ) STOP ! missing files
IF ( lmodif .AND. .NOT. loverwrite) THEN
- ipos=INDEX(cfilein,'.',.TRUE.)
- READ(cfilein(ipos+1:),*,IOSTAT=iostat) iversion
+ ! creating a working copy of the file indexed by iversion
+ ipos=INDEX(cf_in,'.',.TRUE.)
+ READ(cf_in(ipos+1:),*,IOSTAT=iostat) iversion
IF (iostat /=0 ) THEN
iversion=0
- cfileroot=cfilein
+ cf_root=cf_in
ELSE
- cfileroot=cfilein(1:ipos-1)
+ cf_root=cf_in(1:ipos-1)
ENDIF
iversion=iversion+1
DO WHILE ( lexist )
- WRITE(ctmp,'(a,a,i2.2)') TRIM(cfileroot),'.',iversion
- INQUIRE(FILE=ctmp,EXIST=lexist)
+ WRITE(cwkc,'(a,a,i2.2)') TRIM(cf_root),'.',iversion
+ INQUIRE(FILE=cwkc,EXIST=lexist)
iversion=iversion+1
END DO
- PRINT *, 'Working copy will be : ' ,TRIM(ctmp)
- CALL system(' cp -f '//cfilein//' '//ctmp )
+ PRINT *, 'Working copy will be : ' ,TRIM(cwkc)
+ CALL system(' cp -f '//cf_in//' '//cwkc )
ELSE
- ctmp=cfilein
+ cwkc=cf_in
ENDIF
- npiglo=getdim(ctmp,'x')
- npjglo=getdim(ctmp,'y')
- IF ( imin == -10 ) THEN ! no zoom option passed
- imin=1 ; imax=npiglo
- jmin=1 ; jmax=npjglo
- END IF
- PRINT *, 'NPIGLO = ', npiglo
- PRINT *, 'NPJGLO = ', npjglo
- PRINT *, 'IMIN IMAX JMIN JMAX :', imin, imax,jmin,jmax
- ALLOCATE (mbathy(npiglo,npjglo), bathy(npiglo,npjglo),bathyin(npiglo,npjglo),e3_bot(npiglo,npjglo))
- ALLOCATE (mask(npiglo,npjglo))
- mask = 0
- bathy(:,:)=getvar(ctmp,cvar,1, npiglo,npjglo)
- bathy(:,:)=bathy(:,:)/scale_factor
- bathyin=bathy ! save original
+ npiglo = getdim(cwkc,cn_x)
+ npjglo = getdim(cwkc,cn_y)
+ npk = getdim(cwkc,cn_z)
+ npt = getdim(cwkc,cn_t)
+ IF (npk == 0 ) npk = 1
+ IF (npt == 0 ) npt = 1
- IF (lfullstep ) THEN
- CALL zgr_read ; CALL zgr_zps(imin, imax, jmin, jmax)
+ IF ( iklev > npk ) THEN
+ PRINT *,' ERROR : not enough levels in input file ', TRIM(cwkc)
ENDIF
- IF (lfill ) CALL fillzone( imin, imax, jmin, jmax)
- IF (lraz ) CALL raz_zone( imin, imax, jmin, jmax)
- IF (lrazb ) CALL raz_below( imin, imax, jmin, jmax, depfill)
- IF (lsetb ) CALL set_below( imin, imax, jmin, jmax, depfill)
- IF (ldump) CALL dumpzone(cdump,imin, imax, jmin, jmax)
- IF (ldumpn) CALL nicedumpzone(cdump,imin, imax, jmin, jmax)
- IF (lreplace) CALL replacezone(creplace)
-
- IF (lmodif ) THEN
- CALL prlog(bathyin,bathy,npiglo,npjglo,lappend)
- istatus=putvar(ctmp,cvar,1,imax-imin+1,jmax-jmin+1,kimin=imin,kjmin=jmin,&
- & ptab=bathy(imin:imax,jmin:jmax)*scale_factor)
+
+ IF ( itime > npt ) THEN
+ PRINT *,' ERROR : not enough times in input file ', TRIM(cwkc)
+ ENDIF
+
+ IF ( iimin == -10 ) THEN ! no zoom option passed
+ iimin=1 ; iimax=npiglo
+ ijmin=1 ; ijmax=npjglo
+ END IF
+
+ PRINT *, 'NPIGLO = ', npiglo
+ PRINT *, 'NPJGLO = ', npjglo
+ PRINT *, 'IMIN IMAX JMIN JMAX :', iimin, iimax,ijmin,ijmax
+
+ ALLOCATE (mbathy(npiglo,npjglo), e3_bot( npiglo,npjglo))
+ ALLOCATE (bathy( npiglo,npjglo), bathyin(npiglo,npjglo))
+
+ ! we use bathy as variable name but it can be any field from cf_in
+ bathy(:,:) = getvar(cwkc, cv_in, iklev, npiglo, npjglo, ktime=itime)
+ bathy(:,:) = bathy(:,:)/scale_factor
+ bathyin = bathy ! save original
+
+ IF (lfullstep ) THEN ;CALL zgr_read ; CALL zgr_zps(iimin, iimax, ijmin, ijmax) ; ENDIF
+ IF (lfill ) CALL fillzone (iimin, iimax, ijmin, ijmax)
+ IF (lraz ) CALL raz_zone (iimin, iimax, ijmin, ijmax)
+ IF (lrazb ) CALL raz_below (iimin, iimax, ijmin, ijmax, rdepfill)
+ IF (lsetb ) CALL set_below (iimin, iimax, ijmin, ijmax, rdepfill)
+ IF (ldump ) CALL dumpzone (cf_dump, iimin, iimax, ijmin, ijmax)
+ IF (ldumpn ) CALL nicedumpzone (cf_dump, iimin, iimax, ijmin, ijmax)
+ IF (lreplace ) CALL replacezone (cf_replace)
+
+ IF (lmodif ) THEN ! save log
+ CALL prlog(bathyin, bathy, npiglo, npjglo, lappend)
+ ierr = putvar(cwkc, cv_in, iklev, iimax-iimin+1, ijmax-ijmin+1, kimin=iimin, kjmin=ijmin, &
+ & ptab=bathy(iimin:iimax,ijmin:ijmax)*scale_factor, ktime=itime)
ENDIF
CONTAINS
- SUBROUTINE zgr_zps ( kimin,kimax ,kjmin, kjmax )
- INTEGER ,INTENT(in) :: kimin,kimax, kjmin,kjmax
- !! * Local declarations
- INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: ik, it ! temporary integers
- INTEGER, PARAMETER :: wp=4
- REAL(wp) :: &
- ze3tp, ze3wp, & ! Last ocean level thickness at T- and W-points
- zdepwp, & ! Ajusted ocean depth to avoid too small e3t
- zdepth, & ! " "
- zmax, zmin, & ! Maximum and minimum depth
- zdiff ! temporary scalar
+ SUBROUTINE zgr_zps ( kimin, kimax ,kjmin, kjmax )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE zgr_zps ***
+ !!
+ !! ** Purpose : Build the partial steps
+ !!
+ !! ** Method : Use NEMO routine
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4) ,INTENT(in) :: kimin, kimax, kjmin, kjmax
+ !! * Local declarations
+ INTEGER(KIND=4) :: ji, jj, jk ! dummy loop indices
+ INTEGER(KIND=4) :: ik, it ! temporary integers
+ INTEGER(KIND=4), PARAMETER :: wp=4 ! working precision is 4 in the CDFTOOLS
+
+ REAL(wp) :: ze3tp, ze3wp ! Last ocean level thickness at T- and W-points
+ REAL(wp) :: zdepwp ! Ajusted ocean depth to avoid too small e3t
+ REAL(wp) :: zdepth ! " "
+ REAL(wp) :: zmax, zmin ! Maximum and minimum depth
+ REAL(wp) :: zdiff ! temporary scalar
+ !!----------------------------------------------------------------------
! Initialization of constant
zmax = gdepw(npk) + e3t(npk)
zmin = gdepw(4)
@@ -245,157 +345,251 @@ CONTAINS
DO jj=kjmin,kjmax
jk=mbathy(ji,jj)
IF (jk /= 0 ) THEN
- IF (gdepw(jk+1) > depmin ) bathy(ji,jj)=gdepw(jk+1)-0.1
+ IF (gdepw(jk+1) > rdepmin ) bathy(ji,jj)=gdepw(jk+1)-0.1
ENDIF
ENDDO
END DO
END SUBROUTINE zgr_zps
- SUBROUTINE zgr_read
- INTEGER :: numzgr = 10, il, iostat, idum
- CHARACTER(LEN=256) :: cline, cfile='zgrbat.txt'
+
+ SUBROUTINE zgr_read()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE zgr_read ***
+ !!
+ !! ** Purpose : Read zgrbat.txt file (cf_batfile) to set the gdep[tw]_0
+ !! and e3[tw]
+ !!
+ !! ** Method : Read the ocean output format ( ie, cf_batfile is just
+ !! a copy of the ocean.output concerning zgrbat
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4) :: inumzgr = 10, il, iostat, idum, ifoo
+ CHARACTER(LEN=256) :: cline, clfile
+ !!----------------------------------------------------------------------
+ clfile = cf_batfile ! defined in the main program
il=0
- OPEN(numzgr, FILE=cfile,IOSTAT=iostat)
+ OPEN(inumzgr, FILE=clfile,IOSTAT=iostat)
DO WHILE ( iostat == 0 )
- READ(numzgr,'(a)',IOSTAT=iostat) cline
+ READ(inumzgr,'(a)',IOSTAT=iostat) cline
READ(cline,*,IOSTAT=idum )il
- IF ( idum == 0 )npk=il
+ IF ( idum == 0 ) npk=il
END DO
- ALLOCATE ( level(npk), gdept(npk), gdepw(npk), e3t(npk), e3w(npk) )
- REWIND(numzgr)
+ ALLOCATE ( gdept(npk), gdepw(npk), e3t(npk), e3w(npk) )
+ REWIND(inumzgr)
il=0 ; iostat=0
DO WHILE ( iostat == 0 )
- READ(numzgr,'(a)', IOSTAT=iostat) cline
+ READ(inumzgr,'(a)', IOSTAT=iostat) cline
READ(cline,*,IOSTAT=idum) il
- IF ( idum == 0 ) READ(cline,*) level(il), gdept(il), gdepw(il), &
+ IF ( idum == 0 ) READ(cline,*) ifoo, gdept(il), gdepw(il), &
& e3t(il), e3w(il)
END DO
END SUBROUTINE zgr_read
- SUBROUTINE prlog (ptabold, ptab ,kpi,kpj,ldapp)
- ! * save differences in a log fill
- ! * if ldapp results are append to the logfile
- INTEGER :: kpi,kpj
- REAL(KIND=4), DIMENSION(kpi,kpj) :: ptabold, ptab
- LOGICAL :: ldapp
- ! * Local variables
- INTEGER :: numlog=10
+
+ SUBROUTINE prlog (ptabold, ptab ,kpi, kpj, ldapp)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE prlog ***
+ !!
+ !! ** Purpose : Print a fortran 90 log file describing the modifications
+ !! done to the bathymetry
+ !!
+ !! ** Method : File is append instead of created if ldapp true
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: ptabold ! original array
+ REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: ptab ! modified array
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! size of the array
+ LOGICAL, INTENT(in) :: ldapp ! append flag
+
+ INTEGER(KIND=4) :: ji, jj
+ INTEGER(KIND=4) :: inumlog=10
+ CHARACTER(LEN=80) :: clfile
+ !!----------------------------------------------------------------------
+ clfile = cf_log
IF (ldapp ) THEN
- OPEN (numlog, FILE='log.f90', POSITION='append')
+ OPEN (inumlog, FILE=clfile, POSITION='append')
ELSE
- OPEN (numlog, FILE='log.f90')
+ OPEN (inumlog, FILE=clfile)
ENDIF
- WRITE(numlog,'(a,a)') '! modification from original file : ', TRIM(cfilein)
- WRITE(numlog,'(a,a)') '! written to : ', TRIM(ctmp)
+ WRITE(inumlog,'(a,a)') '! modification from original file : ', TRIM(cf_in)
+ WRITE(inumlog,'(a,a)') '! written to : ', TRIM(cwkc)
DO ji=1,kpi
DO jj=1,kpj
IF ( ABS( ptabold(ji,jj) - ptab(ji,jj)) > 0.02 ) THEN ! allow a 2 cm tolerance for rounding purposes
- WRITE(numlog,'(a,i4,a,i4,a,f8.2,a,f8.2)') ' bathy(',ji,',',jj,')=',ptab(ji,jj)*scale_factor,&
- & ' ! instead of ',ptabold(ji,jj)*scale_factor
+ WRITE(inumlog,'(a,i4,a,i4,a,f8.2,a,f8.2)') ' bathy(',ji,',',jj,')=',ptab(ji,jj)*scale_factor, &
+ & ' ! instead of ',ptabold(ji,jj)*scale_factor
END IF
END DO
END DO
- CLOSE(numlog)
+
+ CLOSE(inumlog)
END SUBROUTINE prlog
- SUBROUTINE fillzone(kimin,kimax,kjmin,kjmax)
- ! * Fill subzone of the bathy file
- INTEGER :: kimin, kimax, kjmin,kjmax
- INTEGER :: ji,jj
+
+ SUBROUTINE fillzone(kimin, kimax, kjmin, kjmax)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE fillzone ***
+ !!
+ !! ** Purpose : Fill a subarea with 0 up to encounter a coast on the East
+ !!
+ !! ** Method : Assume that first point is sea point. Mask it and do so with
+ !! all points to the east (j=cst) up to a land point.
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows
+
+ INTEGER(KIND=4) :: jj
+ INTEGER(KIND=4) :: ii
+ !!----------------------------------------------------------------------
DO jj=kjmin,kjmax
- ji=kimin
- IF ( bathy(ji,jj) /= 0 ) THEN
- DO WHILE ( bathy(ji,jj) /= 0 .AND. ji <= kimax )
- bathy(ji,jj) = 0.
- ji=ji+1
+ ii=kimin
+ IF ( bathy(ii,jj) /= 0 ) THEN
+ DO WHILE ( bathy(ii,jj) /= 0 .AND. ii <= kimax )
+ bathy(ii,jj) = 0.
+ ii=ii+1
END DO
END IF
END DO
END SUBROUTINE fillzone
- SUBROUTINE raz_zone(kimin,kimax,kjmin,kjmax)
- ! * Fill subzone of the bathy file
- INTEGER :: kimin, kimax, kjmin,kjmax
+
+ SUBROUTINE raz_zone(kimin, kimax, kjmin, kjmax)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE raz_zone ***
+ !!
+ !! ** Purpose : Fill a sub area of a bathy file with 0
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows
+ !!----------------------------------------------------------------------
bathy(kimin:kimax, kjmin:kjmax) = 0.
+
END SUBROUTINE raz_zone
- SUBROUTINE raz_below(kimin,kimax,kjmin,kjmax,pdepmin)
- ! * Fill subzone of the bathy file
- INTEGER, INTENT(in) :: kimin, kimax, kjmin,kjmax
- REAL(KIND=4), INTENT(in) :: pdepmin
+
+ SUBROUTINE raz_below(kimin, kimax, kjmin, kjmax, pdepmin)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE raz_below ***
+ !!
+ !! ** Purpose : Fill point (set to 0) that are below pdepmin
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows
+ REAL(KIND=4), INTENT(in) :: pdepmin ! threshold bathy value
+ !!----------------------------------------------------------------------
WHERE ( bathy(kimin:kimax, kjmin:kjmax) <= pdepmin) bathy(kimin:kimax, kjmin:kjmax) = 0.
+
END SUBROUTINE raz_below
- SUBROUTINE set_below(kimin,kimax,kjmin,kjmax,pdepmin)
- ! * Fill subzone of the bathy file
- INTEGER, INTENT(in) :: kimin, kimax, kjmin,kjmax
- REAL(KIND=4), INTENT(in) :: pdepmin
+
+ SUBROUTINE set_below(kimin, kimax, kjmin, kjmax, pdepmin)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE set_below ***
+ !!
+ !! ** Purpose : Set bathy points to pdepmin if less than pdepmin in the
+ !! original bathy
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows
+ REAL(KIND=4), INTENT(in) :: pdepmin ! threshold bathy value
+ !!----------------------------------------------------------------------
WHERE ( bathy(kimin:kimax, kjmin:kjmax) <= pdepmin .AND. bathy(kimin:kimax, kjmin:kjmax) > 0 ) &
& bathy(kimin:kimax, kjmin:kjmax) = pdepmin
+
END SUBROUTINE set_below
- SUBROUTINE dumpzone(cdumpf,kimin,kimax,kjmin,kjmax)
- CHARACTER(LEN=*), INTENT(in) :: cdumpf
- INTEGER, INTENT(in) :: kimin,kimax,kjmin,kjmax
- INTEGER :: ji,jj
- INTEGER :: numdmp=20 , ni
- CHARACTER(LEN=256) :: cfmtr, cfmti
- ! PRINT *,' Dumpzone not yet operational' ; STOP
- ni=kimax-kimin+1
- WRITE(cfmtr,99) ni
- WRITE(cfmti,98) ni
- OPEN(numdmp,FILE=cdumpf)
- WRITE(numdmp,*) kimin,kimax,kjmin,kjmax, TRIM(cfmtr)
+
+ SUBROUTINE dumpzone(cdumpf, kimin, kimax, kjmin, kjmax)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE dumpzone ***
+ !!
+ !! ** Purpose : Print subarea to cdumpf ascii file
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdumpf ! name of the dump file
+ INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows
+
+ INTEGER(KIND=4) :: ji, jj
+ INTEGER(KIND=4) :: inumdmp=20 , ini
+ CHARACTER(LEN=256) :: cl_fmtr, cl_fmti
+ !!----------------------------------------------------------------------
+ ini = kimax - kimin + 1
+ WRITE(cl_fmtr,99) ini
+ WRITE(cl_fmti,98) ini
+ OPEN(inumdmp,FILE=cdumpf)
+ WRITE(inumdmp,*) kimin, kimax, kjmin, kjmax, TRIM(cl_fmtr)
99 FORMAT('(I5,',i4.4,'f8.2)')
98 FORMAT('(5x,',i4.4,'I8)')
- WRITE(numdmp,cfmti)(ji,ji=kimin,kimax)
+ WRITE(inumdmp,cl_fmti)(ji,ji=kimin,kimax)
DO jj= kjmax,kjmin,-1
- WRITE(numdmp,cfmtr) jj, bathy(kimin:kimax,jj)
+ WRITE(inumdmp,cl_fmtr) jj, bathy(kimin:kimax,jj)
ENDDO
- CLOSE(numdmp)
+ CLOSE(inumdmp)
+
END SUBROUTINE dumpzone
- SUBROUTINE nicedumpzone(cdumpf,kimin,kimax,kjmin,kjmax)
- CHARACTER(LEN=*), INTENT(in) :: cdumpf
- INTEGER, INTENT(in) :: kimin,kimax,kjmin,kjmax
- INTEGER :: ji,jj
- INTEGER :: numdmp=20 , ni
- CHARACTER(LEN=256) :: cfmtr, cfmti
- ni=kimax-kimin+1
- WRITE(cfmtr,99) ni
- WRITE(cfmti,98) ni
- OPEN(numdmp,FILE=cdumpf)
- WRITE(numdmp,*) kimin,kimax,kjmin,kjmax, TRIM(cfmtr)
+
+ SUBROUTINE nicedumpzone(cdumpf, kimin, kimax, kjmin, kjmax)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE nicedumpzone ***
+ !!
+ !! ** Purpose : Print subarea to cdumpf ascii file with a nice format
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdumpf ! name of the dump file
+ INTEGER(KIND=4), INTENT(in) :: kimin, kimax, kjmin, kjmax ! position of the data windows
+
+ INTEGER(KIND=4) :: ji, jj
+ INTEGER(KIND=4) :: inumdmp=20 , ini
+ CHARACTER(LEN=256) :: cl_fmtr, cl_fmti
+ !!----------------------------------------------------------------------
+ ini=kimax-kimin+1
+ WRITE(cl_fmtr,99) ini
+ WRITE(cl_fmti,98) ini
+ OPEN(inumdmp,FILE=cdumpf)
+ WRITE(inumdmp,*) kimin,kimax,kjmin,kjmax, TRIM(cl_fmtr)
99 FORMAT('(I5,',i4.4,'I5)')
98 FORMAT('(5x,',i4.4,'I5)')
- WRITE(numdmp,cfmti)(ji,ji=kimin,kimax)
+ WRITE(inumdmp,cl_fmti)(ji,ji=kimin,kimax)
DO jj= kjmax,kjmin,-1
- WRITE(numdmp,cfmtr) jj, INT(bathy(kimin:kimax,jj))
- WRITE(numdmp,*)
- WRITE(numdmp,*)
+ WRITE(inumdmp,cl_fmtr) jj, INT(bathy(kimin:kimax,jj))
+ WRITE(inumdmp,*)
+ WRITE(inumdmp,*)
ENDDO
- CLOSE(numdmp)
+ CLOSE(inumdmp)
+
END SUBROUTINE nicedumpzone
SUBROUTINE replacezone(cdreplace)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE replacezone ***
+ !!
+ !! ** Purpose : Replace a bathy area by data read from an ascii input file
+ !! formely generated by -dump option (and manualy modified)
+ !!
+ !! ** Method : Read format in the header part of the file
+ !!
+ !!----------------------------------------------------------------------
CHARACTER(LEN=*), INTENT(in) :: cdreplace
- INTEGER :: jj
- INTEGER :: iimin,iimax,ijmin,ijmax
- INTEGER :: numrep=20, idum
- ! PRINT *,' replacezone not yet operational' ; STOP
- OPEN(numrep,FILE=cdreplace)
- READ(numrep,*) iimin, iimax, ijmin, ijmax
- READ(numrep,*) ! skip 1 line
+
+ INTEGER(KIND=4) :: jj
+ INTEGER(KIND=4) :: iimin, iimax, ijmin, ijmax
+ INTEGER(KIND=4) :: inumrep=20, idum
+ !!----------------------------------------------------------------------
+ OPEN(inumrep,FILE=cdreplace)
+ READ(inumrep,*) iimin, iimax, ijmin, ijmax
+ READ(inumrep,*) ! skip 1 line
DO jj=ijmax,ijmin,-1
- READ(numrep,*) idum, bathy(iimin:iimax,jj)
+ READ(inumrep,*) idum, bathy(iimin:iimax,jj)
END DO
- CLOSE(numrep)
+ CLOSE(inumrep)
+
END SUBROUTINE replacezone
diff --git a/cdfbci.f90 b/cdfbci.f90
index 13203c1..f1189a4 100644
--- a/cdfbci.f90
+++ b/cdfbci.f90
@@ -1,105 +1,130 @@
PROGRAM cdfbci
- !!---------------------------------------------------------------------------
- !! *** PROGRAM cdfbci ***
+ !!======================================================================
+ !! *** PROGRAM cdfbci ***
+ !!=====================================================================
+ !! ** Purpose : Compute the term of energetic transfert BCI
+ !! for the baroclinic instability
!!
- !! ** Purpose: Compute the term of energetic transfert BCI
- !! for the baroclinic instability for given gridU gridV gridU2 gridV2 files and variables
- !! The intput file is the result of a pre-processing by cdfmoyuvwt
+ !! ** Method : take an input file which is the result of a preprocessing
+ !! tool cdfmoyuvwt.
!!
- !! history :
- !! Original : A. Melet (Feb 2008)
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 02/2008 : A. Melet : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, jt, ilev
- INTEGER :: npiglo, npjglo, npk, nt
- INTEGER :: narg, iargc, ncout, ierr
- INTEGER, DIMENSION(5) :: ipk, id_varout !
-
- REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: e2t, e1t
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: anout, anovt, un, vn, tn
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: utn,vtn
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: tmask, umask, vmask
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: bci
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: dtdx, dtdy
- REAL(KIND=4) ,DIMENSION(1) :: tim
-
- CHARACTER(LEN=256) :: cfile
- CHARACTER(LEN=256) :: coord='mesh_hgr.nc', cfileout='bci.nc'
- TYPE (variable), DIMENSION(5) :: typvar !: structure for attibutes
- !!
+ INTEGER(KIND=4) :: ji, jj, jk
+ INTEGER(KIND=4) :: ilev
+ INTEGER(KIND=4) :: npiglo, npjglo, npk, npt
+ INTEGER(KIND=4) :: narg, iargc
+ INTEGER(KIND=4) :: ncout, ierr
+ INTEGER(KIND=4), DIMENSION(5) :: ipk, id_varout !
+
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2t, e1t
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: anout, anovt, un, vn, tn
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: utn, vtn
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask, umask, vmask
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: bci
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdtdx, rdtdy
+
+ CHARACTER(LEN=256) :: cf_in
+ CHARACTER(LEN=256) :: cf_out='bci.nc'
+
+ TYPE (variable), DIMENSION(5) :: stypvar !: structure for attibutes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames() ! load cdf variable name
+
narg = iargc()
- IF ( narg /= 1 ) THEN
- PRINT *,' USAGE : cdfbci file'
- PRINT *,' Produce a cdf file bci.nc with bci variable'
- PRINT *,' file is from cdfmoyuvwt'
- PRINT *,' the mean must have been computed on a period long enough'
- PRINT *,' for the statistics to be meaningful'
- PRINT *,' Need mesh_hgr.nc'
- PRINT *,' '
- PRINT *,' if file is in grid B or C, check the code (PM)'
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfbci UVWT-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute elements for analysing the baroclinic instability'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' UVWT-file : input file is produced by cdfmoyuvwt, and the mean'
+ PRINT *,' must be computed on a long-enough period for the '
+ PRINT *,' statistics to be meaningful. Points are on T grid.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' Need ', TRIM(cn_fhgr) ,' file'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : 5 output variables'
+ PRINT *,' dTdx : zonal derivative of Tbar on T point (*1000)'
+ PRINT *,' dTdy : meridional derivative of Tbar on T point (*1000)'
+ PRINT *,' uT : anomaly of u times anomaly of T on T point'
+ PRINT *,' vT : anomaly of v times anomaly of T on T point'
+ PRINT *,' bci : transfert of energy for the baroclinic instability (*1000)'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfmoyuvwt '
STOP
ENDIF
- CALL getarg(1, cfile)
- npiglo = getdim(cfile,'x')
- npjglo = getdim(cfile,'y')
- npk = getdim(cfile,'depth')
- nt = getdim(cfile,'time_counter')
+ CALL getarg(1, cf_in)
+ IF (chkfile(cf_in) .OR. chkfile (cn_fhgr) ) STOP
- PRINT *, 'npiglo =',npiglo
- PRINT *, 'npjglo =',npjglo
- PRINT *, 'npk =',npk
- PRINT *, 'nt =',nt
+ npiglo = getdim(cf_in, cn_x)
+ npjglo = getdim(cf_in, cn_y)
+ npk = getdim(cf_in, cn_z)
+ npt = getdim(cf_in, cn_t)
+
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npk =', npk
+ PRINT *, 'npt =', npt
! define new variables for output ( must update att.txt)
- typvar(1)%name='dTdx'
- typvar(1)%long_name='zonal derivate of Tbar on T point (*1000)'
- typvar(1)%short_name='dTdx'
+ stypvar(1)%cname = 'dTdx'
+ stypvar(1)%clong_name = 'zonal derivate of Tbar on T point (*1000)'
+ stypvar(1)%cshort_name = 'dTdx'
- typvar(2)%name='dTdy'
- typvar(2)%long_name='meridional derivate of Tbar on T point (*1000)'
- typvar(2)%short_name='dTdy'
+ stypvar(2)%cname = 'dTdy'
+ stypvar(2)%clong_name = 'meridional derivate of Tbar on T point (*1000)'
+ stypvar(2)%cshort_name = 'dTdy'
- typvar(3)%name='uT'
- typvar(3)%long_name='anomaly of u times anomaly of T on T point'
- typvar(3)%short_name='uT'
+ stypvar(3)%cname = 'uT'
+ stypvar(3)%clong_name = 'anomaly of u times anomaly of T on T point'
+ stypvar(3)%cshort_name = 'uT'
- typvar(4)%name='vT'
- typvar(4)%long_name='anomaly of v times anomaly of T on T point'
- typvar(4)%short_name='vT'
+ stypvar(4)%cname = 'vT'
+ stypvar(4)%clong_name = 'anomaly of v times anomaly of T on T point'
+ stypvar(4)%cshort_name = 'vT'
- typvar(5)%name='bci'
- typvar(5)%long_name='transfert of energy for the baroclinic instability (*1000)'
- typvar(5)%short_name='bci'
+ stypvar(5)%cname = 'bci'
+ stypvar(5)%clong_name = 'transfert of energy for the baroclinic instability (*1000)'
+ stypvar(5)%cshort_name = 'bci'
- typvar%units='1000 (u"T" dT/dx + v"T" dT/dy)'
- typvar%missing_value=0.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar%online_operation='N/A'
- typvar%axis='TYX'
+ stypvar%cunits = '1000 (u"T" dT/dx + v"T" dT/dy)'
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = -1000.
+ stypvar%valid_max = 1000.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TYX'
ipk(:) = npk
!test if lev exists
- IF ((npk==0) .AND. (ilev .GT. 0) ) THEN
+ IF ((npk==0) .AND. (ilev > 0) ) THEN
PRINT *, 'Problem : npk = 0 and lev > 0 STOP'
STOP
END IF
! create output fileset
- ncout =create(cfileout, cfile, npiglo,npjglo,npk)
- ierr= createvar(ncout ,typvar,5, ipk,id_varout )
- ierr= putheadervar(ncout, cfile, npiglo, npjglo,npk)
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npk )
+ ierr = createvar (ncout , stypvar, 5, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk )
! Allocate the memory
ALLOCATE ( e1t(npiglo,npjglo) , e2t(npiglo,npjglo) )
@@ -108,42 +133,34 @@ PROGRAM cdfbci
ALLOCATE ( utn(npiglo,npjglo) , vtn(npiglo,npjglo) )
ALLOCATE ( umask(npiglo,npjglo) , vmask(npiglo,npjglo) )
ALLOCATE ( tmask(npiglo,npjglo) )
- ALLOCATE ( dtdx(npiglo,npjglo) , dtdy(npiglo,npjglo) )
+ ALLOCATE ( rdtdx(npiglo,npjglo) , rdtdy(npiglo,npjglo) )
ALLOCATE ( anout(npiglo,npjglo) , anovt(npiglo,npjglo) )
- ALLOCATE ( bci(npiglo,npjglo) )
+ ALLOCATE ( bci(npiglo,npjglo), tim(npt) )
- e1t= getvar(coord, 'e1t', 1,npiglo,npjglo)
- e2t= getvar(coord, 'e2t', 1,npiglo,npjglo)
+ e1t = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo)
+ e2t = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo)
- tim=getvar1d(cfile,'time_counter',nt)
- ierr=putvar1d(ncout,tim,1,'T')
+ tim = getvar1d(cf_in, cn_vtimec, npt)
+ ierr = putvar1d(ncout, tim, npt, 'T')
DO jk=1, npk
PRINT *,' level ',jk
- dtdx(:,:) = 0.d0
- dtdy(:,:) = 0.d0
+ rdtdx(:,:) = 0.0
+ rdtdy(:,:) = 0.0
- anovt(:,:) = 0.d0
- anout(:,:) = 0.d0
- un(:,:) = 0.d0
- vn(:,:) = 0.d0
- tn(:,:) = 0.d0
- utn(:,:) = 0.d0
- vtn(:,:) = 0.d0
-
- un(:,:) = getvar(cfile, 'ubar', jk ,npiglo,npjglo, ktime=1)
- vn(:,:) = getvar(cfile, 'vbar', jk ,npiglo,npjglo, ktime=1)
- tn(:,:) = getvar(cfile, 'tbar', jk ,npiglo,npjglo, ktime=1)
- utn(:,:) = getvar(cfile, 'utbar', jk ,npiglo,npjglo, ktime=1)
- vtn(:,:) = getvar(cfile, 'vtbar', jk ,npiglo,npjglo, ktime=1)
+ anovt(:,:) = 0.0
+ anout(:,:) = 0.0
+
+ un(:,:) = getvar(cf_in, 'ubar', jk ,npiglo, npjglo, ktime=1)
+ vn(:,:) = getvar(cf_in, 'vbar', jk ,npiglo, npjglo, ktime=1)
+ tn(:,:) = getvar(cf_in, 'tbar', jk ,npiglo, npjglo, ktime=1)
+ utn(:,:) = getvar(cf_in, 'utbar', jk ,npiglo, npjglo, ktime=1)
+ vtn(:,:) = getvar(cf_in, 'vtbar', jk ,npiglo, npjglo, ktime=1)
! compute the mask
DO jj = 2, npjglo
DO ji = 2, npiglo
- umask(ji,jj)=0.
- vmask(ji,jj)=0.
- tmask(ji,jj)=0.
umask(ji,jj)= un(ji,jj)*un(ji-1,jj)
vmask(ji,jj)= vn(ji,jj)*vn(ji,jj-1)
tmask(ji,jj)= tn(ji,jj)
@@ -155,41 +172,40 @@ PROGRAM cdfbci
DO jj = 2, npjglo
DO ji = 2, npiglo ! vector opt.
- ! calcul des d�riv�es au point T
- dtdx(ji,jj) = 1000/2 *( ( tn(ji,jj ) - tn(ji-1,jj) ) &
- & * tmask(ji,jj)*tmask(ji-1,jj) &
- & / ( 0.5* ( e1t(ji,jj) + e1t(ji-1,jj) )) &
- & +( tn(ji+1,jj ) - tn(ji,jj) ) &
- & * tmask(ji+1,jj)*tmask(ji,jj) &
+ ! compute derivatives at T point
+ rdtdx(ji,jj) = 1000/2. *( ( tn(ji,jj ) - tn(ji-1,jj) ) &
+ & * tmask(ji,jj)*tmask(ji-1,jj) &
+ & / ( 0.5* ( e1t(ji,jj) + e1t(ji-1,jj) )) &
+ & +( tn(ji+1,jj ) - tn(ji,jj) ) &
+ & * tmask(ji+1,jj)*tmask(ji,jj) &
& / ( 0.5* ( e1t(ji+1,jj) + e1t(ji,jj) )))
- dtdy(ji,jj) = 1000/2 *( ( tn(ji,jj) - tn(ji,jj-1) ) &
- & * tmask(ji,jj)*tmask(ji,jj-1) &
- & / ( 0.5* ( e2t(ji,jj) + e2t(ji,jj-1) )) &
- & +( tn(ji,jj+1 ) - tn(ji,jj) ) &
- & * tmask(ji,jj+1)*tmask(ji,jj) &
+ rdtdy(ji,jj) = 1000/2. *( ( tn(ji,jj) - tn(ji,jj-1) ) &
+ & * tmask(ji,jj)*tmask(ji,jj-1) &
+ & / ( 0.5* ( e2t(ji,jj) + e2t(ji,jj-1) )) &
+ & +( tn(ji,jj+1 ) - tn(ji,jj) ) &
+ & * tmask(ji,jj+1)*tmask(ji,jj) &
& / ( 0.5* ( e2t(ji,jj+1) + e2t(ji,jj) )) )
- anout(ji,jj) = ( utn(ji,jj) &
+ anout(ji,jj) = ( utn(ji,jj) &
& - 1/2 * umask(ji,jj)*( un(ji,jj) + un(ji-1,jj) ) &
& * tmask(ji,jj) * tn(ji,jj) )
- anovt(ji,jj) = ( vtn(ji,jj) &
+ anovt(ji,jj) = ( vtn(ji,jj) &
& - 1/2 * vmask(ji,jj)*( vn(ji,jj) + vn(ji,jj-1) ) &
& * tmask(ji,jj) * tn(ji,jj) )
- ! calcul du terme bti
- bci(ji,jj) = ( anout(ji,jj) * dtdx(ji,jj) &
- & + anovt(ji,jj) * dtdy(ji,jj) )
+ ! compute bci term
+ bci(ji,jj) = ( anout(ji,jj) * rdtdx(ji,jj) + anovt(ji,jj) * rdtdy(ji,jj) )
END DO
END DO
!
- ierr = putvar(ncout, id_varout(1) ,dtdx, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(2) ,dtdy, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(3) ,anout, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(4) ,anovt, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(5) ,bci, jk, npiglo, npjglo, ktime=1)
+ ierr = putvar(ncout, id_varout(1), rdtdx, jk, npiglo, npjglo, ktime=1)
+ ierr = putvar(ncout, id_varout(2), rdtdy, jk, npiglo, npjglo, ktime=1)
+ ierr = putvar(ncout, id_varout(3), anout, jk, npiglo, npjglo, ktime=1)
+ ierr = putvar(ncout, id_varout(4), anovt, jk, npiglo, npjglo, ktime=1)
+ ierr = putvar(ncout, id_varout(5), bci, jk, npiglo, npjglo, ktime=1)
END DO
ierr = closeout(ncout)
diff --git a/cdfbn2-full.f90 b/cdfbn2-full.f90
deleted file mode 100644
index 7af629a..0000000
--- a/cdfbn2-full.f90
+++ /dev/null
@@ -1,153 +0,0 @@
-PROGRAM cdfbn2_full
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfbn2_full ***
- !!
- !! ** Purpose: Compute the Brunt Vaissala frequency
- !! using same algoritm than OPA9
- !! FULL STEP VERSION
- !!
- !! ** Method: Try to avoid 3 d arrays : work with 2 levels a a time
- !! The brunt-vaisala frequency is computed using the
- !! polynomial expression of McDougall (1987):
- !! N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
- !! N2 is then insterpolated at T levels
- !!
- !! history:
- !! Original : J.M. Molines Nov 2004
- !! J.M. Molines Apr 2005 : introduction of module cdfio
- !!--------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: iup = 1 , idown = 2, itmp
- INTEGER, DIMENSION(2) :: ipk, id_varout
- REAL(KIND=4) , DIMENSION (:,:,:), ALLOCATABLE :: ztemp, zsal,zwk !: Array to read 2 layer of data
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: &
- zn2 , & !: Brunt Vaissala Frequency (N2)
- zmask, e3w,gdepw
- REAL(KIND=4) , DIMENSION (:), ALLOCATABLE :: e3k
- REAL(KIND=4),DIMENSION(1) :: tim
- REAL(KIND=4),DIMENSION(:), ALLOCATABLE :: gdep
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='bn2.nc', cdum, cdep !:
- CHARACTER(LEN=256) :: coordzgr='mesh_zgr.nc' !:
- TYPE(variable), DIMENSION (1) :: typvar
-
- INTEGER :: ncout
- INTEGER :: istatus
- REAL(KIND=4) :: zpi
- LOGICAL :: l_w=.false.
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfbn2-full gridT [W]'
- PRINT *,' Output on bn2.nc, variable vobn2'
- PRINT *,' With option W specified, the output is on W points'
- PRINT *,' By default it is on T points'
- PRINT *,' Need mesh_zgr.nc and mesh_hgr.nc '
- PRINT *,' FULL STEP CASE '
- STOP
- ENDIF
-
- CALL getarg (1, cfilet)
- IF (narg == 2 ) THEN
- CALL getarg(2,cdum)
- SELECT CASE (cdum)
- CASE ('W','w') ; l_w=.true.
- CASE DEFAULT ; PRINT *,' Option not understood :', TRIM(cdum) ; STOP
- END SELECT
- ENDIF
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- ipk(1)= npk ! 3D
- typvar(1)%name='vobn2'
- typvar(1)%units='s-1'
- typvar(1)%missing_value=-1000.
- typvar(1)%valid_min=0.
- typvar(1)%valid_max=50000.
- typvar(1)%long_name='Brunt_Vaissala_Frequency'
- typvar(1)%short_name='vobn2'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE (ztemp(npiglo,npjglo,2), zsal(npiglo,npjglo,2), zwk(npiglo,npjglo,2) ,zmask(npiglo,npjglo))
- ALLOCATE (zn2(npiglo,npjglo) ,e3w(npiglo,npjglo),gdepw(1,1),e3k(npk) ,gdep(npk) )
-
- cdep='gdept'
- IF (l_w) cdep='gdepw'
- DO jk=1,npk
- gdepw(:,:)= getvar(coordzgr, cdep, jk, 1,1) ; gdep(jk)= gdepw(1,1)
- ENDDO
-
-
- ! create output fileset
-
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo,npjglo,npk,pdep=gdep)
-
- zpi=ACOS(-1.)
-
- ! 2 levels of T and S are required : iup,idown (with respect to W level)
- ! Compute from bottom to top (for vertical integration)
- ztemp(:,:,idown) = getvar(cfilet, 'votemper', npk-1 ,npiglo, npjglo)
- zsal( :,:,idown) = getvar(cfilet, 'vosaline', npk-1 ,npiglo, npjglo)
-
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
- e3k(:) = getvare3(coordzgr, 'e3w', npk)
-
- DO jk = npk-1, 2, -1
- PRINT *,'level ',jk
- zmask(:,:)=1.
- ztemp(:,:,iup)= getvar(cfilet, 'votemper', jk-1 ,npiglo, npjglo)
- WHERE(ztemp(:,:,idown) == 0 ) zmask = 0
- zsal(:,:,iup) = getvar(cfilet, 'vosaline', jk-1 ,npiglo,npjglo)
-
- gdepw(:,:) = getvar(coordzgr, 'gdepw', jk, 1,1)
- e3w(:,:)=e3k(jk)
-
- zwk(:,:,iup) = eosbn2 ( ztemp,zsal,gdepw(1,1),e3w, npiglo,npjglo ,iup,idown)* zmask(:,:)
-
- IF ( .NOT. l_w ) THEN
- ! now put zn2 at T level (k )
- WHERE ( zwk(:,:,idown) == 0 )
- zn2(:,:) = zwk(:,:,iup)
- ELSEWHERE
- zn2(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) * zmask(:,:)
- END WHERE
- ELSE
- zn2(:,:) = zwk(:,:,iup)
- ENDIF
-
- ierr = putvar(ncout, id_varout(1) ,zn2, jk, npiglo, npjglo )
- itmp = idown ; idown = iup ; iup = itmp
-
- END DO ! loop to next level
-
- istatus = closeout(ncout)
-
-END PROGRAM cdfbn2_full
diff --git a/cdfbn2.f90 b/cdfbn2.f90
index 3ad7f76..eb2cea3 100644
--- a/cdfbn2.f90
+++ b/cdfbn2.f90
@@ -1,147 +1,186 @@
PROGRAM cdfbn2
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfbn2 ***
+ !!======================================================================
+ !! *** PROGRAM cdfbn2 ***
+ !!=====================================================================
+ !! ** Purpose : Compute the Brunt Vaissala frequency
+ !! using same algoritm than NEMO
!!
- !! ** Purpose: Compute the Brunt Vaissala frequency
- !! using same algoritm than OPA9
- !!
- !! ** Method: Try to avoid 3 d arrays : work with 2 levels a a time
+ !! ** Method : Try to avoid 3 d arrays : work with 2 levels a a time
!! The brunt-vaisala frequency is computed using the
!! polynomial expression of McDougall (1987):
!! N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
!! N2 is then insterpolated at T levels
!!
- !! history:
- !! Original : J.M. Molines Nov 2004
- !! J.M. Molines Apr 2005 : introduction of module cdfio
- !!--------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.0 : 11/2004 : J.M. Molines : Original code
+ !! 2.1 : 04/2005 : J.M. Molines : use cdfio
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
+ USE modcdfnames ! for cdf variable names
USE eos
-
- !! * Local variables
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: iup = 1 , idown = 2, itmp
- INTEGER, DIMENSION(2) :: ipk, id_varout
- REAL(KIND=4) , DIMENSION (:,:,:), ALLOCATABLE :: ztemp, zsal,zwk !: Array to read 2 layer of data
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: &
- zn2 , & !: Brunt Vaissala Frequency (N2)
- zmask, e3w,gdepw
- REAL(KIND=4),DIMENSION(1) :: tim
- REAL(KIND=4),DIMENSION(:), ALLOCATABLE :: gdep
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='bn2.nc', cdum , cdep !:
- CHARACTER(LEN=256) :: coordzgr='mesh_zgr.nc' !:
- TYPE(variable), DIMENSION (1) :: typvar
-
- INTEGER :: ncout
- INTEGER :: istatus
- REAL(KIND=4) :: zpi
- LOGICAL :: l_w=.false.
-
- !! Read command line
- narg= iargc()
+
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc, ijarg !
+ INTEGER(KIND=4) :: npiglo, npjglo, npk, npt ! size of the domain
+ INTEGER(KIND=4) :: iup = 1, idown = 2, itmp ! for swapping the levels
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(2) :: ipk, id_varout ! level and id of output variables
+
+ REAL(KIND=4) :: zpi ! 3.14...
+ REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: ztemp, zsal, zwk ! Array to read 2 layer of data
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zn2 ! Brunt Vaissala Frequency (N2)
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e3w ! mask and metric
+ REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep, tim, e3w1d ! depth and time
+
+ CHARACTER(LEN=256) :: cf_tfil, cldum, cv_dep ! input file name, ...
+ CHARACTER(LEN=256) :: cf_out = 'bn2.nc' ! output file name
+ CHARACTER(LEN=256) :: cglobal ! global attribute
+ CHARACTER(LEN=80) :: cv_e3w = 'e3w_ps' ! e3w variable name (partial step)
+ CHARACTER(LEN=80) :: cv_bn2 = 'vobn2' ! cdf variable name for N2
+
+ TYPE(variable), DIMENSION(1) :: stypvar ! variable attribute
+
+ LOGICAL :: l_w=.false. ! flag for vertical location of bn2
+ LOGICAL :: lchk=.true. ! check missing files
+ LOGICAL :: lfull=.false. ! full step flag
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfbn2 gridT [W]'
- PRINT *,' Output on bn2.nc, variable vobn2'
- PRINT *,' With option W specified, the output is on W points'
- PRINT *,' By default it is on T points'
- PRINT *,' Need mesh_zgr.nc and mesh_hgr.nc '
+ PRINT *,' usage : cdfbn2 T-file [W] [-full]'
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the Brunt-Vaissala frequency (N2) according to'
+ PRINT *,' temperature and salinity given in the input file.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf input gridT file for temperature and salinity.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ W ] : keep N2 at W points. Default is to interpolate N2'
+ PRINT *,' at T point on the vertical.'
+ PRINT *,' [ -full ] : indicate a full step configuration instead of'
+ PRINT *,' the default partial steps.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fzgr),' is needed for this program.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_bn2)
STOP
ENDIF
- CALL getarg (1, cfilet)
- IF (narg == 2 ) THEN
- CALL getarg(2,cdum)
- SELECT CASE (cdum)
- CASE ('W','w') ; l_w=.true.
- CASE DEFAULT ; PRINT *,' Option not understood :', TRIM(cdum) ; STOP
- END SELECT
- ENDIF
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- ipk(1)= npk ! 3D
- typvar(1)%name='vobn2'
- typvar(1)%units='s-1'
- typvar(1)%missing_value=-1000.
- typvar(1)%valid_min=0.
- typvar(1)%valid_max=50000.
- typvar(1)%long_name='Brunt_Vaissala_Frequency'
- typvar(1)%short_name='vobn2'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE (ztemp(npiglo,npjglo,2), zsal(npiglo,npjglo,2), zwk(npiglo,npjglo,2) ,zmask(npiglo,npjglo))
- ALLOCATE (zn2(npiglo,npjglo) ,e3w(npiglo,npjglo),gdepw(1,1), gdep(npk) )
-
- cdep='gdept'
- IF (l_w) cdep='gdepw'
- DO jk=1,npk
- gdepw(:,:)= getvar(coordzgr, cdep, jk, 1,1) ; gdep(jk)= gdepw(1,1)
- ENDDO
+ cglobal = 'Partial step computation'
+
+ ijarg = 1
+ CALL getarg (ijarg, cf_tfil) ; ijarg = ijarg + 1
+
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE (cldum)
+ CASE ('W','w') ; l_w = .true.
+ CASE ('-full') ; lfull = .true. ; cglobal = 'full step computation'
+ CASE DEFAULT ; PRINT *,' Option not understood :', TRIM(cldum) ; STOP
+ END SELECT
+ END DO
+
+ lchk = chkfile (cn_fzgr )
+ lchk = lchk .OR. chkfile (cf_tfil )
+ IF ( lchk ) STOP ! missing files
+
+ npiglo = getdim (cf_tfil, cn_x)
+ npjglo = getdim (cf_tfil, cn_y)
+ npk = getdim (cf_tfil, cn_z)
+ npt = getdim (cf_tfil, cn_t)
+
+ ipk(1) = npk ! 3D
+ stypvar(1)%cname = cv_bn2
+ stypvar(1)%cunits = 's-1'
+ stypvar(1)%rmissing_value = -1000.
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 50000.
+ stypvar(1)%clong_name = 'Brunt_Vaissala_Frequency'
+ stypvar(1)%cshort_name = cv_bn2
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npk =', npk
+ PRINT *, 'npt =', npt
+
+ ALLOCATE (ztemp(npiglo,npjglo,2), zsal(npiglo,npjglo,2) )
+ ALLOCATE (zwk(npiglo,npjglo,2), zmask(npiglo,npjglo) )
+ ALLOCATE (zn2(npiglo,npjglo), e3w(npiglo,npjglo) )
+ ALLOCATE (gdep(npk), tim(npt) )
+ IF ( lfull ) ALLOCATE (e3w1d(npk) )
+
+ cv_dep=cn_gdept
+ IF (l_w) cv_dep=cn_gdepw
+
+ gdep(:) = getvare3(cn_fzgr, cv_dep, npk)
! create output fileset
-
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo,npjglo,npk,pdep=gdep)
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk)
+ ierr = createvar (ncout , stypvar, 1, ipk, id_varout, cdglobal=TRIM(cglobal))
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk, pdep=gdep)
zpi=ACOS(-1.)
- ! 2 levels of T and S are required : iup,idown (with respect to W level)
- ! Compute from bottom to top (for vertical integration)
- ztemp(:,:,idown) = getvar(cfilet, 'votemper', npk-1 ,npiglo, npjglo)
- zsal( :,:,idown) = getvar(cfilet, 'vosaline', npk-1 ,npiglo, npjglo)
-
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- DO jk = npk-1, 2, -1
- PRINT *,'level ',jk
- zmask(:,:)=1.
- ztemp(:,:,iup)= getvar(cfilet, 'votemper', jk-1 ,npiglo, npjglo)
- WHERE(ztemp(:,:,idown) == 0 ) zmask = 0
- zsal(:,:,iup) = getvar(cfilet, 'vosaline', jk-1 ,npiglo,npjglo)
-
- gdepw(:,:) = getvar(coordzgr, 'gdepw', jk, 1,1)
- e3w(:,:) = getvar(coordzgr, 'e3w_ps', jk,npiglo,npjglo,ldiom=.true.)
-
- zwk(:,:,iup) = eosbn2 ( ztemp,zsal,gdepw(1,1),e3w, npiglo,npjglo ,iup,idown)* zmask(:,:)
-
- IF ( .NOT. l_w ) THEN
- ! now put zn2 at T level (k )
- WHERE ( zwk(:,:,idown) == 0 )
- zn2(:,:) = zwk(:,:,iup)
- ELSEWHERE
- zn2(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) * zmask(:,:)
- END WHERE
- ELSE
- zn2(:,:) = zwk(:,:,iup)
- ENDIF
-
- ierr = putvar(ncout, id_varout(1) ,zn2, jk, npiglo, npjglo )
- itmp = idown ; idown = iup ; iup = itmp
-
- END DO ! loop to next level
-
- istatus = closeout(ncout)
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt,'T')
+
+ IF ( lfull ) e3w1d(:) = getvare3(cn_fzgr, cn_ve3w, npk)
+
+ gdep(:) = getvare3(cn_fzgr, cn_gdepw, npk)
+ DO jt=1,npt
+ ! 2 levels of T and S are required : iup,idown (with respect to W level)
+ ! Compute from bottom to top (for vertical integration)
+ ztemp(:,:,idown) = getvar(cf_tfil, cn_votemper, npk-1, npiglo, npjglo, ktime=jt)
+ zsal( :,:,idown) = getvar(cf_tfil, cn_vosaline, npk-1, npiglo, npjglo, ktime=jt)
+
+ DO jk = npk-1, 2, -1
+ PRINT *,'level ',jk
+ zmask(:,:)=1.
+ ztemp(:,:,iup)= getvar(cf_tfil, cn_votemper, jk-1, npiglo, npjglo, ktime=jt)
+ WHERE(ztemp(:,:,idown) == 0 ) zmask = 0
+ zsal(:,:,iup) = getvar(cf_tfil, cn_vosaline, jk-1, npiglo, npjglo, ktime=jt)
+
+ IF ( lfull ) THEN
+ e3w(:,:) = e3w1d(jk)
+ ELSE
+ e3w(:,:) = getvar(cn_fzgr, cv_e3w , jk, npiglo, npjglo, ldiom=.true.)
+ ENDIF
+
+ zwk(:,:,iup) = eosbn2(ztemp, zsal, gdep(jk), e3w, npiglo, npjglo ,iup, idown)* zmask(:,:)
+
+ IF ( .NOT. l_w ) THEN
+ ! now put zn2 at T level (k )
+ WHERE ( zwk(:,:,idown) == 0 )
+ zn2(:,:) = zwk(:,:,iup)
+ ELSEWHERE
+ zn2(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) * zmask(:,:)
+ END WHERE
+ ELSE
+ zn2(:,:) = zwk(:,:,iup)
+ ENDIF
+
+ WHERE ( zn2 == 0 ) zn2 = -1000.
+ ierr = putvar(ncout, id_varout(1), zn2, jk, npiglo, npjglo, ktime=jt )
+ itmp = idown ; idown = iup ; iup = itmp
+
+ END DO ! loop to next level
+ END DO
+
+ ierr = closeout(ncout)
END PROGRAM cdfbn2
diff --git a/cdfbottom.f90 b/cdfbottom.f90
index c8fc7b1..4461a62 100644
--- a/cdfbottom.f90
+++ b/cdfbottom.f90
@@ -1,166 +1,187 @@
PROGRAM cdfbottom
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfbottom ***
- !!
- !! ** Purpose: Extract the bottom value for the 3D variables
+ !!======================================================================
+ !! *** PROGRAM cdfbottom ***
+ !!=====================================================================
+ !! ** Purpose : Extract the bottom value for the 3D variables
!! which are in the input file. Store the results
!! on a similar file, with the same variable name.
- !!
- !! ** Method: Try to avoid 3 d arrays
- !! Uses the corresponding mask file to determine the bottom.
- !! If no mask found it assumes that 0.0000 values corresponds
- !! to masked values.
!!
- !! history:
- !! Original : J.M. Molines (Nov. 2005)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! ** Method: Uses the corresponding mask file to determine the bottom.
+ !! If no mask found it assumes that 0.0000 values corresponds
+ !! to masked values.
+ !!
+ !! History : 2.1 : 11/2005 : J.M. Molines : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
- !! * Local variables
IMPLICIT NONE
- INTEGER :: jk , jv, jvar !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvars !: number of variables in the input file
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk,ipko,& !: outptut variables : number of levels,
- & id_var, id_varout !: ncdf varid's
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: zfield ,& !: Array to read a layer of data
- & zbot , & !: array to store the bottom value
- & zmask !: 2D mask at current level
- REAL(KIND=4),DIMENSION(1) :: tim
-
- CHARACTER(LEN=256) :: cfile, cdum ,cmask='mask.nc',cfileout='bottom.nc' !:
- CHARACTER(LEN=1) :: ctype=' '
- CHARACTER(LEN=5) :: cvmask=' ' !: name of the mask variable
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE :: cvarname !: array of var name
- CHARACTER(LEN=256) :: cdep
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar !: structure for variable attribute
-
- INTEGER :: ncout
- INTEGER :: istatus
-
- !! Read command line
- narg= iargc()
+
+ INTEGER(KIND=4) :: jk , jv, jvar, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! argument on line
+ INTEGER(KIND=4) :: npiglo, npjglo, npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvars ! number of variables in the input file
+ INTEGER(KIND=4) :: ncout ! ncid of output ncdf file
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, ipko ! outptut variables : number of levels,
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var, id_varout ! ncdf varid's
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zfield ! Array to read a layer of data
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zbot ! array to store the bottom value
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter of the file
+
+ CHARACTER(LEN=256) :: cf_out='bottom.nc' ! output file name
+ CHARACTER(LEN=256) :: cf_in, cldum ! working strings
+ CHARACTER(LEN=256) :: cv_dep ! true name of dep dimension
+ CHARACTER(LEN=5) :: cv_msk=' ' ! name of the mask variable
+ CHARACTER(LEN=1) :: ctype=' ' ! point type (T U V ..)
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for variable attribute
+ !!--------------------------------------------------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfbottom ncfile [ T | U | V | F]'
- PRINT *,' grid point type is optional: if not given'
- PRINT *,' it does''nt require the mask.nc file and'
- PRINT *,' assumes that data points with 0 are land points '
- PRINT *,' Output on bottom.nc, variables as in the input file'
+ PRINT *,' usage : cdfbottom IN-file [ T | U | V | F]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Create a 2D file with bottom most values for all the variables'
+ PRINT *,' which are in the input 3D file.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : input netcdf 3D file.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ T | U | V | F] : specify the type of grid point on the C-grid'
+ PRINT *,' if not given, assume that land points are values with 0.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fmsk),' file is required if the grid point is specified'
+ PRINT *,' or if the land value is not 0.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : same names than input file, long_name attribute is'
+ PRINT *,' prefixed by Bottom '
STOP
ENDIF
- CALL getarg (1, cfile)
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep,kstatus=istatus)
-
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- npk = getdim (cfile,'nav_lev',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
+ ijarg = 1
+ CALL getarg (ijarg, cf_in) ; ijarg = ijarg + 1
+
+ IF ( chkfile(cf_in) /= 0 ) STOP ! missing files
+
+ npiglo = getdim (cf_in,cn_x)
+ npjglo = getdim (cf_in,cn_y)
+ npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr) ! defautl cn_z is depth
+
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'z', cdtrue=cv_dep, kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'sigma', cdtrue=cv_dep, kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in,'nav_lev', cdtrue=cv_dep, kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
PRINT *,' assume file with no depth'
npk=0
ENDIF
ENDIF
ENDIF
ENDIF
+ npt = getdim (cf_in,cn_t)
- ALLOCATE (zfield(npiglo,npjglo), zbot(npiglo,npjglo),zmask(npiglo,npjglo))
+ ALLOCATE (zfield(npiglo,npjglo), zbot(npiglo,npjglo), zmask(npiglo,npjglo))
+ ALLOCATE (tim(npt) )
- IF (narg == 2 ) THEN
- CALL getarg (2, ctype )
+ DO WHILE ( ijarg <= narg )
+ CALL getarg (ijarg, ctype ) ; ijarg = ijarg + 1
+ IF ( chkfile (cn_fmsk ) ) STOP ! missing mask file
SELECT CASE ( ctype )
CASE ( 'T', 't', 'S', 's' )
- cvmask='tmask'
+ cv_msk='tmask'
CASE ( 'U', 'u' )
- cvmask='umask'
+ cv_msk='umask'
CASE ( 'V', 'v' )
- cvmask='vmask'
+ cv_msk='vmask'
CASE ( 'F', 'f' )
- cvmask='fmask'
+ cv_msk='fmask'
PRINT *, 'Be carefull with fmask ... !!!'
CASE DEFAULT
PRINT *, ' ERROR : This type of point ', ctype,' is not known !'
STOP
END SELECT
- ENDIF
+ END DO
! look for the number of variables in the input file
- nvars = getnvar(cfile)
+ nvars = getnvar(cf_in)
PRINT *,' nvars =', nvars
- ALLOCATE (cvarname(nvars) ,typvar(nvars))
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars) ,ipko(nvars) )
+ ALLOCATE (cv_names(nvars) ,stypvar(nvars))
+ ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars), ipko(nvars) )
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ cv_names(:)=getvarname(cf_in,nvars,stypvar)
id_var(:) = (/(jv, jv=1,nvars)/)
! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
- ipko(:)= 1 ! all variables output are 2D
+ ipk(:) = getipk (cf_in,nvars,cdep=cv_dep)
+ ipko(:) = 1 ! all variables output are 2D
- WHERE( ipk <= 1 ) cvarname='none'
-! typvar%name=cvarname
-! typvar%axis='TYX'
+ WHERE( ipk <= 1 ) cv_names='none'
DO jvar=1,nvars
- typvar(jvar)%name=cvarname(jvar)
- typvar(jvar)%axis='TYX'
- cdum=typvar(jvar)%long_name
- typvar(jvar)%long_name='Bottom '//TRIM(cdum)
+ stypvar(jvar)%cname = cv_names(jvar)
+ stypvar(jvar)%caxis = 'TYX'
+ cldum=stypvar(jvar)%clong_name
+ stypvar(jvar)%clong_name = 'Bottom '//TRIM(cldum)
END DO
! create output fileset
- ! create output file taking the sizes in cfile
-
- ncout =create(cfileout, cfile,npiglo,npjglo,1)
+ ! create output file taking the sizes in cf_in
- ierr= createvar(ncout , typvar, nvars, ipko, id_varout )
-
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, 1)
+ ncout = create (cf_out, cf_in , npiglo, npjglo, 1 ) ! 1 level file
+ ierr = createvar (ncout , stypvar, nvars , ipko , id_varout )
+ ierr = putheadervar(ncout , cf_in , npiglo, npjglo, 1 )
DO jvar = 1,nvars
zfield = 0.
zbot = 0.
- IF (cvarname(jvar) == 'none' ) THEN
+ IF (cv_names(jvar) == 'none' ) THEN
! skip these variable
ELSE
- PRINT *, ' WORKING with ', TRIM( cvarname(jvar) ), ipk(jvar)
- DO jk = 1, ipk(jvar)
- zmask = 1.
- zfield(:,:) = getvar(cfile, cvarname(jvar), jk ,npiglo, npjglo)
- IF (jk == 1 .AND. jvar == 1. ) THEN
- tim=getvar1d(cfile,'time_counter',1)
- ENDIF
- IF ( cvmask == ' ' ) THEN
- WHERE ( zfield /= 0 )
- zbot = zfield
- END WHERE
- ELSE
- zmask(:,:) = getvar(cmask, cvmask, jk, npiglo, npjglo)
- WHERE ( zmask /= 0 )
- zbot = zfield
- END WHERE
- ENDIF
- END DO
- ierr = putvar(ncout, id_varout(jvar) ,zbot, 1,npiglo, npjglo)
+ PRINT *, ' WORKING with ', TRIM( cv_names(jvar) ), ipk(jvar)
+ DO jt = 1, npt
+ DO jk = 1, ipk(jvar)
+ zmask = 1.
+ zfield(:,:) = getvar(cf_in, cv_names(jvar), jk, npiglo, npjglo, ktime=jt)
+ IF ( cv_msk == ' ' ) THEN
+ WHERE ( zfield /= 0 )
+ zbot = zfield
+ END WHERE
+ ELSE
+ zmask(:,:) = getvar(cn_fmsk, cv_msk, jk, npiglo, npjglo)
+ WHERE ( zmask /= 0 )
+ zbot = zfield
+ END WHERE
+ ENDIF
+ END DO
+ ierr = putvar(ncout, id_varout(jvar), zbot, 1, npiglo, npjglo, ktime=jt)
+ ENDDO
ENDIF
-
END DO
- ierr=putvar1d(ncout,tim,1,'T')
- istatus = closeout(ncout)
+ tim = getvar1d(cf_in, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = closeout(ncout)
+
END PROGRAM cdfbottom
diff --git a/cdfbottomsig.f90 b/cdfbottomsig.f90
new file mode 100644
index 0000000..f79601d
--- /dev/null
+++ b/cdfbottomsig.f90
@@ -0,0 +1,166 @@
+PROGRAM cdfbottomsig
+ !!======================================================================
+ !! *** PROGRAM cdfbottomsig ***
+ !!=====================================================================
+ !! ** Purpose : Compute the bottom sigma from gridT file.
+ !! Store the results on a 'similar' cdf file.
+ !!
+ !! ** Method: Uses vosaline do determine the bottom points. A depth
+ !! reference can be specify to compute density refered to
+ !! this depth.
+ !!
+ !! History : 2.1 : 11/2005 : J.M. Molines : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ USE cdfio
+ USE eos
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
+ IMPLICIT NONE
+
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc !
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(1) :: ipk ! outptut variables : number of levels,
+ INTEGER(KIND=4), DIMENSION(1) :: id_varout ! ncdf varid's
+ INTEGER(KIND=4), DIMENSION(2) :: ismin, ismax ! location of min and max sigmabot
+
+ REAL(KIND=4) :: zsigmn, zsigmx ! value of min and max of sigmabot
+ REAL(KIND=4) :: zref ! value of min and max of sigmabot
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp, zsal ! Array to read a layer of data
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp0, zsal0 ! temporary array to read temp, sal
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsig ! potential density
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at surface
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ CHARACTER(LEN=256) :: cf_out='botsig.nc' ! Output file name
+ CHARACTER(LEN=256) :: cf_tfil ! input filename
+ CHARACTER(LEN=256) :: cv_sig ! output variable name
+ CHARACTER(LEN=256) :: cref ! message for depth reference
+ CHARACTER(LEN=256) :: cldum ! dummy char variable
+
+ TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes
+
+ LOGICAL :: lsigi=.FALSE. ! flag for sigma-i computation
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfbottomsig T-file [zref]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Create a 2D file with bottom density. In case a depth reference'
+ PRINT *,' is given, the density is refered to this depth. By default sigma-0'
+ PRINT *,' is used. Bottom most point is determined from the last non zero '
+ PRINT *,' salinity point in the water column.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : input file with temperature and salinity '
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [zref] : depth reference for potential density'
+ PRINT *,' If not given assume sigma-0'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : sobotsig0 or sobotsigi ( kg/m3 - 1000 )'
+ STOP
+ ENDIF
+
+ cv_sig = 'sobotsig0'
+ cref=''
+ CALL getarg (1, cf_tfil)
+ IF ( chkfile(cf_tfil) ) STOP ! missing file
+
+ IF ( narg == 2 ) THEN
+ lsigi = .TRUE.
+ CALL getarg (2, cldum) ; READ(cldum,*) zref
+ cv_sig = 'sobotsigi'
+ WRITE(cref,'("_refered_to_",i4.4,"_m")') NINT(zref)
+ ENDIF
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
+
+ ipk(:)= 1 ! all variables (input and output are 3D)
+
+ stypvar(1)%cname = cv_sig
+ stypvar(1)%cunits = 'kg/m3'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = 0.001
+ stypvar(1)%valid_max = 40.
+ stypvar(1)%clong_name = 'Bottom_Potential_density'//TRIM(cref)
+ stypvar(1)%cshort_name = cv_sig
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TYX'
+
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npk =', npk
+ PRINT *, 'npt =', npt
+
+ ALLOCATE (ztemp( npiglo,npjglo), zsal( npiglo,npjglo), zsig(npiglo,npjglo) ,zmask(npiglo,npjglo))
+ ALLOCATE (ztemp0(npiglo,npjglo), zsal0(npiglo,npjglo) )
+ ALLOCATE ( tim (npt) )
+
+ ! create output fileset
+
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 1 , ipk , id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
+
+ zsal = 0.
+ ztemp = 0.
+ zmask = 1.
+
+ DO jt = 1, npt
+ DO jk = 1, npk
+ PRINT *,'level ',jk
+ zsal0(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt)
+ ztemp0(:,:)= getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt)
+ IF (jk == 1 ) THEN
+ WHERE( zsal0 == 0. ) zmask=0.
+ END IF
+ WHERE ( zsal0 /= 0 )
+ zsal=zsal0 ; ztemp=ztemp0
+ END WHERE
+ ENDDO
+
+ IF (lsigi ) THEN
+ zsig(:,:) = sigmai ( ztemp, zsal, zref, npiglo, npjglo ) * zmask(:,:)
+ ELSE
+ zsig(:,:) = sigma0 ( ztemp, zsal, npiglo, npjglo ) * zmask(:,:)
+ ENDIF
+
+
+ zsigmn=minval(zsig(2:npiglo-1,2:npjglo-1), zmask(2:npiglo-1,2:npjglo-1)==1)
+ zsigmx=maxval(zsig(2:npiglo-1,2:npjglo-1), zmask(2:npiglo-1,2:npjglo-1)==1)
+ ismin= minloc(zsig(2:npiglo-1,2:npjglo-1), zmask(2:npiglo-1,2:npjglo-1)==1)
+ ismax= maxloc(zsig(2:npiglo-1,2:npjglo-1), zmask(2:npiglo-1,2:npjglo-1)==1)
+
+ PRINT *,'Bottom density : min = ', zsigmn,' at ', ismin(1), ismin(2)
+ PRINT *,' : max = ', zsigmx,' at ', ismax(1), ismax(2)
+
+ ierr = putvar(ncout, id_varout(1), zsig, 1, npiglo, npjglo, ktime=jt)
+ ENDDO
+
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim , npt, 'T')
+ ierr = closeout(ncout)
+
+END PROGRAM cdfbottomsig
diff --git a/cdfbottomsig0.f90 b/cdfbottomsig0.f90
deleted file mode 100644
index adad2e5..0000000
--- a/cdfbottomsig0.f90
+++ /dev/null
@@ -1,114 +0,0 @@
-PROGRAM cdfbottomsig0
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfbottomsig0 ***
- !!
- !! ** Purpose: Compute the bottom sig0 from gridT file
- !! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: Try to avoid 3 d arrays
- !! uses vosaline do determine the bottom points
- !!
- !! history:
- !! Original : J.M. Molines (Nov. 2005)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal ,& !: Array to read a layer of data
- & ztemp0 , & !: temporary array to read temp
- & zsal0 , & !: temporary array to read sal
- & zsig0 , & !: potential density (sig-0)
- & zmask !: 2D mask at surface
- REAL(KIND=4),DIMENSION(1) :: tim
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='botsig0.nc' !:
- TYPE (variable), DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: ncout
- INTEGER :: istatus
- INTEGER, DIMENSION (2) :: ismin, ismax
- REAL(KIND=4) :: sigmin, sigmax
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfbottomsig0 gridT '
- PRINT *,' Output on botsig0.nc, variable sobotsig0'
- STOP
- ENDIF
-
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- ipk(:)= 1 ! all variables (input and output are 3D)
- typvar(1)%name= 'sobotsig0'
- typvar(1)%units='kg/m3'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.001
- typvar(1)%valid_max= 40.
- typvar(1)%long_name='Bottom_Potential_density'
- typvar(1)%short_name='sobotsig0'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsig0(npiglo,npjglo) ,zmask(npiglo,npjglo))
- ALLOCATE (ztemp0(npiglo,npjglo), zsal0(npiglo,npjglo) )
-
- ! create output fileset
-
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,npk)
-
- zsal = 0.
- ztemp = 0.
- zmask = 1.
- DO jk = 1, npk
- PRINT *,'level ',jk
- zsal0(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo)
- ztemp0(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo)
- IF (jk == 1 ) THEN
- tim=getvar1d(cfilet,'time_counter',1)
- WHERE( zsal0 == 0. ) zmask=0.
- END IF
- WHERE ( zsal0 /= 0 )
- zsal=zsal0 ; ztemp=ztemp0
- END WHERE
-
- ENDDO
-
- zsig0(:,:) = sigma0 ( ztemp,zsal,npiglo,npjglo )* zmask(:,:)
-
- sigmin=minval(zsig0(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- sigmax=maxval(zsig0(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- ismin= minloc(zsig0(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- ismax= maxloc(zsig0(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- PRINT *,'Bottom density : min = ', sigmin,' at ', ismin(1), ismin(2)
- PRINT *,' : max = ', sigmax,' at ', ismax(1), ismax(2)
-
- ierr = putvar(ncout, id_varout(1) ,zsig0, 1,npiglo, npjglo)
-
- ierr=putvar1d(ncout,tim,1,'T')
-
- istatus = closeout(ncout)
-END PROGRAM cdfbottomsig0
diff --git a/cdfbottomsigi.f90 b/cdfbottomsigi.f90
deleted file mode 100644
index 65deade..0000000
--- a/cdfbottomsigi.f90
+++ /dev/null
@@ -1,117 +0,0 @@
-PROGRAM cdfbottomsigi
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfbottomsigi ***
- !!
- !! ** Purpose: Compute the bottom sigi from gridT file
- !! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: Try to avoid 3 d arrays
- !! uses vosaline do determine the bottom points
- !!
- !! history:
- !! Original : J.M. Molines (Nov. 2005)
- !! : P. Mathiot (2008) from cdfbottomsig0 to cdfbottomdigi
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal ,& !: Array to read a layer of data
- & ztemp0 , & !: temporary array to read temp
- & zsal0 , & !: temporary array to read sal
- & zsigi , & !: potential density (sig-0)
- & zmask !: 2D mask at surface
- REAL(KIND=4),DIMENSION(1) :: tim
- REAL(KIND=4) :: zref
- CHARACTER(LEN=256) :: cdum, cfilet ,cfileout='botsigi.nc' !:
- TYPE (variable), DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: ncout
- INTEGER :: istatus
- INTEGER, DIMENSION (2) :: ismin, ismax
- REAL(KIND=4) :: sigmin, sigmax
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfbottomsigi gridT zref'
- PRINT *,' Output on botsigi.nc, variable sobotsigi'
- STOP
- ENDIF
-
- CALL getarg (1, cfilet)
- CALL getarg (2, cdum); READ(cdum,*) zref
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- ipk(:)= 1 ! all variables (input and output are 3D)
- typvar(1)%name= 'sobotsigi'
- typvar(1)%units='kg/m3'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.001
- typvar(1)%valid_max= 50.
- typvar(1)%long_name='Bottom_Potential_density'
- typvar(1)%short_name='sobotsigi'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsigi(npiglo,npjglo) ,zmask(npiglo,npjglo))
- ALLOCATE (ztemp0(npiglo,npjglo), zsal0(npiglo,npjglo) )
-
- ! create output fileset
-
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,npk)
-
- zsal = 0.
- ztemp = 0.
- zmask = 1.
- DO jk = 1, npk
- PRINT *,'level ',jk
- zsal0(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo)
- ztemp0(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo)
- IF (jk == 1 ) THEN
- tim=getvar1d(cfilet,'time_counter',1)
- WHERE( zsal0 == 0. ) zmask=0.
- END IF
- WHERE ( zsal0 /= 0 )
- zsal=zsal0 ; ztemp=ztemp0
- END WHERE
-
- ENDDO
-
- zsigi(:,:) = sigmai ( ztemp,zsal,zref,npiglo,npjglo )* zmask(:,:)
-
- sigmin=minval(zsigi(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- sigmax=maxval(zsigi(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- ismin= minloc(zsigi(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- ismax= maxloc(zsigi(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- PRINT *,'Bottom density : min = ', sigmin,' at ', ismin(1), ismin(2)
- PRINT *,' : max = ', sigmax,' at ', ismax(1), ismax(2)
-
- ierr = putvar(ncout, id_varout(1) ,zsigi, 1,npiglo, npjglo)
-
- ierr=putvar1d(ncout,tim,1,'T')
-
- istatus = closeout(ncout)
-END PROGRAM cdfbottomsigi
diff --git a/cdfbti.f90 b/cdfbti.f90
index 1d31b5e..4aab265 100644
--- a/cdfbti.f90
+++ b/cdfbti.f90
@@ -1,123 +1,153 @@
PROGRAM cdfbti
- !!---------------------------------------------------------------------------
- !! *** PROGRAM cdfbti ***
+ !!======================================================================
+ !! *** PROGRAM cdfbti ***
+ !!=====================================================================
+ !! ** Purpose : Compute the term of energetic transfert BTI
+ !! for the barotropic instability for given gridU
+ !! gridV gridU2 gridV2 files and variables
!!
- !! ** Purpose: Compute the term of energetic transfert BTI
- !! for the barotropic instability for given gridU gridV gridU2 gridV2 files and variables
+ !! ** Method : Take an input file which is preprocessed by
+ !! cdfmoyuvwt. See also cdfbci
!!
- !! history :
- !! Original : A. Melet (Feb 2008)
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- !! * Modules used
+ !! History : 2.1 : 02/2008 : A. Melet : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, jt, ilev
- INTEGER :: npiglo, npjglo, npk, nt
- INTEGER :: narg, iargc, ncout, ierr
- INTEGER, DIMENSION(8) :: ipk, id_varout !
-
- REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: e2t, e1t, e1f, e2f
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: un, vn, u2n, v2n, uvn
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: fmask, umask, vmask
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: anousqrt, anovsqrt, anouv, bti
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: dudx, dudy, dvdx, dvdy
- REAL(KIND=4) ,DIMENSION(1) :: tim
-
- CHARACTER(LEN=256) :: cfile
- CHARACTER(LEN=256) :: coord='mesh_hgr.nc', cfileout='bti.nc'
- TYPE (variable), DIMENSION(8) :: typvar !: structure for attibutes
+ INTEGER(KIND=4), PARAMETER :: jp_varout = 8
+ INTEGER(KIND=4), PARAMETER :: jp_dudx = 1, jp_dvdx = 2
+ INTEGER(KIND=4), PARAMETER :: jp_dudy = 3, jp_dvdy = 4
+ INTEGER(KIND=4), PARAMETER :: jp_anousqrt= 5, jp_anovsqrt= 6
+ INTEGER(KIND=4), PARAMETER :: jp_anouv = 7, jp_bti = 8
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: npiglo, npjglo ! domain size
+ INTEGER(KIND=4) :: npk, npt ! vertical and time
+ INTEGER(KIND=4) :: narg, iargc !
+ INTEGER(KIND=4) :: ncout, ierr ! ncid of output file, error status
+ INTEGER(KIND=4), DIMENSION(jp_varout) :: ipk, id_varout !
+
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2t, e1t, e1f, e2f !
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn, u2n, v2n, uvn !
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: fmask, umask, vmask !
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: anousqrt, anovsqrt !
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: anouv, bti !
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dudx, dudy, dvdx, dvdy !
+
+ CHARACTER(LEN=256) :: cf_out='bti.nc' ! output file name
+ CHARACTER(LEN=256) :: cf_uvwtfil ! input file name
+
+ TYPE (variable), DIMENSION(jp_varout) :: stypvar ! structure for attibutes
+
+ LOGICAL :: lchk
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
!!
narg = iargc()
IF ( narg /= 1 ) THEN
- PRINT *,' USAGE : cdfbti file'
- PRINT *,' Produce a cdf file bti.nc with bti variable'
- PRINT *,' file is from cdfmoyuvwt'
- PRINT *,' the mean must have been computed on a period long enough'
- PRINT *,' for the statistics to be meaningful'
- PRINT *,' Need mesh_hgr.nc'
- PRINT *,' '
- PRINT *,' if file is in grid B or C, check the code (PM)'
+ PRINT *,' usage : cdfbti UVWT-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the terms in the barotropic energy tranfert equation.'
+ PRINT *,' The transfert of energy for the barotropic instability is '
+ PRINT *,' bti= -[(u''bar)^2*dubar/dx ...'
+ PRINT *,' +(v''bar)^2*dvbar/dy ...'
+ PRINT *,' +(u''v''*(dubar/dy +dvbar/dx))]'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' UVWT-file : netcdf file produced by cdfmoyuvwt'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fhgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : '
+ PRINT *,' dudx : zonal derivate of ubar on T point'
+ PRINT *,' dvdx : zonal derivate of vbar on T point'
+ PRINT *,' dudy : meridional derivate of ubar on T point'
+ PRINT *,' dvdy : meridional derivate of vbar on T point'
+ PRINT *,' anousqrt : mean of (u-ubar)^2 on T point'
+ PRINT *,' anovsqrt : mean of (v-vbar)^2 on T point'
+ PRINT *,' anouv : mean of (u-ubar)*(v-vbar) on T point'
+ PRINT *,' bti : transfert of energy for the barotropic instability.'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfmoyuvwt, cdfbci, cdfnrjcomp, cdfkempemekeepe'
+ PRINT *,' '
STOP
ENDIF
- CALL getarg(1, cfile)
- npiglo = getdim(cfile,'x')
- npjglo = getdim(cfile,'y')
- npk = getdim(cfile,'depth')
- nt = getdim(cfile,'time_counter')
+ CALL getarg(1, cf_uvwtfil)
- PRINT *, 'npiglo =',npiglo
- PRINT *, 'npjglo =',npjglo
- PRINT *, 'npk =',npk
- PRINT *, 'nt =',nt
+ lchk = chkfile (cn_fhgr )
+ lchk = lchk .OR. chkfile (cf_uvwtfil )
+ IF ( lchk ) STOP ! missing file
+
+ npiglo = getdim(cf_uvwtfil,cn_x)
+ npjglo = getdim(cf_uvwtfil,cn_y)
+ npk = getdim(cf_uvwtfil,cn_z)
+ npt = getdim(cf_uvwtfil,cn_t)
+
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npk =', npk
+ PRINT *, 'npt =', npt
! define new variables for output ( must update att.txt)
- typvar(1)%name='dudx'
- typvar(1)%long_name='zonal derivate of u on T point'
- typvar(1)%short_name='dudx'
-
- typvar(2)%name='dvdx'
- typvar(2)%long_name='zonal derivate of v on T point'
- typvar(2)%short_name='dvdx'
-
- typvar(3)%name='dudy'
- typvar(3)%long_name='meridional derivate of u on T point'
- typvar(3)%short_name='dudy'
-
- typvar(4)%name='dvdy'
- typvar(4)%long_name='meridional derivate of v on T point'
- typvar(4)%short_name='dvdy'
-
- typvar(5)%name='anousqrt'
- typvar(5)%long_name='temporal mean of the square of the zonal speed anomaly'
- typvar(5)%short_name='anousqrt'
-
- typvar(6)%name='anovsqrt'
- typvar(6)%long_name='temporal mean of the square of the meridional speed anomaly'
- typvar(6)%short_name='anovsqrt'
-
- typvar(7)%name='anouv'
- typvar(7)%long_name='temporal mean of the Reynolds term'
- typvar(7)%short_name='anouanov'
-
- typvar(8)%name='bti'
- typvar(8)%long_name='transfert of energy for the barotropic instability'
- typvar(8)%short_name='bti'
-
- typvar%units='100000 s-1'
- typvar%missing_value=0.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar%online_operation='N/A'
- typvar%axis='TYX'
-
- ipk(1) = npk
- ipk(2) = npk
- ipk(3) = npk
- ipk(4) = npk
- ipk(5) = npk
- ipk(6) = npk
- ipk(7) = npk
- ipk(8) = npk
-
- !test if lev exists
- IF ((npk==0) .AND. (ilev .GT. 0) ) THEN
- PRINT *, 'Problem : npk = 0 and lev > 0 STOP'
- STOP
- END IF
+ stypvar(jp_dudx)%cname = 'dudx'
+ stypvar(jp_dudx)%clong_name = 'zonal derivate of u on T point'
+ stypvar(jp_dudx)%cshort_name = 'dudx'
+
+ stypvar(jp_dvdx)%cname = 'dvdx'
+ stypvar(jp_dvdx)%clong_name = 'zonal derivate of v on T point'
+ stypvar(jp_dvdx)%cshort_name = 'dvdx'
+
+ stypvar(jp_dudy)%cname = 'dudy'
+ stypvar(jp_dudy)%clong_name = 'meridional derivate of u on T point'
+ stypvar(jp_dudy)%cshort_name = 'dudy'
+
+ stypvar(jp_dvdy)%cname = 'dvdy'
+ stypvar(jp_dvdy)%clong_name = 'meridional derivate of v on T point'
+ stypvar(jp_dvdy)%cshort_name = 'dvdy'
+
+ stypvar(jp_anousqrt)%cname = 'anousqrt'
+ stypvar(jp_anousqrt)%clong_name = 'temporal mean of the square of the zonal speed anomaly'
+ stypvar(jp_anousqrt)%cshort_name = 'anousqrt'
+
+ stypvar(jp_anovsqrt)%cname = 'anovsqrt'
+ stypvar(jp_anovsqrt)%clong_name = 'temporal mean of the square of the meridional speed anomaly'
+ stypvar(jp_anovsqrt)%cshort_name = 'anovsqrt'
+
+ stypvar(jp_anouv)%cname = 'anouv'
+ stypvar(jp_anouv)%clong_name = 'temporal mean of the Reynolds term'
+ stypvar(jp_anouv)%cshort_name = 'anouanov'
+
+ stypvar(jp_bti)%cname = 'bti'
+ stypvar(jp_bti)%clong_name = 'transfert of energy for the barotropic instability'
+ stypvar(jp_bti)%cshort_name = 'bti'
+
+ stypvar%cunits = '100000 s-1'
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = -1000.
+ stypvar%valid_max = 1000.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TYX'
+
+ ipk(:) = npk
! create output fileset
- ncout =create(cfileout, cfile, npiglo,npjglo,npk)
- ierr= createvar(ncout ,typvar,8, ipk,id_varout )
- ierr= putheadervar(ncout, cfile, npiglo, npjglo,npk)
+ ncout = create (cf_out, cf_uvwtfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, jp_varout, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_uvwtfil, npiglo, npjglo, npk )
! Allocate the memory
ALLOCATE ( e1t(npiglo,npjglo) , e1f(npiglo,npjglo) )
@@ -131,108 +161,111 @@ PROGRAM cdfbti
ALLOCATE ( uvn(npiglo,npjglo) )
ALLOCATE ( anousqrt(npiglo,npjglo) , anovsqrt(npiglo,npjglo) )
ALLOCATE ( anouv(npiglo,npjglo), bti(npiglo,npjglo) )
+ ALLOCATE ( tim(npt) )
- e1t= getvar(coord, 'e1t', 1,npiglo,npjglo)
- e1f= getvar(coord, 'e1f', 1,npiglo,npjglo)
- e2t= getvar(coord, 'e2t', 1,npiglo,npjglo)
- e2f= getvar(coord, 'e2f', 1,npiglo,npjglo)
-
- tim=getvar1d(cfile,'time_counter',nt)
- ierr=putvar1d(ncout,tim,1,'T')
-
- DO jk=1, npk
- PRINT *,' level ',jk
-
- dudx(:,:) = 0.d0
- dvdx(:,:) = 0.d0
- dudy(:,:) = 0.d0
- dvdy(:,:) = 0.d0
-
- anousqrt(:,:) = 0.d0
- anovsqrt(:,:) = 0.d0
- anouv(:,:) = 0.d0
-
- un(:,:) = getvar(cfile, 'ubar', jk ,npiglo,npjglo, ktime=1)
- vn(:,:) = getvar(cfile, 'vbar', jk ,npiglo,npjglo, ktime=1)
- u2n(:,:) = getvar(cfile, 'u2bar', jk ,npiglo,npjglo, ktime=1)
- v2n(:,:) = getvar(cfile, 'v2bar', jk ,npiglo,npjglo, ktime=1)
- uvn(:,:) = getvar(cfile, 'uvbar', jk ,npiglo,npjglo, ktime=1)
-
- ! compute the mask
- DO jj = 2, npjglo
- DO ji = 2, npiglo
- umask(ji,jj)=0.
- vmask(ji,jj)=0.
- umask(ji,jj)= un(ji,jj)*un(ji-1,jj)
- vmask(ji,jj)= vn(ji,jj)*vn(ji,jj-1)
- IF (umask(ji,jj) /= 0.) umask(ji,jj)=1.
- IF (vmask(ji,jj) /= 0.) vmask(ji,jj)=1.
+ e1t = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo)
+ e1f = getvar(cn_fhgr, cn_ve1f, 1, npiglo, npjglo)
+ e2t = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo)
+ e2f = getvar(cn_fhgr, cn_ve2f, 1, npiglo, npjglo)
+
+ tim = getvar1d(cf_uvwtfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T' )
+
+ DO jt = 1, npt
+ DO jk=1, npk
+ PRINT *,' level ',jk
+ dudx(:,:) = 0.d0
+ dvdx(:,:) = 0.d0
+ dudy(:,:) = 0.d0
+ dvdy(:,:) = 0.d0
+
+ anousqrt(:,:) = 0.d0
+ anovsqrt(:,:) = 0.d0
+ anouv(:,:) = 0.d0
+
+ un(:,:) = getvar(cf_uvwtfil, 'ubar', jk ,npiglo,npjglo, ktime=jt)
+ vn(:,:) = getvar(cf_uvwtfil, 'vbar', jk ,npiglo,npjglo, ktime=jt)
+ u2n(:,:) = getvar(cf_uvwtfil, 'u2bar', jk ,npiglo,npjglo, ktime=jt)
+ v2n(:,:) = getvar(cf_uvwtfil, 'v2bar', jk ,npiglo,npjglo, ktime=jt)
+ uvn(:,:) = getvar(cf_uvwtfil, 'uvbar', jk ,npiglo,npjglo, ktime=jt)
+
+ ! compute the masks
+ umask(:,:) = 0. ; vmask(:,:) = 0. ; fmask(:,:) = 0.
+ DO jj = 2, npjglo
+ DO ji = 2, npiglo
+ umask(ji,jj)= un(ji,jj)*un(ji-1,jj )
+ vmask(ji,jj)= vn(ji,jj)*vn(ji ,jj-1)
+ ENDDO
ENDDO
- ENDDO
- DO jj = 1, npjglo-1
- DO ji = 1, npiglo-1
- fmask(ji,jj)=0.
- fmask(ji,jj)= un(ji,jj)*un(ji,jj+1) * vn(ji,jj)*vn(ji+1,jj)
- IF (fmask(ji,jj) /= 0.) fmask(ji,jj)=1.
+
+ WHERE ( umask /= 0. ) umask = 1.
+ WHERE ( vmask /= 0. ) vmask = 1.
+
+ DO jj = 1, npjglo-1
+ DO ji = 1, npiglo-1
+ fmask(ji,jj)= un(ji,jj)*un(ji,jj+1) * vn(ji,jj)*vn(ji+1,jj)
+ ENDDO
ENDDO
- ENDDO
-
-
-
- DO jj = 2, npjglo
- DO ji = 2, npiglo ! vector opt.
- ! calcul des d�riv�es au point T
- dudx(ji,jj) = 100000 * ( un(ji,jj ) - un(ji-1,jj) ) &
- & * umask(ji,jj) / e1t(ji,jj)
-
- dvdy(ji,jj) = 100000 * ( vn(ji,jj) - vn(ji,jj-1) ) &
- & * vmask(ji,jj) / e2t(ji,jj)
-
- dudy(ji,jj) = 100000/4 *( ( un(ji,jj+1 ) - un(ji,jj) ) &
- & * fmask(ji,jj) / e2f(ji,jj) &
- + (un(ji,jj ) - un(ji,jj-1) ) &
- & * fmask(ji,jj-1) / e2f(ji,jj-1) &
- + (un(ji-1,jj+1 ) - un(ji-1,jj) ) &
- & * fmask(ji-1,jj) / e2f(ji-1,jj) &
- + (un(ji-1,jj ) - un(ji-1,jj-1) ) &
- & * fmask(ji-1,jj-1) / e2f(ji-1,jj-1) )
-
- dvdx(ji,jj) = 100000/4 *( ( vn(ji,jj ) - vn(ji-1,jj) ) &
- & * fmask(ji-1,jj) / e1f(ji-1,jj) &
- + (vn(ji+1,jj ) - vn(ji,jj) ) &
- & * fmask(ji,jj) / e1f(ji,jj) &
- + (vn(ji-1,jj-1 ) - vn(ji,jj-1) ) &
- & * fmask(ji-1,jj-1) / e1f(ji-1,jj-1) &
- + (vn(ji+1,jj-1 ) - vn(ji,jj-1) ) &
- & * fmask(ji,jj-1) / e1f(ji,jj-1) )
-
- ! calcul des termes de Reynolds
- anousqrt(ji,jj) = 1000/2 * umask(ji,jj)*( ( u2n(ji,jj) - un(ji,jj)*un(ji,jj) ) &
- & + ( u2n(ji-1,jj) - un(ji-1,jj)*un(ji-1,jj) ) )
-
- anovsqrt(ji,jj) = 1000/2 * vmask(ji,jj)*( ( v2n(ji,jj) - vn(ji,jj)*vn(ji,jj) ) &
- & + ( v2n(ji,jj-1) - vn(ji,jj)*vn(ji,jj-1) ) )
-
- anouv(ji,jj) = 1000 * ( uvn(ji,jj) &
- & - 1/2 * umask(ji,jj)*( un(ji,jj) + un(ji-1,jj) ) &
- & * 1/2 * vmask(ji,jj)*( vn(ji,jj) + vn(ji,jj-1) ) )
- ! calcul du terme bti
- bti(ji,jj) = -1 * ( anousqrt(ji,jj) * dudx(ji,jj) &
- & + anovsqrt(ji,jj) * dvdy(ji,jj) &
- & + anouv(ji,jj) * ( dvdx(ji,jj) + dudy(ji,jj) ))
+ WHERE ( fmask /= 0. ) fmask = 1.
+
+ DO jj = 2, npjglo
+ DO ji = 2, npiglo ! vector opt.
+ ! compute derivates at T points
+ dudx(ji,jj) = 100000 * ( un(ji,jj ) - un(ji-1,jj) ) &
+ & * umask(ji,jj) / e1t(ji,jj)
+
+ dvdy(ji,jj) = 100000 * ( vn(ji,jj ) - vn(ji,jj-1) ) &
+ & * vmask(ji,jj) / e2t(ji,jj)
+
+ dudy(ji,jj) = 100000/4 *( ( un(ji,jj+1 ) - un(ji,jj) ) &
+ & * fmask(ji,jj) / e2f(ji,jj) &
+ & + (un(ji,jj ) - un(ji,jj-1) ) &
+ & * fmask(ji,jj-1) / e2f(ji,jj-1) &
+ & + (un(ji-1,jj+1 ) - un(ji-1,jj) ) &
+ & * fmask(ji-1,jj) / e2f(ji-1,jj) &
+ & + (un(ji-1,jj ) - un(ji-1,jj-1) ) &
+ & * fmask(ji-1,jj-1) / e2f(ji-1,jj-1) )
+
+ dvdx(ji,jj) = 100000/4 *( ( vn(ji,jj ) - vn(ji-1,jj) ) &
+ & * fmask(ji-1,jj) / e1f(ji-1,jj) &
+ & + (vn(ji+1,jj ) - vn(ji,jj) ) &
+ & * fmask(ji,jj) / e1f(ji,jj) &
+ & + (vn(ji-1,jj-1 ) - vn(ji,jj-1) ) &
+ & * fmask(ji-1,jj-1) / e1f(ji-1,jj-1) &
+ & + (vn(ji+1,jj-1 ) - vn(ji,jj-1) ) &
+ & * fmask(ji,jj-1) / e1f(ji,jj-1) )
+
+ ! Compute Reynolds terms
+ anousqrt(ji,jj) = 1000/2 * umask(ji,jj)*( ( u2n(ji,jj) - un(ji,jj)*un(ji,jj) ) &
+ & + ( u2n(ji-1,jj) - un(ji-1,jj)*un(ji-1,jj) ) )
+
+ anovsqrt(ji,jj) = 1000/2 * vmask(ji,jj)*( ( v2n(ji,jj) - vn(ji,jj)*vn(ji,jj) ) &
+ & + ( v2n(ji,jj-1) - vn(ji,jj)*vn(ji,jj-1) ) )
+
+ anouv(ji,jj) = 1000 * ( uvn(ji,jj) &
+ & - 0.5 * umask(ji,jj)*( un(ji,jj) + un(ji-1,jj) ) &
+ & * 0.5 * vmask(ji,jj)*( vn(ji,jj) + vn(ji,jj-1) ) )
+
+ ! Compute bti
+ bti(ji,jj) = -1. * ( anousqrt(ji,jj) * dudx(ji,jj) &
+ & + anovsqrt(ji,jj) * dvdy(ji,jj) &
+ & + anouv(ji,jj) * ( dvdx(ji,jj) + dudy(ji,jj) ))
+
+ END DO
END DO
+ !
+ ierr = putvar(ncout, id_varout(jp_dudx), dudx, jk, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(jp_dvdx), dvdx, jk, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(jp_dudy), dudy, jk, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(jp_dvdy), dvdy, jk, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(jp_anousqrt), anousqrt, jk, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(jp_anovsqrt), anovsqrt, jk, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(jp_anouv), anouv, jk, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(jp_bti), bti, jk, npiglo, npjglo, ktime=jt)
END DO
- !
- ierr = putvar(ncout, id_varout(1) ,dudx, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(2) ,dvdx, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(3) ,dudy, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(4) ,dvdy, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(5) ,anousqrt, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(6) ,anovsqrt, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(7) ,anouv, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(8) ,bti, jk, npiglo, npjglo, ktime=1)
- END DO
+ END DO ! time loop
+
ierr = closeout(ncout)
END PROGRAM cdfbti
diff --git a/cdfbuoyflx.f90 b/cdfbuoyflx.f90
index cdb8627..e62bf5b 100644
--- a/cdfbuoyflx.f90
+++ b/cdfbuoyflx.f90
@@ -1,173 +1,203 @@
PROGRAM cdfbuoyflx
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfbuoyflx ***
+ !!======================================================================
+ !! *** PROGRAM cdfbuoyflx ***
+ !!=====================================================================
+ !! ** Purpose : Produce a file with the water flux separated into 4 components:
+ !! E (evap), P (precip), R (runoff), dmp (sssdmp).
+ !! The total water flux is E -P -R + dmp. Units in this program
+ !! are mm/days. (Up to that it is the same than cdfwflx)
!!
- !! ** Purpose : Produce a file with the water flux separated into 4 components:
- !! E (evap), P (precip), R (runoff), dmp (sssdmp).
- !! The total water flux is E -P -R + dmp. Units in this program
- !! are mm/days. (Up to that it is the same than cdfwflx)
+ !! It also produces un the same file the component of the heat flux
+ !! Latent Heat FLux, Sensible Heat flux, Long Wave HF, Short Wave HF,
+ !! Net HF
!!
- !! It also produces un the same file the component of the heat flux
- !! Latent Heat FLux, Sensible Heat flux, Long Wave HF, Short Wave HF, Net HF
- !!
- !! Buoyancy fluxes are also computed, as a net value but also with the
- !! contribution of each term.
- !!
- !! ** Method : Evap is computed from the latent heat flux : evap=-qla/Lv
- !! Runoff is read from the climatological input file
- !! dmp is read from the file (sowafldp)
- !! Precip is then computed as the difference between the
- !! total water flux (sowaflup) and the E-R+dmp. In the high latitudes
- !! this precip includes the effect of snow (storage/melting). Therefore
- !! it may differ slightly from the input precip file.
- !!
- !! Heat fluxes are directly copied from the gridT files, same name, same units
- !! We also add sst and SSS for convenience.
- !!
- !! Buoyancy fluxes are also computed as :
- !! BF = -1/rho (alpha x TF - beta SF )
+ !! Buoyancy fluxes are also computed, as a net value but also with the
+ !! contribution of each term.
+ !!
+ !! ** Method : Evap is computed from the latent heat flux : evap=-qla/Lv
+ !! Runoff is read from the climatological input file
+ !! dmp is read from the file (sowafldp)
+ !! Precip is then computed as the difference between the
+ !! total water flux (sowaflup) and the E-R+dmp. In the high latitudes
+ !! this precip includes the effect of snow (storage/melting). Therefore
+ !! it may differ slightly from the input precip file.
+ !!
+ !! Heat fluxes are directly copied from the gridT files, same name, same units
+ !! We also add sst and SSS for convenience.
+ !!
+ !! Buoyancy fluxes are also computed as :
+ !! BF = -1/rho (alpha x TF - beta SF )
!! (TF = thermal part, SF = haline part )
- !! TF = 1/(rho x Cp)* Q
- !! SF = 1/(1-SSS) x (E-P) x SSS
+ !! TF = 1/(rho x Cp)* Q
+ !! SF = 1/(1-SSS) x (E-P) x SSS
!!
- !! history ;
- !! Original : J.M. Molines (January 2008 )
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 01/2008 : J.M. Molines : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jj, jk ,ji !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo !: size of the domain
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask,zcoefq,zcoefw !: work array
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zalbet, zbeta !: work array
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: evap, precip, runoff, wdmp, wnet !: water flux components
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: wice, precip_runoff !: water flux components
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: qlat, qsb, qlw, qsw, qnet !: heat flux components
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: b_evap, b_precip, b_runoff, b_wdmp, bw_net !: BF water flux components
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: b_qlat, b_qsb, b_qlw, b_qsw , bh_net !: BF heat flux components
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: sst, sss, buoyancy_fl !: Total buoyancy flux
-
- ! Physical constants
- REAL(KIND=4) :: Lv=2.5e6 !: latent HF <--> evap conversion
- REAL(KIND=4) :: Cp = 4000. !: specific heat of water
- CHARACTER(LEN=256) :: cfilet , cfiler
-
- INTEGER :: istatus
- ! output stuff
- INTEGER, PARAMETER :: jpvarout=25
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(jpvarout) :: ipk, id_varout !: only one output variable
- REAL(KIND=4), DIMENSION(1) :: tim,dep !: time output
- CHARACTER(LEN=256) :: cfileout='buoyflx.nc'
-
- TYPE(variable), DIMENSION(jpvarout) :: typvar !: structure for attributes
+ INTEGER(KIND=4), PARAMETER :: jp_varout=25
+ INTEGER(KIND=4) :: ncout, ierr
+ INTEGER(KIND=4) :: jt ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo, npt ! size of the domain
+ INTEGER(KIND=4), DIMENSION(jp_varout) :: ipk, id_varout
+ ! Physical constants
+ REAL(KIND=4) :: Lv = 2.5e6 ! latent HF <--> evap conversion
+ REAL(KIND=4) :: Cp = 4000. ! specific heat of water
+
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim, zdep ! time counter, deptht
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask, zcoefq, zcoefw ! work array
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zalbet, zbeta ! work array
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: evap, precip, runoff, wdmp, wnet ! water flux components
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: wice, precip_runoff ! water flux components
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: qlat, qsb, qlw, qsw, qnet ! heat flux components
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: b_evap, b_precip, b_runoff ! BF water flux components
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: b_wdmp, bw_net ! BF water flux components
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: b_qlat, b_qsb, b_qlw ! BF heat flux components
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: b_qsw , bh_net ! BF heat flux components
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsst, zsss, buoyancy_fl ! Total buoyancy flux
+
+ CHARACTER(LEN=256) :: cf_tfil , cf_rnfil ! input file gridT and runoff
+ CHARACTER(LEN=256) :: cf_out='buoyflx.nc' ! output file
+
+ TYPE(variable), DIMENSION(jp_varout) :: stypvar ! structure for attributes
+
+ LOGICAL :: lchk
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
!! Read command line and output usage message if not compliant.
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfbuoyflx Tfile Runoff file'
- PRINT *,' produces the water fluxes components'
- PRINT *,' produces the heat fluxes components'
- PRINT *,' produces the net fluxes'
- PRINT *,' produces the buoyancy water fluxes components'
- PRINT *,' produces the buoyancy heat fluxes components'
- PRINT *,' produces the buoyancy net fluxes'
- PRINT *,' produces the sss and sst '
- PRINT *,' Output on buoyflx.nc , 25 variables (2D) '
+ PRINT *,' usage : cdfbuoyflx T-file RNF-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute (or read) the heat and water fluxes components.'
+ PRINT *,' Compute (or read) the net heat and water fluxes.'
+ PRINT *,' Compute the buoyancy heat and water fluxes components.'
+ PRINT *,' Compute the net buoyancy fluxes.'
+ PRINT *,' Save sss and sst.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with '
+ PRINT *,' RNF-file : netcdf file with runoff '
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : 25 variables (2D)'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' '
+ PRINT *,' '
STOP
ENDIF
- CALL getarg (1, cfilet)
- CALL getarg (2, cfiler)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
+ CALL getarg (1, cf_tfil)
+ CALL getarg (2, cf_rnfil)
+
+ lchk = chkfile (cf_tfil )
+ lchk = lchk .OR. chkfile (cf_rnfil)
+ IF (lchk ) STOP ! missing files
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npt = getdim (cf_tfil,cn_t)
! prepare output variables
- dep(1) = 0.
- ipk(:)= 1 ! all variables ( output are 2D)
- typvar%online_operation='N/A'
- typvar%axis='TYX'
+ ALLOCATE (zdep(1), tim(npt) )
+ zdep(1) = 0.
+ ipk(:) = 1 ! all variables ( output are 2D)
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TYX'
- !
! 1--> 7 water fluxes ; ! 8 --> 12 heat fluxes
- typvar(1)%name= 'evap' ; typvar(8)%name= 'latent'
- typvar(2)%name= 'precip' ; typvar(9)%name= 'sensible'
- typvar(3)%name= 'runoff' ; typvar(10)%name= 'longwave'
- typvar(4)%name= 'sssdmp' ; typvar(11)%name= 'solar'
- typvar(5)%name= 'watnet' ; typvar(12)%name= 'heatnet'
- typvar(6)%name= 'wice'
- typvar(7)%name= 'precip_runoff'
- typvar(1:7)%units='mm/day' ; typvar(8:12)%units='W/m2'
- typvar(1:7)%missing_value=0. ; typvar(8:12)%missing_value=0.
- typvar(1:7)%valid_min= -100. ; typvar(8:12)%valid_min= -500.
- typvar(1:7)%valid_max= 100. ; typvar(8:12)%valid_max= 500.
- typvar(1)%long_name='Evaporation' ; typvar(8)%long_name='Latent Heat flux'
- typvar(2)%long_name='Precipitation' ; typvar(9)%long_name='Sensible Heat flux'
- typvar(3)%long_name='Runoff' ; typvar(10)%long_name='Long Wave Heat flux'
- typvar(4)%long_name='SSS damping' ; typvar(11)%long_name='Short Wave Heat flux'
- typvar(5)%long_name='Total water flux' ; typvar(12)%long_name='Net Heat Flux'
- typvar(6)%long_name='Ice congelation and melting'
- typvar(7)%long_name='Precip and runoff together'
- typvar(1)%short_name='evap' ; typvar(8)%short_name='latent'
- typvar(2)%short_name='precip' ; typvar(9)%short_name='sensible'
- typvar(3)%short_name='runoff' ; typvar(10)%short_name='longwave'
- typvar(4)%short_name='sssdmp' ; typvar(11)%short_name='solar'
- typvar(5)%short_name='watnet' ; typvar(12)%short_name='heatnet'
- typvar(6)%short_name='wice'
- typvar(7)%short_name='precip_runoff'
+ stypvar(1)%cname= 'evap' ; stypvar(8)%cname= 'latent'
+ stypvar(2)%cname= 'precip' ; stypvar(9)%cname= 'sensible'
+ stypvar(3)%cname= 'runoff' ; stypvar(10)%cname= 'longwave'
+ stypvar(4)%cname= 'sssdmp' ; stypvar(11)%cname= 'solar'
+ stypvar(5)%cname= 'watnet' ; stypvar(12)%cname= 'heatnet'
+ stypvar(6)%cname= 'wice'
+ stypvar(7)%cname= 'precip_runoff'
+
+ stypvar(1:7)%cunits='mm/day' ; stypvar(8:12)%cunits='W/m2'
+ stypvar(1:7)%rmissing_value=0. ; stypvar(8:12)%rmissing_value=0.
+ stypvar(1:7)%valid_min= -100. ; stypvar(8:12)%valid_min= -500.
+ stypvar(1:7)%valid_max= 100. ; stypvar(8:12)%valid_max= 500.
+ stypvar(1)%clong_name='Evaporation' ; stypvar(8)%clong_name='Latent Heat flux'
+ stypvar(2)%clong_name='Precipitation' ; stypvar(9)%clong_name='Sensible Heat flux'
+ stypvar(3)%clong_name='Runoff' ; stypvar(10)%clong_name='Long Wave Heat flux'
+ stypvar(4)%clong_name='SSS damping' ; stypvar(11)%clong_name='Short Wave Heat flux'
+ stypvar(5)%clong_name='Total water flux' ; stypvar(12)%clong_name='Net Heat Flux'
+ stypvar(6)%clong_name='Ice congelation and melting'
+ stypvar(7)%clong_name='Precip and runoff together'
+
+ stypvar(1)%cshort_name='evap' ; stypvar(8)%cshort_name='latent'
+ stypvar(2)%cshort_name='precip' ; stypvar(9)%cshort_name='sensible'
+ stypvar(3)%cshort_name='runoff' ; stypvar(10)%cshort_name='longwave'
+ stypvar(4)%cshort_name='sssdmp' ; stypvar(11)%cshort_name='solar'
+ stypvar(5)%cshort_name='watnet' ; stypvar(12)%cshort_name='heatnet'
+ stypvar(6)%cshort_name='wice'
+ stypvar(7)%cshort_name='precip_runoff'
! 13--> 17 buoy water fluxes ; ! 18 --> 22 buoy heat fluxes
- typvar(13)%name= 'evap_b' ; typvar(18)%name= 'latent_b'
- typvar(14)%name= 'precip_b' ; typvar(19)%name= 'sensible_b'
- typvar(15)%name= 'runoff_b' ; typvar(20)%name= 'longwave_b'
- typvar(16)%name= 'sssdmp_b' ; typvar(21)%name= 'solar_b'
- typvar(17)%name= 'watnet_b' ; typvar(22)%name= 'heatnet_b'
- typvar(13:17)%units='1e-6 kg/m2/s' ; typvar(18:22)%units='1e-6 kg/m2/s'
- typvar(13:17)%missing_value=0. ; typvar(18:22)%missing_value=0.
- typvar(13:17)%valid_min= -100. ; typvar(18:22)%valid_min= -500.
- typvar(13:17)%valid_max= 100. ; typvar(18:22)%valid_max= 500.
- typvar(13)%long_name='buoy flx evap' ; typvar(18)%long_name='buoy Latent Heat flux'
- typvar(14)%long_name='buoy flx precip' ; typvar(19)%long_name='buoy Sensible Heat flux'
- typvar(15)%long_name='buoy flx runoff' ; typvar(20)%long_name='buoy Long Wave Heat flux'
- typvar(16)%long_name='buoy flx damping' ; typvar(21)%long_name='buoy Short Wave Heat flux'
- typvar(17)%long_name='buoy haline flx' ; typvar(22)%long_name='buoy thermo Flux'
- typvar(13)%short_name='evap_b' ; typvar(18)%short_name='latent_b'
- typvar(14)%short_name='precip_b' ; typvar(19)%short_name='sensible_b'
- typvar(15)%short_name='runoff_b' ; typvar(20)%short_name='longwave_b'
- typvar(16)%short_name='sssdmp_b' ; typvar(21)%short_name='solar_b'
- typvar(17)%short_name='watnet_b' ; typvar(22)%short_name='heatnet_b'
+ stypvar(13)%cname= 'evap_b' ; stypvar(18)%cname= 'latent_b'
+ stypvar(14)%cname= 'precip_b' ; stypvar(19)%cname= 'sensible_b'
+ stypvar(15)%cname= 'runoff_b' ; stypvar(20)%cname= 'longwave_b'
+ stypvar(16)%cname= 'sssdmp_b' ; stypvar(21)%cname= 'solar_b'
+ stypvar(17)%cname= 'watnet_b' ; stypvar(22)%cname= 'heatnet_b'
+
+ stypvar(13:17)%cunits='1e-6 kg/m2/s' ; stypvar(18:22)%cunits='1e-6 kg/m2/s'
+ stypvar(13:17)%rmissing_value=0. ; stypvar(18:22)%rmissing_value=0.
+ stypvar(13:17)%valid_min= -100. ; stypvar(18:22)%valid_min= -500.
+ stypvar(13:17)%valid_max= 100. ; stypvar(18:22)%valid_max= 500.
+
+ stypvar(13)%clong_name='buoy flx evap' ; stypvar(18)%clong_name='buoy Latent Heat flux'
+ stypvar(14)%clong_name='buoy flx precip' ; stypvar(19)%clong_name='buoy Sensible Heat flux'
+ stypvar(15)%clong_name='buoy flx runoff' ; stypvar(20)%clong_name='buoy Long Wave Heat flux'
+ stypvar(16)%clong_name='buoy flx damping' ; stypvar(21)%clong_name='buoy Short Wave Heat flux'
+ stypvar(17)%clong_name='buoy haline flx' ; stypvar(22)%clong_name='buoy thermo Flux'
+
+ stypvar(13)%cshort_name='evap_b' ; stypvar(18)%cshort_name='latent_b'
+ stypvar(14)%cshort_name='precip_b' ; stypvar(19)%cshort_name='sensible_b'
+ stypvar(15)%cshort_name='runoff_b' ; stypvar(20)%cshort_name='longwave_b'
+ stypvar(16)%cshort_name='sssdmp_b' ; stypvar(21)%cshort_name='solar_b'
+ stypvar(17)%cshort_name='watnet_b' ; stypvar(22)%cshort_name='heatnet_b'
! total buoyancy flux
- typvar(23)%name= 'buoyancy_fl'
- typvar(23)%units='1e-6 kg/m2/s'
- typvar(23)%missing_value=0.
- typvar(23)%valid_min= -100.
- typvar(23)%valid_max= 100.
- typvar(23)%long_name='buoyancy flux'
- typvar(23)%short_name='buoyancy_fl'
-
- ! SSS ; SST
- typvar(24)%name= 'sss' ; typvar(25)%name= 'sst'
- typvar(24)%units='PSU' ; typvar(25)%units='Celsius'
- typvar(24)%missing_value=0. ; typvar(25)%missing_value=0.
- typvar(24)%valid_min= 0. ; typvar(25)%valid_min= -2.
- typvar(24)%valid_max= 45 ; typvar(25)%valid_max= 45
- typvar(24)%long_name='Sea Surface Salinity' ; typvar(25)%long_name='Sea Surface Temperature'
- typvar(24)%short_name='sss ' ; typvar(25)%short_name='sst'
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
+ stypvar(23)%cname= 'buoyancy_fl'
+ stypvar(23)%cunits='1e-6 kg/m2/s'
+ stypvar(23)%rmissing_value=0.
+ stypvar(23)%valid_min= -100.
+ stypvar(23)%valid_max= 100.
+ stypvar(23)%clong_name='buoyancy flux'
+ stypvar(23)%cshort_name='buoyancy_fl'
+
+ ! SSS ; SST
+ stypvar(24)%cname= 'sss' ; stypvar(25)%cname= 'sst'
+ stypvar(24)%cunits='PSU' ; stypvar(25)%cunits='Celsius'
+ stypvar(24)%rmissing_value=0. ; stypvar(25)%rmissing_value=0.
+ stypvar(24)%valid_min= 0. ; stypvar(25)%valid_min= -2.
+ stypvar(24)%valid_max= 45 ; stypvar(25)%valid_max= 45
+ stypvar(24)%clong_name='Sea Surface Salinity' ; stypvar(25)%clong_name='Sea Surface Temperature'
+ stypvar(24)%cshort_name='sss ' ; stypvar(25)%cshort_name='sst'
+
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npt =', npt
ALLOCATE ( zmask(npiglo,npjglo), wnet(npiglo,npjglo), zalbet(npiglo,npjglo), zbeta(npiglo, npjglo) )
@@ -177,109 +207,109 @@ PROGRAM cdfbuoyflx
ALLOCATE ( qlat(npiglo,npjglo), qsb(npiglo,npjglo), qlw(npiglo,npjglo), qsw(npiglo,npjglo), qnet(npiglo,npjglo) )
ALLOCATE ( b_evap(npiglo,npjglo), b_precip(npiglo,npjglo), b_runoff(npiglo,npjglo), b_wdmp(npiglo,npjglo),bw_net(npiglo,npjglo) )
ALLOCATE ( b_qlat(npiglo,npjglo), b_qsb(npiglo,npjglo), b_qlw(npiglo,npjglo), b_qsw(npiglo,npjglo), bh_net(npiglo,npjglo))
- ALLOCATE ( buoyancy_fl(npiglo,npjglo), sst(npiglo,npjglo), sss(npiglo,npjglo) )
-
- ! read sss for masking purpose and sst
- sss(:,:) = getvar(cfilet, 'vosaline', 1 ,npiglo,npjglo)
- zmask=1. ; WHERE ( sss == 0 ) zmask=0.
- sst(:,:) = getvar(cfilet, 'votemper', 1 ,npiglo,npjglo)
-
- ! Evap :
- qlat(:,:)= getvar(cfilet, 'solhflup', 1 ,npiglo,npjglo)*zmask(:,:) ! W/m2
- evap(:,:)= -1.* qlat(:,:) /Lv*86400. *zmask(:,:) ! mm/days
- print *,'Evap done'
- ! Wdmp
- wdmp(:,:)= getvar(cfilet, 'sowafldp', 1 ,npiglo,npjglo)*86400.*zmask(:,:) ! mm/days
- print *,'Damping done'
- ! Runoff
- runoff(:,:)= getvar(cfiler, 'sorunoff', 1 ,npiglo,npjglo)*86400.*zmask(:,:) ! mm/days
- print *,'Runoff done'
- ! total water flux (emps)
- wnet(:,:) = getvar(cfilet, 'sowaflcd', 1 ,npiglo,npjglo)*86400.*zmask(:,:) ! mm/days
- print *,'Total water flux done'
- ! fsalt = contribution of ice freezing and melting to salinity ( + = freezing, - = melting )Q
- wice(:,:) = getvar(cfilet, 'iowaflup', 1 ,npiglo,npjglo)*86400.*zmask(:,:) ! mm/days
- print *,'ice contribution done'
- ! Precip:
+ ALLOCATE ( buoyancy_fl(npiglo,npjglo), zsst(npiglo,npjglo), zsss(npiglo,npjglo) )
+
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1 )
+ ierr = createvar (ncout, stypvar, jp_varout, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=zdep)
+
+ DO jt = 1, npt
+ ! read sss for masking purpose and sst
+ zsss(:,:) = getvar(cf_tfil, cn_vosaline, 1, npiglo, npjglo, ktime=jt)
+ zmask=1. ; WHERE ( zsss == 0 ) zmask=0.
+ zsst(:,:) = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=jt)
+
+ ! Evap :
+ qlat(:,:)= getvar(cf_tfil, cn_solhflup, 1, npiglo, npjglo, ktime=jt) *zmask(:,:) ! W/m2
+ evap(:,:)= -1.* qlat(:,:) /Lv*86400. *zmask(:,:) ! mm/days
+
+ ! Wdmp
+ wdmp(:,:)= getvar(cf_tfil, cn_sowafldp, 1, npiglo, npjglo, ktime=jt)*86400.*zmask(:,:) ! mm/days
+
+ ! Runoff ! take care : not a model output (time_counter may disagree ... jmm
+ runoff(:,:)= getvar(cf_rnfil, 'sorunoff', 1, npiglo, npjglo)*86400.*zmask(:,:) ! mm/days
+
+ ! total water flux (emps)
+ wnet(:,:) = getvar(cf_tfil, cn_sowaflcd, 1, npiglo, npjglo, ktime=jt )*86400.*zmask(:,:) ! mm/days
+
+ ! fsalt = contribution of ice freezing and melting to salinity ( + = freezing, - = melting )Q
+ wice(:,:) = getvar(cf_tfil, cn_iowaflup, 1, npiglo, npjglo, ktime=jt )*86400.*zmask(:,:) ! mm/days
+
+ ! Precip:
precip(:,:)= evap(:,:)-runoff(:,:)+wdmp(:,:)-wnet(:,:)+wice(:,:) ! mm/day
- print *,'Precip done'
- ! Precip+runoff : (as a whole ) (interpolated on line)
+
+ ! Precip+runoff : (as a whole ) (interpolated on line)
precip_runoff(:,:)= evap(:,:)+wdmp(:,:)-wnet(:,:)+wice(:,:) ! mm/day
- print *,'Precip done'
- ! other heat fluxes
- qsb(:,:)= getvar(cfilet, 'sosbhfup', 1 ,npiglo,npjglo)*zmask(:,:) ! W/m2
- print *,'qsb done'
- qlw(:,:)= getvar(cfilet, 'solwfldo', 1 ,npiglo,npjglo)*zmask(:,:) ! W/m2
- print *,'qlw done'
- qsw(:,:)= getvar(cfilet, 'soshfldo', 1 ,npiglo,npjglo)*zmask(:,:) ! W/m2
- print *,'qsw done'
- qnet(:,:)= getvar(cfilet,'sohefldo', 1 ,npiglo,npjglo)*zmask(:,:) ! W/m2
- print *,'qnet done'
-
- ! buoyancy flux
- zalbet(:,:)= albet ( sst, sss, 0., npiglo,npjglo)
- zbeta (:,:)= beta ( sst, sss, 0., npiglo,npjglo)
- zcoefq(:,:)= -zbeta * zalbet /Cp * 1.e6
- zcoefw(:,:)= zbeta*sss/(1-sss/1000.)/86400. *1.e6 ! division by 86400 to get back water fluxes in kg/m2/s
- buoyancy_fl=0. ; bh_net=0. ; b_qlat=0. ; b_qlw=0. ; b_qsw=0. ; b_qsb=0.
- bw_net=0. ; b_evap=0. ; b_precip=0.; b_wdmp=0. ; b_runoff=0.
- WHERE (sss /= 0 )
- bh_net(:,:)= zcoefq * qnet
- b_qlat(:,:)= zcoefq * qlat
- b_qlw (:,:)= zcoefq * qlw
- b_qsw (:,:)= zcoefq * qsw
- b_qsb (:,:)= zcoefq * qsb
-
- bw_net(:,:)= zcoefw * wnet
- b_evap(:,:)= zcoefw * evap
- b_precip(:,:)= -zcoefw * precip
- b_runoff(:,:)= -zcoefw * runoff
- b_wdmp(:,:)= zcoefw * wdmp
-
-! buoyancy_fl(:,:) = zcoefq * qnet +zcoefw * wnet
- buoyancy_fl(:,:) = bh_net + bw_net
- END WHERE
-
- ! Write output file
- !
- ncout = create(cfileout, cfilet, npiglo,npjglo,1)
- ierr = createvar(ncout ,typvar ,jpvarout, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,1,pdep=dep)
- tim=getvar1d(cfilet,'time_counter',1)
-
- ierr = putvar(ncout, id_varout(1) ,evap, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(2) ,precip, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(3) ,runoff, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(4) ,wdmp, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(5) ,wnet, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(6) ,wice, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(7) ,precip_runoff, 1,npiglo, npjglo)
-
- ierr = putvar(ncout, id_varout(8) ,qlat, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(9) ,qsb, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(10) ,qlw, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(11) ,qsw, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(12) ,qnet, 1,npiglo, npjglo)
-
- ierr = putvar(ncout, id_varout(13) ,b_evap, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(14) ,b_precip, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(15) ,b_runoff, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(16) ,b_wdmp, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(17) ,bw_net, 1,npiglo, npjglo)
-
- ierr = putvar(ncout, id_varout(18) ,b_qlat, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(19) ,b_qsb, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(20) ,b_qlw, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(21) ,b_qsw, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(22) ,bh_net, 1,npiglo, npjglo)
-
- ierr = putvar(ncout, id_varout(23) ,buoyancy_fl, 1,npiglo, npjglo)
-
- ierr = putvar(ncout, id_varout(24) ,sss, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(25) ,sst, 1,npiglo, npjglo)
-
- ierr=putvar1d(ncout,tim,1,'T')
-
- ierr=closeout(ncout)
-
- END PROGRAM cdfbuoyflx
+
+ ! other heat fluxes
+ qsb(:,:)= getvar(cf_tfil, cn_sosbhfup, 1, npiglo, npjglo, ktime = jt )*zmask(:,:) ! W/m2
+ qlw(:,:)= getvar(cf_tfil, cn_solwfldo, 1, npiglo, npjglo, ktime = jt )*zmask(:,:) ! W/m2
+ qsw(:,:)= getvar(cf_tfil, cn_soshfldo, 1, npiglo, npjglo, ktime = jt )*zmask(:,:) ! W/m2
+ qnet(:,:)=getvar(cf_tfil, cn_sohefldo, 1, npiglo, npjglo, ktime = jt )*zmask(:,:) ! W/m2
+
+ ! buoyancy flux
+ zalbet(:,:)= albet ( zsst, zsss, 0., npiglo, npjglo)
+ zbeta (:,:)= beta ( zsst, zsss, 0., npiglo, npjglo)
+ zcoefq(:,:)= -zbeta * zalbet /Cp * 1.e6
+ zcoefw(:,:)= zbeta * zsss/(1-zsss/1000.)/86400. *1.e6 ! division by 86400 to get back water fluxes in kg/m2/s
+
+ buoyancy_fl=0. ; bh_net=0. ; b_qlat=0. ; b_qlw=0. ; b_qsw=0. ; b_qsb=0.
+ bw_net=0. ; b_evap=0. ; b_precip=0.; b_wdmp=0. ; b_runoff=0.
+
+ WHERE (zsss /= 0 )
+ bh_net(:,:)= zcoefq * qnet
+ b_qlat(:,:)= zcoefq * qlat
+ b_qlw (:,:)= zcoefq * qlw
+ b_qsw (:,:)= zcoefq * qsw
+ b_qsb (:,:)= zcoefq * qsb
+
+ bw_net(:,:)= zcoefw * wnet
+ b_evap(:,:)= zcoefw * evap
+ b_precip(:,:)= -zcoefw * precip
+ b_runoff(:,:)= -zcoefw * runoff
+ b_wdmp(:,:)= zcoefw * wdmp
+
+ ! buoyancy_fl(:,:) = zcoefq * qnet +zcoefw * wnet
+ buoyancy_fl(:,:) = bh_net + bw_net
+ END WHERE
+
+ ! Write output file
+
+ ierr = putvar(ncout, id_varout(1), evap, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(2), precip, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(3), runoff, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(4), wdmp, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(5), wnet, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(6), wice, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(7), precip_runoff, 1,npiglo, npjglo, ktime=jt )
+
+ ierr = putvar(ncout, id_varout(8), qlat, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(9), qsb, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(10),qlw, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(11),qsw, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(12),qnet, 1, npiglo, npjglo, ktime=jt )
+
+ ierr = putvar(ncout, id_varout(13),b_evap, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(14),b_precip,1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(15),b_runoff,1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(16),b_wdmp, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(17),bw_net, 1, npiglo, npjglo, ktime=jt )
+
+ ierr = putvar(ncout, id_varout(18),b_qlat, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(19),b_qsb, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(20),b_qlw, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(21),b_qsw, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(22),bh_net, 1, npiglo, npjglo, ktime=jt )
+
+ ierr = putvar(ncout, id_varout(23),buoyancy_fl, 1,npiglo, npjglo, ktime=jt )
+
+ ierr = putvar(ncout, id_varout(24), zsss, 1, npiglo, npjglo, ktime=jt )
+ ierr = putvar(ncout, id_varout(25), zsst, 1, npiglo, npjglo, ktime=jt )
+ END DO ! time loop
+
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ ierr=closeout(ncout)
+
+END PROGRAM cdfbuoyflx
diff --git a/cdfcensus.f90 b/cdfcensus.f90
index 77d7198..e8a2d1a 100644
--- a/cdfcensus.f90
+++ b/cdfcensus.f90
@@ -1,328 +1,365 @@
PROGRAM cdfcensus
- !!-----------------------------------------------------------------------------
- !! *** PROGRAM cdfcensus ***
+ !!======================================================================
+ !! *** PROGRAM cdfcensus ***
+ !!=====================================================================
+ !! ** Purpose : Build an array giving the volume of water in a TS cell.
!!
- !! ** Purpose: Build an array giving the volume of water in a TS cell.
- !!
- !! ** Method:
- !! T-file and S-file are scanned for a given region (eventually limited
- !! in depth) and the volume of water in a (T,S) cell such that
- !! T < Tmodele < T+dt
- !! and S < Smodele < S+ds.
- !! If Smodel or T model are out of the bound they are cumulated in the
- !! nearest (T,S) cell.
- !! The output is done on a bimg file where S is given as
- !! the x-direction and T the y-direction, the field value being the volume
- !! of water. Due to a very large range in the water volume over the TS field
- !! the field is indeed the LOG (1 + VOLUME), and even, the scale can be made
- !! more non-linear by repeating the LOG operation, ie, for example,
- !! field=LOG(1 + LOG (1 + VOLUME)). The parameter nlog, passed as command
- !! argument can be used to fix the number of LOG. If nlog = 0, the true
- !! volume is saved.
- !! Depending on the user purpose, limiting values tmin,tmax, and smin,smax
- !! as well as the increments dt, ds can be adjusted.
-
- !! The ouput file is census.bimg and is always a bimg file. ---> to be changed
+ !! ** Method : T-file and S-file are scanned for a given region
+ !! (eventually limited in depth) and the volume of water in
+ !! a (T,S) cell such that T < Tmodele < T+dt and
+ !! S < Smodele < S+ds.
+ !! If Smodel or T model are out of the bound they are
+ !! cumulated in the nearest (T,S) cell.
+ !! The output is done on a bimg file where S is given as
+ !! the x-direction and T the y-direction, the field value
+ !! being the volume of water. Due to a very large range in
+ !! the water volume over the TS field the field is indeed
+ !! the LOG (1 + VOLUME), and even, the scale can be made
+ !! more non-linear by repeating the LOG operation, ie, for
+ !! example, field=LOG(1 + LOG (1 + VOLUME)). The parameter
+ !! nlog, passed as command argument can be used to fix the
+ !! number of LOG. If nlog = 0, the true volume is saved.
+ !! Depending on the user purpose, limiting values tmin,
+ !! tmax, and smin,smax as well as the increments dt, ds can
+ !! be adjusted.
+ !! output is STILL a dimg file
!!
- !! history :
- !! Jean-Marc MOLINES, 01/02/97 in the dynamo project for SPEM
- !! Modifie a partir de water_mass_census_z par Anne de Miranda (27/09/99)
- !! Rewritten in Dr. Form by Jean-Marc Molines, 11/01/02
- !! Clothilde Langlais 01/06 CDF version and PS
- !! J.M. Molines 03/06 : integration in CDFTOOLS-2.0
- !! J.M. Molines 12/06 : output in netcdf, add sigma2 and sigma4 in output
- !! bimg output as option.
- !!-----------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- ! * Module used
+ !! History : -- : 02/1997 : J.M. Molines as bimgtools in DYNAMO
+ !! -- : 09/1999 : A. de Miranda for OPA
+ !! : 01/2002 : J.M. Molines : DOctor norm
+ !! : 01/2006 : C. Langlais : CDF I and partial cell
+ !! 2.0 : 03/2006 : J.M. Molines : integration in CDFTOOLS
+ !! 2.1 : 12/2006 : J.M. Molines : add sigma-2 and sigma-4 O
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- ! * Local Variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ilog, nlog, idum
- INTEGER :: narg, iargc
- INTEGER :: it, is
- INTEGER :: ji, jj,jk
- INTEGER :: i1, i2, j1, j2, k1, k2
- INTEGER :: iarg, nt, ns
-
- REAL(kind=4),DIMENSION(:,:), ALLOCATABLE :: t, s, rsigma0, rsigma2, rsigma4
- REAL(kind=8),DIMENSION(:,:), ALLOCATABLE :: e1t, e2t
- REAL(kind=8),DIMENSION(:), ALLOCATABLE :: e3t
- REAL(kind=8),DIMENSION(:,:), ALLOCATABLE :: e3t_ps
- REAL(kind=4),DIMENSION(:,:), ALLOCATABLE :: rcensus, dump, sx, ty
- REAL(kind=4),DIMENSION(:), ALLOCATABLE :: depdum, tim
-
- REAL(kind=4) :: tmin, tmax, dt, tm, xt,xs
- REAL(kind=4) :: smin, smax, ds, sm
- REAL(kind=4) :: tpoint, spoint, volpoint, rcmax, rcmax1
-
- REAL(kind=8) :: voltotal
-
- CHARACTER(LEN=256) :: cline1, cline2, cline3, cline4
- CHARACTER(LEN=256) :: cfilTS, cfildum, config
- CHARACTER(LEN=256) :: chgr='mesh_hgr.nc' , czgr='mesh_zgr.nc',cfileout='census.nc'
-
- INTEGER :: ncout, ierr
- TYPE(variable), DIMENSION(4) :: typvar
- INTEGER, DIMENSION(4) :: ipk, id_varout
-
- LOGICAL :: lcdf=.true. , lbimg=.false.
+ INTEGER(KIND=4) :: ji, jj, jk, jt, jlog
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nlog
+ INTEGER(KIND=4) :: narg, iargc, ijarg
+ INTEGER(KIND=4) :: it, is
+ INTEGER(KIND=4) :: ii1, ii2
+ INTEGER(KIND=4) :: ij1, ij2
+ INTEGER(KIND=4) :: ik1, ik2
+ INTEGER(KIND=4) :: nt, ns
+ INTEGER(KIND=4) :: ncout, ierr
+ INTEGER(KIND=4), DIMENSION(2) :: ijloc
+ INTEGER(KIND=4), DIMENSION(4) :: ipk, id_varout
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zt, zs, rsigma0, rsigma2, rsigma4
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3t
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsx, zty
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: rdumdep, tim
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d
+ REAL(KIND=4) :: ztmin, ztmax, zdt, ztm
+ REAL(KIND=4) :: zsmin, zsmax, zds, zsm
+ REAL(KIND=4) :: ztpoint, zspoint, rcmax
+
+ REAL(KIND=8) :: dvoltotal, dvolpoint
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcensus, ddump
+
+ CHARACTER(LEN=256) :: cf_tfil
+ CHARACTER(LEN=256) :: cf_bimg='censusopa.bimg'
+ CHARACTER(LEN=256) :: cf_out='census.nc'
+ CHARACTER(LEN=256) :: cglobal
+ CHARACTER(LEN=256) :: cline1, cline2, cline3, cline4
+ CHARACTER(LEN=256) :: cldum
+
+ TYPE(variable), DIMENSION(4) :: stypvar
+
+ LOGICAL :: lcdf=.TRUE. , lbimg=.FALSE.
+ LOGICAL :: lchk
+ LOGICAL :: lfull = .FALSE. ! flag for full step
! Initialisations
- DATA tmin, tmax, dt /-2.0, 38.0, 0.05/
- DATA smin, smax, ds /25.0, 40.0, 0.02/
-
+ DATA ztmin, ztmax, zdt /-2.0, 38.0, 0.05/
+ DATA zsmin, zsmax, zds /25.0, 40.0, 0.02/
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ dvoltotal=0.d0
+
+ narg = iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfcensus T-file nlog [-zoom imin imax jmin jmax] ...'
+ PRINT *,' ... [-klim kmin kmax] [-full] [-bimg] ... '
+ PRINT *,' ... [-srange smin smax ds ] ...'
+ PRINT *,' ... [-trange tmin tmax dt ] '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the volumetric water mass census: the ocean is divided in'
+ PRINT *,' T,S bins; the program gives the volume of water for each bin.'
+ PRINT *,' A sub-area can be specified, both horizontaly and vertically.'
+ PRINT *,' Temperature and salinity ranges can be also adapted, as well as the'
+ PRINT *,' width of the bins. Default values are provided. In order to attenuate'
+ PRINT *,' the huge maximum values, a log10 operator can be applied many times,'
+ PRINT *,' the number of filter passes being set on the command line.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file name for temperature and salinity'
+ PRINT *,' nlog : number of log10 filter to perform. Can be 0.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-zoom imin imax jmin jmax] : define a model sub-area, in model '
+ PRINT *,' coordinates'
+ PRINT *,' [-klim ik1 ik2 ] : set limits on the vertical.'
+ PRINT *,' [-srange smin smax ds ] : define the size of the salinity bin'
+ PRINT '(a,2f5.1,x,f6.3)',' defaut is :', zsmin, zsmax, zds
+ PRINT *,' [-trange tmin tmax dt ] : define the size of the temperatude bin'
+ PRINT '(a,2f5.1,x,f6.3)',' defaut is :', ztmin, ztmax, zdt
+ PRINT *,' [-full ] : use for full step computation'
+ PRINT *,' [-bimg ] : output on bimg files (to be deprecated).'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' - netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : volcensus (10^15 m3 )'
+ PRINT *,' sigma0 (kg/m3 -1000 )'
+ PRINT *,' sigma2 (kg/m3 -1000 )'
+ PRINT *,' sigma3 (kg/m3 -1000 )'
+ PRINT *,' - bimg file : According to options.'
+ STOP
+ ENDIF
- voltotal=0.d0
+ ijarg = 1
+ CALL getarg(ijarg, cf_tfil) ; ijarg = ijarg + 1
+ CALL getarg(ijarg, cldum ) ; ijarg = ijarg + 1 ; READ(cldum,*) nlog
+ cglobal = 'Census computed from '//TRIM(cf_tfil)
- ! Browse command line
- narg=iargc()
-! IF ( (narg .NE. 2) .AND. (narg .NE. 7) .AND. (narg .NE. 10) ) THEN
- IF ( narg == 0 ) THEN
- PRINT *,'>>>> usage: cdfcensus ''TSfile'''
- PRINT *,' ''nlog'' [-zoom imin imax jmin jmax] [-klim kmin kmax] [-bimg]'
- PRINT *,' Output file is census.nc, variable volcensus,sigma0,sigma2,sigma4'
- PRINT *,' If -bimg is specified, censusopa.bimg is created instead of cdf file'
- PRINT *,' mesh_hgr and mesh_zgr.nc must exist here ./ '
- STOP
- END IF
+ lchk = chkfile ( cn_fzgr )
+ lchk = lchk .OR. chkfile ( cn_fhgr )
+ lchk = lchk .OR. chkfile ( cf_tfil )
+ IF ( lchk ) STOP ! some compulsory files are missing
- CALL getarg(1,cfilTS)
- CALL getarg(2,cline1)
- READ(cline1,*) nlog
- PRINT *,' TS_FILE = ',TRIM(cfilTS)
- PRINT *,' NLOG = ', nlog
+ PRINT *,' TS_FILE = ',TRIM(cf_tfil)
+ PRINT *,' NLOG = ', nlog
! set domain size from TS file
- npiglo= getdim (cfilTS,'x')
- npjglo= getdim (cfilTS,'y')
- npk = getdim (cfilTS,'deptht')
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
+
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npk =', npk
+ PRINT *, 'npt =', npt
! Allocate memory
- ALLOCATE (t(npiglo,npjglo),s(npiglo,npjglo))
- ALLOCATE (e1t(npiglo,npjglo),e2t(npiglo,npjglo),e3t(npk),e3t_ps(npiglo,npjglo))
+ ALLOCATE (zt(npiglo,npjglo),zs(npiglo,npjglo))
+ ALLOCATE (e1t(npiglo,npjglo),e2t(npiglo,npjglo),e31d(npk),e3t(npiglo,npjglo))
! Read metrics
- e1t(:,:) = getvar(chgr,'e1t',1,npiglo,npjglo)
- e2t(:,:) = getvar(chgr,'e2t',1,npiglo,npjglo)
- e3t(:) = getvare3(czgr,'e3t',npk) ! Not necessary for PS
+ e1t(:,:) = getvar (cn_fhgr, cn_ve1t, 1, npiglo, npjglo)
+ e2t(:,:) = getvar (cn_fhgr, cn_ve2t, 1, npiglo, npjglo)
+ e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk ) ! used in full step case
! default is full domain, full depth
- i1 = 1
- i2 = npiglo
- j1 = 1
- j2 = npjglo
- k1 = 1
- k2 = npk
+ ii1 = 1 ; ii2 = npiglo
+ ij1 = 1 ; ij2 = npjglo
+ ik1 = 1 ; ik2 = npk
! Read additional optional argument (zoom)
- IF (narg.GE.3) THEN
- iarg = 3
- DO WHILE ( iarg .LE. narg )
- CALL getarg(iarg,cline1)
- iarg = iarg+1
- IF (cline1 .EQ. '-zoom') THEN
- CALL getarg(iarg,cline1)
- READ(cline1,*) i1
- iarg = iarg+1
- CALL getarg(iarg,cline1)
- READ(cline1,*) i2
- iarg = iarg+1
- CALL getarg(iarg,cline1)
- READ(cline1,*) j1
- iarg = iarg+1
- CALL getarg(iarg,cline1)
- READ(cline1,*) j2
- iarg = iarg+1
- ELSE IF (cline1 .EQ. '-klim' ) THEN
- CALL getarg(iarg,cline1)
- READ(cline1,*) k1
- iarg = iarg+1
- CALL getarg(iarg,cline1)
- READ(cline1,*) k2
- iarg = iarg+1
- ELSE IF (cline1 .EQ. '-bimg' ) THEN
- lbimg=.true.
- lcdf=.false.
- ELSE
- PRINT *,' Unknown option :',TRIM(cline1)
- STOP
- END IF
- END DO
- ENDIF
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum)
+ CASE ( '-zoom' )
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) ii1 ; ijarg = ijarg+1
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) ii2 ; ijarg = ijarg+1
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) ij1 ; ijarg = ijarg+1
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) ij2 ; ijarg = ijarg+1
+ CASE ( '-klim' )
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) ik1 ; ijarg = ijarg+1
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) ik2 ; ijarg = ijarg+1
+ CASE ( '-bimg' )
+ lbimg = .TRUE.
+ lcdf = .FALSE.
+ CASE ( '-srange' )
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) zsmin ; ijarg = ijarg+1
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) zsmax ; ijarg = ijarg+1
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) zds ; ijarg = ijarg+1
+ CASE ( '-trange' )
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) ztmin ; ijarg = ijarg+1
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) ztmax ; ijarg = ijarg+1
+ CALL getarg(ijarg,cldum) ; READ(cldum,*) zdt ; ijarg = ijarg+1
+ CASE ( '-full' )
+ lfull = .TRUE.
+ CASE DEFAULT
+ PRINT *,' Unknown option :',TRIM(cldum)
+ STOP
+ END SELECT
+ END DO
! Extra checking for over bound
- IF (i1.LT.0) i1=1
- IF (i2.GT.npiglo) i2=npiglo
- IF (j1.LT.0) j1=1
- IF (j2.GT.npjglo) j2=npjglo
- PRINT '(a,6i5)','indices:',i1,i2,j1,j2,k1,k2
+ ii1 = MAX(ii1,1) ; ii2 = MIN(ii2,npiglo)
+ ij1 = MAX(ij1,1) ; ij2 = MIN(ij2,npjglo)
+ ik1 = MAX(ik1,1) ; ik2 = MIN(ik2,npk )
+
+ PRINT '(a,6i5)','indices:',ii1, ii2, ij1, ij2, ik1, ik2
! Compute the census on the requested domain
PRINT *,' Water mass census on the file '
- PRINT *, TRIM(cfilTS)
+ PRINT *, TRIM(cf_tfil)
PRINT *, ' running .........'
- xt = (tmax - tmin )/dt + 1
- xs = (smax - smin )/ds + 1
- nt = NINT(xt)
- ns = NINT(xs)
+ nt = NINT( (ztmax - ztmin )/zdt + 1 )
+ ns = NINT( (zsmax - zsmin )/zds + 1 )
! Allocate arrays
- ALLOCATE ( rcensus (ns,nt), dump(ns,nt) )
+ ALLOCATE ( dcensus (ns,nt), ddump(ns,nt) )
ALLOCATE ( rsigma0(ns,nt), rsigma2(ns,nt), rsigma4(ns,nt) )
- ALLOCATE ( sx (ns,nt), ty(ns,nt), depdum(1) ,tim(1))
- rcensus(:,:)=0.
+ ALLOCATE ( zsx (ns,nt), zty(ns,nt), rdumdep(1), tim(npt))
+ dcensus(:,:)=0.d0
! fill up rsigma0 array with theoretical density
DO ji=1,ns
DO jj=1,nt
- spoint=smin+(ji-1)*ds
- tpoint=tmin+(jj-1)*dt
- sx(ji,jj)=spoint ; ty(ji,jj)=tpoint
+ zsx(ji,jj) = zsmin + (ji-1)*zds
+ zty(ji,jj) = ztmin + (jj-1)*zdt
END DO
END DO
- rsigma0=sigma0(ty,sx,ns,nt)
- rsigma2=sigmai(ty,sx,2000.,ns,nt)
- rsigma4=sigmai(ty,sx,4000.,ns,nt)
- depdum(1)=0.
+
+ rsigma0 = sigma0(zty, zsx, ns, nt)
+ rsigma2 = sigmai(zty, zsx, 2000., ns, nt)
+ rsigma4 = sigmai(zty, zsx, 4000., ns, nt)
+ rdumdep(1) = 0.
IF ( lcdf ) THEN
- ! create output fileset
-
- ipk(:)= 1 ! Those three variables are 3D
- ! define variable name and attribute
- typvar(1)%name= 'volcensus'
- typvar(2)%name= 'sigma0'
- typvar(3)%name= 'sigma2'
- typvar(4)%name= 'sigma4'
- typvar(1)%units='m3'
- typvar(2:4)%units='kg/m3'
- typvar%missing_value=-100.
- typvar%valid_min= 0.
- typvar%valid_max= 1.e20
- typvar(1)%long_name='Volume_Census_TS'
- typvar(2)%long_name='Sigma0_TS'
- typvar(3)%long_name='Sigma2_TS'
- typvar(4)%long_name='Sigma4_TS'
- typvar(1)%short_name='volcensus'
- typvar(2)%short_name='sigma0'
- typvar(3)%short_name='sigma2'
- typvar(4)%short_name='sigma4'
- typvar%online_operation='N/A'
- typvar%axis='TYX'
-
-
- ncout =create(cfileout, cfilTS, ns,nt,1)
- ierr= createvar (ncout ,typvar,4, ipk,id_varout )
- ierr= putheadervar(ncout, cfilTS,ns,nt,1,pnavlon=sx,pnavlat=ty,pdep=depdum)
-
+ ! create output fileset
+ ipk(:)= 1
+ stypvar%rmissing_value = -100.
+ stypvar%valid_min = 0.
+ stypvar%valid_max = 1.e20
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TYX'
+
+ stypvar(1)%cname = 'volcensus'
+ stypvar(2)%cname = 'sigma0'
+ stypvar(3)%cname = 'sigma2'
+ stypvar(4)%cname = 'sigma4'
+
+ stypvar(1)%cunits = 'm3'
+ stypvar(2:4)%cunits = 'kg/m3'
+
+ stypvar(1)%clong_name = 'Volume_Census_TS'
+ stypvar(2)%clong_name = 'Sigma0_TS'
+ stypvar(3)%clong_name = 'Sigma2_TS'
+ stypvar(4)%clong_name = 'Sigma4_TS'
+
+ stypvar(1)%cshort_name = 'volcensus'
+ stypvar(2)%cshort_name = 'sigma0'
+ stypvar(3)%cshort_name = 'sigma2'
+ stypvar(4)%cshort_name = 'sigma4'
+
+ ncout = create (cf_out, cf_tfil, ns, nt, 1 )
+ ierr = createvar (ncout, stypvar, 4, ipk, id_varout, cdglobal=cglobal )
+ ierr = putheadervar(ncout, cf_tfil, ns, nt, 1, pnavlon=zsx, pnavlat=zty, pdep=rdumdep )
ENDIF
- ! Enter main loop
- DO jk=k1,k2
- t(:,:)=getvar(cfilTS, 'votemper', jk ,npiglo, npjglo)
- s(:,:)=getvar(cfilTS, 'vosaline', jk ,npiglo, npjglo)
- e3t_ps(:,:) = getvar(czgr,'e3t_ps',jk,npiglo,npjglo,ldiom=.true.)
-
- DO ji=i1,i2
- DO jj=j1,j2
- tpoint=t(ji,jj)
- spoint=s(ji,jj)
- volpoint=e1t(ji,jj)*e2t(ji,jj)*e3t_ps(ji,jj)
-
- ! salinity = 0 on masked points ( OPA !!! )
- IF (spoint .NE. 0) THEN
- it=NINT( (tpoint-tmin)/dt) + 1
- is=NINT( (spoint-smin)/ds) + 1
- IF (it .LT. 1) it=1
- IF (is .LT. 1) is=1
- IF (it .GT. nt) it=nt
- IF (is .GT. ns) is=ns
-
- rcensus(is,it) = rcensus(is,it) + volpoint*1.e-1
- voltotal =voltotal + volpoint*1e-15
- END IF
- END DO
- END DO
-
- END DO ! Main loop
-
- ! Computes some statistics
- rcmax=-100000.
- DO ji=1,ns
- DO jj=1,nt
- rcmax1=amax1(rcmax,rcensus(ji,jj))
- IF (rcmax1.NE.rcmax) THEN
- sm= smin+(ji-1)*ds
- tm= tmin+(jj-1)*dt
- END IF
- rcmax=rcmax1
- END DO
- END DO
-
- PRINT *,' Total Volume of the domain in 10^15 m3:', REAL(voltotal)
- PRINT *,' Volume of the most represented water mass :',rcmax
- PRINT *,' Salinity=',sm
- PRINT *,' Temperature=', tm
+ DO jt = 1, npt
+ ! Enter main loop
+ DO jk=ik1,ik2
+ zt(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime = jt)
+ zs(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime = jt)
- ! use a distorsion function ( n x log ) to reduce extrema in the output file.
- DO ji=1,ns
- DO jj=1,nt
- dump(ji,jj)=rcensus(ji,jj)
- DO ilog=1,nlog
- dump(ji,jj)=ALOG10(1+dump(ji,jj))
+ IF ( lfull ) THEN
+ e3t(:,:) = e31d(jk)
+ ELSE
+ e3t(:,:) = getvar(cn_fzgr, 'e3t_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+
+ DO ji=ii1,ii2
+ DO jj=ij1,ij2
+ ztpoint = zt(ji,jj)
+ zspoint = zs(ji,jj)
+ dvolpoint = e1t(ji,jj)*e2t(ji,jj)*e3t(ji,jj)*1.d0
+
+ ! salinity = 0 on masked points ( OPA !!! )
+ IF (zspoint /= 0) THEN
+ it=NINT( (ztpoint-ztmin)/zdt) + 1
+ is=NINT( (zspoint-zsmin)/zds) + 1
+ ! check for out of bound values
+ it = MIN ( MAX(it,1), nt )
+ is = MIN ( MAX(is,1), ns )
+
+ dcensus(is,it) = dcensus(is,it) + dvolpoint*1.d-15
+ dvoltotal = dvoltotal + dvolpoint*1.d-15
+ END IF
+ END DO
END DO
- END DO
- END DO
+
+ END DO ! Main loop
+
+ ! Computes some statistics
+ rcmax = MAXVAL ( dcensus )
+ ijloc = MAXLOC ( dcensus )
+ zsm = zsmin + (ijloc(1) -1 ) * zds
+ ztm = ztmin + (ijloc(2) -1 ) * zdt
+
+ PRINT *,' Total Volume of the domain in 10^15 m3:', REAL(dvoltotal)
+ PRINT *,' Volume of the most represented water mass :', rcmax
+ PRINT '(a,f6.2,a)' ,' this is about ', rcmax/dvoltotal *100,' % of the total'
+ PRINT *,' Salinity = ', zsm
+ PRINT *,' Temperature= ', ztm
+
+ ! use a distorsion function ( n x log ) to reduce extrema in the output file.
+ ddump(:,:) = dcensus(:,:)
+ DO jlog = 1, nlog
+ ddump(:,:) = LOG10 (1.d0 + ddump(:,:) )
+ ENDDO
+
+ IF ( lcdf ) THEN
+ ! Output on census.nc file
+ ierr = putvar(ncout, id_varout(1), REAL(ddump), 1, ns, nt, ktime=jt)
+ ierr = putvar(ncout, id_varout(2), rsigma0, 1, ns, nt, ktime=jt)
+ ierr = putvar(ncout, id_varout(3), rsigma2, 1, ns, nt, ktime=jt)
+ ierr = putvar(ncout, id_varout(4), rsigma4, 1, ns, nt, ktime=jt)
+ ENDIF
+ ENDDO ! time loop
IF ( lcdf ) THEN
- ! Output on census.nc file
- tim=getvar1d(cfilTS,'time_counter',1)
- ierr = putvar(ncout, id_varout(1) ,dump, 1,ns, nt)
- ierr = putvar(ncout, id_varout(2) ,rsigma0, 1,ns, nt)
- ierr = putvar(ncout, id_varout(3) ,rsigma2, 1,ns, nt)
- ierr = putvar(ncout, id_varout(4) ,rsigma4, 1,ns, nt)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ierr=closeout(ncout)
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = closeout(ncout)
ENDIF
IF (lbimg ) THEN
- ! Output on bimg file
- cfildum='censusopa.bimg'
- OPEN (10,file=cfildum,form='UNFORMATTED')
-
- WRITE(cline1,942)' Water Masses Census [10-15 m3] on',i1,i2,j1,j2
-942 FORMAT(a,4i5)
- cline2=' computed from the following T-S files:'
- cline3=cfilTS
- cline4=''
- !
- WRITE(10) cline1
- WRITE(10) cline2
- WRITE(10) cline3
- WRITE(10) cline4
- WRITE(10) ns,nt,1,1,4,nlog
- WRITE(10) smin,tmin,ds,dt,0.
- WRITE(10) 0.
- WRITE(10) 0.
- WRITE(10) ((dump(ji,jj) ,ji=1,ns),jj=1,nt)
- WRITE(10) ((rsigma0(ji,jj),ji=1,ns),jj=1,nt)
- WRITE(10) ((rsigma2(ji,jj),ji=1,ns),jj=1,nt)
- WRITE(10) ((rsigma4(ji,jj),ji=1,ns),jj=1,nt)
- CLOSE(10)
+ ! Output on bimg file
+ OPEN (10,file=cf_bimg,form='UNFORMATTED')
+
+ WRITE(cline1,942)' Water Masses Census [10-15 m3] on',ii1,ii2,ij1,ij2
+942 FORMAT(a,4i5)
+ cline2 = ' computed from the following T-S files:'
+ cline3 = cf_tfil
+ cline4 = ''
+ !
+ WRITE(10) cline1
+ WRITE(10) cline2
+ WRITE(10) cline3
+ WRITE(10) cline4
+ WRITE(10) ns, nt, 1, 1, 4, nlog
+ WRITE(10) zsmin, ztmin, zds, zdt, 0.
+ WRITE(10) 0.
+ WRITE(10) 0.
+ WRITE(10) ((REAL(ddump(ji,jj)),ji=1,ns),jj=1,nt)
+ WRITE(10) ((rsigma0(ji,jj), ji=1,ns),jj=1,nt)
+ WRITE(10) ((rsigma2(ji,jj), ji=1,ns),jj=1,nt)
+ WRITE(10) ((rsigma4(ji,jj), ji=1,ns),jj=1,nt)
+ CLOSE(10)
ENDIF
-
+
PRINT *,' Done.'
END PROGRAM cdfcensus
diff --git a/cdfclip.f90 b/cdfclip.f90
index 9feb34b..0faf733 100644
--- a/cdfclip.f90
+++ b/cdfclip.f90
@@ -1,113 +1,146 @@
PROGRAM cdfclip
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfclip ***
+ !!======================================================================
+ !! *** PROGRAM cdfclip ***
+ !!=====================================================================
+ !! ** Purpose : An alternative to ncks to clip model file. It is
+ !! usefull when the clipping area cross the E-W
+ !! periodic folding line. Additionally it does not
+ !! mess up the order of the dimensions and variables,
+ !! which was a problem for coordinates.nc files with
+ !! IOIPSL
!!
- !! ** Purpose: same functionality than ncks but without changing the order of the dim/variables
- !!
- !! ** Method: read zoomed area on the command line ( imin imax jmin jmax)
- !! read the sub zome
- !! write the subzone
- !!
- !! history :
- !! Original code : J.M. Molines (Feb 2007)
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
+ !! History : 2.1 : 02/2007 : J.M. Molines : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
!!
USE cdfio
-
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv !: dummy loop index
- INTEGER :: k1, k2, ik
- INTEGER :: ierr !: working integer
- INTEGER :: imin, imax, jmin, jmax, kmin=-9999, kmax=-9999
- INTEGER :: narg, iargc , jarg !:
- INTEGER :: npiglo,npjglo, npk, npkk,nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk ,ipkk , & !: arrays of vertical level for each var
- & id_varout , ndim
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: tab !: Arrays for cumulated values
- REAL(KIND=8) :: total_time
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: v2d ,rlon, rlat, v2dxz, v2dyz, zxz, zyz
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: depg, dep
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: timean, tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout !: file name
- CHARACTER(LEN=256) :: cdep, cdum, ctim
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- CHARACTER(LEN=255) :: cglobal !: global attribute to write on output file
+
+ INTEGER(KIND=4) :: jk, jt, jvar, jv ! dummy loop index
+ INTEGER(KIND=4) :: ik1, ik2, ik !
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: iimin, iimax !
+ INTEGER(KIND=4) :: ijmin, ijmax !
+ INTEGER(KIND=4) :: ikmin=-9999, ikmax=-9999 !
+ INTEGER(KIND=4) :: narg, iargc, ijarg !
+ INTEGER(KIND=4) :: npiglo, npjglo, npk !
+ INTEGER(KIND=4) :: npkk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvars ! Number of variables in a file
+ INTEGER(KIND=4) :: ncout !
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, ipkk ! arrays of vertical level for each var
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout , ndim !
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, rlon, rlat !
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2dxz, v2dyz, zxz, zyz !
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: rdepg, rdep !
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim !
+
+ CHARACTER(LEN=256) :: cf_in ! input file name
+ CHARACTER(LEN=256) :: cf_out='cdfclip.nc' ! output file name
+ CHARACTER(LEN=256) :: cv_dep, cv_tim ! depth and time variable names
+ CHARACTER(LEN=255) :: cglobal ! global attribute to write on output file
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar !
- INTEGER :: ncout
- INTEGER :: istatus
- LOGICAL :: lzonal=.false. , lmeridian=.false.
-
- !!
+ LOGICAL :: lzonal=.false. !
+ LOGICAL :: lmeridian=.false. !
+ !!-------------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfclip -f file -zoom imin imax jmin jmax [kmin kmax] '
- PRINT *,' if imin==imax then assume a meridional section'
- PRINT *,' if jmin==jmax then assume a zonal section'
- PRINT *,' if [kmin kmax] (optional) are not specified the whole water colums is specified '
+ PRINT *,' usage : cdfclip -f IN-file -zoom imin imax jmin jmax [kmin kmax] '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Clip the input file according to the indices given in the'
+ PRINT *,' zoom statement. If no vertical zoomed area is indicated, '
+ PRINT *,' the whole water column is considered. This program is able'
+ PRINT *,' to extract data for a region crossing the E-W periodic boundary'
+ PRINT *,' of a global configuration. It does so if imax < imin.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' -f IN-file : specify the input file to be clipped'
+ PRINT *,' -zoom imin imax jmin jmax : specify the domain to be extracted.'
+ PRINT *,' If imin=imax, or jmin = jmax assume a vertical section either '
+ PRINT *,' meridional or zonal.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [kmin kmax ] : specify vertical limits for the zoom, in order to reduce'
+ PRINT *,' the extracted area to some levels. Default is to take the whole'
+ PRINT *,' water column.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : same as input variables.'
STOP
ENDIF
!!
- jarg=1
- DO WHILE (jarg < narg )
- CALL getarg (jarg, cdum)
- SELECT CASE ( cdum)
+ ijarg=1
+ DO WHILE (ijarg <= narg )
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum)
CASE ('-f' )
- jarg=jarg+1 ; CALL getarg(jarg,cdum) ; cfile=cdum
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; cf_in=cldum
CASE ('-zoom')
- jarg=jarg+1 ; CALL getarg(jarg,cdum) ; READ(cdum,*) imin
- jarg=jarg+1 ; CALL getarg(jarg,cdum) ; READ(cdum,*) imax
- jarg=jarg+1 ; CALL getarg(jarg,cdum) ; READ(cdum,*) jmin
- jarg=jarg+1 ; CALL getarg(jarg,cdum) ; READ(cdum,*) jmax
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimin
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax
IF ( narg == 9 ) THEN ! there are kmin kmax optional arguments
- jarg=jarg+1 ; CALL getarg(jarg,cdum) ; READ(cdum,*) kmin
- jarg=jarg+1 ; CALL getarg(jarg,cdum) ; READ(cdum,*) kmax
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmin
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmax
ENDIF
CASE DEFAULT
- PRINT *,' Unknown option :', TRIM(cdum) ; STOP
+ PRINT *,' Unknown option :', TRIM(cldum) ; STOP
END SELECT
- jarg=jarg+1
ENDDO
- IF ( kmin > 0 ) THEN
- WRITE(cglobal,'(a,a,a,6i5)') 'cdfclip -f ',TRIM(cfile),' -zoom ',imin,imax,jmin,jmax, kmin, kmax
+
+ IF ( chkfile (cf_in ) ) STOP ! missing file
+
+ ! set global attribute for output file
+ IF ( ikmin > 0 ) THEN
+ WRITE(cglobal,'(a,a,a,6i5)') 'cdfclip -f ',TRIM(cf_in),' -zoom ',iimin,iimax,ijmin,ijmax, ikmin, ikmax
ELSE
- WRITE(cglobal,'(a,a,a,4i5)') 'cdfclip -f ',TRIM(cfile),' -zoom ',imin,imax,jmin,jmax
+ WRITE(cglobal,'(a,a,a,4i5)') 'cdfclip -f ',TRIM(cf_in),' -zoom ',iimin,iimax,ijmin,ijmax
ENDIF
- IF ( imin == imax ) THEN ; lmeridian=.true.; print *,' Meridional section ' ; ENDIF
- IF ( jmin == jmax ) THEN ; lzonal=.true. ; print *,' Zonal section ' ; ENDIF
+ IF ( iimin == iimax ) THEN ; lmeridian=.true.; print *,' Meridional section ' ; ENDIF
+ IF ( ijmin == ijmax ) THEN ; lzonal=.true. ; print *,' Zonal section ' ; ENDIF
- IF (imax < imin ) THEN ! we assume that this is the case when we cross the periodic line in orca (Indian ocean)
- npiglo= getdim (cfile,'x')
- npiglo=imax+(npiglo-imin) -1
+ IF (iimax < iimin ) THEN ! we assume that this is the case when we cross the periodic line in orca (Indian ocean)
+ npiglo= getdim (cf_in,cn_x)
+ npiglo=iimax+(npiglo-iimin) -1
ELSE
- npiglo= imax-imin+1
+ npiglo= iimax-iimin+1
ENDIF
- npjglo= jmax-jmin+1
+ npjglo= ijmax-ijmin+1
! look for possible name for vertical dim :
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus) ! depthxxx
- print *,'ist',istatus,'depth'
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus) ! zxxx
- print *,'ist',istatus,'z'
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus) ! sigmaxxx
- print *,'ist',istatus,'sigma'
- IF (istatus /= 0 ) THEN
+ npk = getdim (cf_in,cn_z,cdtrue=cv_dep, kstatus=ierr) ! depthxxx
+ print *,'ist',ierr,TRIM(cn_z)
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr) ! zxxx
+ print *,'ist',ierr,'z'
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr) ! sigmaxxx
+ print *,'ist',ierr,'sigma'
+ IF (ierr /= 0 ) THEN
PRINT *,' assume file with no depth'
- IF ( kmin > 0 ) THEN
+ IF ( ikmin > 0 ) THEN
PRINT *,' You cannot specify limits on k level !' ; STOP
ENDIF
npk=0 ! means no dim level in file (implicitly 1 level)
@@ -115,54 +148,57 @@ PROGRAM cdfclip
ENDIF
ENDIF
- ! replace flag value (-9999) by standard value (no kmin kmax specified = whole column)
- IF ( kmin < 0 ) kmin = 1
- IF ( kmax < 0 ) kmax = npk
- npkk = kmax - kmin +1 ! number of extracted levels. If no level in file, it is 0: 0 -1 + 1 !
- IF (npk == 0 ) kmax = 1
- nt = getdim(cfile,'time_counter', cdtrue=ctim, kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- nt = getdim(cfile,'time', cdtrue=ctim, kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- nt = getdim(cfile,'t', cdtrue=ctim, kstatus=istatus)
- IF ( istatus /= 0 ) THEN
+ ! replace flag value (-9999) by standard value (no ikmin ikmax specified = whole column)
+ IF ( ikmin < 0 ) ikmin = 1
+ IF ( ikmax < 0 ) ikmax = npk
+ npkk = ikmax - ikmin +1 ! number of extracted levels. If no level in file, it is 0: 0 -1 + 1 !
+ IF (npk == 0 ) ikmax = 1
+
+ ! look for possible name for time dimension
+ npt = getdim(cf_in,cn_t, cdtrue=cv_tim, kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npt = getdim(cf_in,'time', cdtrue=cv_tim, kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npt = getdim(cf_in,'t', cdtrue=cv_tim, kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
PRINT *, 'no time dimension found'
- nt=1
+ npt=1
ENDIF
ENDIF
ENDIF
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk ,' npkk =', npkk
- PRINT *, 'nt =', nt
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk ,' npkk =', npkk
+ PRINT *, 'npt = ', npt
IF (npkk > npk ) THEN
PRINT *,' It seems that you want levels that are not represented '
- PRINT *,' in any of the variables that are in the file ',TRIM(cfile)
+ PRINT *,' in any of the variables that are in the file ',TRIM(cf_in)
STOP
ENDIF
- ALLOCATE( v2d(npiglo,npjglo),rlon(npiglo,npjglo), rlat(npiglo,npjglo), depg(npk) , dep(npkk))
+ ALLOCATE( v2d(npiglo,npjglo),rlon(npiglo,npjglo), rlat(npiglo,npjglo), rdepg(npk) , rdep(npkk))
ALLOCATE( zxz(npiglo,1), zyz(1,npjglo) )
- ALLOCATE( timean(nt), tim(nt) )
+ ALLOCATE( tim(npt) )
- nvars = getnvar(cfile)
+ nvars = getnvar(cf_in)
PRINT *,' nvars =', nvars
- ALLOCATE (cvarname(nvars),ndim(nvars) )
- ALLOCATE (typvar(nvars))
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars),ipkk(nvars))
+ ALLOCATE (cv_names(nvars), ndim(nvars) )
+ ALLOCATE (stypvar(nvars))
+ ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars), ipkk(nvars))
- rlon=getvar(cfile,'nav_lon',1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- rlat=getvar(cfile,'nav_lat',1,npiglo,npjglo,kimin=imin,kjmin=jmin)
+ rlon =getvar(cf_in, cn_vlon2d, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin) ! nav_lon
+ rlat =getvar(cf_in, cn_vlat2d, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin) ! nav_lat
IF ( npk /= 0 ) THEN
- depg=getvar1d(cfile,cdep,npk)
- dep(:)=depg(kmin:kmax)
+ rdepg = getvar1d(cf_in, cv_dep, npk)
+ rdep(:) = rdepg(ikmin:ikmax)
ENDIF
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ ! get list of variable names and collect attributes in stypvar (optional)
+ cv_names(:)=getvarname(cf_in, nvars, stypvar)
! save variable dimension in ndim
! 1 = either time or depth : noclip
@@ -170,71 +206,70 @@ PROGRAM cdfclip
! 3 = X,Y,T or X,Y,Z <-- need to fix the ambiguity ...
! 4 = X,Y,Z,T
DO jvar=1,nvars
- ndim(jvar) = getvdim(cfile,cvarname(jvar)) + 1 ! we add 1 because vdim is dim - 1 ...
+ ndim(jvar) = getvdim(cf_in, cv_names(jvar)) + 1 ! we add 1 because vdim is dim - 1 ...
END DO
id_var(:) = (/(jv, jv=1,nvars)/)
+
! ipk gives the number of level or 0 if not a T[Z]YX variable
-
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
- ipk(:) = MIN ( ipk , kmax ) ! reduce max depth to the required maximum
- ipkk(:)= MAX( 0 , ipk(:) - kmin + 1 ) ! for output variable. For 2D input var,
- ! ipkk is set to 0 if kmin > 1 ... OK ?
- WHERE( ipkk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
+ ipk(:) = getipk (cf_in,nvars,cdep=cv_dep)
+ ipk(:) = MIN ( ipk , ikmax ) ! reduce max depth to the required maximum
+ ipkk(:)= MAX( 0 , ipk(:) - ikmin + 1 ) ! for output variable. For 2D input var,
+ ! ipkk is set to 0 if ikmin > 1 ... OK ?
+ WHERE( ipkk == 0 ) cv_names='none'
+ stypvar(:)%cname = cv_names
! create output fileset
- cfileout='cdfclip.nc'
- ! create output file taking the sizes in cfile
- ncout =create(cfileout, cfile,npiglo,npjglo,npkk,cdep=cdep)
- ierr= createvar(ncout , typvar, nvars, ipkk, id_varout,cdglobal=cglobal)
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npkk,pnavlon=rlon, pnavlat=rlat,pdep=dep,cdep=cdep)
+ ! create output file taking the sizes in cf_in
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npkk, cdep=cv_dep )
+ ierr = createvar (ncout, stypvar, nvars, ipkk, id_varout, cdglobal=cglobal)
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npkk, pnavlon=rlon, pnavlat=rlat, pdep=rdep, cdep=cv_dep)
DO jvar = 1,nvars
! skip dimension variables (already done when creating the output file)
- k1=MAX(1,kmin) ; k2=ipk(jvar)
- SELECT CASE (cvarname(jvar) )
- CASE ('none' )
+ ik1=MAX(1,ikmin) ; ik2=ipk(jvar)
+ SELECT CASE (cv_names(jvar) )
+ !
+ CASE ('none' )
! skip
- CASE DEFAULT
- IF ( lzonal ) THEN
- ALLOCATE( v2dxz(npiglo,ipk(jvar)) )
- DO jt=1,nt
- v2dxz=getvarxz(cfile,cvarname(jvar),jmin,npiglo,ipk(jvar), kimin=imin,kkmin=1,ktime=jt)
- DO jk=k1,k2
- ik = jk - k1 + 1
- zxz(:,1)=v2dxz(:,jk)
- ierr=putvar(ncout,id_varout(jvar),zxz,ik,npiglo,1,ktime=jt)
- ENDDO
- ENDDO
- DEALLOCATE ( v2dxz )
- ELSEIF (lmeridian) THEN
- ALLOCATE( v2dyz(npjglo,ipk(jvar)) )
- DO jt=1,nt
- v2dyz=getvaryz(cfile,cvarname(jvar),imin,npjglo,ipk(jvar),kjmin=jmin,kkmin=1,ktime=jt)
- DO jk=k1, k2
- ik = jk - k1 + 1
- zyz(1,:)=v2dyz(:,jk)
- ierr=putvar(ncout,id_varout(jvar),zyz,ik,1,npjglo,ktime=jt)
- ENDDO
- ENDDO
- DEALLOCATE ( v2dyz )
- ELSE
- DO jt = 1, nt
- DO jk=k1,k2
- ik = jk - k1 + 1
- v2d=getvar(cfile,cvarname(jvar),jk,npiglo,npjglo,kimin=imin,kjmin=jmin,ktime=jt)
- ierr=putvar(ncout,id_varout(jvar),v2d,ik,npiglo,npjglo,ktime=jt)
+ CASE DEFAULT
+ IF ( lzonal ) THEN
+ ALLOCATE( v2dxz(npiglo,ipk(jvar)) )
+ DO jt=1,npt
+ v2dxz=getvarxz(cf_in, cv_names(jvar), ijmin, npiglo, ipk(jvar), kimin=iimin, kkmin=1, ktime=jt)
+ DO jk=ik1,ik2
+ ik = jk - ik1 + 1
+ zxz(:,1) = v2dxz(:,jk)
+ ierr=putvar(ncout, id_varout(jvar), zxz, ik, npiglo, 1, ktime=jt)
ENDDO
+ ENDDO
+ DEALLOCATE ( v2dxz )
+ ELSEIF (lmeridian) THEN
+ ALLOCATE( v2dyz(npjglo,ipk(jvar)) )
+ DO jt=1,npt
+ v2dyz=getvaryz(cf_in, cv_names(jvar), iimin, npjglo, ipk(jvar), kjmin=ijmin, kkmin=1, ktime=jt)
+ DO jk=ik1, ik2
+ ik = jk - ik1 + 1
+ zyz(1,:) = v2dyz(:,jk)
+ ierr=putvar(ncout, id_varout(jvar), zyz, ik, 1, npjglo, ktime=jt)
ENDDO
- ENDIF
- END SELECT
+ ENDDO
+ DEALLOCATE ( v2dyz )
+ ELSE
+ DO jt = 1, npt
+ DO jk=ik1,ik2
+ ik = jk - ik1 + 1
+ v2d = getvar(cf_in, cv_names(jvar), jk, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jt)
+ ierr = putvar(ncout, id_varout(jvar), v2d, ik, npiglo, npjglo, ktime=jt)
+ ENDDO
+ ENDDO
+ ENDIF
+ END SELECT
END DO ! loop to next var in file
- timean=getvar1d(cfile,'time_counter',nt)
- ierr=putvar1d(ncout,timean,nt,'T')
-
- istatus = closeout(ncout)
+ tim = getvar1d(cf_in, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = closeout(ncout)
END PROGRAM cdfclip
diff --git a/cdfcofpoint.f90 b/cdfcoastline.f90
similarity index 82%
rename from cdfcofpoint.f90
rename to cdfcoastline.f90
index bd3f29b..117122f 100644
--- a/cdfcofpoint.f90
+++ b/cdfcoastline.f90
@@ -3,6 +3,8 @@ PROGRAM cdfcofpoint
!! *** PROGRAM cdfmean ***
!!
!! ** Purpose : Compute distance of first coast in grid point
+ !! Determine the edge of a mask (for further use
+ !! with iceshelf parametrization)
!!
!! ** Method : long iterative method (check furtehr time all mask point)
!!
@@ -23,12 +25,12 @@ PROGRAM cdfcofpoint
REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, mask, mask_out !: npiglo x npjglo
- CHARACTER(LEN=256) :: cfile, cdum
+ CHARACTER(LEN=256) :: cfile, cldum
CHARACTER(LEN=256) :: cmask='mask.nc'
! output stuff
INTEGER, DIMENSION(1) :: ipk, id_varout
- TYPE(variable), DIMENSION(1) :: typvar
+ TYPE(variable), DIMENSION(1) :: stypvar
REAL(KIND=4) ,DIMENSION(1) :: timean
CHARACTER(LEN=256) :: cfileout='pointcoast.nc'
INTEGER :: ncout, ierr
@@ -59,10 +61,10 @@ PROGRAM cdfcofpoint
STOP
ELSE
! input optional imin imax jmin jmax
- CALL getarg ( 2,cdum) ; READ(cdum,*) imin
- CALL getarg ( 3,cdum) ; READ(cdum,*) imax
- CALL getarg ( 4,cdum) ; READ(cdum,*) jmin
- CALL getarg ( 5,cdum) ; READ(cdum,*) jmax
+ CALL getarg ( 2,cldum) ; READ(cldum,*) imin
+ CALL getarg ( 3,cldum) ; READ(cldum,*) imax
+ CALL getarg ( 4,cldum) ; READ(cldum,*) jmin
+ CALL getarg ( 5,cldum) ; READ(cldum,*) jmax
ENDIF
ENDIF
@@ -103,21 +105,21 @@ PROGRAM cdfcofpoint
! prepare file output
ipk(1) = 1
- typvar(1)%name='pointcoast'
- typvar(1)%units='px'
- typvar(1)%missing_value=0
- typvar(1)%valid_min= 1.
- typvar(1)%valid_max= i
- typvar(1)%long_name='pointcoast'
- typvar(1)%short_name='pointcoast'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
- typvar(1)%precision='r4'
+ stypvar(1)%cname='pointcoast'
+ stypvar(1)%cunits='px'
+ stypvar(1)%rmissing_value=0
+ stypvar(1)%valid_min= 1.
+ stypvar(1)%valid_max= i
+ stypvar(1)%clong_name='pointcoast'
+ stypvar(1)%cshort_name='pointcoast'
+ stypvar(1)%conline_operation='N/A'
+ stypvar(1)%caxis='TZYX'
+ stypvar(1)%cprecision='r4'
PRINT *,' CREATE ...'
ncout=create(cfileout, cfile,npi,npj,1)
PRINT *,' CREATEVAR ...'
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
+ ierr= createvar(ncout ,stypvar,1, ipk,id_varout )
PRINT *,' PUTHEADERVAR ...'
ierr= putheadervar(ncout, cfile, npi,npj,npk)
ierr=putvar(ncout,id_varout(1),mask_out,1,npi,npj)
diff --git a/cdfcofdis.f90 b/cdfcofdis.f90
index 9d99d1d..65f543f 100644
--- a/cdfcofdis.f90
+++ b/cdfcofdis.f90
@@ -1,66 +1,129 @@
PROGRAM cdfcofdis
- !!--------------------------------------------------------------------------
- !! *** PROGRAM cdfcofdis ***
+ !!======================================================================
+ !! *** PROGRAM cdfcofdis ***
+ !!=====================================================================
+ !! ** Purpose : A wrapper for NEMO routine cofdis: create a file
+ !! with the distance to coast variable
!!
- !! ** Purpose : wrap for standalone cofdis routine from OPA
- !!
- !! ** Method : define required arrays and variables in main
- !! call cofdis
- !! write results using cdfio instead of ioipsl
+ !! ** Method : Mimic some NEMO global variables to be able to use
+ !! NEMO cofdis with minimum changes. Use cdfio instead
+ !! of IOIPSL for the output file. Due to this constaint
+ !! DOCTOR norm is not fully respected (eg jpi not PARAMETER)
+ !! pdct is not a routine argument ...
!!
- !!-------------------------------------------------------------------------
+ !! History : 2.1 : 11/2009 : J.M. Molines : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! cofdis : compute distance to coast (NEMO routine )
+ !!----------------------------------------------------------------------
+
USE cdfio
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- ! Global variables
- INTEGER :: jpi,jpj,jpk, jpim1, jpjm1, nperio=4
- INTEGER :: narg, iargc
+
+ INTEGER(KIND=4) :: jpi, jpj, jpk
+ INTEGER(KIND=4) :: jpim1, jpjm1, nperio=4
+ INTEGER(KIND=4) :: narg, iargc, iarg
+ INTEGER(KIND=4) :: ncout, ierr
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout
+
+ ! from phycst
+ REAL(KIND=4) :: rpi = 3.141592653589793 !: pi
+ REAL(KIND=4) :: rad = 3.141592653589793 / 180. !: conv. from degre into radian
+ REAL(KIND=4) :: ra = 6371229. !: earth radius (meter)
+
+ REAL(KIND=4) ,DIMENSION(1) :: timean
+ ! to be read in mesh_hgr
REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamt, glamu,glamv, glamf
REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: gphit, gphiu,gphiv, gphif
REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask, umask, vmask, fmask
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: pdct
- ! from phycst
- REAL(KIND=4) :: rpi = 3.141592653589793 !: pi
- REAL(KIND=4) :: rad = 3.141592653589793 / 180. !: conversion from degre into radian
- REAL(KIND=4) :: ra = 6371229. !: earth radius (meter)
+ !
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: pdct ! 2D only in this version
+ ! It is a 3D arg in original cofdis
+ CHARACTER(LEN=256) :: cf_out='dist.coast'
+ CHARACTER(LEN=256) :: cf_tfil
+ CHARACTER(LEN=256) :: cv_out='Tcoast'
+ CHARACTER(LEN=256) :: cldum
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', cmask='mask.nc'
- CHARACTER(LEN=255) :: cfilet
-
- ! output stuff
- INTEGER, DIMENSION(1) :: ipk, id_varout
- TYPE(variable), DIMENSION(1) :: typvar
- REAL(KIND=4) ,DIMENSION(1) :: timean
- CHARACTER(LEN=256) :: cfileout='dist.coast'
- INTEGER :: ncout, ierr
+ TYPE(variable), DIMENSION(1) :: stypvar
+ LOGICAL :: lchk
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
!
narg=iargc()
IF ( narg == 0 ) THEN
- PRINT *,' USAGE: cdfcofdis mesh_hgr.nc mask.nc gridT.nc'
- PRINT *,' where mesh_hgr.nc and mask.nc stand for the name of the mesh_hgr'
- PRINT *,' and mask files respectively'
- PRINT *,' gridT.nc is used for size and depth references'
- PRINT *,' Program will output dist.coast with variable Tcoast, representing the distance of every'
- PRINT *,' T points to the coast line '
- STOP
+ PRINT *,' usage : cdfcofdis mesh_hgr.nc mask.nc gridT.nc [-jperio jperio ]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the distance to the coast and create a file with '
+ PRINT *,' the ',TRIM(cv_out),' variable, indicating the distance to the coast.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' HGR-file : name of the mesh_hgr file '
+ PRINT *,' MSK-file : name of the mask file '
+ PRINT *,' T-file : netcdf file at T point.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ -jperio jperio ] : define the NEMO jperio variable for north fold condition'
+ PRINT *,' Default is 4.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_out),' (m)'
+ PRINT *,' '
+ PRINT *,' '
+ STOP
ENDIF
- CALL getarg(1,coordhgr)
- CALL getarg(2,cmask)
- CALL getarg(3,cfilet)
+ CALL getarg(1,cn_fhgr) ! overwrite standard name eventually
+ CALL getarg(2,cn_fmsk) ! "" ""
+ CALL getarg(3,cf_tfil )
+
+ lchk = chkfile ( cn_fhgr )
+ lchk = lchk .OR. chkfile ( cn_fmsk )
+ lchk = lchk .OR. chkfile ( cf_tfil )
+ IF ( lchk ) STOP ! missing files
+
+ iarg = 4
+ DO WHILE ( iarg <= narg )
+ CALL getarg(iarg, cldum ) ; iarg = iarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-jperio' )
+ CALL getarg (iarg,cldum) ; READ(cldum, * ) nperio ; iarg = iarg + 1
+ CASE DEFAULT
+ PRINT *,' unknown option : ', TRIM(cldum)
+ STOP
+ END SELECT
+ END DO
! read domain dimensions in the mask file
- jpi=getdim(cfilet,'x')
- jpj=getdim(cfilet,'y')
- jpk=getdim(cfilet,'depth')
+ jpi = getdim(cf_tfil,cn_x)
+ jpj = getdim(cf_tfil,cn_y)
+ jpk = getdim(cf_tfil,cn_z)
+
IF (jpk == 0 ) THEN
- jpk=getdim(cfilet,'z')
+ jpk = getdim(cf_tfil,'z')
IF ( jpk == 0 ) THEN
PRINT *,' ERROR in determining jpk form gridT file ....'
STOP
ENDIF
ENDIF
- PRINT *, jpi,jpj,jpk
+
+ PRINT *, ' JPI = ', jpi
+ PRINT *, ' JPJ = ', jpj
+ PRINT *, ' JPK = ', jpk
+
jpim1=jpi-1 ; jpjm1=jpj-1
! ALLOCATION of the arrays
@@ -72,48 +135,38 @@ PROGRAM cdfcofdis
PRINT *, 'ALLOCATION DONE.'
! read latitude an longitude
- glamt(:,:) = getvar(coordhgr,'glamt',1,jpi,jpj)
- PRINT *,' READ GLAMT done.'
- glamu(:,:) = getvar(coordhgr,'glamu',1,jpi,jpj)
- PRINT *,' READ GLAMU done.'
- glamv(:,:) = getvar(coordhgr,'glamv',1,jpi,jpj)
- PRINT *,' READ GLAMV done.'
- glamf(:,:) = getvar(coordhgr,'glamf',1,jpi,jpj)
- PRINT *,' READ GLAMF done.'
+ glamt(:,:) = getvar(cn_fhgr,cn_glamt,1,jpi,jpj)
+ glamu(:,:) = getvar(cn_fhgr,cn_glamu,1,jpi,jpj)
+ glamv(:,:) = getvar(cn_fhgr,cn_glamv,1,jpi,jpj)
+ glamf(:,:) = getvar(cn_fhgr,cn_glamf,1,jpi,jpj)
- gphit(:,:) = getvar(coordhgr,'gphit',1,jpi,jpj)
- PRINT *,' READ GPHIT done.'
- gphiu(:,:) = getvar(coordhgr,'gphiu',1,jpi,jpj)
- PRINT *,' READ GPHIU done.'
- gphiv(:,:) = getvar(coordhgr,'gphiv',1,jpi,jpj)
- PRINT *,' READ GPHIV done.'
- gphif(:,:) = getvar(coordhgr,'gphif',1,jpi,jpj)
- PRINT *,' READ GPHIF done.'
+ gphit(:,:) = getvar(cn_fhgr,cn_gphit,1,jpi,jpj)
+ gphiu(:,:) = getvar(cn_fhgr,cn_gphiu,1,jpi,jpj)
+ gphiv(:,:) = getvar(cn_fhgr,cn_gphiv,1,jpi,jpj)
+ gphif(:,:) = getvar(cn_fhgr,cn_gphif,1,jpi,jpj)
! prepare file output
- ipk(1) = jpk
- typvar(1)%name='Tcoast'
- typvar(1)%units='m'
- typvar(1)%missing_value=0
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 1.
- typvar(1)%long_name='Tcoast'
- typvar(1)%short_name='Tcoast'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
- typvar(1)%precision='r4'
- PRINT *,' CREATE ...'
- ncout=create(cfileout, cfilet,jpi,jpj,jpk)
+ ipk(1) = jpk
+ stypvar(1)%cname = cv_out
+ stypvar(1)%cunits = 'm'
+ stypvar(1)%rmissing_value = 0
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 1.
+ stypvar(1)%clong_name = cv_out
+ stypvar(1)%cshort_name = cv_out
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+ stypvar(1)%cprecision = 'r4'
+
+ ncout = create (cf_out, cf_tfil, jpi, jpj, jpk )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, jpi, jpj, jpk )
- PRINT *,' CREATEVAR ...'
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- PRINT *,' PUTHEADERVAR ...'
- ierr= putheadervar(ncout, cfilet, jpi,jpj,jpk)
- PRINT *, 'CALL to cofdis ...'
CALL cofdis
CONTAINS
- SUBROUTINE cofdis
+
+ SUBROUTINE cofdis()
!!----------------------------------------------------------------------
!! *** ROUTINE cofdis ***
!!
@@ -133,12 +186,10 @@ PROGRAM cdfcofdis
!! ** Action : - pdct, distance to the coastline (argument)
!! - NetCDF file 'dist.coast'
!!----------------------------------------------------------------------
- !!
- !!
- INTEGER :: ji, jj, jk, jl ! dummy loop indices
- INTEGER :: iju, ijt ! temporary integers
- INTEGER :: icoast, itime
- INTEGER :: icot ! logical unit for file distance to the coast
+ INTEGER(KIND=4) :: ji, jj, jk, jl ! dummy loop indices
+ INTEGER(KIND=4) :: iju, ijt ! temporary integers
+ INTEGER(KIND=4) :: icoast, itime
+ INTEGER(KIND=4) :: icot ! logical unit for file distance to the coast
LOGICAL, DIMENSION(jpi,jpj) :: llcotu, llcotv, llcotf ! ???
CHARACTER (len=32) :: clname
REAL(KIND=4) :: zdate0
@@ -164,10 +215,10 @@ PROGRAM cdfcofdis
! read the masks
! temp(:,:) = getvar(cbathy,'Bathy_level',1, npiglo, npjglo)
- tmask(:,:)=getvar(cmask,'tmask',jk,jpi,jpj)
- umask(:,:)=getvar(cmask,'umask',jk,jpi,jpj)
- vmask(:,:)=getvar(cmask,'vmask',jk,jpi,jpj)
- fmask(:,:)=getvar(cmask,'fmask',jk,jpi,jpj)
+ tmask(:,:)=getvar(cn_fmsk,'tmask',jk,jpi,jpj)
+ umask(:,:)=getvar(cn_fmsk,'umask',jk,jpi,jpj)
+ vmask(:,:)=getvar(cn_fmsk,'vmask',jk,jpi,jpj)
+ fmask(:,:)=getvar(cn_fmsk,'fmask',jk,jpi,jpj)
PRINT *, ' READ masks done.'
! Define the coastline points (U, V and F)
DO jj = 2, jpjm1
@@ -281,7 +332,7 @@ PROGRAM cdfcofdis
ELSE
DO jl = 1, icoast
zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2 &
- & + ( zyt(ji,jj) - zyc(jl) )**2 &
+ & + ( zyt(ji,jj) - zyc(jl) )**2 &
& + ( zzt(ji,jj) - zzc(jl) )**2
END DO
pdct(ji,jj) = ra * SQRT( MINVAL( zdis(1:icoast) ) )
diff --git a/cdfcoloc.f90 b/cdfcoloc.f90
index 98ab3dc..92f2ea9 100644
--- a/cdfcoloc.f90
+++ b/cdfcoloc.f90
@@ -1,306 +1,635 @@
PROGRAM cdfcoloc
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfcoloc ***
+ !!======================================================================
+ !! *** PROGRAM cdfcoloc ***
+ !!=====================================================================
+ !! ** Purpose : Colocates model values on data points. The 3D or 2D
+ !! position of the points are already in the corresponding
+ !! weight file. (Bilinear interpolation).
!!
- !! ** Purpose : colocalisation for Greg Holloway
- !!
- !! ** Method : Use the weight files computed with cdfweight
+ !! ** Method : Use the weight file provided as argument and computed
+ !! with cdfweight
!!
- !! history ;
- !! Original : J.M. Molines (16 may 2007 )
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 05/2007 : J.M. Molines : Original code
+ !! 3.0 : 03/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! subroutine rotation : perform vector rotation to get geographical
+ !! vector components
+ !! subroutine getfld : decipher the field list given on the command line
+ !! subroutine help_message : list available fields
+ !! function interp : perform bilinear interpolation
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER, PARAMETER :: jptyp=5 !: number of type to produce ( look to ctype)
- INTEGER :: narg, iargc
- INTEGER :: ji,jj, jk, jid, jtyp !: dummy loop index
- INTEGER :: i1, j1, i2, j2, i3, j3, i4, j4, k1, k2 !: working integers
- INTEGER :: nid = 0 !: mooring counter initialize to 0
- INTEGER :: npiglo, npjglo, npk !: grid size of the model
- INTEGER :: npkv !: vertical dimension of the target variable (either 1 (2D) or npk (3D)
- INTEGER :: numbin=20, numout=30, numskip=31 !: logical unit for I/O files other than NetCdf
- REAL(KIND=8) :: zmin
+ INTEGER(KIND=4), PARAMETER :: jptyp=16 ! number of available types
+ INTEGER(KIND=4) :: ntyp ! number of type to produce ( look to ctype)
+ INTEGER(KIND=4) :: ji, jj, jk ! dummy loop index
+ INTEGER(KIND=4) :: jid, jtyp ! dummy loop index
+ INTEGER(KIND=4) :: idum ! dummy integer
+ INTEGER(KIND=4) :: narg, iargc, iarg
+ INTEGER(KIND=4) :: nid = 0 ! mooring counter initialize to 0
+ INTEGER(KIND=4) :: npiglo, npjglo ! grid size of the model
+ INTEGER(KIND=4) :: npk ! grid size of the model
+ INTEGER(KIND=4) :: npkv ! vertical dimension of the target variable
+ ! ! (either 1 (2D) or npk (3D)
+ INTEGER(KIND=4) :: numbin = 20 ! logical unit for I/O files other than NetCdf
+ INTEGER(KIND=4) :: numout = 30 ! logical unit for I/O files other than NetCdf
+ INTEGER(KIND=4) :: numskip = 31 ! logical unit for I/O files other than NetCdf
! variables in the weight file, 1 record per mooring
- INTEGER :: id, idep
- INTEGER :: imin, jmin, kmin !: location of horizontal nearest point, vertical above target.
- INTEGER :: iquadran !: grid sector from 1 to 4 (clockwise, 1=NE) in wich target point
- ! is located with respect to nearest point
- REAL(KIND=8) :: xmin, ymin
- REAL(KIND=8) :: alpha, beta, gamma, hN, scale
-
- REAL(KIND=4) :: vup, vdo, wup, wdo !: Working variables
- REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d !: 3D !! working variable
- REAL(KIND=8), DIMENSION(:,:) , ALLOCATABLE :: v2d, e !: 2D working variable and horizontal metric
- REAL(KIND=8), DIMENSION(:,:) , ALLOCATABLE :: vinterp !: result array (nid,jptyp)
-
- INTEGER(KIND=2), DIMENSION(:,:,:), ALLOCATABLE :: mask !: 3D working mask
+ INTEGER(KIND=4) :: id, idep
+ INTEGER(KIND=4) :: nimin, njmin ! location of horizontal nearest point
+ INTEGER(KIND=4) :: nkmin ! location vertical above target.
+ INTEGER(KIND=4) :: nquadran ! grid sector from 1 to 4 (clockwise, 1=NE)
+ ! ! in which target point is located with respect
+ ! ! to nearest point.
+ INTEGER(KIND=4) :: nSx, nSy ! index of the Sx and Sy for rotation
+ INTEGER(KIND=4) :: nU, nV ! index of the U and V for rotation
+ INTEGER(KIND=2), DIMENSION(:,:,:), ALLOCATABLE :: mask ! 3D working mask
+
+ REAL(KIND=4) :: vup, vdo, wup, wdo ! Working variables
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d ! 3D ! working variable (unavoidable)
+
+ REAL(KIND=8) :: dxmin, dymin
+ REAL(KIND=8) :: dalpha, dbeta, dgama
+ REAL(KIND=8) :: dhN, dscale
+ REAL(KIND=8) :: dlmin
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: d2d, de ! 2D working variable and horizontal metric
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dinterp ! result array (nid,jptyp)
! file name
- CHARACTER(LEN=256) :: coord='coordinates.nc', czgr='mesh_zgr.nc', cmask='mask.nc', cfilout='izUVSxSyH.txt'
- CHARACTER(LEN=256) :: cfilskip='izUVSxSyH_skip.txt'
- CHARACTER(LEN=256) :: cweight,cweight_root, cgridt, cgridu, cgridv, cfil
- ! Variable type and name
- CHARACTER(LEN=256) :: cctyp, cvar, cvmask !: current mooring
- CHARACTER(LEN=3), DIMENSION(jptyp) :: ctype !: all jptyp defined there
-
- !!
- ctype=(/'U ','V ','Sx','Sy','H '/)
+ CHARACTER(LEN=256) :: cf_out
+ CHARACTER(LEN=256) :: cf_skip
+ CHARACTER(LEN=256) :: cf_weight
+ CHARACTER(LEN=256) :: cf_weight_root
+ CHARACTER(LEN=256) :: cf_gridt = 'none'
+ CHARACTER(LEN=256) :: cf_gridtrc = 'none'
+ CHARACTER(LEN=256) :: cf_diag = 'none'
+ CHARACTER(LEN=256) :: cf_gridu = 'none'
+ CHARACTER(LEN=256) :: cf_gridv = 'none'
+ CHARACTER(LEN=256) :: cf_bathy = 'none'
+ CHARACTER(LEN=256) :: cf_in
+ CHARACTER(LEN=256) :: cf_weight_t
+ CHARACTER(LEN=256) :: cf_weight_u
+ CHARACTER(LEN=256) :: cf_weight_v
+ CHARACTER(LEN=256) :: cctyp, cvar, cvmask ! current mooring
+ CHARACTER(LEN=256) :: cldum ! dummy char variable for line input
+ CHARACTER(LEN=256) :: ctmplst0 ! current list of type: separated by ,
+ CHARACTER(LEN=256) :: cformat ! ASCII format adapted to ntyp
+ CHARACTER(LEN=12), DIMENSION(jptyp) :: ctype ! all possible type defined there
+ CHARACTER(LEN=12), DIMENSION(:),ALLOCATABLE :: cltype ! actual type used given as argument
+
+ LOGICAL :: llchk
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ ! exhaustive list of supported field
+ ctype = (/'T','S','SSH','CFCINV','CFCCONC','PENDEP', &
+ & 'MXL','MXL01','MXLT02','ISOTHICK','U ','V ','Sx','Sy','H ','etopo'/)
+ ctmplst0 = 'U,V,Sx,Sy,H' ! default list
!! Read command line and output usage message if not compliant.
narg= iargc()
- IF ( narg /= 4 ) THEN
- PRINT *,' Usage : cdfcoloc root_weight gridT gridU gridV '
- PRINT *,' return an ascii file izUVSxSyH.txt (N x 7 )'
- PRINT *,' Example : cdfcoloc weight gridT gridU gridV '
- PRINT *,' coordinates.nc, mesh_zgr.nc, mask.nc required in local directory'
+ IF ( narg < 1 ) THEN
+ PRINT *,' usage : cdfcoloc -w root_weight -t gridT -trc TRC_file ...'
+ PRINT *,' ... -u gridU -v gridV [-l field list ] [-h]'
+ PRINT *,' -w root_weight : specify the root name of the weight files'
+ PRINT *,' _T.bin, _U.bin, or _V.bin will be appended '
+ PRINT *,' to name if necessary.'
+ PRINT *,' -t gridT file : name of gridT model file'
+ PRINT *,' -trc TRC file : name of gridT model file'
+ PRINT *,' -d diag file : name of specific diagnostic file '
+ PRINT *,' -u gridU file : name of gridU model file'
+ PRINT *,' -v gridV file : name of gridV model file'
+ PRINT *,' -b bathy file : name of etopo like bathymetric file'
+ PRINT *,' -l field list : list of fields to be colocated, separated by '','''
+ PRINT *,' Default list is :',TRIM(ctmplst0)
+ PRINT *,' -h : Give the details of available field to colocate.'
+ PRINT *,' Return a column ascii file id dep fields()'
+ PRINT *, TRIM(cn_fmsk),' is required in local directory'
+ PRINT *, TRIM(cn_fcoo),',',TRIM(cn_fzgr),' are also required for slope computation'
STOP
ENDIF
- CALL getarg (1, cweight_root )
- CALL getarg (2, cgridt )
- CALL getarg (3, cgridu )
- CALL getarg (4, cgridv )
+ iarg = 1
+ DO WHILE ( iarg <= narg )
+ CALL getarg ( iarg, cldum ) ; iarg = iarg + 1
+ SELECT CASE ( cldum )
+ CASE ('-w' ) ; CALL getarg ( iarg, cf_weight_root ) ; iarg = iarg + 1
+ CASE ('-t' ) ; CALL getarg ( iarg, cf_gridt ) ; iarg = iarg + 1
+ CASE ('-trc' ) ; CALL getarg ( iarg, cf_gridtrc ) ; iarg = iarg + 1
+ CASE ('-d' ) ; CALL getarg ( iarg, cf_diag ) ; iarg = iarg + 1
+ CASE ('-u' ) ; CALL getarg ( iarg, cf_gridu ) ; iarg = iarg + 1
+ CASE ('-v' ) ; CALL getarg ( iarg, cf_gridv ) ; iarg = iarg + 1
+ CASE ('-b' ) ; CALL getarg ( iarg, cf_bathy ) ; iarg = iarg + 1
+ CASE ('-l' ) ; CALL getarg ( iarg, ctmplst0 ) ; iarg = iarg + 1
+ CASE ('-h' ) ; CALL help_message
+ CASE DEFAULT ; PRINT *,TRIM(cldum),' : option not available.' ; STOP
+ END SELECT
+ ENDDO
- npiglo= getdim (cgridt,'x')
- npjglo= getdim (cgridt,'y')
- npk= getdim (cgridt,'depth')
+ ! intepret ctmplst0 to set up cltype list, ntype and build cf_out file name
+ CALL getfld( )
+
+ idum = INDEX(TRIM(cf_out),'.') - 1
+ IF ( idum == -1 ) THEN
+ idum = LEN_TRIM(cf_out)
+ ENDIF
+ cf_skip = cf_out(1:idum)//'_skip.txt'
+
+ WRITE(cf_weight_t,'(a,a,".bin")') TRIM(cf_weight_root), '_T'
+ WRITE(cf_weight_u,'(a,a,".bin")') TRIM(cf_weight_root), '_U'
+ WRITE(cf_weight_v,'(a,a,".bin")') TRIM(cf_weight_root), '_V'
+
+ ! Check if required files are available
+ llchk = .FALSE.
+
+ IF ( cf_bathy /= 'none' ) THEN ! dealing with special case of etopo file
+ llchk = llchk .OR. chkfile(cf_bathy )
+ IF (llchk ) STOP ! missing files
+ npiglo = getdim (cf_bathy,'lon')
+ npjglo = getdim (cf_bathy,'lat')
+ npk = 1
+ ELSE
+ llchk = llchk .OR. chkfile(cn_fmsk )
+ IF (llchk ) STOP ! missing files
+ npiglo = getdim (cn_fmsk,cn_x)
+ npjglo = getdim (cn_fmsk,cn_y)
+ npk = getdim (cn_fmsk,cn_z)
+ ENDIF
ALLOCATE (v3d(npiglo, npjglo, npk), mask(npiglo, npjglo, npk) )
- ALLOCATE (v2d(npiglo, npjglo), e(npiglo,npjglo) )
-
- ! open the weight (T) file for counting the moorings ( assumed that all
- ! weight file ( T U V ) have the same number of stations.
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- OPEN(numbin, FILE=cweight,FORM='unformatted')
- ! Determine the number of records in the weight file
- DO WHILE (1 /= 2 ) ! not able to use iostat here ... sorry
- READ(numbin, END=100)
- nid=nid+1
- END DO
-100 CONTINUE
- PRINT *, nid ,' stations to process...'
- CLOSE (numbin)
+ ALLOCATE (d2d(npiglo, npjglo ), de(npiglo,npjglo) )
- ! allocate result array
- ALLOCATE ( vinterp(nid,jptyp) )
! loop on all variables to collocate
- DO jtyp=1,jptyp
- cctyp=TRIM(ctype(jtyp))
+ DO jtyp=1,ntyp
+ cctyp=TRIM(cltype(jtyp))
! depending upon the type, set the weigth file, variable name, mask variable, data file
! vertical dimension of output variable and a scale factor
SELECT CASE ( cctyp)
CASE ('T') ! temperature, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='votemper' ; cvmask='tmask'
- cfil=cgridt
- npkv=npk
- scale=1.
+ cf_weight = cf_weight_t
+ cf_in = cf_gridt
+ cvar = cn_votemper
+ cvmask = 'tmask'
+ npkv = npk
+ dscale = 1.d0
CASE ('S') ! salinity, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='vosaline' ; cvmask='tmask'
- cfil=cgridt
- npkv=npk
- scale=1.
+ cf_weight = cf_weight_t
+ cf_in = cf_gridt
+ cvar = cn_vosaline
+ cvmask = 'tmask'
+ npkv = npk
+ dscale = 1.d0
CASE ('SSH') ! SSH, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='sossheig' ; cvmask='tmask'
- cfil=cgridt
- npkv=1
- scale=100.
+ cf_weight = cf_weight_t
+ cf_in = cf_gridt
+ cvar = cn_sossheig
+ cvmask = 'tmask'
+ npkv = 1
+ dscale = 100.d0
+ CASE ('CFCINV') ! CFC inventory, not used for Greg Holloway output
+ cf_weight = cf_weight_t
+ cf_in = cf_gridtrc
+ cvar = cn_invcfc
+ cvmask = 'tmask'
+ npkv = 1
+ dscale = 1000000.d0
+ CASE ('CFCCONC') ! CFC inventory, not used for Greg Holloway output
+ cf_weight = cf_weight_t
+ cf_in = cf_gridtrc
+ cvar = cn_cfc11
+ cvmask = 'tmask'
+ npkv = 1
+ dscale = 1.d0
+ CASE ('PENDEP') ! CFC penetration depth
+ cf_weight = cf_weight_t
+ cf_in = cf_diag
+ cvar = cn_pendep
+ cvmask = 'tmask'
+ npkv = 1
+ dscale = 1.d0
+ CASE ('MXL','MXL01' ) ! Mixed layer depth
+ cf_weight = cf_weight_t
+ cf_in = cf_gridt
+ cvar = cn_somxl010
+ cvmask = 'tmask'
+ npkv = 1
+ dscale = 1.d0
+ CASE ('MXLT02' ) ! Mixed layer depth
+ cf_weight = cf_weight_t
+ cf_in = cf_gridt
+ cvar = cn_somxlt02
+ cvmask = 'tmask'
+ npkv = 1
+ dscale = 1.d0
+ CASE ('ISOTHICK' ) ! Mixed layer depth
+ cf_weight = cf_weight_t
+ cf_in = cf_diag
+ cvar = cn_isothick
+ cvmask = 'tmask'
+ npkv = 1
+ dscale = 1.d0
CASE ('U') ! Zonal component of velocity
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_U'
- cvar='vozocrtx' ; cvmask='umask'
- cfil=cgridu
- npkv=npk
- scale=100. ! to be cm/s in the output
- CASE ('V') ! Meridional component of velocity
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_V'
- cvar='vomecrty' ; cvmask='vmask'
- cfil=cgridv
- npkv=npk
- scale=100. ! to be cm/s in the output
- CASE ('Sx') ! Zonal component of bottom slope
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_U'
- cfil='none' ; cvmask='umask'
- npkv=1
+ cf_weight = cf_weight_u
+ cf_in = cf_gridu
+ cvar = cn_vozocrtx
+ cvmask = 'umask'
+ npkv = npk
+ dscale = 100.d0 ! to be cm/s in the output
+ CASE ('V') ! Meridional component of velocity
+ cf_weight = cf_weight_v
+ cf_in = cf_gridv
+ cvar = cn_vomecrty
+ cvmask = 'vmask'
+ npkv = npk
+ dscale = 100.d0 ! to be cm/s in the output
+ CASE ('Sx') ! Zonal component of bottom slope
+ cf_weight = cf_weight_u
+ cf_in = 'none'
+ cvar = 'none'
+ cvmask = 'umask'
+ npkv = 1
+ dscale = 100.d0 ! to be in % in the output
+ llchk = llchk .OR. chkfile(cn_fcoo )
+ llchk = llchk .OR. chkfile(cn_fzgr )
+ IF ( llchk ) STOP
! Sx is the i-slope of bottom topog: read adequate metric
! and compute it on v3d(:,:,1)
- e(:,:)=getvar(coord,'e1u',1, npiglo,npjglo)
- v2d(:,:)=getvar(czgr,'hdepw',1, npiglo,npjglo)
+ de(:,:) = getvar(cn_fcoo, cn_ve1u, 1, npiglo, npjglo)
+ d2d(:,:) = getvar(cn_fzgr, 'hdepw', 1, npiglo, npjglo)
DO ji=2, npiglo-1
- v3d(ji,:,1)=(v2d(ji+1,:) -v2d(ji,:))/ e(ji,:)
+ v3d(ji,:,1) = (d2d(ji+1,:) - d2d(ji,:)) / de(ji,:)
END DO
- scale=100. ! to be in % in the output
CASE ('Sy') ! Meridional component of bottom slope
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_V'
- cfil='none' ; cvmask='vmask'
- npkv=1
+ cf_weight = cf_weight_v
+ cf_in = 'none'
+ cvar = 'none'
+ cvmask = 'vmask'
+ npkv = 1
+ dscale = 100.d0 ! to be in % in the output
+ llchk = llchk .OR. chkfile(cn_fcoo )
+ llchk = llchk .OR. chkfile(cn_fzgr )
+ IF ( llchk ) STOP
! Sy is the j-slope of bottom topog: read adequate metric
! and compute it on v3d(:,:,1)
- e(:,:)=getvar(coord,'e2v',1, npiglo,npjglo)
- v2d(:,:)=getvar(czgr,'hdepw',1, npiglo,npjglo)
+ de(:,:) = getvar(cn_fcoo, cn_ve2v, 1, npiglo, npjglo)
+ d2d(:,:) = getvar(cn_fzgr, 'hdepw', 1, npiglo, npjglo)
DO jj=2, npjglo-1
- v3d(:,jj,1)=(v2d(:,jj+1) -v2d(:,jj))/ e(:,jj)
+ v3d(:,jj,1) = (d2d(:,jj+1) - d2d(:,jj)) / de(:,jj)
END DO
- scale=100. ! to be in % in the output
CASE ('H') ! Bottom topography
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='hdepw' ; cvmask='tmask'
- cfil=czgr
- npkv=1
- scale=1.
+ cf_weight = cf_weight_t
+ cf_in = cn_fzgr
+ cvar = 'hdepw'
+ cvmask = 'tmask'
+ npkv = 1
+ dscale = 1.d0
+ CASE ('etopo') ! Bottom topography from external file
+ cf_weight = cf_weight_t
+ cf_in = cf_bathy
+ cvar = 'z'
+ cvmask = 'none'
+ npkv = 1
+ dscale = 1.d0
END SELECT
+ IF (chkfile (cf_weight) .OR. chkfile( cf_in) ) STOP ! missing file
+
! Now enter the generic processing
PRINT *,'START coloc for ', TRIM(cctyp)
- OPEN(numbin, FILE=cweight,FORM='unformatted')
+ IF (jtyp == 1 ) THEN ! count number of station and allocate dinterp
+ ! assuming weight file ( T U V ) have the same number of stations.
+ OPEN(numbin, FILE=cf_weight,FORM='unformatted')
+ ! Determine the number of records in the weight file
+ DO
+ READ(numbin, END=100)
+ nid=nid+1
+ END DO
+100 CONTINUE
+ CLOSE(numbin)
+
+ PRINT *, nid ,' stations to process...'
+ ! allocate result array
+ ALLOCATE ( dinterp(nid,ntyp) )
+ ENDIF
- IF (cfil /= 'none' ) THEN ! read data (except for Sx and Sy )
+ OPEN(numbin, FILE=cf_weight,FORM='unformatted')
+
+ IF (cf_in /= 'none' ) THEN ! read data (except for Sx and Sy )
DO jk=1, npkv
- v3d(:,:,jk)=getvar(cfil,cvar,jk, npiglo,npjglo)
+ v3d(:,:,jk)=getvar(cf_in,cvar,jk, npiglo,npjglo)
END DO
ENDIF
! read corresponding mask
- DO jk=1, npkv
- mask(:,:,jk)=getvar(cmask,cvmask,jk, npiglo,npjglo)
- END DO
+ IF ( cvmask == 'none' ) THEN ! special case of etopo files ( valid values are < 0 )
+ mask = 1
+ WHERE ( v3d >= 0 ) mask = 0
+ ELSE
+ DO jk=1, npkv
+ mask(:,:,jk)=getvar(cn_fmsk,cvmask,jk, npiglo,npjglo)
+ END DO
+ ENDIF
DO jid=1,nid
- READ(numbin) id, ymin, xmin, idep ,imin, jmin, kmin, iquadran, hN, alpha, beta, gamma
- vinterp(jid,jtyp)=interp()
+ READ(numbin) id, dymin, dxmin, idep ,nimin, njmin, nkmin, nquadran, dhN, dalpha, dbeta, dgama
+ dinterp(jid,jtyp)=interp()
! do not scale dummy values
- IF ( vinterp (jid,jtyp) > -990 ) vinterp (jid,jtyp) = vinterp (jid,jtyp) * scale
+ IF ( dinterp (jid,jtyp) > -99990.d0 ) dinterp (jid,jtyp) = dinterp (jid,jtyp) * dscale
END DO
CLOSE(numbin)
END DO ! Loop on type
- OPEN(numout ,FILE=cfilout)
- OPEN(numskip,FILE=cfilskip)
+ OPEN(numout, FILE=cf_out )
+ OPEN(numskip, FILE=cf_skip)
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- OPEN(numbin, FILE=cweight,FORM='unformatted')
+ ! need to re-read some informations from the weight file (idep, dhN)
+ cf_weight = cf_weight_t
+ OPEN(numbin, FILE=cf_weight, FORM='unformatted')
DO jid=1, nid ! loop on all stations
- READ(numbin) id, ymin, xmin, idep, imin, jmin, kmin, iquadran, hN
- IF ( xmin > 180.) xmin=xmin -360
- ! output only stations with no problems ( vinterp > -990 )
- zmin=MINVAL(vinterp(jid,:) )
- IF ( zmin > -990 ) THEN
+ READ(numbin) id, dymin, dxmin, idep, nimin, njmin, nkmin, nquadran, dhN
+ IF ( dxmin > 180.d0) dxmin = dxmin - 360.d0
+ ! output only stations with no problems ( dinterp > -99990 )
+ dlmin=MINVAL(dinterp(jid,:) )
+ IF ( dlmin > -99990.d0 ) THEN
! apply vector rotation to have results on the geographic reference system (N-S, E-W )
- CALL rotation( vinterp(jid,:), hN)
- WRITE(numout, '(I5, I6, 5f10.4)') id, idep, (vinterp(jid,jtyp),jtyp=1,jptyp)
+ IF ( nSx > 0 ) THEN ! (Sx, Sy pair )
+ CALL rotation( dinterp(jid,nSx), dinterp(jid,nSy), dhN)
+ ENDIF
+ IF ( nU > 0 ) THEN ! (U, V pair)
+ CALL rotation( dinterp(jid,nU), dinterp(jid,nV), dhN)
+ ENDIF
+ WRITE(numout, cformat) id, idep, (dinterp(jid,jtyp),jtyp=1,ntyp)
ELSE
! save discarted stations for control
- WRITE(numskip, '(I5, I6, 5f10.4)') id, idep, (vinterp(jid,jtyp),jtyp=1,jptyp)
+ WRITE(numskip, cformat) id, idep, (dinterp(jid,jtyp),jtyp=1,ntyp)
ENDIF
-END DO
-CLOSE(numbin)
-CLOSE(numout)
+ END DO
+ CLOSE(numbin)
+ CLOSE(numout)
PRINT *,' Done.'
CONTAINS
-FUNCTION interp ()
- REAL(KIND=8) :: interp
-
- ! skip out of domain stations
- IF (imin == -1000 ) THEN
- interp=-999.
- RETURN
- ENDIF
-
- ! choose the 4 interpolation points, according to sector and nearest point (imin, jmin)
- SELECT CASE (iquadran)
- CASE (1)
- i1=imin ; j1 = jmin
- i2=imin +1 ; j2 = jmin
- i3=imin +1 ; j3 = jmin + 1
- i4=imin ; j4 = jmin + 1
- CASE (2)
- i1=imin ; j1 = jmin
- i2=imin ; j2 = jmin - 1
- i3=imin +1 ; j3 = jmin - 1
- i4=imin +1 ; j4 = jmin
- CASE (3)
- i1=imin ; j1 = jmin
- i2=imin -1 ; j2 = jmin
- i3=imin -1 ; j3 = jmin - 1
- i4=imin ; j4 = jmin - 1
- CASE (4)
- i1=imin ; j1 = jmin
- i2=imin ; j2 = jmin + 1
- i3=imin -1 ; j3 = jmin + 1
- i4=imin -1 ; j4 = jmin
- END SELECT
-
- ! kmin is always above target point
- k1=kmin ; k2 = kmin + 1
-
- IF (npkv == 1 ) THEN ! 2D var, do not take care of vertical interpolation
- k1 = 1 ; k2 = 0 ; wdo = 0.
- ENDIF
-
- ! compute sum of masked weight above target point
- wup = mask(i1,j1,k1)*(1-alpha)*(1-beta) + mask(i2,j2,k1) * alpha *(1-beta) + &
- & mask(i3,j3,k1)*alpha*beta + mask(i4,j4,k1) * (1-alpha)*beta
-
- ! interpolate with non-masked values, above target point
- vup = v3d(i1,j1,k1)*(1-alpha)*(1-beta) + v3d(i2,j2,k1) * alpha *(1-beta) + &
- & v3d(i3,j3,k1)*alpha*beta + v3d(i4,j4,k1) * (1-alpha)*beta
-
- IF (k2 /= 0 ) THEN ! for 3D variables
- ! compute sum of masked weight below target point
- wdo = mask(i1,j1,k2)*(1-alpha)*(1-beta) + mask(i2,j2,k2) * alpha *(1-beta) + &
- & mask(i3,j3,k2)*alpha*beta + mask(i4,j4,k2) * (1-alpha)*beta
-
- ! interpolate with non-masked values, below target point
- vdo = v3d(i1,j1,k2)*(1-alpha)*(1-beta) + v3d(i2,j2,k2) * alpha *(1-beta) + &
- & v3d(i3,j3,k2)*alpha*beta + v3d(i4,j4,k2) * (1-alpha)*beta
- ENDIF
-
- IF ( wup == 0 ) THEN ! all points are masked
- interp=-999.
- ELSE IF ( wdo == 0 ) THEN ! all points below are masked, or 2D
- interp= vup/wup
- ELSE ! general case
- interp= (1 - gamma) * vup/wup + gamma * vdo/wdo
- ENDIF
-
-END FUNCTION interp
-
-SUBROUTINE rotation (pval, pcourse)
- ! This subroutine returns the input vectors on the geographical reference
- ! for vectors in the domain ( only those are processed in the main program)
- REAL(KIND=8), DIMENSION(jptyp), INTENT(inout) :: pval !: input vectors ( U V Sx Sy )
- REAL(KIND=8), INTENT(in) :: pcourse !: local direction of the I=cst lines with respect to N (deg)
-
- ! local variable
- REAL(KIND=8), DIMENSION(2) :: zcomp
- REAL(KIND=8) :: zconv, zcourse, zpi
-
- zpi=ACOS(-1.d0) ; zconv=zpi/180.d0
- zcourse=pcourse*zconv ! heading in radians
- ! Velocity : u=1, v=2
- zcomp(1:2)=pval(1:2)
- pval(1) = zcomp(1)*COS(zcourse) +zcomp(2)*SIN(zcourse)
- pval(2) = -zcomp(1)*SIN(zcourse) +zcomp(2)*COS(zcourse)
-
- ! Bottom slope : Sx=3, Sy=4
- zcomp(1:2)=pval(3:4)
- pval(3) = zcomp(1)*COS(zcourse) +zcomp(2)*SIN(zcourse)
- pval(4) = -zcomp(1)*SIN(zcourse) +zcomp(2)*COS(zcourse)
-
-END SUBROUTINE rotation
+ FUNCTION interp ()
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION interp ***
+ !!
+ !! ** Purpose : Perform spatial interpolation
+ !!
+ !! ** Method : Use the informations in weigth file to perform
+ !! bilinear interpolation
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=8) :: interp ! return value
+
+ INTEGER(KIND=4) :: ii1, ij1, ii2, ij2 ! working integers
+ INTEGER(KIND=4) :: ii3, ij3, ii4, ij4 ! working integers
+ INTEGER(KIND=4) :: ik1, ik2 ! working integers
+ !!----------------------------------------------------------------------
+ ! skip out of domain stations (flagged with nimin = -1000)
+ IF (nimin == -1000 ) THEN
+ interp=-99999.d0
+ RETURN
+ ENDIF
+
+ ! choose the 4 interpolation points, according to sector and nearest point (nimin, njmin)
+ SELECT CASE (nquadran)
+ CASE (1)
+ ii1=nimin ; ij1 = njmin
+ ii2=nimin +1 ; ij2 = njmin
+ ii3=nimin +1 ; ij3 = njmin + 1
+ ii4=nimin ; ij4 = njmin + 1
+ CASE (2)
+ ii1=nimin ; ij1 = njmin
+ ii2=nimin ; ij2 = njmin - 1
+ ii3=nimin +1 ; ij3 = njmin - 1
+ ii4=nimin +1 ; ij4 = njmin
+ CASE (3)
+ ii1=nimin ; ij1 = njmin
+ ii2=nimin -1 ; ij2 = njmin
+ ii3=nimin -1 ; ij3 = njmin - 1
+ ii4=nimin ; ij4 = njmin - 1
+ CASE (4)
+ ii1=nimin ; ij1 = njmin
+ ii2=nimin ; ij2 = njmin + 1
+ ii3=nimin -1 ; ij3 = njmin + 1
+ ii4=nimin -1 ; ij4 = njmin
+ END SELECT
+
+ ! nkmin is always above target point
+ ik1 = nkmin ; ik2 = nkmin + 1
+
+ IF (npkv == 1 ) THEN ! 2D var, do not take care of vertical interpolation
+ ik1 = 1 ; ik2 = 0 ; wdo = 0.
+ ENDIF
+
+ ! compute sum of masked weight above target point
+ wup = mask(ii1,ij1,ik1)*(1-dalpha)*(1-dbeta) + mask(ii2,ij2,ik1) * dalpha *(1-dbeta) + &
+ & mask(ii3,ij3,ik1)* dalpha*dbeta + mask(ii4,ij4,ik1) * (1-dalpha)*dbeta
+
+ ! interpolate with non-masked values, above target point
+ vup = v3d(ii1,ij1,ik1)*(1-dalpha)*(1-dbeta) + v3d(ii2,ij2,ik1) * dalpha *(1-dbeta) + &
+ & v3d(ii3,ij3,ik1)* dalpha*dbeta + v3d(ii4,ij4,ik1) * (1-dalpha)*dbeta
+
+ IF (ik2 /= 0 ) THEN ! for 3D variables
+ ! compute sum of masked weight below target point
+ wdo = mask(ii1,ij1,ik2)*(1-dalpha)*(1-dbeta) + mask(ii2,ij2,ik2) * dalpha *(1-dbeta) + &
+ & mask(ii3,ij3,ik2)* dalpha*dbeta + mask(ii4,ij4,ik2) * (1-dalpha)*dbeta
+
+ ! interpolate with non-masked values, below target point
+ vdo = v3d(ii1,ij1,ik2)*(1-dalpha)*(1-dbeta) + v3d(ii2,ij2,ik2) * dalpha *(1-dbeta) + &
+ & v3d(ii3,ij3,ik2)*dalpha*dbeta + v3d(ii4,ij4,ik2) * (1-dalpha)*dbeta
+ ENDIF
+
+ IF ( wup == 0 ) THEN ! all points are masked
+ interp=-99999.d0
+ ELSE IF ( wdo == 0 ) THEN ! all points below are masked, or 2D
+ interp= vup/wup
+ ELSE ! general case
+ interp= (1 - dgama) * vup/wup + dgama * vdo/wdo
+ ENDIF
+
+ END FUNCTION interp
+
+ SUBROUTINE rotation (ddu, ddv, ddcourse)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE rotation ***
+ !!
+ !! ** Purpose : This subroutine returns the input vectors on the
+ !! geographical reference
+ !!
+ !! ** Method : Projection acording to ddcourse (heading)
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=8), INTENT(inout) :: ddu ! input u component (along I)
+ REAL(KIND=8), INTENT(inout) :: ddv ! input v component (along J)
+ REAL(KIND=8), INTENT(in ) :: ddcourse ! local direction of the I=cst lines
+ ! ! with respect to N (deg).
+ REAL(KIND=8) :: dlu ! Local working variables
+ REAL(KIND=8) :: dlv ! Local working variables
+ REAL(KIND=8) :: dlconv ! "
+ REAL(KIND=8) :: dlcourse ! "
+ REAL(KIND=8) :: dlpi ! "
+ !!----------------------------------------------------------------------
+
+ dlpi = ACOS(-1.d0) ; dlconv = dlpi/180.d0
+ dlcourse = ddcourse*dlconv ! heading in radians
+ dlu = ddu ; dlv = ddv
+
+ ddu = dlu*COS(dlcourse) +dlv*SIN(dlcourse)
+ ddv = -dlu*SIN(dlcourse) +dlv*COS(dlcourse)
+ END SUBROUTINE rotation
+
+ SUBROUTINE getfld ()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE getfld ***
+ !!
+ !! ** Purpose : decipher ctmplst : looking for ',' separating field
+ !! count the number of field in ctmplst0 : ntyp
+ !! Set up pairing for vector components.
+ !! Initialize format output
+ !!
+ !! ** Method : use global variables
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4) :: jt
+ CHARACTER(LEN=256) :: cltmplst
+ !!----------------------------------------------------------------------
+
+ cltmplst = ctmplst0
+ ntyp = 1
+ idum = INDEX(cltmplst,',')
+
+ DO WHILE ( idum > 0 )
+ cltmplst=cltmplst(idum+1:)
+ idum=INDEX(cltmplst,',')
+ ntyp = ntyp + 1
+ ENDDO
+
+ ALLOCATE (cltype(ntyp) )
+ ! populates cltype with individual field
+ cltmplst = ctmplst0
+ DO jtyp = 1, ntyp
+ idum=INDEX(cltmplst,',')
+ IF (idum == 0 ) THEN
+ cltype(jtyp) = TRIM(cltmplst)
+ ELSE
+ cltype(jtyp) = cltmplst(1:idum-1)
+ ENDIF
+ cltmplst=cltmplst(idum+1:)
+ ENDDO
+
+ ! check if all fields are supported:
+ DO jtyp=1, ntyp
+ DO jt =1 , jptyp
+ IF ( cltype(jtyp) == ctype(jt) ) EXIT
+ ENDDO
+ IF ( jt == jptyp + 1 ) THEN
+ PRINT *, 'ERROR in field list :', TRIM(cltype(jtyp) ),' not supported'
+ STOP
+ ENDIF
+ ENDDO
+
+ ! locate pairing for vector variables
+ nSx = -1 ; nSy = -1
+ nU = -1 ; nV = -1
+ DO jtyp = 1, ntyp
+ IF ( cltype(jtyp) == 'Sx' ) nSx = jtyp
+ IF ( cltype(jtyp) == 'Sy' ) nSy = jtyp
+ IF ( cltype(jtyp) == 'U' ) nU = jtyp
+ IF ( cltype(jtyp) == 'V' ) nV = jtyp
+ END DO
+
+ IF ( nSx * nSy < 0 ) THEN
+ PRINT *, ' You must specify both Sx and Sy'
+ PRINT *, ' in order to perform rotation'
+ STOP
+ ENDIF
+ IF ( nU * nV < 0 ) THEN
+ PRINT *, ' You must specify both U and V'
+ PRINT *, ' in order to perform rotation'
+ STOP
+ ENDIF
+
+ ! build output file name
+ cf_out='iz'
+ DO jtyp=1, ntyp
+ cf_out=TRIM(cf_out)//'_'//TRIM(cltype(jtyp))
+ ENDDO
+ cf_out=TRIM(cf_out)//'.txt'
+
+ ! Build output format
+ WRITE(cformat,'(a,i2,a)') '(I5, I6,',ntyp,'e14.6)'
+
+ END SUBROUTINE getfld
+
+ SUBROUTINE help_message ()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE help_message ***
+ !!
+ !! ** Purpose : Print the list of available fields, and describes the
+ !! corresponding required input files
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=24), DIMENSION(jptyp) :: comments
+ CHARACTER(LEN=10), DIMENSION(jptyp) :: crequired
+ !!----------------------------------------------------------------------
+ PRINT *,' List of available field to process:'
+ PRINT *,'field name comments input files'
+
+
+ ! ctype = (/'T','S','SSH','CFCINV','CFCCONC','PENDEP','MXL','MXL01',
+ ! 'MXLT02','ISOTHICK','U ','V ','Sx','Sy','H ','etopo'/)
+ comments = (/' Potential temperature ', &
+ & ' Salinity ', &
+ & ' Sea Surface height ', &
+ & ' CFC inventory ', &
+ & ' CFC concentration ', &
+ & ' Penetration depth ', &
+ & ' Mixed layer depth s0.01', &
+ & ' Mixed layer depth s0.01', &
+ & ' Mixed layer depth t0.2 ', &
+ & ' Isopycnal thickness ', &
+ & ' Zonal velocity ', &
+ & ' Meridional velocity ', &
+ & ' Zonal bottom slope ', &
+ & ' Meridional bottom slope', &
+ & ' Local model bathymetry ', &
+ & ' etopo like bathymetry ' /)
+ crequired = (/' -t gridT ', &
+ & ' -t gridT ', &
+ & ' -t gridT ', &
+ & ' -trc TRC ', &
+ & ' -trc TRC ', &
+ & ' -d diag ', &
+ & ' -t gridT ', &
+ & ' -t gridT ', &
+ & ' -t gridT ', &
+ & ' -d diag ', &
+ & ' -u gridU ', &
+ & ' -v gridV ', &
+ & ' zgr coord', &
+ & ' zgr coord', &
+ & ' zgr ', &
+ & ' -b etopo ' /)
+
+ DO jtyp=1, jptyp
+ PRINT '( 12a,x,24a,x,10a)', ctype(jtyp), comments(jtyp), crequired(jtyp)
+ ENDDO
+ STOP
+
+ END SUBROUTINE help_message
END PROGRAM cdfcoloc
diff --git a/cdfcoloc2.f90 b/cdfcoloc2.f90
deleted file mode 100644
index a1024f1..0000000
--- a/cdfcoloc2.f90
+++ /dev/null
@@ -1,332 +0,0 @@
-PROGRAM cdfcoloc
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfcoloc ***
- !!
- !! ** Purpose : colocalisation for Greg Holloway
- !!
- !! ** Method : Use the weight files computed with cdfweight
- !!
- !! history ;
- !! Original : J.M. Molines (16 may 2007 )
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER, PARAMETER :: jptyp=1 !: number of type to produce ( look to ctype)
- INTEGER :: narg, iargc
- INTEGER :: ji,jj, jk, jid, jtyp !: dummy loop index
- INTEGER :: i1, j1, i2, j2, i3, j3, i4, j4, k1, k2 !: working integers
- INTEGER :: nid = 0 !: mooring counter initialize to 0
- INTEGER :: npiglo, npjglo, npk !: grid size of the model
- INTEGER :: npkv !: vertical dimension of the target variable (either 1 (2D) or npk (3D)
- INTEGER :: numbin=20, numout=30, numskip=31 !: logical unit for I/O files other than NetCdf
- REAL(KIND=8) :: zmin
-
- ! variables in the weight file, 1 record per mooring
- INTEGER :: id
- INTEGER :: imin, jmin, kmin !: location of horizontal nearest point, vertical above target.
- INTEGER :: iquadran !: grid sector from 1 to 4 (clockwise, 1=NE) in wich target point
- ! is located with respect to nearest point
- REAL(KIND=8) :: xmin, ymin
- REAL(KIND=8) :: alpha, beta, gamma, hN, scale
-
- REAL(KIND=4) :: dep
- REAL(KIND=4) :: vup, vdo, wup, wdo !: Working variables
- REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d !: 3D !! working variable
- REAL(KIND=8), DIMENSION(:,:) , ALLOCATABLE :: v2d, e !: 2D working variable and horizontal metric
- REAL(KIND=8), DIMENSION(:,:) , ALLOCATABLE :: vinterp !: result array (nid,jptyp)
-
- INTEGER(KIND=2), DIMENSION(:,:,:), ALLOCATABLE :: mask !: 3D working mask
-
- ! file name
- CHARACTER(LEN=256) :: coord='coordinates.nc', czgr='mesh_zgr.nc', cmask='mask.nc', cfilout='izcfcinv.txt'
- CHARACTER(LEN=256) :: cfilskip='izUVSxSyH_skip.txt'
- CHARACTER(LEN=256) :: cweight,cweight_root, cgridt, cgridu, cgridv, cfil
- ! Variable type and name
- CHARACTER(LEN=256) :: cctyp, cvar, cvmask !: current mooring
- CHARACTER(LEN=10), DIMENSION(jptyp) :: ctype !: all jptyp defined there
-
- !!
-! ctype=(/'CFCCONC'/)
- ctype=(/'CFCINV'/)
-! ctype=(/'PENDEP'/)
-! ctype=(/'MXL'/)
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg /= 2 ) THEN
- PRINT *,' Usage : cdfcoloc root_weight gridT '
- PRINT *,' return an ascii file izcfcinv.txt (N x 7 )'
- PRINT *,' Example : cdfcoloc weight gridT'
- PRINT *,' coordinates.nc, mesh_zgr.nc, mask.nc required in local directory'
- STOP
- ENDIF
-
- CALL getarg (1, cweight_root )
- CALL getarg (2, cgridt )
-
- npiglo= getdim (cgridt,'x')
- npjglo= getdim (cgridt,'y')
- npk= getdim (cgridt,'depth')
- print *, 'npk=',npk
-
- ALLOCATE (v3d(npiglo, npjglo, npk), mask(npiglo, npjglo, npk) )
- ALLOCATE (v2d(npiglo, npjglo), e(npiglo,npjglo) )
-
- ! open the weight (T) file for counting the moorings ( assumed that all
- ! weight file ( T U V ) have the same number of stations.
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- OPEN(numbin, FILE=cweight,FORM='unformatted')
- ! Determine the number of records in the weight file
- DO WHILE (1 /= 2 ) ! not able to use iostat here ... sorry
- READ(numbin, END=100)
- nid=nid+1
- END DO
-100 CONTINUE
- PRINT *, nid ,' stations to process...'
- CLOSE (numbin)
-
- ! allocate result array
- ALLOCATE ( vinterp(nid,jptyp) )
-
- ! loop on all variables to collocate
- DO jtyp=1,jptyp
- cctyp=TRIM(ctype(jtyp))
-
- ! depending upon the type, set the weigth file, variable name, mask variable, data file
- ! vertical dimension of output variable and a scale factor
- SELECT CASE ( cctyp)
- CASE ('T') ! temperature, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='votemper' ; cvmask='tmask'
- cfil=cgridt
- npkv=npk
- scale=1.
- CASE ('S') ! salinity, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='vosaline' ; cvmask='tmask'
- cfil=cgridt
- npkv=npk
- scale=1.
- CASE ('SSH') ! SSH, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='sossheig' ; cvmask='tmask'
- cfil=cgridt
- npkv=1
- scale=100.
- CASE ('CFCINV') ! CFC inventory, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='invcfc' ; cvmask='tmask'
- cfil=cgridt
- npkv=1
- scale=1000000.
- CASE ('CFCCONC') ! CFC inventory, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='cfc11' ; cvmask='tmask'
- cfil=cgridt
- npkv=npk
- scale=1.
- CASE ('PENDEP') ! CFC inventory, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='pendep' ; cvmask='tmask'
- cfil=cgridt
- npkv=1
- scale=1.
- CASE ('MXL') ! Mixed layer depth
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='somxl010' ; cvmask='tmask'
-! cvar='somxlt02' ; cvmask='tmask'
- cfil=cgridt
- npkv=1
- scale=1.
- CASE ('U') ! Zonal component of velocity
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_U'
- cvar='vozocrtx' ; cvmask='umask'
- cfil=cgridu
- npkv=npk
- scale=100. ! to be cm/s in the output
- CASE ('V') ! Meridional component of velocity
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_V'
- cvar='vomecrty' ; cvmask='vmask'
- cfil=cgridv
- npkv=npk
- scale=100. ! to be cm/s in the output
- CASE ('Sx') ! Zonal component of bottom slope
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_U'
- cfil='none' ; cvmask='umask'
- npkv=1
- ! Sx is the i-slope of bottom topog: read adequate metric
- ! and compute it on v3d(:,:,1)
- e(:,:)=getvar(coord,'e1u',1, npiglo,npjglo)
- v2d(:,:)=getvar(czgr,'hdepw',1, npiglo,npjglo)
- DO ji=2, npiglo-1
- v3d(ji,:,1)=(v2d(ji+1,:) -v2d(ji,:))/ e(ji,:)
- END DO
- scale=100. ! to be in % in the output
- CASE ('Sy') ! Meridional component of bottom slope
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_V'
- cfil='none' ; cvmask='vmask'
- npkv=1
- ! Sy is the j-slope of bottom topog: read adequate metric
- ! and compute it on v3d(:,:,1)
- e(:,:)=getvar(coord,'e2v',1, npiglo,npjglo)
- v2d(:,:)=getvar(czgr,'hdepw',1, npiglo,npjglo)
- DO jj=2, npjglo-1
- v3d(:,jj,1)=(v2d(:,jj+1) -v2d(:,jj))/ e(:,jj)
- END DO
- scale=100. ! to be in % in the output
- CASE ('H') ! Bottom topography
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='hdepw' ; cvmask='tmask'
- cfil=czgr
- npkv=1
- scale=1.
- END SELECT
-
- ! Now enter the generic processing
- PRINT *,'START coloc for ', TRIM(cctyp), npkv
- OPEN(numbin, FILE=cweight,FORM='unformatted')
-
- IF (cfil /= 'none' ) THEN ! read data (except for Sx and Sy )
- DO jk=1, npkv
- v3d(:,:,jk)=getvar(cfil,cvar,jk, npiglo,npjglo)
- END DO
- ENDIF
-
- ! read corresponding mask
- DO jk=1, npkv
- mask(:,:,jk)=getvar(cmask,cvmask,jk, npiglo,npjglo)
- END DO
-
- DO jid=1,nid
- READ(numbin) id, ymin, xmin, dep ,imin, jmin, kmin, iquadran, hN, alpha, beta, gamma
- vinterp(jid,jtyp)=interp()
- ! do not scale dummy values
- IF ( vinterp (jid,jtyp) > -990 ) vinterp (jid,jtyp) = vinterp (jid,jtyp) * scale
- END DO
-
- CLOSE(numbin)
- END DO ! Loop on type
-
- OPEN(numout ,FILE=cfilout)
- OPEN(numskip,FILE=cfilskip)
-
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- OPEN(numbin, FILE=cweight,FORM='unformatted')
- DO jid=1, nid ! loop on all stations
- READ(numbin) id, ymin, xmin, dep, imin, jmin, kmin, iquadran, hN
- IF ( xmin > 180.) xmin=xmin -360
- ! output only stations with no problems ( vinterp > -990 )
- zmin=MINVAL(vinterp(jid,:) )
-! IF ( zmin > -990 ) THEN
- WRITE(numout, '(I5, F8.1, 3x, e9.3)') id, dep, (vinterp(jid,jtyp),jtyp=1,jptyp)
-! ELSE
- ! save discarted stations for control
-! WRITE(numskip, '(I5, F8.1,3x, e9.3)') id, dep, (vinterp(jid,jtyp),jtyp=1,jptyp)
-! ENDIF
-END DO
-CLOSE(numbin)
-CLOSE(numout)
-
- PRINT *,' Done.'
-
-CONTAINS
-
-FUNCTION interp ()
- REAL(KIND=8) :: interp
-
- ! skip out of domain stations
- IF (imin == -1000 ) THEN
- interp=-999.
- RETURN
- ENDIF
-
- ! choose the 4 interpolation points, according to sector and nearest point (imin, jmin)
- SELECT CASE (iquadran)
- CASE (1)
- i1=imin ; j1 = jmin
- i2=imin +1 ; j2 = jmin
- i3=imin +1 ; j3 = jmin + 1
- i4=imin ; j4 = jmin + 1
- CASE (2)
- i1=imin ; j1 = jmin
- i2=imin ; j2 = jmin - 1
- i3=imin +1 ; j3 = jmin - 1
- i4=imin +1 ; j4 = jmin
- CASE (3)
- i1=imin ; j1 = jmin
- i2=imin -1 ; j2 = jmin
- i3=imin -1 ; j3 = jmin - 1
- i4=imin ; j4 = jmin - 1
- CASE (4)
- i1=imin ; j1 = jmin
- i2=imin ; j2 = jmin + 1
- i3=imin -1 ; j3 = jmin + 1
- i4=imin -1 ; j4 = jmin
- END SELECT
-
- ! kmin is always above target point
- k1=kmin ; k2 = kmin + 1
-
- IF (npkv == 1 ) THEN ! 2D var, do not take care of vertical interpolation
- k1 = 1 ; k2 = 0 ; wdo = 0.
- ENDIF
-
- ! compute sum of masked weight above target point
- wup = mask(i1,j1,k1)*(1-alpha)*(1-beta) + mask(i2,j2,k1) * alpha *(1-beta) + &
- & mask(i3,j3,k1)*alpha*beta + mask(i4,j4,k1) * (1-alpha)*beta
-
- ! interpolate with non-masked values, above target point
- vup = v3d(i1,j1,k1)*(1-alpha)*(1-beta) + v3d(i2,j2,k1) * alpha *(1-beta) + &
- & v3d(i3,j3,k1)*alpha*beta + v3d(i4,j4,k1) * (1-alpha)*beta
-
- IF (k2 /= 0 ) THEN ! for 3D variables
- ! compute sum of masked weight below target point
- wdo = mask(i1,j1,k2)*(1-alpha)*(1-beta) + mask(i2,j2,k2) * alpha *(1-beta) + &
- & mask(i3,j3,k2)*alpha*beta + mask(i4,j4,k2) * (1-alpha)*beta
-
- ! interpolate with non-masked values, below target point
- vdo = v3d(i1,j1,k2)*(1-alpha)*(1-beta) + v3d(i2,j2,k2) * alpha *(1-beta) + &
- & v3d(i3,j3,k2)*alpha*beta + v3d(i4,j4,k2) * (1-alpha)*beta
- ENDIF
-
- IF ( wup == 0 ) THEN ! all points are masked
- interp=-999.
- ELSE IF ( wdo == 0 ) THEN ! all points below are masked, or 2D
- interp= vup/wup
- ELSE ! general case
- interp= (1 - gamma) * vup/wup + gamma * vdo/wdo
- ENDIF
-
-END FUNCTION interp
-
-SUBROUTINE rotation (pval, pcourse)
- ! This subroutine returns the input vectors on the geographical reference
- ! for vectors in the domain ( only those are processed in the main program)
- REAL(KIND=8), DIMENSION(jptyp), INTENT(inout) :: pval !: input vectors ( U V Sx Sy )
- REAL(KIND=8), INTENT(in) :: pcourse !: local direction of the I=cst lines with respect to N (deg)
-
- ! local variable
- REAL(KIND=8), DIMENSION(2) :: zcomp
- REAL(KIND=8) :: zconv, zcourse, zpi
-
- zpi=ACOS(-1.d0) ; zconv=zpi/180.d0
- zcourse=pcourse*zconv ! heading in radians
- ! Velocity : u=1, v=2
- zcomp(1:2)=pval(1:2)
- pval(1) = zcomp(1)*COS(zcourse) +zcomp(2)*SIN(zcourse)
- pval(2) = -zcomp(1)*SIN(zcourse) +zcomp(2)*COS(zcourse)
-
- ! Bottom slope : Sx=3, Sy=4
- zcomp(1:2)=pval(3:4)
- pval(3) = zcomp(1)*COS(zcourse) +zcomp(2)*SIN(zcourse)
- pval(4) = -zcomp(1)*SIN(zcourse) +zcomp(2)*COS(zcourse)
-
-END SUBROUTINE rotation
-
-END PROGRAM cdfcoloc
diff --git a/cdfcoloc2D.f90 b/cdfcoloc2D.f90
deleted file mode 100644
index dc7364f..0000000
--- a/cdfcoloc2D.f90
+++ /dev/null
@@ -1,239 +0,0 @@
-PROGRAM cdfcoloc2D
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfcoloc2D ***
- !!
- !! ** Purpose : colocalisation for Greg Holloway
- !!
- !! ** Method : Use the weight files computed with cdfweight
- !!
- !! history ;
- !! Original : J.M. Molines (16 may 2007 )
- !!-------------------------------------------------------------------
- !! $Rev: 62 $
- !! $Date: 2007-05-18 16:31:17 +0200 (Fri, 18 May 2007) $
- !! $Id: cdfcoloc.f90 62 2007-05-18 14:31:17Z molines $
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER, PARAMETER :: jptyp=1 !: number of type to produce ( look to ctype)
- INTEGER :: narg, iargc
- INTEGER :: ji,jj, jk, jid, jtyp !: dummy loop index
- INTEGER :: i1, j1, i2, j2, i3, j3, i4, j4, k1, k2 !: working integers
- INTEGER :: nid = 0 !: mooring counter initialize to 0
- INTEGER :: npiglo, npjglo, npk !: grid size of the model
- INTEGER :: npkv !: vertical dimension of the target variable (either 1 (2D) or npk (3D)
- INTEGER :: numbin=20, numout=30, numskip=31 !: logical unit for I/O files other than NetCdf
- REAL(KIND=8) :: zmin
-
- ! variables in the weight file, 1 record per mooring
- INTEGER :: id
- INTEGER :: imin, jmin, kmin !: location of horizontal nearest point, vertical above target.
- INTEGER :: iquadran !: grid sector from 1 to 4 (clockwise, 1=NE) in wich target point
- ! is located with respect to nearest point
- REAL(KIND=8) :: xmin, ymin
- REAL(KIND=8) :: alpha, beta, gamma, hN, scale
-
- REAL(KIND=4) :: dep !: Working variables
- REAL(KIND=4) :: vup, vdo, wup, wdo !: Working variables
- REAL(KIND=8), DIMENSION(:,:) , ALLOCATABLE :: v2d, e !: 2D working variable and horizontal metric
- REAL(KIND=8), DIMENSION(:,:) , ALLOCATABLE :: vinterp !: result array (nid,jptyp)
-
- INTEGER(KIND=2), DIMENSION(:,:), ALLOCATABLE :: mask !: 3D working mask
-
- ! file name
- CHARACTER(LEN=80) :: coord='coordinates.nc', czgr='mesh_zgr.nc', cmask='mask.nc', cfilout='izb.txt'
- CHARACTER(LEN=80) :: cfilskip='izb_skip.txt'
- CHARACTER(LEN=80) :: cweight,cweight_root, cgridt, cgridu, cgridv, cfil
- ! Variable type and name
- CHARACTER(LEN=80) :: cctyp, cvar, cvmask !: current mooring
- CHARACTER(LEN=3), DIMENSION(jptyp) :: ctype !: all jptyp defined there
-
- !!
- ctype=(/'H'/)
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg /= 2 ) THEN
- PRINT *,' Usage : cdfcoloc2D root_weight 2D_T_file '
- PRINT *,' return an ascii file izb.txt (N x 3 )'
- PRINT *,' Example : cdfcoloc2D weight etopo1.nc '
- PRINT *,' coordinates.nc, required in local directory'
- STOP
- ENDIF
-
- CALL getarg (1, cweight_root )
- CALL getarg (2, cgridt )
-
- npiglo= getdim (cgridt,'lon')
- npjglo= getdim (cgridt,'lat')
- PRINT *, 'NPIGLO = ', npiglo
- PRINT *, 'NPJGLO = ', npjglo
-
- ALLOCATE (mask(npiglo, npjglo) )
- ALLOCATE (v2d(npiglo, npjglo), e(npiglo,npjglo) )
-
- ! open the weight (T) file for counting the moorings ( assumed that all
- ! weight file ( T U V ) have the same number of stations.
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- OPEN(numbin, FILE=cweight,FORM='unformatted')
- ! Determine the number of records in the weight file
- DO WHILE (1 /= 2 ) ! not able to use iostat here ... sorry
- READ(numbin, END=100)
- nid=nid+1
- END DO
-100 CONTINUE
- PRINT *, nid ,' stations to process...'
- CLOSE (numbin)
-
- ! allocate result array
- ALLOCATE ( vinterp(nid,jptyp) )
-
- ! loop on all variables to collocate
- DO jtyp=1,jptyp
- cctyp=TRIM(ctype(jtyp))
-
- ! depending upon the type, set the weigth file, variable name, mask variable, data file
- ! vertical dimension of output variable and a scale factor
- SELECT CASE ( cctyp)
- CASE ('H') ! Bottom topography
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='z'
- cfil=cgridt
- npkv=1
- scale=1.
- END SELECT
-
- ! Now enter the generic processing
- PRINT *,'START coloc2D for ', TRIM(cctyp)
- OPEN(numbin, FILE=cweight,FORM='unformatted')
-
- IF (cfil /= 'none' ) THEN ! read data (except for Sx and Sy )
- v2d(:,:)=getvar(cfil,cvar,1, npiglo,npjglo)
- ENDIF
-
- ! compute corresponding mask
- mask = 1
- WHERE ( v2d >= 0 ) mask = 0
-
- DO jid=1,nid
-
- READ(numbin) id, ymin, xmin, dep ,imin, jmin, kmin, iquadran, hN, alpha, beta, gamma
- vinterp(jid,jtyp)=interp()
- ! do not scale dummy values
- IF ( vinterp (jid,jtyp) > -99990 ) vinterp (jid,jtyp) = vinterp (jid,jtyp) * scale
- END DO
-
- CLOSE(numbin)
- END DO ! Loop on type
-
- OPEN(numout ,FILE=cfilout)
- OPEN(numskip,FILE=cfilskip)
-
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- OPEN(numbin, FILE=cweight,FORM='unformatted')
- DO jid=1, nid ! loop on all stations
- READ(numbin) id, ymin, xmin, dep, imin, jmin, kmin, iquadran, hN
- print *, id,ymin, xmin, dep
- IF ( xmin > 180.) xmin=xmin -360
- ! output only stations with no problems ( vinterp > -99990 )
- zmin=MINVAL(vinterp(jid,:) )
- IF ( zmin > -99990 ) THEN
- WRITE(numout, '(I5, 6f10.1)') id, dep, (vinterp(jid,jtyp),jtyp=1,jptyp)
- ELSE
- ! save discarted stations for control
- WRITE(numskip, '(I5, 6f10.1)') id, dep, (vinterp(jid,jtyp),jtyp=1,jptyp)
- ENDIF
-END DO
-CLOSE(numbin)
-CLOSE(numout)
-
- PRINT *,' Done.'
-
-CONTAINS
-
-FUNCTION interp ()
- REAL(KIND=8) :: interp
-
- ! skip out of domain stations
- IF (imin == -1000 ) THEN
- interp=-99999
- RETURN
- ENDIF
-
- ! choose the 4 interpolation points, according to sector and nearest point (imin, jmin)
- SELECT CASE (iquadran)
- CASE (1)
- i1=imin ; j1 = jmin
- i2=imin +1 ; j2 = jmin
- i3=imin +1 ; j3 = jmin + 1
- i4=imin ; j4 = jmin + 1
- CASE (2)
- i1=imin ; j1 = jmin
- i2=imin ; j2 = jmin - 1
- i3=imin +1 ; j3 = jmin - 1
- i4=imin +1 ; j4 = jmin
- CASE (3)
- i1=imin ; j1 = jmin
- i2=imin -1 ; j2 = jmin
- i3=imin -1 ; j3 = jmin - 1
- i4=imin ; j4 = jmin - 1
- CASE (4)
- i1=imin ; j1 = jmin
- i2=imin ; j2 = jmin + 1
- i3=imin -1 ; j3 = jmin + 1
- i4=imin -1 ; j4 = jmin
- END SELECT
-
- ! kmin is always above target point
- k1=kmin ; k2 = kmin + 1
-
- IF (npkv == 1 ) THEN ! 2D var, do not take care of vertical interpolation
- k1 = 1 ; k2 = 0 ; wdo = 0.
- ENDIF
-
- ! compute sum of masked weight above target point
- wup = mask(i1,j1)*(1-alpha)*(1-beta) + mask(i2,j2) * alpha *(1-beta) + &
- & mask(i3,j3)*alpha*beta + mask(i4,j4) * (1-alpha)*beta
-
- ! interpolate with non-masked values, above target point
- vup = v2d(i1,j1)*(1-alpha)*(1-beta) + v2d(i2,j2) * alpha *(1-beta) + &
- & v2d(i3,j3)*alpha*beta + v2d(i4,j4) * (1-alpha)*beta
-
-
- IF ( wup == 0 ) THEN ! all points are masked
- interp=-99999.
- ELSE IF ( wdo == 0 ) THEN ! all points below are masked, or 2D
- interp= vup/wup
- ELSE ! general case
- interp= (1 - gamma) * vup/wup + gamma * vdo/wdo
- ENDIF
-
-END FUNCTION interp
-
-SUBROUTINE rotation (pval, pcourse)
- ! This subroutine returns the input vectors on the geographical reference
- ! for vectors in the domain ( only those are processed in the main program)
- REAL(KIND=8), DIMENSION(jptyp), INTENT(inout) :: pval !: input vectors ( U V Sx Sy )
- REAL(KIND=8), INTENT(in) :: pcourse !: local direction of the I=cst lines with respect to N (deg)
-
- ! local variable
- REAL(KIND=8), DIMENSION(2) :: zcomp
- REAL(KIND=8) :: zconv, zcourse, zpi
-
- zpi=ACOS(-1.d0) ; zconv=zpi/180.d0
- zcourse=pcourse*zconv ! heading in radians
- ! Velocity : u=1, v=2
- zcomp(1:2)=pval(1:2)
- pval(1) = zcomp(1)*COS(zcourse) +zcomp(2)*SIN(zcourse)
- pval(2) = -zcomp(1)*SIN(zcourse) +zcomp(2)*COS(zcourse)
-
- ! Bottom slope : Sx=3, Sy=4
- zcomp(1:2)=pval(3:4)
- pval(3) = zcomp(1)*COS(zcourse) +zcomp(2)*SIN(zcourse)
- pval(4) = -zcomp(1)*SIN(zcourse) +zcomp(2)*COS(zcourse)
-
-END SUBROUTINE rotation
-
-END PROGRAM cdfcoloc2D
diff --git a/cdfcoloc3.f90 b/cdfcoloc3.f90
deleted file mode 100644
index b7567e9..0000000
--- a/cdfcoloc3.f90
+++ /dev/null
@@ -1,345 +0,0 @@
-PROGRAM cdfcoloc
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfcoloc ***
- !!
- !! ** Purpose : colocalisation for Greg Holloway
- !!
- !! ** Method : Use the weight files computed with cdfweight
- !!
- !! history ;
- !! Original : J.M. Molines (16 may 2007 )
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER, PARAMETER :: jptyp=1 !: number of type to produce ( look to ctype)
- INTEGER :: narg, iargc
- INTEGER :: ji,jj, jk, jid, jtyp !: dummy loop index
- INTEGER :: i1, j1, i2, j2, i3, j3, i4, j4, k1, k2 !: working integers
- INTEGER :: nid = 0 !: mooring counter initialize to 0
- INTEGER :: npiglo, npjglo, npk !: grid size of the model
- INTEGER :: npkv !: vertical dimension of the target variable (either 1 (2D) or npk (3D)
- INTEGER :: numbin=20, numout=30, numskip=31 !: logical unit for I/O files other than NetCdf
- REAL(KIND=8) :: zmin
-
- ! variables in the weight file, 1 record per mooring
- INTEGER :: id
- INTEGER :: imin, jmin, kmin !: location of horizontal nearest point, vertical above target.
- INTEGER :: iquadran !: grid sector from 1 to 4 (clockwise, 1=NE) in wich target point
- ! is located with respect to nearest point
- REAL(KIND=8) :: xmin, ymin
- REAL(KIND=8) :: alpha, beta, gamma, hN, scale
-
- REAL(KIND=4) :: dep
- REAL(KIND=4) :: vup, vdo, wup, wdo !: Working variables
- REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d !: 3D !! working variable
- REAL(KIND=8), DIMENSION(:,:) , ALLOCATABLE :: v2d, e !: 2D working variable and horizontal metric
- REAL(KIND=8), DIMENSION(:,:) , ALLOCATABLE :: vinterp !: result array (nid,jptyp)
-
- INTEGER(KIND=2), DIMENSION(:,:,:), ALLOCATABLE :: mask !: 3D working mask
-
- ! file name
- CHARACTER(LEN=256) :: coord='coordinates.nc', czgr='mesh_zgr.nc', cmask='mask.nc', cfilout='izcfcinv.txt'
- CHARACTER(LEN=256) :: cfilskip='izUVSxSyH_skip.txt'
- CHARACTER(LEN=256) :: cweight,cweight_root, cgridt, cgridu, cgridv, cfil
- ! Variable type and name
- CHARACTER(LEN=256) :: cctyp, cvar, cvmask !: current mooring
- CHARACTER(LEN=10), DIMENSION(jptyp) :: ctype !: all jptyp defined there
-
- !!
-! ctype=(/'CFCCONC'/)
-! ctype=(/'PENDEP'/)
-! ctype=(/'MXL'/)
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg /= 3 ) THEN
- PRINT *,' Usage : cdfcoloc root_weight gridT ctype'
- PRINT *,' return an ascii file izcfcinv.txt (N x 7 )'
- PRINT *,' Example : cdfcoloc weight gridT PENDEP'
- PRINT *,' coordinates.nc, mesh_zgr.nc, mask.nc required in local directory'
- PRINT *,' ctype is one of : CFCCONC PENDEP MXL01 MXLT02 isothick '
- STOP
- ENDIF
-
- CALL getarg (1, cweight_root )
- CALL getarg (2, cgridt )
- CALL getarg (3, ctype (1))
-
- npiglo= getdim (cgridt,'x')
- npjglo= getdim (cgridt,'y')
- npk= getdim (cgridt,'depth')
- print *, 'npk=',npk
-
- ALLOCATE (v3d(npiglo, npjglo, npk), mask(npiglo, npjglo, npk) )
- ALLOCATE (v2d(npiglo, npjglo), e(npiglo,npjglo) )
-
- ! open the weight (T) file for counting the moorings ( assumed that all
- ! weight file ( T U V ) have the same number of stations.
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- OPEN(numbin, FILE=cweight,FORM='unformatted')
- ! Determine the number of records in the weight file
- DO WHILE (1 /= 2 ) ! not able to use iostat here ... sorry
- READ(numbin, END=100)
- nid=nid+1
- END DO
-100 CONTINUE
- PRINT *, nid ,' stations to process...'
- CLOSE (numbin)
-
- ! allocate result array
- ALLOCATE ( vinterp(nid,jptyp) )
-
- ! loop on all variables to collocate
- DO jtyp=1,jptyp
- cctyp=TRIM(ctype(jtyp))
-
- ! depending upon the type, set the weigth file, variable name, mask variable, data file
- ! vertical dimension of output variable and a scale factor
- SELECT CASE ( cctyp)
- CASE ('T') ! temperature, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='votemper' ; cvmask='tmask'
- cfil=cgridt
- npkv=npk
- scale=1.
- CASE ('S') ! salinity, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='vosaline' ; cvmask='tmask'
- cfil=cgridt
- npkv=npk
- scale=1.
- CASE ('SSH') ! SSH, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='sossheig' ; cvmask='tmask'
- cfil=cgridt
- npkv=1
- scale=100.
- CASE ('CFCINV') ! CFC inventory, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='invcfc' ; cvmask='tmask'
- cfil=cgridt
- npkv=1
- scale=1000000.
- CASE ('CFCCONC') ! CFC inventory, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='cfc11' ; cvmask='tmask'
- cfil=cgridt
- npkv=npk
- scale=1.
- CASE ('PENDEP') ! CFC inventory, not used for Greg Holloway output
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='pendep' ; cvmask='tmask'
- cfil=cgridt
- npkv=1
- scale=1.
- CASE ('MXL01') ! Mixed layer depth
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='somxl010' ; cvmask='tmask'
-! cvar='somxlt02' ; cvmask='tmask'
- cfil=cgridt
- npkv=1
- scale=1.
- CASE ('MXLT02') ! Mixed layer depth
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='somxlt02' ; cvmask='tmask'
- cfil=cgridt
- npkv=1
- scale=1.
- CASE ('ISOTHICK') ! Mixed layer depth
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='isothick' ; cvmask='tmask'
- cfil=cgridt
- npkv=1
- scale=1.
- CASE ('U') ! Zonal component of velocity
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_U'
- cvar='vozocrtx' ; cvmask='umask'
- cfil=cgridu
- npkv=npk
- scale=100. ! to be cm/s in the output
- CASE ('V') ! Meridional component of velocity
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_V'
- cvar='vomecrty' ; cvmask='vmask'
- cfil=cgridv
- npkv=npk
- scale=100. ! to be cm/s in the output
- CASE ('Sx') ! Zonal component of bottom slope
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_U'
- cfil='none' ; cvmask='umask'
- npkv=1
- ! Sx is the i-slope of bottom topog: read adequate metric
- ! and compute it on v3d(:,:,1)
- e(:,:)=getvar(coord,'e1u',1, npiglo,npjglo)
- v2d(:,:)=getvar(czgr,'hdepw',1, npiglo,npjglo)
- DO ji=2, npiglo-1
- v3d(ji,:,1)=(v2d(ji+1,:) -v2d(ji,:))/ e(ji,:)
- END DO
- scale=100. ! to be in % in the output
- CASE ('Sy') ! Meridional component of bottom slope
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_V'
- cfil='none' ; cvmask='vmask'
- npkv=1
- ! Sy is the j-slope of bottom topog: read adequate metric
- ! and compute it on v3d(:,:,1)
- e(:,:)=getvar(coord,'e2v',1, npiglo,npjglo)
- v2d(:,:)=getvar(czgr,'hdepw',1, npiglo,npjglo)
- DO jj=2, npjglo-1
- v3d(:,jj,1)=(v2d(:,jj+1) -v2d(:,jj))/ e(:,jj)
- END DO
- scale=100. ! to be in % in the output
- CASE ('H') ! Bottom topography
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- cvar='hdepw' ; cvmask='tmask'
- cfil=czgr
- npkv=1
- scale=1.
- END SELECT
-
- ! Now enter the generic processing
- PRINT *,'START coloc for ', TRIM(cctyp), npkv
- OPEN(numbin, FILE=cweight,FORM='unformatted')
-
- IF (cfil /= 'none' ) THEN ! read data (except for Sx and Sy )
- DO jk=1, npkv
- v3d(:,:,jk)=getvar(cfil,cvar,jk, npiglo,npjglo)
- END DO
- ENDIF
-
- ! read corresponding mask
- DO jk=1, npkv
- mask(:,:,jk)=getvar(cmask,cvmask,jk, npiglo,npjglo)
- END DO
-
- DO jid=1,nid
- READ(numbin) id, ymin, xmin, dep ,imin, jmin, kmin, iquadran, hN, alpha, beta, gamma
- vinterp(jid,jtyp)=interp()
- ! do not scale dummy values
- IF ( vinterp (jid,jtyp) > -990 ) vinterp (jid,jtyp) = vinterp (jid,jtyp) * scale
- END DO
-
- CLOSE(numbin)
- END DO ! Loop on type
-
- OPEN(numout ,FILE=cfilout)
- OPEN(numskip,FILE=cfilskip)
-
- WRITE(cweight,'(a,a,".bin")') TRIM(cweight_root), '_T'
- OPEN(numbin, FILE=cweight,FORM='unformatted')
- DO jid=1, nid ! loop on all stations
- READ(numbin) id, ymin, xmin, dep, imin, jmin, kmin, iquadran, hN
- IF ( xmin > 180.) xmin=xmin -360
- ! output only stations with no problems ( vinterp > -990 )
- zmin=MINVAL(vinterp(jid,:) )
-! IF ( zmin > -990 ) THEN
- WRITE(numout, '(I5, F8.1, 3x, e9.3)') id, dep, (vinterp(jid,jtyp),jtyp=1,jptyp)
-! ELSE
- ! save discarted stations for control
-! WRITE(numskip, '(I5, F8.1,3x, e9.3)') id, dep, (vinterp(jid,jtyp),jtyp=1,jptyp)
-! ENDIF
-END DO
-CLOSE(numbin)
-CLOSE(numout)
-
- PRINT *,' Done.'
-
-CONTAINS
-
-FUNCTION interp ()
- REAL(KIND=8) :: interp
-
- ! skip out of domain stations
- IF (imin == -1000 ) THEN
- interp=-999.
- RETURN
- ENDIF
-
- ! choose the 4 interpolation points, according to sector and nearest point (imin, jmin)
- SELECT CASE (iquadran)
- CASE (1)
- i1=imin ; j1 = jmin
- i2=imin +1 ; j2 = jmin
- i3=imin +1 ; j3 = jmin + 1
- i4=imin ; j4 = jmin + 1
- CASE (2)
- i1=imin ; j1 = jmin
- i2=imin ; j2 = jmin - 1
- i3=imin +1 ; j3 = jmin - 1
- i4=imin +1 ; j4 = jmin
- CASE (3)
- i1=imin ; j1 = jmin
- i2=imin -1 ; j2 = jmin
- i3=imin -1 ; j3 = jmin - 1
- i4=imin ; j4 = jmin - 1
- CASE (4)
- i1=imin ; j1 = jmin
- i2=imin ; j2 = jmin + 1
- i3=imin -1 ; j3 = jmin + 1
- i4=imin -1 ; j4 = jmin
- END SELECT
-
- ! kmin is always above target point
- k1=kmin ; k2 = kmin + 1
-
- IF (npkv == 1 ) THEN ! 2D var, do not take care of vertical interpolation
- k1 = 1 ; k2 = 0 ; wdo = 0.
- ENDIF
-
- ! compute sum of masked weight above target point
- wup = mask(i1,j1,k1)*(1-alpha)*(1-beta) + mask(i2,j2,k1) * alpha *(1-beta) + &
- & mask(i3,j3,k1)*alpha*beta + mask(i4,j4,k1) * (1-alpha)*beta
-
- ! interpolate with non-masked values, above target point
- vup = v3d(i1,j1,k1)*(1-alpha)*(1-beta) + v3d(i2,j2,k1) * alpha *(1-beta) + &
- & v3d(i3,j3,k1)*alpha*beta + v3d(i4,j4,k1) * (1-alpha)*beta
-
- IF (k2 /= 0 ) THEN ! for 3D variables
- ! compute sum of masked weight below target point
- wdo = mask(i1,j1,k2)*(1-alpha)*(1-beta) + mask(i2,j2,k2) * alpha *(1-beta) + &
- & mask(i3,j3,k2)*alpha*beta + mask(i4,j4,k2) * (1-alpha)*beta
-
- ! interpolate with non-masked values, below target point
- vdo = v3d(i1,j1,k2)*(1-alpha)*(1-beta) + v3d(i2,j2,k2) * alpha *(1-beta) + &
- & v3d(i3,j3,k2)*alpha*beta + v3d(i4,j4,k2) * (1-alpha)*beta
- ENDIF
-
- IF ( wup == 0 ) THEN ! all points are masked
- interp=-999.
- ELSE IF ( wdo == 0 ) THEN ! all points below are masked, or 2D
- interp= vup/wup
- ELSE ! general case
- interp= (1 - gamma) * vup/wup + gamma * vdo/wdo
- ENDIF
-
-END FUNCTION interp
-
-SUBROUTINE rotation (pval, pcourse)
- ! This subroutine returns the input vectors on the geographical reference
- ! for vectors in the domain ( only those are processed in the main program)
- REAL(KIND=8), DIMENSION(jptyp), INTENT(inout) :: pval !: input vectors ( U V Sx Sy )
- REAL(KIND=8), INTENT(in) :: pcourse !: local direction of the I=cst lines with respect to N (deg)
-
- ! local variable
- REAL(KIND=8), DIMENSION(2) :: zcomp
- REAL(KIND=8) :: zconv, zcourse, zpi
-
- zpi=ACOS(-1.d0) ; zconv=zpi/180.d0
- zcourse=pcourse*zconv ! heading in radians
- ! Velocity : u=1, v=2
- zcomp(1:2)=pval(1:2)
- pval(1) = zcomp(1)*COS(zcourse) +zcomp(2)*SIN(zcourse)
- pval(2) = -zcomp(1)*SIN(zcourse) +zcomp(2)*COS(zcourse)
-
- ! Bottom slope : Sx=3, Sy=4
- zcomp(1:2)=pval(3:4)
- pval(3) = zcomp(1)*COS(zcourse) +zcomp(2)*SIN(zcourse)
- pval(4) = -zcomp(1)*SIN(zcourse) +zcomp(2)*COS(zcourse)
-
-END SUBROUTINE rotation
-
-END PROGRAM cdfcoloc
diff --git a/cdfconvert.f90 b/cdfconvert.f90
index 90716c8..46e8ab3 100644
--- a/cdfconvert.f90
+++ b/cdfconvert.f90
@@ -1,545 +1,607 @@
PROGRAM cdfconvert
- !!-------------------------------------------------------------------
- !! PROGRAM CDFCONVERT
- !! ******************
- !!
- !! ** Purpose: Convert a set of dimgfile (Clipper like)
+ !!======================================================================
+ !! *** PROGRAM cdfconvert ***
+ !!=====================================================================
+ !! ** Purpose : Convert a set of dimgfile (Clipper like)
!! to a set of CDF files (Drakkar like )
- !!
- !! ** Method: Read tag then open the respective T S 2D U V files to create
+ !!
+ !! ** Method : Read tag then open the respective T S 2D U V files to create
!! gridT, gridU and gridV files.
!! Requires mesh_hgr.nc and mesh_zgr.nc files
!!
- !! history:
- !! Original: J.M. Molines (Jan. 2007 )
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- !! * Modules used
+ !! History : 2.1 : 01/2007 : J.M. Molines : Original code
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! isdirect : integer function which return the record length
+ !! of the file in argument if a dimgfile, 0 else.
+ !!
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, jvar
- INTEGER :: narg, iargc, nvar
- INTEGER :: npiglo,npjglo, npk !: size of the domain
-
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d, glam, gphi
- REAL(KIND=4) , DIMENSION (:), ALLOCATABLE :: dep
- REAL(KIND=4) ,DIMENSION(1) :: timean
-
- CHARACTER(LEN=256) :: ctag, confcase
-
- ! Dimg stuff
- INTEGER :: irecl, ii, nt, ndim
- INTEGER :: numu=10, numv=11, numt=12, nums=14, num2d=15, numssh=16, numuu=17, numvv=18
- CHARACTER(LEN=256) :: cdimgu, cdimgv,cdimgt, cdimgs, cdimg2d !: file name dimg
- CHARACTER(LEN=256) :: cdimguu, cdimgvv, cdimgssh !: file name dimg (optional)
- CHARACTER(LEN=80) :: cheader
- CHARACTER(LEN=4) :: cver
- REAL(KIND=4) :: x1,y1, dx,dy, spval
- LOGICAL :: lexist
-
- ! Netcdf Stuff
- CHARACTER(LEN=256) :: cfilu ,cfilv ,cfilt, cfilbsf !: file name nc
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc'
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
- INTEGER :: ncout
- INTEGER :: istatus
+
+ INTEGER(KIND=4) :: ji, jj, jk ! dummy loop index
+ INTEGER(KIND=4) :: jt, jvar ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: nvar ! number of output variables
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: irecl, ii, ndim ! dimg stuff variables
+ INTEGER(KIND=4) :: numu=10 ! logical id for input dimg file
+ INTEGER(KIND=4) :: numv=11 ! " "
+ INTEGER(KIND=4) :: numt=12 ! " "
+ INTEGER(KIND=4) :: nums=14 ! " "
+ INTEGER(KIND=4) :: num2d=15 ! " "
+ INTEGER(KIND=4) :: numssh=16 ! " "
+ INTEGER(KIND=4) :: numuu=17 ! " "
+ INTEGER(KIND=4) :: numvv=18 ! " "
+ INTEGER(KIND=4) :: ncout ! ncid of output netcdf file
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! outpur variables levels and id's
+
+ REAL(KIND=4) :: x1, y1 ! dimg header ( SW corner)
+ REAL(KIND=4) :: dx, dy ! dimg header ( x,y step)
+ REAL(KIND=4) :: zspval ! dimg header ( special value)
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, glam, gphi ! working arrays
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zdep ! depth
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ CHARACTER(LEN=256) :: cf_ufil ! output gridU file
+ CHARACTER(LEN=256) :: cf_vfil ! output gridV file
+ CHARACTER(LEN=256) :: cf_tfil ! output gridT file
+ CHARACTER(LEN=256) :: cf_bsfil ! output BSF file
+ CHARACTER(LEN=256) :: cf_dimgu ! input dimg U file
+ CHARACTER(LEN=256) :: cf_dimgv ! input dimg V file
+ CHARACTER(LEN=256) :: cf_dimgt ! input dimg T file
+ CHARACTER(LEN=256) :: cf_dimgs ! input dimg S file
+ CHARACTER(LEN=256) :: cf_dimg2d ! input dimg 2D file
+ CHARACTER(LEN=256) :: cf_dimguu ! input dimg U2 file
+ CHARACTER(LEN=256) :: cf_dimgvv ! input dimg V2 file
+ CHARACTER(LEN=256) :: cf_dimgssh ! input dimg SSH file
+ CHARACTER(LEN=256) :: ctag ! time tag
+ CHARACTER(LEN=256) :: confcase ! config-case
+ CHARACTER(LEN=80 ) :: cheader ! comment in header of dimg file
+ CHARACTER(LEN=4 ) :: cver ! dimg version
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! output data structure
+
+ LOGICAL :: lexist ! flag for existing file
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
!! Read command line
narg= iargc()
IF ( narg /= 2 ) THEN
- PRINT *,' Usage : cdfconvert ''Clipper tag '' ''CLIPPER confcase'' '
- PRINT *,' Output on gridT.nc, gridU.nc and gridV.nc '
- PRINT *,' mesh_hgr and mesh_zgr must be in the current directory'
+ PRINT *,' usage : cdfconvert CLIPPER_tag CLIPPER_Confcase'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Convert dimg files (CLIPPER like) to netcdf (DRAKKAR like).'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' CLIPPER_tag : a string such as y2000m01d15 for time identification.'
+ PRINT *,' CLIPPER_confcase : CONFIG-CASE of the files to be converted (eg ATL6-V6)'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fhgr),' and ', TRIM(cn_fzgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : gridT, gridU, gridV files'
+ PRINT *,' variables : same as in standard NEMO output'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfflxconv, cdfsstconv, cdfstrconv'
+ PRINT *,' '
STOP
ENDIF
!!
CALL getarg (1, ctag)
CALL getarg (2, confcase)
- !! Build dimg file names
- cdimgu=TRIM(confcase)//'_U_'//TRIM(ctag)//'.dimg'
- cdimgv=TRIM(confcase)//'_V_'//TRIM(ctag)//'.dimg'
- cdimgt=TRIM(confcase)//'_T_'//TRIM(ctag)//'.dimg'
- cdimgs=TRIM(confcase)//'_S_'//TRIM(ctag)//'.dimg'
- cdimg2d=TRIM(confcase)//'_2D_'//TRIM(ctag)//'.dimg'
-
- cdimgssh=TRIM(confcase)//'_SSH_'//TRIM(ctag)//'.dimg'
- cdimguu=TRIM(confcase)//'_UU_'//TRIM(ctag)//'.dimg'
- cdimgvv=TRIM(confcase)//'_VV_'//TRIM(ctag)//'.dimg'
+ lchk = lchk .OR. chkfile( cn_fhgr )
+ lchk = lchk .OR. chkfile (cn_fzgr )
- cfilu=TRIM(confcase)//'_'//TRIM(ctag)//'_gridU.nc'
- cfilv=TRIM(confcase)//'_'//TRIM(ctag)//'_gridV.nc'
- cfilt=TRIM(confcase)//'_'//TRIM(ctag)//'_gridT.nc'
- cfilbsf=TRIM(confcase)//'_'//TRIM(ctag)//'_PSI.nc'
+ !! Build dimg file names
+ cf_dimgu = TRIM(confcase)//'_U_' //TRIM(ctag)//'.dimg' ; lchk = lchk .OR. chkfile(cf_dimgu )
+ cf_dimgv = TRIM(confcase)//'_V_' //TRIM(ctag)//'.dimg' ; lchk = lchk .OR. chkfile(cf_dimgv )
+ cf_dimgt = TRIM(confcase)//'_T_' //TRIM(ctag)//'.dimg' ; lchk = lchk .OR. chkfile(cf_dimgt )
+ cf_dimgs = TRIM(confcase)//'_S_' //TRIM(ctag)//'.dimg' ; lchk = lchk .OR. chkfile(cf_dimgs )
+ cf_dimg2d = TRIM(confcase)//'_2D_' //TRIM(ctag)//'.dimg' ; lchk = lchk .OR. chkfile(cf_dimg2d)
+ IF ( lchk ) STOP ! missing file
+
+ cf_dimgssh = TRIM(confcase)//'_SSH_'//TRIM(ctag)//'.dimg'
+ cf_dimguu = TRIM(confcase)//'_UU_' //TRIM(ctag)//'.dimg'
+ cf_dimgvv = TRIM(confcase)//'_VV_' //TRIM(ctag)//'.dimg'
+
+ cf_ufil = TRIM(confcase)//'_' //TRIM(ctag)//'_gridU.nc'
+ cf_vfil = TRIM(confcase)//'_' //TRIM(ctag)//'_gridV.nc'
+ cf_tfil = TRIM(confcase)//'_' //TRIM(ctag)//'_gridT.nc'
+ cf_bsfil = TRIM(confcase)//'_' //TRIM(ctag)//'_PSI.nc'
! open (and check ?? if they exists )
- irecl=isdirect(cdimgu) ; OPEN( numu,FILE=cdimgu, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
- irecl=isdirect(cdimgv) ; OPEN( numv,FILE=cdimgv, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
- irecl=isdirect(cdimgt) ; OPEN( numt,FILE=cdimgt, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
- irecl=isdirect(cdimgs) ; OPEN( nums,FILE=cdimgs, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
- irecl=isdirect(cdimg2d) ; OPEN( num2d,FILE=cdimg2d, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ irecl=isdirect(cf_dimgu ) ; OPEN( numu, FILE=cf_dimgu, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ irecl=isdirect(cf_dimgv ) ; OPEN( numv, FILE=cf_dimgv, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ irecl=isdirect(cf_dimgt ) ; OPEN( numt, FILE=cf_dimgt, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ irecl=isdirect(cf_dimgs ) ; OPEN( nums, FILE=cf_dimgs, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ irecl=isdirect(cf_dimg2d) ; OPEN( num2d, FILE=cf_dimg2d, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
- READ(numt,REC=1) cver, cheader, ii, npiglo, npjglo, npk
+ READ(numt,REC=1) cver, cheader, ii, npiglo, npjglo, npk, npt
+
+ ALLOCATE (v2d(npiglo, npjglo), glam(npiglo,npjglo), gphi(npiglo,npjglo), zdep(npk), tim(npt) )
+
+ READ(numt,REC=1) cver, cheader, ii, npiglo, npjglo, npk, npt, ndim, &
+ & x1,y1,dx,dy,zspval, &
+ & ( zdep(jk),jk=1,npk), &
+ ( tim(jt), jt=1,npt)
- ALLOCATE (v2d(npiglo, npjglo), glam(npiglo,npjglo), gphi(npiglo,npjglo), dep(npk) )
- READ(numt,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, &
- x1,y1,dx,dy,spval, &
- (dep(jk),jk=1,npk), &
- timean(1)
! transform Clipper days to drakkar seconds ...
- timean(1)=timean(1)*86400.
+ tim(:)=tim(:)*86400.
+ !###############
+ !# GRID T FILE #
+ !###############
! Build gridT file with votemper, vosaline, sossheig, ... fluxes ...
- INQUIRE(FILE=cdimgssh, EXIST=lexist)
+ INQUIRE(FILE=cf_dimgssh, EXIST=lexist)
IF ( lexist ) THEN
- irecl=isdirect(cdimgssh); OPEN( numssh,FILE=cdimgssh, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
- nvar=10
+ irecl = isdirect(cf_dimgssh)
+ OPEN( numssh,FILE=cf_dimgssh, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ nvar = 10
ELSE
- nvar=9
+ nvar = 9
ENDIF
- ALLOCATE ( typvar(nvar), ipk(nvar), id_varout(nvar) )
- jvar=1
- ipk(jvar) = npk
- typvar(jvar)%name='votemper'
- typvar(jvar)%units='C'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= -2.
- typvar(jvar)%valid_max= 40.
- typvar(jvar)%long_name='Potential Temperature'
- typvar(jvar)%short_name='votemper'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TZYX'
+ ALLOCATE ( stypvar(nvar), ipk(nvar), id_varout(nvar) )
+ jvar=1
+ ipk(jvar) = npk
+ stypvar(jvar)%cname = cn_votemper
+ stypvar(jvar)%cunits = 'C'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = -2.
+ stypvar(jvar)%valid_max = 40.
+ stypvar(jvar)%clong_name = 'Potential Temperature'
+ stypvar(jvar)%cshort_name = cn_votemper
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TZYX'
jvar=jvar+1
- ipk(jvar) = npk
- typvar(jvar)%name='vosaline'
- typvar(jvar)%units='PSU'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= 0.
- typvar(jvar)%valid_max= 45.
- typvar(jvar)%long_name='Salinity'
- typvar(jvar)%short_name='vosaline'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TZYX'
+ ipk(jvar) = npk
+ stypvar(jvar)%cname = cn_vosaline
+ stypvar(jvar)%cunits = 'PSU'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = 0.
+ stypvar(jvar)%valid_max = 45.
+ stypvar(jvar)%clong_name = 'Salinity'
+ stypvar(jvar)%cshort_name = cn_vosaline
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TZYX'
jvar=jvar+1
IF ( lexist ) THEN
- ipk(jvar) = 1
- typvar(jvar)%name='sossheig'
- typvar(jvar)%units='m'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= -10.
- typvar(jvar)%valid_max= 10.
- typvar(jvar)%long_name='Sea_Surface_height'
- typvar(jvar)%short_name='sossheig'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TYX'
+ ipk(jvar) = 1
+ stypvar(jvar)%cname = cn_sossheig
+ stypvar(jvar)%cunits = 'm'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = -10.
+ stypvar(jvar)%valid_max = 10.
+ stypvar(jvar)%clong_name = 'Sea_Surface_height'
+ stypvar(jvar)%cshort_name = cn_sossheig
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TYX'
jvar=jvar+1
ENDIF
- ipk(jvar) = 1
- typvar(jvar)%name='somxl010' ! rec 12 of dimg file 2D
- typvar(jvar)%units='m'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= 0.
- typvar(jvar)%valid_max= 7000.
- typvar(jvar)%long_name='Mixed_Layer_Depth_on_0.01_rho_crit'
- typvar(jvar)%short_name='somxl010'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TYX'
+ ipk(jvar) = 1
+ stypvar(jvar)%cname = cn_somxl010 ! rec 12 of dimg file 2D
+ stypvar(jvar)%cunits = 'm'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = 0.
+ stypvar(jvar)%valid_max = 7000.
+ stypvar(jvar)%clong_name = 'Mixed_Layer_Depth_on_0.01_rho_crit'
+ stypvar(jvar)%cshort_name = cn_somxl010
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TYX'
jvar=jvar+1
- ipk(jvar) = 1
- typvar(jvar)%name='sohefldo' ! rec 4 of dimg file 2D
- typvar(jvar)%units='W/m2'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= -1000.
- typvar(jvar)%valid_max= 1000.
- typvar(jvar)%long_name='Net_Downward_Heat_Flux'
- typvar(jvar)%short_name='sohefldo'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TYX'
+ ipk(jvar) = 1
+ stypvar(jvar)%cname = 'sohefldo' ! rec 4 of dimg file 2D
+ stypvar(jvar)%cunits = 'W/m2'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = -1000.
+ stypvar(jvar)%valid_max = 1000.
+ stypvar(jvar)%clong_name = 'Net_Downward_Heat_Flux'
+ stypvar(jvar)%cshort_name = 'sohefldo'
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TYX'
jvar=jvar+1
- ipk(jvar) = 1
- typvar(jvar)%name='soshfldo' ! rec 8 of dimg file 2D (qsr)
- typvar(jvar)%units='W/m2'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= -1000.
- typvar(jvar)%valid_max= 1000.
- typvar(jvar)%long_name='Short_Wave_Radiation'
- typvar(jvar)%short_name='soshfldo'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TYX'
+ ipk(jvar) = 1
+ stypvar(jvar)%cname = cn_soshfldo ! rec 8 of dimg file 2D (qsr)
+ stypvar(jvar)%cunits = 'W/m2'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = -1000.
+ stypvar(jvar)%valid_max = 1000.
+ stypvar(jvar)%clong_name = 'Short_Wave_Radiation'
+ stypvar(jvar)%cshort_name = cn_soshfldo
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TYX'
jvar=jvar+1
- ipk(jvar) = 1
- typvar(jvar)%name='sowaflup' ! rec 5 of dimg file 2D (emp)
- typvar(jvar)%units='kg/m2/s' ! conversion required from CLIPPER /86400.
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= -1000.
- typvar(jvar)%valid_max= 1000.
- typvar(jvar)%long_name='Net_Upward_Water_Flux'
- typvar(jvar)%short_name='sowaflup'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TYX'
+ ipk(jvar) = 1
+ stypvar(jvar)%cname = cn_sowaflup ! rec 5 of dimg file 2D (emp)
+ stypvar(jvar)%cunits = 'kg/m2/s' ! conversion required from CLIPPER /86400.
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = -1000.
+ stypvar(jvar)%valid_max = 1000.
+ stypvar(jvar)%clong_name = 'Net_Upward_Water_Flux'
+ stypvar(jvar)%cshort_name = cn_sowaflup
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TYX'
jvar=jvar+1
- ipk(jvar) = 1
- typvar(jvar)%name='sowafldp' ! rec 10 of dimg file 2D (erp)
- typvar(jvar)%units='kg/m2/s' ! conversion required from CLIPPER /jvar.
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= -1000.
- typvar(jvar)%valid_max= 1000.
- typvar(jvar)%long_name='Surface_Water_Flux:Damping'
- typvar(jvar)%short_name='sowafldp'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TYX'
+ ipk(jvar) = 1
+ stypvar(jvar)%cname = 'sowafldp' ! rec 10 of dimg file 2D (erp)
+ stypvar(jvar)%cunits = 'kg/m2/s' ! conversion required from CLIPPER /jvar.
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = -1000.
+ stypvar(jvar)%valid_max = 1000.
+ stypvar(jvar)%clong_name = 'Surface_Water_Flux:Damping'
+ stypvar(jvar)%cshort_name = 'sowafldp'
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TYX'
jvar=jvar+1
- ipk(jvar) = 1
- typvar(jvar)%name='soicecov' ! rec 13 of dimg file 2D (erp)
- typvar(jvar)%units='%'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= 0.
- typvar(jvar)%valid_max= 1.
- typvar(jvar)%long_name='Ice Cover'
- typvar(jvar)%short_name='soicecov'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TYX'
+ ipk(jvar) = 1
+ stypvar(jvar)%cname = cn_soicecov ! rec 13 of dimg file 2D (erp)
+ stypvar(jvar)%cunits = '%'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = 0.
+ stypvar(jvar)%valid_max = 1.
+ stypvar(jvar)%clong_name = 'Ice Cover'
+ stypvar(jvar)%cshort_name = cn_soicecov
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TYX'
jvar=jvar+1
- ipk(jvar) = 1
- typvar(jvar)%name='sohefldp' ! rec 9 of dimg file 2D (erp)
- typvar(jvar)%units='W/m2'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= -10.
- typvar(jvar)%valid_max= 10.
- typvar(jvar)%long_name='Surface Heat Flux: Damping'
- typvar(jvar)%short_name='sohefldp'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TYX'
-
- glam=getvar(coordhgr,'glamt',1,npiglo,npjglo)
- gphi=getvar(coordhgr,'gphit',1,npiglo,npjglo)
- dep=getvare3(coordzgr,'gdept',npk)
-
- ncout =create(cfilt, 'none',npiglo,npjglo,npk,cdep='deptht' )
- istatus= createvar(ncout ,typvar,nvar, ipk,id_varout )
- istatus= putheadervar(ncout, 'none', npiglo, npjglo,npk,&
- pnavlon=glam,pnavlat=gphi,pdep=dep )
+ ipk(jvar) = 1
+ stypvar(jvar)%cname = 'sohefldp' ! rec 9 of dimg file 2D (erp)
+ stypvar(jvar)%cunits = 'W/m2'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = -10.
+ stypvar(jvar)%valid_max = 10.
+ stypvar(jvar)%clong_name = 'Surface Heat Flux: Damping'
+ stypvar(jvar)%cshort_name = 'sohefldp'
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TYX'
+
+ glam = getvar (cn_fhgr, cn_glamt, 1, npiglo, npjglo)
+ gphi = getvar (cn_fhgr, cn_gphit, 1, npiglo, npjglo)
+ zdep = getvare3(cn_fzgr, cn_gdept, npk )
+
+ ncout = create (cf_tfil, 'none', npiglo, npjglo, npk, cdep=cn_vdeptht )
+ ierr = createvar (ncout, stypvar, nvar, ipk, id_varout )
+ ierr = putheadervar(ncout, 'none', npiglo, npjglo, npk, pnavlon=glam, pnavlat=gphi, pdep=zdep )
jvar=1
! T
DO jk=1, npk
READ(numt,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, jk, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(jvar), v2d, jk, npiglo, npjglo)
END DO
- jvar=jvar+1
-
- print *, 'Done for T'
+ jvar = jvar+1
+ PRINT *, 'Done for T'
! S
DO jk=1, npk
READ(nums,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, jk, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(jvar), v2d, jk, npiglo, npjglo)
END DO
- jvar=jvar+1
- print *, 'Done for S'
+ jvar = jvar+1
+ PRINT *, 'Done for S'
IF ( lexist ) THEN
! SSH
READ(numssh,REC=2) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, 1, npiglo, npjglo)
- jvar=jvar+1
- print *, 'Done for SSH'
+ ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo)
+ jvar = jvar+1
+ PRINT *, 'Done for SSH'
ENDIF
! MXL
READ(num2d,REC=12) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, 1, npiglo, npjglo)
- jvar=jvar+1
- print *, 'Done for MXL'
+ ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo)
+ jvar = jvar+1
+ PRINT *, 'Done for MXL'
! QNET
- READ(num2d,REC=4) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, 1, npiglo, npjglo)
- jvar=jvar+1
- print *, 'Done for QNET'
+ READ(num2d,REC=4 ) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
+ ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo)
+ jvar = jvar+1
+ PRINT *, 'Done for QNET'
! QSR
- READ(num2d,REC=8) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, 1, npiglo, npjglo)
- jvar=jvar+1
- print *, 'Done for QSR'
+ READ(num2d,REC=8) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
+ ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo)
+ jvar = jvar+1
+ PRINT *, 'Done for QSR'
! EMP
- READ(num2d,REC=5) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- v2d=v2d/86400. ! to change units
- istatus=putvar(ncout, id_varout(jvar),v2d, 1, npiglo, npjglo)
- jvar=jvar+1
- print *, 'Done for EMP'
+ READ(num2d,REC=5) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
+ v2d = v2d/86400. ! to change units
+ ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo)
+ jvar = jvar+1
+ PRINT *, 'Done for EMP'
! ERP
READ(num2d,REC=10) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- v2d=v2d/86400. ! to change units
- istatus=putvar(ncout, id_varout(jvar),v2d, 1, npiglo, npjglo)
- jvar=jvar+1
- print *, 'Done for ERP'
+ v2d = v2d/86400. ! to change units
+ ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo)
+ jvar = jvar+1
+ PRINT *, 'Done for ERP'
! FREEZE
READ(num2d,REC=13) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, 1, npiglo, npjglo)
- jvar=jvar+1
- print *, 'Done for FREEZE'
+ ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo)
+ jvar = jvar+1
+ PRINT *, 'Done for FREEZE'
! QRP
- READ(num2d,REC=9) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, 1, npiglo, npjglo)
- jvar=jvar+1
- print *, 'Done for QRP'
+ READ(num2d,REC=9) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
+ ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo)
+ jvar = jvar+1
+ PRINT *, 'Done for QRP'
- istatus=putvar1d(ncout,timean,1,'T')
- istatus=CLOSEOUT(ncout)
- DEALLOCATE ( typvar, ipk, id_varout )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = closeout(ncout)
+ DEALLOCATE ( stypvar, ipk, id_varout )
-!!!!! GRID U !!!!!
- ! Build gridU file with vozocrtx, sozotaux
- INQUIRE(FILE=cdimguu, EXIST=lexist)
+ !###############
+ !# GRID U FILE #
+ !###############
+ ! Build gridU file with vozocrtx, sozotaux
+ INQUIRE(FILE=cf_dimguu, EXIST=lexist)
IF ( lexist ) THEN
- irecl=isdirect(cdimguu); OPEN( numuu,FILE=cdimguu, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ irecl = isdirect(cf_dimguu)
+ OPEN( numuu, FILE=cf_dimguu, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
nvar=3
ELSE
nvar=2
ENDIF
- ALLOCATE ( typvar(nvar), ipk(nvar), id_varout(nvar) )
-
- jvar=1
- ipk(jvar) = npk
- typvar(jvar)%name='vozocrtx'
- typvar(jvar)%units='m/s'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= 0.
- typvar(jvar)%valid_max= 20.
- typvar(jvar)%long_name='Zonal Velocity '
- typvar(jvar)%short_name='vozocrtx'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TZYX'
- jvar=jvar+1
- ipk(jvar) = 1
- typvar(jvar)%name='sozotaux'
- typvar(jvar)%units='N/m2'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= 0.
- typvar(jvar)%valid_max= 20.
- typvar(jvar)%long_name='Zonal Wind Stress'
- typvar(jvar)%short_name='sozotaux'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TYX'
- jvar=jvar+1
+ ALLOCATE ( stypvar(nvar), ipk(nvar), id_varout(nvar) )
+
+ jvar = 1
+ ipk(jvar) = npk
+ stypvar(jvar)%cname = cn_vozocrtx
+ stypvar(jvar)%cunits = 'm/s'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = 0.
+ stypvar(jvar)%valid_max = 20.
+ stypvar(jvar)%clong_name = 'Zonal Velocity '
+ stypvar(jvar)%cshort_name = cn_vozocrtx
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TZYX'
+ jvar = jvar+1
+
+ ipk(jvar) = 1
+ stypvar(jvar)%cname = 'sozotaux'
+ stypvar(jvar)%cunits = 'N/m2'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = 0.
+ stypvar(jvar)%valid_max = 20.
+ stypvar(jvar)%clong_name = 'Zonal Wind Stress'
+ stypvar(jvar)%cshort_name = 'sozotaux'
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TYX'
+ jvar = jvar+1
IF ( lexist ) THEN
ipk(jvar) = npk
- typvar(jvar)%name='vozocrtx_sqd'
- typvar(jvar)%units='m2/s2'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= 0.
- typvar(jvar)%valid_max= 100.
- typvar(jvar)%long_name='MS_Zonal_Velocity'
- typvar(jvar)%short_name='vozocrtx_sqd'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TZYX'
+ stypvar(jvar)%cname = TRIM(cn_vozocrtx)//'_sqd'
+ stypvar(jvar)%cunits = 'm2/s2'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = 0.
+ stypvar(jvar)%valid_max = 100.
+ stypvar(jvar)%clong_name = 'MS_Zonal_Velocity'
+ stypvar(jvar)%cshort_name = TRIM(cn_vozocrtx)//'_sqd'
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TZYX'
ENDIF
- glam=getvar(coordhgr,'glamu',1,npiglo,npjglo)
- gphi=getvar(coordhgr,'gphiu',1,npiglo,npjglo)
- dep=getvare3(coordzgr,'gdept',npk)
+ glam = getvar (cn_fhgr, cn_glamu, 1, npiglo, npjglo)
+ gphi = getvar (cn_fhgr, cn_gphiu, 1, npiglo, npjglo)
+ zdep = getvare3(cn_fzgr, cn_gdept, npk )
- ncout =create(cfilu, 'none',npiglo,npjglo,npk,cdep='depthu' )
- istatus= createvar(ncout ,typvar,nvar, ipk,id_varout )
- istatus= putheadervar(ncout, 'none', npiglo, npjglo,npk,&
- pnavlon=glam,pnavlat=gphi,pdep=dep )
+ ncout = create (cf_ufil, 'none', npiglo, npjglo, npk, cdep=cn_vdepthu )
+ ierr = createvar (ncout, stypvar, nvar, ipk, id_varout )
+ ierr = putheadervar(ncout, 'none', npiglo, npjglo, npk, pnavlon=glam, pnavlat=gphi, pdep=zdep )
jvar=1
DO jk=1, npk
READ(numu,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, jk, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(jvar), v2d, jk, npiglo, npjglo)
END DO
- jvar=jvar+1
- print *, 'Done for U'
+ jvar = jvar+1
+ PRINT *, 'Done for U'
READ(num2d, REC=2 ) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, 1, npiglo, npjglo)
- jvar=jvar+1
- print *, 'Done for TAUX'
+ ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo)
+ jvar = jvar+1
+ PRINT *, 'Done for TAUX'
IF ( lexist ) THEN
DO jk=1, npk
READ(numuu,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, jk, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(jvar), v2d, jk, npiglo, npjglo)
END DO
- print *, 'Done for UU'
+ PRINT *, 'Done for UU'
ENDIF
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = closeout(ncout )
- istatus=putvar1d(ncout,timean,1,'T')
- istatus=CLOSEOUT(ncout)
- DEALLOCATE ( typvar, ipk, id_varout )
+ DEALLOCATE ( stypvar, ipk, id_varout )
-!!!!! GRID V !!!!!
+ !###############
+ !# GRID V FILE #
+ !###############
! Build gridV file with vomecrty, sometauy
- INQUIRE(FILE=cdimgvv, EXIST=lexist)
+ INQUIRE(FILE=cf_dimgvv, EXIST=lexist)
IF ( lexist ) THEN
- irecl=isdirect(cdimgvv); OPEN( numvv,FILE=cdimgvv, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ irecl = isdirect(cf_dimgvv)
+ OPEN( numvv, FILE=cf_dimgvv, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
nvar=3
ELSE
nvar=2
ENDIF
- ALLOCATE ( typvar(nvar), ipk(nvar), id_varout(nvar) )
+ ALLOCATE ( stypvar(nvar), ipk(nvar), id_varout(nvar) )
jvar=1
- ipk(jvar) = npk
- typvar(jvar)%name='vomecrty'
- typvar(jvar)%units='m/s'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= 0.
- typvar(jvar)%valid_max= 20.
- typvar(jvar)%long_name='Meridinal Velocity '
- typvar(jvar)%short_name='vomecrty'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TZYX'
- jvar=jvar+1
-
- ipk(jvar) = 1
- typvar(jvar)%name='sometauy'
- typvar(jvar)%units='N/m2'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= 0.
- typvar(jvar)%valid_max= 20.
- typvar(jvar)%long_name='Meridional Wind Stress'
- typvar(jvar)%short_name='sometauy'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TYX'
+ ipk(jvar) = npk
+ stypvar(jvar)%cname = cn_vomecrty
+ stypvar(jvar)%cunits = 'm/s'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = 0.
+ stypvar(jvar)%valid_max = 20.
+ stypvar(jvar)%clong_name = 'Meridinal Velocity '
+ stypvar(jvar)%cshort_name = cn_vomecrty
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TZYX'
+ jvar = jvar+1
+
+ ipk(jvar) = 1
+ stypvar(jvar)%cname = 'sometauy'
+ stypvar(jvar)%cunits = 'N/m2'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = 0.
+ stypvar(jvar)%valid_max = 20.
+ stypvar(jvar)%clong_name = 'Meridional Wind Stress'
+ stypvar(jvar)%cshort_name = 'sometauy'
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TYX'
jvar=jvar+1
IF ( lexist ) THEN
- ipk(jvar) = npk
- typvar(jvar)%name='vomecrty_sqd'
- typvar(jvar)%units='m2/s2'
- typvar(jvar)%missing_value=0.
- typvar(jvar)%valid_min= 0.
- typvar(jvar)%valid_max= 100.
- typvar(jvar)%long_name='MS_Meridional_Velocity'
- typvar(jvar)%short_name='vomecrty_sqd'
- typvar(jvar)%online_operation='N/A'
- typvar(jvar)%axis='TZYX'
+ ipk(jvar) = npk
+ stypvar(jvar)%cname = TRIM(cn_vomecrty)//'_sqd'
+ stypvar(jvar)%cunits = 'm2/s2'
+ stypvar(jvar)%rmissing_value = 0.
+ stypvar(jvar)%valid_min = 0.
+ stypvar(jvar)%valid_max = 100.
+ stypvar(jvar)%clong_name = 'MS_Meridional_Velocity'
+ stypvar(jvar)%cshort_name = TRIM(cn_vomecrty)//'_sqd'
+ stypvar(jvar)%conline_operation = 'N/A'
+ stypvar(jvar)%caxis = 'TZYX'
ENDIF
- glam=getvar(coordhgr,'glamv',1,npiglo,npjglo)
- gphi=getvar(coordhgr,'gphiv',1,npiglo,npjglo)
- dep=getvare3(coordzgr,'gdept',npk)
+ glam = getvar (cn_fhgr, cn_glamv, 1, npiglo, npjglo)
+ gphi = getvar (cn_fhgr, cn_gphiv, 1, npiglo, npjglo)
+ zdep = getvare3(cn_fzgr, cn_gdept, npk )
- ncout =create(cfilv, 'none',npiglo,npjglo,npk,cdep='depthv' )
- istatus= createvar(ncout ,typvar,nvar, ipk,id_varout )
- istatus= putheadervar(ncout, 'none', npiglo, npjglo,npk,&
- pnavlon=glam,pnavlat=gphi,pdep=dep )
+ ncout = create (cf_vfil, 'none', npiglo, npjglo, npk, cdep=cn_vdepthv )
+ ierr = createvar (ncout, stypvar, nvar, ipk, id_varout )
+ ierr = putheadervar(ncout, 'none', npiglo, npjglo, npk, pnavlon=glam, pnavlat=gphi, pdep=zdep )
+ jvar = 1
DO jk=1, npk
- READ(numv,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(1),v2d, jk, npiglo, npjglo)
+ READ(numv,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
+ ierr = putvar (ncout, id_varout(jvar), v2d, jk, npiglo, npjglo)
END DO
- print *, 'Done for V'
+ jvar = jvar+1
+ PRINT *, 'Done for V'
- READ(num2d, REC=3 ) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(2),v2d, 1, npiglo, npjglo)
- print *, 'Done for TAUY'
+ READ(num2d, REC=3) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
+ ierr = putvar(ncout, id_varout(jvar), v2d, 1, npiglo, npjglo)
+ jvar = jvar+1
+ PRINT *, 'Done for TAUY'
IF ( lexist ) THEN
DO jk=1, npk
READ(numvv,REC=jk+1) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(jvar),v2d, jk, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(jvar), v2d, jk, npiglo, npjglo)
END DO
- print *, 'Done for VV'
+ PRINT *, 'Done for VV'
ENDIF
- istatus=putvar1d(ncout,timean,1,'T')
- istatus=CLOSEOUT(ncout)
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = closeout(ncout )
- DEALLOCATE ( typvar, ipk, id_varout )
+ DEALLOCATE ( stypvar, ipk, id_varout )
-!!!!! PSI !!!!!
+ !###############
+ !# PSI FILE #
+ !###############
! Build PSI file with sobarstf
nvar=1
- ALLOCATE ( typvar(nvar), ipk(nvar), id_varout(nvar) )
- ipk(1) = 1
- typvar(1)%name='sobarstf'
- typvar(1)%units='m3/s'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -3.e8
- typvar(1)%valid_max= 3.e8
- typvar(1)%long_name='Barotropic_Stream_Function'
- typvar(1)%short_name='sobarstf'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
-
- glam=getvar(coordhgr,'glamf',1,npiglo,npjglo)
- gphi=getvar(coordhgr,'gphif',1,npiglo,npjglo)
- dep=getvare3(coordzgr,'gdept',1)
+ ALLOCATE ( stypvar(nvar), ipk(nvar), id_varout(nvar) )
+ ipk(1) = 1
+ stypvar(1)%cname = 'sobarstf'
+ stypvar(1)%cunits = 'm3/s'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = -3.e8
+ stypvar(1)%valid_max = 3.e8
+ stypvar(1)%clong_name = 'Barotropic_Stream_Function'
+ stypvar(1)%cshort_name = 'sobarstf'
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TYX'
+
+ glam = getvar (cn_fhgr, cn_glamf, 1, npiglo, npjglo)
+ gphi = getvar (cn_fhgr, cn_gphif, 1, npiglo, npjglo)
+ zdep = getvare3(cn_fzgr, cn_gdept, 1 )
- ncout =create(cfilbsf, 'none',npiglo,npjglo,1,cdep='depthu' )
- istatus= createvar(ncout ,typvar,nvar, ipk,id_varout )
- istatus= putheadervar(ncout, 'none', npiglo, npjglo,1,&
- pnavlon=glam,pnavlat=gphi,pdep=dep )
+ ncout = create (cf_bsfil, 'none', npiglo, npjglo, 1, cdep=cn_vdepthu )
+ ierr = createvar (ncout, stypvar, nvar, ipk, id_varout )
+ ierr = putheadervar(ncout, 'none', npiglo, npjglo, 1, pnavlon=glam, pnavlat=gphi, pdep=zdep )
- READ(num2d,REC=7) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
- istatus=putvar(ncout, id_varout(1),v2d, 1, npiglo, npjglo)
- print *, 'Done for PSI'
+ jvar = 1
+ READ(num2d,REC=7) (( v2d(ji,jj), ji=1, npiglo), jj=1,npjglo)
+ ierr = putvar(ncout, id_varout(jvar),v2d, 1, npiglo, npjglo)
+ PRINT *, 'Done for PSI'
- istatus=putvar1d(ncout,timean,1,'T')
- istatus=CLOSEOUT(ncout)
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = closeout(ncout )
- DEALLOCATE ( typvar, ipk, id_varout )
+ DEALLOCATE ( stypvar, ipk, id_varout )
CONTAINS
- INTEGER FUNCTION isdirect(clname)
-!!! FUNCTION ISDIRECT
-!!! *****************
-!!!
-!!! PURPOSE : This integer function returns the record length if clname
-!!! is a valid dimg file, it returns 0 either.
-!!!
-!!! METHOD : Open the file and look for the key characters (@!01) for
-!!! identification.
-!!!
-!!! AUTHOR : Jean-Marc Molines (Apr. 1998)
-!!! -------------------------------------------------------------------------
- IMPLICIT NONE
- CHARACTER(LEN=*), INTENT(in) :: clname
- CHARACTER(LEN=4) :: cver
- CHARACTER(LEN=80) :: clheader
-!
- INTEGER :: irecl
+
+ INTEGER(KIND=4) FUNCTION isdirect(cdname)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION isdirect ***
+ !!
+ !! ** Purpose : This integer function returns the record length if cdname
+ !! is a valid dimg file, it returns 0 either.
+ !!
+ !! ** Method : Open the file and look for the key characters (@!01) for
+ !! identification.
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdname
+
+ ! --
+ INTEGER(KIND=4) :: irecl
+ INTEGER(KIND=4) :: inum = 100
+
+ CHARACTER(LEN=4) :: clver
+ CHARACTER(LEN=80) :: clheader
+ !!----------------------------------------------------------------------
!
- OPEN(100,FILE=clname, FORM ='UNFORMATTED', ACCESS ='DIRECT', RECL =88)
- READ(100,REC=1) cver ,clheader,irecl
- CLOSE(100)
+ OPEN(inum,FILE=cdname, FORM = 'UNFORMATTED', ACCESS = 'DIRECT', RECL = 88)
+ READ(inum,REC=1) clver ,clheader, irecl
+ CLOSE(inum)
!
- IF (cver == '@!01' ) THEN
- isdirect=irecl
+ IF (clver == '@!01' ) THEN
+ isdirect = irecl
ELSE
- isdirect=0
+ isdirect = 0
END IF
!
END FUNCTION isdirect
diff --git a/cdfcsp.f90 b/cdfcsp.f90
index e2dba29..b758968 100644
--- a/cdfcsp.f90
+++ b/cdfcsp.f90
@@ -1,112 +1,126 @@
PROGRAM cdfcsp
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfcsp ***
- !!
- !! ** Purpose: Replace the masked part of the arrays (marked with
- !! special values) with spval zero. Replace consistently
+ !!======================================================================
+ !! *** PROGRAM cdfcsp ***
+ !!=====================================================================
+ !! ** Purpose : Replace the masked part of the arrays (marked with
+ !! special values) with spval zero. Replace consistently
!! the definition of the spval in the variable attribut.
- !!
- !! history :
- !! Original : F. Castruccio (October 2006)
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
!!
- !! * Modules used
+ !! History : 2.1 : 10/2006 : F. Castruccio : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jf,jk,jvar, jt, jkk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: ncid, narg, iargc !:
- INTEGER :: npiglo,npjglo, npk , nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER , DIMENSION(:), ALLOCATABLE :: ipk !: arrays of vertical level for each var
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var !: arrays of var id
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: tab !: Arrays for cumulated values
- REAL(KIND=4) :: spval
- CHARACTER(LEN=256) :: cfile !: file name
- CHARACTER(LEN=256) :: cunits, clname, csname
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
-
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar !: type for attributes
-
- INTEGER :: istatus
-
-
- !! Read command line
- narg= iargc()
+
+ INTEGER(KIND=4) :: jf, jk, jvar, jt ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc !
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk , npt ! size of the domain
+ INTEGER(KIND=4) :: ncid, ierr ! ncdf related integer
+ INTEGER(KIND=4) :: nvars ! Number of variables in a file
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of vertical level for each var
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id
+
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: tab ! working array
+ REAL(KIND=4) :: zspval ! special value read in file
+
+ CHARACTER(LEN=256) :: cf_in ! input file name
+ CHARACTER(LEN=256) :: cunits ! units attribute
+ CHARACTER(LEN=256) :: clname ! long name attribute
+ CHARACTER(LEN=256) :: csname ! short name attribute
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! type for attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
+
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfcsp ''list_of_files'' '
- PRINT *,' Replace missing_values by 0 and update attribute'
+ PRINT *,' usage : cdfcsp list_of_files '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Replace missing_values by 0 and update attribute'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' The list of cdf file to process, all variables will be processed'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : same as input file (modified)'
+ PRINT *,' variables : same as input file'
STOP
ENDIF
- PRINT *, 'narg=', narg
- !!
+
!! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',kstatus=istatus)
- nt = getdim (cfile,'time_counter')
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',kstatus=istatus)
- IF (istatus /= 0 ) THEN
+ CALL getarg (1, cf_in)
+ IF ( chkfile (cf_in) ) STOP ! missing file
+
+ npiglo = getdim (cf_in, cn_x)
+ npjglo = getdim (cf_in, cn_y)
+ npk = getdim (cf_in, cn_z, kstatus=ierr)
+ npt = getdim (cf_in, cn_t)
+
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'z',kstatus=ierr)
+ IF (ierr /= 0 ) THEN
PRINT *, "ASSUME NO VERTICAL DIMENSIONS !"
npk=0
ENDIF
ENDIF
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
ALLOCATE( tab(npiglo,npjglo) )
- nvars = getnvar(cfile)
+ nvars = getnvar(cf_in)
- ALLOCATE (cvarname(nvars), id_var(nvars),ipk(nvars), typvar(nvars))
+ ALLOCATE (cv_names(nvars), id_var(nvars),ipk(nvars), stypvar(nvars))
- print *,' in getvarname'
- cvarname(:)=getvarname(cfile,nvars,typvar)
- print *,' in getipk'
- ipk(:) = getipk(cfile,nvars)
- print *,' done'
- id_var(:) = getvarid(cfile,nvars)
+ cv_names(:) = getvarname(cf_in, nvars, stypvar)
+ ipk(:) = getipk (cf_in, nvars )
+ id_var(:) = getvarid (cf_in, nvars )
DO jf = 1, narg
- CALL getarg (jf, cfile)
- PRINT *, 'Change spval on file ', cfile
- ncid = ncopen(cfile)
- nt = getdim (cfile,'time_counter')
+ CALL getarg (jf, cf_in)
+ IF ( chkfile (cf_in) ) STOP ! missing file
+ PRINT *, 'Change spval on file ', cf_in
+ ncid = ncopen(cf_in)
+ npt = getdim (cf_in,cn_t)
DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' .OR. &
- cvarname(jvar) == 'time_counter' .OR. &
- cvarname(jvar) == 'deptht' .OR. &
- cvarname(jvar) == 'depthu' .OR. &
- cvarname(jvar) == 'depthv' ) THEN
+ IF ( cv_names(jvar) == cn_vlon2d .OR. &
+ & cv_names(jvar) == cn_vlat2d .OR. &
+ & cv_names(jvar) == cn_vtimec .OR. &
+ & cv_names(jvar) == cn_vdeptht .OR. &
+ & cv_names(jvar) == cn_vdepthu .OR. &
+ & cv_names(jvar) == cn_vdepthv ) THEN
! skip these variable
ELSE
- ierr = getvaratt (cfile,cvarname(jvar),cunits,spval,clname,csname)
- ierr = cvaratt (cfile,cvarname(jvar),cunits,0.,clname,csname)
- DO jt=1,nt
+ ierr = getvaratt (cf_in, cv_names(jvar), cunits, zspval, clname, csname)
+ ierr = cvaratt (cf_in, cv_names(jvar), cunits, 0., clname, csname)
+ DO jt=1,npt
DO jk = 1, ipk(jvar)
- jkk=jk
- IF (npk == 0 ) jkk=jt
- tab(:,:) = getvar(cfile, cvarname(jvar), jkk ,npiglo, npjglo, ktime=jt )
- WHERE( tab(:,:) == spval ) tab(:,:) = 0.
- ierr = putvar(ncid, id_var(jvar) ,tab, jkk, npiglo, npjglo, ktime=jt)
+ tab(:,:) = getvar(cf_in, cv_names(jvar), jk, npiglo, npjglo, ktime=jt )
+ WHERE( tab(:,:) == zspval ) tab(:,:) = 0.
+ ierr = putvar(ncid, id_var(jvar), tab, jk, npiglo, npjglo, ktime=jt )
ENDDO
END DO
ENDIF
ENDDO
ENDDO
- istatus = closeout(ncid)
+ ierr = closeout(ncid)
END PROGRAM cdfcsp
diff --git a/cdfcurl.f90 b/cdfcurl.f90
index 7251007..2b8ee4d 100644
--- a/cdfcurl.f90
+++ b/cdfcurl.f90
@@ -1,108 +1,135 @@
PROGRAM cdfcurl
- !!---------------------------------------------------------------------------
- !! *** PROGRAM cdfcurl ***
+ !!======================================================================
+ !! *** PROGRAM cdfcurl ***
+ !!=====================================================================
+ !! ** Purpose : Compute the curl on F-points for given gridU gridV
+ !! files and variables
!!
- !! ** Purpose: Compute the curl on F-points for given gridU gridV files and variables
+ !! ** Method : Use the same algorithm than NEMO
!!
- !! history :
- !! Original : J.M. Molines (May 2005)
- !! Modified : P. Mathiot (June 2007) update for forcing fields
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 05/2005 : J.M. Molines : Original code
+ !! : 2.1 : 06/2007 : P. Mathiot : for use with forcing fields
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, jt, ilev
- INTEGER :: npiglo, npjglo, npk, nt
- INTEGER :: narg, iargc, ncout, ierr
- INTEGER, DIMENSION(1) :: ipk, id_varout !
-
- REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: e2v, e1u, e1f, e2f
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: un, vn, rotn, fmask, zun, zvn
- REAL(KIND=4) ,DIMENSION(:), ALLOCATABLE :: tim
- LOGICAL :: lforcing = .FALSE.
+ INTEGER(KIND=4) :: ji, jj, jt ! dummy loop index
+ INTEGER(KIND=4) :: ilev ! level to be processed
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: narg, iargc ! browse command line
+ INTEGER(KIND=4) :: ncout, ierr ! browse command line
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! output variable properties
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2v, e1u, e1f, e2f ! horizontql metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn ! velocity field
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zun, zvn ! working arrays
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rotn, fmask ! curl and fmask
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ CHARACTER(LEN=256) :: cf_ufil, cf_vfil ! file names
+ CHARACTER(LEN=256) :: cf_out = 'curl.nc' ! output file name
+ CHARACTER(LEN=256) :: cv_u, cv_v ! variable names
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ TYPE (variable), DIMENSION(1) :: stypvar ! structure for attibutes
+
+ LOGICAL :: lforcing = .FALSE. ! forcing flag
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ LOGICAL :: lperio = .FALSE. ! flag for E-W periodicity
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- CHARACTER(LEN=256) :: cfilu, cfilv, cvaru, cvarv, cdum
- CHARACTER(LEN=256) :: coord='mesh_hgr.nc', cfileout='curl.nc'
- TYPE (variable), DIMENSION(1) :: typvar !: structure for attibutes
-
- !!
narg = iargc()
IF ( narg /= 5 ) THEN
- PRINT *,' USAGE : cdfcurl fileU fileV varU varV lev'
- PRINT *,' lev is the level where the curl will be computed'
- PRINT *,' Produce a cdf file curl.nc with socurl variable'
- PRINT *,' Need mesh_hgr.nc'
- PRINT *,' '
- PRINT *,' For forcing fields : '
- PRINT *,' if no z dimension put lev=0 (PM)'
- PRINT *,' if file is in grid B or C, check the code (PM)'
+ PRINT *,' usage : cdfcurl U-file V-file U-var V-var lev'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the curl of a vector field, at a specified level.'
+ PRINT *,' If level is specified as 0, assume that the input files are'
+ PRINT *,' forcing files, presumably on A-grid. In this latter case, the'
+ PRINT *,' vector field is interpolated on the C-grid. In any case, the'
+ PRINT *,' curl is computed on the F-point.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' U-file : zonal component of the vector field.'
+ PRINT *,' V-file : meridional component of the vector field.'
+ PRINT *,' U-var : zonal component variable name'
+ PRINT *,' V-var : meridional component variable name.'
+ PRINT *,' lev : level to be processed. If set to 0, assume forcing file '
+ PRINT *,' in input.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fhgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : socurl (s^-1)'
STOP
ENDIF
- CALL getarg(1, cfilu)
- CALL getarg(2, cfilv)
- CALL getarg(3, cvaru)
- CALL getarg(4, cvarv)
- CALL getarg(5, cdum)
- READ(cdum,*) ilev
-
- ! define new variables for output ( must update att.txt)
- typvar(1)%name='socurl'
- typvar(1)%units='s-1'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar(1)%long_name='Relative_Vorticity (curl)'
- typvar(1)%short_name='socurl'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
+ CALL getarg(1, cf_ufil)
+ CALL getarg(2, cf_vfil)
+ CALL getarg(3, cv_u )
+ CALL getarg(4, cv_v )
+ CALL getarg(5, cldum ) ; READ(cldum,*) ilev
+
+ lchk = chkfile(cn_fhgr ) .OR. lchk
+ lchk = chkfile(cf_ufil ) .OR. lchk
+ lchk = chkfile(cf_vfil ) .OR. lchk
+ IF ( lchk ) STOP ! missing files
+
+ ! define new variables for output
+ stypvar(1)%cname = 'socurl'
+ stypvar(1)%cunits = 's-1'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = -1000.
+ stypvar(1)%valid_max = 1000.
+ stypvar(1)%clong_name = 'Relative_Vorticity (curl)'
+ stypvar(1)%cshort_name = 'socurl'
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TYX'
ipk(1) = 1 ! 2D
- npiglo = getdim(cfilu,'x')
- npjglo = getdim(cfilu,'y')
- npk = getdim(cfilu,'depth')
- nt = getdim(cfilu,'time_counter') !PM
+ npiglo = getdim(cf_ufil,cn_x)
+ npjglo = getdim(cf_ufil,cn_y)
+ npk = getdim(cf_ufil,cn_z)
+ npt = getdim(cf_ufil,cn_t)
- PRINT *, 'npiglo =',npiglo
- PRINT *, 'npjglo =',npjglo
- PRINT *, 'npk =',npk
- PRINT *, 'nt =',nt !PM
- PRINT *, 'ilev =',ilev
+ PRINT *, 'npiglo = ',npiglo
+ PRINT *, 'npjglo = ',npjglo
+ PRINT *, 'npk = ',npk
+ PRINT *, 'npt = ',npt
+ PRINT *, 'ilev = ',ilev
!test if lev exists
- IF ((npk==0) .AND. (ilev .GT. 0) ) THEN
+ IF ( (npk==0) .AND. (ilev > 0) ) THEN
PRINT *, 'Problem : npk = 0 and lev > 0 STOP'
STOP
END IF
- ! if forcing field (PM)
- IF (ilev==0 .AND. npk==0) THEN
+ ! if forcing field
+ IF ( ilev==0 .AND. npk==0 ) THEN
lforcing=.true.
npk = 1 ; ilev=1
PRINT *, 'npk =0, assume 1'
END IF
- IF (nt==0) THEN
- PRINT *, 'nt=0, assume 1'
- nt=1
+ IF ( npt==0 ) THEN
+ PRINT *, 'npt=0, assume 1'
+ npt=1
END IF
- !end (PM)
-
! check files and determines if the curl will be 2D of 3D
-
- ! create output fileset
- ncout =create(cfileout, cfilu, npiglo,npjglo,0)
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilu, npiglo, npjglo, 0)
-
+ ! ????????????
! Allocate the memory
ALLOCATE ( e1u(npiglo,npjglo) , e1f(npiglo,npjglo) )
@@ -110,23 +137,34 @@ PROGRAM cdfcurl
ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) )
ALLOCATE ( zun(npiglo,npjglo) , zvn(npiglo,npjglo) )
ALLOCATE ( rotn(npiglo,npjglo) , fmask(npiglo,npjglo) )
- ALLOCATE ( tim(nt) )
+ ALLOCATE ( tim(npt) )
- e1u= getvar(coord, 'e1u', 1,npiglo,npjglo)
- e1f= getvar(coord, 'e1f', 1,npiglo,npjglo)
- e2v= getvar(coord, 'e2v', 1,npiglo,npjglo)
- e2f= getvar(coord, 'e2f', 1,npiglo,npjglo)
+ e1u = getvar(cn_fhgr, cn_ve1u, 1, npiglo, npjglo)
+ e1f = getvar(cn_fhgr, cn_ve1f, 1, npiglo, npjglo)
+ e2v = getvar(cn_fhgr, cn_ve2v, 1, npiglo, npjglo)
+ e2f = getvar(cn_fhgr, cn_ve2f, 1, npiglo, npjglo)
- tim=getvar1d(cfilu,'time_counter',nt)
- ierr=putvar1d(ncout,tim,nt,'T')
+ ! use zun and zvn to store f latitude and longitude for output
+ zun = getvar(cn_fhgr, cn_glamf, 1, npiglo, npjglo)
+ zvn = getvar(cn_fhgr, cn_gphif, 1, npiglo, npjglo)
+
+ ! look for E-W periodicity
+ IF ( zun(1,1) == zun(npiglo-1,1) ) lperio = .TRUE.
+
+ ! create output fileset
+ ncout = create (cf_out, cf_ufil, npiglo, npjglo, 0 )
+ ierr = createvar (ncout , stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_ufil, npiglo, npjglo, 0, pnavlon=zun, pnavlat=zvn )
+
+ tim = getvar1d(cf_ufil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
- DO jt=1,nt
+ DO jt=1,npt
+ IF (MOD(jt,100)==0 ) PRINT *, jt,'/',npt
+ ! if files are forcing fields
+ zun(:,:) = getvar(cf_ufil, cv_u, ilev ,npiglo,npjglo, ktime=jt)
+ zvn(:,:) = getvar(cf_vfil, cv_v, ilev ,npiglo,npjglo, ktime=jt)
- IF (MOD(jt,100)==0) PRINT *, jt,'/',nt
- ! if files are forcing fields
- jk = ilev
- zun(:,:) = getvar(cfilu, cvaru, jk ,npiglo,npjglo, ktime=jt)
- zvn(:,:) = getvar(cfilv, cvarv, jk ,npiglo,npjglo, ktime=jt)
IF ( lforcing ) THEN ! for forcing file u and v are on the A grid
DO ji=1, npiglo-1
un(ji,:) = 0.5*(zun(ji,:) + zun(ji+1,:))
@@ -142,7 +180,7 @@ PROGRAM cdfcurl
END IF
! compute the mask
- IF (jt==1) THEN
+ IF ( jt==1 ) THEN
DO jj = 1, npjglo - 1
DO ji = 1, npiglo - 1
fmask(ji,jj)=0.
@@ -156,17 +194,14 @@ PROGRAM cdfcurl
DO jj = 1, npjglo -1
DO ji = 1, npiglo -1 ! vector opt.
rotn(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ) - e2v(ji,jj) * vn(ji,jj) &
- & - e1u(ji ,jj+1) * un(ji ,jj+1) + e1u(ji,jj) * un(ji,jj) ) &
- & * fmask(ji,jj) / ( e1f(ji,jj) * e2f(ji,jj) )
+ & - e1u(ji ,jj+1) * un(ji ,jj+1) + e1u(ji,jj) * un(ji,jj) ) &
+ & * fmask(ji,jj) / ( e1f(ji,jj) * e2f(ji,jj) )
END DO
END DO
- !
+
+ IF ( lperio ) rotn(npiglo,:) = rotn(2, :)
! write rotn on file at level k and at time jt
- IF (lforcing ) THEN
- ierr = putvar(ncout, id_varout(1) ,rotn, 1 ,npiglo, npjglo, jt)
- ELSE
- ierr = putvar(ncout, id_varout(1) ,rotn, 1 ,npiglo, npjglo, jt)
- END IF
+ ierr = putvar(ncout, id_varout(1), rotn, 1, npiglo, npjglo, ktime=jt)
END DO
ierr = closeout(ncout)
diff --git a/cdfdifmask.f90 b/cdfdifmask.f90
index 8c52257..3a03d32 100644
--- a/cdfdifmask.f90
+++ b/cdfdifmask.f90
@@ -1,102 +1,106 @@
PROGRAM cdfdifmask
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfdifmask ***
+ !!======================================================================
+ !! *** PROGRAM cdfdifmask ***
+ !!=====================================================================
+ !! ** Purpose : Build the difference between 2 mask files
!!
- !! ** Purpose: Build mask file from a salinity output
- !!
- !! ** Method: Read vosaline and set tmask to 1 where sal is not 0
- !! then umask, vmask and fmask are deduced from tmask
- !! REM: the result may be locally different for fmask than
- !! fmask produced online as there are computed on line
!!
- !! history:
- !! Original : J.M. Molines November 2005
- !!-------------------------------------------------------------------
- !! $Rev: 255 $
- !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $
- !! $Id: cdfdifmask.f90 255 2009-07-21 15:49:27Z molines $
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : ?????? : ??? : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk,jt, jvar !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc , ntags !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(4) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: zmask,zmask2 !: 2D mask at current level
- CHARACTER(LEN=256) :: cvar !: array of var name
- CHARACTER(LEN=256) :: cfile1, cfile2, cline,cfileout='mask_diff.nc'
- TYPE(variable), DIMENSION(4) :: typvar
- REAL(KIND=4) ,DIMENSION(1) :: timean
+ INTEGER(KIND=4) :: jk, jvar ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! browsing command line
+ INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(4) :: ipk ! outptut variables : levels,
+ INTEGER(KIND=4), DIMENSION(4) :: id_varout ! ncdf varid's
+
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, zmask2 ! 2D mask at current level
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! dummy time variable
+
+ CHARACTER(LEN=256) :: cf_out='mask_diff.nc' ! Output file name
+ CHARACTER(LEN=256) :: cf_msk1, cf_msk2 ! name of input files
+ CHARACTER(LEN=256) :: cv_in ! variable name
- INTEGER :: ncout, npt
- INTEGER :: istatus
- REAL(4) :: ss
+ TYPE(variable), DIMENSION(4) :: stypvar ! data structure
- !! Read command line
- narg= iargc()
+ LOGICAL :: lchk ! checking file existence
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfdifmask mask1 mask2'
+ PRINT *,' usage : cdfdifmask mask1 mask2'
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the difference between 2 mask files.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' mask1, mask2 : model files to be compared.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : tmask, umask, vmask, fmask'
STOP
ENDIF
+ CALL getarg (1, cf_msk1)
+ CALL getarg (2, cf_msk2)
- CALL getarg (1, cfile1)
- CALL getarg (2, cfile2)
- npiglo= getdim (cfile1,'x')
- npjglo= getdim (cfile1,'y')
- npk = getdim (cfile1,'z')
-
- print *, npiglo, npjglo, npk
+ lchk = chkfile ( cf_msk1 )
+ lchk = lchk .OR. chkfile ( cf_msk2 )
+ IF ( lchk ) STOP ! missing file
- ipk(1:4) = npk
- typvar(1)%name='tmask'
- typvar(2)%name='umask'
- typvar(3)%name='vmask'
- typvar(4)%name='fmask'
- typvar(1:4)%units='1/0'
- typvar(1:4)%missing_value=9999.
- typvar(1:4)%valid_min= 0.
- typvar(1:4)%valid_max= 1.
- typvar(1)%long_name='tmask'
- typvar(2)%long_name='umask'
- typvar(3)%long_name='vmask'
- typvar(4)%long_name='fmask'
- typvar(1)%short_name='tmask'
- typvar(2)%short_name='umask'
- typvar(3)%short_name='vmask'
- typvar(4)%short_name='fmask'
- typvar(1:4)%online_operation='N/A'
- typvar(1:4)%axis='TZYX'
- typvar(1:4)%precision='by'
+ npiglo = getdim (cf_msk1, cn_x)
+ npjglo = getdim (cf_msk1, cn_y)
+ npk = getdim (cf_msk1, 'z' ) ! mask file have a z depth dim instead of depth ...
- ncout =create(cfileout, cfile1,npiglo,npjglo,npk,cdep='z',cdepvar='nav_lev')
+ ipk(:) = npk
+ stypvar(:)%cunits = '1/0'
+ stypvar(:)%rmissing_value = 9999.
+ stypvar(:)%valid_min = 0.
+ stypvar(:)%valid_max = 1.
+ stypvar(:)%conline_operation = 'N/A'
+ stypvar(:)%caxis = 'TZYX'
+ stypvar(:)%cprecision = 'by'
- ierr= createvar(ncout ,typvar,4, ipk,id_varout )
- ierr= putheadervar(ncout, cfile1, npiglo, npjglo,npk,cdep='nav_lev')
+ stypvar(1)%cname='tmask' ; stypvar(1)%clong_name='tmask' ; stypvar(1)%cshort_name='tmask'
+ stypvar(2)%cname='umask' ; stypvar(2)%clong_name='umask' ; stypvar(2)%cshort_name='umask'
+ stypvar(3)%cname='vmask' ; stypvar(3)%clong_name='vmask' ; stypvar(3)%cshort_name='vmask'
+ stypvar(4)%cname='fmask' ; stypvar(4)%clong_name='fmask' ; stypvar(4)%cshort_name='fmask'
+ ncout = create (cf_out, cf_msk1, npiglo, npjglo, npk, cdep='z', cdepvar='nav_lev')
+ ierr = createvar (ncout, stypvar, 4, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_msk1, npiglo, npjglo, npk, cdep='nav_lev' )
- ALLOCATE (zmask(npiglo,npjglo),zmask2(npiglo,npjglo))
+ ALLOCATE (zmask(npiglo,npjglo), zmask2(npiglo,npjglo))
- npt= 0
DO jvar=1,4
- cvar=typvar(jvar)%name
- PRINT *, ' making difference for ', TRIM(cvar)
- DO jk=1, npk
- PRINT * ,'jk = ', jk
- zmask(:,:)= getvar(cfile1, cvar, jk ,npiglo, npjglo)
- zmask2(:,:)= getvar(cfile2, cvar, jk ,npiglo, npjglo)
- zmask(:,:)= zmask2(:,:) - zmask(:,:)
- ierr=putvar(ncout,id_varout(jvar), zmask, jk ,npiglo, npjglo)
- END DO ! loop to next level
+ cv_in = stypvar(jvar)%cname
+ PRINT *, ' making difference for ', TRIM(cv_in)
+ DO jk=1, npk
+ PRINT * ,'jk = ', jk
+ zmask(:,:) = getvar(cf_msk1, cv_in, jk, npiglo, npjglo)
+ zmask2(:,:) = getvar(cf_msk2, cv_in, jk, npiglo, npjglo)
+ zmask(:,:) = zmask2(:,:) - zmask(:,:)
+ ierr = putvar(ncout, id_varout(jvar), zmask, jk, npiglo, npjglo)
+ END DO ! loop to next level
END DO
- timean(:)=0.
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
+ tim(:) = 0.
+ ierr = putvar1d(ncout, tim, 1, 'T')
+ ierr = closeout(ncout)
END PROGRAM cdfdifmask
diff --git a/cdfeke.f90 b/cdfeke.f90
index a9fcb65..fb5c5ef 100644
--- a/cdfeke.f90
+++ b/cdfeke.f90
@@ -1,104 +1,149 @@
PROGRAM cdfeke
- !!-------------------------------------------------------------------
- !! PROGRAM CDFEKE
- !! **************
+ !!======================================================================
+ !! *** PROGRAM cdfeke ***
+ !!=====================================================================
+ !! ** Purpose : Compute Eddy Kinetic Energy
!!
- !! ** Purpose: Compute EKE from mean files :
- !! mean gridU , MS gridU mean gridV MS gridV
- !!
- !! ** Method: Try to avoid 3 d arrays
+ !! ** Method : Use gridU gridU2, gridV gridV2 files produced by
+ !! cdfmoy. Velocities are interpolated both on T points
+ !! and the variance is computed
!!
- !! history:
- !! Original: J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (Apr 2005) : use of modules
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- !! * Modules used
+ !! History : pre : 11/2004 : J.M. Molines : Original code
+ !! 2.1 : 04/2005 : J.M. Molines : use modules
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, id_varout
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: u, v, u2, v2, eke
- REAL(KIND=4) :: ua, va
- REAL(KIND=4) ,DIMENSION(1) :: timean
- CHARACTER(LEN=256) :: cfileu ,cfileu2,cfilev, cfilev2, cfilet, cfileout='eke.nc' !: file name
- TYPE(variable), DIMENSION(1) :: typvar
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc ! command line browsing
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain (horiz)
+ INTEGER(KIND=4) :: npk, npt ! size of the domain vert and time
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: ierr ! Error status
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout !
+
+ REAL(KIND=4) :: ua, va ! working arrays
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time variable
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: uc, vc, u2, v2 ! velocities etc...
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: eke ! velocities etc...
+
+ CHARACTER(LEN=256) :: cf_out='eke.nc' ! file name
+ CHARACTER(LEN=256) :: cf_ufil, cf_u2fil ! file name
+ CHARACTER(LEN=256) :: cf_vfil, cf_v2fil !
+ CHARACTER(LEN=256) :: cf_tfil !
+
+ TYPE(variable), DIMENSION(1) :: stypvar !
- INTEGER :: ncout
- INTEGER :: istatus, ierr
+ LOGICAL :: lchk ! checking files existence
+ LOGICAL :: lperio=.FALSE. ! checking E-W periodicity
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
!! Read command line
narg= iargc()
IF ( narg /= 5 ) THEN
- PRINT *,' Usage : cdfeke ''gridU gridU2 gridV gridV2 gridT2'' '
- PRINT *,' Grid T2 is only required for the Tgrid of output field'
- PRINT *,' We suggest to give a gridT2 file, which is smaller '
- PRINT *,' Output on eke.nc ,variable voeke'
+ PRINT *,' usage : cdfeke U-file U2-file V-file V2-file T2-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the Eddy Kinetic Energy from previously computed'
+ PRINT *,' mean values and mean squared values of velocity components.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' U-file : gridU type file with mean U component.'
+ PRINT *,' U2-file : gridU2 type file with mean U2 component.'
+ PRINT *,' V-file : gridV type file with mean V component.'
+ PRINT *,' V2-file : gridV2 type file with mean V2 component.'
+ PRINT *,' T2-file : any gridT or gridT2 (smaller) file, used for EKE header.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : voeke (m2/s)'
STOP
ENDIF
!!
!! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfileu)
- CALL getarg (2, cfileu2)
- CALL getarg (3, cfilev)
- CALL getarg (4, cfilev2)
- CALL getarg (5, cfilet)
-
- npiglo = getdim (cfileu,'x')
- npjglo = getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
-
- ipk(1) = npk
- typvar(1)%name='voeke'
- typvar(1)%units='m2/s2'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 10000.
- typvar(1)%long_name='Eddy_Kinetic_Energy'
- typvar(1)%short_name='voeke'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( u(npiglo,npjglo), u2(npiglo,npjglo), v(npiglo,npjglo) ,v2(npiglo,npjglo) )
- ALLOCATE( eke(npiglo,npjglo) )
-
- ncout =create(cfileout, cfilet,npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet, npiglo, npjglo,npk)
-
- DO jk = 1, npk
- u(:,:) = getvar(cfileu,'vozocrtx',jk ,npiglo, npjglo)
- v(:,:) = getvar(cfilev,'vomecrty',jk ,npiglo, npjglo)
- u2(:,:) = getvar(cfileu2,'vozocrtx_sqd',jk ,npiglo, npjglo)
- v2(:,:) = getvar(cfilev2,'vomecrty_sqd',jk ,npiglo, npjglo)
-
- ua = 0. ; va = 0. ; eke(:,:) = 0.
- DO ji=2, npiglo
- DO jj=2,npjglo
- ua = 0.5* ((u2(ji,jj)-u(ji,jj)*u(ji,jj))+ (u2(ji-1,jj)-u(ji-1,jj)*u(ji-1,jj)))
- va = 0.5* ((v2(ji,jj)-v(ji,jj)*v(ji,jj))+ (v2(ji,jj-1)-v(ji,jj-1)*v(ji,jj-1)))
- eke(ji,jj) = 0.5 * ( ua + va )
+ CALL getarg (1, cf_ufil )
+ CALL getarg (2, cf_u2fil)
+ CALL getarg (3, cf_vfil )
+ CALL getarg (4, cf_v2fil)
+ CALL getarg (5, cf_tfil )
+
+ lchk = chkfile (cf_ufil )
+ lchk = lchk .OR. chkfile (cf_u2fil)
+ lchk = lchk .OR. chkfile (cf_vfil )
+ lchk = lchk .OR. chkfile (cf_v2fil)
+ lchk = lchk .OR. chkfile (cf_tfil )
+ IF ( lchk ) STOP ! missing files
+
+ npiglo = getdim (cf_ufil,cn_x)
+ npjglo = getdim (cf_ufil,cn_y)
+ npk = getdim (cf_ufil,cn_z)
+ npt = getdim (cf_ufil,cn_t)
+
+ ipk(1) = npk
+ stypvar(1)%cname = 'voeke'
+ stypvar(1)%cunits = 'm2/s2'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 10000.
+ stypvar(1)%clong_name = 'Eddy_Kinetic_Energy'
+ stypvar(1)%cshort_name = 'voeke'
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE( uc(npiglo,npjglo), u2(npiglo,npjglo), vc(npiglo,npjglo), v2(npiglo,npjglo) )
+ ALLOCATE( eke(npiglo,npjglo) , tim(npt) )
+
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
+
+ ! check for E_W periodicity
+ uc(:,:) = getvar(cf_tfil, cn_vlon2d, 1, npiglo, npjglo )
+ IF ( uc(1,1) == uc(npiglo-1,1) ) THEN
+ lperio = .TRUE.
+ PRINT *,' E-W periodicity detected '
+ ENDIF
+
+ DO jt = 1, npt ! input file is likely to contain only one time frame but who knows ...
+ DO jk = 1, npk
+ uc(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jt )
+ vc(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt )
+ u2(:,:) = getvar(cf_u2fil, TRIM(cn_vozocrtx)//'_sqd', jk ,npiglo, npjglo, ktime=jt )
+ v2(:,:) = getvar(cf_v2fil, TRIM(cn_vomecrty)//'_sqd', jk ,npiglo, npjglo, ktime=jt )
+
+ ua = 0. ; va = 0. ; eke(:,:) = 0.
+ DO ji=2, npiglo
+ DO jj=2,npjglo
+ ua = 0.5* ((u2(ji,jj)-uc(ji,jj)*uc(ji,jj))+ (u2(ji-1,jj)-uc(ji-1,jj)*uc(ji-1,jj)))
+ va = 0.5* ((v2(ji,jj)-vc(ji,jj)*vc(ji,jj))+ (v2(ji,jj-1)-vc(ji,jj-1)*vc(ji,jj-1)))
+ eke(ji,jj) = 0.5 * ( ua + va )
+ END DO
END DO
+ IF ( lperio ) eke(1,:) = eke(npiglo-1,:)
+ ierr=putvar(ncout,id_varout(1), eke, jk ,npiglo, npjglo, ktime=jt )
END DO
- ierr=putvar(ncout,id_varout(1), eke, jk ,npiglo, npjglo)
- END DO
- timean=getvar1d(cfileu,'time_counter',1)
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
+ END DO ! time loop
+
+ tim = getvar1d(cf_ufil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ ierr = closeout(ncout)
END PROGRAM cdfeke
diff --git a/cdfets.f90 b/cdfets.f90
index cdac354..1cb5e79 100644
--- a/cdfets.f90
+++ b/cdfets.f90
@@ -1,134 +1,158 @@
PROGRAM cdfets
- !!--------------------------------------------------------------------
- !! *** PROGRAM cdfets ***
+ !!======================================================================
+ !! *** PROGRAM cdfets ***
+ !!=====================================================================
+ !! ** Purpose : Compute Eddy Time Scale 3D field from gridT file
+ !! and the Rosby Radius of deformation.
+ !! Store the results on a 'similar' cdf file.
!!
- !! *** Purpose: Compute Eddy Time Scale 3D field from gridT file
- !! and the Rosby Radius of deformation.
- !! Store the results on a 'similar' cdf file.
- !!
- !! *** Method: Try to avoid 3 d arrays.
- !! (1) Compute the BruntVaissala frequency (N2) using eosbn2
- !! (2) Compute the Rossby Radius as the vertical integral of N, scaled
- !! by |f|*pi
- !! (3) Compytes the buoyancy =-g x rho/rho0 and is horizontal derivative db/dx and db/dy
+ !! ** Method : (1) Compute the BruntVaissala frequency (N2) using eosbn2
+ !! (2) Compute the Rossby Radius as the vertical integral of N,
+ !! scaled by |f|*pi
+ !! (3) Computes the buoyancy =-g x rho/rho0 and is horizontal
+ !! derivative db/dx and db/dy
!! (4) Computes M2 = SQRT ( (db/dx)^2 + (db/dy)^2 )
!! (5) Computes eddy length scale = ets = N/M2
- !! (6) Output on netcdf file ets.nc : ets = voets ; rosby_radius = sorosrad
+ !! (6) Output on netcdf file ets.nc :
+ !! ets = voets ; rosby_radius = sorosrad
!!
- !! *** Remarks : A special care has been taken with respect to land value which have been set to
- !! spval (-1000.) and not 0 as usual. This is because a value of 0.00 has a physical
- !! meaning for N. On the other hand, ets is N/M2. If M2 is 0, (which is likely not very
- !! usual), ets is set to the arbitrary value of -10., to flag these points.
+ !! ** Remarks : A special care has been taken with respect to land value
+ !! which have been set to spval (-1000.) and not 0 as usual.
+ !! This is because a value of 0.00 has a physical meaning for N.
+ !! On the other hand, ets is N/M2. If M2 is 0, (which is likely
+ !! not very usual), ets is set to the arbitrary value of -10.,
+ !! to flag these points.
!!
- !! history :
- !! Original : J.M. Molines, J. Le Sommer (Dec. 2004 ) for ORCA025
- !! J.M. Molines, Apr. 2005 : use of modules
- !!--------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.0 : 12/2004 : J.M. Molines, J. Le Sommer : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: iup = 1 , idown = 2, itmp
- INTEGER, DIMENSION(2) :: ipk, id_varout !
-
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: ztemp, zsal,zwk !: Array to read 2 layer of data
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zn2 , & !: Brunt Vaissala Frequency (N2)
- & zmask, e1u, e2v, e3w, ff !: mask, metrics, and coriolis.
- REAL(KIND=4) ,DIMENSION(1) :: tim
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: buoy, dbu,dbv, zlda, M2, ets !: Double precision
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw !: depth of w level here a 1x1 array to
- ! be in agreement with mesh_zgr.nc
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='ets.nc' !:
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc' !:
- TYPE (variable), DIMENSION(2) :: typvar !: structure for attribute
-
- INTEGER :: ncout
- INTEGER :: istatus
-
- ! constants
- REAL(KIND=4) :: rau0=1000., zpi, grav= 9.81, spval=-1000.
-
- !! Read command line and output usage message if not compliant.
+
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: iup = 1, idown = 2, itmp !
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(2) :: ipk, id_varout !
+
+ REAL(KIND=4) :: rau0 = 1000. ! density of water
+ REAL(KIND=4) :: grav = 9.81 ! Gravity
+ REAL(KIND=4) :: spval = -1000. ! special value
+ REAL(KIND=4) :: zpi
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: ztemp, zsal, zwk ! Array to read 2 layer of data
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zn2 ! Brunt Vaissala Frequency (N2)
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask, ff ! mask coriolis.
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1u, e2v, e3w ! metrics
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of w level
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dbuoy, dbu, dbv ! Double precision
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dlda, dM2, dets ! Double precision
+
+ CHARACTER(LEN=256) :: cf_tfil ! out file names
+ CHARACTER(LEN=256) :: cf_out = 'ets.nc' ! in file names
+
+ TYPE (variable), DIMENSION(2) :: stypvar ! structure for attribute
+
+ LOGICAL :: lchk ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfets gridT '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in te current directory'
- PRINT *,' Output on ets.nc, variables voets and sorosrad'
+ PRINT *,' usage : cdfets T-file '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the eddy time scale, and a proxy for rossby radius.'
+ PRINT *,' The Rossby radius is computed as the vertical integral of N2'
+ PRINT *,' (Brunt Vaissala frequency), scaled by |f|*pi'
+ PRINT *,' The Eddy Time Scale is the ratio N/|grad B| where N is the square'
+ PRINT *,' root of N2 and |grad B| is the module of the horizontal buoyancy'
+ PRINT *,' gradient. B is the buoyancy computed as B=-g rho/rho0.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf input file for temperature and salinity (gridT).'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fhgr),', ',TRIM(cn_fzgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : voets (days) and sorosrad (m)'
STOP
ENDIF
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
+ CALL getarg (1, cf_tfil)
+ lchk = ( chkfile (cf_tfil) .OR. chkfile( cn_fhgr ) .OR. chkfile( cn_fzgr) )
+ IF ( lchk ) STOP ! missing file
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
! define new variables for output
- typvar(1)%name= 'voets'
- typvar(1)%units='days'
- typvar(1)%missing_value=-1000.
- typvar(1)%valid_min= 0
- typvar(1)%valid_max= 50000.
- typvar(1)%long_name='Eddy_Time_Scale'
- typvar(1)%short_name='voets'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
- typvar(2)%name= 'sorosrad'
- typvar(2)%units='m'
- typvar(2)%missing_value=-1000.
- typvar(2)%valid_min= 0.
- typvar(2)%valid_max= 50000.
- typvar(2)%long_name='Rossby_Radius'
- typvar(2)%short_name='sorosrad'
- typvar(2)%online_operation='N/A'
- typvar(2)%axis='TYX'
-
- ipk(1) = npk ! 3D
+ stypvar(1)%cname = 'voets'
+ stypvar(1)%cunits = 'days'
+ stypvar(1)%rmissing_value = -1000.
+ stypvar(1)%valid_min = 0
+ stypvar(1)%valid_max = 50000.
+ stypvar(1)%clong_name = 'Eddy_Time_Scale'
+ stypvar(1)%cshort_name = 'voets'
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+
+ stypvar(2)%cname = 'sorosrad'
+ stypvar(2)%cunits = 'm'
+ stypvar(2)%rmissing_value = -1000.
+ stypvar(2)%valid_min = 0.
+ stypvar(2)%valid_max = 50000.
+ stypvar(2)%clong_name = 'Rossby_Radius'
+ stypvar(2)%cshort_name = 'sorosrad'
+ stypvar(2)%conline_operation = 'N/A'
+ stypvar(2)%caxis = 'TYX'
+
+ ipk(1) = npk ! 3D
ipk(2) = 1 ! 2D
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
! Allocate arrays
ALLOCATE (ztemp(npiglo,npjglo,2), zsal(npiglo,npjglo,2), zwk(npiglo,npjglo,2) ,zmask(npiglo,npjglo))
ALLOCATE (zn2(npiglo,npjglo), e1u(npiglo,npjglo), e2v(npiglo,npjglo) ,e3w(npiglo,npjglo))
- ALLOCATE (dbu(npiglo,npjglo), dbv(npiglo,npjglo),zlda(npiglo,npjglo) )
- ALLOCATE (buoy(npiglo,npjglo), M2(npiglo,npjglo),ets(npiglo,npjglo) ,ff(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
+ ALLOCATE (dbu(npiglo,npjglo), dbv(npiglo,npjglo),dlda(npiglo,npjglo) )
+ ALLOCATE (dbuoy(npiglo,npjglo), dM2(npiglo,npjglo),dets(npiglo,npjglo) ,ff(npiglo,npjglo) )
+ ALLOCATE (gdepw(npk), tim(npt) )
! create output fileset
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
- ierr= createvar(ncout ,typvar ,2, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet, npiglo, npjglo, npk)
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar , 2, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
zpi=ACOS(-1.)
- ! 2 levels of T and S are required : iup,idown (with respect to W level)
- ! Compute from bottom to top (for vertical integration)
- ztemp(:,:,idown) = getvar(cfilet, 'votemper', npk-1 ,npiglo,npjglo )
- zsal(:,:,idown) = getvar(cfilet, 'vosaline', npk-1 ,npiglo,npjglo )
- zwk(:,:,idown) = spval
-
- e1u(:,:) = getvar(coordhgr, 'e1u', 1,npiglo,npjglo)
- e2v(:,:) = getvar(coordhgr, 'e2v', 1,npiglo,npjglo)
- ff(:,:) = getvar(coordhgr, 'ff', 1,npiglo,npjglo)
- gdepw(:) = getvare3(coordzgr,'gdepw',npk)
+ e1u(:,:) = getvar (cn_fhgr, cn_ve1u, 1, npiglo, npjglo)
+ e2v(:,:) = getvar (cn_fhgr, cn_ve2v, 1, npiglo, npjglo)
+ ff(:,:) = getvar (cn_fhgr, cn_vff, 1, npiglo, npjglo)
+ gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk )
! eliminates zeros (which corresponds to land points where no procs were used)
WHERE ( e1u == 0 )
- ff = 1.e-6
+ ff = 1.e-6
e1u = 1
e2v = 1
END WHERE
@@ -141,31 +165,37 @@ PROGRAM cdfets
END DO
END DO
ff(:,:) = zwk(:,:,iup)
- ff(:,1)=ff(:,2)
- ff(1,:)=ff(2,:)
-
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ! at level 1 and npk, ets is not defined
- ets(:,:) = spval
- ierr = putvar(ncout, id_varout(1) ,SNGL(ets), npk, npiglo, npjglo)
-
- ! Set to 0 zlda
- zlda(:,:) = 0.d0
- DO jk = npk-1, 2, -1 ! from bottom to top
- PRINT *,'level ',jk
- ! Get temperature and salinity at jk -1 (up )
- ztemp(:,:,iup)= getvar(cfilet, 'votemper', jk-1 ,npiglo,npjglo)
- zsal(:,:,iup) = getvar(cfilet, 'vosaline', jk-1 ,npiglo,npjglo)
-
- ! build tmask at level jk
- zmask(:,:)=1.
- WHERE(ztemp(:,:,idown) == 0 ) zmask = 0
-
- ! get depthw and e3w at level jk
- e3w(:,:) = getvar(coordzgr, 'e3w_ps', jk,npiglo,npjglo,ldiom=.true.)
- WHERE(e3w == 0. ) e3w = 0.1 ! avoid 0's in e3w (land points anyway)
+ ff(:,1) = ff(:,2)
+ ff(1,:) = ff(2,:)
+
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ DO jt = 1, npt
+ ! at level 1 and npk, dets is not defined
+ dets(:,:) = spval
+ ierr = putvar(ncout, id_varout(1) ,SNGL(dets), npk, npiglo, npjglo, ktime = jt)
+ ! 2 levels of T and S are required : iup,idown (with respect to W level)
+ ! Compute from bottom to top (for vertical integration)
+ ztemp(:,:,idown) = getvar(cf_tfil, cn_votemper, npk-1 ,npiglo,npjglo, ktime=jt )
+ zsal (:,:,idown) = getvar(cf_tfil, cn_vosaline, npk-1 ,npiglo,npjglo, ktime=jt )
+ zwk (:,:,idown) = spval
+
+ ! Set to 0 dlda
+ dlda(:,:) = 0.d0
+ DO jk = npk-1, 2, -1 ! from bottom to top
+ PRINT *,'level ',jk
+ ! Get temperature and salinity at jk -1 (up )
+ ztemp(:,:,iup) = getvar(cf_tfil, cn_votemper, jk-1 ,npiglo,npjglo, ktime = jt)
+ zsal (:,:,iup) = getvar(cf_tfil, cn_vosaline, jk-1 ,npiglo,npjglo, ktime = jt)
+
+ ! build tmask at level jk
+ zmask(:,:)=1.
+ WHERE(ztemp(:,:,idown) == 0 ) zmask = 0
+
+ ! get depthw and e3w at level jk
+ e3w(:,:) = getvar(cn_fzgr, 'e3w_ps', jk,npiglo,npjglo,ldiom=.TRUE.)
+ WHERE(e3w == 0. ) e3w = 0.1 ! avoid 0's in e3w (land points anyway)
! zwk will hold N2 at W level
zwk(:,:,iup) = eosbn2 ( ztemp,zsal,gdepw(jk),e3w,npiglo,npjglo, iup, idown ) ! not masked
@@ -179,7 +209,6 @@ PROGRAM cdfets
zn2(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) )
END WHERE
-
! Only the square root is used in this program (work for ocean points only)
WHERE (zmask == 1 )
zn2=SQRT(zn2)
@@ -188,53 +217,54 @@ PROGRAM cdfets
END WHERE
! integrates vertically (ff is already ABS(ff) * pi
- zlda(:,:) = zlda(:,:) + e3w(:,:)/ff(:,:) * zn2(:,:)* zmask(:,:)
+ dlda(:,:) = dlda(:,:) + e3w(:,:)/ff(:,:) * zn2(:,:)* zmask(:,:)
! Compute buoyancy at level Tk ( idown)
- buoy(:,:) = - grav * (sigma0 ( ztemp(:,:,idown), zsal(:,:,idown),npiglo, npjglo) ) * zmask(:,:) / rau0
+ dbuoy(:,:) = - grav * (sigma0 ( ztemp(:,:,idown), zsal(:,:,idown),npiglo, npjglo) ) * zmask(:,:) / rau0
! Compute dB/dx (U point) and dB/dy (V point)
DO jj =1 , npjglo -1
DO ji= 1, npiglo -1
- dbu(ji,jj) = 1./e1u(ji,jj) *( buoy(ji+1,jj) - buoy(ji,jj) )
- dbv(ji,jj) = 1./e2v(ji,jj) *( buoy(ji,jj+1) - buoy(ji,jj) )
+ dbu(ji,jj) = 1./e1u(ji,jj) *( dbuoy(ji+1,jj) - dbuoy(ji,jj) )
+ dbv(ji,jj) = 1./e2v(ji,jj) *( dbuoy(ji,jj+1) - dbuoy(ji,jj) )
END DO
END DO
- ! M2 at T point ( (dB/dx)^2 + (dB/dy)^2 ) ^1/2
+ ! dM2 at T point ( (dB/dx)^2 + (dB/dy)^2 ) ^1/2
DO jj=2,npjglo -1
DO ji=2,npiglo -1
- M2(ji,jj) = 0.25*(dbu(ji,jj) + dbu(ji-1,jj)) * (dbu(ji,jj) + dbu(ji-1,jj)) &
+ dM2(ji,jj) = 0.25*(dbu(ji,jj) + dbu(ji-1,jj)) * (dbu(ji,jj) + dbu(ji-1,jj)) &
+ 0.25*(dbv(ji,jj) + dbv(ji,jj-1)) * (dbv(ji,jj) + dbv(ji,jj-1))
END DO
END DO
- M2(:,:) = SQRT( M2(:,:) )
+ dM2(:,:) = SQRT( dM2(:,:) )
- ! Eddy Time Scale = N / M2
- ets(:,:) = spval
- WHERE (M2 /= 0 )
- ets = zn2/M2/86400. ! in seconds
+ ! Eddy Time Scale = N / dM2
+ dets(:,:) = spval
+ WHERE (dM2 /= 0 )
+ dets = zn2/dM2/86400. ! in seconds
ELSEWHERE
- ets = -10. ! flag ocean points with M2 = 0 (very few ?)
+ dets = -10.d0 ! flag ocean points with dM2 = 0 (very few ?)
END WHERE
- WHERE (zmask == 0 ) ets = spval
+ WHERE (zmask == 0 ) dets = spval
- ! write ets at level jk on the output file
- ierr = putvar(ncout, id_varout(1) ,SNGL(ets), jk, npiglo, npjglo)
+ ! write dets at level jk on the output file
+ ierr = putvar(ncout, id_varout(1) ,SNGL(dets), jk, npiglo, npjglo, ktime=jt)
! swap up and down, next will be read in up
itmp = idown ; idown = iup ; iup = itmp
END DO ! loop to next level
- ! repeat ets at the surface and level 2 (the last computed)
- ierr = putvar(ncout, id_varout(1) ,SNGL(ets), 1,npiglo, npjglo)
- ! apply land mask (level 2) on zlda (level 1 and 2 have same mask, as there are always at least 3 levels)
+ ! repeat dets at the surface and level 2 (the last computed)
+ ierr = putvar(ncout, id_varout(1) ,SNGL(dets), 1,npiglo, npjglo, ktime=jt)
+
+ ! apply land mask (level 2) on dlda (level 1 and 2 have same mask, as there are always at least 3 levels)
+ WHERE (zmask == 0 ) dlda=spval
+ ierr = putvar(ncout, id_varout(2) ,SNGL(dlda), 1,npiglo, npjglo, ktime=jt)
- ! Save zlda on file
- WHERE (zmask == 0 ) zlda=spval
- ierr = putvar(ncout, id_varout(2) ,SNGL(zlda), 1,npiglo, npjglo)
+ END DO ! time loop
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
- END PROGRAM cdfets
+END PROGRAM cdfets
diff --git a/cdffindij.f90 b/cdffindij.f90
index b521dd0..5595d7b 100644
--- a/cdffindij.f90
+++ b/cdffindij.f90
@@ -1,56 +1,87 @@
PROGRAM cdffindij
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdffindij ***
+ !!======================================================================
+ !! *** PROGRAM cdffindij ***
+ !!=====================================================================
+ !! ** Purpose : Return the window index (imin imax jmin jmax )
+ !! for the geographical windows given on input
+ !! (longmin longmax latmin matmax)
!!
- !! ** Purpose : return the window index (imin imax jmin jmax )
- !! for the geographical windows given on input (longmin longmax latmin matmax)
- !!
- !! ** Method : Read the coordinate/mesh_hgr file and look
- !! for the glam, gphi variables
- !! Then use a seach algorithm to find the corresponding I J
- !! The point type ( T U V F ) is specified on the command line
- !! as well as the name of the coordinate/mesh hgr file.
+ !! ** Method : Read the coordinate/mesh_hgr file and look for the glam,
+ !! gphi variables.
+ !! Then use a search algorithm to find the corresponding I J
+ !! The point type ( T U V F ) is specified on the command
+ !! line as well as the name of the coordinate/mesh hgr file.
!!
- !! history ;
- !! Original : J.M. Molines (November 2005 )
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2005 : J.M. Molines : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ USE cdfio
USE cdftools
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: narg, iargc, niter
- INTEGER :: imin, imax, jmin, jmax
- REAL(KIND=4) :: xmin, xmax, ymin, ymax
- CHARACTER(LEN=256) :: cdum, coord='coordinates.nc', ctype='F'
+
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: iimin, iimax, ijmin, ijmax ! model grid window
+
+ REAL(KIND=4) :: xmin, xmax, ymin, ymax ! geographical window
+
+ CHARACTER(LEN=256) :: ctype='F' ! point type to search for
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
!! Read command line and output usage message if not compliant.
narg= iargc()
IF ( narg < 4 ) THEN
- PRINT *,' Usage : cdffindij xmin xmax ymin ymax [coord_file] [point_type]'
- PRINT *,' return the i,j position for the zoomed area (nearest point ) '
- PRINT *,' as read in coord_file for the point type specified by point_type'
- PRINT *,' Example : cdffindij -70 15 -20 25 coordinate_ORCA025.nc F '
+ PRINT *,' usage : cdffindij xmin xmax ymin ymax [-c COOR-file] [-p point_type]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Return the model limit (i,j space) of the geographical window '
+ PRINT *,' given on the input line.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' xmin xmax ymin ymax : geographical limits of the window, in lon/lat'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-c COOR-file ] : specify a particular coordinate file'
+ PRINT *,' default is ',TRIM(cn_fcoo)
+ PRINT *,' [-p point type] : specify the point on the C-grid (T U V F)'
+ PRINT *,' default is ',TRIM(ctype)
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fcoo),' or the specified coordinates file.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' Output is done on standard output.'
STOP
ENDIF
- CALL getarg (1, cdum ) ; READ(cdum,*) xmin
- CALL getarg (2, cdum ) ; READ(cdum,*) xmax
- CALL getarg (3, cdum ) ; READ(cdum,*) ymin
- CALL getarg (4, cdum ) ; READ(cdum,*) ymax
+ ijarg = 1 ; ireq = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
+ CASE ( '-c' ) ; CALL getarg(ijarg, cn_fcoo ) ; ijarg=ijarg+1
+ CASE ( '-p' ) ; CALL getarg(ijarg, ctype ) ; ijarg=ijarg+1
+ CASE DEFAULT
+ ireq=ireq+1
+ SELECT CASE (ireq)
+ CASE ( 1 ) ; READ(cldum,*) xmin
+ CASE ( 2 ) ; READ(cldum,*) xmax
+ CASE ( 3 ) ; READ(cldum,*) ymin
+ CASE ( 4 ) ; READ(cldum,*) ymax
+ CASE DEFAULT
+ PRINT *,' Too many arguments !' ; STOP
+ END SELECT
+ END SELECT
+ END DO
- ! if 5th argument not given coordinates.nc is assumed
- IF ( narg > 4 ) THEN
- CALL getarg (5, coord )
- ENDIF
- ! if 6th argument not given, assume F point
- IF ( narg == 6 ) THEN
- CALL getarg (6, ctype )
- ENDIF
+ CALL cdf_findij ( xmin, xmax, ymin, ymax, iimin, iimax, ijmin, ijmax, cd_coord=cn_fcoo, cd_point=ctype)
- CALL cdf_findij ( xmin, xmax, ymin, ymax, imin, imax, jmin, jmax, cd_coord=coord, cd_point=ctype)
END PROGRAM cdffindij
diff --git a/cdffixtime.f90 b/cdffixtime.f90
index 7e64ed2..cbd3f24 100644
--- a/cdffixtime.f90
+++ b/cdffixtime.f90
@@ -1,40 +1,75 @@
PROGRAM cdffixtime
- !--------------------------------------------------------------------------------------
- ! *** PROGRAM cdffixtime ***
- !
- ! ** Purpose: change time variable to jcness deduce from time tag given in arguments
- !
- ! History:
- ! Jean-Marc Molines (March 2007) from old jcness
- !---------------------------------------------------------------------------------------
+ !!======================================================================
+ !! *** PROGRAM cdffixtime ***
+ !!=====================================================================
+ !! ** Purpose : Correct time inconsistency in model output file or
+ !! mean fields.
+ !!
+ !! ** Method : Adjust the values of time_counters in order to be
+ !! coherent with the time_origin and units attribute.
+ !! According to drakkar the time in seconds represents
+ !! the time of the model at the moment of output, ie at
+ !! the end of the averaging period. The time origin is
+ !! shifted back half the averaging period in order to
+ !! indicate the center of the averaging period.
+ !! This program is intended to manage both leap year
+ !! and noleap year calendars.
+ !!
+ !! History : 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! jcnes : return the jcnes Julian day from time tag
+ !! julday : return the true Julian day
+ !! caldatjm : Return the calendar date from the input jcnes day
+ !!----------------------------------------------------------------------
USE cdfio
-! USE netcdf
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- ! parameter to set the behaviour of the calendar : 365= no leap year
- ! 365.2425 = leap year
- REAL :: rpp_un_an = 365 !365.2425
- INTEGER :: narg, iargc, jarg
- INTEGER :: is, ie !: starting and ending position of the tag in file name
- INTEGER :: iyear, imon, iday
- INTEGER :: iyr_init, imm_init, idd_init
- INTEGER :: ihr_init, imn_init, isec_init
- REAL(KIND=4) :: rdt_obs=5. !: time interval between the observations (jcness will be offset by -rdt_obs/2
- REAL(KIND=4) :: rday0, rday_origin
- ! with respect to time tag
- REAL(KIND=4),DIMENSION(1) :: rdaycnes, rseconds
- CHARACTER(LEN=80) :: cfile, cdum, ctag='none', cdate, ctim
- CHARACTER(LEN=80) :: ctag0, ctim_unit, ctim_origin
- CHARACTER(LEN=3) :: cmm
- LOGICAL :: lnoleap=.true., lagrif=.false.
+ INTEGER(KIND=4) :: narg ! number of arguments
+ INTEGER(KIND=4) :: iargc ! f90 function
+ INTEGER(KIND=4) :: ijarg ! argument counter
+ INTEGER(KIND=4) :: is, ie ! starting and ending position of the tag in file name
+ INTEGER(KIND=4) :: iyr_init ! initial date (year)
+ INTEGER(KIND=4) :: imm_init ! initial date (month)
+ INTEGER(KIND=4) :: idd_init ! initial date (day)
+ INTEGER(KIND=4) :: ihr_init ! ititial time (hour)
+ INTEGER(KIND=4) :: imn_init ! ititial time (minutes)
+ INTEGER(KIND=4) :: isec_init ! ititial time (seconds)
+ INTEGER(KIND=4) :: ierr ! error status for i/o
+
+ REAL(KIND=4) :: rpp_one_year = 365 ! 365.2425
+ REAL(KIND=4) :: rdt_obs = 5. ! time interval between file fields (days)
+ REAL(KIND=4) :: rday0 ! CNES julian day corresponding to tag of initial date
+ REAL(KIND=4) :: rday_origin ! CNES julian day corresponding to origin date
+ REAL(KIND=4), DIMENSION(1) :: rdaycnes ! CNES julian day corresponding to current tag
+ REAL(KIND=4), DIMENSION(1) :: rseconds ! seconds since rday0
+
+ CHARACTER(LEN=80) :: cf_in ! input file
+ CHARACTER(LEN=80) :: cldum ! dummy character variable
+ CHARACTER(LEN=80) :: ctag='none' ! tag default. Interpreted from file name if possible
+ CHARACTER(LEN=80) :: cldate, ctim ! date and time as string
+ CHARACTER(LEN=80) :: ctag0 ! time tag from input initial date/time
+ CHARACTER(LEN=80) :: ctim_unit ! attribute value for time_counter unit
+ CHARACTER(LEN=80) :: ctim_origin ! attribute value for time_counter time_origin
+ CHARACTER(LEN=3) :: cmm ! month in character
+
+ LOGICAL :: lnoleap=.true. ! flag for noleap years
+ LOGICAL :: lagrif=.false. ! flag for agrif files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- ! Netcdf Stuff
- INTEGER :: istatus, ncid, id_time
- !---------------------------------------------------------------------------------------
- ! *
narg=iargc()
IF ( narg == 0 ) THEN
- PRINT *,' usage : cdffixtime -f file -i initial date [-t tag] [-leap] [ -noleap]'
+ PRINT *,' usage : cdffixtime -f file -i initial date [-t tag] [-dt freq] ... '
+ PRINT *,' ... [-leap] [ -noleap]'
PRINT *,' Change time_counter in file to set it according to drakkar rule'
PRINT *,' -i initial_date : to indicate time origin (yyyy-mm-dd hh:mm:ss) (2 words)'
PRINT *,' [-t tag ] : if not supplied, tag is taken from the name''s file'
@@ -45,73 +80,81 @@ PROGRAM cdffixtime
STOP
ENDIF
- jarg=1
- DO WHILE ( jarg <= narg )
- CALL getarg(jarg, cdum) ; jarg=jarg + 1
- SELECT CASE (cdum)
+ ! browse line option
+ ijarg=1
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum) ; ijarg=ijarg + 1
+ SELECT CASE (cldum)
CASE ( '-f' )
- CALL getarg(jarg,cfile) ;jarg=jarg +1
+ CALL getarg(ijarg,cf_in) ;ijarg=ijarg +1
CASE ( '-t' )
- CALL getarg(jarg,ctag) ; jarg=jarg +1
+ CALL getarg(ijarg,ctag) ; ijarg=ijarg +1
CASE ( '-dt' )
- CALL getarg(jarg,cdum) ; jarg=jarg +1
- READ(cdum,*) rdt_obs
+ CALL getarg(ijarg,cldum) ; ijarg=ijarg +1
+ READ(cldum,*) rdt_obs
CASE ( '-i' )
- CALL getarg(jarg,cdate) ; jarg=jarg +1
- CALL getarg(jarg,ctim) ; jarg=jarg +1
+ CALL getarg(ijarg,cldate) ; ijarg=ijarg +1
+ CALL getarg(ijarg,ctim) ; ijarg=ijarg +1
CASE ( '-leap' )
- rpp_un_an=365.2425
+ rpp_one_year=365.2425
lnoleap=.false.
CASE ( '-noleap' )
- rpp_un_an=365
+ rpp_one_year=365
lnoleap=.true.
CASE DEFAULT
- PRINT *,' Option ',TRIM(cdum),' unknown'
+ PRINT *,' Option ',TRIM(cldum),' unknown'
STOP
END SELECT
END DO
+
+ IF ( chkfile(cf_in) ) STOP ! missing file
+ PRINT *,' Changing time on file :', TRIM(cf_in)
! if ctag = none, try to find it from the file name.
-
- IF ( TRIM(ctag) == 'none' ) THEN
- is = INDEX(cfile,'_')
+ IF ( TRIM(ctag) == 'none' ) THEN ! no tag given as arguments
+ is = INDEX(cf_in,'_')
IF ( is == 2 ) THEN
- PRINT *,' ASSUME AGRIF file for ', TRIM(cfile)
+ PRINT *,' ASSUME AGRIF file for ', TRIM(cf_in)
lagrif = .TRUE.
ENDIF
+
IF (lagrif) THEN
- is=INDEX(cfile(3:),'_' )+2
- ie=INDEX(cfile(is+1:),'_' )
- ctag=cfile(is+1:is+ie-1)
+ is=INDEX(cf_in(3:),'_' )+2
+ ie=INDEX(cf_in(is+1:),'_' )
+ ctag=cf_in(is+1:is+ie-1)
ELSE
- is=INDEX(cfile,'_')
- ie=INDEX(cfile(is+1:),'_' )
- ctag=cfile(is+1:is+ie-1)
+ is=INDEX(cf_in,'_')
+ ie=INDEX(cf_in(is+1:),'_' )
+ ctag=cf_in(is+1:is+ie-1)
ENDIF
- ENDIF
- PRINT *,' Changing time on file :', TRIM(cfile)
- is=INDEX(ctag,'d')
- IF ( is == 0 ) THEN ! not a model output but a mean value
- is=INDEX(ctag,'m')
- IF ( is == 0 ) THEN ! annual mean set pseudo date to 01/07
- ctag=ctag(1:5)//"m07d01"
- ELSE ! monthly mean
- ctag=ctag(1:8)//"d15"
+ is=INDEX(ctag,'d')
+ IF ( is == 0 ) THEN ! not a model output but a mean value
+ is=INDEX(ctag,'m')
+ IF ( is == 0 ) THEN ! annual mean set pseudo date to 01/07
+ ctag=ctag(1:5)//"m07d01"
+ ELSE ! monthly mean set pseudo date to the 15 of month
+ ctag=ctag(1:8)//"d15"
+ ENDIF
ENDIF
ENDIF
+
PRINT *,' Using tag = ', TRIM(ctag)
- ! interpret ctim and cdate
- READ(cdate,'(i4,1x,i2,1x,i2)') iyr_init, imm_init, idd_init
- READ(ctim,'(i2,1x,i2,1x,i2)') ihr_init, imn_init, isec_init
+ ! interpret ctim and cldate
+ READ(cldate,'(i4,1x,i2,1x,i2)' ) iyr_init, imm_init, idd_init
+ READ(ctim, '(i2,1x,i2,1x,i2)' ) ihr_init, imn_init, isec_init
WRITE(ctag0,'("y",i4.4,"m",i2.2,"d",i2.2)') iyr_init, imm_init, idd_init
- rday0=jcnes(ctag0)+ihr_init/24.0 + imn_init/60./24. + isec_init/3600./24.
- rday_origin = rday0 - rdt_obs/2.
- CALL caldatjm( rday_origin, iyr_init, imm_init, idd_init, ihr_init, imn_init, isec_init)
- WRITE(cdate,'(i4.4,"-",i2.2,"-",i2.2)') iyr_init, imm_init, idd_init
- WRITE(ctim, '(i2.2,":",i2.2,":",i2.2)') ihr_init, imn_init, isec_init
+ ! jcnes of initial date including time as fraction of days
+ rday0 = jcnes(ctag0) + ihr_init/24.0 + imn_init/60./24. + isec_init/3600./24.
+
+ ! compute the pseudo time_origin and set up variable attributes
+ rday_origin = rday0 - rdt_obs/2. ! offset of -1/2 of time interval
+ CALL caldatjm(rday_origin, iyr_init, imm_init, idd_init, ihr_init, imn_init, isec_init)
+
+ WRITE(cldate,'(i4.4,"-",i2.2,"-",i2.2)') iyr_init, imm_init, idd_init
+ WRITE(ctim, '(i2.2,":",i2.2,":",i2.2)') ihr_init, imn_init, isec_init
! Compute initial julian day
SELECT CASE ( imm_init )
@@ -129,157 +172,152 @@ PROGRAM cdffixtime
CASE ( 12 ) ; cmm='DEC'
END SELECT
+ WRITE(ctim_unit, '("seconds since ",a,i3.2,":",i2.2,":",i2.2 )') TRIM(cldate), ihr_init, imn_init, isec_init
+ WRITE(ctim_origin,'(i5,"-",a,"-",i2.2," ",i2.2,":",i2.2,":",i2.2)') iyr_init,cmm, idd_init, ihr_init, imn_init, isec_init
- WRITE(ctim_unit,'("seconds since ",a,i3.2,":",i2.2,":",i2.2)') TRIM(cdate), ihr_init, imn_init, isec_init
- WRITE(ctim_origin,'(i5,"-",a,"-",i2.2," ",i2.2,":",i2.2,":",i2.2)') iyr_init,cmm,idd_init, ihr_init, imn_init, isec_init
- PRINT *, iyr_init, imm_init, idd_init, ihr_init, imn_init, isec_init
- PRINT *, TRIM(ctim_unit)
- PRINT *, TRIM(ctim_origin)
+ PRINT *, " ",TRIM(cn_vtimec)," units set to : ", TRIM(ctim_unit)
+ PRINT *, " ",TRIM(cn_vtimec)," time origin set to : ", TRIM(ctim_origin)
! Compute corresponding jcnes
rdaycnes=jcnes(ctag)
rseconds=(rdaycnes - rday0 +1 ) * 86400.
! Modify cdfile !! CAUTION : Original file will be modified !!
- istatus = putvar1d( cfile, 'time_counter', rseconds, 1 )
- istatus = atted(cfile,'time_counter','units',ctim_unit)
- istatus = atted(cfile,'time_counter','time_origin',ctim_origin)
+ ierr = putvar1d( cf_in, cn_vtimec, rseconds, 1 )
+ ierr = atted ( cf_in, cn_vtimec, 'units', ctim_unit )
+ ierr = atted ( cf_in, cn_vtimec, 'time_origin', ctim_origin)
CONTAINS
- FUNCTION jcnes(cdtag)
- IMPLICIT NONE
+ REAL(KIND=4) FUNCTION jcnes(cdtag)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION jcnes ***
+ !!
+ !! ** Purpose : return the JCNES corresponding to time tag. JCNES is a julian
+ !! day refered from 1950-01-01
+ !!
+ !! ** Method : Interface with function julday
+ !!
+ !!----------------------------------------------------------------------
CHARACTER(LEN=*),INTENT(in) :: cdtag
- REAL(KIND=4) :: jcnes
- ! local variables
- INTEGER :: iyear,imon,iday
- REAL(KIND=4) :: sec=0.
- REAL(KIND=4) :: rjuldeb, rjulfin, rjulday
+
+ INTEGER(KIND=4) :: iyear, imon, iday
+ REAL(KIND=4) :: zsec = 0.
+ REAL(KIND=4) :: zjuldeb, zjulfin, zjulday
READ(cdtag,'(1x,i4.4,1x,i2.2,1x,i2.2)') iyear, imon, iday
- sec=0.
+ zsec=0.
!---------------------------------------------------------------------
- rjulfin = julday(iyear,imon,iday,sec)
- rjuldeb = julday(1950,01,01,0.)
- jcnes = rjulfin - rjuldeb
+ zjulfin = julday(iyear, imon, iday, zsec)
+ zjuldeb = julday(1950, 01, 01, 0.)
+ jcnes = zjulfin - zjuldeb
END FUNCTION jcnes
- FUNCTION julday(kyear,kmonth,kday,rsec)
- !---------------------------------------------------------------------
- !- Converts year, month, day and seconds into a julian day
- !-
- !- In 1968 in a letter to the editor of Communications of the ACM
- !- (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel
- !- and Thomas C. Van Flandern presented such an algorithm.
- !-
- !- See also : http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm
- !-
- !- In the case of the Gregorian calendar we have chosen to use
- !- the Lilian day numbers. This is the day counter which starts
- !- on the 15th October 1582.
- !- This is the day at which Pope Gregory XIII introduced the
- !- Gregorian calendar.
- !- Compared to the true Julian calendar, which starts some
- !- 7980 years ago, the Lilian days are smaler and are dealt with
- !- easily on 32 bit machines. With the true Julian days you can only
- !- the fraction of the day in the real part to a precision of
- !- a 1/4 of a day with 32 bits.
- !---------------------------------------------------------------------
- IMPLICIT NONE
- !-
- INTEGER, INTENT(in) :: kyear,kmonth,kday
- REAL(KIND=4),INTENT(in) :: rsec
- REAL(KIND=4) :: julday
-
- ! Local variables
- REAL,PARAMETER :: pp_un_jour = 86400.0
- INTEGER,PARAMETER :: jp_mon_len(12)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+ REAL(KIND=4) FUNCTION julday(kyear, kmonth, kday, psec)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION julday ***
+ !!
+ !! ** Purpose : Converts year, month, day and seconds into a julian day
+ !!
+ !! ** Method : In 1968 in a letter to the editor of Communications of
+ !! the ACM (CACM, volume 11, number 10, October 1968, p.657)
+ !! Henry F. Fliegel and Thomas C. Van Flandern presented
+ !! such an algorithm.
+ !! In the case of the Gregorian calendar we have chosen
+ !! to use the Lilian day numbers. This is the day counter
+ !! which starts on the 15th October 1582.
+ !! This is the day at which Pope Gregory XIII introduced the
+ !! Gregorian calendar.
+ !! Compared to the true Julian calendar, which starts some
+ !! 7980 years ago, the Lilian days are smaller and are dealt
+ !! with easily on 32 bit machines. With the true Julian days
+ !! you can only the fraction of the day in the real part to
+ !! a precision of a 1/4 of a day with 32 bits.
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kyear, kmonth, kday ! input date
+ REAL(KIND=4), INTENT(in) :: psec ! input seconds
- INTEGER :: mm, iy, id, jd, ml
- INTEGER :: julian_day
- REAL :: rjulian_sec
+ REAL(KIND=4), PARAMETER :: pp_one_day = 86400.0
+ INTEGER(KIND=4), PARAMETER :: jp_mon_len(12)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
- CHARACTER(LEN=3),PARAMETER :: &
- & cal(12) = (/'JAN','FEB','MAR','APR','MAY','JUN', &
- & 'JUL','AUG','SEP','OCT','NOV','DEC'/)
+ INTEGER(KIND=4) :: in_m, in_y, in_d
+ INTEGER(KIND=4) :: ijd, iml
!---------------------------------------------------------------------
- mm = kmonth
- iy = kyear
- id = kday
- !-
+ in_m = kmonth
+ in_y = kyear
+ in_d = kday
!- We deduce the calendar from the length of the year as it
!- is faster than an INDEX on the calendar variable.
!-
!- Gregorian
- IF ( (rpp_un_an > 365.0).AND.(rpp_un_an < 366.0) ) THEN
- jd = (1461*(iy+4800+INT(( mm-14 )/12)))/4 &
- & +(367*(mm-2-12*(INT(( mm-14 )/12))))/12 &
- & -(3*((iy+4900+INT((mm-14)/12))/100))/4 &
- & +id-32075
- jd = jd-2299160
+ IF ( (rpp_one_year > 365.0) .AND. (rpp_one_year < 366.0) ) THEN
+ ijd = (1461*(in_y+4800+INT(( in_m-14 )/12)))/4 &
+ & +(367*(in_m-2-12*(INT(( in_m-14 )/12))))/12 &
+ & -(3*((in_y+4900+INT((in_m-14)/12))/100))/4 &
+ & +in_d-32075
+ ijd = ijd-2299160
!- No leap or All leap
- ELSE IF (ABS(rpp_un_an-365.0) <= EPSILON(rpp_un_an) .OR. &
- & ABS(rpp_un_an-366.0) <= EPSILON(rpp_un_an)) THEN
- ml = SUM(jp_mon_len(1:mm-1))
- jd = iy*INT(rpp_un_an)+ml+(id-1)
+ ELSE IF (ABS(rpp_one_year-365.0) <= EPSILON(rpp_one_year) .OR. &
+ & ABS(rpp_one_year-366.0) <= EPSILON(rpp_one_year)) THEN
+ iml = SUM(jp_mon_len(1:in_m-1))
+ ijd = in_y*INT(rpp_one_year)+iml+(in_d-1)
!- Calendar with regular month
! ELSE
- ! ml = INT(un_an)/12
- ! jd = y*INT(un_an)+(m-1)*ml+(d-1)
+ ! iml = INT(one_year)/12
+ ! ijd = y*INT(one_year)+(m-1)*iml+(d-1)
ENDIF
!-
- julian_day = jd
- rjulian_sec = rsec
- julday = julian_day+rjulian_sec / pp_un_jour
+ julday = ijd + psec / pp_one_day
END FUNCTION julday
+
SUBROUTINE caldatjm( pjcnes, ky, km, kd, kh, kmn, ksec )
- !!--------------------------------------------------------------------------------
- !! *** ROUTINE caldatjm ***
- !!
- !! Purpose : return the calendar date from the jcnes given in argument
- !!
- !! Method : jcnes= 0 is 1950/01/01 00:00:00
- !! Take care of leap/noleap year
- !!--------------------------------------------------------------------------------
- REAL(KIND=4), INTENT(in) :: pjcnes
- INTEGER, INTENT(out) :: ky, km, kd, kh, kmn, ksec
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE caldatjm ***
+ !!
+ !! ** Purpose : Compute the calendar date from the julian CNES day
+ !! given as input
+ !!
+ !! ** Method : Take care of the leap/noleap calendar. That's why we
+ !! cannot use the standard caldat from numerical recipe
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), INTENT(in) :: pjcnes
+ INTEGER(KIND=4), INTENT(out) :: ky, km, kd, kh, kmn, ksec
- INTEGER :: isec, idays
- INTEGER :: jd, jm
- INTEGER, DIMENSION(12) :: indays=(/31,28,31,30,31,30,31,31,30,31,30,31/)
- INTEGER, DIMENSION(12) :: icumul
- !!--------------------------------------------------------------------------------
- icumul(1) = indays(1)
- DO jm=2,12
- icumul(jm)=icumul(jm-1)+indays(jm)
- ENDDO
-
- ! look for time
- isec = (pjcnes-INT(pjcnes) ) * 86400.
- kh = isec/3600
- kmn = (isec - kh * 3600 )/60
- ksec = isec - kh * 3600 - kmn * 60
-
- ! number of years since 1950
- IF ( lnoleap ) THEN ! no leap years
- ky=1950 + INT(pjcnes)/365
- idays= ( INT(pjcnes)/ 365. - INT(pjcnes)/365 )* 365
- km=1 ; kd=0
- DO jd=1, idays
- IF ( jd > icumul(km) ) THEN
- km=km+1
- kd=1
- ELSE
- kd=kd+1
- ENDIF
+ INTEGER(KIND=4) :: jd, jm ! dummy loop index
+ INTEGER(KIND=4) :: isec, idays
+ INTEGER(KIND=4), DIMENSION(12) :: indays=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+ INTEGER(KIND=4), DIMENSION(12) :: icumul
+ !!--------------------------------------------------------------------------------
+ ! initialize the cumulated time
+ icumul(1) = indays(1)
+ DO jm=2,12
+ icumul(jm) = icumul(jm-1) + indays(jm)
ENDDO
- ELSE
- PRINT *, 'Not done yet for leap years'
- ENDIF
- END SUBROUTINE caldatjm
-
-
+
+ ! look for time part of pjcnes
+ isec = (pjcnes-INT(pjcnes) ) * 86400.
+ kh = isec/3600
+ kmn = (isec - kh * 3600 )/60
+ ksec = isec - kh * 3600 - kmn * 60
+
+ ! number of years since 1950
+ IF ( lnoleap ) THEN ! no leap years
+ ky=1950 + INT(pjcnes)/365
+ idays= ( INT(pjcnes)/ 365. - INT(pjcnes)/365 )* 365
+ km=1 ; kd=0
+ DO jd=1, idays
+ IF ( jd > icumul(km) ) THEN
+ km=km+1
+ kd=1
+ ELSE
+ kd=kd+1
+ ENDIF
+ ENDDO
+ ELSE
+ PRINT *, 'Not done yet for leap years'
+ ENDIF
+ END SUBROUTINE caldatjm
END PROGRAM cdffixtime
diff --git a/cdfflxconv.f90 b/cdfflxconv.f90
index d69b5c7..7bee4f5 100644
--- a/cdfflxconv.f90
+++ b/cdfflxconv.f90
@@ -139,37 +139,37 @@ PROGRAM cdfflxconv
ALLOCATE ( typvarqsr(nvar), ipkqsr(nvar), id_varoutqsr(nvar) )
jvar=1
ipkemp(jvar) = 1
- typvaremp(jvar)%name='sowaflup' ! E - P = dim 3 - dim 4 dimgfile
- typvaremp(jvar)%units='kg/m2/s'
- typvaremp(jvar)%missing_value=0.
+ typvaremp(jvar)%cname='sowaflup' ! E - P = dim 3 - dim 4 dimgfile
+ typvaremp(jvar)%cunits='kg/m2/s'
+ typvaremp(jvar)%rmissing_value=0.
typvaremp(jvar)%valid_min= -0.002
typvaremp(jvar)%valid_max= 0.002
- typvaremp(jvar)%long_name='E-P Upward water flux'
- typvaremp(jvar)%short_name='sowaflup'
- typvaremp(jvar)%online_operation='N/A'
- typvaremp(jvar)%axis='TYX'
+ typvaremp(jvar)%clong_name='E-P Upward water flux'
+ typvaremp(jvar)%cshort_name='sowaflup'
+ typvaremp(jvar)%conline_operation='N/A'
+ typvaremp(jvar)%caxis='TYX'
ipkqnet(jvar) = 1
- typvarqnet(jvar)%name='sohefldo' ! QNET = dim 1 dimgfile
- typvarqnet(jvar)%units='W/m2'
- typvarqnet(jvar)%missing_value=0.
+ typvarqnet(jvar)%cname='sohefldo' ! QNET = dim 1 dimgfile
+ typvarqnet(jvar)%cunits='W/m2'
+ typvarqnet(jvar)%rmissing_value=0.
typvarqnet(jvar)%valid_min= -1000.
typvarqnet(jvar)%valid_max= 1000.
- typvarqnet(jvar)%long_name='Net_Downward_Heat_Flux'
- typvarqnet(jvar)%short_name='sohefldo'
- typvarqnet(jvar)%online_operation='N/A'
- typvarqnet(jvar)%axis='TYX'
+ typvarqnet(jvar)%clong_name='Net_Downward_Heat_Flux'
+ typvarqnet(jvar)%cshort_name='sohefldo'
+ typvarqnet(jvar)%conline_operation='N/A'
+ typvarqnet(jvar)%caxis='TYX'
ipkqsr(jvar) = 1
- typvarqsr(jvar)%name='soshfldo' ! QSR = dim 2 dimgfile
- typvarqsr(jvar)%units='W/m2'
- typvarqsr(jvar)%missing_value=0.
+ typvarqsr(jvar)%cname='soshfldo' ! QSR = dim 2 dimgfile
+ typvarqsr(jvar)%cunits='W/m2'
+ typvarqsr(jvar)%rmissing_value=0.
typvarqsr(jvar)%valid_min= -1000.
typvarqsr(jvar)%valid_max= 1000.
- typvarqsr(jvar)%long_name='Short_Wave_Radiation'
- typvarqsr(jvar)%short_name='soshfldo'
- typvarqsr(jvar)%online_operation='N/A'
- typvarqsr(jvar)%axis='TYX'
+ typvarqsr(jvar)%clong_name='Short_Wave_Radiation'
+ typvarqsr(jvar)%cshort_name='soshfldo'
+ typvarqsr(jvar)%conline_operation='N/A'
+ typvarqsr(jvar)%caxis='TYX'
ncoutemp =create(cemp, 'none',npiglo,npjglo,npk,cdep='deptht' )
istatus= createvar(ncoutemp ,typvaremp,nvar, ipkemp,id_varoutemp )
@@ -266,26 +266,26 @@ PROGRAM cdfflxconv
ALLOCATE ( typvartauy(nvar), ipktauy(nvar), id_varouttauy(nvar) )
jvar=1
ipktaux(jvar) = 1
- typvartaux(jvar)%name='sozotaux' ! taux dim 1 of dimgfile
- typvartaux(jvar)%units='N/m2'
- typvartaux(jvar)%missing_value=0.
+ typvartaux(jvar)%cname='sozotaux' ! taux dim 1 of dimgfile
+ typvartaux(jvar)%cunits='N/m2'
+ typvartaux(jvar)%rmissing_value=0.
typvartaux(jvar)%valid_min= -0.1
typvartaux(jvar)%valid_max= 0.1
- typvartaux(jvar)%long_name='Zonal Wind Stress'
- typvartaux(jvar)%short_name='sozotaux'
- typvartaux(jvar)%online_operation='N/A'
- typvartaux(jvar)%axis='TYX'
+ typvartaux(jvar)%clong_name='Zonal Wind Stress'
+ typvartaux(jvar)%cshort_name='sozotaux'
+ typvartaux(jvar)%conline_operation='N/A'
+ typvartaux(jvar)%caxis='TYX'
ipktauy(jvar) = 1
- typvartauy(jvar)%name='sometauy' ! tauy dim 2 of dimgfile
- typvartauy(jvar)%units='N/m2'
- typvartauy(jvar)%missing_value=0.
+ typvartauy(jvar)%cname='sometauy' ! tauy dim 2 of dimgfile
+ typvartauy(jvar)%cunits='N/m2'
+ typvartauy(jvar)%rmissing_value=0.
typvartauy(jvar)%valid_min= -0.1
typvartauy(jvar)%valid_max= 0.1
- typvartauy(jvar)%long_name='Meridional Wind Stress'
- typvartauy(jvar)%short_name='sometauy'
- typvartauy(jvar)%online_operation='N/A'
- typvartauy(jvar)%axis='TYX'
+ typvartauy(jvar)%clong_name='Meridional Wind Stress'
+ typvartauy(jvar)%cshort_name='sometauy'
+ typvartauy(jvar)%conline_operation='N/A'
+ typvartauy(jvar)%caxis='TYX'
ncouttaux =create(ctaux, 'none',npiglo,npjglo,npk,cdep='deptht' )
istatus= createvar(ncouttaux ,typvartaux,nvar, ipktaux,id_varouttaux )
@@ -357,15 +357,15 @@ PROGRAM cdfflxconv
ALLOCATE ( typvarsst(nvar), ipksst(nvar), id_varoutsst(nvar) )
jvar=1
ipksst(jvar) = 1
- typvarsst(jvar)%name='sst' ! sst dim 1 of dimgfile
- typvarsst(jvar)%units='C'
- typvarsst(jvar)%missing_value=0.
+ typvarsst(jvar)%cname='sst' ! sst dim 1 of dimgfile
+ typvarsst(jvar)%cunits='C'
+ typvarsst(jvar)%rmissing_value=0.
typvarsst(jvar)%valid_min= -10.
typvarsst(jvar)%valid_max= 50.
- typvarsst(jvar)%long_name='Reynolds SST'
- typvarsst(jvar)%short_name='SST'
- typvarsst(jvar)%online_operation='N/A'
- typvarsst(jvar)%axis='TYX'
+ typvarsst(jvar)%clong_name='Reynolds SST'
+ typvarsst(jvar)%cshort_name='SST'
+ typvarsst(jvar)%conline_operation='N/A'
+ typvarsst(jvar)%caxis='TYX'
ncoutsst =create(csst, 'none',npiglo,npjglo,npk,cdep='deptht' )
istatus= createvar(ncoutsst ,typvarsst,nvar, ipksst,id_varoutsst )
diff --git a/cdffracinv.f90 b/cdffracinv.f90
index 7a54efe..2afd1d7 100644
--- a/cdffracinv.f90
+++ b/cdffracinv.f90
@@ -1,94 +1,124 @@
PROGRAM cdffracinv
- !!-------------------------------------------------------------------
- !! PROGRAM CDFFRACINV
- !! ******************
+ !!======================================================================
+ !! *** PROGRAM cdffracinv ***
+ !!=====================================================================
+ !! ** Purpose : Computes fraction of inventory for passive tracers
+ !! output. This is the ratio between inventory at a
+ !! grid point and total inventory
!!
- !! ** Purpose: Computes fraction of inventory for passive tracers
- !! output. This is the ratio between inventory at a
- !! grid point and total inventory
- !!
- !! ** Method: takes TRC files as input
- !!
- !! history:
- !! Original: C.O. Dufour (Jul. 2010)
- !!-------------------------------------------------------------------
- !!--------------------------------------------------------------
- !!
- !! * Modules used
+ !! History : 2.1 : 07/2010 : C.O. Dufour : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, jarg
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, id_varout
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: trcinvij, fracinv
- REAL(KIND=4) ,DIMENSION(1) :: timean
-
- CHARACTER(LEN=256) :: cfiletrc, cfileout='fracinv.nc' !: file name
- CHARACTER(LEN=256) :: cinv='invcfc' , cdum
- TYPE(variable), DIMENSION(1) :: typvar
-
- INTEGER :: ncout
- INTEGER :: istatus, ierr
-
- !! Read command line
- narg= iargc()
+
+ INTEGER(KIND=4) :: jt ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's of output vars
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: trcinvij ! tracer inventory
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: fracinv ! fraction of inventory
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ CHARACTER(LEN=256) :: cf_trc ! tracer file (for inventory)
+ CHARACTER(LEN=256) :: cf_out='fracinv.nc' ! output file name
+ CHARACTER(LEN=256) :: cv_inv='invcfc' ! inventory name
+ CHARACTER(LEN=256) :: cv_out='fracinv' ! output variable name
+ CHARACTER(LEN=256) :: cglobal ! global attribute
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ TYPE(variable), DIMENSION(1) :: stypvar ! structure for attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdffracinv ''TRC file'' [-inv inventory_name ]'
- PRINT *,' if not given, inventory name is invcfc '
- PRINT *,' Output on fracinv.nc ,variable fracinv (no unit) '
+ PRINT *,' usage : cdffracinv TRC-file [-inv INV-name]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the fraction of inventory for passive tracers, which is '
+ PRINT *,' the ratio between inventory at a grid point and the total inventory.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' TRC-file : netcdf file with tracer inventory.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' -inv INV-name : name of the netcdf name for inventory [ ',TRIM(cv_inv),' ]'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none ... but : horizontal weight to be coded ?'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_out)
STOP
ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfiletrc)
- IF ( narg > 1 ) THEN
- jarg=2
- DO WHILE (jarg <= narg )
- CALL getarg(jarg,cdum)
- SELECT CASE (cdum)
- CASE ('-inv') ; jarg=jarg+1 ; CALL getarg(jarg,cinv) ; jarg=jarg+1
- CASE DEFAULT ; PRINT *, 'option ', TRIM(cdum),' not understood' ; STOP
- END SELECT
- END DO
- ENDIF
-
- npiglo = getdim (cfiletrc,'x')
- npjglo = getdim (cfiletrc,'y')
- npk = getdim (cfiletrc,'depth')
-
- ipk(1) = 1
- typvar(1)%name='fracinv'
- typvar(1)%units=''
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 10000.
- typvar(1)%long_name='Fraction of inventory'
- typvar(1)%short_name='fracinv'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+
+ ijarg = 1
+ CALL getarg (ijarg, cf_trc) ; ijarg = ijarg + 1
+
+ IF ( chkfile(cf_trc) ) STOP ! missing file
+
+ DO WHILE (ijarg <= narg )
+ CALL getarg(ijarg,cldum ) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-inv' ) ; CALL getarg(ijarg, cv_inv) ; ijarg =ijarg + 1
+ CASE DEFAULT ; PRINT *, 'option ', TRIM(cldum),' not understood' ; STOP
+ END SELECT
+ END DO
+
+ npiglo = getdim (cf_trc,cn_x)
+ npjglo = getdim (cf_trc,cn_y)
+ npk = getdim (cf_trc,cn_z)
+ npt = getdim (cf_trc,cn_t)
+
+ ipk(1) = 1
+ stypvar(1)%cname = cv_out
+ stypvar(1)%cunits = ''
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 10000.
+ stypvar(1)%clong_name = 'Fraction of inventory'
+ stypvar(1)%cshort_name = cv_out
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
ALLOCATE( trcinvij(npiglo,npjglo), fracinv(npiglo,npjglo) )
+ ALLOCATE( tim(npt) )
- ncout =create(cfileout, cfiletrc,npiglo,npjglo,1)
+ WRITE(cglobal,9000) TRIM(cf_trc), TRIM(cv_inv)
+9000 FORMAT('cdffracinv ',a,' -inv ',a )
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfiletrc, npiglo, npjglo,1)
+ ncout = create (cf_out, cf_trc, npiglo, npjglo, 1 )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout, cdglobal=cglobal )
+ ierr = putheadervar(ncout, cf_trc, npiglo, npjglo, 1 )
- fracinv(:,:)=0.
- trcinvij(:,:) = getvar(cfiletrc,cinv,1 ,npiglo, npjglo)
- fracinv(:,:)=trcinvij(:,:)/SUM(trcinvij(:,:))
- ierr=putvar(ncout,id_varout(1), fracinv, 1 ,npiglo, npjglo)
+ DO jt=1,npt
+ fracinv( :,:) = 0.
+ trcinvij(:,:) = getvar(cf_trc, cv_inv, 1, npiglo, npjglo, ktime=jt)
+ ! JMM bug ?? : SUM(trcinij) is not the 'total inventory', should be weighted by model metrics ???
+ ! also assume spval is 0
+ fracinv( :,:) = trcinvij(:,:) / SUM(trcinvij(:,:))
+ ierr = putvar(ncout, id_varout(1), fracinv, 1, npiglo, npjglo, ktime=jt)
+ END DO
- timean=getvar1d(cfiletrc,'time_counter',1)
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
+ tim = getvar1d(cf_trc, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = closeout(ncout)
END PROGRAM cdffracinv
diff --git a/cdfgeo-uv.f90 b/cdfgeo-uv.f90
index b729b4c..5e192ff 100644
--- a/cdfgeo-uv.f90
+++ b/cdfgeo-uv.f90
@@ -1,160 +1,203 @@
PROGRAM cdfgeo_uv
- !!---------------------------------------------------------------------------
- !! *** PROGRAM cdfgeo_uv ***
+ !!======================================================================
+ !! *** PROGRAM cdfgeo_uv ***
+ !!=====================================================================
+ !! ** Purpose : Compute the ug and vg component of the geostrophic
+ !! velocity from the SSH field
+ !!
+ !! ** Method : ug = -g/f * d(ssh)/dy
+ !! vg = g/f * d(ssh)/dx
!!
- !! ** Purpose: Compute the ug and vg component of the geostrophic velocity
- !! from the SSH field
- !!
- !! ** Method : ug = -g/f * d(ssh)/dy
- !! vg = g/f * d(ssh)/dx
- !!
!! ** Note : ug is located on a V grid point
- !! vg U grid point
+ !! vg U grid point
!!
!!
- !! history :
- !! Original : J. Jouanno (Feb 2008)
- ! remark JMM : use of fmask ? use of ff ?
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 02/2008 : J. Juanno : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. and bug fix
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj !: dummy loop index
- INTEGER :: npiglo, npjglo , npk !: size of the domain
- INTEGER :: narg, iargc, ncoutu, ncoutv , ierr !:
- INTEGER, DIMENSION(1) :: ipk, id_varoutu , id_varoutv !
-
- REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: e1u, e2v , ff !, e1t, e2t !: metrics
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: glamt, gphit , glamv , gphiv , glamu , gphiu !: longitude latitude
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: un, vn
- REAL(KIND=4) , DIMENSION (:), ALLOCATABLE :: dep
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: sshn , fmask
- REAL(KIND=4) ,DIMENSION(1) :: tim
- REAL(KIND=4) :: g
- CHARACTER(LEN=256) :: cfilt
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc'
- CHARACTER(LEN=256) :: cfiloutu='ugeo.nc' , cfileoutv='vgeo.nc'
- CHARACTER(LEN=256) :: cvart='sossheig', cvaru='vozocrtx', cvarv='vomecrty'
-
- TYPE(variable), DIMENSION(1) :: typvaru ,typvarv !: structure for attributes
-
- g=9.81
- !!
+ INTEGER(KIND=4) :: ji, jj, jt ! dummy loop index
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: narg, iargc ! browse line
+ INTEGER(KIND=4) :: ncoutu ! ncid for ugeo file
+ INTEGER(KIND=4) :: ncoutv ! ncid for vgeo file
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4), DIMENSION(1) :: ipk ! levels of output vars
+ INTEGER(KIND=4), DIMENSION(1) :: id_varoutu ! varid for ugeo
+ INTEGER(KIND=4), DIMENSION(1) :: id_varoutv ! varid for vgeo
+
+ REAL(KIND=4) :: grav ! gravity
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1u, e2v, ff ! horiz metrics, coriolis (f-point)
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamu, gphiu ! longitude latitude u-point
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamv, gphiv ! longitude latitude v-point
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn ! velocity components
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsshn ! ssh
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: umask, vmask ! mask at u and v points
+
+ CHARACTER(LEN=256) :: cf_tfil ! input file name
+ CHARACTER(LEN=256) :: cf_uout='ugeo.nc'
+ CHARACTER(LEN=256) :: cf_vout='vgeo.nc'
+
+ TYPE(variable), DIMENSION(1) :: stypvaru ! attributes for ugeo
+ TYPE(variable), DIMENSION(1) :: stypvarv ! attributes for vgeo
+
+ LOGICAL :: lchk ! file existence flag
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ grav = 9.81 ! gravity
+
narg = iargc()
- IF ( narg < 1 ) THEN
- PRINT *,' USAGE : cdfgeo-uv fileT'
- PRINT *,' Read sossheig on grid T'
- PRINT *,' Produce 2 cdf file ugeo.nc and vgeo.nc with vozocrtx and vomecrty variables'
- PRINT *,' Names of the variable have been chosen to be compatible with cdfeke, but note '
- PRINT *,' that Ugeo and Vgeo are now respectively on V and U grid points'
- PRINT *,' Need mesh_hgr.nc mesh_zgr.nc'
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfgeo-uv T-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the geostrophic velocity component from the gradient '
+ PRINT *,' of the SSH read in the input file. Note that in the C-grid '
+ PRINT *,' output file, the zonal component is located on V point and the'
+ PRINT *,' meridional component is located on U point.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with SSH.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' - netcdf file : ', TRIM(cf_uout)
+ PRINT *,' variables : ', TRIM(cn_vozocrtx)
+ PRINT *,' *** CAUTION: this variable is located on V-point ***'
+ PRINT *,' - netcdf file : ', TRIM(cf_vout)
+ PRINT *,' variables : ', TRIM(cn_vomecrty)
+ PRINT *,' *** CAUTION: this variable is located on U-point ***'
STOP
ENDIF
- CALL getarg(1, cfilt)
-
- npiglo = getdim(cfilt,'x')
- npjglo = getdim(cfilt,'y')
- npk = getdim(cfilt,'depth')
-
- ipk(1)=1
-
- typvaru(1)%name=TRIM(cvaru)
- typvaru(1)%units='m/s'
- typvaru(1)%missing_value=0.
- typvaru(1)%valid_min= 0.
- typvaru(1)%valid_max= 20.
- typvaru(1)%long_name='Zonal_Geostrophic_Velocity'
- typvaru(1)%short_name=TRIM(cvaru)
- typvaru(1)%online_operation='N/A'
- typvaru(1)%axis='TYX'
-
- typvarv(1)%name=TRIM(cvarv)
- typvarv(1)%units='m/s'
- typvarv(1)%missing_value=0.
- typvarv(1)%valid_min= 0.
- typvarv(1)%valid_max= 20.
- typvarv(1)%long_name='Meridional_Geostrophic_Velocity'
- typvarv(1)%short_name=TRIM(cvarv)
- typvarv(1)%online_operation='N/A'
- typvarv(1)%axis='TYX'
-
+ CALL getarg(1, cf_tfil)
+
+ lchk = chkfile(cn_fhgr)
+ lchk = chkfile(cn_fzgr) .OR. lchk
+ lchk = chkfile(cf_tfil) .OR. lchk
+ IF ( lchk ) STOP ! missing file
+
+ npiglo = getdim(cf_tfil, cn_x)
+ npjglo = getdim(cf_tfil, cn_y)
+ npk = getdim(cf_tfil, cn_z)
+ npt = getdim(cf_tfil, cn_t)
+
+ ipk(1) = 1
+ stypvaru(1)%cname = TRIM(cn_vozocrtx)
+ stypvaru(1)%cunits = 'm/s'
+ stypvaru(1)%rmissing_value = 0.
+ stypvaru(1)%valid_min = 0.
+ stypvaru(1)%valid_max = 20.
+ stypvaru(1)%clong_name = 'Zonal_Geostrophic_Velocity'
+ stypvaru(1)%cshort_name = TRIM(cn_vozocrtx)
+ stypvaru(1)%conline_operation = 'N/A'
+ stypvaru(1)%caxis = 'TYX'
+
+ stypvarv(1)%cname = TRIM(cn_vomecrty)
+ stypvarv(1)%cunits = 'm/s'
+ stypvarv(1)%rmissing_value = 0.
+ stypvarv(1)%valid_min = 0.
+ stypvarv(1)%valid_max = 20.
+ stypvarv(1)%clong_name = 'Meridional_Geostrophic_Velocity'
+ stypvarv(1)%cshort_name = TRIM(cn_vomecrty)
+ stypvarv(1)%conline_operation = 'N/A'
+ stypvarv(1)%caxis = 'TYX'
! Allocate the memory
- ALLOCATE ( e1u(npiglo,npjglo) ,e2v(npiglo,npjglo) )
+ ALLOCATE ( e1u(npiglo,npjglo), e2v(npiglo,npjglo) )
ALLOCATE ( ff(npiglo,npjglo) )
- ALLOCATE ( glamt(npiglo,npjglo), gphit(npiglo,npjglo) )
ALLOCATE ( glamu(npiglo,npjglo), gphiu(npiglo,npjglo) )
ALLOCATE ( glamv(npiglo,npjglo), gphiv(npiglo,npjglo) )
- ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) )
- ALLOCATE ( sshn(npiglo,npjglo) , fmask(npiglo,npjglo) )
+ ALLOCATE ( un(npiglo,npjglo), vn(npiglo,npjglo) )
+ ALLOCATE ( zsshn(npiglo,npjglo) )
+ ALLOCATE ( umask(npiglo,npjglo), vmask(npiglo,npjglo) )
! Read the metrics from the mesh_hgr file
- e2v= getvar(coordhgr, 'e2v', 1,npiglo,npjglo)
- e1u= getvar(coordhgr, 'e1u', 1,npiglo,npjglo)
- ff(:,:) = getvar(coordhgr, 'ff', 1,npiglo,npjglo)
-
- ! and the coordinates from the mesh_hgr file
- glamt = getvar(coordhgr, 'glamt', 1,npiglo,npjglo)
- gphit = getvar(coordhgr, 'gphit', 1,npiglo,npjglo)
-
- ! create output fileset
- glamu=getvar(coordhgr,'glamu',1,npiglo,npjglo)
- gphiu=getvar(coordhgr,'gphiu',1,npiglo,npjglo)
- dep=getvare3(coordzgr,'gdept',1)
-
- ncoutu =create(cfiloutu,cfilt,npiglo,npjglo,0)
- ierr= createvar(ncoutu,typvaru(1),1,ipk,id_varoutu )
- ierr= putheadervar(ncoutu,cfilt,npiglo,npjglo,0,pnavlon=glamv,pnavlat=gphiv)
-
- tim=getvar1d(cfilt,'time_counter',1)
- ierr=putvar1d(ncoutu,tim,1,'T')
-
- glamv=getvar(coordhgr,'glamv',1,npiglo,npjglo)
- gphiv=getvar(coordhgr,'gphiv',1,npiglo,npjglo)
- dep=getvare3(coordzgr,'gdept',1)
-
- ncoutv =create(cfileoutv,cfilt,npiglo,npjglo,0)
- ierr= createvar(ncoutv,typvarv(1),1,ipk,id_varoutv )
- ierr= putheadervar(ncoutv,cfilt,npiglo,npjglo,0,pnavlon=glamu,pnavlat=gphiu)
-
- tim=getvar1d(cfilt,'time_counter',1)
- ierr=putvar1d(ncoutv,tim,1,'T')
+ e2v = getvar(cn_fhgr, cn_ve2v, 1, npiglo, npjglo)
+ e1u = getvar(cn_fhgr, cn_ve1u, 1, npiglo, npjglo)
+ ff = getvar(cn_fhgr, cn_vff, 1, npiglo, npjglo)
+
+ glamu = getvar(cn_fhgr, cn_glamu, 1, npiglo, npjglo)
+ gphiu = getvar(cn_fhgr, cn_gphiu, 1, npiglo, npjglo)
+ glamv = getvar(cn_fhgr, cn_glamv, 1, npiglo, npjglo)
+ gphiv = getvar(cn_fhgr, cn_gphiv, 1, npiglo, npjglo)
+
+ ! create output filesets
+ ! U geo ! @ V-point !
+ ncoutu = create (cf_uout, cf_tfil, npiglo, npjglo, 0 )
+ ierr = createvar (ncoutu, stypvaru, 1, ipk, id_varoutu )
+ ierr = putheadervar(ncoutu, cf_tfil, npiglo, npjglo, 0, pnavlon=glamv, pnavlat=gphiv)
+
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncoutu, tim, npt, 'T')
+
+ ! V geo ! @ U-point !
+ ncoutv = create (cf_vout, cf_tfil, npiglo, npjglo, 0 )
+ ierr = createvar (ncoutv, stypvarv, 1, ipk, id_varoutv )
+ ierr = putheadervar(ncoutv, cf_tfil, npiglo, npjglo, 0, pnavlon=glamu, pnavlat=gphiu)
+
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncoutv, tim, npt, 'T')
! Read ssh
- sshn(:,:) = getvar(cfilt, cvart,1, npiglo,npjglo)
-
- ! compute the masks
- fmask=0.
- DO jj = 1, npjglo - 1
- DO ji = 1, npiglo - 1
- fmask(ji,jj)=0.
- fmask(ji,jj)= sshn(ji,jj)*sshn(ji,jj+1)*sshn(ji+1,jj)
- IF (fmask(ji,jj) /= 0.) fmask(ji,jj)=1.
- ENDDO
- ENDDO
-
- ! Calculation of geostrophic velocity :
- un(:,:) = 0.
- vn(:,:) = 0.
-
- DO jj = 2, npjglo - 1
- DO ji = 2, npiglo -1
- vn(ji,jj) = g * fmask(ji,jj) * ( sshn(ji+1,jj ) -sshn(ji,jj) ) / ( ff(ji,jj) * e1u(ji,jj) )
- un(ji,jj) = - g * fmask(ji,jj) * ( sshn(ji ,jj+1) -sshn(ji,jj) ) / ( ff(ji,jj) * e2v(ji,jj) )
- END DO
- END DO
-
- ! write un and vn ...
- ierr = putvar(ncoutu,id_varoutu(1),un(:,:),1,npiglo,npjglo)
- ierr = putvar(ncoutv,id_varoutv(1),vn(:,:),1,npiglo,npjglo)
+ DO jt=1,npt
+ zsshn = getvar(cf_tfil, cn_sossheig, 1, npiglo, npjglo, ktime=jt)
+
+ IF ( jt == 1 ) THEN
+ ! compute the masks
+ umask=0. ; vmask = 0
+ DO jj = 1, npjglo
+ DO ji = 1, npiglo - 1
+ umask(ji,jj) = zsshn(ji,jj)*zsshn(ji+1,jj)
+ IF (umask(ji,jj) /= 0.) umask(ji,jj) = 1.
+ END DO
+ END DO
+
+ DO jj = 1, npjglo - 1
+ DO ji = 1, npiglo
+ vmask(ji,jj) = zsshn(ji,jj)*zsshn(ji,jj+1)
+ IF (vmask(ji,jj) /= 0.) vmask(ji,jj) = 1.
+ END DO
+ END DO
+ ! e1u and e1v are modified to simplify the computation below
+ DO jj=2, npjglo - 1
+ DO ji=2, npiglo - 1
+ e1u(ji,jj)= 2.* grav * umask(ji,jj) / ( ff(ji,jj) + ff(ji, jj-1) ) / e1u(ji,jj)
+ e2v(ji,jj)= 2.* grav * vmask(ji,jj) / ( ff(ji,jj) + ff(ji-1,jj ) ) / e2v(ji,jj)
+ END DO
+ END DO
+ END IF
+
+ ! Calculation of geostrophic velocity :
+ un(:,:) = 0.
+ vn(:,:) = 0.
+
+ DO jj = 2,npjglo - 1
+ DO ji = 2,npiglo -1
+ vn(ji,jj) = e1u(ji,jj) * ( zsshn(ji+1,jj ) - zsshn(ji,jj) )
+ un(ji,jj) = e2v(ji,jj) * ( zsshn(ji ,jj+1) - zsshn(ji,jj) )
+ END DO
+ END DO
+
+ ! write un and vn ...
+ ierr = putvar(ncoutu, id_varoutu(1), un(:,:), 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncoutv, id_varoutv(1), vn(:,:), 1, npiglo, npjglo, ktime=jt)
+
+ END DO ! time loop
ierr = closeout(ncoutu)
ierr = closeout(ncoutv)
diff --git a/cdfhdy.f90 b/cdfhdy.f90
index 2180ae1..0770c65 100644
--- a/cdfhdy.f90
+++ b/cdfhdy.f90
@@ -1,78 +1,103 @@
PROGRAM cdfhdy
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfhdy ***
+ !!======================================================================
+ !! *** PROGRAM cdfhdy ***
+ !!=====================================================================
+ !! ** Purpose : Compute dynamical height anomaly field from gridT file
+ !! Store the results on a 2D cdf file.
!!
- !! ** Purpose: Compute dynamical height anomaly field from gridT file
- !! Store the results on a 2D cdf file.
- !!
+ !! ** Method : the integral of (1/g) *10e4 * sum [ delta * dz ]
+ !! with delta = (1/rho - 1/rho0)
+ !! 10e4 factor is conversion decibar/pascal
!!
- !! history:
- !! Original : R. Dussin, May 2010
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 05/2010 : R. Dussin : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
- USE eos
-
- !! * Local variables
+ USE eos, ONLY : sigmai
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk, npt !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal ,& !: Array to read a layer of data
- & ztemp0, zsal0 ,& !: reference density
- & zsig0 , & !: potential density (sig-0)
- & zsig , & !: potential density (sig-0)
- & zmask , & !: 2D mask at current level
- & zhdy, zterm, zdep, zdepth, zssh
- REAL(KIND=4),DIMENSION(:),ALLOCATABLE :: tim, ze3t_1d
-
- CHARACTER(LEN=256) :: cfilet , cdum, cfileout='cdfhdy.nc', cmask='mask.nc' !:
- CHARACTER(LEN=256) :: coordzgr='mesh_zgr.nc'
-
- TYPE(variable) , DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: ncout
- INTEGER :: istatus
- INTEGER :: zlev1, zlev2
- INTEGER, DIMENSION (2) :: ismin, ismax
- REAL(KIND=4) :: sigmin, sigmax, rau0=1000.
-
-
- !! Read command line
+
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! browse arguments
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! " "
+ INTEGER(KIND=4) :: nlev1, nlev2 ! limit of vertical integration
+ INTEGER(KIND=4) :: ncout ! ncid of output fileset
+ INTEGER(KIND=4), DIMENSION(1) :: ipk ! outptut variables : number of levels,
+ INTEGER(KIND=4), DIMENSION(1) :: id_varout ! ncdf varid's
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp, sal ! Temperature and salinity at current level
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp0, sal0 ! reference temperature and salinity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! 2D mask at current level
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdep, rdepth ! depth at current level including SSH
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ssh ! Sea Surface Heigh
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim, e3t_1d ! time counter, vertical level spacing
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dhdy, dterm ! dynamic height, working array
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsig0, dsig ! In situ density (reference, local)
+ REAL(KIND=8) :: drau0 = 1000.d0 ! density of fresh water
+ REAL(KIND=8) :: dgrav = 9.81d0 ! gravity
+
+ CHARACTER(LEN=256) :: cf_tfil ! input file name
+ CHARACTER(LEN=256) :: cf_out='cdfhdy.nc' ! output file name
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ TYPE(variable) , DIMENSION(1) :: stypvar ! structure for attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
- IF ( narg .LT. 3 ) THEN
- PRINT *,' Usage : cdfhdy gridT level1 level2 '
- PRINT *,' integrates from level1 (usually surface) to level2, level2 greater than level1 '
- PRINT *,' reference is the sea surface, mask.nc and mesh_zgr.nc must be in your directory'
- PRINT *,' Output on cdfhdy.nc, variable sohdy'
+ IF ( narg <= 3 ) THEN
+ PRINT *,' usage : cdfhdy T-file level1 level2'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute dynamical height anomaly field from gridT file.'
+ PRINT *,' It is computed as the integral of (1/g) *10e4 * sum [ delta * dz ]'
+ PRINT *,' where delta = (1/rho - 1/rho0)'
+ PRINT *,' 10e4 factor is for the conversion decibar to pascal.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with temperature and salinity'
+ PRINT *,' level1 : upper limit for vertical integration (usually 1 = surface)'
+ PRINT *,' level2 : lower limit for vertical integration.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fmsk),' and ', TRIM(cn_fzgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : sohdy (m)'
STOP
ENDIF
- CALL getarg (1, cfilet)
- CALL getarg (2, cdum) ; READ(cdum,*) zlev1
- CALL getarg (3, cdum) ; READ(cdum,*) zlev2
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npt = getdim (cfilet,'time')
-
- ipk(:)= 1
- typvar(1)%name= 'sohdy'
- typvar(1)%units='m'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -100.
- typvar(1)%valid_max= 100.
- typvar(1)%long_name='Dynamical height anomaly'
- typvar(1)%short_name='sohdy'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
+ CALL getarg (1, cf_tfil )
+ CALL getarg (2, cldum ) ; READ(cldum,*) nlev1
+ CALL getarg (3, cldum ) ; READ(cldum,*) nlev2
+
+ IF ( chkfile (cf_tfil) .OR. chkfile(cn_fmsk) .OR. chkfile(cn_fzgr) ) STOP ! missing file
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
+
+ ipk(:) = 1
+ stypvar(1)%cname= 'sohdy'
+ stypvar(1)%cunits='m'
+ stypvar(1)%rmissing_value=0.
+ stypvar(1)%valid_min= -100.
+ stypvar(1)%valid_max= 100.
+ stypvar(1)%clong_name='Dynamical height anomaly'
+ stypvar(1)%cshort_name='sohdy'
+ stypvar(1)%conline_operation='N/A'
+ stypvar(1)%caxis='TYX'
PRINT *, 'npiglo=', npiglo
@@ -80,173 +105,70 @@ PROGRAM cdfhdy
PRINT *, 'npk =', npk
PRINT *, 'npt =', npt
- ALLOCATE (ztemp0(npiglo,npjglo), zsal0(npiglo,npjglo), zsig0(npiglo,npjglo) ,zmask(npiglo,npjglo))
- ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsig(npiglo,npjglo) , zhdy(npiglo,npjglo), zterm(npiglo,npjglo))
- ALLOCATE (zdep(npiglo,npjglo), zdepth(npiglo,npjglo), zssh(npiglo,npjglo), ze3t_1d(npk))
+ ALLOCATE (temp0(npiglo,npjglo), sal0(npiglo,npjglo), dsig0(npiglo,npjglo) ,tmask(npiglo,npjglo))
+ ALLOCATE (temp(npiglo,npjglo), sal(npiglo,npjglo), dsig(npiglo,npjglo) , dhdy(npiglo,npjglo), dterm(npiglo,npjglo))
+ ALLOCATE (rdep(npiglo,npjglo), rdepth(npiglo,npjglo), ssh(npiglo,npjglo), e3t_1d(npk))
ALLOCATE (tim(npt))
! create output fileset
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,npk)
- tim=getvar1d(cfilet,'time_counter',npt)
- ierr=putvar1d(ncout,tim,npt,'T')
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
! Temperature and salinity for reference profile
- ztemp0(:,:)=0.
- zsal0(:,:)=35.
+ temp0(:,:) = 0.
+ sal0(:,:) = 35.
- zmask(:,:) = getvar(cmask, 'tmask', zlev2, npiglo, npjglo)
- zssh(:,:) = getvar(cfilet, 'sossheig', 1, npiglo, npjglo)
- ze3t_1d(:) = getvare3(coordzgr, 'e3t',npk)
+ tmask(:,:) = getvar(cn_fmsk, 'tmask', nlev2, npiglo, npjglo)
+ ssh(:,:) = getvar(cf_tfil, cn_sossheig, 1, npiglo, npjglo)
+ e3t_1d(:) = getvare3(cn_fzgr, cn_ve3t, npk)
DO jt=1,npt
- PRINT *,' TIME = ', jt, tim(jt)/86400.,' days'
+ PRINT *,' TIME = ', jt, tim(jt)/86400.,' days'
+ dhdy(:,:) = 0.
+ rdepth(:,:) = 0.
- zhdy(:,:) = 0.
- zdepth(:,:) = 0.
+ DO jk = nlev1, nlev2
- DO jk = zlev1, zlev2
+ !rdep(:,:) = getvar(cn_fzgr, 'e3t_ps', jk,npiglo,npjglo,ldiom=.true.)
+ ! we degrade the computation to smooth the results
+ rdep(:,:) = e3t_1d(jk)
- !zdep(:,:) = getvar(coordzgr, 'e3t_ps', jk,npiglo,npjglo,ldiom=.true.)
- ! we degrade the computation to smooth the results
- zdep(:,:) = ze3t_1d(jk)
+ IF ( jk == 1 ) THEN
+ rdep(:,:) = rdep(:,:) + ssh(:,:)
+ ENDIF
- IF ( jk == 1 ) THEN
-! IF ( zlev1 == 1) THEN oh le vilain bug
- zdep(:,:) = zdep(:,:) + zssh(:,:)
- ENDIF
+ ! depth at current level, including ssh (used for computation of rho in situ)
+ rdepth(:,:) = rdepth(:,:) + rdep(:,:)
- ! total depth at current level (used for computation of rho in situ)
- zdepth(:,:) = zdepth(:,:) + zdep(:,:)
+ temp(:,:)= getvar(cf_tfil, cn_votemper, jk ,npiglo, npjglo, ktime=jt)
+ sal(:,:) = getvar(cf_tfil, cn_vosaline, jk ,npiglo, npjglo, ktime=jt)
- ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo,ktime=jt)
- zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo,ktime=jt)
+ dsig0 = sigmai(temp0, sal0, rdepth, npiglo, npjglo)
+ dsig = sigmai(temp , sal , rdepth, npiglo, npjglo)
- CALL eos_insitu( ztemp0, zsal0, zdepth, npiglo, npjglo, zsig0 )
- CALL eos_insitu( ztemp, zsal, zdepth, npiglo, npjglo, zsig )
+ ! we compute the term of the integral : (1/g) *10e4 * sum [ delta * dz ]
+ ! with delta = (1/rho - 1/rho0)
+ ! 10e4 factor is conversion decibar/pascal
+ !
+ dterm = ( ( 1.d0 / ( drau0 + dsig(:,:) ) ) - ( 1.d0 / ( drau0 + dsig0(:,:) ) ) ) * 10000.d0 * rdep / dgrav
+ ! in land, it seems appropriate to stop the computation
+ WHERE(sal == 0 ) dterm = 0
- ! we compute the term of the integral : (1/g) *10e4 * sum [ delta * dz ]
- ! with delta = (1/rho - 1/rho0)
- ! 10e4 factor is conversion decibar/pascal
- !
- zterm = ( ( 1. / ( rau0 + zsig(:,:) ) ) - ( 1. / ( rau0 + zsig0(:,:) ) ) ) * 10000. * zdep / 9.81
- ! in land, it seems appropriate to stop the computation
- WHERE(zsal == 0 ) zterm = 0
+ dhdy(:,:) = dhdy(:,:) + dterm(:,:)
- zhdy(:,:) = zhdy(:,:) + zterm(:,:)
+ END DO ! loop to next level
- END DO ! loop to next level
-
! we mask with the last level of the integral
- zhdy(:,:) = zhdy(:,:) * zmask(:,:)
+ dhdy(:,:) = dhdy(:,:) * tmask(:,:)
- ierr = putvar(ncout, id_varout(1) ,zhdy, 1,npiglo, npjglo,ktime=jt)
+ ierr = putvar(ncout, id_varout(1) ,REAL(dhdy), 1, npiglo, npjglo, ktime=jt)
END DO ! next time frame
- istatus = closeout(ncout)
-
-CONTAINS
-
-SUBROUTINE eos_insitu( ptem, psal, pdepth, jpiglo, jpjglo, prd )
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_insitu ***
- !!
- !! ** Purpose : Compute the in situ density (ratio rho/rau0) from
- !! potential temperature and salinity using an equation of state
- !! defined through the namelist parameter nn_eos.
- !!
- !! ** Method :
- !! nn_eos = 0 : Jackett and McDougall (1994) equation of state.
- !! the in situ density is computed directly as a function of
- !! potential temperature relative to the surface (the opa t
- !! variable), salt and pressure (assuming no pressure variation
- !! along geopotential surfaces, i.e. the pressure p in decibars
- !! is approximated by the depth in meters.
- !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
- !! with pressure p decibars
- !! potential temperature t deg celsius
- !! salinity s psu
- !! reference volumic mass rau0 kg/m**3
- !! in situ volumic mass rho kg/m**3
- !! in situ density anomalie prd no units
- !! Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
- !! t = 40 deg celcius, s=40 psu
- !! prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
- !! Note that no boundary condition problem occurs in this routine
- !! as (ptem,psal) are defined over the whole domain.
- !!
- !! ** Action : compute prd , the in situ density (no units)
- !!
- !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
- !!----------------------------------------------------------------------
- INTEGER, INTENT(in ) :: jpiglo, jpjglo
- REAL(8), DIMENSION(jpiglo,jpjglo), INTENT(in ) :: ptem ! potential temperature [Celcius]
- REAL(8), DIMENSION(jpiglo,jpjglo), INTENT(in ) :: psal ! salinity [psu]
- REAL(8), DIMENSION(jpiglo,jpjglo), INTENT(in ) :: pdepth ! depth [m]
- REAL(8), DIMENSION(jpiglo,jpjglo), INTENT( out) :: prd ! in situ density
- !!
- INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: jpkm1
- REAL(8) :: zt , zs , zh , zsr ! temporary scalars
- REAL(8) :: zr1, zr2, zr3, zr4 ! - -
- REAL(8) :: zrhop, ze, zbw, zb ! - -
- REAL(8) :: zd , zc , zaw, za ! - -
- REAL(8) :: zb1, za1, zkw, zk0 ! - -
- REAL(8) :: zrau0r ! - -
- REAL(8), DIMENSION(jpiglo,jpjglo) :: zws ! temporary workspace
- INTEGER :: nn_eos = 0 !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
- REAL(8) :: rn_alpha = 2.0e-4 !: thermal expension coeff. (linear equation of state)
- REAL(8) :: rn_beta = 7.7e-4 !: saline expension coeff. (linear equation of state)
-
- REAL(8) :: ralpbet !: alpha / beta ratio
- !!----------------------------------------------------------------------
-
- zrau0r = 1.e0 / rau0
- zws(:,:) = SQRT( ABS( psal(:,:) ) )
- !
- DO jj = 1, jpjglo
- DO ji = 1, jpiglo
- zt = ptem (ji,jj)
- zs = psal (ji,jj)
- zh = pdepth(ji,jj) ! depth
- zsr= zws (ji,jj) ! square root salinity
- !
- ! compute volumic mass pure water at atm pressure
- zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt &
- & -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
- ! seawater volumic mass atm pressure
- zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt &
- & -4.0899e-3 ) *zt+0.824493
- zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
- zr4= 4.8314e-4
- !
- ! potential volumic mass (reference to the surface)
- zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
- !
- ! add the compression terms
- ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
- zbw= ( 1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
- zb = zbw + ze * zs
- !
- zd = -2.042967e-2
- zc = (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
- zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
- za = ( zd*zsr + zc ) *zs + zaw
- !
- zb1= (-0.1909078*zt+7.390729 ) *zt-55.87545
- za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
- zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
- zk0= ( zb1*zsr + za1 )*zs + zkw
- !
- ! masked in situ density anomaly
- prd(ji,jj) = ( zrhop / ( 1.0 - zh / ( zk0 - zh * ( za - zh * zb ) ) ) &
- & - rau0 ) ! * zrau0r ! * tmask(ji,jj)
- END DO
- END DO
-END SUBROUTINE eos_insitu
+ ierr = closeout(ncout)
END PROGRAM cdfhdy
diff --git a/cdfhdy3d.f90 b/cdfhdy3d.f90
index 2094311..837a1cb 100644
--- a/cdfhdy3d.f90
+++ b/cdfhdy3d.f90
@@ -1,250 +1,170 @@
PROGRAM cdfhdy3d
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfhdy3d ***
+ !!======================================================================
+ !! *** PROGRAM cdfhdy3d ***
+ !!=====================================================================
+ !! ** Purpose : Compute dynamical height anomaly field from gridT file
+ !! at each levels.
+ !! Store the results on a 3D cdf file.
!!
- !! ** Purpose: Compute dynamical height anomaly field from gridT file
- !! Store the results on a 3D cdf file.
- !!
+ !! ** Method : the integral of (1/g) *10e4 * sum [ delta * dz ]
+ !! with delta = (1/rho - 1/rho0)
+ !! 10e4 factor is conversion decibar/pascal
!!
- !! history:
- !! Original : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines Apr 2005 : use modules
- !!-------------------------------------------------------------------
- !! $Rev: 256 $
- !! $Date: 2009-07-21 17:49:27 +0200 (mar. 21 juil. 2009) $
- !! $Id: cdfsig0.f90 256 2009-07-21 15:49:27Z molines $
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 05/2010 : R. Dussin : Original code
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
- USE eos
-
- !! * Local variables
+ USE eos, ONLY : sigmai
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk, npt !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal ,& !: Array to read a layer of data
- & ztemp0, zsal0 ,& !: reference density
- & zsig0 , & !: potential density (sig-0)
- & zsig , & !: potential density (sig-0)
- & zmask , & !: 2D mask at current level
- & zhdy, zterm, zdep, zdepth, zssh
- REAL(KIND=4),DIMENSION(:),ALLOCATABLE :: tim, ze3t_1d
-
- CHARACTER(LEN=256) :: cfilet , cdum, cfileout='cdfhdy3d.nc', cmask='mask.nc' !:
- CHARACTER(LEN=256) :: coordzgr='mesh_zgr.nc'
-
- TYPE(variable) , DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: ncout
- INTEGER :: istatus
- INTEGER :: zlev1, zlev2
- INTEGER, DIMENSION (2) :: ismin, ismax
- REAL(KIND=4) :: sigmin, sigmax, rau0=1000.
-
-
- !! Read command line
+
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! browse arguments
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! " "
+ INTEGER(KIND=4) :: nlev1, nlev2 ! limit of vertical integration
+ INTEGER(KIND=4) :: ncout ! ncid of output fileset
+ INTEGER(KIND=4), DIMENSION(1) :: ipk ! outptut variables : number of levels,
+ INTEGER(KIND=4), DIMENSION(1) :: id_varout ! ncdf varid's
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp, zsal ! Temperature and salinity at current level
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp0, zsal0 ! reference temperature and salinity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! 2D mask at current level
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdep, rdepth ! depth at current level including SSH
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zssh ! Sea Surface Heigh
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim, e3t_1d ! time counter, vertical level spacing
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dhdy, dterm ! dynamic height, working array
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsig0, dsig ! In situ density (reference, local)
+ REAL(KIND=8) :: drau0 = 1000.d0 ! density of fresh water
+ REAL(KIND=8) :: dgrav = 9.81d0 ! gravity
+
+ CHARACTER(LEN=256) :: cf_tfil ! input file name
+ CHARACTER(LEN=256) :: cf_out='cdfhdy3d.nc' ! output file name
+ CHARACTER(LEN=256) :: cv_out='vohdy' ! output file name
+
+ TYPE(variable) , DIMENSION(1) :: stypvar ! structure for attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
- IF ( narg .NE. 1 ) THEN
- PRINT *,' Usage : cdfhdy3d gridT '
- PRINT *,' reference is the sea surface, mask.nc and mesh_zgr.nc must be in your directory'
- PRINT *,' Output on cdfhdy3d.nc, variable vohdy'
+ IF ( narg /= 1 ) THEN
+ PRINT *,' usage : cdfhdy3d T-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute dynamic height anomaly from T-file given as argument.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with temperature and salinity.'
+ PRINT *,' '
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fmsk),' and ', TRIM(cn_fzgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_out),' ( m )'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfhdy'
+ PRINT *,' '
STOP
ENDIF
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npt = getdim (cfilet,'time')
-
- ipk(:)= npk
- typvar(1)%name= 'vohdy'
- typvar(1)%units='m'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -100.
- typvar(1)%valid_max= 100.
- typvar(1)%long_name='Dynamical height anomaly'
- typvar(1)%short_name='vohdy'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'npt =', npt
-
- ALLOCATE (ztemp0(npiglo,npjglo), zsal0(npiglo,npjglo), zsig0(npiglo,npjglo) ,zmask(npiglo,npjglo))
- ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsig(npiglo,npjglo) , zhdy(npiglo,npjglo), zterm(npiglo,npjglo))
- ALLOCATE (zdep(npiglo,npjglo), zdepth(npiglo,npjglo), zssh(npiglo,npjglo), ze3t_1d(npk))
+ CALL getarg (1, cf_tfil)
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
+
+ IF ( chkfile(cf_tfil) .OR. chkfile(cn_fmsk) .OR. chkfile(cn_fzgr) ) STOP ! missing files
+
+ ipk(:) = npk
+ stypvar(1)%cname = cv_out
+ stypvar(1)%cunits = 'm'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = -100.
+ stypvar(1)%valid_max = 100.
+ stypvar(1)%clong_name = 'Dynamical height anomaly'
+ stypvar(1)%cshort_name = cv_out
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE (temp0(npiglo,npjglo), zsal0(npiglo,npjglo), dsig0(npiglo,npjglo) ,tmask(npiglo,npjglo))
+ ALLOCATE (temp(npiglo,npjglo), zsal(npiglo,npjglo), dsig(npiglo,npjglo) , dhdy(npiglo,npjglo), dterm(npiglo,npjglo))
+ ALLOCATE (rdep(npiglo,npjglo), rdepth(npiglo,npjglo), zssh(npiglo,npjglo), e3t_1d(npk))
ALLOCATE (tim(npt))
! create output fileset
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,npk)
- tim=getvar1d(cfilet,'time_counter',npt)
- ierr=putvar1d(ncout,tim,npt,'T')
+ tim = getvar1d (cf_tfil, cn_vtimec, npt)
+ ierr = putvar1d(ncout, tim, npt, 'T')
! Temperature and salinity for reference profile
- ztemp0(:,:)=0.
- zsal0(:,:)=35.
-
- zssh(:,:) = getvar(cfilet, 'sossheig', 1, npiglo, npjglo)
- ze3t_1d(:) = getvare3(coordzgr, 'e3t',npk)
-
- DO jt=1,npt
- PRINT *,' TIME = ', jt, tim(jt)/86400.,' days'
-
- zhdy(:,:) = 0.
- zdepth(:,:) = 0.
-
- DO jk = 1, npk
+ temp0(:,:) = 0.
+ zsal0(:,:) = 35.
- !zdep(:,:) = getvar(coordzgr, 'e3t_ps', jk,npiglo,npjglo,ldiom=.true.)
- ! we degrade the computation to smooth the results
- zdep(:,:) = ze3t_1d(jk)
+ zssh(:,:) = getvar(cf_tfil, cn_sossheig, 1, npiglo, npjglo)
+ e3t_1d(:) = getvare3(cn_fzgr, cn_ve3t, npk)
- zmask(:,:) = getvar(cmask, 'tmask', jk, npiglo, npjglo)
+ DO jt = 1, npt
+ PRINT *,' TIME = ', jt, tim(jt)/86400.,' days'
+ dhdy(:,:) = 0.
+ rdepth(:,:) = 0.
- IF ( jk == 1) THEN
- zdep(:,:) = zdep(:,:) + zssh(:,:)
- ENDIF
+ DO jk = 1, npk
+ !rdep(:,:) = getvar(cn_fzgr, 'e3t_ps', jk,npiglo,npjglo,ldiom=.true.)
+ ! we degrade the computation to smooth the results
+ rdep(:,:) = e3t_1d(jk)
+ tmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo)
- ! total depth at current level (used for computation of rho in situ)
- zdepth(:,:) = zdepth(:,:) + zdep(:,:)
+ IF ( jk == 1 ) THEN
+ rdep(:,:) = rdep(:,:) + zssh(:,:)
+ ENDIF
- ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo,ktime=jt)
- zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo,ktime=jt)
+ ! depth at current level, including ssh (used for computation of rho in situ)
+ rdepth(:,:) = rdepth(:,:) + rdep(:,:)
- CALL eos_insitu( ztemp0, zsal0, zdepth, npiglo, npjglo, zsig0 )
- CALL eos_insitu( ztemp, zsal, zdepth, npiglo, npjglo, zsig )
+ temp(:,:)= getvar(cf_tfil, cn_votemper, jk ,npiglo, npjglo, ktime=jt)
+ zsal(:,:) = getvar(cf_tfil, cn_vosaline, jk ,npiglo, npjglo, ktime=jt)
- ! we compute the term of the integral : (1/g) *10e4 * sum [ delta * dz ]
- ! with delta = (1/rho - 1/rho0)
- ! 10e4 factor is conversion decibar/pascal
- !
- zterm = ( ( 1. / ( rau0 + zsig(:,:) ) ) - ( 1. / ( rau0 + zsig0(:,:) ) ) ) * 10000. * zdep / 9.81
- ! in land, it seems appropriate to stop the computation
- WHERE(zsal == 0 ) zterm = 0
+ dsig0 = sigmai(temp0, zsal0, rdepth, npiglo, npjglo)
+ dsig = sigmai(temp , zsal , rdepth, npiglo, npjglo)
- zhdy(:,:) = zhdy(:,:) + zterm(:,:)
- ! we mask with the mask of the level
- zhdy(:,:) = zhdy(:,:) * zmask(:,:)
+ ! we compute the term of the integral : (1/g) *10e4 * sum [ delta * dz ]
+ ! with delta = (1/rho - 1/rho0)
+ ! 10e4 factor is conversion decibar/pascal
+ !
+ dterm = ( ( 1.d0 / ( drau0 + dsig(:,:) ) ) - ( 1.d0 / ( drau0 + dsig0(:,:) ) ) ) * 10000.d0 * rdep / dgrav
+ ! in land, it seems appropriate to stop the computation
+ WHERE(zsal == 0 ) dterm = 0
- ierr = putvar(ncout, id_varout(1) ,zhdy, jk,npiglo, npjglo,ktime=jt)
+ dhdy(:,:) = dhdy(:,:) + dterm(:,:)
+ ! masked
+ dhdy(:,:) = dhdy(:,:) * tmask(:,:)
+ ierr = putvar(ncout, id_varout(1) ,REAL(dhdy), jk, npiglo, npjglo, ktime=jt)
- END DO ! loop to next level
-
+ END DO ! loop to next level
END DO ! next time frame
- istatus = closeout(ncout)
-
-CONTAINS
-
-SUBROUTINE eos_insitu( ptem, psal, pdepth, jpiglo, jpjglo, prd )
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_insitu ***
- !!
- !! ** Purpose : Compute the in situ density (ratio rho/rau0) from
- !! potential temperature and salinity using an equation of state
- !! defined through the namelist parameter nn_eos.
- !!
- !! ** Method :
- !! nn_eos = 0 : Jackett and McDougall (1994) equation of state.
- !! the in situ density is computed directly as a function of
- !! potential temperature relative to the surface (the opa t
- !! variable), salt and pressure (assuming no pressure variation
- !! along geopotential surfaces, i.e. the pressure p in decibars
- !! is approximated by the depth in meters.
- !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
- !! with pressure p decibars
- !! potential temperature t deg celsius
- !! salinity s psu
- !! reference volumic mass rau0 kg/m**3
- !! in situ volumic mass rho kg/m**3
- !! in situ density anomalie prd no units
- !! Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
- !! t = 40 deg celcius, s=40 psu
- !! prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
- !! Note that no boundary condition problem occurs in this routine
- !! as (ptem,psal) are defined over the whole domain.
- !!
- !! ** Action : compute prd , the in situ density (no units)
- !!
- !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
- !!----------------------------------------------------------------------
- INTEGER, INTENT(in ) :: jpiglo, jpjglo
- REAL(8), DIMENSION(jpiglo,jpjglo), INTENT(in ) :: ptem ! potential temperature [Celcius]
- REAL(8), DIMENSION(jpiglo,jpjglo), INTENT(in ) :: psal ! salinity [psu]
- REAL(8), DIMENSION(jpiglo,jpjglo), INTENT(in ) :: pdepth ! depth [m]
- REAL(8), DIMENSION(jpiglo,jpjglo), INTENT( out) :: prd ! in situ density
- !!
- INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: jpkm1
- REAL(8) :: zt , zs , zh , zsr ! temporary scalars
- REAL(8) :: zr1, zr2, zr3, zr4 ! - -
- REAL(8) :: zrhop, ze, zbw, zb ! - -
- REAL(8) :: zd , zc , zaw, za ! - -
- REAL(8) :: zb1, za1, zkw, zk0 ! - -
- REAL(8) :: zrau0r ! - -
- REAL(8), DIMENSION(jpiglo,jpjglo) :: zws ! temporary workspace
- INTEGER :: nn_eos = 0 !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
- REAL(8) :: rn_alpha = 2.0e-4 !: thermal expension coeff. (linear equation of state)
- REAL(8) :: rn_beta = 7.7e-4 !: saline expension coeff. (linear equation of state)
-
- REAL(8) :: ralpbet !: alpha / beta ratio
- !!----------------------------------------------------------------------
-
- zrau0r = 1.e0 / rau0
- zws(:,:) = SQRT( ABS( psal(:,:) ) )
- !
- DO jj = 1, jpjglo
- DO ji = 1, jpiglo
- zt = ptem (ji,jj)
- zs = psal (ji,jj)
- zh = pdepth(ji,jj) ! depth
- zsr= zws (ji,jj) ! square root salinity
- !
- ! compute volumic mass pure water at atm pressure
- zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt &
- & -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
- ! seawater volumic mass atm pressure
- zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt &
- & -4.0899e-3 ) *zt+0.824493
- zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
- zr4= 4.8314e-4
- !
- ! potential volumic mass (reference to the surface)
- zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
- !
- ! add the compression terms
- ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
- zbw= ( 1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
- zb = zbw + ze * zs
- !
- zd = -2.042967e-2
- zc = (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
- zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
- za = ( zd*zsr + zc ) *zs + zaw
- !
- zb1= (-0.1909078*zt+7.390729 ) *zt-55.87545
- za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
- zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
- zk0= ( zb1*zsr + za1 )*zs + zkw
- !
- ! masked in situ density anomaly
- prd(ji,jj) = ( zrhop / ( 1.0 - zh / ( zk0 - zh * ( za - zh * zb ) ) ) &
- & - rau0 ) ! * zrau0r ! * tmask(ji,jj)
- END DO
- END DO
-END SUBROUTINE eos_insitu
+ ierr = closeout(ncout)
END PROGRAM cdfhdy3d
diff --git a/cdfheatc-full.f90 b/cdfheatc-full.f90
deleted file mode 100644
index 96d758b..0000000
--- a/cdfheatc-full.f90
+++ /dev/null
@@ -1,171 +0,0 @@
-PROGRAM cdfheatc_full
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfheatc_full ***
- !!
- !! ** Purpose : Compute the heat content
- !! FULL STEPS
- !!
- !! ** Method : compute the sum ( rho cp T * e1 *e2 * e3 *mask )
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (March 2006)
- !! F. Castruccio ( fall 2006) for FUll step version
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jk, ik
- INTEGER :: imin=0, imax=0, jmin=0, jmax=0 !: domain limitation for computation
- INTEGER :: kmin=0, kmax=0 !: domain limitation for computation
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvpk !: vertical levels in working variable
-
- REAL(KIND=8), PARAMETER :: rprho0=1020., rpcp=4000.
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: e3
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: npiglo x npjglo
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep !: depth
-
- REAL(KIND=8) :: zvol, zsum, zvol2d, zsum2d, zsurf
- CHARACTER(LEN=256) :: cfilev , cdum
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmask='mask.nc'
- CHARACTER(LEN=256) :: cvar, cvartype
- CHARACTER(LEN=20) :: ce1, ce2, ce3, cvmask, cvtype, cdep
-
-
- INTEGER :: istatus
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfheatc-full gridTfile [imin imax jmin jmax kmin kmax] '
- PRINT *,' Computes the heat content in the specified area (Joules)'
- PRINT *,' imin imax jmin jmax kmin kmax can be given in option '
- PRINT *,' if imin = 0 then ALL i are taken'
- PRINT *,' if jmin = 0 then ALL j are taken'
- PRINT *,' if kmin = 0 then ALL k are taken'
- PRINT *,' FULL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on standard output'
- STOP
- ENDIF
-
- CALL getarg (1, cfilev)
- cvar='votemper'
- cvartype='T'
-
- IF (narg > 1 ) THEN
- IF ( narg /= 7 ) THEN
- PRINT *, ' ERROR : You must give 6 optional values (imin imax jmin jmax kmin kmax)'
- STOP
- ELSE
- ! input optional imin imax jmin jmax
- CALL getarg ( 2,cdum) ; READ(cdum,*) imin
- CALL getarg ( 3,cdum) ; READ(cdum,*) imax
- CALL getarg ( 4,cdum) ; READ(cdum,*) jmin
- CALL getarg ( 5,cdum) ; READ(cdum,*) jmax
- CALL getarg ( 6,cdum) ; READ(cdum,*) kmin
- CALL getarg ( 7,cdum) ; READ(cdum,*) kmax
- ENDIF
- ENDIF
-
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
- nvpk = getvdim(cfilev,cvar)
- IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF
- IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF
- IF (kmin /= 0 ) THEN ; npk =kmax -kmin + 1; ELSE ; kmin=1 ; ENDIF
-
- IF (nvpk == 2 ) nvpk = 1
- IF (nvpk == 3 ) nvpk = npk
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'nvpk =', nvpk
-
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e3(npk) )
- ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo) )
- ALLOCATE ( gdep(npk) )
- SELECT CASE (TRIM(cvartype))
- CASE ( 'T' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3t'
- cvmask='tmask'
- cdep='gdept'
- CASE ( 'U' )
- ce1='e1u'
- ce2='e2u'
- ce3='e3t'
- cvmask='umask'
- cdep='gdept'
- CASE ( 'V' )
- ce1='e1v'
- ce2='e2v'
- ce3='e3t'
- cvmask='vmask'
- cdep='gdept'
- CASE ( 'F' )
- ce1='e1f'
- ce2='e2f'
- ce3='e3t'
- cvmask='fmask'
- cdep='gdept'
- CASE ( 'W' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3w'
- cvmask='tmask'
- cdep='gdepw'
- CASE DEFAULT
- PRINT *, 'this type of variable is not known :', trim(cvartype)
- STOP
- END SELECT
-
- e1(:,:) = getvar(coordhgr, ce1, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- e2(:,:) = getvar(coordhgr, ce2, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- e3(:) = getvare3(coordzgr,ce3,npk)
- gdep(:) = getvare3(coordzgr,cdep,npk)
-
- zvol=0.d0
- zsum=0.d0
- DO jk = 1,nvpk
- ik = jk+kmin-1
- ! Get velocities v at ik
- zv(:,:)= getvar(cfilev, cvar, ik ,npiglo,npjglo,kimin=imin,kjmin=jmin)
- zmask(:,:)=getvar(cmask,cvmask,ik,npiglo,npjglo,kimin=imin,kjmin=jmin)
-! zmask(:,npjglo)=0.
-
- zsurf=sum(e1 * e2 * zmask)
- zvol2d=sum(e1 * e2 * e3(jk) * zmask)
- zvol=zvol+zvol2d
- zsum2d=sum(zv*e1*e2*e3(jk)*zmask)
- zsum=zsum+zsum2d
- IF (zvol2d /= 0 )THEN
- PRINT *, ' Heat Content at level ',ik,'(',gdep(ik),' m) ',rprho0*rpcp*zsum2d, 'surface = ',zsurf/1.e6,' km^2'
- ELSE
- PRINT *, ' No points in the water at level ',ik,'(',gdep(ik),' m) '
- ENDIF
-
- END DO
- PRINT * ,' Total Heat content : ', rprho0*rpcp*zsum ,' Joules'
- PRINT * ,' Total Heat content/volume : ', rprho0*rpcp*zsum/zvol ,' Joules/m3 '
-
- END PROGRAM cdfheatc_full
diff --git a/cdfheatc.f90 b/cdfheatc.f90
index 64e40b5..aa6ff16 100644
--- a/cdfheatc.f90
+++ b/cdfheatc.f90
@@ -1,171 +1,181 @@
PROGRAM cdfheatc
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfheatc ***
+ !!======================================================================
+ !! *** PROGRAM cdfheatc ***
+ !!=====================================================================
+ !! ** Purpose : Compute the heat content of the ocean : 1 single value
!!
- !! ** Purpose : Compute the heat content
- !! PARTIAL STEPS
- !!
- !! ** Method : compute the sum ( rho cp T * e1 *e2 * e3 *mask )
+ !! ** Method : compute the sum ( rho cp T * e1t *e2t * e3t * tmask )
!!
- !!
- !! history ;
- !! Original : J.M. Molines (March 2006)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 03/2006 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, ik
- INTEGER :: imin=0, imax=0, jmin=0, jmax=0 !: domain limitation for computation
- INTEGER :: kmin=0, kmax=0 !: domain limitation for computation
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvpk !: vertical levels in working variable
-
- REAL(KIND=8), PARAMETER :: rprho0=1020., rpcp=4000.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, e3, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: npiglo x npjglo
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep
-
- REAL(KIND=8) :: zvol, zsum, zvol2d, zsum2d, zsurf
- CHARACTER(LEN=256) :: cfilev , cdum
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmask='mask.nc'
- CHARACTER(LEN=256) :: cvar, cvartype
- CHARACTER(LEN=20) :: ce1, ce2, ce3, cvmask, cvtype, cdep
-
- INTEGER :: istatus
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ik ! working integer
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: iimin=0, iimax=0 ! domain limitation for computation
+ INTEGER(KIND=4) :: ijmin=0, ijmax=0 ! domain limitation for computation
+ INTEGER(KIND=4) :: ikmin=0, ikmax=0 ! domain limitation for computation
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvpk ! vertical levels in working variable
+
+ REAL(KIND=4), PARAMETER :: pprho0=1020. ! water density (kg/m3)
+ REAL(KIND=4), PARAMETER :: ppcp=4000. ! calorific capacity (J/kg/m3)
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t ! horizontal metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3t ! vertical metric
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp ! temperature
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! tmask
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept ! depth
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics in case of full step
+
+ REAL(KIND=8) :: dvol ! 3D volume of the ocean
+ REAL(KIND=8) :: dsum ! weighted sum 3D
+ REAL(KIND=8) :: dvol2d ! volume of a layer
+ REAL(KIND=8) :: dsum2d ! weigthed sum per layer
+ REAL(KIND=8) :: dsurf ! surface of a layer
+
+ CHARACTER(LEN=256) :: cf_tfil ! input gridT file
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+
+ LOGICAL :: lfull=.FALSE. ! flag for full step computation
+ LOGICAL :: lchk ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfheatc gridTfile [imin imax jmin jmax kmin kmax] '
- PRINT *,' Computes the heat content in the specified area (Joules)'
- PRINT *,' imin imax jmin jmax kmin kmax can be given in option '
- PRINT *,' if imin = 0 then ALL i are taken'
- PRINT *,' if jmin = 0 then ALL j are taken'
- PRINT *,' if kmin = 0 then ALL k are taken'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on standard output'
+ PRINT *,' usage : cdfheatc T-file ...'
+ PRINT *,' ... [imin imax jmin jmax kmin kmax] [-full] '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes the heat content in the specified area (Joules)'
+ PRINT *,' A sub-domain can be specified in option.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : a file with temperature and salinity'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [imin imax jmin jmax kmin kmax] : limit of a sub domain where'
+ PRINT *,' the heat content will be calculated.'
+ PRINT *,' - if imin = 0 then ALL i are taken'
+ PRINT *,' - if jmin = 0 then ALL j are taken'
+ PRINT *,' - if kmin = 0 then ALL k are taken'
+ PRINT *,' [-full ] : assume full step model output instead of default'
+ PRINT *,' partial steps.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' Files ',TRIM(cn_fhgr),', ',TRIM(cn_fzgr),' and ',TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : to be done ....'
+ PRINT *,' Standard output'
STOP
ENDIF
- CALL getarg (1, cfilev)
- cvar='votemper'
- cvartype='T'
-
- IF (narg > 1 ) THEN
- IF ( narg /= 7 ) THEN
- PRINT *, ' ERROR : You must give 6 optional values (imin imax jmin jmax kmin kmax)'
- STOP
- ELSE
- ! input optional imin imax jmin jmax
- CALL getarg ( 2,cdum) ; READ(cdum,*) imin
- CALL getarg ( 3,cdum) ; READ(cdum,*) imax
- CALL getarg ( 4,cdum) ; READ(cdum,*) jmin
- CALL getarg ( 5,cdum) ; READ(cdum,*) jmax
- CALL getarg ( 6,cdum) ; READ(cdum,*) kmin
- CALL getarg ( 7,cdum) ; READ(cdum,*) kmax
- ENDIF
- ENDIF
+ ijarg = 1
+ CALL getarg (ijarg, cf_tfil) ; ijarg = ijarg + 1
+
+ lchk = chkfile(cn_fhgr)
+ lchk = chkfile(cn_fzgr) .OR. lchk
+ lchk = chkfile(cn_fmsk) .OR. lchk
+ lchk = chkfile(cf_tfil) .OR. lchk
+ IF ( lchk ) STOP ! missing files
+
+ DO WHILE ( ijarg <= narg )
+ CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-full' ) ; lfull = .true.
+ CASE DEFAULT
+ PRINT *,' Reading 6 values : imin imax jmin jmax kmin kmax '
+ READ(cldum,*) iimin
+ CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax
+ CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin
+ CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax
+ CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmin
+ CALL getarg ( ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmax
+ END SELECT
+ END DO
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
- nvpk = getvdim(cfilev,cvar)
- IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF
- IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF
- IF (kmin /= 0 ) THEN ; npk =kmax -kmin + 1; ELSE ; kmin=1 ; ENDIF
+ IF (iimin /= 0 ) THEN ; npiglo = iimax - iimin + 1; ELSE ; iimin=1 ; ENDIF
+ IF (ijmin /= 0 ) THEN ; npjglo = ijmax - ijmin + 1; ELSE ; ijmin=1 ; ENDIF
+ IF (ikmin /= 0 ) THEN ; npk = ikmax - ikmin + 1; ELSE ; ikmin=1 ; ENDIF
+ nvpk = getvdim(cf_tfil,cn_votemper)
IF (nvpk == 2 ) nvpk = 1
IF (nvpk == 3 ) nvpk = npk
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'nvpk =', nvpk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+ PRINT *, 'nvpk = ', nvpk
! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo), e3(npiglo,npjglo) )
- ALLOCATE ( gdep(npk) )
- SELECT CASE (TRIM(cvartype))
- CASE ( 'T' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3t_ps'
- cvmask='tmask'
- cdep='gdept'
- CASE ( 'U' )
- ce1='e1u'
- ce2='e2u'
- ce3='e3t_ps'
- cvmask='umask'
- cdep='gdept'
- CASE ( 'V' )
- ce1='e1v'
- ce2='e2v'
- ce3='e3t_ps'
- cvmask='vmask'
- cdep='gdept'
- CASE ( 'F' )
- ce1='e1f'
- ce2='e2f'
- ce3='e3t_ps'
- cvmask='fmask'
- cdep='gdept'
- CASE ( 'W' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3w_ps'
- cvmask='tmask'
- cdep='gdepw'
- CASE DEFAULT
- PRINT *, 'this type of variable is not known :', trim(cvartype)
- STOP
- END SELECT
-
- e1(:,:) = getvar(coordhgr, ce1, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- e2(:,:) = getvar(coordhgr, ce2, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- gdep(:) = getvare3(coordzgr,cdep,npk)
-
- zvol=0.d0
- zsum=0.d0
- DO jk = 1,nvpk
- ik = jk+kmin-1
- ! Get velocities v at ik
- zv(:,:)= getvar(cfilev, cvar, ik ,npiglo,npjglo,kimin=imin,kjmin=jmin)
- zmask(:,:)=getvar(cmask,cvmask,ik,npiglo,npjglo,kimin=imin,kjmin=jmin)
-! zmask(:,npjglo)=0.
-
- ! get e3 at level ik ( ps...)
- e3(:,:) = getvar(coordzgr, ce3, ik,npiglo,npjglo,kimin=imin,kjmin=jmin,ldiom=.true.)
+ ALLOCATE ( tmask(npiglo,npjglo) )
+ ALLOCATE ( temp (npiglo,npjglo) )
+ ALLOCATE ( e1t (npiglo,npjglo), e2t(npiglo,npjglo), e3t(npiglo,npjglo) )
+ ALLOCATE ( gdept(npk), tim(npt) )
+ IF ( lfull ) ALLOCATE ( e31d(npk) )
+
+ e1t(:,:) = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin)
+ e2t(:,:) = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin)
+ gdept(:) = getvare3(cn_fzgr, cn_gdept, npk)
+ tim (:) = getvare3(cf_tfil, cn_vtimec, npt)
+ IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk)
+
+ DO jt=1,npt
+ dvol = 0.d0
+ dsum = 0.d0
+ PRINT * ,'TIME : ', tim(jt)/86400.,' days'
+
+ DO jk = 1,nvpk
+ ik = jk + ikmin -1
+ ! Get velocities v at ik
+ temp( :,:) = getvar(cf_tfil, cn_votemper, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jt)
+ tmask(:,:) = getvar(cn_fmsk, 'tmask', ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin )
+
+ ! get e3t at level ik ( ps...)
+ IF ( lfull ) THEN
+ e3t(:,:) = e31d(jk)
+ ELSE
+ e3t(:,:) = getvar(cn_fzgr, 'e3t_ps', ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ldiom=.TRUE.)
+ ENDIF
+
+ dsurf = SUM(e1t * e2t * tmask)
+ dvol2d = SUM(e1t * e2t * e3t * tmask)
+ dvol = dvol + dvol2d
+
+ dsum2d = SUM(e1t * e2t * e3t * temp * tmask)
+ dsum = dsum + dsum2d
+
+ IF (dvol2d /= 0 )THEN
+ PRINT *, ' Heat Content at level ',ik,'(',gdept(ik),' m) ',pprho0*ppcp*dsum2d, 'surface = ',dsurf/1.e6,' km^2'
+ ELSE
+ PRINT *, ' No points in the water at level ',ik,'(',gdept(ik),' m) '
+ ENDIF
+
+ END DO
- !
- zsurf=sum(e1 * e2 * zmask)
- zvol2d=sum(e1 * e2 * e3 * zmask)
- zvol=zvol+zvol2d
- zsum2d=sum(zv*e1*e2*e3*zmask)
- zsum=zsum+zsum2d
- IF (zvol2d /= 0 )THEN
- PRINT *, ' Heat Content at level ',ik,'(',gdep(ik),' m) ',rprho0*rpcp*zsum2d, 'surface = ',zsurf/1.e6,' km^2'
- ELSE
- PRINT *, ' No points in the water at level ',ik,'(',gdep(ik),' m) '
- ENDIF
-
+ PRINT * ,' Total Heat content : ', pprho0*ppcp*dsum ,' Joules'
+ PRINT * ,' Total Heat content/volume : ', pprho0*ppcp*dsum/dvol ,' Joules/m3 '
END DO
- PRINT * ,' Total Heat content : ', rprho0*rpcp*zsum ,' Joules'
- PRINT * ,' Total Heat content/volume : ', rprho0*rpcp*zsum/zvol ,' Joules/m3 '
- END PROGRAM cdfheatc
+END PROGRAM cdfheatc
diff --git a/cdfhflx.f90 b/cdfhflx.f90
index 0eea244..e29b4bd 100644
--- a/cdfhflx.f90
+++ b/cdfhflx.f90
@@ -1,238 +1,240 @@
PROGRAM cdfhflx
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfhflx ***
+ !!======================================================================
+ !! *** PROGRAM cdfhflx ***
+ !!=====================================================================
+ !! ** Purpose : Compute the Meridional Heat Transport from the
+ !! forcing fluxes.
!!
- !! ** Purpose : Compute the Meridional Heat Transport from the forcing fluxes
- !! PARTIAL STEPS
- !!
- !! ** Method : Compute the zonaly integrated heat flux.
- !! The program looks for the file "new_maskglo.nc". If it does not exist,
- !! only the calculation over all the domain is performed (this is adequate
- !! for a basin configuration like NATL4).
- !! In new_maskglo.nc the masking corresponds to the global
- !! configuration. (Global, Atlantic, Indo-Pacific, Indian,Pacific ocean)
+ !! ** Method : Compute the zonaly integrated heat flux.
+ !! The program looks for the file "new_maskglo.nc".
+ !! If it does not exist, only the calculation over all
+ !! the whole domain is performed (this is adequate for
+ !! a basin configuration like NATL4).
+ !! In new_maskglo.nc the masking corresponds to the global
+ !! configuration. (Global, Atlantic, Indo-Pacific,
+ !! Indian,Pacific ocean)
!!
- !!
- !! history ;
- !! Original : J.M. Molines (jul. 2005)
- !! A.M. Treguier (april 2006) adaptation to NATL4 case
- !! R. Dussin (Jul. 2009) : Add netcdf output
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 07/2005 : J.M. Molines : Original code
+ !! 2.1 : 04/2006 : A.M. Treguier : adaptation to NATL4 case
+ !! 2.1 : 07/2009 : R. Dussin : Netcdf output
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic. + generalization
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jpbasins
- INTEGER :: jbasin, jj, jk ,ji !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout, np, imean
- INTEGER :: numout=10
- INTEGER, DIMENSION(2) :: iloc
- ! added to write in netcdf
- INTEGER :: kx=1, ky=1 ! dims of netcdf output file
- INTEGER :: nboutput ! number of values to write in cdf output
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1t, e2t, gphit, zflx !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4) ,DIMENSION(:,:) , ALLOCATABLE :: gphimean,htrp !: jpbasins x npjglo
-
- REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zmht !: jpbasins x npjglo
- ! added to write in netcdf
- REAL(KIND=4) :: threedmeanout, pmissing_value
- REAL(KIND=4), DIMENSION (1) :: tim ! time counter
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: meanout
-
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar ! structure of output
-
- CHARACTER(LEN=256) :: cfilet , cfileout='hflx.out'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc',cbasinmask='new_maskglo.nc'
- ! added to write in netcdf
- CHARACTER(LEN=256) :: cfileoutnc='cdfhflx.nc'
- CHARACTER(LEN=256) :: cdunits, cdlong_name, cdshort_name
-
- LOGICAL :: llglo = .FALSE. !: indicator for presence of new_maskglo.nc file
- ! added to write in netcdf
- LOGICAL :: lwrtcdf=.TRUE.
-
- INTEGER :: istatus
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 1 ) THEN
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- ELSE
- PRINT *,' Usage : cdfhflx T-file '
- PRINT *,' Computes the MHT from heat fluxes '
- PRINT *,' Files mesh_hgr.nc, new_maskglo.nc must be in the current directory '
- PRINT *,' Output on hflx.out (ascii file ) and hflx.nc '
+
+ INTEGER(KIND=4) :: jbasin, ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: npbasins ! number of subbasins
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: numout=10 ! logical unit of txt output file
+ INTEGER(KIND=4) :: ikx=1, iky=1 ! dims of netcdf output file
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! levels and varid's of output vars
+ INTEGER(KIND=4), DIMENSION(2) :: iloc ! used for maxloc
+
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: zmask ! npbasins x npiglo x npjglo
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t ! horizontal metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: gphit ! Latitide
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zflx ! fluxes read on file
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon ! dummy longitude = 0.
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlat ! latitude for i = north pole
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmht ! cumulated heat trp
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dhtrp ! MHT from fluxes
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! attributes output
+
+ CHARACTER(LEN=256) :: cf_tfil ! input file
+ CHARACTER(LEN=256) :: cf_out='hflx.out' ! output txt file
+ CHARACTER(LEN=256) :: cf_outnc='cdfhflx.nc' ! output nc file
+
+ LOGICAL :: lglo = .FALSE. ! global or subbasin computation
+ LOGICAL :: lchk = .FALSE. ! missing file flag
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
+
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfhflx T-file '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes the Meridional Heat Transport (MHT) from surface heat fluxes,'
+ PRINT *,' in function of the latitude.'
+ PRINT *,' If a sub-basin file is available, MHT is computed for each sub-basin.'
+ PRINT *,' Note that the latitude is in fact a line of constant J coordinate, not'
+ PRINT *,' a true parallel, if the model grid is distorted as in the northern most'
+ PRINT *,' part of ORCA configurations.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : a file with heat fluxes (gridT). '
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' Files ', TRIM(cn_fhgr),', ',TRIM(cn_fbasins),' and ',TRIM(cn_fmsk),'.'
+ PRINT *,' If ',TRIM(cn_fbasins),' is not available, only global MHT is computed.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' ASCII file : ', TRIM(cf_out )
+ PRINT *,' netcdf file : ', TRIM(cf_outnc)
+ PRINT *,' variables : hflx_glo, [hflx_atl, hflx_inp, hflx_pac, hflx_ind]'
STOP
ENDIF
+ CALL getarg (1, cf_tfil)
+
+ lchk = chkfile(cn_fhgr)
+ lchk = chkfile(cn_fmsk) .OR. lchk
+ lchk = chkfile(cf_tfil) .OR. lchk
+ IF ( lchk ) STOP ! missing file
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
! Detects newmaskglo file
- INQUIRE( FILE='new_maskglo.nc', EXIST=llglo )
- IF (llglo) THEN
- jpbasins = 5
+ lglo = .NOT. ( chkfile(cn_fbasins) )
+
+ IF (lglo) THEN
+ npbasins = 5
ELSE
- jpbasins = 1
+ npbasins = 1
ENDIF
! Allocate arrays
- ALLOCATE ( zmask(jpbasins,npiglo,npjglo) )
+ ALLOCATE ( zmask(npbasins,npiglo,npjglo) )
ALLOCATE ( zflx(npiglo,npjglo) )
- ALLOCATE ( e1t(npiglo,npjglo),e2t(npiglo,npjglo), gphit(npiglo,npjglo) )
- ALLOCATE ( htrp (jpbasins,npjglo) )
- ALLOCATE ( zmht(jpbasins, npjglo) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
-
- IF (lwrtcdf) THEN
- nboutput=jpbasins
- ALLOCATE (typvar(nboutput), ipk(nboutput), id_varout(nboutput))
-
- DO jj=1,jpbasins
- ipk(jj)=1
- ENDDO
-
- ! define new variables for output
- typvar(1)%name='hflx_glo'
- typvar%units=TRIM(cdunits)
- typvar%missing_value=99999.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar%scale_factor= 1.
- typvar%add_offset= 0.
- typvar%savelog10= 0.
- typvar%units='PW'
- typvar(1)%long_name='Heat_Fluxes_Global'
- typvar(1)%short_name='hflx_glo'
- typvar%online_operation='N/A'
- typvar%axis='ZT'
-
- IF (llglo) THEN
-
- typvar(2)%name='hflx_atl'
- typvar(2)%long_name='Heat_Fluxes_Atlantic'
- typvar(2)%short_name='hflx_atl'
-
- typvar(3)%name='hflx_inp'
- typvar(3)%long_name='Heat_Fluxes_Indo-Pacific'
- typvar(3)%short_name='hflx_inp'
-
- typvar(4)%name='hflx_ind'
- typvar(4)%long_name='Heat_Fluxes_Indian'
- typvar(4)%short_name='hflx_ind'
-
- typvar(5)%name='hflx_pac'
- typvar(5)%long_name='Heat_Fluxes_Pacific'
- typvar(5)%short_name='hflx_pac'
-
- ENDIF
+ ALLOCATE ( e1t(npiglo,npjglo), e2t(npiglo,npjglo), gphit(npiglo,npjglo) )
+ ALLOCATE ( dhtrp (npbasins,npjglo) )
+ ALLOCATE ( dmht(npbasins, npjglo) )
+ ALLOCATE ( rdumlon(1,npjglo), rdumlat(1,npjglo) )
+ ALLOCATE ( tim(npt) )
+
+ ALLOCATE (stypvar(npbasins), ipk(npbasins), id_varout(npbasins))
+
+ ! define new variables for output
+ ipk(:) = 1
+ stypvar%cunits = 'PW'
+ stypvar%rmissing_value = 99999.
+ stypvar%valid_min = -1000.
+ stypvar%valid_max = 1000.
+ stypvar%scale_factor = 1.
+ stypvar%add_offset = 0.
+ stypvar%savelog10 = 0.
+ stypvar%cunits = 'PW'
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'T'
+
+ stypvar(1)%cname = 'hflx_glo'
+ stypvar(1)%clong_name = 'Heat_Fluxes_Global'
+ stypvar(1)%cshort_name = 'hflx_glo'
+
+ IF (lglo) THEN
+ stypvar(2)%cname = 'hflx_atl' ; stypvar(3)%cname = 'hflx_inp'
+ stypvar(2)%clong_name = 'Heat_Fluxes_Atlantic' ; stypvar(3)%clong_name = 'Heat_Fluxes_Indo-Pacific'
+ stypvar(2)%cshort_name = 'hflx_atl' ; stypvar(3)%cshort_name = 'hflx_inp'
+
+ stypvar(4)%cname = 'hflx_ind' ; stypvar(5)%cname = 'hflx_pac'
+ stypvar(4)%clong_name = 'Heat_Fluxes_Indian' ; stypvar(5)%clong_name = 'Heat_Fluxes_Pacific'
+ stypvar(4)%cshort_name = 'hflx_ind' ; stypvar(5)%cshort_name = 'hflx_pac'
ENDIF
- e1t(:,:) = getvar(coordhgr, 'e1t', 1,npiglo,npjglo)
- e2t(:,:) = getvar(coordhgr, 'e2t', 1,npiglo,npjglo)
- gphit(:,:) = getvar(coordhgr, 'gphit', 1,npiglo,npjglo)
+ e1t( :,:) = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo)
+ e2t( :,:) = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo)
+ gphit(:,:) = getvar(cn_fhgr, cn_gphit, 1, npiglo, npjglo)
+
+ iloc = MAXLOC(gphit)
+ rdumlat(1,:) = gphit(iloc(1),:)
+ rdumlon(:,:) = 0. ! set the dummy longitude to 0
- iloc=MAXLOC(gphit)
- dumlat(1,:) = gphit(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
+ ! create output fileset
+ ncout = create (cf_outnc, 'none', ikx, npjglo, npk )
+ ierr = createvar (ncout, stypvar, npbasins, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, ikx, npjglo, npk, pnavlon=rdumlon, pnavlat=rdumlat)
+
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ OPEN(numout, FILE=cf_out, FORM='FORMATTED', RECL=256) ! to avoid wrapped line with ifort
+ WRITE(numout,*)'! Zonal heat transport (integrated from surface fluxes) (in Pw)'
! reading the masks
! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif
- zmask(1,:,:)=getvar('mask.nc','vmask',1,npiglo,npjglo)
+ zmask(1,:,:)= getvar(cn_fmsk, 'vmask', 1, npiglo, npjglo)
- IF (llglo) THEN
- zmask(2,:,:)=getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- zmask(4,:,:)=getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
- zmask(5,:,:)=getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- zmask(3,:,:)=zmask(5,:,:)+zmask(4,:,:)
+ IF (lglo) THEN
+ zmask(2,:,:) = getvar(cn_fbasins, 'tmaskatl', 1, npiglo, npjglo)
+ zmask(4,:,:) = getvar(cn_fbasins, 'tmaskind', 1, npiglo, npjglo)
+ zmask(5,:,:) = getvar(cn_fbasins, 'tmaskpac', 1, npiglo, npjglo)
+ zmask(3,:,:) = zmask(5,:,:) + zmask(4,:,:)
! ensure that there are no overlapping on the masks
WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1
- ! change global mask for GLOBAL periodic condition
+ ! change global mask for GLOBAL periodic condition
zmask(1,1,:) = 0.
zmask(1,npiglo,:) = 0.
ENDIF
- ! initialize zmht
- zmht(:,:) = 0.
- htrp(:,:) = 0.
-
-
- ! Get fluxes
- zflx(:,:)= getvar(cfilet, 'sohefldo', 1 ,npiglo,npjglo)
-
- ! integrates 'zonally' (along i-coordinate)
- DO ji=1,npiglo
- ! For all basins
- DO jbasin = 1, jpbasins
- DO jj=1,npjglo
- zmht(jbasin,jj)=zmht(jbasin,jj) + e1t(ji,jj)*e2t(ji,jj)* zmask(jbasin,ji,jj)*zflx(ji,jj)
- ENDDO
+ DO jt = 1, npt
+ ! initialize dmht
+ dmht(:,:) = 0.d0
+ dhtrp(:,:) = 0.d0
+ WRITE(numout,*)' TIME =', jt, tim(jt)/86400.,' days'
+
+ ! Get fluxes
+ zflx(:,:)= getvar(cf_tfil, cn_sohefldo, 1, npiglo, npjglo, ktime=jt)
+
+ ! integrates 'zonally' (along i-coordinate)
+ DO ji=1,npiglo
+ ! For all basins
+ DO jbasin = 1, npbasins
+ dmht(jbasin,:) = dmht(jbasin,:) + e1t(ji,:)*e2t(ji,:)* zmask(jbasin,ji,:)*zflx(ji,:)*1.d0
+ END DO
END DO
- END DO
- ! cumulates transport from north to south
- DO jj=npjglo-1,1,-1
- DO jbasin=1, jpbasins
- htrp(jbasin,jj) = htrp(jbasin,jj+1) - zmht(jbasin,jj)
+ ! cumulates transport from north to south
+ DO jj=npjglo-1,1,-1
+ dhtrp(:,jj) = dhtrp(:,jj+1) - dmht(:,jj)
END DO
- END DO
-
- OPEN(numout,FILE=cfileout,FORM='FORMATTED', RECL=256) ! to avoid wrapped line with ifort
- WRITE(numout,*)'! Zonal heat transport (integrated from surface fluxes) (in Pw)'
- IF (llglo) THEN
- WRITE(numout,*)'! J Global Atlantic INDO-PACIF INDIAN PACIF '
- DO jj=npjglo, 1, -1
- WRITE(numout,9000) jj, &
- dumlat(1,jj), htrp(1,jj)/1e15 , &
- htrp(2,jj)/1e15, &
- htrp(3,jj)/1e15, &
- htrp(4,jj)/1e15, &
- htrp(5,jj)/1e15
- ENDDO
- ELSE
- WRITE(numout,*)'! J Global '
- DO jj=npjglo, 1, -1
- WRITE(numout,9000) jj, &
- dumlat(1,jj), htrp(1,jj)/1e15
- ENDDO
- ENDIF
- CLOSE(numout)
-9000 FORMAT(I4,5(1x,f9.3,1x,f8.4))
+ ! transform to peta watt
+ dhtrp(:,:) = dhtrp(:,:) / 1.d15
- IF (lwrtcdf) THEN
+ IF (lglo) THEN
+ WRITE(numout,*)'! J Global Atlantic INDO-PACIF INDIAN PACIF '
+ DO jj=npjglo, 1, -1
+ WRITE(numout,9000) jj, &
+ rdumlat(1,jj), dhtrp(1,jj), dhtrp(2,jj), dhtrp(3,jj), dhtrp(4,jj), dhtrp(5,jj)
+ ENDDO
+ ELSE
+ WRITE(numout,*)'! J Global '
+ DO jj=npjglo, 1, -1
+ WRITE(numout,9000) jj, rdumlat(1,jj), dhtrp(1,jj)
+ ENDDO
+ ENDIF
- ! create output fileset
- ncout =create(cfileoutnc,'none',kx,npjglo,npk)
- ierr= createvar(ncout,typvar,nboutput,ipk,id_varout )
- ierr= putheadervar(ncout, cfilet ,kx, npjglo,npk,pnavlon=dumlon,pnavlat=dumlat)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
+9000 FORMAT(I4,5(1x,f9.3,1x,f8.4))
- ! netcdf output
- DO jj=1, jpbasins
- ierr = putvar(ncout, id_varout(jj), htrp(jj,:)/1e15, ipk(jj), kx, npjglo )
+ DO jj=1, npbasins
+ ierr = putvar(ncout, id_varout(jj), REAL(dhtrp(jj,:)), ipk(jj), ikx, npjglo, ktime=jt )
END DO
+ END DO ! time loop
- ierr = closeout(ncout)
-
- ENDIF
+ ierr = closeout(ncout)
+ CLOSE(numout)
END PROGRAM cdfhflx
diff --git a/cdficediags.f90 b/cdficediags.f90
index 6497624..a64bf18 100644
--- a/cdficediags.f90
+++ b/cdficediags.f90
@@ -1,216 +1,229 @@
PROGRAM cdficediag
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdficediag ***
+ !!======================================================================
+ !! *** PROGRAM cdficediag ***
+ !!=====================================================================
+ !! ** Purpose : Compute the Ice volume, area and extend for each
+ !! hemisphere
!!
- !! ** Purpose : Compute the Ice volume, area and extend for each hemisphere
- !!
- !! ** Method : Read the ice output and integrates (2D)
- !! determine the hemisphere by the sign of ff (coriolis)
+ !! ** Method : Use the icemod files for input and determine the
+ !! hemisphere with sign of the coriolis parameter.
!!
- !! history ;
- !! Original : J.M. Molines (Jan. 2006)
- !! R. Dussin (Jul. 2009) : Add netcdf output
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 01/2006 : J.M. Molines : Original code
+ !! : 2.1 : 07/2009 : R. Dussin : Add Ncdf output
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, jj
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo !: size of the domain
- INTEGER :: nvpk !: vertical levels in working variable
- INTEGER :: nperio = 4 !: boundary condition ( periodic, north fold)
- ! added to write in netcdf
- INTEGER :: kx=1, ky=1, kz=1 ! dims of netcdf output file
- INTEGER :: nboutput=8 ! number of values to write in cdf output
- INTEGER :: ncout ! for netcdf output
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2 !: metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask ,ff !: npiglo x npjglo
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: ricethick, riceldfra !: thickness, leadfrac (concentration)
-
- REAL(KIND=8) :: zvols, zareas, zextends,zextends2 !: volume, area extend South hemisphere
- REAL(KIND=8) :: zvoln, zarean, zextendn,zextendn2 !: volume, area extend North hemisphere
- ! added to write in netcdf
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dumlon, dumlat
- REAL(KIND=4), DIMENSION (1) :: tim ! time counter
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar ! structure of output
- ! REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth read
+
+ INTEGER(KIND=4) :: jk, jj, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo, npt ! size of the domain
+ INTEGER(KIND=4) :: nvpk ! vertical levels in working variable
+ INTEGER(KIND=4) :: nperio = 4 ! boundary condition ( periodic, north fold)
+ INTEGER(KIND=4) :: ikx=1, iky=1, ikz=1 ! dims of netcdf output file
+ INTEGER(KIND=4) :: nboutput=8 ! number of values to write in cdf output
+ INTEGER(KIND=4) :: ncout ! for netcdf output
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1, e2 ! metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask, ff ! npiglo x npjglo
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ricethick, riceldfra ! thickness, leadfrac (concentration)
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon, rdumlat ! dummy lon lat for output
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ REAL(KIND=8) :: dvols, dareas ! volume, area extend South hemisphere
+ REAL(KIND=8) :: dextends, dextends2 ! volume, area extend South hemisphere
+ REAL(KIND=8) :: dvoln, darean ! volume, area extend North hemisphere
+ REAL(KIND=8) :: dextendn, dextendn2 ! volume, area extend North hemisphere
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output
!
- CHARACTER(LEN=256) :: cfilei , cdum
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', cmask='mask.nc'
- ! added to write in netcdf
- CHARACTER(LEN=256) :: cfileoutnc='icediags.nc'
- ! added to write in netcdf
- LOGICAL :: lwrtcdf=.TRUE.
-
- INTEGER :: istatus
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 1) THEN
- CALL getarg (1, cfilei)
- npiglo= getdim (cfilei,'x')
- npjglo= getdim (cfilei,'y')
- ELSE
- PRINT *,' Usage : cdficediag ncfile '
- PRINT *,' Files mesh_hgr.nc, mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on standard output and icediags.nc '
+ CHARACTER(LEN=256) :: cf_ifil ! input ice file
+ CHARACTER(LEN=256) :: cf_out='icediags.nc' ! output file
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
+ IF ( narg /= 1 ) THEN
+ PRINT *,' usage : cdficediag ICE-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the ice volume, area and extent for each hemisphere.'
+ PRINT *,' The extent is computed in a similar way to NSIDC for easy '
+ PRINT *,' comparison : the extent is the surface of the grid cells covered'
+ PRINT *,' by ice when the ice concentration is above 0.15'
+ PRINT *,' '
+ PRINT *,' For compatibility with previous version, another estimate of '
+ PRINT *,' the extend is computed using grid cell surfaces weighted by the'
+ PRINT *,' ice concentration, but it will be deprecated soon.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' ICE-file : netcdf icemod file'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : [NS]Volume (10^9 m3 )'
+ PRINT *,' [NS]Area (10^9 m2 )'
+ PRINT *,' [NS]Extent (10^9 m2 ) -- obsolete --'
+ PRINT *,' [NS]Exnsidc (10^9 m2 )'
+ PRINT *,' N = northern hemisphere'
+ PRINT *,' S = southern hemisphere'
+ PRINT *,' standard output'
STOP
ENDIF
- ALLOCATE ( zmask(npiglo,npjglo) ,ff(npiglo,npjglo) )
+ CALL getarg (1, cf_ifil)
+ IF ( chkfile(cf_ifil) ) STOP ! missing file
+
+ npiglo = getdim (cf_ifil,cn_x)
+ npjglo = getdim (cf_ifil,cn_y)
+ npt = getdim (cf_ifil,cn_t)
+
+ ALLOCATE ( tmask(npiglo,npjglo) ,ff(npiglo,npjglo) )
ALLOCATE ( ricethick(npiglo,npjglo) )
ALLOCATE ( riceldfra(npiglo,npjglo) )
ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo) )
-
- IF(lwrtcdf) THEN
-
- ALLOCATE ( typvar(nboutput), ipk(nboutput), id_varout(nboutput) )
- ALLOCATE (dumlon(1,1) , dumlat(1,1) )
-
- dumlon(:,:)=0.
- dumlat(:,:)=0.
-
- DO jj=1,nboutput
- ipk(jj)=1
- ENDDO
-
- ! define new variables for output
- typvar(1)%name='NVolume'
- typvar(1)%units='10^9 m3'
- typvar%scale_factor= 1.
- typvar%add_offset= 0.
- typvar%savelog10= 0.
- typvar(1)%long_name='Ice_volume_in_Northern_Hemisphere'
- typvar(1)%short_name='NVolume'
- typvar%online_operation='N/A'
- typvar%axis='T'
-
- typvar(2)%name='NArea'
- typvar(2)%units='10^9 m2'
- typvar(2)%long_name='Ice_area_in_Northern_Hemisphere'
- typvar(2)%short_name='NArea'
-
- typvar(3)%name='NExtent'
- typvar(3)%units='10^9 m2'
- typvar(3)%long_name='Ice_extent_in_Northern_Hemisphere'
- typvar(3)%short_name='NExtent'
-
- typvar(4)%name='NExnsidc'
- typvar(4)%units='10^9 m2'
- typvar(4)%long_name='Ice_extent_similar_to_NSIDC_in_Northern_Hemisphere'
- typvar(4)%short_name='NExnsidc'
-
- typvar(5)%name='SVolume'
- typvar(5)%units='10^9 m3'
- typvar(5)%long_name='Ice_volume_in_Southern_Hemisphere'
- typvar(5)%short_name='SVolume'
-
- typvar(6)%name='SArea'
- typvar(6)%units='10^9 m2'
- typvar(6)%long_name='Ice_area_in_Southern_Hemisphere'
- typvar(6)%short_name='SArea'
-
- typvar(7)%name='SExtent'
- typvar(7)%units='10^9 m2'
- typvar(7)%long_name='Ice_extent_in_Southern_Hemisphere'
- typvar(7)%short_name=''
-
- typvar(8)%name='SExnsidc'
- typvar(8)%units='10^9 m2'
- typvar(8)%long_name='Ice_extent_similar_to_NSIDC_in_Southern_Hemisphere'
- typvar(8)%short_name='SExnsidc'
-
-
- ENDIF
-
- e1(:,:) = getvar(coordhgr, 'e1t', 1,npiglo,npjglo)
- e2(:,:) = getvar(coordhgr, 'e2t', 1,npiglo,npjglo)
- ! only the sign of ff is important
- ff(:,:) = getvar(coordhgr, 'gphit' , 1,npiglo,npjglo)
-
-
- ricethick(:,:)= getvar(cfilei, 'iicethic', 1 ,npiglo,npjglo)
- riceldfra(:,:)= getvar(cfilei, 'ileadfra', 1 ,npiglo,npjglo)
+ ALLOCATE ( tim(npt) )
+
+ ALLOCATE ( stypvar(nboutput), ipk(nboutput), id_varout(nboutput) )
+ ALLOCATE ( rdumlon(1,1), rdumlat(1,1) )
+
+ rdumlon(:,:) = 0.
+ rdumlat(:,:) = 0.
+
+ ipk(:) = 1
+
+ ! define new variables for output
+ stypvar%scale_factor = 1.
+ stypvar%add_offset = 0.
+ stypvar%savelog10 = 0.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'T'
+
+ stypvar(1)%cname = 'NVolume'
+ stypvar(1)%cunits = '10^9 m3'
+ stypvar(1)%clong_name = 'Ice_volume_in_Northern_Hemisphere'
+ stypvar(1)%cshort_name = 'NVolume'
+
+ stypvar(2)%cname = 'NArea'
+ stypvar(2)%cunits = '10^9 m2'
+ stypvar(2)%clong_name = 'Ice_area_in_Northern_Hemisphere'
+ stypvar(2)%cshort_name = 'NArea'
+
+ stypvar(3)%cname = 'NExtent'
+ stypvar(3)%cunits = '10^9 m2'
+ stypvar(3)%clong_name = 'Ice_extent_in_Northern_Hemisphere'
+ stypvar(3)%cshort_name = 'NExtent'
+
+ stypvar(4)%cname = 'NExnsidc'
+ stypvar(4)%cunits = '10^9 m2'
+ stypvar(4)%clong_name = 'Ice_extent_similar_to_NSIDC_in_Northern_Hemisphere'
+ stypvar(4)%cshort_name = 'NExnsidc'
+
+ stypvar(5)%cname = 'SVolume'
+ stypvar(5)%cunits = '10^9 m3'
+ stypvar(5)%clong_name = 'Ice_volume_in_Southern_Hemisphere'
+ stypvar(5)%cshort_name = 'SVolume'
+
+ stypvar(6)%cname = 'SArea'
+ stypvar(6)%cunits = '10^9 m2'
+ stypvar(6)%clong_name = 'Ice_area_in_Southern_Hemisphere'
+ stypvar(6)%cshort_name = 'SArea'
+
+ stypvar(7)%cname = 'SExtent'
+ stypvar(7)%cunits = '10^9 m2'
+ stypvar(7)%clong_name = 'Ice_extent_in_Southern_Hemisphere'
+ stypvar(7)%cshort_name = ''
+
+ stypvar(8)%cname = 'SExnsidc'
+ stypvar(8)%cunits = '10^9 m2'
+ stypvar(8)%clong_name = 'Ice_extent_similar_to_NSIDC_in_Southern_Hemisphere'
+ stypvar(8)%cshort_name = 'SExnsidc'
+
+ e1(:,:) = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo)
+ e2(:,:) = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo)
+ ff(:,:) = getvar(cn_fhgr, cn_gphit, 1, npiglo, npjglo) ! only the sign of ff is important
! modify the mask for periodic and north fold condition (T pivot, F Pivot ...)
! in fact should be nice to use jperio as in the code ...
-
- zmask(:,:)=getvar(cmask,'tmask',1,npiglo,npjglo)
+ tmask(:,:)=getvar(cn_fmsk,'tmask',1,npiglo,npjglo)
SELECT CASE (nperio)
CASE (0) ! closed boundaries
! nothing to do
CASE (4) ! ORCA025 type boundary
- zmask(1:2,:)=0.
- zmask(:,npjglo)=0.
- zmask(npiglo/2+1:npiglo,npjglo-1)= 0.
+ tmask(1:2,:)=0.
+ tmask(:,npjglo)=0.
+ tmask(npiglo/2+1:npiglo,npjglo-1)= 0.
CASE (6)
- zmask(1:2,:)=0.
- zmask(:,npjglo)=0.
+ tmask(1:2,:)=0.
+ tmask(:,npjglo)=0.
CASE DEFAULT
PRINT *,' Nperio=', nperio,' not yet coded'
STOP
END SELECT
- ! North : ff > 0
- zvoln=SUM( ricethick (:,:)* e1(:,:) * e2(:,:) * riceldfra (:,:) * zmask (:,:) , (ff > 0 ) )
- zarean=SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * zmask (:,:) ,( ff > 0 ) )
- zextendn=SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * zmask (:,:), (riceldfra > 0.15 .AND. ff > 0 ) )
- ! JMM added 22/01/2007 : to compute same extent than the NSIDC
- zextendn2=SUM( e1(:,:) * e2(:,:) * zmask (:,:), (riceldfra > 0.15 .AND. ff > 0 ) )
-
- ! South : ff < 0
- zvols=SUM( ricethick (:,:)* e1(:,:) * e2(:,:) * riceldfra (:,:) * zmask (:,:) ,(ff < 0 ) )
- zareas=SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * zmask (:,:), ( ff < 0 ) )
- zextends=SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * zmask (:,:), (riceldfra > 0.15 .AND. ff < 0 ) )
- zextends2=SUM( e1(:,:) * e2(:,:)* zmask (:,:), (riceldfra > 0.15 .AND. ff < 0 ) )
-
- PRINT *,' Northern Hemisphere '
- PRINT *,' NVolume (10^9 m3) ', zvoln /1.d9
- PRINT *,' NArea (10^9 m2) ', zarean /1.d9
- PRINT *,' NExtend (10^9 m2) ', zextendn /1.d9
- PRINT *,' NExnsidc (10^9 m2) ', zextendn2 /1.d9
- PRINT *
- PRINT *,' Southern Hemisphere '
- PRINT *,' SVolume (10^9 m3) ', zvols /1.d9
- PRINT *,' SArea (10^9 m2) ', zareas /1.d9
- PRINT *,' SExtend (10^9 m2) ', zextends /1.d9
- PRINT *,' SExnsidc (10^9 m2) ', zextends2 /1.d9
-
- IF (lwrtcdf) THEN
-
- ! create output fileset
- ncout =create(cfileoutnc,'none',kx,ky,kz,cdep='depthw')
- ierr= createvar(ncout,typvar,nboutput,ipk,id_varout )
- ierr= putheadervar(ncout, cfilei,kx, &
- ky,kz,pnavlon=dumlon,pnavlat=dumlat)
- tim=getvar1d(cfilei,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
+ DO jt = 1, npt
+ ricethick(:,:) = getvar(cf_ifil, cn_iicethic, 1, npiglo, npjglo, ktime=jt)
+ riceldfra(:,:) = getvar(cf_ifil, cn_ileadfra, 1, npiglo, npjglo, ktime=jt)
+
+ ! North : ff > 0
+ dvoln = SUM( ricethick (:,:)* e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (ff > 0 ) )
+ darean = SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (ff > 0 ) )
+ dextendn = SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (riceldfra > 0.15 .AND. ff > 0 ) )
+ ! JMM added 22/01/2007 : to compute same extent than the NSIDC
+ dextendn2 = SUM( e1(:,:) * e2(:,:) * tmask (:,:), (riceldfra > 0.15 .AND. ff > 0 ) )
+
+ ! South : ff < 0
+ dvols = SUM( ricethick (:,:)* e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (ff < 0 ) )
+ dareas = SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (ff < 0 ) )
+ dextends = SUM( e1(:,:) * e2(:,:) * riceldfra (:,:) * tmask (:,:), (riceldfra > 0.15 .AND. ff < 0 ) )
+ dextends2 = SUM( e1(:,:) * e2(:,:) * tmask (:,:), (riceldfra > 0.15 .AND. ff < 0 ) )
+
+ PRINT *,' TIME = ', jt,' ( ',tim(jt),' )'
+ PRINT *,' Northern Hemisphere '
+ PRINT *,' NVolume (10^9 m3) ', dvoln /1.d9
+ PRINT *,' NArea (10^9 m2) ', darean /1.d9
+ PRINT *,' NExtend (10^9 m2) ', dextendn /1.d9
+ PRINT *,' NExnsidc (10^9 m2) ', dextendn2 /1.d9
+ PRINT *
+ PRINT *,' Southern Hemisphere '
+ PRINT *,' SVolume (10^9 m3) ', dvols /1.d9
+ PRINT *,' SArea (10^9 m2) ', dareas /1.d9
+ PRINT *,' SExtend (10^9 m2) ', dextends /1.d9
+ PRINT *,' SExnsidc (10^9 m2) ', dextends2 /1.d9
+
+ IF ( jt == 1 ) THEN
+ ! create output fileset
+ ncout = create (cf_out, 'none', ikx, iky, ikz, cdep='depthw' )
+ ierr = createvar (ncout, stypvar, nboutput, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_ifil, ikx, iky, ikz, pnavlon=rdumlon, pnavlat=rdumlat)
+
+ tim = getvar1d(cf_ifil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ENDIF
! netcdf output
- ierr = putvar0d(ncout,id_varout(1), REAL(zvoln /1.d9) )
- ierr = putvar0d(ncout,id_varout(2), REAL(zarean /1.d9) )
- ierr = putvar0d(ncout,id_varout(3), REAL(zextendn /1.d9) )
- ierr = putvar0d(ncout,id_varout(4), REAL(zextendn2 /1.d9) )
- ierr = putvar0d(ncout,id_varout(5), REAL(zvols /1.d9) )
- ierr = putvar0d(ncout,id_varout(6), REAL(zareas /1.d9) )
- ierr = putvar0d(ncout,id_varout(7), REAL(zextends /1.d9) )
- ierr = putvar0d(ncout,id_varout(8), REAL(zextends2 /1.d9) )
-
- ierr = closeout(ncout)
-
- ENDIF
-
+ ierr = putvar0d(ncout,id_varout(1), REAL(dvoln /1.d9), ktime=jt)
+ ierr = putvar0d(ncout,id_varout(2), REAL(darean /1.d9), ktime=jt)
+ ierr = putvar0d(ncout,id_varout(3), REAL(dextendn /1.d9), ktime=jt)
+ ierr = putvar0d(ncout,id_varout(4), REAL(dextendn2 /1.d9), ktime=jt)
+ ierr = putvar0d(ncout,id_varout(5), REAL(dvols /1.d9), ktime=jt)
+ ierr = putvar0d(ncout,id_varout(6), REAL(dareas /1.d9), ktime=jt)
+ ierr = putvar0d(ncout,id_varout(7), REAL(dextends /1.d9), ktime=jt)
+ ierr = putvar0d(ncout,id_varout(8), REAL(dextends2 /1.d9), ktime=jt)
+
+ END DO ! time loop
+ ierr = closeout(ncout)
END PROGRAM cdficediag
diff --git a/cdfimprovechk.f90 b/cdfimprovechk.f90
index be86008..7b950f1 100644
--- a/cdfimprovechk.f90
+++ b/cdfimprovechk.f90
@@ -1,120 +1,153 @@
PROGRAM cdfimprovechk
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfimprovechk ***
+ !!======================================================================
+ !! *** PROGRAM cdfimprovechk ***
+ !!=====================================================================
+ !! ** Purpose : Estimate the improvement/deterioration of a test run,
+ !! compared with a reference run relative to some observations
!!
- !! ** Purpose: Estimate the improvement/deterioration
- !! of a test run, compared with a reference run
- !! relative to some observations
- !! given zobs (observed field), zref (reference run field)
- !! and ztst (test run field)
- !! compute zchk as the ratio : zchk=(zref - ztst) / (zref - zobs )
- !! Where 0 < zchk <=1 the correction act in the right direction
- !! Where 1 < zchk the correction is too strong, in the right way
- !! Where zchk < 0 the correction is in the wrong way (deterioration)
- !! or deterioration (-1)
- !! store results on file
- !!
- !! ** Method: Try to avoid 3 d arrays
+ !! ** Method : Given zobs (observed field), zref (reference run field)
+ !! and ztst (test run field), compute zchk as the ratio:
+ !! zchk=(zref - ztst) / (zref - zobs )
!!
- !! history:
- !! Original : J.M. Molines (Nov. 2005)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! Where 0 < zchk <=1 correction act in the right direction
+ !! Where 1 < zchk correction is too strong, in the right way
+ !! Where zchk < 0 correction is in the wrong way (deterioration)
+ !!
+ !! History : 2.1 : 11/2005 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvpk !: dim of the working variable
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: zobs, zref, ztst ,& !: Array to read a layer of data
- & zmask ,& !: 2D mask at surface
- & zchk !: check index output
- REAL(KIND=4),DIMENSION(1) :: tim
-
- CHARACTER(LEN=256) :: cfilobs, cfilref, cfiltst ,cvar ,cfileout='chk.nc' !:
- TYPE (variable), DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: ncout
- INTEGER :: istatus
-
- !! Read command line
- narg= iargc()
+
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! browse line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvpk ! dim of the working variable
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid of output vars
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zobs ! observation array
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zref ! reference array
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztst ! test array
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at surface
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zchk ! check index output
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ CHARACTER(LEN=256) :: cf_obs ! observation-file name
+ CHARACTER(LEN=256) :: cf_ref ! reference-file name
+ CHARACTER(LEN=256) :: cf_tst ! test-file name
+ CHARACTER(LEN=256) :: cv_in ! cdf variable name
+ CHARACTER(LEN=256) :: cf_out='chk.nc' ! output filename
+
+ TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes
+
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfimprovechk cdfvar obs.nc ref.nc tst.nc '
- PRINT *,' Output on chk.nc, same variable '
+ PRINT *,' usage : cdfimprovechk IN-var OBS-file REF-file TST-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Estimate the improvement/deterioration of a test run,'
+ PRINT *,' compared with a reference run relative to some observations'
+ PRINT *,' This program computes the quantity zchk= ( REF - TEST )/(REF - OBS)'
+ PRINT *,' Where 0 < zchk <= 1, the TST is better than the reference'
+ PRINT *,' Where 1 < zchk, the TST was corrected in the right sense but too much'
+ PRINT *,' Where zchk < 0, the TST was corrected was corrected in the wrong way.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-var : netcdf input variable'
+ PRINT *,' OBS-file : netcdf observation file'
+ PRINT *,' REF-file : netcdf reference file'
+ PRINT *,' TST-file : netcdf test file'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : same as input variable.'
STOP
ENDIF
- CALL getarg (1, cvar)
- CALL getarg (2, cfilobs)
- CALL getarg (3, cfilref)
- CALL getarg (4, cfiltst)
+ CALL getarg (1, cv_in )
+ CALL getarg (2, cf_obs)
+ CALL getarg (3, cf_ref)
+ CALL getarg (4, cf_tst)
- npiglo= getdim (cfilref,'x')
- npjglo= getdim (cfilref,'y')
- npk = getdim (cfilref,'depth')
+ IF ( chkfile(cf_obs) .OR. chkfile(cf_ref) .OR. chkfile(cf_tst) ) STOP ! missing files
- nvpk = getvdim (cfilref,cvar)
+ npiglo = getdim(cf_ref, cn_x)
+ npjglo = getdim(cf_ref, cn_y)
+ npk = getdim(cf_ref, cn_z)
+ npt = getdim(cf_ref, cn_t)
+
+ nvpk = getvdim(cf_ref, cv_in)
IF (nvpk == 2 ) nvpk = 1
IF (nvpk == 3 ) nvpk = npk
- ipk(:)= nvpk ! all variables
- typvar(1)%name=TRIM(cvar)
- typvar(1)%units='%'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 100.
- typvar(1)%long_name='Checking ratio for'//TRIM(cvar)
- typvar(1)%short_name=cvar
- typvar(1)%online_operation='N/A'
- IF (nvpk == npk ) typvar(1)%axis='TZYX'
- IF (nvpk == 1 ) typvar(1)%axis='TYX'
+ ipk(:) = nvpk ! all variables
+ stypvar(1)%cname = TRIM(cv_in)
+ stypvar(1)%cunits = '%'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 100.
+ stypvar(1)%clong_name = 'Checking ratio for'//TRIM(cv_in)
+ stypvar(1)%cshort_name = cv_in
+ stypvar(1)%conline_operation = 'N/A'
+
+ IF (nvpk == npk ) stypvar(1)%caxis='TZYX'
+ IF (nvpk == 1 ) stypvar(1)%caxis='TYX'
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
- ALLOCATE (zobs(npiglo,npjglo), zref(npiglo,npjglo), ztst(npiglo,npjglo) ,zmask(npiglo,npjglo))
- ALLOCATE (zchk(npiglo,npjglo) )
+ ALLOCATE (zobs(npiglo,npjglo), zref(npiglo,npjglo), ztst(npiglo,npjglo), zmask(npiglo,npjglo))
+ ALLOCATE (zchk(npiglo,npjglo), tim(npt) )
! create output fileset
- ncout =create(cfileout, cfilref, npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilref,npiglo, npjglo,npk)
-
- zref = 0.
- zobs = 0.
- zmask = 1.
- DO jk = 1, npk
- PRINT *,'level ',jk
- zchk = 0.
- zobs(:,:) = getvar(cfilobs, cvar, jk ,npiglo, npjglo)
- zref(:,:) = getvar(cfilref, cvar, jk ,npiglo, npjglo)
- ztst(:,:) = getvar(cfiltst, cvar, jk ,npiglo, npjglo)
- IF (jk == 1 ) THEN
- tim=getvar1d(cfilref,'time_counter',1)
- WHERE( zref == 0. ) zmask=0.
- END IF
- WHERE ( (zref -zobs) /= 0 )
- zchk= (zref - ztst ) / ( zref - zobs) * zmask
- END WHERE
- ierr = putvar(ncout, id_varout(1) ,zchk, jk,npiglo, npjglo)
-
- ENDDO
-
- ierr=putvar1d(ncout,tim,1,'T')
-
- istatus = closeout(ncout)
+ ncout = create (cf_out, cf_ref, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_ref, npiglo, npjglo, npk )
+
+ zref = 0. ; zobs = 0. ; zmask = 1.
+
+ DO jt = 1,npt
+ DO jk = 1,npk
+ PRINT *,'level ',jk
+ zchk = 0.
+ zobs(:,:) = getvar(cf_obs, cv_in, jk ,npiglo, npjglo, ktime=jt)
+ zref(:,:) = getvar(cf_ref, cv_in, jk ,npiglo, npjglo, ktime=jt)
+ ztst(:,:) = getvar(cf_tst, cv_in, jk ,npiglo, npjglo, ktime=jt)
+
+ IF (jk == 1 ) THEN
+ WHERE( zref == 0. ) zmask = 0.
+ END IF
+ WHERE ( (zref - zobs ) /= 0 )
+ zchk = (zref - ztst ) / ( zref - zobs) * zmask
+ END WHERE
+ ierr = putvar(ncout, id_varout(1), zchk, jk, npiglo, npjglo, ktime=jt)
+
+ END DO
+ END DO
+
+ tim = getvar1d(cf_ref, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ ierr = closeout(ncout)
+
END PROGRAM cdfimprovechk
diff --git a/cdfinfo.f90 b/cdfinfo.f90
index ea7816c..b6e8d05 100644
--- a/cdfinfo.f90
+++ b/cdfinfo.f90
@@ -1,63 +1,72 @@
PROGRAM cdfinfo
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfinfo ***
+ !!======================================================================
+ !! *** PROGRAM cdfinfo ***
+ !!=====================================================================
+ !! ** Purpose : Give very basic informations for Netcdf File
!!
- !! ** Purpose: Give very basic informations for Netcdf File
- !!
- !! ** Method:
- !!
- !! history :
- !! Original code : J.M. Molines (Sep. 2010)
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
+ !! ** Method : to be improved
!!
+ !! History : 2.1 : 09/2010 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv , jtt,jkk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER :: ntframe !: Cumul of time frame
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout
- CHARACTER(LEN=256) :: cfile !: file name
- CHARACTER(LEN=256) :: cdep
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar
-
- INTEGER :: istatus
+ INTEGER(KIND=4) :: jvar ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc !
+ INTEGER(KIND=4) :: npiglo, npjglo, npk ,npt ! size of the domain
+ INTEGER(KIND=4) :: nvars ! Number of variables in a file
+ CHARACTER(LEN=256) :: cf_in ! file name
+ CHARACTER(LEN=256) :: cv_dep ! depth name
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! variable attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line
narg= iargc()
+
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfinfo ''model cdf file'' '
+ PRINT *,' usage : cdfinfo ''model cdf file'' '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Gives very basic information about the file given in arguments.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' model output file in netcdf.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' On standard ouput, gives the size of the domain, the depth '
+ PRINT *,' dimension name, the number of variables.'
+ PRINT *,' '
STOP
ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
+ CALL getarg (1, cf_in)
+ IF ( chkfile(cf_in) ) STOP ! missing file
+
+ npiglo = getdim (cf_in,cn_x)
+ npjglo = getdim (cf_in,cn_y)
+ npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- npk = getdim (cfile,'nav_lev',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- npk = getdim (cfile,'levels',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in,'nav_lev',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in,'levels',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
PRINT *,' assume file with no depth'
npk=0
ENDIF
@@ -65,25 +74,27 @@ PROGRAM cdfinfo
ENDIF
ENDIF
ENDIF
-
+
+ npt = getdim (cf_in,cn_t)
PRINT *, 'npiglo =', npiglo
PRINT *, 'npjglo =', npjglo
PRINT *, 'npk =', npk
+ PRINT *, 'npt =', npt
- PRINT *,' Depth dimension name is ', TRIM(cdep)
+ PRINT *,' Depth dimension name is ', TRIM(cv_dep)
- nvars = getnvar(cfile)
+ nvars = getnvar(cf_in)
PRINT *,' nvars =', nvars
- ALLOCATE (cvarname(nvars) )
- ALLOCATE (typvar(nvars) )
+ ALLOCATE (cv_names(nvars) )
+ ALLOCATE (stypvar(nvars) )
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ ! get list of variable names
+ cv_names(:)=getvarname(cf_in, nvars, stypvar)
DO jvar = 1, nvars
- PRINT *, 'variable# ',jvar,' is : ',TRIM(cvarname(jvar))
+ PRINT *, 'variable# ',jvar,' is : ',TRIM(cv_names(jvar))
END DO
END PROGRAM cdfinfo
diff --git a/cdfio.f90 b/cdfio.f90
index a929749..7be8095 100644
--- a/cdfio.f90
+++ b/cdfio.f90
@@ -1,95 +1,147 @@
MODULE cdfio
- !!---------------------------------------------------------------------------------------------------
+ !!======================================================================
!! *** MODULE cdfio ***
+ !! Implement all I/O related to netcdf in CDFTOOLS
+ !!=====================================================================
+ !! History : 2.1 : 2005 : J.M. Molines : Original code
+ !! : 2009 : R. Dussin : add putvar_0d function
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor + Licence
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! .............................
+ !! ERR_HDL : Error Handler routine to catch netcdf errors
+ !! gettimeseries : print a 2 column array (time, variable) for a given
+ !! file, variable and depth
!!
- !! ** Purpose : this module manage all the IO with Netcdf Library
- !!
- !! ** Method : provide functions that are used in the different
- !! subprograms for performing dedicated tasks
- !!
- !! history:
- !! Original : J.M. Molines (2005 )
- !! R. Dussin (2009) add putvar_0d function
+ !! functions : description
+ !! .............................
+ !! chkfile : check the existence of a file
+ !! closeout : close output file
+ !! copyatt : copy attributes from a file taken as model
+ !! create : create a netcdf data set
+ !! createvar : create netcdf variables in a new data set
+ !! cvaratt : change some var attributes
+ !! edatt_char : edit attributes of char type
+ !! edatt_r4 : edit attributes of float type
+ !! getatt : get attributes of a variable
+ !! getdim : return the value of the dimension passed as argument
+ !! getipk : get the vertical dimension of the variable
+ !! getnvar : get the number of variable in a file
+ !! getspval : get spval of a given variable
+ !! getvar1d : read 1D variable (eg depth, time_counter) from a file
+ !! getvaratt : read variable attributes
+ !! getvar : read the variable
+ !! getvare3 : read e3 type variable
+ !! getvarid : get the varid of a variable in a file
+ !! getvarname : get the name of a variable, according to its varid
+ !! getvarxz : get a x-z slice of 3D data
+ !! getvaryz : get a y-z slice of 3D data
+ !! getvdim : get the number of dim of a variable
+ !! ncopen : open a netcdf file and return its ncid
+ !! putatt : write variable attribute
+ !! putheadervar : write header variables such as nav_lon, nav_lat etc ... from a file taken
+ !! : as template
+ !! putvar0d : write a 0d variable (constant)
+ !! putvar1d4 : write a 1d variable
+ !! putvari2 : write a 2d Integer*2 variable
+ !! putvarr4 : write a 2d Real*4 variable
+ !! putvarr8 : write a 2d Real*8 variable
+ !! putvarzo : write a zonally integrated/mean field
+ !! reputvarr4 : re-write a real*4 variable
+ !! reputvar1d4 : re-write a real*4 1d variable
!!------------------------------------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- USE netcdf
+ USE netcdf
+ USE modcdfnames
IMPLICIT NONE
- INTEGER :: id_x, id_y, id_z, id_t, id_lat, id_lon, id_dep, id_tim
- LOGICAL :: l_mbathy=.false.
- INTEGER, DIMENSION(:,:), ALLOCATABLE :: mbathy !: for reading e3._ps in nemo3.x
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: e3t_ps, e3w_ps !: for reading e3._ps in nemo3.x
-! REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: e3u_ps, e3v_ps !: for reading e3._ps in nemo3.x
- REAL(kind=4), DIMENSION(:), ALLOCATABLE :: e3t_0, e3w_0 !: for readinf e3._ps in nemo3.x
+
+ PRIVATE
+
+ INTEGER(KIND=4) :: nid_x, nid_y, nid_z, nid_t, nid_lat, nid_lon, nid_dep, nid_tim
+ LOGICAL :: l_mbathy=.false.
+ INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: mbathy !: for reading e3._ps in nemo3.x
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3t_ps, e3w_ps !: for reading e3._ps in nemo3.x
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e3t_0, e3w_0 !: for readinf e3._ps in nemo3.x
TYPE, PUBLIC :: variable
- CHARACTER(LEN=256):: name
- CHARACTER(LEN=256):: units
- REAL(kind=4) :: missing_value
- REAL(kind=4) :: valid_min
- REAL(kind=4) :: valid_max
- REAL(kind=4) :: scale_factor=1.
- REAL(kind=4) :: add_offset=0.
- REAL(kind=4) :: savelog10=0.
- INTEGER :: iwght=1
- CHARACTER(LEN=256):: long_name
- CHARACTER(LEN=256):: short_name
- CHARACTER(LEN=256):: online_operation
- CHARACTER(LEN=256):: axis
- CHARACTER(LEN=256):: PRECISION='r4' ! possible values are i2, r4, r8
+ CHARACTER(LEN=256) :: cname !# variable name
+ CHARACTER(LEN=256) :: cunits !# variable unit
+ REAL(KIND=4) :: rmissing_value !# variable missing value or spval
+ REAL(KIND=4) :: valid_min !# valid minimum
+ REAL(KIND=4) :: valid_max !# valid maximum
+ REAL(KIND=4) :: scale_factor=1. !# scale factor
+ REAL(KIND=4) :: add_offset=0. !# add offset
+ REAL(KIND=4) :: savelog10=0. !# flag for log10 transform
+ INTEGER(KIND=4) :: iwght=1 !# weight of the variable for cdfmoy_weighted
+ CHARACTER(LEN=256) :: clong_name !# Long Name of the variable
+ CHARACTER(LEN=256) :: cshort_name !# short name of the variable
+ CHARACTER(LEN=256) :: conline_operation !# ???
+ CHARACTER(LEN=256) :: caxis !# string defining the dim of the variable
+ CHARACTER(LEN=256) :: cprecision='r4' !# possible values are i2, r4, r8
END TYPE variable
INTERFACE putvar
MODULE PROCEDURE putvarr8, putvarr4, putvari2, putvarzo, reputvarr4
END INTERFACE
- INTERFACE putvar1d
+ INTERFACE putvar1d
MODULE PROCEDURE putvar1d4, reputvar1d4
END INTERFACE
+ INTERFACE putvar0d
+ MODULE PROCEDURE putvar0dt, putvar0ds
+ END INTERFACE
+
INTERFACE atted
MODULE PROCEDURE atted_char, atted_r4
END INTERFACE
-
- PRIVATE
- PUBLIC copyatt, create, createvar, getvaratt,cvaratt
- PUBLIC putatt, putheadervar, putvar, putvar1d, putvar0d, atted
- PUBLIC getatt, getdim, getvdim, getipk, getnvar, getvarname, getvarid, getspval
- PUBLIC getvar, getvarxz, getvaryz, getvar1d, getvare3
- PUBLIC gettimeseries
- PUBLIC closeout, ncopen
- PUBLIC ERR_HDL
-
+ PUBLIC :: chkfile
+ PUBLIC :: copyatt, create, createvar, getvaratt, cvaratt
+ PUBLIC :: putatt, putheadervar, putvar, putvar1d, putvar0d, atted
+ PUBLIC :: getatt, getdim, getvdim, getipk, getnvar, getvarname, getvarid, getspval
+ PUBLIC :: getvar, getvarxz, getvaryz, getvar1d, getvare3
+ PUBLIC :: gettimeseries
+ PUBLIC :: closeout, ncopen
+ PUBLIC :: ERR_HDL
+
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
CONTAINS
- FUNCTION copyatt(cdvar,kidvar,kcin,kcout)
- !! ----------------------------------------------------------------------------------------------------
- !! *** Copy attributes for variable cdvar, which have id kidvar in kcout, from file id kcin
- !!
- !! ----------------------------------------------------------------------------------------------------
- ! * Arguments
- INTEGER, INTENT(in) :: kidvar, kcout
- INTEGER, INTENT(in) :: kcin
+
+ INTEGER(KIND=4) FUNCTION copyatt (cdvar, kidvar, kcin, kcout)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION copyatt ***
+ !!
+ !! ** Purpose : Copy attributes for variable cdvar, which have id
+ !! kidvar in kcout, from file id kcin
+ !!
+ !! ** Method : Use NF90_COPY_ATT
+ !!
+ !!----------------------------------------------------------------------
CHARACTER(LEN=*), INTENT(in) :: cdvar
- INTEGER :: copyatt
+ INTEGER(KIND=4), INTENT(in) :: kidvar, kcin, kcout
- ! * Local variable
- INTEGER :: istatus, idvar, iatt, ja
+ INTEGER(KIND=4) :: ja
+ INTEGER(KIND=4) :: istatus, idvar, iatt
CHARACTER(LEN=256) :: clatt
-
- IF ( kcin /= -9999) THEN
- istatus = NF90_INQ_VARID(kcin,cdvar,idvar)
- istatus = NF90_INQUIRE_VARIABLE(kcin,idvar,natts=iatt)
+ !!----------------------------------------------------------------------
+ IF ( kcin /= -9999) THEN ! there is a reference file open
+ istatus = NF90_INQ_VARID(kcin, cdvar, idvar)
+ istatus = NF90_INQUIRE_VARIABLE(kcin, idvar, natts=iatt)
DO ja = 1, iatt
istatus = NF90_INQ_ATTNAME(kcin,idvar,ja,clatt)
istatus = NF90_COPY_ATT(kcin,idvar,clatt,kcout,kidvar)
END DO
- ELSE
- SELECT CASE (cdvar )
+ ELSE ! no reference file
+ SELECT CASE (TRIM(cdvar) )
CASE ('nav_lon' )
istatus=NF90_PUT_ATT(kcout, kidvar, 'units', 'degrees_east')
istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_min', -180.)
@@ -115,6 +167,13 @@ CONTAINS
istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_max', 5875.)
istatus=NF90_PUT_ATT(kcout, kidvar, 'title', TRIM(cdvar))
istatus=NF90_PUT_ATT(kcout, kidvar, 'long_name', 'Vertical Levels')
+ CASE ('sigma')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'units', 'kg/m3')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'positive', 'unknown')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_min', 0.)
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_max', 40.)
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'title', TRIM(cdvar))
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'long_name', 'Sigma bin limits')
END SELECT
ENDIF
@@ -122,30 +181,29 @@ CONTAINS
END FUNCTION copyatt
- FUNCTION create( cdfile, cdfilref ,kx,ky,kz ,cdep, cdepvar)
- !! ------------------------------------------------------------------------------------------
- !! *** Create the file, and creates dimensions, and copy attributes from a cdilref
- !! reference file ( for the nav_lon, nav_lat etc ...)
- !! If optional cdep given : take as depth variable name instead of cdfilref
- !! Return the nc id of the created file, and leave it open
- !!
- !! ------------------------------------------------------------------------------------------
- ! * Arguments
- CHARACTER(LEN=*), INTENT(in) :: cdfile,cdfilref
- INTEGER, INTENT(in) :: kx,ky,kz
- CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep !: name of vertical dim name if not standard
- CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdepvar !: name of vertical var name if it differs
- !: from vertical dimension name
- INTEGER :: create
-
- ! * Local Variable
- INTEGER :: istatus, icout,ncid, idum
- INTEGER ,DIMENSION(4) :: nvdim
- CHARACTER(LEN=256) :: cldep, cldepref, cldepvar
-
+ INTEGER(KIND=4) FUNCTION create( cdfile, cdfilref ,kx,ky,kz ,cdep, cdepvar)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION create ***
+ !!
+ !! ** Purpose : Create the file, and creates dimensions, and copy attributes
+ !! from a cdilref reference file (for the nav_lon, nav_lat etc ...)
+ !! If optional cdep given : take as depth variable name instead of
+ !! cdfilref. Return the ncid of the created file, and leave it open
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile, cdfilref ! input file and reference file
+ INTEGER(KIND=4), INTENT(in) :: kx, ky, kz ! dimension of the variable
+ CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep ! name of vertical dim name if not standard
+ CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdepvar ! name of vertical var name if it differs
+ ! from vertical dimension name
+
+ INTEGER(KIND=4) :: istatus, icout, incid, idum
+ INTEGER(KIND=4) ,DIMENSION(4) :: invdim
+ CHARACTER(LEN=256) :: cldep, cldepref, cldepvar
+ !!----------------------------------------------------------------------
istatus = NF90_CREATE(cdfile,cmode=or(NF90_CLOBBER,NF90_64BIT_OFFSET), ncid=icout)
- istatus = NF90_DEF_DIM(icout,'x',kx, id_x)
- istatus = NF90_DEF_DIM(icout,'y',ky, id_y)
+ istatus = NF90_DEF_DIM(icout, 'x', kx, nid_x)
+ istatus = NF90_DEF_DIM(icout, 'y', ky, nid_y)
IF ( kz /= 0 ) THEN
! try to find out the name I will use for depth dimension in the new file ...
@@ -158,101 +216,103 @@ CONTAINS
cldepref=cldep
ENDIF
cldepvar=cldep
- istatus = NF90_DEF_DIM(icout,TRIM(cldep),kz, id_z)
+ istatus = NF90_DEF_DIM(icout,TRIM(cldep),kz, nid_z)
IF (PRESENT (cdepvar) ) THEN
cldepvar=cdepvar
ENDIF
ENDIF
- istatus = NF90_DEF_DIM(icout,'time_counter',NF90_UNLIMITED, id_t)
+ istatus = NF90_DEF_DIM(icout,'time_counter',NF90_UNLIMITED, nid_t)
- nvdim(1) = id_x ; nvdim(2) = id_y ; nvdim(3) = id_z ; nvdim(4) = id_t
+ invdim(1) = nid_x ; invdim(2) = nid_y ; invdim(3) = nid_z ; invdim(4) = nid_t
! Open reference file if any, otherwise set ncid to flag value (for copy att)
IF ( TRIM(cdfilref) /= 'none' ) THEN
- istatus = NF90_OPEN(cdfilref,NF90_NOWRITE,ncid)
+ istatus = NF90_OPEN(cdfilref,NF90_NOWRITE,incid)
ELSE
- ncid = -9999
+ incid = -9999
ENDIF
! define variables and copy attributes
- istatus = NF90_DEF_VAR(icout,'nav_lon',NF90_FLOAT,(/id_x,id_y/),id_lon)
- istatus = copyatt('nav_lon',id_lon,ncid,icout)
- istatus = NF90_DEF_VAR(icout,'nav_lat',NF90_FLOAT,(/id_x,id_y/),id_lat)
- istatus = copyatt('nav_lat',id_lat,ncid,icout)
+ istatus = NF90_DEF_VAR(icout,'nav_lon',NF90_FLOAT,(/nid_x, nid_y/), nid_lon)
+ istatus = copyatt('nav_lon', nid_lon,incid,icout)
+ istatus = NF90_DEF_VAR(icout,'nav_lat',NF90_FLOAT,(/nid_x, nid_y/), nid_lat)
+ istatus = copyatt('nav_lat', nid_lat,incid,icout)
IF ( kz /= 0 ) THEN
- istatus = NF90_DEF_VAR(icout,TRIM(cldepvar),NF90_FLOAT,(/id_z/),id_dep)
+ istatus = NF90_DEF_VAR(icout,TRIM(cldepvar),NF90_FLOAT,(/nid_z/), nid_dep)
! JMM bug fix : if cdep present, then chose attribute from cldepref
- istatus = copyatt(TRIM(cldepvar),id_dep,ncid,icout)
+ istatus = copyatt(TRIM(cldepvar), nid_dep,incid,icout)
ENDIF
- istatus = NF90_DEF_VAR(icout,'time_counter',NF90_FLOAT,(/id_t/),id_tim)
- istatus = copyatt('time_counter',id_tim,ncid,icout)
+ istatus = NF90_DEF_VAR(icout,'time_counter',NF90_FLOAT,(/nid_t/), nid_tim)
+ istatus = copyatt('time_counter', nid_tim,incid,icout)
- istatus = NF90_CLOSE(ncid)
+ istatus = NF90_CLOSE(incid)
create=icout
END FUNCTION create
- FUNCTION createvar(kout,ptyvar,kvar,kpk, kidvo, cdglobal)
- !! ----------------------------------------------------------------------------------------------------
- !! *** Create kvar n-2D variables cdvar(:), in file id kout, kpk gives the number of vertical levels
- !! idvo(:) contains the id of the crated variables.
- !! INPUT:
- !! kout = ncid of output file
- !! cdvar= array of name of variables
- !! kvar = number of variables to create
- !! kpk = number of vertical dimensions foreach variable
- !!
- !! OUTPUT:
- !! kidvo = arrays with the varid of the variables just created.
- !!
- !! ----------------------------------------------------------------------------------------------------
- ! * Arguments
- INTEGER, INTENT(in) :: kout, kvar
- INTEGER, DIMENSION(kvar), INTENT(in) :: kpk
- INTEGER, DIMENSION(kvar), INTENT(out) :: kidvo
- INTEGER :: createvar
- TYPE (variable), DIMENSION(kvar) ,INTENT(in) :: ptyvar
- CHARACTER(LEN=*), INTENT(in), OPTIONAL :: cdglobal
-
- ! * Local variables
- INTEGER :: jv,idims, istatus
- INTEGER, DIMENSION(4):: iidims
-
+ INTEGER(KIND=4) FUNCTION createvar(kout, sdtyvar, kvar, kpk, kidvo, cdglobal)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION createvar ***
+ !!
+ !! ** Purpose : Create kvar variables cdvar(:), in file id kout,
+ !!
+ !! ** Method : INPUT:
+ !! kout = ncid of output file
+ !! cdvar = array of name of variables
+ !! kvar = number of variables to create
+ !! kpk = number of vertical dimensions foreach variable
+ !! OUTPUT:
+ !! kidvo = arrays with the varid of the variables just created.
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file
+ TYPE (variable), DIMENSION(kvar) ,INTENT(in) :: sdtyvar ! variable structure
+ INTEGER(KIND=4), INTENT(in) :: kvar ! number of variable
+ INTEGER(KIND=4), DIMENSION(kvar), INTENT(in) :: kpk ! number of level/var
+ INTEGER(KIND=4), DIMENSION(kvar), INTENT(out):: kidvo ! varid's of output var
+ CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdglobal! Global Attribute
+
+ INTEGER(KIND=4) :: jv ! dummy loop index
+ INTEGER(KIND=4) :: idims, istatus
+ INTEGER(KIND=4), DIMENSION(4) :: iidims
+ INTEGER(KIND=4) :: iprecision
+ !!----------------------------------------------------------------------
DO jv = 1, kvar
-
! Create variables whose name is not 'none'
- IF ( ptyvar(jv)%name /= 'none' ) THEN
+ IF ( sdtyvar(jv)%cname /= 'none' ) THEN
IF (kpk(jv) == 1 ) THEN
idims=3
- iidims(1) = id_x ; iidims(2) = id_y ; iidims(3) = id_t
+ iidims(1) = nid_x ; iidims(2) = nid_y ; iidims(3) = nid_t
ELSE IF (kpk(jv) > 1 ) THEN
idims=4
- iidims(1) = id_x ; iidims(2) = id_y ; iidims(3) = id_z ; iidims(4) = id_t
+ iidims(1) = nid_x ; iidims(2) = nid_y ; iidims(3) = nid_z ; iidims(4) = nid_t
ELSE
- PRINT *,' ERROR: ipk = ',kpk(jv), jv , ptyvar(jv)%name
+ PRINT *,' ERROR: ipk = ',kpk(jv), jv , sdtyvar(jv)%cname
STOP
ENDIF
-
- IF ( ptyvar(jv)%precision == 'r8' ) THEN
- istatus = NF90_DEF_VAR(kout,ptyvar(jv)%name,NF90_DOUBLE,iidims(1:idims) ,kidvo(jv) )
- ELSE IF ( ptyvar(jv)%precision == 'i2' ) THEN
- istatus = NF90_DEF_VAR(kout,ptyvar(jv)%name,NF90_SHORT,iidims(1:idims) ,kidvo(jv) )
- ELSE IF ( ptyvar(jv)%precision == 'by' ) THEN
- istatus = NF90_DEF_VAR(kout,ptyvar(jv)%name,NF90_BYTE,iidims(1:idims) ,kidvo(jv) )
- ELSE
- IF ( ptyvar(jv)%scale_factor == 1. .AND. ptyvar(jv)%add_offset == 0. ) THEN
- istatus = NF90_DEF_VAR(kout,ptyvar(jv)%name,NF90_FLOAT,iidims(1:idims) ,kidvo(jv) )
- ELSE
- istatus = NF90_DEF_VAR(kout,ptyvar(jv)%name,NF90_SHORT,iidims(1:idims) ,kidvo(jv) )
+
+ SELECT CASE ( sdtyvar(jv)%cprecision ) ! check the precision of the variable to create
+ !
+ CASE ( 'r8' ) ; iprecision = NF90_DOUBLE
+ !
+ CASE ( 'i2' ) ; iprecision = NF90_SHORT
+ !
+ CASE ( 'by' ) ; iprecision = NF90_BYTE
+ !
+ CASE DEFAULT ! r4
+ iprecision = NF90_FLOAT
+ IF ( sdtyvar(jv)%scale_factor /= 1. .OR. sdtyvar(jv)%add_offset /= 0. ) THEN
+ iprecision = NF90_SHORT
ENDIF
- ENDIF
+ END SELECT
+
+ istatus = NF90_DEF_VAR(kout, sdtyvar(jv)%cname, iprecision, iidims(1:idims) ,kidvo(jv) )
! add attributes
- istatus = putatt(ptyvar(jv), kout,kidvo(jv),cdglobal=cdglobal)
+ istatus = putatt(sdtyvar(jv), kout, kidvo(jv), cdglobal=cdglobal)
createvar=istatus
ENDIF
END DO
@@ -260,205 +320,200 @@ CONTAINS
END FUNCTION createvar
+
FUNCTION getvarid( cdfile, knvars )
- !! ------------------------------------------------------------------------------------------
- !! *** return a real array with the nvar variable id
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION getvarid ***
!!
- !! ------------------------------------------------------------------------------------------
- ! * Arguments
- CHARACTER(LEN=*), INTENT(in) :: cdfile
- INTEGER, INTENT(in) :: knvars ! Number of variables in cdfile
- INTEGER, DIMENSION(knvars) :: getvarid
+ !! ** Purpose : return a real array with the nvar variable id
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile
+ INTEGER(KIND=4), INTENT(in) :: knvars ! Number of variables in cdfile
+ INTEGER(KIND=4), DIMENSION(knvars) :: getvarid ! return function
- !! * local declarations
+ INTEGER(KIND=4) :: jv ! dummy loop index
CHARACTER(LEN=256), DIMENSION(knvars) :: cdvar
- INTEGER :: ncid, jv
- INTEGER :: istatus
-
-
- istatus = NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
+ INTEGER(KIND=4) :: incid
+ INTEGER(KIND=4) :: istatus
+ !!----------------------------------------------------------------------
+ istatus = NF90_OPEN(cdfile, NF90_NOWRITE, incid)
DO jv = 1, knvars
- istatus = NF90_INQUIRE_VARIABLE(ncid,jv,cdvar(jv) )
- istatus = NF90_INQ_VARID(ncid,cdvar(jv),getvarid(jv))
+ istatus = NF90_INQUIRE_VARIABLE(incid, jv, cdvar(jv) )
+ istatus = NF90_INQ_VARID(incid, cdvar(jv), getvarid(jv))
ENDDO
- istatus=NF90_CLOSE(ncid)
+ istatus=NF90_CLOSE(incid)
END FUNCTION getvarid
- FUNCTION getvaratt (cdfile,cdvar,cdunits, pmissing_value, cdlong_name, cdshort_name)
- !! ----------------------------------------------------------------------------------------------------
- !! *** Change variable attributs in an existing variable
+
+ INTEGER(KIND=4) FUNCTION getvaratt (cdfile, cdvar, cdunits, pmissing_value, cdlong_name, cdshort_name)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION getvaratt ***
!!
- !! ----------------------------------------------------------------------------------------------------
- ! * Arguments
- CHARACTER(LEN=256), INTENT(in) :: cdfile, cdvar
+ !! ** Purpose : Get specific attributes for a variable (units, missing_value,
+ !! long_name, short_name
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=256), INTENT(in) :: cdfile, cdvar
+ REAL(KIND=4), INTENT(out) :: pmissing_value
CHARACTER(LEN=256), INTENT(out) :: cdunits, cdlong_name, cdshort_name
- REAL(KIND=4), INTENT(out) :: pmissing_value
- INTEGER :: getvaratt
-
- !! * local declarations
- INTEGER :: istatus
- INTEGER :: ncid, varid
- istatus = NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
- istatus = NF90_INQ_VARID(ncid,cdvar,varid)
+ INTEGER(KIND=4) :: istatus
+ INTEGER(KIND=4) :: incid, ivarid
+ !!----------------------------------------------------------------------
+ istatus = NF90_OPEN(cdfile, NF90_NOWRITE, incid)
+ istatus = NF90_INQ_VARID(incid, cdvar, ivarid)
- istatus=NF90_GET_ATT(ncid, varid, 'units', cdunits)
- istatus=NF90_GET_ATT(ncid, varid, 'missing_value', pmissing_value)
- istatus=NF90_GET_ATT(ncid, varid, 'long_name', cdlong_name)
- istatus=NF90_GET_ATT(ncid, varid, 'short_name', cdshort_name)
+ istatus = NF90_GET_ATT(incid, ivarid, 'units', cdunits )
+ istatus = NF90_GET_ATT(incid, ivarid, 'missing_value', pmissing_value )
+ istatus = NF90_GET_ATT(incid, ivarid, 'long_name', cdlong_name )
+ istatus = NF90_GET_ATT(incid, ivarid, 'short_name', cdshort_name )
-! istatus = NF90_ENDDEF(ncid)
- getvaratt=istatus
- istatus=NF90_CLOSE(ncid)
+ getvaratt = istatus
+ istatus = NF90_CLOSE(incid)
END FUNCTION getvaratt
- FUNCTION cvaratt (cdfile,cdvar,cdunits,pmissing_value, cdlong_name, cdshort_name)
- !! ----------------------------------------------------------------------------------------------------
- !! *** Change variable attributs in an existing variable
+ INTEGER(KIND=4) FUNCTION cvaratt (cdfile, cdvar, cdunits, pmissing_value, cdlong_name, cdshort_name)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION cvaratt ***
+ !!
+ !! ** Purpose : Change variable attributs in an existing variable
!!
- !! ----------------------------------------------------------------------------------------------------
- ! * Arguments
+ !!----------------------------------------------------------------------
CHARACTER(LEN=256), INTENT(in) :: cdfile, cdvar
CHARACTER(LEN=256), INTENT(in) :: cdunits, cdlong_name, cdshort_name
- INTEGER :: cvaratt
- REAL(KIND=4) :: pmissing_value
+ REAL(KIND=4), INTENT(in) :: pmissing_value
- !! * local declarations
- INTEGER :: istatus
- INTEGER :: ncid, varid
+ INTEGER(KIND=4) :: istatus
+ INTEGER(KIND=4) :: incid, ivarid
+ !!----------------------------------------------------------------------
+ istatus = NF90_OPEN (cdfile, NF90_WRITE, incid)
+ istatus = NF90_REDEF(incid)
+ istatus = NF90_INQ_VARID(incid, cdvar, ivarid)
- istatus = NF90_OPEN(cdfile,NF90_WRITE,ncid)
- istatus = NF90_REDEF(ncid)
- istatus = NF90_INQ_VARID(ncid,cdvar,varid)
+ istatus=NF90_RENAME_ATT(incid, ivarid, 'units', cdunits )
+ istatus=NF90_PUT_ATT (incid, ivarid, 'missing_value', pmissing_value )
+ istatus=NF90_RENAME_ATT(incid, ivarid, 'long_name', cdlong_name )
+ istatus=NF90_RENAME_ATT(incid, ivarid, 'short_name', cdshort_name )
- istatus=NF90_RENAME_ATT(ncid, varid, 'units', cdunits)
- istatus=NF90_PUT_ATT(ncid, varid, 'missing_value', pmissing_value)
- istatus=NF90_RENAME_ATT(ncid, varid, 'long_name', cdlong_name)
- istatus=NF90_RENAME_ATT(ncid, varid, 'short_name', cdshort_name)
-
- istatus=NF90_ENDDEF(ncid)
+ istatus=NF90_ENDDEF(incid)
cvaratt=istatus
- istatus=NF90_CLOSE(ncid)
+ istatus=NF90_CLOSE(incid)
END FUNCTION cvaratt
- FUNCTION putatt (tyvar,kout,kid,cdglobal)
- !! ----------------------------------------------------------------------------------------------------
- !! *** Scan file att.txt for finding the line corresponding to cdvar, then read the attributes
- !! for this variables ,whose id is kid and write them in file id kout
+ INTEGER(KIND=4) FUNCTION putatt (sdtyvar, kout, kid, cdglobal)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION putatt ***
!!
- !! ----------------------------------------------------------------------------------------------------
- ! * Arguments
- INTEGER :: putatt
- INTEGER, INTENT(in) :: kout, kid
- TYPE (variable) ,INTENT(in) :: tyvar
- CHARACTER(LEN=*), INTENT(in), OPTIONAL :: cdglobal !: global attribute
- putatt=NF90_PUT_ATT(kout,kid,'units',tyvar%units)
+ !! ** Purpose : Put attribute for variable defined in the data structure
+ !!
+ !!----------------------------------------------------------------------
+ TYPE (variable), INTENT(in) :: sdtyvar
+ INTEGER(KIND=4), INTENT(in) :: kout, kid
+ CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdglobal !: global attribute
+ !!----------------------------------------------------------------------
+ putatt=NF90_PUT_ATT(kout,kid,'units',sdtyvar%cunits)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt units'; ENDIF
- putatt=NF90_PUT_ATT(kout,kid,'missing_value',tyvar%missing_value)
+ putatt=NF90_PUT_ATT(kout,kid,'missing_value',sdtyvar%rmissing_value)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt missing value'; ENDIF
- putatt=NF90_PUT_ATT(kout,kid,'valid_min',tyvar%valid_min)
+ putatt=NF90_PUT_ATT(kout,kid,'valid_min',sdtyvar%valid_min)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt valid_min'; ENDIF
- putatt=NF90_PUT_ATT(kout,kid,'valid_max',tyvar%valid_max)
+ putatt=NF90_PUT_ATT(kout,kid,'valid_max',sdtyvar%valid_max)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt valid_max'; ENDIF
- putatt=NF90_PUT_ATT(kout,kid,'long_name',tyvar%long_name)
+ putatt=NF90_PUT_ATT(kout,kid,'long_name',sdtyvar%clong_name)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt longname'; ENDIF
- putatt=NF90_PUT_ATT(kout,kid,'short_name',tyvar%short_name)
+ putatt=NF90_PUT_ATT(kout,kid,'short_name',sdtyvar%cshort_name)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt short name'; ENDIF
- putatt=NF90_PUT_ATT(kout,kid,'iweight',tyvar%iwght)
+ putatt=NF90_PUT_ATT(kout,kid,'iweight',sdtyvar%iwght)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt iweight'; ENDIF
- putatt=NF90_PUT_ATT(kout,kid,'online_operation',tyvar%online_operation)
+ putatt=NF90_PUT_ATT(kout,kid,'online_operation',sdtyvar%conline_operation)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt online oper'; ENDIF
- putatt=NF90_PUT_ATT(kout,kid,'axis',tyvar%axis)
+ putatt=NF90_PUT_ATT(kout,kid,'axis',sdtyvar%caxis)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt axis'; ENDIF
+
! Optional attributes (scale_factor, add_offset )
- putatt=NF90_PUT_ATT(kout,kid,'scale_factor',tyvar%scale_factor)
+ putatt=NF90_PUT_ATT(kout,kid,'scale_factor',sdtyvar%scale_factor)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt scale fact'; ENDIF
- putatt=NF90_PUT_ATT(kout,kid,'add_offset',tyvar%add_offset)
+ putatt=NF90_PUT_ATT(kout,kid,'add_offset',sdtyvar%add_offset)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt add offset'; ENDIF
- putatt=NF90_PUT_ATT(kout,kid,'savelog10',tyvar%savelog10)
+ putatt=NF90_PUT_ATT(kout,kid,'savelog10',sdtyvar%savelog10)
IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt savelog0'; ENDIF
+
! Global attribute
IF ( PRESENT(cdglobal) ) THEN
- putatt=NF90_PUT_ATT(kout,NF90_GLOBAL,'history',cdglobal)
- IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt global'; ENDIF
+ putatt=NF90_PUT_ATT(kout,NF90_GLOBAL,'history',cdglobal)
+ IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt global'; ENDIF
ENDIF
END FUNCTION putatt
- FUNCTION getatt(cdfile,cdvar,cdatt)
- !!-----------------------------------------------------------
- !! *** FUNCTION getatt ***
+
+ REAL(KIND=4) FUNCTION getatt (cdfile, cdvar, cdatt)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION getatt ***
!!
- !! ** Purpose : return a REAL value with the values of the
- !! attribute cdatt for all the variable cdvar in cdfile
- !!
- !! ** Method : open, read attribute close
+ !! ** Purpose : return a REAL value with the values of the
+ !! attribute cdatt for all the variable cdvar in cdfile
!!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !! 12/03/2007 : J.M. Molines : modif
- !!-----------------------------------------------------------
- !! * Arguments declarations
-
- CHARACTER(LEN=*), INTENT(in) :: cdatt, & ! attribute name to look for
- & cdfile, & ! file to look at
- & cdvar
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name
+ CHARACTER(LEN=*), INTENT(in) :: cdvar ! var name
+ CHARACTER(LEN=*), INTENT(in) :: cdatt ! attribute name to look for
- REAL(KIND=4) :: getatt
+ INTEGER(KIND=4) :: istatus, jv, incid, idum
+ !!----------------------------------------------------------------------
+ istatus = NF90_OPEN (cdfile, NF90_NOWRITE, incid)
+ istatus = NF90_INQ_VARID(incid, cdvar, idum)
- !! * Local declarations
-
- INTEGER :: istatus, jv, ncid, idum
- !! ----------------------------------------------------------
- istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
- istatus=NF90_INQ_VARID(ncid,cdvar,idum)
IF ( istatus /= NF90_NOERR) PRINT *, TRIM(NF90_STRERROR(istatus)),' when looking for ',TRIM(cdvar),' in getatt.'
- istatus = NF90_GET_ATT(ncid, idum,cdatt, getatt)
+
+ istatus = NF90_GET_ATT(incid, idum, cdatt, getatt)
IF ( istatus /= NF90_NOERR ) THEN
PRINT *,' getatt problem :',NF90_STRERROR(istatus)
PRINT *,' attribute :', TRIM(cdatt)
PRINT *,' return default 0 '
getatt=0.
ENDIF
- istatus=NF90_CLOSE(ncid)
+
+ istatus=NF90_CLOSE(incid)
END FUNCTION getatt
- FUNCTION atted_char ( cdfile, cdvar, cdatt, cdvalue )
- !!-------------------------------------------------------------------------
- !! *** FUNCTION atted_char ***
- !!
- !! ** Purpose : attribute editor : modify existing attribute or create
- !! new attribute for variable cdvar in cdfile
- !!
- !! ** Method : just put_att after some check.
- !!-------------------------------------------------------------------------
- CHARACTER(LEN=*), INTENT(in) :: cdfile ! input file
- CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name
- CHARACTER(LEN=*), INTENT(in) :: cdatt ! attribute name
- CHARACTER(LEN=*), INTENT(in) :: cdvalue ! attribute value
- INTEGER :: atted_char
-
- INTEGER :: incid, istatus, idvar, ityp
- !!-------------------------------------------------------------------------
- istatus = NF90_OPEN(cdfile, NF90_WRITE, incid)
- istatus = NF90_INQ_VARID(incid, cdvar, idvar)
- IF ( istatus /= NF90_NOERR ) THEN
+
+ INTEGER(KIND=4) FUNCTION atted_char ( cdfile, cdvar, cdatt, cdvalue )
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION atted_char ***
+ !!
+ !! ** Purpose : attribute editor : modify existing attribute or create
+ !! new attribute for variable cdvar in cdfile
+ !!
+ !! ** Method : just put_att after some check.
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! input file
+ CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name
+ CHARACTER(LEN=*), INTENT(in) :: cdatt ! attribute name
+ CHARACTER(LEN=*), INTENT(in) :: cdvalue ! attribute value
+
+ INTEGER(KIND=4) :: incid, istatus, idvar, ityp
+ !!-------------------------------------------------------------------------
+ istatus = NF90_OPEN(cdfile, NF90_WRITE, incid)
+ istatus = NF90_INQ_VARID(incid, cdvar, idvar)
+ IF ( istatus /= NF90_NOERR ) THEN
PRINT *, NF90_STRERROR(istatus),' in atted ( inq_varid)'
STOP
- ENDIF
- istatus = NF90_INQUIRE_ATTRIBUTE(incid, idvar, cdatt, xtype=ityp )
- IF ( istatus /= NF90_NOERR ) THEN
+ ENDIF
+ istatus = NF90_INQUIRE_ATTRIBUTE(incid, idvar, cdatt, xtype=ityp )
+ IF ( istatus /= NF90_NOERR ) THEN
PRINT *, ' Attribute does not exist. Create it'
istatus = NF90_REDEF(incid)
istatus = NF90_PUT_ATT(incid, idvar, cdatt, cdvalue)
atted_char = istatus
- ELSE
+ ELSE
IF ( ityp == NF90_CHAR ) THEN
istatus = NF90_REDEF(incid)
istatus = NF90_PUT_ATT(incid, idvar, cdatt, cdvalue)
@@ -467,41 +522,41 @@ CONTAINS
PRINT *, ' Mismatch in attribute type in atted_char'
STOP
ENDIF
- ENDIF
+ ENDIF
istatus=NF90_CLOSE(incid)
END FUNCTION atted_char
- FUNCTION atted_r4 ( cdfile, cdvar, cdatt, pvalue )
- !!-------------------------------------------------------------------------
- !! *** FUNCTION atted_r4 ***
- !!
- !! ** Purpose : attribute editor : modify existing attribute or create
- !! new attribute for variable cdvar in cdfile
- !!
- !! ** Method : just put_att after some check.
- !!-------------------------------------------------------------------------
- CHARACTER(LEN=*), INTENT(in) :: cdfile ! input file
- CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name
- CHARACTER(LEN=*), INTENT(in) :: cdatt ! attribute name
- REAL(KIND=4), INTENT(in) :: pvalue ! attribute value
- INTEGER :: atted_r4
-
- INTEGER :: incid, istatus, idvar, ityp
- !!-------------------------------------------------------------------------
- istatus = NF90_OPEN(cdfile, NF90_WRITE, incid)
- istatus = NF90_INQ_VARID(incid, cdvar, idvar)
- IF ( istatus /= NF90_NOERR ) THEN
+
+ INTEGER(KIND=4) FUNCTION atted_r4 ( cdfile, cdvar, cdatt, pvalue )
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION atted_r4 ***
+ !!
+ !! ** Purpose : attribute editor : modify existing attribute or create
+ !! new attribute for variable cdvar in cdfile
+ !!
+ !! ** Method : just put_att after some check.
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! input file
+ CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name
+ CHARACTER(LEN=*), INTENT(in) :: cdatt ! attribute name
+ REAL(KIND=4), INTENT(in) :: pvalue ! attribute value
+
+ INTEGER(KIND=4) :: incid, istatus, idvar, ityp
+ !!-------------------------------------------------------------------------
+ istatus = NF90_OPEN(cdfile, NF90_WRITE, incid)
+ istatus = NF90_INQ_VARID(incid, cdvar, idvar)
+ IF ( istatus /= NF90_NOERR ) THEN
PRINT *, NF90_STRERROR(istatus),' in atted ( inq_varid)'
STOP
- ENDIF
- istatus = NF90_INQUIRE_ATTRIBUTE(incid, idvar, cdatt, xtype=ityp )
- IF ( istatus /= NF90_NOERR ) THEN
+ ENDIF
+ istatus = NF90_INQUIRE_ATTRIBUTE(incid, idvar, cdatt, xtype=ityp )
+ IF ( istatus /= NF90_NOERR ) THEN
PRINT *, ' Attribute does not exist. Create it'
istatus = NF90_REDEF(incid)
istatus = NF90_PUT_ATT(incid, idvar, cdatt, pvalue)
atted_r4 = istatus
- ELSE
+ ELSE
IF ( ityp == NF90_FLOAT ) THEN
istatus = NF90_REDEF(incid)
istatus = NF90_PUT_ATT(incid, idvar, cdatt, pvalue)
@@ -510,83 +565,73 @@ CONTAINS
PRINT *, ' Mismatch in attribute type in atted_r4'
STOP
ENDIF
- ENDIF
+ ENDIF
istatus=NF90_CLOSE(incid)
END FUNCTION atted_r4
-
- FUNCTION getdim (cdfile,cdim_name,cdtrue,kstatus,ldexact)
- !!-----------------------------------------------------------
- !! *** FUNCTION getdim ***
- !!
- !! ** Purpose : return the INTEGER value of the dimension
- !! identified with cdim_name in cdfile
- !!
- !! ** Method : Scan all the dimension name in cdfile and
- !! select the one which match cdim_name.
- !! cdim_name can be only a fraction of the total name
- !! (eg: depth will be ok for depht, or dephu, or dephv )
- !!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- CHARACTER(LEN=*), INTENT(in) :: cdfile , & ! File name to look at
- & cdim_name ! dimension name to look at
- CHARACTER(LEN=256),OPTIONAL, INTENT(out) :: cdtrue ! full name of the read dimension
- INTEGER, OPTIONAL, INTENT(out) :: kstatus ! status of the nf inquire
- LOGICAL, OPTIONAL, INTENT(in) :: ldexact ! when true look for exact cdim_name
- INTEGER :: getdim ! the value for dim cdim_name, in file cdfile
-
- ! * Local variables
- INTEGER :: ncid, id_var
- INTEGER :: istatus
- INTEGER :: idims
+ INTEGER(KIND=4) FUNCTION getdim (cdfile, cdim_name, cdtrue, kstatus, ldexact)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION getdim ***
+ !!
+ !! ** Purpose : Return the INTEGER value of the dimension
+ !! identified with cdim_name in cdfile
+ !!
+ !! ** Method : This function look for a dimension name that contains
+ !! cdim_name, in cdfile. In option it returns the error
+ !! status which can be used to make another intent, changing
+ !! the dim name. Finally, with the last optional argument
+ !! ldexact, exact match to cdim_name can be required.
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in ) :: cdfile ! File name to look at
+ CHARACTER(LEN=*), INTENT(in ) :: cdim_name ! File name to look at
+ CHARACTER(LEN=256), OPTIONAL, INTENT(out) :: cdtrue ! full name of the read dimension
+ INTEGER(KIND=4), OPTIONAL, INTENT(out) :: kstatus ! status of the nf inquire
+ LOGICAL, OPTIONAL, INTENT(in ) :: ldexact ! when true look for exact cdim_name
+
+ INTEGER(KIND=4) :: jdim
+ INTEGER(KIND=4) :: incid, id_dim
+ INTEGER(KIND=4) :: istatus
+ INTEGER(KIND=4) :: idims
CHARACTER(LEN=256) :: clnam
- LOGICAL :: lexact=.false.
+ LOGICAL :: lexact = .false.
+ !!-----------------------------------------------------------
clnam = '-------------'
IF ( PRESENT(kstatus) ) kstatus=0
IF ( PRESENT(ldexact) ) lexact=ldexact
- istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
+ istatus=NF90_OPEN(cdfile, NF90_NOWRITE, incid)
IF ( istatus == NF90_NOERR ) THEN
- istatus=NF90_INQUIRE(ncid,ndimensions=idims)
-
- id_var = 1
- ! Look for dim name containing at least 'cdim_name'
- ! DO WHILE ( INDEX(clnam,cdim_name) == 0 .AND. id_var <= idims )
- ! istatus=NF90_INQUIRE_DIMENSION(ncid,id_var,name=clnam,len=getdim)
- ! id_var = id_var + 1
- ! END DO
+ istatus=NF90_INQUIRE(incid, ndimensions=idims)
IF ( lexact ) THEN
- istatus=NF90_INQ_DIMID(ncid,cdim_name,id_var)
+ istatus=NF90_INQ_DIMID(incid, cdim_name, id_dim)
IF (istatus /= NF90_NOERR ) THEN
PRINT *,NF90_STRERROR(istatus)
PRINT *,' Exact dimension name ', TRIM(cdim_name),' not found in ',TRIM(cdfile) ; STOP
ENDIF
- istatus=NF90_INQUIRE_DIMENSION(ncid,id_var,len=getdim)
+ istatus=NF90_INQUIRE_DIMENSION(incid, id_dim, len=getdim)
IF ( PRESENT(cdtrue) ) cdtrue=cdim_name
- ELSE
- DO id_var = 1,idims
- istatus=NF90_INQUIRE_DIMENSION(ncid,id_var,name=clnam,len=getdim)
- IF ( INDEX(clnam,cdim_name) /= 0 ) THEN
+ jdim = 0
+ ELSE ! scann all dims to look for a partial match
+ DO jdim = 1, idims
+ istatus=NF90_INQUIRE_DIMENSION(incid, jdim, name=clnam, len=getdim)
+ IF ( INDEX(clnam, TRIM(cdim_name)) /= 0 ) THEN
IF ( PRESENT(cdtrue) ) cdtrue=clnam
EXIT
ENDIF
ENDDO
ENDIF
- IF ( id_var > idims ) THEN
- ! PRINT *,' warning: problem in getdim for ', TRIM(cdim_name),' in ', TRIM(cdfile)
+ IF ( jdim > idims ) THEN ! dimension not found
IF ( PRESENT(kstatus) ) kstatus=1 ! error send optionally to the calling program
getdim=0
IF ( PRESENT(cdtrue) ) cdtrue='unknown'
ENDIF
- istatus=NF90_CLOSE(ncid)
- ELSE
+ istatus=NF90_CLOSE(incid)
+ ELSE ! problem with the file
IF ( PRESENT(cdtrue) ) cdtrue='unknown'
IF ( PRESENT(kstatus) ) kstatus=1
ENDIF
@@ -595,137 +640,127 @@ CONTAINS
END FUNCTION getdim
- FUNCTION getspval (cdfile,cdvar)
- !!-----------------------------------------------------------
- !! *** FUNCTION getspval ***
+
+ REAL(KIND=4) FUNCTION getspval (cdfile, cdvar)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION getspval ***
!!
- !! ** Purpose : return the SPVAL value of the variable
- !! cdvar in cdfile
+ !! ** Purpose : return the SPVAL value of the variable cdvar in cdfile
!!
- !!-----------------------------------------------------------
- !! * Arguments declarations
- CHARACTER(LEN=*), INTENT(in) :: cdfile , & ! File name to look at
- & cdvar ! variable name
- REAL(KIND=4) :: getspval ! the missing value for cdvar
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! File name to look at
+ CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name
- ! * Local variables
- INTEGER :: ncid, id_var
- INTEGER :: istatus
+ INTEGER(KIND=4) :: incid, id_var
+ INTEGER(KIND=4) :: istatus
+ !!----------------------------------------------------------------------
- istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
- istatus=NF90_INQ_VARID ( ncid,cdvar,id_var)
- istatus=NF90_GET_ATT(ncid,id_var,"missing_value",getspval)
- istatus=NF90_CLOSE(ncid)
+ istatus=NF90_OPEN (cdfile, NF90_NOWRITE, incid )
+ istatus=NF90_INQ_VARID (incid, cdvar, id_var )
+ istatus=NF90_GET_ATT (incid, id_var, "missing_value", getspval)
+ istatus=NF90_CLOSE (incid )
END FUNCTION getspval
- FUNCTION getvdim (cdfile, cdvar)
- !!-----------------------------------------------------------
- !! *** FUNCTION getvdim ***
+
+ INTEGER(KIND=4) FUNCTION getvdim (cdfile, cdvar)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION getvdim ***
!!
- !! ** Purpose : return the number of dimensions for variable cdvar in cdfile
+ !! ** Purpose : Return the number of dimensions for variable cdvar in cdfile
!!
!! ** Method : Inquire for variable cdvar in cdfile. If found,
!! determines the number of dimensions , assuming that variables
!! are either (x,y,dep,time) or (x,y,time)
!! If cdvar is not found, give an interactive choice for an existing
- !! variable, cdvar is then updated to this correct name.
+ !! variable, cdvar is then updated to this correct name.
!!
- !! history:
- !! 31/10/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- CHARACTER(LEN=*), INTENT(in) :: cdfile ! File name to look at
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! File name to look at
CHARACTER(LEN=*), INTENT(inout) :: cdvar ! variable name to look at.
- INTEGER :: getvdim ! number of lebvels for cdvar
- !! * Local variables
- INTEGER :: istatus, ncid, id_var, ivar, idi, istatus0
- INTEGER :: jvar
+ INTEGER(KIND=4) :: jvar
+ INTEGER(KIND=4) :: istatus, incid, id_var, ivar, idi, istatus0
CHARACTER(LEN=256) :: clongname='long_name', clongn
+ !!----------------------------------------------------------------------
+ CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,incid))
- CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,ncid))
- istatus0 = NF90_INQ_VARID ( ncid,cdvar,id_var)
+ istatus0 = NF90_INQ_VARID ( incid,cdvar,id_var)
DO WHILE ( istatus0 == NF90_ENOTVAR )
ivar=getnvar(cdfile)
PRINT *, 'Give the number corresponding to the variable you want to work with '
DO jvar = 1, ivar
clongn=''
- istatus=NF90_INQUIRE_VARIABLE (ncid, jvar, cdvar,ndims=idi)
- istatus=NF90_GET_ATT (ncid,jvar,clongname,clongn)
+ istatus=NF90_INQUIRE_VARIABLE (incid, jvar, cdvar, ndims=idi)
+ istatus=NF90_GET_ATT (incid, jvar, clongname, clongn)
IF (istatus /= NF90_NOERR ) clongn='unknown'
PRINT *, jvar, ' ',TRIM(cdvar),' ',TRIM(clongn)
ENDDO
READ *,id_var
- istatus0=NF90_INQUIRE_VARIABLE (ncid, id_var, cdvar,ndims=idi)
+ istatus0=NF90_INQUIRE_VARIABLE (incid, id_var, cdvar, ndims=idi)
ENDDO
!
- CALL ERR_HDL(NF90_INQUIRE_VARIABLE (ncid, id_var, cdvar,ndims=idi))
- getvdim=idi-1
- CALL ERR_HDL (NF90_CLOSE(ncid))
+ CALL ERR_HDL(NF90_INQUIRE_VARIABLE (incid, id_var, cdvar, ndims=idi))
+ getvdim = idi - 1
+ CALL ERR_HDL (NF90_CLOSE(incid))
+
END FUNCTION getvdim
- FUNCTION getnvar (cdfile)
- !!-----------------------------------------------------------
- !! *** FUNCTION getnvar ***
- !!
- !! ** Purpose : return the number of variables in cdfile
+
+ INTEGER(KIND=4) FUNCTION getnvar (cdfile)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION getnvar ***
!!
- !! ** Method :
+ !! ** Purpose : return the number of variables in cdfile
!!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
+ !!----------------------------------------------------------------------
CHARACTER(LEN=*), INTENT(in) :: cdfile ! file to look at
- INTEGER :: getnvar ! return the number of variables
-
- !! * Local variables
- INTEGER :: ncid
- INTEGER :: istatus
- istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
- istatus=NF90_INQUIRE(ncid,nvariables= getnvar)
- istatus=NF90_CLOSE(ncid)
+ INTEGER(KIND=4) :: incid
+ INTEGER(KIND=4) :: istatus
+ !!----------------------------------------------------------------------
+ istatus = NF90_OPEN (cdfile, NF90_NOWRITE, incid )
+ istatus = NF90_INQUIRE (incid, nvariables = getnvar )
+ istatus = NF90_CLOSE (incid )
END FUNCTION getnvar
+
FUNCTION getipk (cdfile,knvars,cdep)
- !!-----------------------------------------------------------
- !! *** FUNCTION getipk ***
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION getipk ***
!!
- !! ** Purpose : return the number of levels for all the variables
- !! in cdfile. Return 0 if the variable in a vector.
+ !! ** Purpose : Return the number of levels for all the variables
+ !! in cdfile. Return 0 if the variable in 1d.
!!
!! ** Method : returns npk when 4D variables ( x,y,z,t )
!! returns 1 when 3D variables ( x,y, t )
!! returns 0 when other ( vectors )
!!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- CHARACTER(LEN=*), INTENT(in) :: cdfile ! File to look at
- INTEGER, INTENT(in) :: knvars ! Number of variables in cdfile
- CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep ! optional depth dim name
- INTEGER, DIMENSION(knvars) :: getipk ! array (variables ) of levels
-
- !! * local declarations
- INTEGER :: ncid, ipk, jv, iipk
- INTEGER :: istatus
- CHARACTER(LEN=256) :: cldep='dep'
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! File to look at
+ INTEGER(KIND=4), INTENT(in) :: knvars ! Number of variables in cdfile
+ CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep ! optional depth dim name
+ INTEGER(KIND=4), DIMENSION(knvars) :: getipk ! array (variables ) of levels
+ INTEGER(KIND=4) :: incid, ipk, jv, iipk
+ INTEGER(KIND=4) :: istatus
+ CHARACTER(LEN=256) :: cldep='dep'
+ !!----------------------------------------------------------------------
+ istatus=NF90_OPEN(cdfile,NF90_NOWRITE,incid)
- istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
IF ( PRESENT (cdep) ) cldep = cdep
+
! Note the very important TRIM below : if not, getdim crashes as it never find the correct dim !
- iipk = getdim(cdfile,TRIM(cldep),kstatus=istatus)
+ iipk = getdim(cdfile, TRIM(cldep), kstatus=istatus)
+
IF ( istatus /= 0 ) THEN
PRINT *,' getipk : vertical dim not found ...assume 1'
iipk=1
ENDIF
+
DO jv = 1, knvars
- istatus=NF90_INQUIRE_VARIABLE(ncid,jv, ndims=ipk)
+ istatus=NF90_INQUIRE_VARIABLE(incid, jv, ndims=ipk)
IF (ipk == 4 ) THEN
getipk(jv) = iipk
ELSE IF (ipk == 3 ) THEN
@@ -734,150 +769,146 @@ CONTAINS
getipk(jv) = 0
ENDIF
END DO
- istatus=NF90_CLOSE(ncid)
+
+ istatus=NF90_CLOSE(incid)
END FUNCTION getipk
- FUNCTION getvarname (cdfile, knvars, ptypvar)
- !!-----------------------------------------------------------
- !! *** FUNCTION getvarname ***
+
+ FUNCTION getvarname (cdfile, knvars, sdtypvar)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION getvarname ***
!!
!! ** Purpose : return a character array with the knvars variable
- !! name corresponding to cdfile
- !!
- !! ** Method :
+ !! name corresponding to cdfile
!!
- !!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- CHARACTER(LEN=*), INTENT(in) :: cdfile
- INTEGER, INTENT(in) :: knvars ! Number of variables in cdfile
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile
+ INTEGER(KIND=4), INTENT(in) :: knvars ! Number of variables in cdfile
+ TYPE (variable), DIMENSION (knvars) :: sdtypvar ! Retrieve variables attribute
CHARACTER(LEN=256), DIMENSION(knvars) :: getvarname
- TYPE (variable), DIMENSION (knvars) :: ptypvar ! Retrieve variables attribute
- !! * local declarations
- INTEGER :: ncid, jv, ILEN
- INTEGER :: istatus
+ INTEGER(KIND=4) :: incid, jv, ilen
+ INTEGER(KIND=4) :: istatus
+ INTEGER(KIND=4) :: iatt
+ REAL(KIND=4) :: zatt
CHARACTER(LEN=256) :: cldum=''
- REAL(KIND=4) :: zatt
- INTEGER :: iatt
+ !!----------------------------------------------------------------------
+ istatus=NF90_OPEN(cdfile,NF90_NOWRITE,incid)
- istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
DO jv = 1, knvars
- istatus=NF90_INQUIRE_VARIABLE(ncid,jv,name=getvarname(jv) )
- ptypvar(jv)%name=getvarname(jv)
+ istatus=NF90_INQUIRE_VARIABLE(incid, jv, name=getvarname(jv) )
+ sdtypvar(jv)%cname=getvarname(jv)
! look for standard attibutes
- IF ( NF90_INQUIRE_ATTRIBUTE(ncid,jv,'units',len=ILEN) == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,jv,'units',cldum(1:ILEN))
- ptypvar(jv)%units=TRIM(cldum)
- cldum =''
+ IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'units', len=ilen) == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(incid, jv, 'units', cldum(1:ilen))
+ sdtypvar(jv)%cunits = TRIM(cldum)
+ cldum = ''
ELSE
- ptypvar(jv)%units='N/A'
+ sdtypvar(jv)%cunits = 'N/A'
ENDIF
- IF ( NF90_INQUIRE_ATTRIBUTE(ncid,jv,'missing_value') == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,jv,'missing_value',zatt)
- ptypvar(jv)%missing_value=zatt
+ IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'missing_value') == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(incid, jv, 'missing_value', zatt)
+ sdtypvar(jv)%rmissing_value = zatt
ELSE
- ptypvar(jv)%missing_value=0.
+ sdtypvar(jv)%rmissing_value = 0.
ENDIF
- IF ( NF90_INQUIRE_ATTRIBUTE(ncid,jv,'valid_min') == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,jv,'valid_min',zatt)
- ptypvar(jv)%valid_min=zatt
+ IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'valid_min') == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(incid, jv, 'valid_min', zatt)
+ sdtypvar(jv)%valid_min = zatt
ELSE
- ptypvar(jv)%valid_min=0.
+ sdtypvar(jv)%valid_min = 0.
ENDIF
- IF ( NF90_INQUIRE_ATTRIBUTE(ncid,jv,'valid_max') == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,jv,'valid_max',zatt)
- ptypvar(jv)%valid_max=zatt
+ IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'valid_max') == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(incid, jv, 'valid_max', zatt)
+ sdtypvar(jv)%valid_max = zatt
ELSE
- ptypvar(jv)%valid_max=0.
+ sdtypvar(jv)%valid_max = 0.
ENDIF
- IF ( NF90_INQUIRE_ATTRIBUTE(ncid,jv,'iweight') == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,jv,'iweight',iatt)
- ptypvar(jv)%iwght=iatt
+ IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'iweight') == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(incid, jv, 'iweight', iatt)
+ sdtypvar(jv)%iwght = iatt
ELSE
- ptypvar(jv)%iwght=1
+ sdtypvar(jv)%iwght = 1
ENDIF
- IF ( NF90_INQUIRE_ATTRIBUTE(ncid,jv,'long_name',len=ILEN) == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,jv,'long_name',cldum(1:ILEN))
- ptypvar(jv)%long_name=TRIM(cldum)
- cldum=''
+ IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'long_name', len=ilen) == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(incid, jv, 'long_name', cldum(1:ilen))
+ sdtypvar(jv)%clong_name = TRIM(cldum)
+ cldum = ''
ELSE
- ptypvar(jv)%long_name='N/A'
+ sdtypvar(jv)%clong_name = 'N/A'
ENDIF
- IF ( NF90_INQUIRE_ATTRIBUTE(ncid,jv,'short_name',len=ILEN) == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,jv,'short_name',cldum(1:ILEN))
- ptypvar(jv)%short_name=TRIM(cldum)
- cldum=''
+ IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'short_name', len=ilen) == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(incid, jv, 'short_name', cldum(1:ilen))
+ sdtypvar(jv)%cshort_name = TRIM(cldum)
+ cldum = ''
ELSE
- ptypvar(jv)%short_name='N/A'
+ sdtypvar(jv)%cshort_name = 'N/A'
ENDIF
- IF ( NF90_INQUIRE_ATTRIBUTE(ncid,jv,'online_operation',len=ILEN) == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,jv,'online_operation',cldum(1:ILEN))
- ptypvar(jv)%online_operation=TRIM(cldum)
- cldum=''
+ IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'online_operation', len=ilen) == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(incid, jv, 'online_operation', cldum(1:ilen))
+ sdtypvar(jv)%conline_operation = TRIM(cldum)
+ cldum = ''
ELSE
- ptypvar(jv)%online_operation='N/A'
+ sdtypvar(jv)%conline_operation = 'N/A'
ENDIF
- IF ( NF90_INQUIRE_ATTRIBUTE(ncid,jv,'axis',len=ILEN) == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,jv,'axis',cldum(1:ILEN))
- ptypvar(jv)%axis=TRIM(cldum)
- cldum=''
+ IF ( NF90_INQUIRE_ATTRIBUTE(incid, jv, 'axis', len=ilen) == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(incid, jv, 'axis', cldum(1:ilen))
+ sdtypvar(jv)%caxis = TRIM(cldum)
+ cldum = ''
ELSE
- ptypvar(jv)%axis='N/A'
+ sdtypvar(jv)%caxis = 'N/A'
ENDIF
END DO
- istatus=NF90_CLOSE(ncid)
+ istatus=NF90_CLOSE(incid)
END FUNCTION getvarname
- FUNCTION getvar (cdfile,cdvar,klev,kpi,kpj,kimin,kjmin, ktime,ldiom)
- !!-----------------------------------------------------------
- !! *** FUNCTION getvar ***
+
+ FUNCTION getvar (cdfile,cdvar,klev,kpi,kpj,kimin,kjmin, ktime, ldiom)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION getvar ***
!!
!! ** Purpose : Return the 2D REAL variable cvar, from cdfile at level klev.
!! kpi,kpj are the horizontal size of the 2D variable
!!
- !! ** Method :
- !!
- !!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- CHARACTER(LEN=*), INTENT(in) :: cdfile, & ! file name to work with
- & cdvar ! variable name to work with
- INTEGER, INTENT(in) :: kpi,kpj ! horizontal size of the 2D variable
- INTEGER, OPTIONAL, INTENT(in) :: klev ! Optional variable. If missing 1 is assumed
- INTEGER, OPTIONAL, INTENT(in) :: kimin,kjmin ! Optional variable. If missing 1 is assumed
- INTEGER, OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed
- LOGICAL, OPTIONAL, INTENT(in) :: ldiom ! Optional variable. If missing false is assumed
- REAL(KIND=4), DIMENSION(kpi,kpj) :: getvar ! 2D REAL 4 holding variable field at klev
-
- !! * Local variables
- INTEGER, DIMENSION(4) :: istart, icount, nldim
- INTEGER :: ncid, id_var, id_dimunlim, nbdim
- INTEGER :: istatus, ilev, imin, jmin, itime, ilog, ipiglo, imax
- INTEGER, SAVE :: ii, ij, ik0, ji, jj, ik1, ik
- LOGICAL :: lliom=.false., llperio=.false.
- CHARACTER(LEN=256) :: clvar
-
- LOGICAL :: llog=.FALSE. , lsf=.FALSE. , lao=.FALSE.
- REAL(KIND=4) :: sf=1., ao=0. !: Scale factor and add_offset
- REAL(KIND=4) :: spval !: missing value
+ !! ** Method : Initially a quite straigth forward function. But with the
+ !! NEMO variation about the e3t in partial steps, I try to adapt
+ !! the code to all existing mesh_zgr format, which reduces the
+ !! readibility of the code. One my think of specific routine for
+ !! getvar (e3._ps ...)
+ !!
+ !!---------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with
+ CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: klev ! Optional variable. If missing 1 is assumed
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! horizontal size of the 2D variable
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kimin, kjmin ! Optional variable. If missing 1 is assumed
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed
+ LOGICAL, OPTIONAL, INTENT(in) :: ldiom ! Optional variable. If missing false is assumed
+ REAL(KIND=4), DIMENSION(kpi,kpj) :: getvar ! 2D REAL 4 holding variable field at klev
+
+ INTEGER(KIND=4), DIMENSION(4) :: istart, icount, inldim
+ INTEGER(KIND=4) :: incid, id_var, id_dimunlim, inbdim
+ INTEGER(KIND=4) :: istatus, ilev, imin, jmin
+ INTEGER(KIND=4) :: itime, ilog, ipiglo, imax
+ INTEGER(KIND=4), SAVE :: ii, ij, ik0, ji, jj, ik1, ik
+ REAL(KIND=4) :: sf=1., ao=0. !: Scale factor and add_offset
+ REAL(KIND=4) :: spval !: missing value
REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: zend, zstart
-
+ CHARACTER(LEN=256) :: clvar
+ LOGICAL :: lliom=.false., llperio=.false.
+ LOGICAL :: llog=.FALSE. , lsf=.FALSE. , lao=.FALSE.
+ !!---------------------------------------------------------------------
llperio=.false.
IF (PRESENT(klev) ) THEN
ilev=klev
@@ -887,8 +918,8 @@ CONTAINS
IF (PRESENT(kimin) ) THEN
imin=kimin
- ! next line in problem when x_a is before x in the mesh files ...
- ipiglo=getdim(cdfile,'x',ldexact=.true.)
+
+ ipiglo=getdim(cdfile,'x', ldexact=.true.)
IF (imin+kpi-1 > ipiglo ) THEN
llperio=.true.
imax=kpi+1 +imin -ipiglo
@@ -918,59 +949,61 @@ CONTAINS
clvar=cdvar
! Must reset the flags to false for every call to getvar
- llog=.FALSE.
- lsf=.FALSE.
- lao=.FALSE.
+ llog = .FALSE.
+ lsf = .FALSE.
+ lao = .FALSE.
+
+ CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,incid) )
- CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,ncid) )
IF ( lliom) THEN ! try to detect if input file is a zgr IOM file, looking for e3t_0
- istatus=NF90_INQ_VARID( ncid,'e3t_0', id_var)
+ istatus=NF90_INQ_VARID( incid,'e3t_0', id_var)
IF ( istatus == NF90_NOERR ) THEN
! iom file , change names
! now try to detect if it is v2 or v3, in v3, e3t_ps exist and is a 2d variable
- istatus=NF90_INQ_VARID( ncid,'e3t_ps', id_var)
+ istatus=NF90_INQ_VARID( incid,'e3t_ps', id_var)
IF ( istatus == NF90_NOERR ) THEN
! case of NEMO_v3 zfr files
! look for mbathy and out it in memory, once for all
IF ( .NOT. l_mbathy ) THEN
PRINT *,'MESH_ZGR V3 detected'
l_mbathy=.true.
- istatus=NF90_INQ_DIMID(ncid,'x',id_var) ; istatus=NF90_INQUIRE_DIMENSION(ncid,id_var,len=ii)
- istatus=NF90_INQ_DIMID(ncid,'y',id_var) ; istatus=NF90_INQUIRE_DIMENSION(ncid,id_var,len=ij)
- istatus=NF90_INQ_DIMID(ncid,'z',id_var) ; istatus=NF90_INQUIRE_DIMENSION(ncid,id_var,len=ik0)
+ istatus=NF90_INQ_DIMID(incid,'x',id_var) ; istatus=NF90_INQUIRE_DIMENSION(incid,id_var, len=ii )
+ istatus=NF90_INQ_DIMID(incid,'y',id_var) ; istatus=NF90_INQUIRE_DIMENSION(incid,id_var, len=ij )
+ istatus=NF90_INQ_DIMID(incid,'z',id_var) ; istatus=NF90_INQUIRE_DIMENSION(incid,id_var, len=ik0)
+
ALLOCATE( mbathy(ii,ij)) ! mbathy is allocated on the whole domain
ALLOCATE( e3t_ps(ii,ij),e3w_ps(ii,ij)) ! e3._ps are allocated on the whole domain
- ALLOCATE( e3t_0(ik0), e3w_0(ik0) ) ! whole depth
+ ALLOCATE( e3t_0(ik0), e3w_0(ik0) ) ! whole depth
- istatus=NF90_INQ_VARID (ncid,'mbathy', id_var)
+ istatus=NF90_INQ_VARID (incid,'mbathy', id_var)
IF ( istatus /= NF90_NOERR ) THEN
PRINT *, 'Problem reading mesh_zgr.nc v3 : no mbathy found !' ; STOP
ENDIF
- istatus=NF90_GET_VAR(ncid,id_var,mbathy, start=(/1,1,1/), count=(/ii,ij,1/) )
+ istatus=NF90_GET_VAR(incid,id_var, mbathy, start=(/1,1,1/), count=(/ii,ij,1/) )
!
- istatus=NF90_INQ_VARID (ncid,'e3t_ps', id_var)
+ istatus=NF90_INQ_VARID (incid,'e3t_ps', id_var)
IF ( istatus /= NF90_NOERR ) THEN
PRINT *, 'Problem reading mesh_zgr.nc v3 : no e3t_ps found !' ; STOP
ENDIF
- istatus=NF90_GET_VAR(ncid,id_var,e3t_ps, start=(/1,1,1/), count=(/ii,ij,1/) )
+ istatus=NF90_GET_VAR(incid,id_var,e3t_ps, start=(/1,1,1/), count=(/ii,ij,1/) )
!
- istatus=NF90_INQ_VARID (ncid,'e3w_ps', id_var)
+ istatus=NF90_INQ_VARID (incid,'e3w_ps', id_var)
IF ( istatus /= NF90_NOERR ) THEN
PRINT *, 'Problem reading mesh_zgr.nc v3 : no e3w_ps found !' ; STOP
ENDIF
- istatus=NF90_GET_VAR(ncid,id_var,e3w_ps, start=(/1,1,1/), count=(/ii,ij,1/) )
+ istatus=NF90_GET_VAR(incid,id_var,e3w_ps, start=(/1,1,1/), count=(/ii,ij,1/) )
!
- istatus=NF90_INQ_VARID (ncid,'e3t_0', id_var)
+ istatus=NF90_INQ_VARID (incid,'e3t_0', id_var)
IF ( istatus /= NF90_NOERR ) THEN
PRINT *, 'Problem reading mesh_zgr.nc v3 : no e3t_0 found !' ; STOP
ENDIF
- istatus=NF90_GET_VAR(ncid,id_var,e3t_0, start=(/1,1/), count=(/ik0,1/) )
+ istatus=NF90_GET_VAR(incid,id_var,e3t_0, start=(/1,1/), count=(/ik0,1/) )
!
- istatus=NF90_INQ_VARID (ncid,'e3w_0', id_var)
+ istatus=NF90_INQ_VARID (incid,'e3w_0', id_var)
IF ( istatus /= NF90_NOERR ) THEN
PRINT *, 'Problem reading mesh_zgr.nc v3 : no e3w_0 found !' ; STOP
ENDIF
- istatus=NF90_GET_VAR(ncid,id_var,e3w_0, start=(/1,1/), count=(/ik0,1/) )
+ istatus=NF90_GET_VAR(incid,id_var,e3w_0, start=(/1,1/), count=(/ik0,1/) )
DO ji=1,ii
DO jj=1,ij
IF ( e3t_ps (ji,jj) == 0 ) e3t_ps(ji,jj)=e3t_0(mbathy(ji,jj))
@@ -995,16 +1028,16 @@ CONTAINS
ENDIF
ENDIF
- istatus=NF90_INQUIRE(ncid,unlimitedDimId=id_dimunlim)
- CALL ERR_HDL(NF90_INQ_VARID ( ncid,clvar,id_var))
+ istatus=NF90_INQUIRE(incid, unlimitedDimId=id_dimunlim)
+ CALL ERR_HDL(NF90_INQ_VARID ( incid,clvar,id_var))
! look for time dim in variable
- nldim=0
- istatus=NF90_INQUIRE_VARIABLE(ncid, id_var,ndims=nbdim,dimids=nldim(:) )
+ inldim=0
+ istatus=NF90_INQUIRE_VARIABLE(incid, id_var, ndims=inbdim,dimids=inldim(:) )
istart(1) = imin
istart(2) = jmin
! JMM ! it workd for X Y Z T file, not for X Y T .... try to found a fix !
- IF ( nldim(3) == id_dimunlim ) THEN
+ IF ( inldim(3) == id_dimunlim ) THEN
istart(3) = itime
istart(4) = 1
ELSE
@@ -1017,32 +1050,32 @@ CONTAINS
icount(3)=1
icount(4)=1
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'missing_value')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'missing_value')
IF (istatus == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,id_var,'missing_value',spval)
+ istatus=NF90_GET_ATT(incid,id_var,'missing_value',spval)
ELSE
! assume spval is 0 ?
spval = 0.
ENDIF
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'savelog10')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'savelog10')
IF (istatus == NF90_NOERR ) THEN
! there is a scale factor for this variable
- istatus=NF90_GET_ATT(ncid,id_var,'savelog10',ilog)
+ istatus=NF90_GET_ATT(incid,id_var,'savelog10',ilog)
IF ( ilog /= 0 ) llog=.TRUE.
ENDIF
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'scale_factor')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'scale_factor')
IF (istatus == NF90_NOERR ) THEN
! there is a scale factor for this variable
- istatus=NF90_GET_ATT(ncid,id_var,'scale_factor',sf)
+ istatus=NF90_GET_ATT(incid,id_var,'scale_factor',sf)
IF ( sf /= 1. ) lsf=.TRUE.
ENDIF
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'add_offset')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'add_offset')
IF (istatus == NF90_NOERR ) THEN
! there is a scale factor for this variable
- istatus=NF90_GET_ATT(ncid,id_var,'add_offset',ao)
+ istatus=NF90_GET_ATT(incid,id_var,'add_offset', ao)
IF ( ao /= 0.) lao=.TRUE.
ENDIF
@@ -1123,8 +1156,8 @@ CONTAINS
END SELECT
ELSE
- istatus=NF90_GET_VAR(ncid,id_var,zend, start=(/imin,jmin,ilev,itime/),count=(/ipiglo-imin,kpj,1,1/))
- istatus=NF90_GET_VAR(ncid,id_var,zstart, start=(/2,jmin,ilev,itime/),count=(/imax-1,kpj,1,1/))
+ istatus=NF90_GET_VAR(incid,id_var,zend, start=(/imin,jmin,ilev,itime/),count=(/ipiglo-imin,kpj,1,1/))
+ istatus=NF90_GET_VAR(incid,id_var,zstart, start=(/2,jmin,ilev,itime/),count=(/imax-1,kpj,1,1/))
getvar(1:ipiglo-imin,:)=zend
getvar(ipiglo-imin+1:kpi,:)=zstart
ENDIF
@@ -1179,7 +1212,7 @@ CONTAINS
END SELECT
ELSE
- istatus=NF90_GET_VAR(ncid,id_var,getvar, start=istart,count=icount)
+ istatus=NF90_GET_VAR(incid,id_var,getvar, start=istart,count=icount)
ENDIF
ENDIF
IF ( istatus /= 0 ) THEN
@@ -1193,40 +1226,36 @@ CONTAINS
IF (lao ) WHERE (getvar /= spval ) getvar=getvar + ao
IF (llog) WHERE (getvar /= spval ) getvar=10**getvar
- istatus=NF90_CLOSE(ncid)
+ istatus=NF90_CLOSE(incid)
END FUNCTION getvar
- FUNCTION getvarxz (cdfile,cdvar,kj,kpi,kpz,kimin,kkmin,ktime)
- !!-----------------------------------------------------------
- !! *** FUNCTION getvar ***
+
+ FUNCTION getvarxz (cdfile, cdvar, kj, kpi, kpz, kimin, kkmin, ktime)
+ !!-------------------------------------------------------------------------
+ !! *** FUNCTION getvar ***
!!
!! ** Purpose : Return the 2D REAL variable x-z slab cvar, from cdfile at j=kj
!! kpi,kpz are the size of the 2D variable
!!
- !! ** Method :
- !!
- !! history:
- !! 03/03/2006 : Jean-Marc Molines : Original code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- CHARACTER(LEN=*), INTENT(in) :: cdfile, & ! file name to work with
- & cdvar ! variable name to work with
- INTEGER, INTENT(in) :: kpi,kpz ! size of the 2D variable
- INTEGER, INTENT(in) :: kj ! Optional variable. If missing 1 is assumed
- INTEGER, OPTIONAL, INTENT(in) :: kimin,kkmin ! Optional variable. If missing 1 is assumed
- INTEGER, OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed
- REAL(KIND=4), DIMENSION(kpi,kpz) :: getvarxz ! 2D REAL 4 holding variable x-z slab at kj
-
- !! * Local variables
- INTEGER, DIMENSION(4) :: istart, icount
- INTEGER :: ncid, id_var
- INTEGER :: istatus, ilev, imin, kmin, itime, ilog
-
- LOGICAL :: llog=.FALSE. , lsf=.FALSE. , lao=.FALSE.
- REAL(KIND=4) :: sf=1., ao=0. !: Scale factor and add_offset
- REAL(KIND=4) :: spval !: Missing values
- INTEGER :: idum
+ !!-------------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with
+ CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with
+ INTEGER(KIND=4), INTENT(in) :: kj ! Optional variable. If missing 1 is assumed
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpz ! size of the 2D variable
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kimin, kkmin ! Optional variable. If missing 1 is assumed
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed
+ REAL(KIND=4), DIMENSION(kpi,kpz) :: getvarxz ! 2D REAL 4 holding variable x-z slab at kj
+
+ INTEGER(KIND=4), DIMENSION(4) :: istart, icount
+ INTEGER(KIND=4) :: incid, id_var
+ INTEGER(KIND=4) :: istatus, ilev, imin, kmin
+ INTEGER(KIND=4) :: itime, ilog
+ INTEGER(KIND=4) :: idum
+ REAL(KIND=4) :: sf=1., ao=0. ! Scale factor and add_offset
+ REAL(KIND=4) :: spval ! Missing values
+ LOGICAL :: llog=.FALSE. , lsf=.FALSE. , lao=.FALSE.
+ !!-------------------------------------------------------------------------
IF (PRESENT(kimin) ) THEN
imin=kimin
@@ -1252,40 +1281,40 @@ CONTAINS
lao=.FALSE.
- CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,ncid) )
- CALL ERR_HDL(NF90_INQ_VARID ( ncid,cdvar,id_var))
+ CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,incid) )
+ CALL ERR_HDL(NF90_INQ_VARID ( incid,cdvar,id_var))
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'missing_value')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'missing_value')
IF (istatus == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,id_var,'missing_value',spval)
+ istatus=NF90_GET_ATT(incid,id_var,'missing_value',spval)
ELSE
! assume spval is 0 ?
spval = 0.
ENDIF
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'savelog10')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'savelog10')
IF (istatus == NF90_NOERR ) THEN
! there is a scale factor for this variable
- istatus=NF90_GET_ATT(ncid,id_var,'savelog10',ilog)
+ istatus=NF90_GET_ATT(incid,id_var,'savelog10',ilog)
IF ( ilog /= 0 ) llog=.TRUE.
ENDIF
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'scale_factor')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'scale_factor')
IF (istatus == NF90_NOERR ) THEN
! there is a scale factor for this variable
- istatus=NF90_GET_ATT(ncid,id_var,'scale_factor',sf)
+ istatus=NF90_GET_ATT(incid,id_var,'scale_factor',sf)
IF ( sf /= 1. ) lsf=.TRUE.
ENDIF
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'add_offset')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'add_offset')
IF (istatus == NF90_NOERR ) THEN
! there is a scale factor for this variable
- istatus=NF90_GET_ATT(ncid,id_var,'add_offset',ao)
+ istatus=NF90_GET_ATT(incid,id_var,'add_offset',ao)
IF ( ao /= 0.) lao=.TRUE.
ENDIF
! detect if there is a y dimension in cdfile
- istatus=NF90_INQ_DIMID(ncid,'y',idum)
+ istatus=NF90_INQ_DIMID(incid,'y',idum)
IF ( istatus == NF90_NOERR ) THEN ! the file has a 'y' dimension
istart=(/imin,kj,kmin,itime/)
! JMM ! it workd for X Y Z T file, not for X Y T .... try to found a fix !
@@ -1295,7 +1324,7 @@ CONTAINS
icount=(/kpi,kpz,1,1/)
ENDIF
- istatus=NF90_GET_VAR(ncid,id_var,getvarxz, start=istart,count=icount)
+ istatus=NF90_GET_VAR(incid,id_var,getvarxz, start=istart,count=icount)
IF ( istatus /= 0 ) THEN
PRINT *,' Problem in getvarxz for ', TRIM(cdvar)
CALL ERR_HDL(istatus)
@@ -1307,40 +1336,37 @@ CONTAINS
IF (lao ) WHERE (getvarxz /= spval ) getvarxz=getvarxz + ao
IF (llog) WHERE (getvarxz /= spval ) getvarxz=10**getvarxz
- istatus=NF90_CLOSE(ncid)
+ istatus=NF90_CLOSE(incid)
END FUNCTION getvarxz
- FUNCTION getvaryz (cdfile,cdvar,ki,kpj,kpz,kjmin,kkmin,ktime)
- !!-----------------------------------------------------------
- !! *** FUNCTION getvar ***
+
+ FUNCTION getvaryz (cdfile, cdvar, ki, kpj, kpz, kjmin, kkmin, ktime)
+ !!-------------------------------------------------------------------------
+ !! *** FUNCTION getvar ***
!!
!! ** Purpose : Return the 2D REAL variable y-z slab cvar, from cdfile at i=ki
!! kpj,kpz are the size of the 2D variable
!!
- !! ** Method :
- !!
- !! history:
- !! 03/03/2006 : Jean-Marc Molines : Original code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- CHARACTER(LEN=*), INTENT(in) :: cdfile, & ! file name to work with
- & cdvar ! variable name to work with
- INTEGER, INTENT(in) :: kpj,kpz ! size of the 2D variable
- INTEGER, INTENT(in) :: ki !
- INTEGER, OPTIONAL, INTENT(in) :: kjmin,kkmin ! Optional variable. If missing 1 is assumed
- INTEGER, OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed
- REAL(KIND=4), DIMENSION(kpj,kpz) :: getvaryz ! 2D REAL 4 holding variable x-z slab at kj
-
- !! * Local variables
- INTEGER, DIMENSION(4) :: istart, icount
- INTEGER :: ncid, id_var
- INTEGER :: istatus, ilev, jmin, kmin, itime, ilog
-
- LOGICAL :: llog=.FALSE. , lsf=.FALSE. , lao=.FALSE.
- REAL(KIND=4) :: sf=1., ao=0. !: Scale factor and add_offset
- REAL(KIND=4) :: spval !: Missing values
- INTEGER :: idum
+ !!-------------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with
+ CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with
+ INTEGER(KIND=4), INTENT(in) :: ki !
+ INTEGER(KIND=4), INTENT(in) :: kpj,kpz ! size of the 2D variable
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kjmin, kkmin ! Optional variable. If missing 1 is assumed
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed
+ REAL(KIND=4), DIMENSION(kpj,kpz) :: getvaryz ! 2D REAL 4 holding variable x-z slab at kj
+
+ INTEGER(KIND=4), DIMENSION(4) :: istart, icount
+ INTEGER(KIND=4) :: incid, id_var
+ INTEGER(KIND=4) :: istatus, ilev, jmin, kmin
+ INTEGER(KIND=4) :: itime, ilog
+ INTEGER(KIND=4) :: idum
+
+ REAL(KIND=4) :: sf=1., ao=0. ! Scale factor and add_offset
+ REAL(KIND=4) :: spval ! Missing values
+ LOGICAL :: llog=.FALSE. , lsf=.FALSE. , lao=.FALSE.
+ !!-------------------------------------------------------------------------
IF (PRESENT(kjmin) ) THEN
jmin=kjmin
@@ -1366,40 +1392,40 @@ CONTAINS
lao=.FALSE.
- CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,ncid) )
- CALL ERR_HDL(NF90_INQ_VARID ( ncid,cdvar,id_var))
+ CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,incid) )
+ CALL ERR_HDL(NF90_INQ_VARID ( incid,cdvar,id_var))
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'missing_value')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'missing_value')
IF (istatus == NF90_NOERR ) THEN
- istatus=NF90_GET_ATT(ncid,id_var,'missing_value',spval)
+ istatus=NF90_GET_ATT(incid,id_var,'missing_value',spval)
ELSE
! assume spval is 0 ?
spval = 0.
ENDIF
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'savelog10')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'savelog10')
IF (istatus == NF90_NOERR ) THEN
! there is a scale factor for this variable
- istatus=NF90_GET_ATT(ncid,id_var,'savelog10',ilog)
+ istatus=NF90_GET_ATT(incid,id_var,'savelog10',ilog)
IF ( ilog /= 0 ) llog=.TRUE.
ENDIF
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'scale_factor')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'scale_factor')
IF (istatus == NF90_NOERR ) THEN
! there is a scale factor for this variable
- istatus=NF90_GET_ATT(ncid,id_var,'scale_factor',sf)
+ istatus=NF90_GET_ATT(incid,id_var,'scale_factor',sf)
IF ( sf /= 1. ) lsf=.TRUE.
ENDIF
- istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'add_offset')
+ istatus=NF90_INQUIRE_ATTRIBUTE(incid,id_var,'add_offset')
IF (istatus == NF90_NOERR ) THEN
! there is a scale factor for this variable
- istatus=NF90_GET_ATT(ncid,id_var,'add_offset',ao)
+ istatus=NF90_GET_ATT(incid,id_var,'add_offset', ao)
IF ( ao /= 0.) lao=.TRUE.
ENDIF
! detect if there is a x dimension in cdfile
- istatus=NF90_INQ_DIMID(ncid,'x',idum)
+ istatus=NF90_INQ_DIMID(incid,'x',idum)
IF ( istatus == NF90_NOERR ) THEN ! the file has a 'x' dimension
istart=(/ki,jmin,kmin,itime/)
! JMM ! it workd for X Y Z T file, not for X Y T .... try to found a fix !
@@ -1409,7 +1435,7 @@ CONTAINS
icount=(/kpj,kpz,1,1/)
ENDIF
- istatus=NF90_GET_VAR(ncid,id_var,getvaryz, start=istart,count=icount)
+ istatus=NF90_GET_VAR(incid,id_var,getvaryz, start=istart,count=icount)
IF ( istatus /= 0 ) THEN
PRINT *,' Problem in getvaryz for ', TRIM(cdvar)
CALL ERR_HDL(istatus)
@@ -1421,89 +1447,77 @@ CONTAINS
IF (lao ) WHERE (getvaryz /= spval ) getvaryz=getvaryz + ao
IF (llog) WHERE (getvaryz /= spval ) getvaryz=10**getvaryz
- istatus=NF90_CLOSE(ncid)
+ istatus=NF90_CLOSE(incid)
END FUNCTION getvaryz
- FUNCTION getvar1d (cdfile,cdvar,kk,kstatus)
- !!-----------------------------------------------------------
- !! *** FUNCTION getvar1d ***
+
+ FUNCTION getvar1d (cdfile, cdvar, kk, kstatus)
+ !!-------------------------------------------------------------------------
+ !! *** FUNCTION getvar1d ***
!!
!! ** Purpose : return 1D variable cdvar from cdfile, of size kk
!!
- !! ** Method :
- !!
- !!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- CHARACTER(LEN=*), INTENT(in) :: cdfile, & ! file name to work with
- & cdvar ! variable name to work with
- INTEGER, INTENT(in) :: kk ! size of 1D vector to be returned
- INTEGER, OPTIONAL, INTENT(out) :: kstatus ! return status concerning the variable existence
- REAL(KIND=4), DIMENSION(kk) :: getvar1d ! real returned vector
-
- !! * Local variables
- INTEGER, DIMENSION(1) :: istart, icount
- INTEGER :: ncid, id_var
- INTEGER :: istatus
-
+ !!-------------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with
+ CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with
+ INTEGER(KIND=4), INTENT(in) :: kk ! size of 1D vector to be returned
+ INTEGER(KIND=4), OPTIONAL, INTENT(out) :: kstatus ! return status concerning the variable existence
+ REAL(KIND=4), DIMENSION(kk) :: getvar1d ! real returned vector
+
+ INTEGER(KIND=4), DIMENSION(1) :: istart, icount
+ INTEGER(KIND=4) :: incid, id_var
+ INTEGER(KIND=4) :: istatus
+ !!-------------------------------------------------------------------------
istart(:) = 1
icount(1)=kk
IF ( PRESENT(kstatus) ) kstatus = 0
- istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
- istatus=NF90_INQ_VARID ( ncid,cdvar,id_var)
+ istatus=NF90_OPEN(cdfile,NF90_NOWRITE,incid)
+ istatus=NF90_INQ_VARID ( incid,cdvar,id_var)
IF ( istatus == NF90_NOERR ) THEN
- istatus=NF90_GET_VAR(ncid,id_var,getvar1d,start=istart,count=icount)
+ istatus=NF90_GET_VAR(incid,id_var,getvar1d,start=istart,count=icount)
ELSE
IF ( PRESENT(kstatus) ) kstatus= istatus
getvar1d=99999999999.
ENDIF
- istatus=NF90_CLOSE(ncid)
+ istatus=NF90_CLOSE(incid)
END FUNCTION getvar1d
+
FUNCTION getvare3 (cdfile,cdvar,kk)
- !!-----------------------------------------------------------
- !! *** FUNCTION getvare3 ***
+ !!-------------------------------------------------------------------------
+ !! *** FUNCTION getvare3 ***
!!
!! ** Purpose : Special routine for e3, which in fact is a 1D variable
!! but defined as e3 (1,1,npk,1) in coordinates.nc (!!)
!!
- !! ** Method :
- !!
- !!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- CHARACTER(LEN=*), INTENT(in) :: cdfile, & ! file name to work with
- & cdvar ! variable name to work with
- INTEGER, INTENT(in) :: kk ! size of 1D vector to be returned
- REAL(KIND=4), DIMENSION(kk) :: getvare3 ! return e3 variable form the coordinate file
-
- !! * Local variables
- INTEGER, DIMENSION(4) :: istart, icount
- INTEGER :: ncid, id_var
- INTEGER :: istatus
- CHARACTER(LEN=256) :: clvar ! local name for cdf var (modified)
-
+ !!-------------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with
+ CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with
+ INTEGER(KIND=4), INTENT(in) :: kk ! size of 1D vector to be returned
+ REAL(KIND=4), DIMENSION(kk) :: getvare3 ! return e3 variable form the coordinate file
+
+ INTEGER(KIND=4), DIMENSION(4) :: istart, icount
+ INTEGER(KIND=4) :: incid, id_var
+ INTEGER(KIND=4) :: istatus
+ CHARACTER(LEN=256) :: clvar ! local name for cdf var (modified)
+ !!-------------------------------------------------------------------------
istart(:) = 1
icount(:) = 1
icount(3)=kk
clvar=cdvar
- istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
+ istatus=NF90_OPEN(cdfile,NF90_NOWRITE,incid)
! check for IOM style mesh_zgr or coordinates :
! IOIPSL (x_a=y_a=1) IOM
! gdept(time,z,y_a,x_a) gdept_0(t,z)
! gdepw(time,z,y_a,x_a) gdepw_0(t,z)
! e3t(time,z,y_a,x_a) e3t_0(t,z)
! e3w(time,z,y_a,x_a) e3w_0(t,z)
- istatus=NF90_INQ_VARID ( ncid,'e3t_0',id_var)
+ istatus=NF90_INQ_VARID ( incid,'e3t_0',id_var)
IF ( istatus == NF90_NOERR) THEN
icount(1)=kk ; icount(3)=1
SELECT CASE (clvar)
@@ -1518,8 +1532,8 @@ CONTAINS
END SELECT
ENDIF
- istatus=NF90_INQ_VARID ( ncid,clvar,id_var)
- istatus=NF90_GET_VAR(ncid,id_var,getvare3,start=istart,count=icount)
+ istatus=NF90_INQ_VARID ( incid,clvar,id_var)
+ istatus=NF90_GET_VAR(incid,id_var,getvare3,start=istart,count=icount)
IF ( istatus /= 0 ) THEN
PRINT *,' Problem in getvare3 for ', TRIM(cdvar)
PRINT *,TRIM(cdfile), kk
@@ -1527,54 +1541,54 @@ CONTAINS
STOP
ENDIF
- istatus=NF90_CLOSE(ncid)
+ istatus=NF90_CLOSE(incid)
+
END FUNCTION getvare3
- FUNCTION putheadervar(kout, cdfile, kpi,kpj,kpk, pnavlon, pnavlat ,pdep,cdep)
- !!-----------------------------------------------------------
- !! *** FUNCTION putheadervar ***
+ INTEGER(KIND=4) FUNCTION putheadervar(kout, cdfile, kpi, kpj, kpk, pnavlon, pnavlat , pdep, cdep)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION putheadervar ***
!!
!! ** Purpose : copy header variables from cdfile to the already open ncfile (ncid=kout)
!!
!! ** Method : header variables are nav_lat, nav_lon and either (deptht, depthu, or depthv )
- !! Even if the use of different variable name for deptht, depthu depthv is
+ !! Even if the use of different variable name for deptht, depthu depthv is
!! one of the many non sense of IOIPSL, we are forced to stick with !
!! (Note that these 3 depth are identical in OPA. On the other hand, nav_lon, nav_lat
- !! differ for U and V and T points but have the same variable name).
+ !! differ for U and V and T points but have the same variable name).
!! If pnavlon and pnavlat are provided as arguments, they are used for nav_lon, nav_lat
!! instead of the nav_lon,nav_lat read on the file cdfile.
- !!
+ !!
!! ** Action : header variables for file kout is copied from cdfile
!!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- INTEGER, INTENT(in) :: kout ! ncid of the outputfile (already open )
- CHARACTER(LEN=*), INTENT(in) :: cdfile ! file from where the headers will be copied
- INTEGER, INTENT(in) :: kpi,kpj,kpk ! dimension of nav_lon,nav_lat (kpi,kpj), and depht(kpk)
- REAL(KIND=4), OPTIONAL, DIMENSION(kpi,kpj), INTENT(in) :: pnavlon, pnavlat ! array provided optionaly to overrid the
- ! ! corresponding arrays in cdfile
- REAL(KIND=4), OPTIONAL,DIMENSION(kpk), INTENT(in) :: pdep ! dep array if not on cdfile
- CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep ! optional name of vertical variable
- INTEGER :: putheadervar ! return status
-
- !! * Local variables
- INTEGER , PARAMETER :: jpdep=6
- INTEGER :: istatus, idep, jj
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kout ! ncid of the outputfile (already open )
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! file from where the headers will be copied
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of nav_lon (kpi,kpj)
+ INTEGER(KIND=4), INTENT(in) :: kpk ! dimension of depht(kpk)
+ REAL(KIND=4), OPTIONAL, DIMENSION(kpi,kpj), INTENT(in) :: pnavlon ! array provided optionaly to overrid the
+ REAL(KIND=4), OPTIONAL, DIMENSION(kpi,kpj), INTENT(in) :: pnavlat ! corresponding arrays in cdfile
+ REAL(KIND=4), OPTIONAL, DIMENSION(kpk), INTENT(in) :: pdep ! dep array if not on cdfile
+ CHARACTER(LEN=*), OPTIONAL, INTENT(in) :: cdep ! optional name of vertical variable
+
+ INTEGER(KIND=4), PARAMETER :: jpdep=6
+ INTEGER(KIND=4) :: istatus, idep, jj
REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: z2d
- REAL(KIND=4), DIMENSION(kpk) :: z1d
- CHARACTER(LEN=256),DIMENSION(jpdep ) :: cldept=(/'deptht ','depthu ','depthv ','depthw ','nav_lev','z '/)
- CHARACTER(LEN=256) :: cldep
+ REAL(KIND=4), DIMENSION(kpk) :: z1d
+ CHARACTER(LEN=256), DIMENSION(jpdep ) :: cldept= (/'deptht ','depthu ','depthv ','depthw ','nav_lev','z '/)
+! CHARACTER(LEN=256), DIMENSION(jpdep ) :: cldept=(/'deptht','depthu','depthv','depthw','nav_lev','z'/)
+ CHARACTER(LEN=256) :: cldep
+ !!----------------------------------------------------------------------
ALLOCATE ( z2d (kpi,kpj) )
+
IF (PRESENT(pnavlon) ) THEN
z2d = pnavlon
ELSE
z2d=getvar(cdfile,'nav_lon', 1,kpi,kpj)
ENDIF
- istatus = putvar(kout,id_lon,z2d,1,kpi,kpj)
+ istatus = putvar(kout, nid_lon,z2d,1,kpi,kpj)
IF (PRESENT(pnavlat) ) THEN
z2d = pnavlat
@@ -1582,7 +1596,7 @@ CONTAINS
z2d=getvar(cdfile,'nav_lat', 1,kpi,kpj)
ENDIF
- istatus = putvar(kout,id_lat,z2d,1,kpi,kpj)
+ istatus = putvar(kout, nid_lat,z2d,1,kpi,kpj)
IF (kpk /= 0 ) THEN
IF (PRESENT(pdep) ) THEN
@@ -1609,192 +1623,228 @@ CONTAINS
istatus = putvar1d(kout,z1d,kpk,'D')
ENDIF
+
putheadervar=istatus
+
DEALLOCATE (z2d)
END FUNCTION putheadervar
- FUNCTION putvarr8(kout, kid,ptab, klev, kpi, kpj,ktime, kwght)
- !!-----------------------------------------------------------
- !! *** FUNCTION putvar ***
- !!
- !! ** Purpose : copy a 2D level of ptab in already open file kout, using variable kid
- !!
- !! ** Method :
- !!
- !! ** Action : variable level written
- !!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- INTEGER, INTENT(in) :: kout , & ! ncid of output file
- & kid ! varid of output variable
- INTEGER, INTENT(in) :: klev ! level at which ptab will be written
- INTEGER, INTENT(in) :: kpi,kpj ! dimension of ptab
- INTEGER, OPTIONAL, INTENT(in) :: ktime ! dimension of ptab
- INTEGER, OPTIONAL, INTENT(in) :: kwght ! weight of this variable
- REAL(KIND=8), DIMENSION(kpi,kpj),INTENT(in) :: ptab ! 2D array to write in file
- INTEGER :: putvarr8 ! return status
-
- !! * Local variables
- INTEGER :: istatus, itime, id_dimunlim
- INTEGER, DIMENSION(4) :: istart, icount, nldim
+ INTEGER(KIND=4) FUNCTION putvarr8(kout, kid, ptab, klev, kpi, kpj, ktime, kwght)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION putvarr8 ***
+ !!
+ !! ** Purpose : copy a 2D level of ptab in already open file kout,
+ !! using variable kid
+ !!
+ !! ** Method : this corresponds to the generic function putvar with r8 arg.
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file
+ INTEGER(KIND=4), INTENT(in) :: kid ! varid of output variable
+ REAL(KIND=8), DIMENSION(kpi,kpj), INTENT(in) :: ptab ! 2D array to write in file
+ INTEGER(KIND=4), INTENT(in) :: klev ! level at which ptab will be written
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of ptab
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! dimension of ptab
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kwght ! weight of this variable
+
+ INTEGER(KIND=4) :: istatus, itime, id_dimunlim
+ INTEGER(KIND=4), DIMENSION(4) :: istart, icount, inldim
+ !!----------------------------------------------------------------------
IF (PRESENT(ktime) ) THEN
itime=ktime
ELSE
itime=1
ENDIF
- istatus=NF90_INQUIRE(kout,unlimitedDimId=id_dimunlim)
- nldim=0
+
+ ! Look for a unlimited dimension
+ istatus=NF90_INQUIRE(kout, unlimitedDimId = id_dimunlim)
+ inldim(:) = 0
istart(:) = 1
- istatus=NF90_INQUIRE_VARIABLE(kout, kid,dimids=nldim(:) )
- IF ( nldim(3) == id_dimunlim) THEN
+ istatus=NF90_INQUIRE_VARIABLE(kout, kid, dimids = inldim(:) )
+
+ IF ( inldim(3) == id_dimunlim) THEN ! this is a x,y,t file
istart(3)=itime ; istart(4)=1
ELSE
- istart(3)=klev ; istart(4)=itime
+ istart(3)=klev ; istart(4)=itime ! this is a x,y,z, t file
ENDIF
+
icount(:) = 1 ; icount(1) = kpi ; icount(2) = kpj
istatus=NF90_PUT_VAR(kout,kid, ptab, start=istart,count=icount)
+
IF (PRESENT(kwght) ) THEN
- istatus=NF90_PUT_ATT(kout,kid,'iweight',kwght)
+ istatus=NF90_PUT_ATT(kout, kid, 'iweight', kwght)
ENDIF
putvarr8=istatus
END FUNCTION putvarr8
- FUNCTION putvarr4(kout, kid,ptab, klev, kpi, kpj, ktime, kwght)
- !!-----------------------------------------------------------
- !! *** FUNCTION putvar ***
- !!
- !! ** Purpose : copy a 2D level of ptab in already open file kout, using variable kid
- !!
- !! ** Method :
- !!
- !! ** Action : variable level written
- !!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- INTEGER, INTENT(in) :: kout , & ! ncid of output file
- & kid ! varid of output variable
- INTEGER, INTENT(in) :: klev ! level at which ptab will be written
- INTEGER, INTENT(in) :: kpi,kpj ! dimension of ptab
- INTEGER, OPTIONAL, INTENT(in) :: ktime ! dimension of ptab
- INTEGER, OPTIONAL, INTENT(in) :: kwght ! weight of this variable
- REAL(KIND=4), DIMENSION(kpi,kpj),INTENT(in) :: ptab ! 2D array to write in file
- INTEGER :: putvarr4 ! return status
-
- !! * Local variables
- INTEGER :: istatus, itime, id_dimunlim
- INTEGER, DIMENSION(4) :: istart, icount, nldim
+ INTEGER(KIND=4) FUNCTION putvarr4(kout, kid, ptab, klev, kpi, kpj, ktime, kwght)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION putvarr4 ***
+ !!
+ !! ** Purpose : copy a 2D level of ptab in already open file kout,
+ !! using variable kid
+ !!
+ !! ** Method : this corresponds to the generic function putvar with r4 arg.
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file
+ INTEGER(KIND=4), INTENT(in) :: kid ! varid of output variable
+ REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptab ! 2D array to write in file
+ INTEGER(KIND=4), INTENT(in) :: klev ! level at which ptab will be written
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of ptab
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! dimension of ptab
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kwght ! weight of this variable
+
+ INTEGER(KIND=4) :: istatus, itime, id_dimunlim
+ INTEGER(KIND=4), DIMENSION(4) :: istart, icount, inldim
+ !!----------------------------------------------------------------------
IF (PRESENT(ktime) ) THEN
itime=ktime
ELSE
itime=1
ENDIF
- istatus=NF90_INQUIRE(kout,unlimitedDimId=id_dimunlim)
- nldim=0
- istart(:) = 1
- istatus=NF90_INQUIRE_VARIABLE(kout, kid,dimids=nldim(:) )
- IF ( nldim(3) == id_dimunlim) THEN
+
+ ! Look for a unlimited dimension
+ istatus=NF90_INQUIRE(kout, unlimitedDimId = id_dimunlim)
+ inldim(:) = 0
+ istart(:) = 1
+ istatus=NF90_INQUIRE_VARIABLE(kout, kid, dimids = inldim(:) )
+
+ IF ( inldim(3) == id_dimunlim) THEN ! this is a x,y,t file
istart(3)=itime ; istart(4)=1
ELSE
- istart(3)=klev ; istart(4)=itime
+ istart(3)=klev ; istart(4)=itime ! this is a x,y,z, t file
ENDIF
+
icount(:) = 1 ; icount(1) = kpi ; icount(2) = kpj
istatus=NF90_PUT_VAR(kout,kid, ptab, start=istart,count=icount)
+
IF (PRESENT(kwght) ) THEN
- istatus=NF90_PUT_ATT(kout,kid,'iweight',kwght)
+ istatus=NF90_PUT_ATT(kout, kid, 'iweight', kwght)
ENDIF
putvarr4=istatus
END FUNCTION putvarr4
- FUNCTION reputvarr4 (cdfile,cdvar,klev,kpi,kpj,kimin,kjmin, ktime,ptab,kwght)
- !!-----------------------------------------------------------
- !! *** FUNCTION putvar ***
- !!
- !! ** Purpose : Change an existing variable in inputfile
- !!
- !! ** Method :
- !!
- !! ** Action : variable level written
- !!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
-
- CHARACTER(LEN=*), INTENT(in) :: cdfile, & ! file name to work with
- & cdvar ! variable name to work with
- INTEGER, INTENT(in) :: kpi,kpj ! horizontal size of the 2D variable
- INTEGER, OPTIONAL, INTENT(in) :: klev ! Optional variable. If missing 1 is assumed
- INTEGER, OPTIONAL, INTENT(in) :: kimin,kjmin ! Optional variable. If missing 1 is assumed
- INTEGER, OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed
- INTEGER, OPTIONAL, INTENT(in) :: kwght ! weight of this variable
- REAL(KIND=4), DIMENSION(kpi,kpj) :: ptab ! 2D REAL 4 holding variable field at klev
- INTEGER :: reputvarr4
-
- !! * Local variables
- INTEGER, DIMENSION(4) :: istart, icount, nldim
- INTEGER :: ncid, id_var, id_dimunlim
- INTEGER :: istatus, ilev, imin, jmin, itime
-
- ilev=1 ; IF (PRESENT(klev) ) ilev=klev
- imin=1 ; IF (PRESENT(kimin) ) imin=kimin
- jmin=1 ; IF (PRESENT(kjmin) ) jmin=kjmin
- itime=1 ; IF (PRESENT(ktime) ) itime=ktime
-
- istatus=NF90_OPEN(cdfile,NF90_WRITE,ncid)
- istatus=NF90_INQ_VARID(ncid,cdvar,id_var)
+
+ INTEGER(KIND=4) FUNCTION putvari2(kout, kid, ktab, klev, kpi, kpj, ktime, kwght)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION putvari2 ***
+ !!
+ !! ** Purpose : copy a 2D level of ptab in already open file kout,
+ !! using variable kid
+ !!
+ !! ** Method : this corresponds to the generic function putvar with i2 arg.
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file
+ INTEGER(KIND=4), INTENT(in) :: kid ! varid of output variable
+ INTEGER(KIND=2), DIMENSION(kpi,kpj), INTENT(in) :: ktab ! 2D array to write in file
+ INTEGER(KIND=4), INTENT(in) :: klev ! level at which ktab will be written
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of ktab
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! dimension of ktab
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kwght ! weight of this variable
+
+ INTEGER(KIND=4) :: istatus, itime, id_dimunlim
+ INTEGER(KIND=4), DIMENSION(4) :: istart, icount, inldim
+ !!----------------------------------------------------------------------
+ IF (PRESENT(ktime) ) THEN
+ itime=ktime
+ ELSE
+ itime=1
+ ENDIF
+
+ ! Look for a unlimited dimension
+ istatus=NF90_INQUIRE(kout, unlimitedDimId = id_dimunlim)
+ inldim(:) = 0
+ istart(:) = 1
+ istatus=NF90_INQUIRE_VARIABLE(kout, kid, dimids = inldim(:) )
+
+ IF ( inldim(3) == id_dimunlim) THEN ! this is a x,y,t file
+ istart(3)=itime ; istart(4)=1
+ ELSE
+ istart(3)=klev ; istart(4)=itime ! this is a x,y,z, t file
+ ENDIF
+
+ icount(:) = 1 ; icount(1) = kpi ; icount(2) = kpj
+ istatus=NF90_PUT_VAR(kout,kid, ktab, start=istart,count=icount)
+
+ IF (PRESENT(kwght) ) THEN
+ istatus=NF90_PUT_ATT(kout, kid, 'iweight', kwght)
+ ENDIF
+ putvari2=istatus
+
+ END FUNCTION putvari2
+
+
+ INTEGER(KIND=4) FUNCTION reputvarr4 (cdfile, cdvar, klev, kpi, kpj, kimin, kjmin, ktime, ptab, kwght)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION reputvarr4 ***
+ !!
+ !! ** Purpose : Change an existing variable in inputfile
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name to work with
+ CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name to work with
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: klev ! Optional variable. If missing 1 is assumed
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! horizontal size of the 2D variable
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kimin, kjmin ! Optional variable. If missing 1 is assumed
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! Optional variable. If missing 1 is assumed
+ REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptab ! 2D REAL 4 holding variable field at klev
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: kwght ! weight of this variable
+
+ INTEGER(KIND=4), DIMENSION(4) :: istart, icount, inldim
+ INTEGER(KIND=4) :: incid, id_var, id_dimunlim
+ INTEGER(KIND=4) :: istatus, ilev, iimin, ijmin, itime
+ !!----------------------------------------------------------------------
+ ilev = 1 ; IF (PRESENT(klev ) ) ilev = klev
+ iimin = 1 ; IF (PRESENT(kimin) ) iimin = kimin
+ ijmin = 1 ; IF (PRESENT(kjmin) ) ijmin = kjmin
+ itime = 1 ; IF (PRESENT(ktime) ) itime = ktime
+
+ istatus=NF90_OPEN(cdfile,NF90_WRITE,incid)
+ istatus=NF90_INQ_VARID(incid,cdvar,id_var)
!! look for eventual unlimited dim (time_counter)
- istatus=NF90_INQUIRE(ncid,unlimitedDimId=id_dimunlim)
+ istatus=NF90_INQUIRE(incid, unlimitedDimId=id_dimunlim)
- nldim=0
- istatus=NF90_INQUIRE_VARIABLE(ncid, id_var,dimids=nldim(:) )
- ! if the third dim of id_var is time, then adjust the starting point to take ktime into account (case XYT file)
- IF ( nldim(3) == id_dimunlim) THEN ; ilev=itime ; itime=1 ; ENDIF
- istatus=NF90_PUT_VAR(ncid,id_var,ptab,start=(/imin,jmin,ilev,itime/), count=(/kpi,kpj,1,1/) )
- !PRINT *,TRIM(NF90_STRERROR(istatus)),' in reputvar'
+ inldim=0
+ istatus=NF90_INQUIRE_VARIABLE(incid, id_var,dimids=inldim(:) )
+
+ ! if the third dim of id_var is time, then adjust the starting point
+ ! to take ktime into account (case XYT file)
+ IF ( inldim(3) == id_dimunlim) THEN ; ilev=itime ; itime=1 ; ENDIF
+ istatus=NF90_PUT_VAR(incid,id_var, ptab,start=(/iimin,ijmin,ilev,itime/), count=(/kpi,kpj,1,1/) )
+
IF (PRESENT(kwght)) THEN
- istatus=NF90_PUT_ATT(ncid,id_var,'iweight',kwght)
+ istatus=NF90_PUT_ATT(incid,id_var,'iweight',kwght)
ENDIF
+
reputvarr4=istatus
- istatus=NF90_CLOSE(ncid)
+
+ istatus=NF90_CLOSE(incid)
END FUNCTION reputvarr4
- FUNCTION putvarzo(kout, kid,ptab, klev, kpi, kpj,ktime)
- !!-----------------------------------------------------------
- !! *** FUNCTION putvarzo ***
- !!
- !! ** Purpose : copy a 2D level of ptab in already open file kout, using variable kid
- !! This variant deals with degenerated 2D (1 x jpj) zonal files
- !!
- !! ** Method :
+
+ INTEGER(KIND=4) FUNCTION putvarzo(kout, kid, ptab, klev, kpi, kpj, ktime)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION putvarzo ***
!!
- !! ** Action : variable level written
+ !! ** Purpose : Copy a 2D level of ptab in already open file kout, using variable kid
+ !! This variant deals with degenerated 2D (1 x jpj) zonal files
!!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- INTEGER, INTENT(in) :: kout , & ! ncid of output file
- & kid ! varid of output variable
- INTEGER, INTENT(in) :: klev ! level at which ptab will be written
- INTEGER, INTENT(in) :: kpi,kpj ! dimension of ptab
- INTEGER, OPTIONAL, INTENT(in) :: ktime ! dimension of ptab
- REAL(KIND=4), DIMENSION(kpj),INTENT(in) :: ptab ! 2D array to write in file
- INTEGER :: putvarzo ! return status
-
- !! * Local variables
- INTEGER :: istatus, itime, ilev, id_dimunlim
- INTEGER, DIMENSION(4) :: istart, icount,nldim
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file
+ INTEGER(KIND=4), INTENT(in) :: kid ! varid of output variable
+ REAL(KIND=4), DIMENSION(kpj), INTENT(in) :: ptab ! 2D array to write in file
+ INTEGER(KIND=4), INTENT(in) :: klev ! level at which ptab will be written
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of ptab
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! time to write
+ INTEGER(KIND=4) :: istatus, itime, ilev, id_dimunlim
+ INTEGER(KIND=4), DIMENSION(4) :: istart, icount,inldim
+ !!----------------------------------------------------------------------
ilev=klev
IF (PRESENT(ktime) ) THEN
itime=ktime
@@ -1803,11 +1853,13 @@ CONTAINS
ENDIF
! look for unlimited dim (time_counter)
- istatus=NF90_INQUIRE(kout,unlimitedDimId=id_dimunlim)
- nldim=0
- istatus=NF90_INQUIRE_VARIABLE(kout,kid,dimids=nldim(:) )
- ! if the third dim of id_var is time, then adjust the starting point to take ktime into account (case XYT file)
- IF ( nldim(3) == id_dimunlim) THEN ; ilev=itime ; itime=1 ; ENDIF
+ istatus=NF90_INQUIRE(kout, unlimitedDimId=id_dimunlim)
+ inldim=0
+ istatus=NF90_INQUIRE_VARIABLE(kout,kid,dimids=inldim(:) )
+
+ ! if the third dim of id_var is time, then adjust the starting point
+ ! to take ktime into account (case XYT file)
+ IF ( inldim(3) == id_dimunlim) THEN ; ilev=itime ; itime=1 ; ENDIF
istart(:) = 1 ; istart(3)=ilev ; istart(4)=itime
icount(:) = 1 ; icount(1) = kpi ; icount(2) = kpj
istatus=NF90_PUT_VAR(kout,kid, ptab, start=istart,count=icount)
@@ -1816,85 +1868,29 @@ CONTAINS
END FUNCTION putvarzo
- FUNCTION putvari2(kout, kid,ptab, klev, kpi, kpj,ktime)
- !!-----------------------------------------------------------
- !! *** FUNCTION putvar ***
- !!
- !! ** Purpose : copy a 2D level of ptab in already open file kout, using variable kid
+ INTEGER(KIND=4) FUNCTION putvar1d4(kout, ptab, kk, cdtype)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION putvar1d4 ***
!!
- !! ** Method :
+ !! ** Purpose : Copy 1D variable (size kk) hold in ptab, with id
+ !! kid, into file id kout
!!
- !! ** Action : variable level written
+ !! ** Method : cdtype is either T (time_counter) or D (depth.)
!!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- INTEGER, INTENT(in) :: kout , & ! ncid of output file
- & kid ! varid of output variable
- INTEGER, INTENT(in) :: klev ! level at which ptab will be written
- INTEGER, INTENT(in) :: kpi,kpj ! dimension of ptab
- INTEGER, OPTIONAL, INTENT(in) :: ktime ! dimension of ptab
- INTEGER(KIND=2), DIMENSION(kpi,kpj),INTENT(in) :: ptab ! 2D array to write in file
- INTEGER :: putvari2 ! return status
-
- !! * Local variables
- INTEGER :: istatus, itime, ilev, id_dimunlim
- INTEGER, DIMENSION(4) :: istart, icount, nldim
-
- ilev=klev
- IF (PRESENT(ktime) ) THEN
- itime=ktime
- ELSE
- itime=1
- ENDIF
- ! idem above for XYT files
- istatus=NF90_INQUIRE(kout,unlimitedDimId=id_dimunlim)
- nldim=0
- istart(:) = 1
- istatus=NF90_INQUIRE_VARIABLE(kout, kid,dimids=nldim(:) )
- IF ( nldim(3) == id_dimunlim) THEN
- istart(3)=itime ; istart(4)=1
- ELSE
- istart(3)=ilev ; istart(4)=itime
- ENDIF
-
- icount(:) = 1 ; icount(1) = kpi ; icount(2) = kpj
- istatus=NF90_PUT_VAR(kout,kid, ptab, start=istart,count=icount)
- putvari2=istatus
-
- END FUNCTION putvari2
-
-
- FUNCTION putvar1d4(kout,ptab,kk,cdtype)
- !!-----------------------------------------------------------
- !! *** FUNCTION putvar1d4 ***
- !!
- !! ** Purpose : Copy 1D variable (size kk) hold in ptab, with id kid, into file id kout
- !!
- !! ** Method : cdtype is either T (time_counter) or D (depth?)
- !!
- !! ** Action : 1D variable written
- !!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- !! * Arguments declarations
- INTEGER, INTENT(in) :: kout ! ncid of output file
- INTEGER, INTENT(in) :: kk ! number of elements in ptab
- REAL(KIND=4), DIMENSION(kk),INTENT(in) :: ptab ! 1D array to write in file
- CHARACTER(LEN=1), INTENT(in) :: cdtype ! either T or D
- INTEGER :: putvar1d4 ! return status
-
- !! * Local variables
- INTEGER :: istatus, iid
- INTEGER, DIMENSION(1) :: istart, icount
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file
+ REAL(KIND=4), DIMENSION(kk),INTENT(in) :: ptab ! 1D array to write in file
+ INTEGER(KIND=4), INTENT(in) :: kk ! number of elements in ptab
+ CHARACTER(LEN=1), INTENT(in) :: cdtype ! either T or D
+ INTEGER(KIND=4) :: istatus, iid
+ INTEGER(KIND=4), DIMENSION(1) :: istart, icount
+ !!----------------------------------------------------------------------
SELECT CASE ( cdtype )
CASE ('T', 't' )
- iid = id_tim
+ iid = nid_tim
CASE ('D', 'd' )
- iid = id_dep
+ iid = nid_dep
END SELECT
istart(:) = 1
@@ -1904,28 +1900,23 @@ CONTAINS
END FUNCTION putvar1d4
- FUNCTION reputvar1d4(cdfile, cdvar, ptab, kk )
- !!-----------------------------------------------------------
- !! *** FUNCTION reputvar1d4 ***
- !!
- !! ** Purpose : same as putvar1d4 but using an already existing file and variable
+ INTEGER(KIND=4) FUNCTION reputvar1d4(cdfile, cdvar, ptab, kk )
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION reputvar1d4 ***
!!
- !! ** Method :
+ !! ** Purpose : Copy 1d variable cdfvar in cdfile, an already existing file
+ !! ptab is the 1d array to write and kk the size of ptab
!!
- !! ** Action : 1D variable written
+ !! ** Method :
!!
- !! history:
- !! 04/2011 : Jean-Marc Molines : introduce module procedure for putvar1d
- !!-----------------------------------------------------------
+ !!----------------------------------------------------------------------
CHARACTER(LEN=*), INTENT(in) :: cdfile ! filename
CHARACTER(LEN=*), INTENT(in) :: cdvar ! variable name
REAL(KIND=4), DIMENSION(kk), INTENT(in) :: ptab ! 1D array to write in file
- INTEGER, INTENT(in) :: kk ! number of elements in ptab
- INTEGER :: reputvar1d4 ! return status
+ INTEGER(KIND=4), INTENT(in) :: kk ! number of elements in ptab
INTEGER :: istatus, incid, id
!!-----------------------------------------------------------
- incid = ncopen(cdfile)
istatus = NF90_OPEN(cdfile, NF90_WRITE, incid)
istatus = NF90_INQ_VARID(incid, cdvar, id )
istatus = NF90_PUT_VAR(incid, id, ptab, start=(/1/), count=(/kk/) )
@@ -1934,105 +1925,138 @@ CONTAINS
END FUNCTION reputvar1d4
- FUNCTION putvar0d(kout,varid,value)
- !!-----------------------------------------------------------
- !! *** FUNCTION putvar0d ***
+ INTEGER(KIND=4) FUNCTION putvar0dt(kout, kvarid, pvalue, ktime)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION putvar0dt ***
!!
!! ** Purpose : Copy single value, with id varid, into file id kout
!!
- !! ** Method :
+ !! ** Method : use argument as dummy array(1,1)
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file
+ INTEGER(KIND=4), INTENT(in) :: kvarid ! id of the variable
+ REAL(KIND=4), DIMENSION(1,1), INTENT(in) :: pvalue ! single value to write in file
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! time frame to write
+
+ INTEGER(KIND=4) :: istatus
+ INTEGER(KIND=4) :: itime
+ !!----------------------------------------------------------------------
+ IF (PRESENT(ktime) ) THEN
+ itime = ktime
+ ELSE
+ itime = 1
+ ENDIF
+
+ istatus=NF90_PUT_VAR(kout, kvarid, pvalue, start=(/1,1,itime/), count=(/1,1,1/) )
+
+ putvar0dt=istatus
+
+ END FUNCTION putvar0dt
+
+ INTEGER(KIND=4) FUNCTION putvar0ds(kout, kvarid, pvalue, ktime)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION putvar0ds ***
+ !!
+ !! ** Purpose : Copy single value, with id varid, into file id kout
!!
- !! ** Action : single value variable written
+ !! ** Method : use argument as scalar
!!
- !!-----------------------------------------------------------
- !! * Arguments declarations
- INTEGER, INTENT(in) :: kout ! ncid of output file
- INTEGER, INTENT(in) :: varid ! id of the variable
- REAL(KIND=4), INTENT(in) :: value ! single value to write in file
- INTEGER :: putvar0d ! return status
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kout ! ncid of output file
+ INTEGER(KIND=4), INTENT(in) :: kvarid ! id of the variable
+ REAL(KIND=4), INTENT(in) :: pvalue ! single value to write in file
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: ktime ! time frame to write
+
+ INTEGER(KIND=4) :: istatus
+ INTEGER(KIND=4) :: itime
+ REAL(KIND=4), DIMENSION(1,1) :: ztab ! dummy array for PUT_VAR
+ !!----------------------------------------------------------------------
+ IF (PRESENT(ktime) ) THEN
+ itime = ktime
+ ELSE
+ itime = 1
+ ENDIF
+ ztab = pvalue
- ! Local variables
- INTEGER :: istatus
+ istatus=NF90_PUT_VAR(kout, kvarid, ztab, start=(/1,1,itime/), count=(/1,1,1/) )
- istatus=NF90_PUT_VAR(kout,varid,value)
- putvar0d=istatus
+ putvar0ds=istatus
- END FUNCTION putvar0d
+ END FUNCTION putvar0ds
- FUNCTION closeout(kout)
- !!----------------------------------------------------------
- !! *** FUNCTION closeout ***
+
+
+ INTEGER(KIND=4) FUNCTION closeout(kout)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION closeout ***
!!
- !! ** Purpose : close open output files
+ !! ** Purpose : close opened output files
!!
- !! history:
- !! 27/04/2005 : Jean-Marc Molines : Original Code
- !!-----------------------------------------------------------
- INTEGER,INTENT(in) :: kout ! ncid of file to be closed
- INTEGER :: closeout ! return status
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kout ! ncid of file to be closed
+ !!----------------------------------------------------------------------
closeout=NF90_CLOSE(kout)
+
END FUNCTION closeout
- FUNCTION ncopen(cdfile)
- !!----------------------------------------------------------
- !! *** FUNCTION ncopen ***
+ INTEGER(KIND=4) FUNCTION ncopen(cdfile)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION ncopen ***
!!
!! ** Purpose : open file cdfile and return file ID
!!
- !!-----------------------------------------------------------
+ !!---------------------------------------------------------------------
CHARACTER(LEN=*), INTENT(in) :: cdfile ! file name
- INTEGER :: ncopen ! return status
- ! * Local variables
- INTEGER :: istatus, ncid
- istatus = NF90_OPEN(cdfile,NF90_WRITE,ncid)
- ncopen=ncid
+
+ INTEGER(KIND=4) :: istatus, incid
+ !!---------------------------------------------------------------------
+ istatus = NF90_OPEN(cdfile,NF90_WRITE,incid)
+
+ ncopen=incid
+
END FUNCTION ncopen
SUBROUTINE ERR_HDL(kstatus)
- !! ----------------------------------------------------------
- !! *** SUBROUTINE err_hdl
- !!
- !! ** Purpose : Error handle for NetCDF routine.
- !! Stop if kstatus indicates error conditions.
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE ERR_HDL ***
!!
- !! History :
- !! Original: J.M. Molines (01/99)
+ !! ** Purpose : Error handle for NetCDF routine.
+ !! Stop if kstatus indicates error conditions.
!!
- !! -----------------------------------------------------------
- IMPLICIT NONE
- INTEGER, INTENT(in) :: kstatus
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kstatus
+ !!----------------------------------------------------------------------
IF (kstatus /= NF90_NOERR ) THEN
PRINT *, 'ERROR in NETCDF routine, status=',kstatus
PRINT *,NF90_STRERROR(kstatus)
STOP
END IF
+
END SUBROUTINE ERR_HDL
- SUBROUTINE gettimeseries (cdfile, cdvar, kilook, kjlook,klev)
- !! ----------------------------------------------------------
- !! *** SUBROUTINE gettimeseries ***
- !!
- !! ** Purpose : Display a 2 column output ( time, variable) for
- !! a given variable of a given file at a given point
+
+ SUBROUTINE gettimeseries (cdfile, cdvar, kilook, kjlook, klev)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE gettimeseries ***
!!
- !! History :
- !! Original: J.M. Molines (03/2007)
+ !! ** Purpose : Display a 2 columns output ( time, variable) for
+ !! a given variable of a given file at a given point
!!
- !! -----------------------------------------------------------
- !* Arguments
- IMPLICIT NONE
- CHARACTER(LEN=*),INTENT(in) :: cdfile, cdvar
- INTEGER,INTENT(in) :: kilook,kjlook
- INTEGER, OPTIONAL, INTENT(in) :: klev
- !* Local variables
- INTEGER :: nt, jt
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: ztime, zval
- REAL(KIND=4) :: ztmp, zao=0., zsf=1.0 !: add_offset, scale_factor
-
- ! netcdf stuff
- INTEGER :: istatus
- INTEGER :: ncid, id_t, id_var, ndim, jk
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile, cdvar
+ INTEGER(KIND=4), INTENT(in) :: kilook,kjlook
+ INTEGER(KIND=4), OPTIONAL, INTENT(in) :: klev
+ INTEGER(KIND=4) :: jt, jk
+ INTEGER(KIND=4) :: iint
+ INTEGER(KIND=4) :: istatus
+ INTEGER(KIND=4) :: incid, id_t, id_var
+ INTEGER(KIND=4) :: indim
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: ztime, zval
+ REAL(KIND=4) :: ztmp
+ REAL(KIND=4) :: zao=0., zsf=1.0 !: add_offset, scale_factor
+ !!----------------------------------------------------------------------
! Klev can be used to give the model level we want to look at
IF ( PRESENT(klev) ) THEN
jk=klev
@@ -2041,35 +2065,36 @@ CONTAINS
ENDIF
! Open cdf dataset
- istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
+ istatus=NF90_OPEN(cdfile,NF90_NOWRITE,incid)
! read time dimension
- istatus=NF90_INQ_DIMID(ncid,'time_counter',id_t)
- istatus=NF90_INQUIRE_DIMENSION(ncid,id_t,len=nt)
+ istatus=NF90_INQ_DIMID(incid, cn_t, id_t)
+ istatus=NF90_INQUIRE_DIMENSION(incid,id_t, len=iint)
! Allocate space
- ALLOCATE (ztime(nt), zval(nt) )
+ ALLOCATE (ztime(iint), zval(iint) )
! gettime
- istatus=NF90_INQ_VARID(ncid,'time_counter',id_var)
- istatus=NF90_GET_VAR(ncid,id_var,ztime,(/1/),(/nt/) )
+ istatus=NF90_INQ_VARID(incid,cn_vtimec,id_var)
+ istatus=NF90_GET_VAR(incid,id_var,ztime,(/1/),(/iint/) )
! read variable
- istatus=NF90_INQ_VARID(ncid,cdvar,id_var)
- ! look for scale_factor and add_offset attribute:
- istatus=NF90_GET_ATT(ncid,id_var,'add_offset',ztmp)
+ istatus=NF90_INQ_VARID(incid,cdvar,id_var)
+
+ ! look for scale_factor and add_offset attribute:
+ istatus=NF90_GET_ATT(incid,id_var,'add_offset',ztmp)
IF ( istatus == NF90_NOERR ) zao = ztmp
- istatus=NF90_GET_ATT(ncid,id_var,'scale_factor',ztmp)
+ istatus=NF90_GET_ATT(incid,id_var,'scale_factor',ztmp)
IF ( istatus == NF90_NOERR ) zsf = ztmp
! get number of dimension of the variable ( either x,y,t or x,y,z,t )
- istatus=NF90_INQUIRE_VARIABLE(ncid,id_var,ndims=ndim)
- IF ( ndim == 3 ) THEN
- istatus=NF90_GET_VAR(ncid,id_var,zval,(/kilook,kjlook,1/),(/1,1,nt/) )
- ELSE IF ( ndim == 4 ) THEN
- istatus=NF90_GET_VAR(ncid,id_var,zval,(/kilook,kjlook,jk,1/),(/1,1,1,nt/) )
+ istatus=NF90_INQUIRE_VARIABLE(incid,id_var, ndims=indim)
+ IF ( indim == 3 ) THEN
+ istatus=NF90_GET_VAR(incid,id_var,zval,(/kilook,kjlook,1/),(/1,1,iint/) )
+ ELSE IF ( indim == 4 ) THEN
+ istatus=NF90_GET_VAR(incid,id_var,zval,(/kilook,kjlook,jk,1/),(/1,1,1,iint/) )
ELSE
- PRINT *,' ERROR : variable ',TRIM(cdvar),' has ', ndim, &
+ PRINT *,' ERROR : variable ',TRIM(cdvar),' has ', indim, &
& ' dimensions !. Only 3 or 4 supported'
STOP
ENDIF
@@ -2078,13 +2103,44 @@ CONTAINS
zval=zval*zsf + zao
! display results :
- DO jt=1,nt
+ DO jt=1,iint
PRINT *,ztime(jt)/86400., zval(jt)
ENDDO
- istatus=NF90_CLOSE(ncid)
+ istatus=NF90_CLOSE(incid)
END SUBROUTINE gettimeseries
+ LOGICAL FUNCTION chkfile (cd_file)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION chkfile ***
+ !!
+ !! ** Purpose : Check if cd_file exists.
+ !! Return false if it exists, true if it does not
+ !! Do nothing is filename is 'none'
+ !!
+ !! ** Method : Doing it this way allow statements such as
+ !! IF ( chkfile( cf_toto) ) STOP ! missing file
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cd_file
+
+ LOGICAL :: ll_exist
+ !!----------------------------------------------------------------------
+ IF ( TRIM(cd_file) /= 'none') THEN
+ INQUIRE (file = TRIM(cd_file), EXIST=ll_exist)
+
+ IF (ll_exist) THEN
+ chkfile = .false.
+ ELSE
+ PRINT *, ' File ',TRIM(cd_file),' is missing '
+ chkfile = .true.
+ ENDIF
+ ELSE
+ chkfile = .false. ! 'none' file is not checked
+ ENDIF
+
+ END FUNCTION chkfile
+
END MODULE cdfio
diff --git a/cdfisopsi.f90 b/cdfisopsi.f90
index f54dfc7..2318813 100644
--- a/cdfisopsi.f90
+++ b/cdfisopsi.f90
@@ -1,442 +1,436 @@
PROGRAM cdfisopsi
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfisopsi ***
- !!
- !! ** Purpose: Compute a geostrophic streamfunction projected
+ !!======================================================================
+ !! *** PROGRAM cdfisopsi ***
+ !!=====================================================================
+ !! ** Purpose : Compute a geostrophic streamfunction projected
!! on an isopycn (Ref: McDougall and ?, need reference)
- !!
- !! ** Method: read temp and salinity, compute sigmainsitu and sigma
+ !!
+ !! ** Method : read temp and salinity, compute sigmainsitu and sigma
!! at a reference level, projection of p,T,S on a given
!! isopycnal, compute specific volume anomaly and
!! integrates it.
!!
- !! history:
- !! Original : R. Dussin Dec 2010 (from various existing cdftools)
- !!
- !!-------------------------------------------------------------------
- !! $Rev: 256 $
- !! $Date: 2009-07-21 17:49:27 +0200 (mar. 21 juil. 2009) $
- !! $Id: cdfsiginsitu.f90 256 2009-07-21 15:49:27Z molines $
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 12/2010 : R. Dussin
+ !! 3.0 : 03/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER, PARAMETER :: nvars=7
- INTEGER :: jj,ji,jk,jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line arguments
- INTEGER :: npiglo,npjglo, npk ,npt !: size of the domain
- INTEGER :: k0 !:
- INTEGER, DIMENSION(nvars) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal , zssh, & !: Array to read a layer of data
- & ztemp0, zsal0, & !: Arrays for reference profile
- & zsiginsitu , & !: in-situ density
- & zsig0, zsigsurf, & !: potential density of ref profile and surface
- & zmask, zdep !: 2D mask at current level, level depths
- REAL(KIND=4),DIMENSION(:,:), ALLOCATABLE :: v2d, ztempint, zsalint, zint, pint, alpha !: 2d working arrays
- REAL(KIND=4),DIMENSION(:,:,:), ALLOCATABLE :: v3d, ztemp3, zsal3, sva3 !: 3d array
- REAL(KIND=4),DIMENSION(:,:), ALLOCATABLE :: e1t, e2t
- REAL(KIND=4),DIMENSION(:,:), ALLOCATABLE :: deltapsi1, deltapsi2, psi0, psi, sva2
- REAL(KIND=4),DIMENSION(:), ALLOCATABLE :: prof, tim !: prof (m) and time (sec)
+ INTEGER(KIND=4), PARAMETER :: jp_vars=7
+
+ INTEGER(KIND=4) :: jj, ji, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! command line arguments
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ik, ik0 !
+ INTEGER(KIND=4) :: ncout
+ INTEGER(KIND=4), DIMENSION(jp_vars) :: ipk ! outptut variables : number of levels,
+ INTEGER(KIND=4), DIMENSION(jp_vars) :: id_varout ! ncdf varid's
+
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d, ztemp3 ! 3d array
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: zsal3, zsva3 ! 3d array
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp, zsal , zssh ! Array to read a layer of data
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp0, zsal0 ! Arrays for reference profile
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsiginsitu ! in-situ density
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsig0, zsigsurf ! potential density of ref profile and surface
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask, zdep ! 2D mask at current level, level depths
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! 2d working arrays
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztempint ! 2d working arrays
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsalint ! 2d working arrays
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zint ! 2d working arrays
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: pint ! 2d working arrays
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: alpha ! 2d working arrays
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdeltapsi1
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdeltapsi2
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: psi0
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: psi
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsva2
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: prof, tim ! prof (m) and time (sec)
REAL(KIND=4) :: P1, P2
- REAL(KIND=4) :: spval !: missing value
+ REAL(KIND=4) :: zspval ! missing value
REAL(KIND=4) :: refdepth
- REAL(KIND=4) :: sigmaref
- REAL(KIND=4) :: tmean, smean, hmean, pmean
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='isopsi.nc', coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc'
- CHARACTER(LEN=256) :: cdum
+ REAL(KIND=4) :: zsigmaref !
+ REAL(KIND=4) :: ztmean, zsmean ! mean temperature and salinity on isopycnal
+ REAL(KIND=4) :: hmean, pmean ! mean isopycnal depth and mean pressure
- TYPE(variable) , DIMENSION(nvars) :: typvar !: structure for attributes
+ CHARACTER(LEN=256) :: cf_tfil ! input gridT file
+ CHARACTER(LEN=256) :: cf_out='isopsi.nc' ! output file name
+ CHARACTER(LEN=256) :: cldum ! dummy character variable for reading
- INTEGER :: ncout
- INTEGER :: istatus
+ TYPE(variable) , DIMENSION(jp_vars) :: stypvar ! structure for attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !--------------------------------------------------------------------
- !! Read command line
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfisopsi ref_level sigma_ref gridT '
- PRINT *,' Output on isopsi.nc, variable soisopsi'
- PRINT *,' Depths are taken from input file '
- PRINT *,' requires mesh_hgr.nc and mesh_zgr.nc'
+ PRINT *,' usage : cdfisopsi ref_level sigma_ref gridT '
+ PRINT *,' Compute a geostrophic streamfunction'
+ PRINT *,' projected on an isopycn.'
+ PRINT *,' ref_level = reference level for pot. density'
+ PRINT *,' sigma_ref = density level to project on'
+ PRINT *,' gridT = input file for temperature and salinity'
+ PRINT *,' '
+ PRINT *,' Output on ',TRIM(cf_out),' variable soisopsi'
+ PRINT *,' Depths are taken from input file '
+ PRINT *,' requires ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr)
STOP
ENDIF
- CALL getarg (1, cdum)
- READ (cdum,*) refdepth
- CALL getarg (2, cdum)
- READ (cdum,*) sigmaref
- CALL getarg (3, cfilet)
+ CALL getarg (1, cldum) ; READ (cldum,*) refdepth
+ CALL getarg (2, cldum) ; READ (cldum,*) zsigmaref
+ CALL getarg (3, cf_tfil)
+
+ IF ( chkfile(cf_tfil) .OR. chkfile(cn_fzgr) .OR. chkfile(cn_fhgr) ) STOP ! missing file
PRINT *, 'Potential density referenced at ', refdepth , ' meters'
- PRINT *, 'Isopycn for projection is ', sigmaref
+ PRINT *, 'Isopycn for projection is ', zsigmaref
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npt = getdim (cfilet,'time')
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'npt =', npt
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
- ALLOCATE ( prof(npk) , tim(npt) )
- ALLOCATE ( e1t(npiglo,npjglo) , e2t(npiglo,npjglo) )
+ ALLOCATE ( prof(npk) , tim(npt) )
+ ALLOCATE ( e1t(npiglo,npjglo), e2t(npiglo,npjglo) )
- e1t(:,:) = getvar(coordhgr, 'e1t' ,1,npiglo,npjglo)
- e2t(:,:) = getvar(coordhgr, 'e2t' ,1,npiglo,npjglo)
+ e1t(:,:) = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo)
+ e2t(:,:) = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo)
!--------------------------------------------------------------------
!! Output file
ipk(:)= 1 ! all variables are 2d
- typvar(1)%name= 'votemper_interp'
- typvar(1)%units='DegC'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -2.
- typvar(1)%valid_max= 45.
- typvar(1)%long_name='Temperature interpolated on isopycnal layer'
- typvar(1)%short_name='votemper_interp'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
- typvar(2)%name= 'vosaline_interp'
- typvar(2)%units='PSU'
- typvar(2)%missing_value=0.
- typvar(2)%valid_min= 0.
- typvar(2)%valid_max= 50.
- typvar(2)%long_name='Salinity interpolated on isopycnal layer'
- typvar(2)%short_name='vosaline_interp'
- typvar(2)%online_operation='N/A'
- typvar(2)%axis='TZYX'
-
- typvar(3)%name= 'depth_interp'
- typvar(3)%units='meters'
- typvar(3)%missing_value=0.
- typvar(3)%valid_min= 0.0
- typvar(3)%valid_max= 8000.
- typvar(3)%long_name='Depth of the isopycnal layer'
- typvar(3)%short_name='depth_interp'
- typvar(3)%online_operation='N/A'
- typvar(3)%axis='TZYX'
-
- typvar(4)%name= 'soisopsi'
- typvar(4)%units=' m2s-2 (to be verified)'
- typvar(4)%missing_value=0.
- typvar(4)%valid_min= -500.
- typvar(4)%valid_max= 500.
- typvar(4)%long_name='Total streamfunction on the isopycnal layer'
- typvar(4)%short_name='soisopsi'
- typvar(4)%online_operation='N/A'
- typvar(4)%axis='TZYX'
-
- typvar(5)%name= 'soisopsi0'
- typvar(5)%units=' m2s-2 (to be verified)'
- typvar(5)%missing_value=0.
- typvar(5)%valid_min= -500.
- typvar(5)%valid_max= 500.
- typvar(5)%long_name='Contribution of the SSH'
- typvar(5)%short_name='soisopsi'
- typvar(5)%online_operation='N/A'
- typvar(5)%axis='TZYX'
-
- typvar(6)%name= 'soisopsi1'
- typvar(6)%units=' m2s-2 (to be verified)'
- typvar(6)%missing_value=0.
- typvar(6)%valid_min= -500.
- typvar(6)%valid_max= 500.
- typvar(6)%long_name='Contribution of specific volume anomaly vertical integration'
- typvar(6)%short_name='soisopsi'
- typvar(6)%online_operation='N/A'
- typvar(6)%axis='TZYX'
-
- typvar(7)%name= 'soisopsi2'
- typvar(7)%units=' m2s-2 (to be verified)'
- typvar(7)%missing_value=0.
- typvar(7)%valid_min= -500.
- typvar(7)%valid_max= 500.
- typvar(7)%long_name='Contribution of pressure term on the isopycnal layer'
- typvar(7)%short_name='soisopsi'
- typvar(7)%online_operation='N/A'
- typvar(7)%axis='TZYX'
+ stypvar(1)%cname = 'votemper_interp'
+ stypvar(1)%cunits = 'DegC'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = -2.
+ stypvar(1)%valid_max = 45.
+ stypvar(1)%clong_name = 'Temperature interpolated on isopycnal layer'
+ stypvar(1)%cshort_name = 'votemper_interp'
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+
+ stypvar(2)%cname = 'vosaline_interp'
+ stypvar(2)%cunits = 'PSU'
+ stypvar(2)%rmissing_value = 0.
+ stypvar(2)%valid_min = 0.
+ stypvar(2)%valid_max = 50.
+ stypvar(2)%clong_name = 'Salinity interpolated on isopycnal layer'
+ stypvar(2)%cshort_name = 'vosaline_interp'
+ stypvar(2)%conline_operation = 'N/A'
+ stypvar(2)%caxis = 'TZYX'
+
+ stypvar(3)%cname = 'depth_interp'
+ stypvar(3)%cunits = 'meters'
+ stypvar(3)%rmissing_value = 0.
+ stypvar(3)%valid_min = 0.0
+ stypvar(3)%valid_max = 8000.
+ stypvar(3)%clong_name = 'Depth of the isopycnal layer'
+ stypvar(3)%cshort_name = 'depth_interp'
+ stypvar(3)%conline_operation = 'N/A'
+ stypvar(3)%caxis = 'TZYX'
+
+ stypvar(4)%cname = 'soisopsi'
+ stypvar(4)%cunits = 'm2s-2 (to be verified)'
+ stypvar(4)%rmissing_value = 0.
+ stypvar(4)%valid_min = -500.
+ stypvar(4)%valid_max = 500.
+ stypvar(4)%clong_name = 'Total streamfunction on the isopycnal layer'
+ stypvar(4)%cshort_name = 'soisopsi'
+ stypvar(4)%conline_operation = 'N/A'
+ stypvar(4)%caxis = 'TZYX'
+
+ stypvar(5)%cname = 'soisopsi0'
+ stypvar(5)%cunits = 'm2s-2 (to be verified)'
+ stypvar(5)%rmissing_value = 0.
+ stypvar(5)%valid_min = -500.
+ stypvar(5)%valid_max = 500.
+ stypvar(5)%clong_name = 'Contribution of the SSH'
+ stypvar(5)%cshort_name = 'soisopsi'
+ stypvar(5)%conline_operation = 'N/A'
+ stypvar(5)%caxis = 'TZYX'
+
+ stypvar(6)%cname = 'soisopsi1'
+ stypvar(6)%cunits = 'm2s-2 (to be verified)'
+ stypvar(6)%rmissing_value = 0.
+ stypvar(6)%valid_min = -500.
+ stypvar(6)%valid_max = 500.
+ stypvar(6)%clong_name = 'Contribution of specific volume anomaly vertical integration'
+ stypvar(6)%cshort_name = 'soisopsi'
+ stypvar(6)%conline_operation = 'N/A'
+ stypvar(6)%caxis = 'TZYX'
+
+ stypvar(7)%cname = 'soisopsi2'
+ stypvar(7)%cunits = 'm2s-2 (to be verified)'
+ stypvar(7)%rmissing_value = 0.
+ stypvar(7)%valid_min = -500.
+ stypvar(7)%valid_max = 500.
+ stypvar(7)%clong_name = 'Contribution of pressure term on the isopycnal layer'
+ stypvar(7)%cshort_name = 'soisopsi'
+ stypvar(7)%conline_operation = 'N/A'
+ stypvar(7)%caxis = 'TZYX'
! create output fileset
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, jp_vars, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,nvars, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,npk)
- prof(:)=getvar1d(cfilet,'deptht',npk)
- tim=getvar1d(cfilet,'time_counter',npt)
- ierr=putvar1d(ncout,tim,npt,'T')
+ prof(:) = getvar1d(cf_tfil, cn_vdeptht, npk )
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
- spval=getatt(cfilet,'vosaline','missing_value')
+ zspval = getatt(cf_tfil, cn_vosaline, cn_missing_value )
!---------------------------------------------------------------------------
- !! BEGIN LOOP ON TIME COUNTER
DO jt=1,npt
PRINT *,'time ',jt, tim(jt)/86400.,' days'
- !------------------------------------------------------------------------------
- ! 1. First we compute the potential density and store it into a 3d array
- ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zmask(npiglo,npjglo))
- ALLOCATE (v3d(npiglo,npjglo,npk))
-
- DO jk = 1, npk
- zmask(:,:)=1.
-
- ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo, ktime=jt)
- zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo, ktime=jt)
+ !------------------------------------------------------------------------------
+ ! 1. First we compute the potential density and store it into a 3d array
+ ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zmask(npiglo,npjglo))
+ ALLOCATE (v3d(npiglo,npjglo,npk) )
- WHERE(zsal == spval ) zmask = 0
+ DO jk = 1, npk
+ zmask(:,:) = 1.
- v3d(:,:,jk) = sigmai ( ztemp,zsal,refdepth,npiglo,npjglo ) * zmask(:,:)
+ ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt)
+ zsal(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt)
- END DO ! loop to next level
- DEALLOCATE ( ztemp, zsal, zmask )
+ WHERE(zsal == zspval ) zmask = 0
- !------------------------------------------------------------------------------
- ! 2. Projection of T,S and p on the chosen isopycnal layer (from cdfrhoproj)
+ v3d(:,:,jk) = sigmai(ztemp, zsal, refdepth, npiglo, npjglo ) * zmask(:,:)
+ END DO ! loop to next level
- ALLOCATE ( alpha(npiglo,npjglo) )
+ DEALLOCATE ( ztemp, zsal, zmask )
+ !------------------------------------------------------------------------------
+ ! 2. Projection of T,S and p on the chosen isopycnal layer (from cdfrhoproj)
+ ALLOCATE ( alpha(npiglo,npjglo) )
- !! Compute coefficients
- DO ji=1,npiglo
- DO jj = 1, npjglo
- jk = 1
- ! Assume that rho (z) is increasing downward (no inversion)
- ! Caution with sigma0 at great depth !
- DO WHILE (sigmaref >= v3d(ji,jj,jk) .AND. jk <= npk &
- & .AND. v3d(ji,jj,jk) /= spval )
- jk=jk+1
+ !! Compute coefficients
+ DO ji=1,npiglo
+ DO jj = 1, npjglo
+ ik = 1
+ ! Assume that rho (z) is increasing downward (no inversion)
+ ! Caution with sigma0 at great depth !
+ DO WHILE (zsigmaref >= v3d(ji,jj,ik) .AND. ik <= npk &
+ & .AND. v3d(ji,jj,ik) /= zspval )
+ ik=ik+1
END DO
- jk=jk-1
- k0=jk
- IF (jk .EQ. 0) THEN
- jk=1
+ ik=ik-1
+ ik0=ik
+ IF (ik == 0) THEN
+ ik=1
alpha(ji,jj) = 0.
- ELSE IF (v3d(ji,jj,jk+1) .EQ. spval ) THEN
- k0=0
+ ELSE IF (v3d(ji,jj,ik+1) == zspval ) THEN
+ ik0=0
alpha(ji,jj) = 0.
ELSE
- ! ... alpha is always in [0,1]. Adding k0 ( >=1 ) for saving space for k0
- alpha(ji,jj)= &
- & (sigmaref-v3d(ji,jj,jk))/(v3d(ji,jj,jk+1)-v3d(ji,jj,jk)) + k0
+ ! ... alpha is always in [0,1]. Adding ik0 ( >=1 ) for saving space for ik0
+ alpha(ji,jj)= (zsigmaref-v3d(ji,jj,ik))/(v3d(ji,jj,ik+1)-v3d(ji,jj,ik)) + ik0
ENDIF
+ END DO
END DO
- END DO
-
- DEALLOCATE (v3d)
-
- ! Working on temperature first
- ALLOCATE( ztempint(npiglo, npjglo), zint(npiglo, npjglo), pint(npiglo, npjglo) )
- ALLOCATE( ztemp3(npiglo, npjglo,npk) )
-
- DO jk=1,npk
- ztemp3(:,:,jk) = getvar(cfilet, 'votemper', jk ,npiglo, npjglo, ktime=jt)
- ENDDO
-
- DO ji=1,npiglo
- DO jj=1,npjglo
- ! k0 is retrieved from alpha, taking the integer part.
- ! The remnant is alpha.
- k0=INT(alpha(ji,jj))
- alpha(ji,jj) = alpha(ji,jj) - k0
- IF (k0 /= 0) THEN
- P1=ztemp3(ji,jj,k0)
- P2=ztemp3(ji,jj,k0+1)
- IF (P1 /= spval .AND. P2 /= spval) THEN
- ztempint(ji,jj) = alpha(ji,jj)*P2 &
- & +(1-alpha(ji,jj))*P1
- zint(ji,jj) = alpha(ji,jj)*prof(k0+1) &
- & +(1-alpha(ji,jj))*prof(k0)
+ DEALLOCATE (v3d)
+
+ ! Working on temperature first
+ ALLOCATE( ztempint(npiglo, npjglo), zint(npiglo, npjglo), pint(npiglo, npjglo) )
+ ALLOCATE( ztemp3(npiglo, npjglo,npk) )
+
+ DO jk=1,npk
+ ztemp3(:,:,jk) = getvar(cf_tfil, cn_votemper, jk ,npiglo, npjglo, ktime=jt)
+ ENDDO
+
+ DO ji=1,npiglo
+ DO jj=1,npjglo
+ ! ik0 is retrieved from alpha, taking the integer part.
+ ! The remnant is alpha.
+ ik0=INT(alpha(ji,jj))
+ alpha(ji,jj) = alpha(ji,jj) - ik0
+ IF (ik0 /= 0) THEN
+ P1=ztemp3(ji,jj,ik0)
+ P2=ztemp3(ji,jj,ik0+1)
+ IF (P1 /= zspval .AND. P2 /= zspval) THEN
+ ztempint(ji,jj) = alpha(ji,jj) * P2 + (1-alpha(ji,jj)) * P1
+ zint(ji,jj) = alpha(ji,jj) * prof(ik0+1) + (1-alpha(ji,jj)) * prof(ik0)
+ ELSE
+ ztempint(ji,jj) = zspval
+ zint(ji,jj) = zspval
+ ENDIF
ELSE
- ztempint(ji,jj)=spval
- zint (ji,jj)=spval
+ ztempint(ji,jj) = zspval
+ zint(ji,jj) = zspval
ENDIF
- ELSE
- ztempint(ji,jj)=spval
- zint (ji,jj)=spval
- ENDIF
- ! re-add k0 to alpha for the next computation
- alpha(ji,jj) = alpha(ji,jj) + k0
+ ! re-add ik0 to alpha for the next computation
+ alpha(ji,jj) = alpha(ji,jj) + ik0
+ END DO
END DO
- END DO
-
- pint = zint / 10. ! pressure on the isopycnal layer = depth / 10.
-
- ierr = putvar(ncout, id_varout(1) ,ztempint, 1,npiglo, npjglo,ktime=jt)
- ierr = putvar(ncout, id_varout(3) ,zint, 1,npiglo, npjglo,ktime=jt)
-
- ! Working on salinity
- DEALLOCATE( ztemp3 )
- ALLOCATE( zsalint(npiglo, npjglo) )
- ALLOCATE( zsal3(npiglo, npjglo,npk) )
-
- DO jk=1,npk
- zsal3(:,:,jk) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo, ktime=jt)
- ENDDO
-
- DO ji=1,npiglo
- DO jj=1,npjglo
- ! k0 is retrieved from alpha, taking the integer part.
- ! The remnant is alpha.
- k0=INT(alpha(ji,jj))
- alpha(ji,jj) = alpha(ji,jj) - k0
- IF (k0 /= 0) THEN
- P1=zsal3(ji,jj,k0)
- P2=zsal3(ji,jj,k0+1)
- IF (P1 /= spval .AND. P2 /= spval) THEN
- zsalint(ji,jj) = alpha(ji,jj)*P2 &
- & +(1-alpha(ji,jj))*P1
+
+ pint = zint / 10. ! pressure on the isopycnal layer = depth / 10.
+
+ ierr = putvar(ncout, id_varout(1), ztempint, 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(3), zint, 1, npiglo, npjglo, ktime=jt)
+ DEALLOCATE( ztemp3 )
+
+ ! Working on salinity
+ ALLOCATE( zsalint(npiglo, npjglo) )
+ ALLOCATE( zsal3(npiglo, npjglo,npk) )
+
+ DO jk=1,npk
+ zsal3(:,:,jk) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt)
+ ENDDO
+
+ DO ji=1,npiglo
+ DO jj=1,npjglo
+ ! ik0 is retrieved from alpha, taking the integer part.
+ ! The remnant is alpha.
+ ik0=INT(alpha(ji,jj))
+ alpha(ji,jj) = alpha(ji,jj) - ik0
+ IF (ik0 /= 0) THEN
+ P1=zsal3(ji,jj,ik0)
+ P2=zsal3(ji,jj,ik0+1)
+ IF (P1 /= zspval .AND. P2 /= zspval) THEN
+ zsalint(ji,jj) = alpha(ji,jj) * P2 + (1-alpha(ji,jj)) * P1
+ ELSE
+ zsalint(ji,jj) = zspval
+ ENDIF
ELSE
- zsalint(ji,jj)=spval
+ zsalint(ji,jj) = zspval
ENDIF
- ELSE
- zsalint(ji,jj)=spval
- ENDIF
- ! re-add k0 to alpha for the next computation
- alpha(ji,jj) = alpha(ji,jj) + k0
+ ! re-add ik0 to alpha for the next computation
+ alpha(ji,jj) = alpha(ji,jj) + ik0
+ END DO
END DO
- END DO
-
- ierr = putvar(ncout, id_varout(2) ,zsalint, 1,npiglo, npjglo,ktime=jt)
- DEALLOCATE( zsal3 )
-
- ! 3. Compute means for T,S and depth on the isopycnal layer
-
- ALLOCATE( zmask(npiglo, npjglo) )
- zmask=1. ! define a new mask which correspond to the isopycnal layer
- WHERE( zint == 0. ) zmask = 0.
-
- tmean = SUM( ztempint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask )
- smean = SUM( zsalint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask )
- hmean = SUM( zint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask )
- pmean = SUM( pint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask )
-
- DEALLOCATE ( ztempint, zsalint )
-
- ! 4. Compute specific volume anomaly
- ALLOCATE( sva3(npiglo,npjglo,npk) )
- ALLOCATE( zsiginsitu(npiglo,npjglo), zsig0(npiglo,npjglo) )
- ALLOCATE( ztemp(npiglo,npjglo), zsal(npiglo,npjglo) )
- ALLOCATE( ztemp0(npiglo,npjglo), zsal0(npiglo,npjglo) )
-
- DO jk=1,npk
-
- ztemp(:,:) = getvar(cfilet, 'votemper', jk ,npiglo, npjglo,ktime=jt)
- zsal (:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo,ktime=jt)
-
- ztemp0(:,:) = tmean
- zsal0 (:,:) = smean
-
- ! again land/sea mask
- zmask (:,:) = 1.
- WHERE( zsal == spval ) zmask = 0.
- zsiginsitu(:,:) = sigmai ( ztemp , zsal , prof(jk),npiglo,npjglo ) * zmask(:,:) ! in-situ density
- zsig0(:,:) = sigmai ( ztemp0, zsal0, prof(jk),npiglo,npjglo ) * zmask(:,:) ! density of reference profile
-
- sva3(:,:,jk) = ( 1. / zsiginsitu(:,:) ) - ( 1. / zsig0(:,:) )
-
- ENDDO
-
- DEALLOCATE( zsiginsitu, zsig0, ztemp0, zsal0 )
-
- ! 5. Integrates from surface to depth of isopycnal layer
- ALLOCATE( zdep(npiglo, npjglo), deltapsi1(npiglo, npjglo) )
-
- deltapsi1(:,:) = 0.
-
- DO jk=1, npk
-
- zdep(:,:) = getvar(coordzgr, 'e3t_ps', jk,npiglo,npjglo,ldiom=.true.)
-
- ! For each point we integrate from surface to zint(ji,jj) which is the depth
- ! of the isopycnal layer
-
- ! If isopycnal layer depth is below the current level
- WHERE( zint >= prof(jk) ) deltapsi1 = deltapsi1 - sva3(:,:,jk) * zdep / 10.
- ! If isopycnal layer is between current level and previous level
- WHERE( zint < prof(jk) .AND. zint > prof(jk-1) ) deltapsi1 = deltapsi1 &
- & - sva3(:,:,jk) * ( zint - prof(jk-1) ) / 10.
-
- ENDDO
-
- ierr = putvar(ncout, id_varout(6) ,deltapsi1, 1,npiglo, npjglo,ktime=jt)
-
- DEALLOCATE( zdep )
-
- ! 6. Projection of the specific volume anomaly on the isopycnal layer
- ALLOCATE( sva2(npiglo,npjglo), deltapsi2(npiglo,npjglo) )
-
- DO ji=1,npiglo
- DO jj=1,npjglo
- ! k0 is retrieved from alpha, taking the integer part.
- ! The remnant is alpha.
- k0=INT(alpha(ji,jj))
- alpha(ji,jj) = alpha(ji,jj) - k0
- IF (k0 /= 0) THEN
- P1=sva3(ji,jj,k0)
- P2=sva3(ji,jj,k0+1)
- IF (P1 /= spval .AND. P2 /= spval) THEN
- sva2(ji,jj) = alpha(ji,jj)*P2 &
- & +(1-alpha(ji,jj))*P1
+ ierr = putvar(ncout, id_varout(2), zsalint, 1, npiglo, npjglo, ktime=jt)
+ DEALLOCATE( zsal3 )
+
+ ! 3. Compute means for T,S and depth on the isopycnal layer
+ ALLOCATE( zmask(npiglo, npjglo) )
+ zmask=1. ! define a new mask which correspond to the isopycnal layer
+ WHERE( zint == 0. ) zmask = 0.
+
+ ztmean = SUM( ztempint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask )
+ zsmean = SUM( zsalint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask )
+ ! JMM rem : hmean never used ...
+ ! hmean = SUM( zint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask )
+ pmean = SUM( pint * e1t * e2t * zmask ) / SUM( e1t * e2t * zmask )
+
+ DEALLOCATE ( ztempint, zsalint )
+
+ ! 4. Compute specific volume anomaly
+ ALLOCATE( zsva3(npiglo,npjglo,npk) )
+ ALLOCATE( zsiginsitu(npiglo,npjglo), zsig0(npiglo,npjglo) )
+ ALLOCATE( ztemp(npiglo,npjglo), zsal(npiglo,npjglo) )
+ ALLOCATE( ztemp0(npiglo,npjglo), zsal0(npiglo,npjglo) )
+
+ DO jk=1,npk
+ ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt)
+ zsal (:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt)
+
+ ztemp0(:,:) = ztmean
+ zsal0 (:,:) = zsmean
+
+ ! again land/sea mask
+ zmask (:,:) = 1.
+ WHERE( zsal == zspval ) zmask = 0.
+
+ zsiginsitu(:,:) = sigmai ( ztemp, zsal, prof(jk), npiglo, npjglo ) * zmask(:,:) ! in-situ density
+ zsig0(:,:) = sigmai ( ztemp0, zsal0, prof(jk), npiglo, npjglo ) * zmask(:,:) ! density of reference profile
+
+ zsva3(:,:,jk) = ( 1. / zsiginsitu(:,:) ) - ( 1. / zsig0(:,:) )
+ ENDDO
+
+ DEALLOCATE( zsiginsitu, zsig0, ztemp0, zsal0 )
+
+ ! 5. Integrates from surface to depth of isopycnal layer
+ ALLOCATE( zdep(npiglo, npjglo), rdeltapsi1(npiglo, npjglo) )
+
+ rdeltapsi1(:,:) = 0.
+ DO jk=1, npk
+ zdep(:,:) = getvar(cn_fzgr, 'e3t_ps', jk,npiglo,npjglo,ldiom=.TRUE.)
+
+ ! For each point we integrate from surface to zint(ji,jj) which is the depth
+ ! of the isopycnal layer
+
+ ! If isopycnal layer depth is below the current level
+ WHERE( zint >= prof(jk) ) rdeltapsi1 = rdeltapsi1 - zsva3(:,:,jk) * zdep / 10.
+ ! If isopycnal layer is between current level and previous level
+ WHERE( zint < prof(jk) .AND. zint > prof(jk-1) ) rdeltapsi1 = rdeltapsi1 &
+ & - zsva3(:,:,jk) * ( zint - prof(jk-1) ) / 10.
+ ENDDO
+ ierr = putvar(ncout, id_varout(6), rdeltapsi1, 1, npiglo, npjglo, ktime=jt)
+ DEALLOCATE( zdep )
+
+ ! 6. Projection of the specific volume anomaly on the isopycnal layer
+ ALLOCATE( zsva2(npiglo,npjglo), rdeltapsi2(npiglo,npjglo) )
+
+ DO ji=1,npiglo
+ DO jj=1,npjglo
+ ! ik0 is retrieved from alpha, taking the integer part.
+ ! The remnant is alpha.
+ ik0=INT(alpha(ji,jj))
+ alpha(ji,jj) = alpha(ji,jj) - ik0
+ IF (ik0 /= 0) THEN
+ P1=zsva3(ji,jj,ik0)
+ P2=zsva3(ji,jj,ik0+1)
+ IF (P1 /= zspval .AND. P2 /= zspval) THEN
+ zsva2(ji,jj) = alpha(ji,jj) * P2 + ( 1-alpha(ji,jj) ) * P1
+ ELSE
+ zsva2(ji,jj) = zspval
+ ENDIF
ELSE
- sva2(ji,jj)=spval
+ zsva2(ji,jj) = zspval
ENDIF
- ELSE
- sva2(ji,jj)=spval
- ENDIF
- ! re-add k0 to alpha for the next computation
- alpha(ji,jj) = alpha(ji,jj) + k0
+ ! re-add ik0 to alpha for the next computation
+ alpha(ji,jj) = alpha(ji,jj) + ik0
+ END DO
END DO
- END DO
-
- deltapsi2 = ( pint - pmean ) * sva2
-
- ierr = putvar(ncout, id_varout(7) ,deltapsi2, 1,npiglo, npjglo,ktime=jt)
- DEALLOCATE ( sva3, sva2, alpha, zint, pint )
+ rdeltapsi2 = ( pint - pmean ) * zsva2
+ ierr = putvar(ncout, id_varout(7), rdeltapsi2, 1, npiglo, npjglo, ktime=jt)
+ DEALLOCATE ( zsva3, zsva2, alpha, zint, pint )
- ! 6. Finally we compute the surface streamfunction
+ ! 6. Finally we compute the surface streamfunction
+ ALLOCATE(zssh(npiglo,npjglo) , zsigsurf(npiglo,npjglo), psi0(npiglo,npjglo) )
- ALLOCATE(zssh(npiglo,npjglo) , zsigsurf(npiglo,npjglo), psi0(npiglo,npjglo) )
-
- ztemp (:,:) = getvar(cfilet, 'votemper', 1 ,npiglo, npjglo,ktime=jt)
- zsal (:,:) = getvar(cfilet, 'vosaline', 1 ,npiglo, npjglo,ktime=jt)
- zssh (:,:) = getvar(cfilet, 'sossheig', 1 ,npiglo, npjglo,ktime=jt)
+ ztemp (:,:) = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=jt)
+ zsal (:,:) = getvar(cf_tfil, cn_vosaline, 1, npiglo, npjglo, ktime=jt)
+ zssh (:,:) = getvar(cf_tfil, cn_sossheig, 1, npiglo, npjglo, ktime=jt)
- ! land/sea mask at surface
- zmask (:,:) = 1.
- WHERE( zsal == spval ) zmask = 0.
-
- zsigsurf(:,:) = sigmai ( ztemp,zsal,prof(1),npiglo,npjglo ) * zmask(:,:)
-
- psi0 = zsigsurf * zssh * (9.81 / 1020. )
- ierr = putvar(ncout, id_varout(5) ,psi0, 1,npiglo, npjglo,ktime=jt)
-
- DEALLOCATE(zssh, zsigsurf, ztemp, zsal )
-
- ! 7. At least we are done with the computations
- ALLOCATE( psi(npiglo,npjglo) )
+ ! land/sea mask at surface
+ zmask (:,:) = 1.
+ WHERE( zsal == zspval ) zmask = 0.
- ! final mask for output : mask the contribution of SSH where isopycn outcrops
- zmask=1.
- WHERE(deltapsi1 == spval ) zmask = 0.
- psi = ( psi0 * zmask ) + deltapsi1 + deltapsi2
+ zsigsurf(:,:) = sigmai ( ztemp, zsal, prof(1), npiglo, npjglo ) * zmask(:,:)
- ierr = putvar(ncout, id_varout(4) ,psi, 1,npiglo, npjglo,ktime=jt)
+ psi0 = zsigsurf * zssh * (9.81 / 1020. )
+ ierr = putvar(ncout, id_varout(5), psi0, 1, npiglo, npjglo, ktime=jt)
+ DEALLOCATE(zssh, zsigsurf, ztemp, zsal )
- DEALLOCATE( psi, psi0, deltapsi1, deltapsi2, zmask )
+ ! 7. At least we are done with the computations
+ ALLOCATE( psi(npiglo,npjglo) )
+ ! final mask for output : mask the contribution of SSH where isopycn outcrops
+ zmask=1.
+ WHERE(rdeltapsi1 == zspval ) zmask = 0.
+ psi = ( psi0 * zmask ) + rdeltapsi1 + rdeltapsi2
+ ierr = putvar(ncout, id_varout(4), psi, 1, npiglo, npjglo, ktime=jt)
+ DEALLOCATE( psi, psi0, rdeltapsi1, rdeltapsi2, zmask )
END DO ! loop to next time
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
END PROGRAM cdfisopsi
diff --git a/cdfisopycdep.f90 b/cdfisopycdep.f90
deleted file mode 100644
index 540240d..0000000
--- a/cdfisopycdep.f90
+++ /dev/null
@@ -1,182 +0,0 @@
-PROGRAM cdfisopycdep
- !! --------------------------------------------------------------
- !! *** PROGRAM cdfisopycdep ***
- !! ** Purpose: This program is used to determine the depth of isopycnal
- !!
- !! ** Method: Linear interpolation is used on the vertical to define
- !! the depth of the given isopycn.
- !!
- !! ** Usage :
- !! cdfisopycdep [-s sigma] 'rho file' cdfsigmavar
- !!
- !! * history:
- !! Original : J.M. Molines for SPEM in Dynamo (1996)
- !! Modif : J-O. Beismann for OPA (1999)
- !! Modif : J.M. Molines for normalization Clipper (March 2000)
- !! : J.M. Molines in cdftools, f90 dor DRAKKAR (Nov. 2005)
- !! ---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- !! * Used modules
- USE cdfio
-
- !! * Local declaration
- IMPLICIT NONE
-
- INTEGER :: npiglo, npjglo, npk, npkk ,npt
- INTEGER :: narg, iargc
- INTEGER :: ji,jj,jk,jkk,k0
- INTEGER :: istartarg = 1
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(1) :: ipk, id_varout !: for output variables
- !
- REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d, alpha
- REAL(KIND=4), DIMENSION(:,:) , ALLOCATABLE :: zint
- REAL(KIND=4), DIMENSION(:) , ALLOCATABLE :: zi, time_tag, h1d
- REAL(KIND=4) :: P1,P2
- REAL(KIND=4) :: spval=999999.
- REAL(KIND=4) :: spvalz=0.
-
- CHARACTER(LEN=256) :: cline, cfilZI, cfilsigma, cvar, cfilout
-
- TYPE(variable), DIMENSION(1) :: typvar !: structure for attributes
- !
- LOGICAL :: lsingle=.false.
-
- !! * Read command line
- narg=iargc()
- IF (narg < 2 ) THEN
- PRINT *, &
- &' >>>> usage: cdfisopycdep [-s sigma ] <rhofile> <cdfsigmavar> '
- PRINT *,' Deptht of isopycnal surfaces will be in isopycdep.nc'
- PRINT *,' Isopycnal value are read on a text file ''rho_lev'' '
- PRINT *,' unless the option -s is specified with one particular value.'
- PRINT *,' Model density are taken on file ''rhofile'' with name cdfsigmavar'
- PRINT *,' Output done on isopycdep.nc, var vodepiso'
- STOP
- ENDIF
- ! seek a -s option
- CALL getarg(1,cline)
- IF (cline == '-s' ) THEN
- npkk = 1
- lsingle=.true.
- istartarg = 3
- CALL getarg(2,cline)
- ALLOCATE (zi(npkk) )
- READ(cline,*) zi(1)
- END IF
- ! read ZI if not single
- IF ( .NOT. lsingle ) THEN
- cfilZI='rho_lev'
- OPEN(10,file=cfilZI)
- READ(10,*) npkk
- ALLOCATE (zi(npkk) )
- DO jkk=1,npkk
- READ(10,*) zi(jkk)
- PRINT *,zi(jkk)
- END DO
- CLOSE(10)
- ENDIF
-
- ! Read Rho file
- CALL getarg(istartarg,cfilsigma)
- npiglo=getdim(cfilsigma,'x')
- npjglo=getdim(cfilsigma,'y')
- npk =getdim(cfilsigma,'depth')
- npt =getdim(cfilsigma,'time')
-
- ! Read variable name
- CALL getarg(istartarg+1,cvar)
-
-
- ALLOCATE( v3d(npiglo,npjglo,npk), alpha(npiglo, npjglo, npkk) )
- ALLOCATE( zint(npiglo,npjglo) )
- ALLOCATE( time_tag(npt), h1d(npk) )
-
- time_tag(:)=getvar1d(cfilsigma,'time_counter', npt)
- h1d(:)=getvar1d(cfilsigma,'deptht',npk)
-
- DO jk=1,npk
- v3d(:,:,jk) = getvar(cfilsigma,cvar,jk,npiglo,npjglo)
- END DO
-
- !! ** Compute interpolation coefficients as well as the level used
- !! to interpolate between
- DO ji=1,npiglo
- DO jj = 1, npjglo
- jk = 1
- DO jkk=1,npkk
- ! Assume that rho (z) is increasing downward (no inversion)
- ! Caution with sigma0 at great depth !
- DO WHILE (zi(jkk) >= v3d(ji,jj,jk) .AND. jk <= npk &
- & .AND. v3d(ji,jj,jk) /= spvalz )
- jk=jk+1
- END DO
- jk=jk-1
- k0=jk
- IF (jk .EQ. 0) THEN
- jk=1
- alpha(ji,jj,jkk) = 0.
- ELSE IF (v3d(ji,jj,jk+1) .EQ. spvalz ) THEN
- k0=0
- alpha(ji,jj,jkk) = 0.
- ELSE
- ! ... alpha is always in [0,1]. Adding k0 ( >=1 ) for saving space for k0
- alpha(ji,jj,jkk)= &
- & (zi(jkk)-v3d(ji,jj,jk))/(v3d(ji,jj,jk+1)-v3d(ji,jj,jk)) +k0
- ENDIF
- END DO
- END DO
- END DO
-
-
- ! ... open output file and write header
- ipk(:)=npkk
-
- typvar(1)%name= 'vodepiso'
- typvar(1)%units='m'
- typvar(1)%missing_value=999999.
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 7000.
- typvar(1)%long_name='Depth_of_Isopycnals'
- typvar(1)%short_name='vodepiso'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TRYX'
-
-
- cfilout='isopycdep.nc'
-
- ncout = create(cfilout,cfilsigma ,npiglo,npjglo,npkk)
- ierr = createvar(ncout, typvar,1,ipk, id_varout )
- ierr = putheadervar(ncout , cfilsigma, npiglo, npjglo, npkk,pdep=zi)
-
- DO jkk=1,npkk
- DO ji=1,npiglo
- DO jj=1,npjglo
- ! k0 is retrieved from alpha, taking the integer part.
- ! The remnant is alpha.
- k0=INT(alpha(ji,jj,jkk))
- alpha(ji,jj,jkk) = alpha(ji,jj,jkk) - k0
- IF (k0 /= 0) THEN
- P1=v3d(ji,jj,k0)
- P2=v3d(ji,jj,k0+1)
- IF (P1 /= spvalz .AND. P2 /= spvalz) THEN
- zint (ji,jj)=alpha(ji,jj,jkk)*h1d(k0+1) &
- & +(1-alpha(ji,jj,jkk))*h1d(k0)
- ELSE
- zint (ji,jj)=spval
- ENDIF
- ELSE
- zint (ji,jj)=spval
- ENDIF
- END DO
- END DO
- ierr = putvar(ncout,id_varout(1), zint ,jkk,npiglo,npjglo)
- END DO
- ierr = putvar1d(ncout,time_tag,1,'T')
- ierr = closeout(ncout)
- PRINT *,'Projection on isopycns completed successfully'
-END PROGRAM cdfisopycdep
diff --git a/cdfkempemekeepe.f90 b/cdfkempemekeepe.f90
index bb82c6e..0226b9d 100644
--- a/cdfkempemekeepe.f90
+++ b/cdfkempemekeepe.f90
@@ -1,132 +1,137 @@
PROGRAM cdfkempemekeepe
- !!---------------------------------------------------------------------------
- !! *** PROGRAM cdfkempemekeepe ***
+ !!======================================================================
+ !! *** PROGRAM cdfkempemekeepe ***
+ !!=====================================================================
+ !! ** Purpose : Compute the term of energetic transfert from mean kinetic
+ !! energy to mean potential energy (T1) and from eddy
+ !! potential energy to eddy kinetic energy (T3)
!!
- !! ** Purpose: Compute the term of energetic transfert
- !! from mean kinetic energy to mean potential energy (T1)
- !! and from eddy potential energy to eddy kinetic energy (T3)
- !!
- !! history :
- !! Original : A. Melet (Mar 2008)
- !!---------------------------------------------------------------------
- !!--------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
-
+ !! History : 2.1 : 03/2008 : A. Melet : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, jt, ilev, jmin
- INTEGER :: npiglo, npjglo, npk, nt
- INTEGER :: kimin,imin,kkmin,ktime
- INTEGER :: narg, iargc, ncout, ierr
- INTEGER, DIMENSION(2) :: ipk, id_varout !
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: t1mask,w1mask,txz,wxz
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: wtxz,wbartbarxz,anowtxz
- REAL(kind=4), DIMENSION(:,:,:), ALLOCATABLE :: wbartbar,anowt
- REAL(KIND=4) ,DIMENSION(1) :: tim
+ INTEGER(KIND=4) :: jj, jk ! dummy loop index
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: narg, iargc ! browse line
+ INTEGER(KIND=4) :: ncout, ierr ! ncid of outputfile, error status
+ INTEGER(KIND=4), DIMENSION(2) :: ipk, id_varout ! levels and varid's of output vars
+
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: wbartbar
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: anowt
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: t1mask
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: w1mask
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: txz
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: wxz
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: wtxz
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: wbartbarxz
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: anowtxz
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter (dummy)
+
+ CHARACTER(LEN=256) :: cf_uvwtfil ! input file
+ CHARACTER(LEN=256) :: cf_out='transfertst1t3.nc'
+
+ TYPE (variable), DIMENSION(2) :: stypvar ! structure for attibutes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- CHARACTER(LEN=256) :: cfile
- CHARACTER(LEN=256) :: cfileout='transfertst1t3.nc'
- TYPE (variable), DIMENSION(2) :: typvar !: structure for attibutes
-
- !!
narg = iargc()
IF ( narg /= 1 ) THEN
- PRINT *,' USAGE : cdfkempemekeepe file'
- PRINT *,' Produce a cdf file transfertst1t3.nc with wT and anowT variables'
- PRINT *,' file is from cdfmoyuvwt'
- PRINT *,' the mean must have been computed on a period long enough'
- PRINT *,' for the statistics to be meaningful'
+ PRINT *,'usage : cdfkempemekeepe file'
+ PRINT *,' Produce a cdf file transfertst1t3.nc with wT and anowT variables'
+ PRINT *,' file is from cdfmoyuvwt'
+ PRINT *,' the mean must have been computed on a period long enough'
+ PRINT *,' for the statistics to be meaningful'
PRINT *,' '
- PRINT *,' if file is in grid B or C, check the code (PM)'
STOP
ENDIF
- CALL getarg(1, cfile)
- npiglo = getdim(cfile,'x')
- npjglo = getdim(cfile,'y')
- npk = getdim(cfile,'depth')
- nt = getdim(cfile,'time_counter')
+ CALL getarg(1, cf_uvwtfil)
- PRINT *, 'npiglo =',npiglo
- PRINT *, 'npjglo =',npjglo
- PRINT *, 'npk =',npk
- PRINT *, 'nt =',nt
+ IF (chkfile(cf_uvwtfil) ) STOP ! missing file
+ npiglo = getdim(cf_uvwtfil, cn_x)
+ npjglo = getdim(cf_uvwtfil, cn_y)
+ npk = getdim(cf_uvwtfil, cn_z)
+ npt = getdim(cf_uvwtfil, cn_t)
- ! define new variables for output ( must update att.txt)
- typvar(1)%name='wT'
- typvar(1)%long_name='temporal mean of w times temporal mean of T on T point (*1000)'
- typvar(1)%short_name='wT'
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
- typvar(2)%name='anowT'
- typvar(2)%long_name='temporal mean of anomaly of w times ano of T on T point (*1000)'
- typvar(2)%short_name='anowT'
+ ! define new variables for output ( must update att.txt)
+ ipk(:) = npk
+ stypvar(1)%cname = 'wT'
+ stypvar(1)%clong_name = 'temporal mean of w times temporal mean of T on T point (*1000)'
+ stypvar(1)%cshort_name = 'wT'
+
+ stypvar(2)%cname = 'anowT'
+ stypvar(2)%clong_name = 'temporal mean of anomaly of w times ano of T on T point (*1000)'
+ stypvar(2)%cshort_name = 'anowT'
- typvar%units='1000 m.K'
- typvar%missing_value=0.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar%online_operation='N/A'
- typvar%axis='TYX'
-
- ipk(:) = npk
+ stypvar%cunits = '1000 m.K'
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = -1000.
+ stypvar%valid_max = 1000.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TYX'
- !test if lev exists
- IF ((npk==0) .AND. (ilev .GT. 0) ) THEN
- PRINT *, 'Problem : npk = 0 and lev > 0 STOP'
- STOP
- END IF
-
! create output fileset
- ncout =create(cfileout, cfile, npiglo,npjglo,npk)
- ierr= createvar(ncout ,typvar,2, ipk,id_varout )
- ierr= putheadervar(ncout, cfile, npiglo, npjglo,npk)
+ ncout = create (cf_out, cf_uvwtfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 2, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_uvwtfil, npiglo, npjglo, npk )
! Allocate the memory
- ALLOCATE ( t1mask(npiglo,npk) , w1mask(npiglo,npk) )
- ALLOCATE ( txz(npiglo,npk) , wxz(npiglo,npk) )
- ALLOCATE ( wtxz(npiglo,npk) )
- ALLOCATE ( wbartbarxz(npiglo,npk), anowtxz(npiglo,npk) )
- ALLOCATE ( wbartbar(npiglo, npjglo, npk) )
- ALLOCATE ( anowt(npiglo, npjglo, npk) )
+ ALLOCATE ( wbartbar( npiglo, npjglo, npk) ) ! 3D can be huge !
+ ALLOCATE ( anowt( npiglo, npjglo, npk) ) ! 3D can be huge
+ ALLOCATE ( t1mask( npiglo,npk) )
+ ALLOCATE ( w1mask( npiglo,npk) )
+ ALLOCATE ( txz( npiglo,npk) )
+ ALLOCATE ( wxz( npiglo,npk) )
+ ALLOCATE ( wtxz( npiglo,npk) )
+ ALLOCATE ( anowtxz( npiglo,npk) )
+ ALLOCATE ( wbartbarxz(npiglo,npk) )
+ ALLOCATE ( tim(npt) )
- tim=getvar1d(cfile,'time_counter',nt)
- ierr=putvar1d(ncout,tim,1,'T')
+ tim = getvar1d(cf_uvwtfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
DO jj = 1, npjglo
- print*, 'jj : ',jj
- wbartbarxz(:,:) = 0.d0
- anowtxz(:,:) = 0.d0
- wtxz(:,:) = 0.d0
- wxz(:,:) = 0.d0
- txz(:,:) = 0.d0
+ wbartbarxz(:,:) = 0.0
+ anowtxz(:,:) = 0.0
+ wtxz(:,:) = 0.0
+ wxz(:,:) = 0.0
+ txz(:,:) = 0.0
- txz(:,:) = getvarxz(cfile,'tbar',jj,npiglo,npk,kimin=1,kkmin=1,ktime=1)
- wxz(:,:) = getvarxz(cfile,'wbar',jj,npiglo,npk,kimin=1,kkmin=1,ktime=1)
- wtxz(:,:)= getvarxz(cfile,'wtbar',jj,npiglo,npk,kimin=1,kkmin=1,ktime=1)
+ txz( :,:) = getvarxz(cf_uvwtfil, 'tbar', jj, npiglo, npk, kimin=1, kkmin=1, ktime=1)
+ wxz( :,:) = getvarxz(cf_uvwtfil, 'wbar', jj, npiglo, npk, kimin=1, kkmin=1, ktime=1)
+ wtxz(:,:) = getvarxz(cf_uvwtfil, 'wtbar', jj, npiglo, npk, kimin=1, kkmin=1, ktime=1)
DO jk=1, npk-1
w1mask(:,jk) = wxz(:,jk) * wxz(:,jk+1)
t1mask(:,jk) = txz(:,jk)
WHERE ( w1mask(:,jk) /= 0.) w1mask(:,jk)=1.
WHERE ( t1mask(:,jk) /= 0.) t1mask(:,jk)=1.
- wbartbarxz(:,jk) = 1000 * t1mask(:,jk) * txz(:,jk) &
- & * 0.5 * w1mask(:,jk) * ( wxz(:,jk) + wxz(:,jk+1) )
- anowtxz(:,jk) = 1000 * ( wtxz(:,jk) - wbartbarxz(:,jk)*0.001 )
+ wbartbarxz(:,jk) = 1000. * t1mask(:,jk) * txz(:,jk) * 0.5 * w1mask(:,jk) * ( wxz(:,jk) + wxz(:,jk+1) )
+ anowtxz( :,jk) = 1000. * ( wtxz(:,jk) - wbartbarxz(:,jk)*0.001 )
END DO
wbartbar(:,jj,:) = wbartbarxz(:,:)
- anowt(:,jj,:) = anowtxz(:,:)
+ anowt( :,jj,:) = anowtxz( :,:)
END DO
DO jk=1,npk
- ierr = putvar(ncout, id_varout(1) ,wbartbar(:,:,jk), jk, npiglo, npjglo )
- ierr = putvar(ncout, id_varout(2) ,anowt(:,:,jk), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout(1), wbartbar(:,:,jk), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout(2), anowt( :,:,jk), jk, npiglo, npjglo )
END DO
+
ierr = closeout(ncout)
END PROGRAM cdfkempemekeepe
diff --git a/cdflinreg.f90 b/cdflinreg.f90
index 350b7fc..9e76b11 100644
--- a/cdflinreg.f90
+++ b/cdflinreg.f90
@@ -1,250 +1,262 @@
PROGRAM cdflinreg
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdflinreg ***
+ !!======================================================================
+ !! *** PROGRAM cdflinreg ***
+ !!=====================================================================
+ !! ** Purpose : Compute linear regression coef from a bunch of input
+ !! cdf files given as argument.
+ !! Store the results on a 'similar' cdf file.
!!
- !! ** Purpose: Compute linear regression coef from a bunch of input files.
- !! of cdf files given as argument
- !! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: compute a and b such as yr = a . t + b
+ !! ** Method : compute a and b such as yr = a . t + b
!! yr is the estimation of the field value, t is the time (in days ).
!! a= cov(y,t) / var(t)
- !! b= moy(y) - a . moy(t)
+ !! b= moy(y) - a . moy(t)
!! R2 pearson value [0,1], giving the quality of the adjustment is also given
!! R2= a*a*var(t)/var(y)
- !! cov(y,t)= moy(y*t) - moy(y)*moy(t)
- !! var(t) = moy(t*t) - moy(t)*moy(t)
- !! var(y) = moy(y*y) - moy(y)*moy(y)
+ !! cov(y,t)= moy(y*t) - moy(y)*moy(t)
+ !! var(t) = moy(t*t) - moy(t)*moy(t)
+ !! var(y) = moy(y*y) - moy(y)*moy(y)
!!
- !! history :
- !! Original code : J.M. Molines (Jan 2008 ) from cdfmoy
- !!
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
+ !! History : 2.1 : 01/2008 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
!!--------------------------------------------------------------
-
USE cdfio
-
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER, PARAMETER :: jptmax=365 !: maximum number of time frame
- INTEGER :: jk,jt,jvar, jv , jtt,jkk !: dummy loop index
- INTEGER :: ierr, ijvar !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER :: ntframe !: Cumul of time frame
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & ipk2 , & !: arrays of vertical level for each var
- & id_varout,&
- & id_varout2
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: zy, zyy, zyt !: Arrays for cumulated values
- REAL(KIND=8) :: zt, zt2 !: variables for cumulated time values
- REAL(KIND=8) :: total_time
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean, rmean2,rmean3, &
- & areg, breg, rpear !: slope, origin ordinate, pearson coef
- REAL(KIND=4),DIMENSION(2) :: timean !: trick : timean(1) hold moy(t) (days)
- !: timean(2) hold moy(t2) (days)**2
- REAL(KIND=4),DIMENSION(365) :: tim
- REAL(KIND=4) :: spval = -99999.
-
- CHARACTER(LEN=256) :: cfile ,cfileout, cfileout2 !: file name
- CHARACTER(LEN=256) :: cdep
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname2 !: array of var22 name for output
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar, typvar2
-
- INTEGER :: ncout, ncout2
- INTEGER :: istatus
- LOGICAL :: lcaltmean
- !!
+ INTEGER(KIND=4), PARAMETER :: jptmax=365 ! maximum number of time frame
+ INTEGER(KIND=4) :: jk, jfil, jvar, jv, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr, ijvar ! working integer
+ INTEGER(KIND=4) :: narg, iargc !
+ INTEGER(KIND=4) :: npiglo, npjglo, npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvars ! Number of variables in a file
+ INTEGER(KIND=4) :: ntframe ! Cumul of time frame
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipki ! arrays of vertical level for each var
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipko ! arrays of vertical level for each var
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! id of output variable
+
+ REAL(KIND=4) :: zspval = -99999. ! special value/ missing value
+ REAL(KIND=4), DIMENSION(2) :: timean ! trick : timean(1) hold moy(t) (days)
+ ! ! timean(2) hold moy(t2) (days)**2
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ REAL(KIND=8) :: dt, dt2 ! variables for cumulated time values
+ REAL(KIND=8) :: dtotal_time ! cumulated time
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dy, dyy, dyt ! Arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dv2d ! Array to read a layer of data
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmean, dmean2, dmean3 !
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dareg, dbreg, dpear ! slope, origin ordinate, pearson coef
+
+ CHARACTER(LEN=256) :: cf_in ! file names
+ CHARACTER(LEN=256) :: cf_out='linreg.nc' ! file names
+ CHARACTER(LEN=256) :: cv_dep ! depth variable name
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_namesi ! array of var name
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nameso ! array of var22 name for output
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvari, stypvaro ! data structure
+
+ LOGICAL :: lcaltmean ! flag for timemean computation
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdflinreg ''list_of_ioipsl_model_output_files'' '
+ PRINT *,' usage : cdflinreg ''list of model files'' '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the linear regression coefficients for a bunch of'
+ PRINT *,' input files. '
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' A list of netcdf model file of same kind'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : for each input variables, there are 3 computed field'
+ PRINT *,' - slope coefficient'
+ PRINT *,' - barycenter '
+ PRINT *,' - Pearson Coefficient'
STOP
ENDIF
- !!
+
!! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
-
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- PRINT *,' assume file with no depth'
- npk=0
+ CALL getarg (1, cf_in )
+ IF ( chkfile(cf_in) ) STOP ! missing file
+
+ npiglo = getdim (cf_in,cn_x )
+ npjglo = getdim (cf_in,cn_y )
+ npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr)
+
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ PRINT *,' assume file with no depth'
+ npk=0
ENDIF
ENDIF
ENDIF
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- ALLOCATE( zy(npiglo,npjglo), zyt(npiglo,npjglo), zyy(npiglo,npjglo),v2d(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo), rmean2(npiglo,npjglo), rmean3(npiglo,npjglo) )
- ALLOCATE( areg(npiglo,npjglo), breg(npiglo,npjglo) , rpear(npiglo,npjglo) )
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+
+ ALLOCATE( dy (npiglo,npjglo), dyt (npiglo,npjglo), dyy (npiglo,npjglo), dv2d(npiglo,npjglo) )
+ ALLOCATE( dmean(npiglo,npjglo), dmean2(npiglo,npjglo), dmean3(npiglo,npjglo) )
+ ALLOCATE( dareg(npiglo,npjglo), dbreg (npiglo,npjglo) ,dpear (npiglo,npjglo) )
+ ALLOCATE( tim (jptmax) )
- nvars = getnvar(cfile)
+ nvars = getnvar(cf_in)
PRINT *,' nvars =', nvars
- ALLOCATE (cvarname(nvars), cvarname2(3*nvars) )
- ALLOCATE (typvar(nvars), typvar2(3*nvars) )
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars), id_varout2(3*nvars),ipk2(3*nvars) )
+ ALLOCATE (cv_namesi(nvars), cv_nameso(3*nvars) )
+ ALLOCATE (stypvari (nvars), stypvaro (3*nvars) )
+ ALLOCATE (ipki (nvars), ipko (3*nvars) )
+ ALLOCATE ( id_varout(3*nvars) )
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ ! get list of variable names and collect attributes in stypvari (optional)
+ cv_namesi(:) = getvarname(cf_in, nvars, stypvari)
DO jvar = 1, nvars
- ijvar=(jvar -1)*3 +1
- ! AREG
- cvarname2(ijvar)=TRIM(cvarname(jvar))//'_areg'
- typvar2(ijvar)%name = TRIM(typvar(jvar)%name)//'_areg' ! name
- typvar2(ijvar)%units = TRIM(typvar(jvar)%units)//'/year' ! unit
- typvar2(ijvar)%missing_value = spval ! missing_value
- typvar2(ijvar)%valid_min = -100. ! valid_min = zero
- typvar2(ijvar)%valid_max = 100. ! valid_max *valid_max
- typvar2(ijvar)%scale_factor= 1.
- typvar2(ijvar)%add_offset= 0.
- typvar2(ijvar)%savelog10= 0.
- typvar2(ijvar)%long_name =TRIM(typvar(jvar)%long_name)//'_linear_slope' !
- typvar2(ijvar)%short_name = TRIM(typvar(jvar)%short_name)//'_areg' !
- typvar2(ijvar)%online_operation = TRIM(typvar(jvar)%online_operation)
- typvar2(ijvar)%axis = TRIM(typvar(jvar)%axis)
- ! BREG
- cvarname2(ijvar+1)=TRIM(cvarname(jvar))//'_breg'
- typvar2(ijvar+1)%name = TRIM(typvar(jvar)%name)//'_breg' ! name
- typvar2(ijvar+1)%units = TRIM(typvar(jvar)%units) ! unit
- typvar2(ijvar+1)%missing_value = spval ! missing_value
- typvar2(ijvar+1)%valid_min = -100. ! valid_min = zero
- typvar2(ijvar+1)%valid_max = 100. ! valid_max *valid_max
- typvar2(ijvar+1)%scale_factor= 1.
- typvar2(ijvar+1)%add_offset= 0.
- typvar2(ijvar+1)%savelog10= 0.
- typvar2(ijvar+1)%long_name =TRIM(typvar(jvar)%long_name)//'_b' !
- typvar2(ijvar+1)%short_name = TRIM(typvar(jvar)%short_name)//'_breg' !
- typvar2(ijvar+1)%online_operation = TRIM(typvar(jvar)%online_operation)
- typvar2(ijvar+1)%axis = TRIM(typvar(jvar)%axis)
- ! R2 pearson
- cvarname2(ijvar+2)=TRIM(cvarname(jvar))//'_r2'
- typvar2(ijvar+2)%name = TRIM(typvar(jvar)%name)//'_r2' ! name
- typvar2(ijvar+2)%units = 'no unit' ! unit
- typvar2(ijvar+2)%missing_value = spval ! missing_value
- typvar2(ijvar+2)%valid_min = 0. ! valid_min = zero
- typvar2(ijvar+2)%valid_max = 1. ! valid_max *valid_max
- typvar2(ijvar+2)%scale_factor= 1.
- typvar2(ijvar+2)%add_offset= 0.
- typvar2(ijvar+2)%savelog10= 0.
- typvar2(ijvar+2)%long_name =TRIM(typvar(jvar)%long_name)//'_r2_Pearson' !
- typvar2(ijvar+2)%short_name = TRIM(typvar(jvar)%short_name)//'_r2' !
- typvar2(ijvar+2)%online_operation = TRIM(typvar(jvar)%online_operation)
- typvar2(ijvar+2)%axis = TRIM(typvar(jvar)%axis)
+ ijvar=(jvar -1)*3 +1
+ ! AREG
+ cv_nameso(ijvar) = TRIM(cv_namesi(jvar))//'_areg'
+ stypvaro(ijvar)%cname = TRIM(stypvari(jvar)%cname)//'_areg' ! name
+ stypvaro(ijvar)%cunits = TRIM(stypvari(jvar)%cunits)//'/year' ! unit
+ stypvaro(ijvar)%rmissing_value = zspval ! missing_value
+ stypvaro(ijvar)%valid_min = -100. ! valid_min = zero
+ stypvaro(ijvar)%valid_max = 100. ! valid_max *valid_max
+ stypvaro(ijvar)%scale_factor = 1.
+ stypvaro(ijvar)%add_offset = 0.
+ stypvaro(ijvar)%savelog10 = 0.
+ stypvaro(ijvar)%clong_name = TRIM(stypvari(jvar)%clong_name)//'_linear_slope'
+ stypvaro(ijvar)%cshort_name = TRIM(stypvari(jvar)%cshort_name)//'_areg'
+ stypvaro(ijvar)%conline_operation = TRIM(stypvari(jvar)%conline_operation)
+ stypvaro(ijvar)%caxis = TRIM(stypvari(jvar)%caxis)
+ ! BREG
+ cv_nameso(ijvar+1) = TRIM(cv_namesi(jvar))//'_breg'
+ stypvaro(ijvar+1)%cname = TRIM(stypvari(jvar)%cname)//'_breg' ! name
+ stypvaro(ijvar+1)%cunits = TRIM(stypvari(jvar)%cunits) ! unit
+ stypvaro(ijvar+1)%rmissing_value = zspval ! missing_value
+ stypvaro(ijvar+1)%valid_min = -100. ! valid_min = zero
+ stypvaro(ijvar+1)%valid_max = 100. ! valid_max *valid_max
+ stypvaro(ijvar+1)%scale_factor = 1.
+ stypvaro(ijvar+1)%add_offset = 0.
+ stypvaro(ijvar+1)%savelog10 = 0.
+ stypvaro(ijvar+1)%clong_name = TRIM(stypvari(jvar)%clong_name)//'_b'
+ stypvaro(ijvar+1)%cshort_name = TRIM(stypvari(jvar)%cshort_name)//'_breg'
+ stypvaro(ijvar+1)%conline_operation = TRIM(stypvari(jvar)%conline_operation)
+ stypvaro(ijvar+1)%caxis = TRIM(stypvari(jvar)%caxis)
+ ! R2 pearson
+ cv_nameso(ijvar+2) = TRIM(cv_namesi(jvar))//'_r2'
+ stypvaro(ijvar+2)%cname = TRIM(stypvari(jvar)%cname)//'_r2' ! name
+ stypvaro(ijvar+2)%cunits = 'no unit' ! unit
+ stypvaro(ijvar+2)%rmissing_value = zspval ! missing_value
+ stypvaro(ijvar+2)%valid_min = 0. ! valid_min = zero
+ stypvaro(ijvar+2)%valid_max = 1. ! valid_max *valid_max
+ stypvaro(ijvar+2)%scale_factor = 1.
+ stypvaro(ijvar+2)%add_offset = 0.
+ stypvaro(ijvar+2)%savelog10 = 0.
+ stypvaro(ijvar+2)%clong_name = TRIM(stypvari(jvar)%clong_name)//'_r2_Pearson'
+ stypvaro(ijvar+2)%cshort_name = TRIM(stypvari(jvar)%cshort_name)//'_r2'
+ stypvaro(ijvar+2)%conline_operation = TRIM(stypvari(jvar)%conline_operation)
+ stypvaro(ijvar+2)%caxis = TRIM(stypvari(jvar)%caxis)
END DO
- id_var(:) = (/(jv, jv=1,nvars)/)
- ! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
+ ! ipki gives the number of level or 0 if not a T[Z]YX variable
+ ipki(:) = getipk (cf_in, nvars, cdep=cv_dep)
+
DO jvar=1,nvars
- ipk2( (jvar-1)*3 +1 ) = ipk(jvar)
- ipk2( (jvar-1)*3 +2 ) = ipk(jvar)
- ipk2( (jvar-1)*3 +3 ) = ipk(jvar)
+ ipko( (jvar-1)*3 +1 ) = ipki(jvar)
+ ipko( (jvar-1)*3 +2 ) = ipki(jvar)
+ ipko( (jvar-1)*3 +3 ) = ipki(jvar)
ENDDO
- WHERE( ipk == 0 ) cvarname='none'
- WHERE( ipk2 == 0 ) cvarname2='none'
- typvar(:)%name=cvarname
- typvar2(:)%name=cvarname2
- ! create output fileset
- cfileout='cdflinreg.nc'
- cfileout2='linreg.nc'
- ! create output file taking the sizes in cfile
-
-! ncout =create(cfileout, cfile,npiglo,npjglo,npk,cdep=cdep)
- ncout2=create(cfileout2,cfile,npiglo,npjglo,npk,cdep=cdep)
+ WHERE( ipki == 0 ) cv_namesi = 'none'
+ WHERE( ipko == 0 ) cv_nameso = 'none'
+ stypvari(:)%cname = cv_namesi
+ stypvaro(:)%cname = cv_nameso
-! ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- ierr= createvar(ncout2, typvar2, 3*nvars, ipk2, id_varout2)
+ ! create output fileset
+ cf_out='linreg.nc'
+ ! create output file taking the sizes in cf_in
-! ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk,cdep=cdep)
- ierr= putheadervar(ncout2, cfile, npiglo, npjglo, npk,cdep=cdep)
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep )
+ ierr = createvar (ncout, stypvaro, 3*nvars, ipko, id_varout )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk, cdep=cv_dep )
- lcaltmean=.TRUE. ; zt=0.d0 ; zt2=0.d0
+ lcaltmean=.TRUE. ; dt=0.d0 ; dt2=0.d0
DO jvar = 1,nvars
- ijvar=(jvar-1)*3 +1
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' ) THEN
+ ijvar=(jvar-1)*3 + 1
+ IF (cv_namesi(jvar) == cn_vlon2d .OR. &
+ cv_namesi(jvar) == cn_vlat2d ) THEN
! skip these variable
ELSE
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar), jvar
- DO jk = 1, ipk(jvar)
-! PRINT *,'level ',jk
- zy(:,:) = 0.d0 ; zyt(:,:) = 0.d0 ; zyy(:,:) =0.d0 ; total_time = 0.; ntframe=0
- DO jt = 1, narg
- CALL getarg (jt, cfile)
- nt = getdim (cfile,'time_counter')
- ntframe=ntframe+nt
+ PRINT *,' Working with ', TRIM(cv_namesi(jvar)), ipki(jvar), jvar
+ DO jk = 1, ipki(jvar)
+ dy(:,:) = 0.d0 ; dyt(:,:) = 0.d0 ; dyy(:,:) =0.d0 ; dtotal_time = 0.; ntframe=0
+ DO jfil = 1, narg
+ CALL getarg (jfil, cf_in)
+ IF ( jvar == 1 ) THEN
+ IF ( chkfile(cf_in) ) STOP ! missing file
+ ENDIF
+ npt = getdim (cf_in,cn_t)
+ ntframe=ntframe+npt
IF ( lcaltmean ) THEN
- tim(ntframe-nt+1:ntframe)=getvar1d(cfile,'time_counter',nt)/86400.d0/365.
-! tim(ntframe-nt+1:ntframe)=(/(ntframe-nt+jtt,jtt=1,nt)/)
+ ! read time and convert seconds to years
+ tim(ntframe-npt+1:ntframe)=getvar1d(cf_in,cn_vtimec,npt)/86400.d0/365.
END IF
- DO jtt=1,nt
- jkk=jk
- ! If forcing fields is without depth dimension
- IF (npk==0) jkk=jtt
- v2d(:,:)= getvar(cfile, cvarname(jvar), jkk ,npiglo, npjglo,ktime=jtt )
- zy(:,:) = zy(:,:) + v2d(:,:)
- zyy(:,:) = zyy(:,:) + v2d(:,:)*v2d(:,:)
- zyt(:,:) = zyt(:,:) + v2d(:,:)*tim(ntframe-nt+jtt)
+
+ DO jt=1,npt
+ ! If forcing fields is without depth dimension
+ dv2d(:,:) = getvar(cf_in, cv_namesi(jvar), jk ,npiglo, npjglo, ktime=jt )
+ dy(:,:) = dy(:,:) + dv2d(:,:)
+ dyy(:,:) = dyy(:,:) + dv2d(:,:)*dv2d(:,:)
+ dyt(:,:) = dyt(:,:) + dv2d(:,:)*tim(ntframe-npt+jt)
ENDDO
END DO
- ! finish with level jk ; compute mean (assume spval is 0 )
- zt=sum(tim(1:ntframe))
- zt2=sum(tim(1:ntframe)*tim(1:ntframe) )
- rmean(:,:) = zy(:,:)/ntframe
- rmean2(:,:) = zyt(:,:)/ntframe
- rmean3(:,:) = zyy(:,:)/ntframe
- ! store variable on outputfile
-! ierr = putvar(ncout2,id_varout2(jvar) ,rmean, jk, npiglo, npjglo)
-! ierr = putvar(ncout2,id_varout2(jvar),rmean2, jk,npiglo, npjglo)
+ ! finish with level jk ; compute mean (assume zspval is 0 )
+ dt = SUM(tim(1:ntframe) )
+ dt2 = SUM(tim(1:ntframe)*tim(1:ntframe) )
+ dmean(:,:) = dy (:,:) / ntframe
+ dmean2(:,:) = dyt(:,:) / ntframe
+ dmean3(:,:) = dyy(:,:) / ntframe
+
IF (lcaltmean ) THEN
- timean(1)= zt/ntframe
- timean(2)= zt2/ntframe
-! ierr=putvar1d(ncout,timean,2,'T')
- ierr=putvar1d(ncout2,timean,1,'T')
+ timean(1)= dt/ntframe
+ timean(2)= dt2/ntframe
+ ierr=putvar1d(ncout,timean,1,'T')
END IF
- !compute areg, breg, rpear
- WHERE (rmean /= 0 )
- areg(:,:)=( rmean2(:,:) - rmean(:,:) *timean(1) ) / ( timean(2) -timean(1)*timean(1) )
- breg(:,:)=rmean(:,:) - areg(:,:)*timean(1)
- rpear(:,:) = areg(:,:)*areg(:,:)*( timean(2) -timean(1)*timean(1))/( rmean3(:,:) -rmean(:,:)*rmean(:,:) )
- WHERE (rpear < 0 ) rpear=0 ; WHERE (rpear > 1 ) rpear=1
+
+ !compute dareg, dbreg, dpear
+ WHERE (dmean /= 0 )
+ dareg(:,:) = ( dmean2(:,:) - dmean(:,:) *timean(1) ) / ( timean(2) -timean(1)*timean(1) )
+ dbreg(:,:) = dmean(:,:) - dareg(:,:)*timean(1)
+ dpear(:,:) = dareg(:,:)*dareg(:,:)*( timean(2) -timean(1)*timean(1))/( dmean3(:,:) -dmean(:,:)*dmean(:,:) )
+ WHERE (dpear < 0 ) dpear=0 ; WHERE (dpear > 1 ) dpear=1
ELSEWHERE
- areg=spval ; breg=spval ; rpear=spval
+ dareg=zspval ; dbreg=zspval ; dpear=zspval
ENDWHERE
-
- ierr = putvar(ncout2,id_varout2(ijvar) ,REAL(areg), jk, npiglo, npjglo)
- ierr = putvar(ncout2,id_varout2(ijvar+1),REAL(breg), jk,npiglo, npjglo)
- ierr = putvar(ncout2,id_varout2(ijvar+2),REAL(rpear), jk,npiglo, npjglo)
- lcaltmean=.FALSE. ! tmean already computed
+
+ ierr = putvar(ncout, id_varout(ijvar ), REAL(dareg), jk, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(ijvar+1), REAL(dbreg), jk, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(ijvar+2), REAL(dpear), jk, npiglo, npjglo)
+ lcaltmean = .FALSE. ! tmean already computed
END DO ! loop to next level
END IF
END DO ! loop to next var in file
-! istatus = closeout(ncout)
- istatus = closeout(ncout2)
-
+ ierr = closeout(ncout)
END PROGRAM cdflinreg
diff --git a/cdflspv.f90 b/cdflspv.f90
deleted file mode 100644
index 1075116..0000000
--- a/cdflspv.f90
+++ /dev/null
@@ -1,157 +0,0 @@
-PROGRAM cdflspv
- !! --------------------------------------------------------------
- !! *** PROGRAM CDFLSPV ***
- !! ** Purpose: This program is used to compute the
- !! large scale potential vorticity
- !! from a set of T S files.
- !!
- !! ** Method: pv = 1/rho0 * f * d(rho)/d(z)
- !! rho0 = 1020. kg/m3
- !! f is the coriolis factor
- !! zeta is the relative vorticity
- !! Output is done for f (2D) (at f-points)
- !! f/rho0 d(rho)/d(z) (3D) at W points
- !!
- !! ** Usage :
- !! cdfpv gridT gridU gridV files.
- !! output is done on pv.nc, with variable name
- !! volspv (PV)
- !!
- !! * history:
- !! Original : J.M. Molines for SPEM in Dynamo (1996)
- !! Modif : J-O. Beismann for OPA (1999)
- !! Modif : J.M. Molines for normalization Clipper (March 2000)
- !! : J.M. Molines in cdftools, f90 dor DRAKKAR (Nov. 2005)
- !! ---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Used modules
- USE cdfio
- USE eos
-
- !! * Local declaration
- IMPLICIT NONE
-
- INTEGER :: npiglo, npjglo, npk, npt
- INTEGER :: narg, iargc
- INTEGER :: ji,jj,jk, jt
- INTEGER :: ncout, ierr
- INTEGER :: iup=1 , idown=2, itmp
- INTEGER, DIMENSION(1) :: ipk, id_varout !: for output variables
- !
- REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: sigma
- REAL(KIND=4), DIMENSION(:,:) , ALLOCATABLE :: ztemp, zsal, dsig, zmask, fcorio, pv,&
- & e3w, gphit
- REAL(KIND=4), DIMENSION(:) , ALLOCATABLE :: time_tag, h1d, gdepw
- REAL(KIND=4) :: zrot, pi, rho0=1020.
-
- CHARACTER(LEN=256) :: cfilet, cfilout
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc'
-
- TYPE(variable) , DIMENSION(1) :: typvar !: structure for attributes
- !
-
- !! * Read command line
- narg=iargc()
- IF (narg == 0 ) THEN
- PRINT *, &
- &' >>>> usage: cdflspv gridT files '
- PRINT *,' Output is done on lspv.nc'
- PRINT *,' variables volspv '
- PRINT *,' mesh_hgr.nc, mesh_zgr.nc are required'
- STOP
- ENDIF
- CALL getarg(1,cfilet)
-
- npiglo=getdim(cfilet,'x')
- npjglo=getdim(cfilet,'y')
- npk =getdim(cfilet,'depth')
- npt =getdim(cfilet,'time')
-
- ALLOCATE( sigma(npiglo,npjglo,2) )
- ALLOCATE( ztemp(npiglo,npjglo), zsal(npiglo,npjglo) )
- ALLOCATE (fcorio(npiglo,npjglo),pv(npiglo,npjglo) )
- ALLOCATE( zmask(npiglo,npjglo), dsig(npiglo,npjglo) )
- ALLOCATE( time_tag(npt), h1d(npk) ,gdepw(npk))
- ALLOCATE ( gphit(npiglo,npjglo))
- ALLOCATE ( e3w(npiglo,npjglo) )
-
-
- ! read mesh_mask/ time information
- time_tag(:)=getvar1d(cfilet,'time_counter', npt)
- h1d(:)=getvar1d(cfilet,'deptht',npk)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- gphit(:,:) = getvar(coordhgr,'gphit',1,npiglo,npjglo)
-
- ! Compute coriolis factor
- pi=ACOS(-1.)
- fcorio(:,:)=4*pi/86400.*ABS(SIN(pi/180*gphit(:,:)))
-
- ! ... open output file and write header
- ipk(:)=npk
- typvar(1)%name= 'volspv'
- typvar(1)%units='kg.m-4.s-1 x 1e7'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar(1)%long_name='Large Scale Potential_vorticity'
- typvar(1)%short_name='volspv'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
- cfilout='lspv.nc'
-
- ncout = create(cfilout,'none' ,npiglo,npjglo,npk,cdep='depthw')
- ierr = createvar(ncout, typvar,1,ipk, id_varout )
- ierr = putheadervar(ncout , cfilet, npiglo, npjglo, npk,pdep=gdepw)
- ierr = putvar1d(ncout,time_tag,npt,'T')
-
- DO jt=1,npt
- PRINT *, 'time ',jt
- ! surface PV is unknown ...
- pv(:,:) = 0.
- ierr = putvar(ncout,id_varout(1), pv,1,npiglo,npjglo,ktime=jt)
-
- ! initialize first level
- ztemp(:,:) = getvar(cfilet,'votemper',1,npiglo,npjglo,ktime=jt)
- zsal(:,:) = getvar(cfilet,'vosaline',1,npiglo,npjglo,ktime=jt)
-
- zmask = 1.0
- WHERE(zsal == 0 ) zmask = 0.0
- sigma(:,:,iup) = sigma0 ( ztemp,zsal,npiglo,npjglo )* zmask(:,:)
-
- ! Main vertical loop
- DO jk=2,npk
- ztemp(:,:) = getvar(cfilet,'votemper',jk,npiglo,npjglo,ktime=jt)
- zsal(:,:) = getvar(cfilet,'vosaline',jk,npiglo,npjglo,ktime=jt)
- e3w (:,:) = getvar(coordzgr,'e3w_ps', jk, npiglo,npjglo, ldiom=.true.)
- WHERE (e3w == 0 ) e3w = 1.
-
- zmask=1.0
- WHERE(zsal == 0 ) zmask = 0.0
- sigma(:,:,idown) = sigma0 ( ztemp,zsal,npiglo,npjglo )* zmask(:,:)
-
- ! d(sigma0)/dz at W point ( masked if down level is masked )
- dsig(:,:)=(sigma(:,:,idown) - sigma(:,:,iup)) /e3w *zmask
-
- ! Full pv:
- DO ji=1,npiglo
- DO jj = 1, npjglo
- pv(ji,jj) = (fcorio(ji,jj))*dsig(ji,jj)*1.e7
- END DO
- END DO
- ierr = putvar(ncout,id_varout(1), pv,jk,npiglo,npjglo,ktime=jt)
-
- ! swap index up and down
- itmp=iup
- iup=idown
- idown=itmp
- END DO ! level loop
- END DO ! time loop
-
- ierr = closeout(ncout)
- PRINT *,'cdflspv completed successfully'
-END PROGRAM cdflspv
diff --git a/cdfmaskdmp.f90 b/cdfmaskdmp.f90
index c487850..7e40a34 100644
--- a/cdfmaskdmp.f90
+++ b/cdfmaskdmp.f90
@@ -1,58 +1,102 @@
PROGRAM cdfmaskdmp
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmaskdmp ***
+ !!======================================================================
+ !! *** PROGRAM cdfmaskdmp ***
+ !!=====================================================================
+ !! ** Purpose : Compute 3D mask for AABW relaxation from T and S
+ !! climatology.
+ !! Store the results on a cdf file.
!!
- !! ** Purpose: Compute 3D mask for AABW relaxation from T and S climatologies
- !! Store the results on a cdf file.
- !!
!! ** Method: read temp and salinity, compute sigma-2
!! compute coefs, create mask
!!
- !! history:
- !! Original : R. Dussin (sept 2010) for ORCA025
- !!
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 09/2010 : R. Dussin : Original code from JLS Py version
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk , jt , jj , ji !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk, npt !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal ,& !: Array to read a layer of data
- & zsigi , & !: potential density (sig-i)
- & zmask , & !: 2D mask at current level
- & zwdmp , & !: damping mask at current level
- & zlat !: latitude
- REAL(KIND=4),DIMENSION(:),ALLOCATABLE :: tim , zdep
- REAL(KIND=4) :: spval !: missing value
-
- CHARACTER(LEN=256) :: cfilet , cfiles, cfilemask='mask.nc', cfileout='mask_dmp.nc' !:
- CHARACTER(LEN=256) :: cdum
-
- TYPE(variable) , DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: ncout
- INTEGER :: istatus
- ! default parameters
- REAL(KIND=4) :: prof=2000.
- REAL(KIND=4) :: snmax=37.16 , swidth=0.025
- REAL(KIND=4) :: hmin=1000. , hwidth=100.
- REAL(KIND=4) :: latmax=-20. , latwidth=2.
- REAL(KIND=4) :: riri, fifi, loulou
-
- !! Read command line
- narg= iargc()
+
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4) :: narg, iargc ! browse command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's
+
+ REAL(KIND=4) :: ref_dep=2000. ! reference depth in meters
+ REAL(KIND=4) :: zsnmin=37.16 ! minimum density
+ REAL(KIND=4) :: zswidth=0.025 ! tapering width
+ REAL(KIND=4) :: hmin=1000. ! depth limit
+ REAL(KIND=4) :: hwidth=100. ! depth tapering height
+ REAL(KIND=4) :: rlatmax=-20 ! max latitude
+ REAL(KIND=4) :: rlatwidth=2 ! latitude tapering width
+ REAL(KIND=4) :: wdep, wsig, wlat ! tapering function dep, sigma and lat
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp ! temperature
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsal ! salinity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsigi ! sigma-i
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zwdmp ! 2D build mask at current level
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zlat ! latitudes
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zdep ! deptht
+
+ CHARACTER(LEN=256) :: cf_tfil ! input filename for temperature
+ CHARACTER(LEN=256) :: cf_sfil ! input filename for salinity
+ CHARACTER(LEN=256) :: cf_out='mask_dmp.nc' ! output file name
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmaskdmp fileT fileS [prof snmax swidth hmin hwidth latmax latwidth]'
- PRINT *,' default is : cdfmaskdmp fileT fileS 2000. 37.16 0.025 1000. 100. -20. 2. '
- PRINT *,' mask.nc must be in your directory '
- PRINT *,' Output on mask_dmp.nc, variable wdmp'
+ PRINT *,' usage : cdfmaskdmp T-file S-file ... '
+ PRINT *,' ... [ref_dep snmin swidth hmin hwidth latmax latwidth]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute a damping mask with smooth transition according to density,'
+ PRINT *,' depth and latitude criteria.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : temperature file'
+ PRINT *,' S-file : salinity file'
+ PRINT *,' They can be the same file, but as many climatologied are provided'
+ PRINT *,' in separate files, we decided to put both in the command line.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' ** If used, they must all be provided in the correct order (!) **'
+ PRINT *,' ref_dep : reference depth for potential density.'
+ PRINT *,' snmin : density minimum for the mask.'
+ PRINT *,' swidth : density width for tapering'
+ PRINT *,' hmin : minimum depth'
+ PRINT *,' hwidth : depth width for tapering'
+ PRINT *,' latmax : maximum latitude'
+ PRINT *,' latwidth : latitude width for tapering'
+ PRINT *,' '
+ PRINT *,' Actual default values are :'
+ PRINT *,' ref_dep = ', ref_dep
+ PRINT *,' snmin = ', zsnmin
+ PRINT *,' swidth = ', zswidth
+ PRINT *,' hmin = ', hmin
+ PRINT *,' hwidth = ', hwidth
+ PRINT *,' latmax = ', rlatmax
+ PRINT *,' latwidth = ', rlatwidth
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : wdmp'
STOP
ENDIF
@@ -61,90 +105,81 @@ PROGRAM cdfmaskdmp
STOP
ENDIF
- CALL getarg (1, cfilet)
- CALL getarg (2, cfiles)
- IF ( narg == 9 ) THEN
+ CALL getarg (1, cf_tfil)
+ CALL getarg (2, cf_sfil)
- CALL getarg (3, cdum)
- READ(cdum,*) prof
- CALL getarg (4, cdum)
- READ(cdum,*) snmax
- CALL getarg (5, cdum)
- READ(cdum,*) swidth
- CALL getarg (6, cdum)
- READ(cdum,*) hmin
- CALL getarg (7, cdum)
- READ(cdum,*) hwidth
- CALL getarg (8, cdum)
- READ(cdum,*) latmax
- CALL getarg (9, cdum)
- READ(cdum,*) latwidth
-
- ENDIF
+ IF ( chkfile(cf_tfil) .OR. chkfile(cf_sfil) ) STOP ! missing files
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npt = getdim (cfilet,'time')
+ IF ( narg == 9 ) THEN
+ CALL getarg (3, cldum) ; READ(cldum,*) ref_dep
+ CALL getarg (4, cldum) ; READ(cldum,*) zsnmin
+ CALL getarg (5, cldum) ; READ(cldum,*) zswidth
+ CALL getarg (6, cldum) ; READ(cldum,*) hmin
+ CALL getarg (7, cldum) ; READ(cldum,*) hwidth
+ CALL getarg (8, cldum) ; READ(cldum,*) rlatmax
+ CALL getarg (9, cldum) ; READ(cldum,*) rlatwidth
+ ENDIF
- ipk(:)= npk ! all variables (input and output are 3D)
- typvar(1)%name='wdmp'
- typvar(1)%missing_value=1.e+20
- typvar(1)%axis='TZYX'
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
+ ipk(:) = npk
+ stypvar(1)%cname = 'wdmp'
+ stypvar(1)%rmissing_value = 1.e+20
+ stypvar(1)%caxis = 'TZYX'
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'npt =', npt
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
- ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsigi(npiglo,npjglo) ,zmask(npiglo,npjglo) , zlat(npiglo,npjglo))
- ALLOCATE (zwdmp(npiglo,npjglo))
- ALLOCATE (tim(npt) , zdep(npk))
+ ALLOCATE (ztemp(npiglo,npjglo), zsal( npiglo,npjglo) )
+ ALLOCATE (zsigi(npiglo,npjglo), zmask(npiglo,npjglo), zlat(npiglo,npjglo) )
+ ALLOCATE (zwdmp(npiglo,npjglo) )
+ ALLOCATE (tim(npt) , zdep(npk) )
! create output fileset
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,npk)
-
- tim=getvar1d(cfilet,'time_counter',npt)
- zdep=getvar1d(cfilet,'deptht',npk)
- zlat(:,:) = getvar(cfilet, 'nav_lat', 1 ,npiglo, npjglo)
+ tim(:) = getvar1d(cf_tfil, cn_vtimec, npt )
+ zdep(:) = getvar1d(cf_tfil, cn_vdeptht, npk )
+ zlat(:,:) = getvar (cf_tfil, cn_vlat2d, 1, npiglo, npjglo)
- ierr=putvar1d(ncout,tim,npt,'T')
+ ierr=putvar1d(ncout, tim, npt, 'T')
DO jt = 1, npt
PRINT *,'time: ',jt
- DO jk = 1, npk
- PRINT *, 'jk = ', jk
+ DO jk = 1, npk
+ PRINT *, 'jk = ', jk
+ ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt)
+ zsal( :,:) = getvar(cf_sfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt)
+ zmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo )
- ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo,ktime=jt)
- zsal(:,:) = getvar(cfiles, 'vosaline', jk ,npiglo, npjglo,ktime=jt)
+ zsigi(:,:) = sigmai( ztemp, zsal, ref_dep, npiglo, npjglo)* zmask(:,:)
- zmask(:,:) = getvar(cfilemask, 'tmask', jk ,npiglo, npjglo)
+ DO jj=1,npjglo
+ DO ji=1,npiglo
- zsigi(:,:) = sigmai ( ztemp,zsal,prof,npiglo,npjglo )* zmask(:,:)
+ wdep = TANH( (zdep(jk ) - hmin ) / hwidth ) / 2. + 0.5
+ wsig = TANH( (zsigi(ji,jj) - zsnmin ) / zswidth ) / 2. + 0.5
+ wlat = TANH(-(zlat( ji,jj) - rlatmax) / rlatwidth) / 2. + 0.5
- DO jj=1,npjglo
- DO ji=1,npiglo
-
- riri=tanh((zdep(jk)-hmin)/hwidth)/2. + 0.5
- fifi=tanh((zsigi(ji,jj)-snmax)/swidth)/2. + 0.5
- loulou=tanh(-(zlat(ji,jj)-latmax)/latwidth)/2. + 0.5
-
- zwdmp(ji,jj)=riri * fifi * loulou
+ zwdmp(ji,jj) = wdep * wsig * wlat
+ ENDDO
ENDDO
- ENDDO
- zwdmp(:,:) = zwdmp(:,:) * zmask(:,:)
+ zwdmp(:,:) = zwdmp(:,:) * zmask(:,:)
- ierr = putvar(ncout, id_varout(1) ,zwdmp, jk,npiglo, npjglo,ktime=jt)
+ ierr = putvar(ncout, id_varout(1), zwdmp, jk,npiglo, npjglo, ktime=jt)
- END DO ! loop to next level
+ END DO ! loop to next level
END DO ! loop on time
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
+
END PROGRAM cdfmaskdmp
diff --git a/cdfmasstrp-full.f90 b/cdfmasstrp-full.f90
deleted file mode 100644
index 4482ea0..0000000
--- a/cdfmasstrp-full.f90
+++ /dev/null
@@ -1,469 +0,0 @@
-PROGRAM cdfmasstrp_full
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfmasstrp ***
- !!
- !! ** Purpose: Compute Mass Transports across a section
- !! FULL STEPS version
- !!
- !! ** Method: Try to avoid 3 d arrays.
- !! The begining and end point of the section are given in term of f-points index.
- !! This program computes the transport across this section for
- !! Mass transport ( Sv)
- !! The transport is > 0 left handside of the line
- !! This program use a zig-zag line going through U and V-points.
- !! It takes as input : gridU, gridV files.
- !! The mesh_hgr.nc, mesh_hzr.nc are required.
- !! It is convenient to use an ASCII file as the standard input to give
- !! the name and the imin imax jmin jmax for eaxh section required
- !! The last name of this ASCII file must be EOF
- !!
- !!
- !! history :
- !! Original : J.M. Molines (jan. 2005)
- !! J.M. Molines Apr 2005 : use modules (cdftransportiz)
- !! J.M. Molines March 2006 : just mass transport
- !! F. Castruccio (Fall 2006) : full step version
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nclass !: number of depth class
- INTEGER ,DIMENSION (:),ALLOCATABLE :: imeter !: limit beetween depth level, in m (nclass -1)
- INTEGER ,DIMENSION (:),ALLOCATABLE :: ilev0,ilev1 !: limit in levels ! nclass
- INTEGER :: jk, jclass !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: imin, imax, jmin, jmax, ik
- INTEGER :: numout = 10
-
- ! broken line stuff
- INTEGER, PARAMETER :: jpseg=10000
- INTEGER :: i0,j0,i1,j1, i, j
- INTEGER :: n,nn,k, jseg
- INTEGER :: norm_u, norm_v, ist, jst
-
- REAL(KIND=4) :: rxi0,ryj0, rxi1, ryj1
- REAL(KIND=4) :: ai,bi, aj,bj,d
- REAL(KIND=4) :: rxx(jpseg),ryy(jpseg)
- REAL(KIND=4), DIMENSION(jpseg) :: gla, gphi
-
- REAL(KIND=8), DIMENSION(jpseg) :: voltrp
- REAL(KIND=8) :: voltrpsum
- COMPLEX yypt(jpseg), yypti
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v,gphiv, zv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u,gphiu, zu, zut, zus !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamu, glamv
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw, e3t
- REAL(KIND=4) :: rd1, rd2
- REAL(KIND=4) :: udum, vdum
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku,zwkv
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: ztrpu, ztrpv
-
- CHARACTER(LEN=256) :: cfilet, cfileu, cfilev, csection, cfileout='section_trp.dat'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cdum
-
- INTEGER :: nxtarg
- LOGICAL :: ltest=.FALSE.
-
- ! constants
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 2 ) THEN
- PRINT *,' Usage : cdfmasstrp [-test u v ] gridUfile gridVfile ''limit of level'' '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in te current directory'
- PRINT *,' Option -test u v is used for testing purposes, with constant flow field'
- PRINT *,' Output on standard output and on an ascii file called section_trp.dat'
- STOP
- ENDIF
-
-
- CALL getarg (1, cfileu)
- IF ( cfileu == '-test') THEN
- ltest = .TRUE.
- CALL getarg (2, cdum)
- READ(cdum,*) udum
- CALL getarg (3, cdum)
- READ(cdum,*) vdum
- CALL getarg (4, cfileu)
- CALL getarg (5, cfilev)
- nxtarg=5
- ELSE
- CALL getarg (2, cfilev)
- nxtarg=2
- ENDIF
- nclass = narg -nxtarg + 1
-
- ALLOCATE ( imeter(nclass -1), ilev0(nclass), ilev1(nclass) )
-
- DO jk=1, nclass -1
- CALL getarg(nxtarg+jk,cdum)
- READ(cdum,*) imeter(jk)
- END DO
-
- npiglo= getdim (cfileu,'x')
- npjglo= getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE( zu (npiglo,npjglo) )
- ALLOCATE( zv (npiglo,npjglo) )
- !
- ALLOCATE ( zwku (npiglo,npjglo) )
- ALLOCATE ( zwkv (npiglo,npjglo) )
- !
- ALLOCATE ( ztrpu (npiglo,npjglo,nclass), ztrpv (npiglo,npjglo,nclass))
- !
- ALLOCATE ( e1v(npiglo,npjglo) )
- ALLOCATE ( e2u(npiglo,npjglo) )
- ALLOCATE ( e3t(npk) )
- !
- ALLOCATE ( gphiu(npiglo,npjglo), gphiv(npiglo,npjglo) )
- ALLOCATE ( glamu(npiglo,npjglo), glamv(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
- !
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
-
- e3t(:) = getvare3(coordzgr, 'e3t', npk)
-
- glamv(:,:) = getvar(coordhgr, 'glamv', 1,npiglo,npjglo)
- glamu(:,:) = getvar(coordhgr, 'glamu', 1,npiglo,npjglo)
-
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gphiu(:,:) = getvar(coordhgr, 'gphiu', 1,npiglo,npjglo)
-
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- ! look for nearest level to imeter
- ik = 1
-
- ilev0(1) = 1
- ilev1(nclass) = npk-1
-
- DO jk = 1, nclass -1
- DO WHILE ( gdepw(ik) < imeter(jk) )
- ik = ik +1
- END DO
-
- rd1= ABS(gdepw(ik-1) - imeter(jk) )
- rd2= ABS(gdepw(ik) - imeter(jk) )
- IF ( rd2 < rd1 ) THEN
- ilev1(jk) = ik -1 ! t-levels
- ilev0(jk+1) = ik
- ELSE
- ilev1(jk) = ik -2 ! t-levels
- ilev0(jk+1) = ik -1
- END IF
- END DO
- PRINT *, 'Limits : '
- DO jk = 1, nclass
- PRINT *, ilev0(jk),ilev1(jk), gdepw(ilev0(jk)), gdepw(ilev1(jk)+1)
- END DO
-
- !! compute the transport
- ztrpu (:,:,:)= 0
- ztrpv (:,:,:)= 0
-
- DO jclass = 1, nclass
- DO jk = ilev0(jclass),ilev1(jclass)
- PRINT *,'level ',jk
- ! Get velocities, temperature and salinity fluxes at jk
- IF ( ltest ) THEN
- zu (:,:)= udum
- zv (:,:)= vdum
- ELSE
- zu (:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv (:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- ENDIF
-
- zwku (:,:) = zu (:,:)*e2u(:,:)*e3t(jk)
- zwkv (:,:) = zv (:,:)*e1v(:,:)*e3t(jk)
-
- ! integrates vertically
- ztrpu (:,:,jclass) = ztrpu (:,:,jclass) + zwku (:,:)
- ztrpv (:,:,jclass) = ztrpv (:,:,jclass) + zwkv (:,:)
-
- END DO ! loop to next level
- END DO ! next class
-
- OPEN(numout,FILE=cfileout)
- DO
- PRINT *, ' Give name of section '
- READ(*,'(a)') csection
- IF (TRIM(csection) == 'EOF' ) CLOSE(numout)
- IF (TRIM(csection) == 'EOF' ) EXIT
- PRINT *, ' Give imin, imax, jmin, jmax '
- READ(*,*) imin, imax, jmin, jmax
- !! Find the broken line between P1 (imin,jmin) and P2 (imax, jmax)
- !! ---------------------------------------------------------------
- ! ... Initialization
- i0=imin; j0=jmin; i1=imax; j1=jmax
- rxi1=i1; ryj1=j1; rxi0=i0; ryj0=j0
-
- ! .. Compute equation: ryj = aj rxi + bj
- IF ( (rxi1 -rxi0) /= 0 ) THEN
- aj = (ryj1 - ryj0 ) / (rxi1 -rxi0)
- bj = ryj0 - aj * rxi0
- ELSE
- aj=10000.
- bj=0.
- END IF
-
- ! .. Compute equation: rxi = ai ryj + bi
- IF ( (ryj1 -ryj0) /= 0 ) THEN
- ai = (rxi1 - rxi0 ) / ( ryj1 -ryj0 )
- bi = rxi0 - ai * ryj0
- ELSE
- ai=10000.
- bi=0.
- END IF
-
- ! .. Compute the integer pathway:
- n=0
-
- ! .. Chose the strait line with the smallest slope
- IF (ABS(aj) <= 1 ) THEN
- ! ... Here, the best line is y(x)
- ! ... If i1 < i0 swap points and remember it has been swapped
- IF (i1 < i0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
-
- IF ( j1 >= j0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 1 ; jst = 0
- norm_u = -1 ; norm_v = -1
- END IF
-
- ! ... compute the nearest j point on the line crossing at i
- DO i=i0,i1
- n=n+1
- IF (n > jpseg) STOP 'n > jpseg !'
- j=NINT(aj*i + bj )
- yypt(n) = CMPLX(i,j)
- END DO
- ELSE
- ! ... Here, the best line is x(y)
- ! ... If j1 < j0 swap points and remember it has been swapped
- IF (j1 < j0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
- IF ( i1 >= i0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 0
- jst = 1
- norm_u = 1
- norm_v = 1
- END IF
-
- ! ... compute the nearest i point on the line crossing at j
- DO j=j0,j1
- n=n+1
- IF (n > jpseg) STOP 'n>jpseg !'
- i=NINT(ai*j + bi)
- yypt(n) = CMPLX(i,j)
- END DO
- END IF
-
- !!
- !! Look for intermediate points to be added.
- ! .. The final positions are saved in rxx,ryy
- rxx(1)=REAL(yypt(1))
- ryy(1)=IMAG(yypt(1))
- nn=1
-
- DO k=2,n
- ! .. distance between 2 neighbour points
- d=ABS(yypt(k)-yypt(k-1))
- ! .. intermediate points required if d > 1
- IF ( d > 1 ) THEN
- CALL interm_pt(yypt,k,ai,bi,aj,bj,yypti)
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypti)
- ryy(nn)=IMAG(yypti)
- END IF
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypt(k))
- ryy(nn)=IMAG(yypt(k))
- END DO
-
- ! Now extract the transport through a section
- ! ... Check whether we need a u velocity or a v velocity
- ! Think that the points are f-points and delimit either a U segment
- ! or a V segment (ist and jst are set in order to look for the correct
- ! velocity point on the C-grid
- PRINT *, TRIM(csection)
- PRINT *, 'IMIN IMAX JMIN JMAX', imin, imax, jmin, jmax
- WRITE(numout,*)'% Transport along a section by levels' ,TRIM(csection)
- WRITE(numout,*) '% nada IMIN IMAX JMIN JMAX'
- DO jclass=1,nclass
- voltrpsum = 0.
-
- DO jseg = 1, nn-1
- i0=rxx(jseg)
- j0=ryy(jseg)
- IF ( rxx(jseg) == rxx(jseg+1) ) THEN
- gla(jseg)=glamu(i0,j0+jst) ; gphi(jseg)=gphiu(i0,j0+jst)
- voltrp(jseg)= ztrpu (i0,j0+jst,jclass)*norm_u
- ELSE IF ( ryy(jseg) == ryy(jseg+1) ) THEN
- gla(jseg)=glamv(i0+ist,j0) ; gphi(jseg)=gphiv(i0+ist,j0)
- voltrp(jseg)=ztrpv (i0+ist,j0,jclass)*norm_v
- ELSE
- PRINT *,' ERROR :', rxx(jseg),ryy(jseg),rxx(jseg+1),ryy(jseg+1)
- END IF
- voltrpsum = voltrpsum+voltrp(jseg)
- END DO ! next segment
- IF (jclass == 1 ) PRINT *, 'FROM (LON LAT): ', gla(1),gphi(1),' TO (LON LAT)', gla(nn-1), gphi(nn-1)
- PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1)
- PRINT *, ' Mass transport : ', voltrpsum/1.e6,' SV'
- IF (jclass == 1 ) THEN
- WRITE(numout,*) '% nada LONmin LATmin '
- WRITE(numout,*) '% nada LONmax LATmax'
- WRITE(numout,*) '% Top(m) Bottom(m) MassTrans(Sv) '
- WRITE(numout,*) 0 ,imin, imax
- WRITE(numout,*) 0 ,jmin, jmax
- WRITE(numout,9003) 0 , gla(1), gphi(1)
- WRITE(numout,9003) 0 , gla(nn-1), gphi(nn-1)
- ENDIF
- WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), voltrpsum/1.e6
-
- END DO ! next class
- END DO ! infinite loop : gets out when input is EOF
-9002 FORMAT(2f9.0, f9.2)
-9003 FORMAT(3f9.2)
-
-
-CONTAINS
- SUBROUTINE interm_pt (ydpt,k,pai,pbi,paj,pbj,ydpti)
- !! -----------------------------------------------------
- !! SUBROUTINE INTERM_PT
- !! ********************
- !!
- !! PURPOSE:
- !! --------
- !! Find the best intermediate points on a pathway.
- !!
- !! ARGUMENTS:
- !! ----------
- !! ydpt : complex vector of the positions of the nearest points
- !! k : current working index
- !! pai ,pbi : slope and original ordinate of x(y)
- !! paj ,pbj : slope and original ordinate of y(x)
- !! ydpti : Complex holding the position of intermediate point
- !!
- !! AUTHOR:
- !! -------
- !! 19/07/1999 : Jean-Marc MOLINES
- !! 14/01/2005 : J M M in F90
- !!
- !!--------------------------------------------------------------
- !!
- !! 0. Declarations:
- !! ----------------
- IMPLICIT NONE
- COMPLEX, INTENT(in) :: ydpt(*)
- COMPLEX, INTENT(out) :: ydpti
- REAL(KIND=4), INTENT(IN) :: pai,pbi,paj,pbj
- INTEGER ,INTENT(in) :: k
- ! ... local
- COMPLEX :: ylptmp1, ylptmp2
- REAL(KIND=4) :: za0,zb0,za1,zb1,zd1,zd2
- REAL(KIND=4) :: zxm,zym
- REAL(KIND=4) :: zxp,zyp
- !!
- !! 1. Compute intermediate points
- !! ------------------------------
- !
- ! ... Determines whether we use y(x) or x(y):
- IF (ABS(paj) <= 1) THEN
- ! ..... y(x)
- ! ... possible intermediate points:
- ylptmp1=ydpt(k-1)+(1.,0.)
- ylptmp2=ydpt(k-1)+CMPLX(0.,SIGN(1.,paj))
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=paj
- zb0=pbj
- !
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd1 is the distance MP
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd2 is the distance MP
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- ! ... chose the smallest (zd1,zd2)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- !
- ELSE
- !
- ! ... x(y)
- ylptmp1=ydpt(k-1)+CMPLX(SIGN(1.,pai),0.)
- ylptmp2=ydpt(k-1)+(0.,1.)
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=pai
- zb0=pbi
- !
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- END IF
- END SUBROUTINE interm_pt
-
-END PROGRAM cdfmasstrp_full
diff --git a/cdfmasstrp.f90 b/cdfmasstrp.f90
deleted file mode 100644
index 1548118..0000000
--- a/cdfmasstrp.f90
+++ /dev/null
@@ -1,469 +0,0 @@
-PROGRAM cdfmasstrp
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfmasstrp ***
- !!
- !! ** Purpose: Compute Mass Transports across a section
- !! PARTIAL STEPS version
- !!
- !! ** Method: Try to avoid 3 d arrays.
- !! The begining and end point of the section are given in term of f-points index.
- !! This program computes the transport across this section for
- !! Mass transport ( Sv)
- !! The transport is > 0 left handside of the line
- !! This program use a zig-zag line going through U and V-points.
- !! It takes as input : gridU, gridV files.
- !! The mesh_hgr.nc, mesh_hzr.nc are required.
- !! It is convenient to use an ASCII file as the standard input to give
- !! the name and the imin imax jmin jmax for eaxh section required
- !! The last name of this ASCII file must be EOF
- !!
- !!
- !! history :
- !! Original : J.M. Molines (jan. 2005)
- !! J.M. Molines Apr 2005 : use modules (cdftransportiz)
- !! J.M. Molines March 2006 : just mass transport
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nclass !: number of depth class
- INTEGER ,DIMENSION (:),ALLOCATABLE :: imeter !: limit beetween depth level, in m (nclass -1)
- INTEGER ,DIMENSION (:),ALLOCATABLE :: ilev0,ilev1 !: limit in levels ! nclass
- INTEGER :: jk, jclass !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: imin, imax, jmin, jmax, ik
- INTEGER :: numout = 10
-
- ! broken line stuff
- INTEGER, PARAMETER :: jpseg=10000
- INTEGER :: i0,j0,i1,j1, i, j
- INTEGER :: n,nn,k, jseg
- INTEGER :: norm_u, norm_v, ist, jst
-
- REAL(KIND=4) :: rxi0,ryj0, rxi1, ryj1
- REAL(KIND=4) :: ai,bi, aj,bj,d
- REAL(KIND=4) :: rxx(jpseg),ryy(jpseg)
- REAL(KIND=4), DIMENSION(jpseg) :: gla, gphi
-
- REAL(KIND=8), DIMENSION(jpseg) :: voltrp
- REAL(KIND=8) :: voltrpsum
- COMPLEX yypt(jpseg), yypti
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, e3v ,gphiv, zv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u ,gphiu, zu, zut, zus !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamu, glamv
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw
- REAL(KIND=4) :: rd1, rd2
- REAL(KIND=4) :: udum, vdum
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku,zwkv
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: ztrpu, ztrpv
-
- CHARACTER(LEN=256) :: cfilet, cfileu, cfilev, csection, cfileout='section_trp.dat'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cdum
-
- INTEGER :: nxtarg
- LOGICAL :: ltest=.FALSE.
-
- ! constants
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 2 ) THEN
- PRINT *,' Usage : cdfmasstrp [-test u v ] gridUfile gridVfile ''limit of level'' '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in te current directory'
- PRINT *,' Option -test u v is used for testing purposes, with constant flow field'
- PRINT *,' Output on standard output and on an ascii file called section_trp.dat'
- STOP
- ENDIF
-
-
- CALL getarg (1, cfileu)
- IF ( cfileu == '-test') THEN
- ltest = .TRUE.
- CALL getarg (2, cdum)
- READ(cdum,*) udum
- CALL getarg (3, cdum)
- READ(cdum,*) vdum
- CALL getarg (4, cfileu)
- CALL getarg (5, cfilev)
- nxtarg=5
- ELSE
- CALL getarg (2, cfilev)
- nxtarg=2
- ENDIF
- nclass = narg -nxtarg + 1
-
- ALLOCATE ( imeter(nclass -1), ilev0(nclass), ilev1(nclass) )
-
- DO jk=1, nclass -1
- CALL getarg(nxtarg+jk,cdum)
- READ(cdum,*) imeter(jk)
- END DO
-
- npiglo= getdim (cfileu,'x')
- npjglo= getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE( zu (npiglo,npjglo) )
- ALLOCATE( zv (npiglo,npjglo) )
- !
- ALLOCATE ( zwku (npiglo,npjglo) )
- ALLOCATE ( zwkv (npiglo,npjglo) )
- !
- ALLOCATE ( ztrpu (npiglo,npjglo,nclass), ztrpv (npiglo,npjglo,nclass))
- !
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo))
- !
- ALLOCATE ( gphiu(npiglo,npjglo), gphiv(npiglo,npjglo) )
- ALLOCATE ( glamu(npiglo,npjglo), glamv(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
- !
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
-
- glamv(:,:) = getvar(coordhgr, 'glamv', 1,npiglo,npjglo)
- glamu(:,:) = getvar(coordhgr, 'glamu', 1,npiglo,npjglo)
-
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gphiu(:,:) = getvar(coordhgr, 'gphiu', 1,npiglo,npjglo)
-
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- ! look for nearest level to imeter
- ik = 1
-
- ilev0(1) = 1
- ilev1(nclass) = npk-1
-
- DO jk = 1, nclass -1
- DO WHILE ( gdepw(ik) < imeter(jk) )
- ik = ik +1
- END DO
-
- rd1= ABS(gdepw(ik-1) - imeter(jk) )
- rd2= ABS(gdepw(ik) - imeter(jk) )
- IF ( rd2 < rd1 ) THEN
- ilev1(jk) = ik -1 ! t-levels
- ilev0(jk+1) = ik
- ELSE
- ilev1(jk) = ik -2 ! t-levels
- ilev0(jk+1) = ik -1
- END IF
- END DO
- PRINT *, 'Limits : '
- DO jk = 1, nclass
- PRINT *, ilev0(jk),ilev1(jk), gdepw(ilev0(jk)), gdepw(ilev1(jk)+1)
- END DO
-
- !! compute the transport
- ztrpu (:,:,:)= 0
- ztrpv (:,:,:)= 0
-
- DO jclass = 1, nclass
- DO jk = ilev0(jclass),ilev1(jclass)
- PRINT *,'level ',jk
- ! Get velocities, temperature and salinity fluxes at jk
- IF ( ltest ) THEN
- zu (:,:)= udum
- zv (:,:)= vdum
- ELSE
- zu (:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv (:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- ENDIF
-
- ! get e3u, e3v at level jk
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
-
- zwku (:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)
- zwkv (:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)
-
- ! integrates vertically
- ztrpu (:,:,jclass) = ztrpu (:,:,jclass) + zwku (:,:)
- ztrpv (:,:,jclass) = ztrpv (:,:,jclass) + zwkv (:,:)
-
- END DO ! loop to next level
- END DO ! next class
-
- OPEN(numout,FILE=cfileout)
- DO
- PRINT *, ' Give name of section '
- READ(*,'(a)') csection
- IF (TRIM(csection) == 'EOF' ) CLOSE(numout)
- IF (TRIM(csection) == 'EOF' ) EXIT
- PRINT *, ' Give imin, imax, jmin, jmax '
- READ(*,*) imin, imax, jmin, jmax
- !! Find the broken line between P1 (imin,jmin) and P2 (imax, jmax)
- !! ---------------------------------------------------------------
- ! ... Initialization
- i0=imin; j0=jmin; i1=imax; j1=jmax
- rxi1=i1; ryj1=j1; rxi0=i0; ryj0=j0
-
- ! .. Compute equation: ryj = aj rxi + bj
- IF ( (rxi1 -rxi0) /= 0 ) THEN
- aj = (ryj1 - ryj0 ) / (rxi1 -rxi0)
- bj = ryj0 - aj * rxi0
- ELSE
- aj=10000.
- bj=0.
- END IF
-
- ! .. Compute equation: rxi = ai ryj + bi
- IF ( (ryj1 -ryj0) /= 0 ) THEN
- ai = (rxi1 - rxi0 ) / ( ryj1 -ryj0 )
- bi = rxi0 - ai * ryj0
- ELSE
- ai=10000.
- bi=0.
- END IF
-
- ! .. Compute the integer pathway:
- n=0
-
- ! .. Chose the strait line with the smallest slope
- IF (ABS(aj) <= 1 ) THEN
- ! ... Here, the best line is y(x)
- ! ... If i1 < i0 swap points and remember it has been swapped
- IF (i1 < i0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
-
- IF ( j1 >= j0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 1 ; jst = 0
- norm_u = -1 ; norm_v = -1
- END IF
-
- ! ... compute the nearest j point on the line crossing at i
- DO i=i0,i1
- n=n+1
- IF (n > jpseg) STOP 'n > jpseg !'
- j=NINT(aj*i + bj )
- yypt(n) = CMPLX(i,j)
- END DO
- ELSE
- ! ... Here, the best line is x(y)
- ! ... If j1 < j0 swap points and remember it has been swapped
- IF (j1 < j0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
- IF ( i1 >= i0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 0
- jst = 1
- norm_u = 1
- norm_v = 1
- END IF
-
- ! ... compute the nearest i point on the line crossing at j
- DO j=j0,j1
- n=n+1
- IF (n > jpseg) STOP 'n>jpseg !'
- i=NINT(ai*j + bi)
- yypt(n) = CMPLX(i,j)
- END DO
- END IF
-
- !!
- !! Look for intermediate points to be added.
- ! .. The final positions are saved in rxx,ryy
- rxx(1)=REAL(yypt(1))
- ryy(1)=IMAG(yypt(1))
- nn=1
-
- DO k=2,n
- ! .. distance between 2 neighbour points
- d=ABS(yypt(k)-yypt(k-1))
- ! .. intermediate points required if d > 1
- IF ( d > 1 ) THEN
- CALL interm_pt(yypt,k,ai,bi,aj,bj,yypti)
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypti)
- ryy(nn)=IMAG(yypti)
- END IF
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypt(k))
- ryy(nn)=IMAG(yypt(k))
- END DO
-
- ! Now extract the transport through a section
- ! ... Check whether we need a u velocity or a v velocity
- ! Think that the points are f-points and delimit either a U segment
- ! or a V segment (ist and jst are set in order to look for the correct
- ! velocity point on the C-grid
- PRINT *, TRIM(csection)
- PRINT *, 'IMIN IMAX JMIN JMAX', imin, imax, jmin, jmax
- WRITE(numout,*)'% Transport along a section by levels' ,TRIM(csection)
- WRITE(numout,*) '% nada IMIN IMAX JMIN JMAX'
- DO jclass=1,nclass
- voltrpsum = 0.
-
- DO jseg = 1, nn-1
- i0=rxx(jseg)
- j0=ryy(jseg)
- IF ( rxx(jseg) == rxx(jseg+1) ) THEN
- gla(jseg)=glamu(i0,j0+jst) ; gphi(jseg)=gphiu(i0,j0+jst)
- voltrp(jseg)= ztrpu (i0,j0+jst,jclass)*norm_u
- ELSE IF ( ryy(jseg) == ryy(jseg+1) ) THEN
- gla(jseg)=glamv(i0+ist,j0) ; gphi(jseg)=gphiv(i0+ist,j0)
- voltrp(jseg)=ztrpv (i0+ist,j0,jclass)*norm_v
- ELSE
- PRINT *,' ERROR :', rxx(jseg),ryy(jseg),rxx(jseg+1),ryy(jseg+1)
- END IF
- voltrpsum = voltrpsum+voltrp(jseg)
- END DO ! next segment
- IF (jclass == 1 ) PRINT *, 'FROM (LON LAT): ', gla(1),gphi(1),' TO (LON LAT)', gla(nn-1), gphi(nn-1)
- PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1)
- PRINT *, ' Mass transport : ', voltrpsum/1.e6,' SV'
- IF (jclass == 1 ) THEN
- WRITE(numout,*) '% nada LONmin LATmin '
- WRITE(numout,*) '% nada LONmax LATmax'
- WRITE(numout,*) '% Top(m) Bottom(m) MassTrans(Sv) '
- WRITE(numout,*) 0 ,imin, imax
- WRITE(numout,*) 0 ,jmin, jmax
- WRITE(numout,9003) 0 , gla(1), gphi(1)
- WRITE(numout,9003) 0 , gla(nn-1), gphi(nn-1)
- ENDIF
- WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), voltrpsum/1.e6
-
- END DO ! next class
- END DO ! infinite loop : gets out when input is EOF
-9002 FORMAT(2f9.0, f9.2)
-9003 FORMAT(3f9.2)
-
-
-CONTAINS
- SUBROUTINE interm_pt (ydpt,k,pai,pbi,paj,pbj,ydpti)
- !! -----------------------------------------------------
- !! SUBROUTINE INTERM_PT
- !! ********************
- !!
- !! PURPOSE:
- !! --------
- !! Find the best intermediate points on a pathway.
- !!
- !! ARGUMENTS:
- !! ----------
- !! ydpt : complex vector of the positions of the nearest points
- !! k : current working index
- !! pai ,pbi : slope and original ordinate of x(y)
- !! paj ,pbj : slope and original ordinate of y(x)
- !! ydpti : Complex holding the position of intermediate point
- !!
- !! AUTHOR:
- !! -------
- !! 19/07/1999 : Jean-Marc MOLINES
- !! 14/01/2005 : J M M in F90
- !!
- !!--------------------------------------------------------------
- !!
- !! 0. Declarations:
- !! ----------------
- IMPLICIT NONE
- COMPLEX, INTENT(in) :: ydpt(*)
- COMPLEX, INTENT(out) :: ydpti
- REAL(KIND=4), INTENT(IN) :: pai,pbi,paj,pbj
- INTEGER ,INTENT(in) :: k
- ! ... local
- COMPLEX :: ylptmp1, ylptmp2
- REAL(KIND=4) :: za0,zb0,za1,zb1,zd1,zd2
- REAL(KIND=4) :: zxm,zym
- REAL(KIND=4) :: zxp,zyp
- !!
- !! 1. Compute intermediate points
- !! ------------------------------
- !
- ! ... Determines whether we use y(x) or x(y):
- IF (ABS(paj) <= 1) THEN
- ! ..... y(x)
- ! ... possible intermediate points:
- ylptmp1=ydpt(k-1)+(1.,0.)
- ylptmp2=ydpt(k-1)+CMPLX(0.,SIGN(1.,paj))
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=paj
- zb0=pbj
- !
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd1 is the distance MP
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd2 is the distance MP
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- ! ... chose the smallest (zd1,zd2)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- !
- ELSE
- !
- ! ... x(y)
- ylptmp1=ydpt(k-1)+CMPLX(SIGN(1.,pai),0.)
- ylptmp2=ydpt(k-1)+(0.,1.)
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=pai
- zb0=pbi
- !
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- END IF
- END SUBROUTINE interm_pt
-
-END PROGRAM cdfmasstrp
diff --git a/cdfmax-test.f90 b/cdfmax-test.f90
deleted file mode 100644
index a9cb904..0000000
--- a/cdfmax-test.f90
+++ /dev/null
@@ -1,285 +0,0 @@
-PROGRAM cdfmax
- !!----------------------------------------------------------------------------
- !! *** PROGRAM cdfmax ***
- !!
- !! ** Purpose: Find the min/max of a variable of an nc file. Give its location.
- !! A sub-area can be specified either horizontally and/or vertically
- !!
- !! ** Method: Read command line, open the file get the variable and display the values
- !!
- !! ** Usage : cdfmax -f file -var cdfvarname [-lev kmin kmax -zoom imin imax jmin jmax ]
- !!
- !! History:
- !! 2006 : J-M Molines : from cdfzoom.
- !!
- !!----------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- ! * Module used
- USE cdfio
-
- ! * Local Variable
- IMPLICIT NONE
- !
- INTEGER :: ji,jk,jvar, idep, jt
- INTEGER :: narg, iargc
- INTEGER :: ni,nj,nk,nt,ndim, ntype
- INTEGER :: i1,i2,j1,j2
- INTEGER :: niz,njz, nkz, itime, nvars
- INTEGER :: imin=1, imax=0, jmin=1, jmax=0,kext, istatus, kmin=1, kmax=0
- INTEGER :: ipmin, ipmax, jpmin, jpmax
- INTEGER, DIMENSION (2) :: ilmin, ilmax
- !
- REAL ,DIMENSION(:),ALLOCATABLE :: h, rtime
- REAL ,DIMENSION (:,:), ALLOCATABLE :: v2d, rlon, rlat
- REAL :: rfact=1.0
- !
- CHARACTER(LEN=256) :: cfilein, cline1, cline2
- CHARACTER(LEN=256) :: cvar='none', cdim
- CHARACTER(LEN=256), DIMENSION(:),ALLOCATABLE :: cvarnames
- TYPE(variable), DIMENSION(:),ALLOCATABLE :: typvar
- !
- LOGICAL :: lvar=.false., lfil=.false.
- LOGICAL, DIMENSION(:,:), ALLOCATABLE :: lmask
- !!
- !! Initializations:
- !!-----------------
- !!
- narg = iargc()
- IF (narg == 0) THEN
- PRINT *,'USAGE :cdfmax -f file '// &
- ' -var cdfvarname ' //&
- ' [-lev kmin kmax ' // &
- ' -zoom imin imax jmin jmax -fact multfact]'
- PRINT *, ' -lev and -zoom limit the area for min/max computation'
- PRINT *, ' if not specified : the 3D data is taken '
- PRINT *, ' spval is assumed to be 0 (not taken into account)'
- PRINT *, ' if either imin=imax or jmin=jmax a vertical slab is considered'
-
- STOP
- END IF
- !
- kext=1
- ji=1
- ! Read command line
- DO WHILE (ji <= narg)
- CALL getarg(ji,cline1)
- ji = ji + 1
- IF (cline1 == '-f') THEN
- lfil=.true.
- CALL getarg(ji,cline2)
- ji = ji + 1
- cfilein=cline2
- ELSE IF (cline1 == '-lev') THEN
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) kmin
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) kmax
- ELSE IF (cline1 == '-fact') THEN
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) rfact
- ELSE IF (cline1 == '-zoom') THEN
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) imin
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) imax
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) jmin
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) jmax
- ELSE IF ( cline1 == '-var') THEN
- lvar=.true.
- CALL getarg(ji,cvar)
- ji = ji + 1
-
- ELSE
- PRINT *, cline1,' : unknown option '
- STOP
- END IF
- END DO
-! IF ( .not. lvar .OR. .not. lfil ) THEN
-! PRINT *,' ERROR : you must specify a variable name with -var option AND a filename (-f) '
-! STOP
-! ENDIF
- !
- ! Look for dimensions of the variables in the file
- ni=0 ; nj=0; nk=0; nt=0
-
- ni=getdim(cfilein,'x',cdim,istatus)
- IF ( istatus == 1 ) THEN
- ni=getdim(cfilein,'lon',cdim,istatus)
- IF ( istatus == 1 ) THEN
- PRINT *,' No X or lon dim found ' ; STOP
- ENDIF
- ENDIF
- IF ( imax == 0 ) imax =ni
-
- nj=getdim(cfilein,'y',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nj=getdim(cfilein,'lat',cdim,istatus)
- IF ( istatus == 1 ) THEN
- PRINT *,' No y or lat dim found ' ; STOP
- ENDIF
- ENDIF
- IF ( jmax == 0 ) jmax =nj
-
- nk=getdim(cfilein,'dep',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nk=getdim(cfilein,'z',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nk=getdim(cfilein,'lev',cdim,istatus)
- IF ( istatus == 1 ) THEN
- PRINT *,' No dep or z or lev dim found '
- ENDIF
- ENDIF
- ENDIF
- IF ( kmax == 0 ) kmax =nk
-
- nt=getdim(cfilein,'time',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nt=getdim(cfilein,'step',cdim,istatus)
- IF ( istatus == 1 ) THEN
- PRINT *,' No time or step dim found '
- ENDIF
- ENDIF
-
-
- ! fix the size of the zoomed area, or the whole domain if no zoom
- niz=imax-imin+1
- njz=jmax-jmin+1
- nkz=kmax-kmin+1
-
- IF (nk == 0 ) nk = 1 ; kext=1 ! assume a 2D variable
- IF (nt == 0 ) nt = 1 ; itime=1 ! assume a 1 time frame file
- ! allocate arrays
- ALLOCATE (h(nk), rtime(nt), rlon(niz,njz),rlat(niz,njz))
-
- ! Look for variable name starting with dep
- nvars=getnvar(cfilein)
- ALLOCATE (cvarnames(nvars), typvar(nvars))
- cvarnames=getvarname(cfilein,nvars,typvar)
- DO jvar=1,nvars
- idep=INDEX(cvarnames(jvar),'dep') + INDEX(cvarnames(jvar),'lev')
- IF (idep /= 0 ) EXIT
- END DO
- IF ( jvar == nvars +1 ) THEN
- ! no depth variable found ... we initialize it to levels
- h=(/(ji,ji=1,nk)/)
- ELSE
- h=getvar1d(cfilein,cvarnames(jvar),nk)
- ENDIF
-
- ! Allocate memory and define ntype : (1) = horizontal i-j slab eventually many layers.
- ! (2) = vertical j-k slab, at a given i
- ! (3) = vertical i-k slab, at a given j
- IF ( niz /= 1 .AND. njz /= 1 ) THEN
- ALLOCATE (v2d(niz,njz) ,lmask(niz,njz))
- ntype=1
- ELSE
- IF ( niz == 1 ) THEN
- ALLOCATE (v2d(njz,nkz),lmask(njz,nkz))
- ntype=2
- ELSE
- ALLOCATE(v2d(niz,nkz),lmask(niz,nkz))
- ntype=3
- ENDIF
- ENDIF
-
- ! read latitude, longitude from the header
- rlon=getvar(cfilein,'nav_lon',1,niz,njz,imin,jmin)
- rlat=getvar(cfilein,'nav_lat',1,niz,njz,imin,jmin)
-
-DO
- ndim=getvdim(cfilein,cvar)+1 ! getvdim gives ndim-1 !
- PRINT *,TRIM(cvar),' with multiplying factor of ', rfact, ndim
- ! ndim <=3 corresponds to purely 2D variables (x,y) or (x,y,t)
- IF ( ndim <= 3 ) THEN
- kmin=1 ; kmax=1 ; nkz=1
- ENDIF
-
- SELECT CASE (ntype)
- CASE (1)
- ipmin=imin ; ipmax=imax; jpmin=jmin; jpmax=jmax
- SELECT CASE (ndim)
- CASE( 2,3,4 ) ! assume x,y variable
- PRINT 9000,'time level dep MAX: i long j lat MaxValue MIN: i long j lat MinValue'
- DO jt=1,nt
- DO jk =kmin,kmax
- v2d(:,:)=getvar(cfilein,cvar,jk,niz,njz,ktime=jt)
- print *, v2d(929,705), niz, njz
- lmask(:,:)=.true. ; WHERE ( v2d == 0 ) lmask=.false.
- ilmax=maxloc(v2d,lmask)
- ilmin=minloc(v2d,lmask)
- i1=ilmax(1) ; j1=ilmax(2)
- i2=ilmin(1) ; j2=ilmin(2)
- PRINT 9003, jt, jk, h(jk),i1+imin -1, rlon(i1,j1),j1+jmin -1,rlat(i1,j1),v2d(i1,j1)*rfact, &
- & i2+imin -1, rlon(i2,j2),j2+jmin -1,rlat(i2,j2),v2d(i2,j2)*rfact
- v2d=0.
- print *, v2d(929,705), niz, njz, kmin,kmax, jk
- END DO
- END DO
- EXIT
-
- CASE DEFAULT
- PRINT *,' Non mapable variables x-y :('
- cvar='none'
- END SELECT
-
- CASE (2)
- SELECT CASE (ndim)
- CASE( 4 ) ! assume x,y,z,t variable
- ipmin=jmin ; ipmax=jmax; jpmin=kmin; jpmax=kmax
- v2d(:,:)=getvaryz(cfilein,cvar,imin,njz,nkz,jmin,kmin)
- lmask(:,:)=.true. ; WHERE ( v2d == 0 ) lmask=.false.
- ilmax=maxloc(v2d,lmask)
- ilmin=minloc(v2d,lmask)
- i1=ilmax(1) ; j1=ilmax(2)
- i2=ilmin(1) ; j2=ilmin(2)
- PRINT 9000,' i-slab MAX: i long j lat k dep MaxValue MIN: i long j lat k dep MinValue'
- PRINT 9002, imin, imin, rlon(1,i1),i1+jmin -1,rlat(1,i1),j1+kmin-1, h(j1+kmin-1), v2d(i1,j1)*rfact, &
- & imin, rlon(1,i2),i2+jmin -1,rlat(1,i2),j2+kmin-1, h(j2+kmin-1), v2d(i2,j2)*rfact
- EXIT
- CASE DEFAULT
- PRINT *,' Non mapable variables x-z or y-z :('
- cvar='none'
- END SELECT
-
- CASE (3)
- SELECT CASE (ndim)
- CASE( 4 ) ! assume x,y,z,t variable
- ipmin=imin ; ipmax=imax; jpmin=kmin; jpmax=kmax
- v2d(:,:)=getvarxz(cfilein,cvar,jmin,niz,nkz,imin,kmin)
- lmask(:,:)=.true. ; WHERE ( v2d == 0 ) lmask=.false.
- ilmax=maxloc(v2d,lmask)
- ilmin=minloc(v2d,lmask)
- i1=ilmax(1) ; j1=ilmax(2)
- i2=ilmin(1) ; j2=ilmin(2)
- PRINT 9000,' j-slab MAX: i long j lat k dep MaxValue MIN: i long j lat k dep MinValue'
- PRINT 9002, jmin, i1, rlon(i1,1),jmin,rlat(i1,1),j1+kmin-1, h(j1+kmin-1), v2d(i1,j1)*rfact, &
- & i2, rlon(i2,1),jmin,rlat(i2,1),j2+kmin-1, h(j2+kmin-1), v2d(i2,j2)*rfact
- EXIT
- CASE DEFAULT
- PRINT *,' Non mapable variables x-z or y-z :('
- cvar='none'
- END SELECT
-
- CASE DEFAULT
- PRINT *,' ntype = ',ntype, ' is not defined ' ; STOP
- END SELECT ! ntype
- ENDDO
-
-9000 FORMAT(a)
-9001 FORMAT(i4,1x,f7.2,5x,i4,f8.2, i4, f7.2, e14.5, 5x,i4,f8.2, i4, f7.2, e14.5)
-9002 FORMAT( i4,9x, i4,f8.2, i4, f7.2, i4, f8.2, e14.5, 6x, i4,f8.2, i4, f7.2, i4, f8.2, e14.5 )
-9003 FORMAT(I5,x,i4,1x,f7.2,5x,i4,f8.2, i4, f7.2, e14.5, 5x,i4,f8.2, i4, f7.2, e14.5)
-
-END PROGRAM cdfmax
diff --git a/cdfmax.f90 b/cdfmax.f90
index ce8804c..391e3ad 100644
--- a/cdfmax.f90
+++ b/cdfmax.f90
@@ -1,156 +1,157 @@
PROGRAM cdfmax
- !!----------------------------------------------------------------------------
- !! *** PROGRAM cdfmax ***
+ !!======================================================================
+ !! *** PROGRAM cdfmax ***
+ !!=====================================================================
+ !! ** Purpose : Find the min/max of a variable of an nc file. Give its
+ !! location. A sub-area can be specified either horizontally
+ !! and/or vertically.
!!
- !! ** Purpose: Find the min/max of a variable of an nc file. Give its location.
- !! A sub-area can be specified either horizontally and/or vertically
- !!
- !! ** Method: Read command line, open the file get the variable and display the values
- !!
- !! ** Usage :
- !! cdfmax -f file -var cdfvarname [-lev kmin kmax -zoom imin imax jmin jmax ]
- !! [-fact mutlfactor] [-xy]
- !!
- !! History:
- !! 2006 : J-M Molines : from cdfzoom.
- !!
- !!----------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- ! * Module used
+ !! History : 2.1 : 11/2006 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- ! * Local Variable
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- !
- INTEGER :: ji,jk,jvar, idep, jt
- INTEGER :: narg, iargc
- INTEGER :: ni,nj,nk,nt,ndim, ntype
- INTEGER :: i1,i2,j1,j2
- INTEGER :: niz,njz, nkz, itime, nvars
- INTEGER :: imin=1, imax=0, jmin=1, jmax=0,kext, istatus, kmin=1, kmax=0
- INTEGER :: ipmin, ipmax, jpmin, jpmax
- INTEGER, DIMENSION (2) :: ilmin, ilmax
- !
- REAL ,DIMENSION(:),ALLOCATABLE :: h, rtime
- REAL ,DIMENSION (:,:), ALLOCATABLE :: v2d, rlon, rlat
- REAL :: rfact=1.0
- REAL :: rmissing=0.
- !
- CHARACTER(LEN=256) :: cfilein, cline1, cline2
- CHARACTER(LEN=256) :: cvar='none', cdim
- CHARACTER(LEN=256), DIMENSION(:),ALLOCATABLE :: cvarnames
- TYPE(variable), DIMENSION(:),ALLOCATABLE :: typvar
- !
- LOGICAL :: lvar=.FALSE., lfil=.FALSE., lforcexy=.FALSE.
- LOGICAL, DIMENSION(:,:), ALLOCATABLE :: lmask
- !!
- !! Initializations:
- !!-----------------
- !!
- narg = iargc()
- IF (narg == 0) THEN
- PRINT *,'USAGE :cdfmax -f file '// &
- ' -var cdfvarname ' //&
- ' [-lev kmin kmax ' // &
- ' -zoom imin imax jmin jmax -fact multfact -xy ]'
- PRINT *, ' -lev and -zoom limit the area for min/max computation'
- PRINT *, ' if not specified : the 3D data is taken '
- PRINT *, ' if either imin=imax or jmin=jmax a vertical slab is considered'
- PRINT *, ' UNLESS -xy option is specified !!! '
+ INTEGER(KIND=4) :: ji, jk, jvar, jt
+ INTEGER(KIND=4) :: idep
+ INTEGER(KIND=4) :: narg, iargc, ijarg
+ INTEGER(KIND=4) :: ni, nj, nk, nt ! size of the global domain
+ INTEGER(KIND=4) :: ndim ! dimension of the variables
+ INTEGER(KIND=4) :: ntype ! type of slab (xy, xz, yz ...)
+ INTEGER(KIND=4) :: ii1, ii2, ij1, ij2 ! index of min max
+ INTEGER(KIND=4) :: niz, njz, nkz, nvars ! size of the domain
+ INTEGER(KIND=4) :: iimin=1, iimax=0 ! i-limit of the domain
+ INTEGER(KIND=4) :: ijmin=1, ijmax=0 ! j-limit of the domain
+ INTEGER(KIND=4) :: ikmin=1, ikmax=0 ! k-limit of the domain
+ INTEGER(KIND=4) :: itmin=1, itmax=0 ! t-limit of the domain
+ INTEGER(KIND=4) :: istatus ! working integer
+ INTEGER(KIND=4), DIMENSION(2) :: ilmin, ilmax ! working array for minloc, maxloc
+
+ REAL(KIND=4) :: rfact=1.0 ! multiplying factor
+ REAL(KIND=4) :: zspval ! missing value or spval
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: h ! depth
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, rlon, rlat ! data array, longitude, latitude
+
+ CHARACTER(LEN=256) :: cf_in ! input file name
+ CHARACTER(LEN=256) :: cv_in='none' ! current variable name
+ CHARACTER(LEN=256) :: cldum ! dummy char variable
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! list of variables in file
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! dummy dtructure to read var names
+
+ LOGICAL :: lforcexy=.FALSE. ! flag for forced horizontal slab
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfmax -f file -var cdfvar ...'
+ PRINT *,' ... [-lev kmin kmax ] [-zoom imin imax jmin jmax] ...'
+ PRINT *,' ... [-time tmin tmax ] [-fact multfact] [-xy ]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Find minimum and maximum of a file as well as their '
+ PRINT *,' respective location. Options allow to restrict the '
+ PRINT *,' finding to a sub area in time and space. This program'
+ PRINT *,' also deal with vertical slabs in a domain.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' -f file : input file '
+ PRINT *,' -var cdfvar : input variable'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-lev kmin kmax ] : restrict to level between kmin and kmax. '
+ PRINT *,' [-zoom imin imax jmin jmax] : restrict to sub area specified'
+ PRINT *,' by the given limits. If the zoomed area is '
+ PRINT *,' degenerated to a single line, then the vertical'
+ PRINT *,' slab is considered as domain.'
+ PRINT *,' [-time tmin tmax ] : restrict to the indicated time windows.'
+ PRINT *,' [-fact multfact] : use a multiplicative factor for the output'
+ PRINT *,' [-xy ] : force horizontal slab even in the case of a degenerated'
+ PRINT *,' zoomed area.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' output is done on standard output.'
STOP
- END IF
- !
- kext=1
- ji=1
- ! Read command line
- DO WHILE (ji <= narg)
- CALL getarg(ji,cline1)
- ji = ji + 1
- IF (cline1 == '-f') THEN
- lfil=.TRUE.
- CALL getarg(ji,cline2)
- ji = ji + 1
- cfilein=cline2
- ELSE IF (cline1 == '-lev') THEN
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) kmin
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) kmax
- ELSE IF (cline1 == '-fact') THEN
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) rfact
- ELSE IF (cline1 == '-zoom') THEN
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) imin
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) imax
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) jmin
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) jmax
- ELSE IF ( cline1 == '-var') THEN
- lvar=.TRUE.
- CALL getarg(ji,cvar)
- ji = ji + 1
- ELSE IF ( cline1 == '-xy') THEN
- lforcexy=.TRUE.
- ELSE
- PRINT *, cline1,' : unknown option '
+ ENDIF
+
+ ijarg=1
+ DO WHILE (ijarg <= narg)
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE (cldum )
+ CASE ( '-f' )
+ CALL getarg(ijarg, cf_in) ; ijarg = ijarg + 1
+ CASE ( '-lev' )
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmin
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmax
+ CASE ( '-fact' )
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rfact
+ CASE ( '-zoom' )
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimin
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax
+ CASE ( '-time' )
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itmin
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itmax
+ CASE ( '-var' )
+ CALL getarg(ijarg, cv_in) ; ijarg = ijarg + 1
+ CASE ( '-xy' )
+ lforcexy = .TRUE.
+ CASE DEFAULT
+ PRINT *, cldum,' : unknown option '
STOP
- END IF
+ END SELECT
END DO
- ! IF ( .not. lvar .OR. .not. lfil ) THEN
- ! PRINT *,' ERROR : you must specify a variable name with -var option AND a filename (-f) '
- ! STOP
- ! ENDIF
- !
- ! Look for dimensions of the variables in the file
+
+ IF ( chkfile(cf_in) ) STOP ! missing file
+
ni=0 ; nj=0; nk=0; nt=0
- ni=getdim(cfilein,'x',cdim,istatus)
+ ni = getdim(cf_in, cn_x, cldum, istatus)
IF ( istatus == 1 ) THEN
- ni=getdim(cfilein,'lon',cdim,istatus)
+ ni = getdim(cf_in, 'lon', cldum, istatus)
IF ( istatus == 1 ) THEN
PRINT *,' No X or lon dim found ' ; STOP
ENDIF
ENDIF
- IF ( imax == 0 ) imax =ni
+ IF ( iimax == 0 ) iimax = ni
- nj=getdim(cfilein,'y',cdim,istatus)
+ nj = getdim(cf_in, cn_y, cldum, istatus)
IF ( istatus == 1 ) THEN
- nj=getdim(cfilein,'lat',cdim,istatus)
+ nj = getdim(cf_in, 'lat', cldum, istatus)
IF ( istatus == 1 ) THEN
PRINT *,' No y or lat dim found ' ; STOP
ENDIF
ENDIF
- IF ( jmax == 0 ) jmax =nj
+ IF ( ijmax == 0 ) ijmax = nj
- nk=getdim(cfilein,'dep',cdim,istatus)
+ nk=getdim(cf_in, cn_z, cldum, istatus)
IF ( istatus == 1 ) THEN
- nk=getdim(cfilein,'z',cdim,istatus)
+ nk = getdim(cf_in, 'z', cldum, istatus)
IF ( istatus == 1 ) THEN
- nk=getdim(cfilein,'lev',cdim,istatus)
+ nk = getdim(cf_in, 'lev', cldum, istatus)
IF ( istatus == 1 ) THEN
PRINT *,' No dep or z or lev dim found '
ENDIF
ENDIF
ENDIF
- IF ( kmax == 0 ) kmax =nk
+ IF ( ikmax == 0 ) ikmax = nk
+
+ nt = getdim(cf_in, cn_t, cldum, istatus)
- nt=getdim(cfilein,'time',cdim,istatus)
IF ( istatus == 1 ) THEN
- nt=getdim(cfilein,'step',cdim,istatus)
+ nt = getdim(cf_in, 'step', cldum, istatus)
IF ( istatus == 1 ) THEN
PRINT *,' No time or step dim found '
ENDIF
@@ -158,121 +159,121 @@ PROGRAM cdfmax
! fix the size of the zoomed area, or the whole domain if no zoom
- niz=imax-imin+1
- njz=jmax-jmin+1
- nkz=kmax-kmin+1
+ niz = iimax - iimin + 1
+ njz = ijmax - ijmin + 1
+ nkz = ikmax - ikmin + 1
- IF (nk == 0 ) nk = 1 ; kext=1 ! assume a 2D variable
- IF (nt == 0 ) nt = 1 ; itime=1 ! assume a 1 time frame file
+ IF (nt == 0 ) nt = 1 ! assume a 1 time frame file
+ IF ( itmax == 0 ) itmax = nt
! allocate arrays
- ALLOCATE (h(nk), rtime(nt), rlon(niz,njz),rlat(niz,njz))
+ ALLOCATE (h(nk), rlon(niz,njz), rlat(niz,njz))
! Look for variable name starting with dep
- nvars=getnvar(cfilein)
- ALLOCATE (cvarnames(nvars), typvar(nvars))
- cvarnames=getvarname(cfilein,nvars,typvar)
+ nvars = getnvar(cf_in)
+ ALLOCATE (cv_names(nvars), stypvar(nvars))
+ cv_names = getvarname(cf_in,nvars,stypvar)
DO jvar=1,nvars
- idep=INDEX(cvarnames(jvar),'dep') + INDEX(cvarnames(jvar),'lev')
+ idep = INDEX(cv_names(jvar),'dep') + INDEX(cv_names(jvar),'lev')
IF (idep /= 0 ) EXIT
END DO
+
IF ( jvar == nvars +1 ) THEN
! no depth variable found ... we initialize it to levels
- h=(/(ji,ji=1,nk)/)
+ h = (/(ji,ji=1,nk)/)
ELSE
- h=getvar1d(cfilein,cvarnames(jvar),nk)
+ h = getvar1d(cf_in, cv_names(jvar), nk)
ENDIF
+ zspval = getatt(cf_in, cv_in, cn_missing_value)
! Allocate memory and define ntype : (1) = horizontal i-j slab eventually many layers.
! (2) = vertical j-k slab, at a given i
! (3) = vertical i-k slab, at a given j
IF ( (niz /= 1 .AND. njz /= 1 ) .OR. lforcexy ) THEN
- ALLOCATE (v2d(niz,njz) ,lmask(niz,njz))
- ntype=1
+ ALLOCATE (v2d(niz,njz) )
+ ntype = 1 ! horizontal x-y slabs
ELSE
IF ( niz == 1 ) THEN
- ALLOCATE (v2d(njz,nkz),lmask(njz,nkz))
- ntype=2
+ ALLOCATE (v2d(njz,nkz))
+ ntype = 2 ! vertical y-z slab
ELSE
- ALLOCATE(v2d(niz,nkz),lmask(niz,nkz))
- ntype=3
+ ALLOCATE(v2d(niz,nkz))
+ ntype = 3 ! vertical x-z slab
ENDIF
ENDIF
! read latitude, longitude from the header
- rlon=getvar(cfilein,'nav_lon',1,niz,njz,imin,jmin)
- rlat=getvar(cfilein,'nav_lat',1,niz,njz,imin,jmin)
+ rlon = getvar(cf_in, cn_vlon2d, 1, niz, njz, iimin, ijmin)
+ rlat = getvar(cf_in, cn_vlat2d, 1, niz, njz, iimin, ijmin)
- rmissing=getatt(cfilein, cvar,'missing_value')
DO
- ndim=getvdim(cfilein,cvar)+1 ! getvdim gives ndim-1 !
- PRINT *,TRIM(cvar),' with multiplying factor of ', rfact
+ ndim = getvdim(cf_in, cv_in) + 1 ! getvdim gives ndim-1 !
+ PRINT *,TRIM(cv_in),' with multiplying factor of ', rfact
! ndim <=3 corresponds to purely 2D variables (x,y) or (x,y,t)
IF ( ndim <= 3 ) THEN
- kmin=1 ; kmax=1 ; nkz=1
+ ikmin = 1 ; ikmax = 1 ; nkz = 1
ENDIF
SELECT CASE (ntype)
CASE (1)
- ipmin=imin ; ipmax=imax; jpmin=jmin; jpmax=jmax
SELECT CASE (ndim)
- CASE( 2,3,4 ) ! assume x,y variable
+ CASE( 2,3,4 ) ! assume x,y,z,t variable
PRINT 9000,'time level dep MAX: i long j lat MaxValue MIN: i long j lat MinValue'
- DO jt=1,nt
- DO jk =kmin,kmax
- v2d(:,:)=getvar(cfilein,cvar,jk,niz,njz,kimin=imin,kjmin=jmin,ktime=jt)
- lmask(:,:)=.TRUE. ; WHERE ( v2d == rmissing ) lmask=.FALSE.
- ilmax=MAXLOC(v2d,lmask)
- ilmin=MINLOC(v2d,lmask)
- i1=ilmax(1) ; j1=ilmax(2)
- i2=ilmin(1) ; j2=ilmin(2)
- PRINT 9003, jt, jk, h(jk),i1+imin -1, rlon(i1,j1),j1+jmin -1,rlat(i1,j1),v2d(i1,j1)*rfact, &
- & i2+imin -1, rlon(i2,j2),j2+jmin -1,rlat(i2,j2),v2d(i2,j2)*rfact
+ DO jt=itmin, itmax
+ DO jk=ikmin,ikmax
+ v2d(:,:) = getvar(cf_in, cv_in, jk, niz, njz, kimin=iimin, kjmin=ijmin, ktime=jt)
+ ilmax = MAXLOC(v2d,(v2d /= zspval) )
+ ilmin = MINLOC(v2d,(v2d /= zspval) )
+ ii1=ilmax(1) ; ij1=ilmax(2)
+ ii2=ilmin(1) ; ij2=ilmin(2)
+ PRINT 9003, jt, jk, h(jk),ii1+iimin -1, rlon(ii1,ij1),ij1+ijmin -1,rlat(ii1,ij1),v2d(ii1,ij1)*rfact, &
+ & ii2+iimin -1, rlon(ii2,ij2),ij2+ijmin -1,rlat(ii2,ij2),v2d(ii2,ij2)*rfact
END DO
END DO
EXIT
CASE DEFAULT
PRINT *,' Non mapable variables x-y :('
- cvar='none'
+ cv_in='none'
END SELECT
CASE (2)
SELECT CASE (ndim)
CASE( 4 ) ! assume x,y,z,t variable
- ipmin=jmin ; ipmax=jmax; jpmin=kmin; jpmax=kmax
- v2d(:,:)=getvaryz(cfilein,cvar,imin,njz,nkz,jmin,kmin)
- lmask(:,:)=.TRUE. ; WHERE ( v2d == rmissing ) lmask=.FALSE.
- ilmax=MAXLOC(v2d,lmask)
- ilmin=MINLOC(v2d,lmask)
- i1=ilmax(1) ; j1=ilmax(2)
- i2=ilmin(1) ; j2=ilmin(2)
- ! sorry for nice identation but if not .. rhodes complains
- PRINT 9000,' i-slab MAX: i long j lat k dep MaxValue MIN: i long j lat k dep MinValue'
- PRINT 9002, imin, imin, rlon(1,i1),i1+jmin -1,rlat(1,i1),j1+kmin-1, h(j1+kmin-1), v2d(i1,j1)*rfact, &
- & imin, rlon(1,i2),i2+jmin -1,rlat(1,i2),j2+kmin-1, h(j2+kmin-1), v2d(i2,j2)*rfact
+ PRINT 9000,' time i-slab MAX: i long j lat k dep MaxValue MIN: i &
+ & long j lat k dep MinValue'
+ DO jt=itmin, itmax
+ v2d(:,:) = getvaryz(cf_in, cv_in, iimin, njz, nkz, ijmin, ikmin, ktime=jt)
+ ilmax = MAXLOC(v2d,(v2d/= zspval) )
+ ilmin = MINLOC(v2d,(v2d/= zspval) )
+ ii1=ilmax(1) ; ij1=ilmax(2)
+ ii2=ilmin(1) ; ij2=ilmin(2)
+ PRINT 9002, jt, iimin, iimin, rlon(1,ii1),ii1+ijmin -1,rlat(1,ii1),ij1+ikmin-1, h(ij1+ikmin-1), v2d(ii1,ij1)*rfact, &
+ & iimin, rlon(1,ii2),ii2+ijmin -1,rlat(1,ii2),ij2+ikmin-1, h(ij2+ikmin-1), v2d(ii2,ij2)*rfact
+ END DO
EXIT
CASE DEFAULT
PRINT *,' Non mapable variables x-z or y-z :('
- cvar='none'
+ cv_in='none'
END SELECT
CASE (3)
SELECT CASE (ndim)
CASE( 4 ) ! assume x,y,z,t variable
- ipmin=imin ; ipmax=imax; jpmin=kmin; jpmax=kmax
- v2d(:,:)=getvarxz(cfilein,cvar,jmin,niz,nkz,imin,kmin)
- lmask(:,:)=.TRUE. ; WHERE ( v2d == rmissing ) lmask=.FALSE.
- ilmax=MAXLOC(v2d,lmask)
- ilmin=MINLOC(v2d,lmask)
- i1=ilmax(1) ; j1=ilmax(2)
- i2=ilmin(1) ; j2=ilmin(2)
- PRINT 9000,' j-slab MAX: i long j lat k dep MaxValue MIN: i long j lat k dep MinValue'
- PRINT 9002, jmin, i1, rlon(i1,1),jmin,rlat(i1,1),j1+kmin-1, h(j1+kmin-1), v2d(i1,j1)*rfact, &
- & i2, rlon(i2,1),jmin,rlat(i2,1),j2+kmin-1, h(j2+kmin-1), v2d(i2,j2)*rfact
+ PRINT 9000,' time j-slab MAX: i long j lat k dep MaxValue MIN: i &
+ & long j lat k dep MinValue'
+ DO jt=itmin, itmax
+ v2d(:,:) = getvarxz(cf_in, cv_in, ijmin, niz, nkz, iimin, ikmin, ktime=jt)
+ ilmax = MAXLOC(v2d,(v2d /= zspval) )
+ ilmin = MINLOC(v2d,(v2d /= zspval) )
+ ii1=ilmax(1) ; ij1=ilmax(2)
+ ii2=ilmin(1) ; ij2=ilmin(2)
+ PRINT 9002, jt, ijmin, ii1, rlon(ii1,1),ijmin,rlat(ii1,1),ij1+ikmin-1, h(ij1+ikmin-1), v2d(ii1,ij1)*rfact, &
+ & ii2, rlon(ii2,1),ijmin,rlat(ii2,1),ij2+ikmin-1, h(ij2+ikmin-1), v2d(ii2,ij2)*rfact
+ END DO
EXIT
CASE DEFAULT
PRINT *,' Non mapable variables x-z or y-z :('
- cvar='none'
+ cv_in='none'
END SELECT
CASE DEFAULT
@@ -281,8 +282,7 @@ PROGRAM cdfmax
ENDDO
9000 FORMAT(a)
-9001 FORMAT(i4,1x,f7.2,5x,i5,f8.2, i5, f7.2, e14.5, 5x,i5,f8.2, i5, f7.2, e14.5)
-9002 FORMAT(i4,9x, i5,f8.2, i5, f7.2, i5, f8.2, e14.5, 6x, i5,f8.2, i5, f7.2, i5, f8.2, e14.5 )
+9002 FORMAT(I5, x,i4,9x, i5,f8.2, i5, f7.2, i5, f8.2, e14.5, 6x, i5,f8.2, i5, f7.2, i5, f8.2, e14.5 )
9003 FORMAT(I5, x,i5,1x,f7.2,5x,i5,f8.2, i5, f7.2, e14.5, 5x,i5,f8.2, i5, f7.2, e14.5)
END PROGRAM cdfmax
diff --git a/cdfmax_sp.f90 b/cdfmax_sp.f90
deleted file mode 100644
index ead5835..0000000
--- a/cdfmax_sp.f90
+++ /dev/null
@@ -1,288 +0,0 @@
-PROGRAM cdfmax_sp
- !!----------------------------------------------------------------------------
- !! *** PROGRAM cdfmax_sp ***
- !!
- !! ** Purpose: Find the min/max of a variable of an nc file. Give its location.
- !! A sub-area can be specified either horizontally and/or vertically
- !!
- !! ** Method: Read command line, open the file get the variable and display the values
- !! this version takes spval into account
- !!
- !! ** Usage :
- !! cdfmax_sp -f file -var cdfvarname [-lev kmin kmax -zoom imin imax jmin jmax ]
- !! [-fact mutlfactor] [-xy]
- !!
- !! History:
- !! 2006 : J-M Molines : from cdfzoom.
- !!
- !!----------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- ! * Module used
- USE cdfio
-
- ! * Local Variable
- IMPLICIT NONE
- !
- INTEGER :: ji,jk,jvar, idep, jt
- INTEGER :: narg, iargc
- INTEGER :: ni,nj,nk,nt,ndim, ntype
- INTEGER :: i1,i2,j1,j2
- INTEGER :: niz,njz, nkz, itime, nvars
- INTEGER :: imin=1, imax=0, jmin=1, jmax=0,kext, istatus, kmin=1, kmax=0
- INTEGER :: ipmin, ipmax, jpmin, jpmax
- INTEGER, DIMENSION (2) :: ilmin, ilmax
- !
- REAL ,DIMENSION(:),ALLOCATABLE :: h, rtime
- REAL ,DIMENSION (:,:), ALLOCATABLE :: v2d, rlon, rlat
- REAL :: rfact=1.0, spval
- !
- CHARACTER(LEN=256) :: cfilein, cline1, cline2
- CHARACTER(LEN=256) :: cvar='none', cdim
- CHARACTER(LEN=256), DIMENSION(:),ALLOCATABLE :: cvarnames
- TYPE(variable), DIMENSION(:),ALLOCATABLE :: typvar
- !
- LOGICAL :: lvar=.FALSE., lfil=.FALSE., lforcexy=.FALSE.
- LOGICAL, DIMENSION(:,:), ALLOCATABLE :: lmask
- !!
- !! Initializations:
- !!-----------------
- !!
- narg = iargc()
- IF (narg == 0) THEN
- PRINT *,'USAGE :cdfmax_sp -f file '// &
- ' -var cdfvarname '
- PRINT *, ' [-lev kmin kmax ' // &
- ' -zoom imin imax jmin jmax -fact multfact -xy ]'
- PRINT *, ' -lev and -zoom limit the area for min/max computation'
- PRINT *, ' if not specified : the 3D data is taken '
- PRINT *, ' if either imin=imax or jmin=jmax a vertical slab is considered'
- PRINT *, ' UNLESS -xy option is specified !!! '
-
- STOP
- END IF
- !
- kext=1
- ji=1
- ! Read command line
- DO WHILE (ji <= narg)
- CALL getarg(ji,cline1)
- ji = ji + 1
- IF (cline1 == '-f') THEN
- lfil=.TRUE.
- CALL getarg(ji,cline2)
- ji = ji + 1
- cfilein=cline2
- ELSE IF (cline1 == '-lev') THEN
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) kmin
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) kmax
- ELSE IF (cline1 == '-fact') THEN
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) rfact
- ELSE IF (cline1 == '-zoom') THEN
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) imin
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) imax
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) jmin
- CALL getarg(ji,cline2)
- ji = ji + 1
- READ(cline2,*) jmax
- ELSE IF ( cline1 == '-var') THEN
- lvar=.TRUE.
- CALL getarg(ji,cvar)
- ji = ji + 1
- ELSE IF ( cline1 == '-xy') THEN
- lforcexy=.TRUE.
- ELSE
- PRINT *, cline1,' : unknown option '
- STOP
- END IF
- END DO
- ! IF ( .not. lvar .OR. .not. lfil ) THEN
- ! PRINT *,' ERROR : you must specify a variable name with -var option AND a filename (-f) '
- ! STOP
- ! ENDIF
- !
- ! Look for dimensions of the variables in the file
- ni=0 ; nj=0; nk=0; nt=0
-
- ni=getdim(cfilein,'x',cdim,istatus)
- IF ( istatus == 1 ) THEN
- ni=getdim(cfilein,'lon',cdim,istatus)
- IF ( istatus == 1 ) THEN
- PRINT *,' No X or lon dim found ' ; STOP
- ENDIF
- ENDIF
- IF ( imax == 0 ) imax =ni
-
- nj=getdim(cfilein,'y',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nj=getdim(cfilein,'lat',cdim,istatus)
- IF ( istatus == 1 ) THEN
- PRINT *,' No y or lat dim found ' ; STOP
- ENDIF
- ENDIF
- IF ( jmax == 0 ) jmax =nj
-
- nk=getdim(cfilein,'dep',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nk=getdim(cfilein,'z',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nk=getdim(cfilein,'lev',cdim,istatus)
- IF ( istatus == 1 ) THEN
- PRINT *,' No dep or z or lev dim found '
- ENDIF
- ENDIF
- ENDIF
- IF ( kmax == 0 ) kmax =nk
-
- nt=getdim(cfilein,'time',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nt=getdim(cfilein,'step',cdim,istatus)
- IF ( istatus == 1 ) THEN
- PRINT *,' No time or step dim found '
- ENDIF
- ENDIF
-
-
- ! fix the size of the zoomed area, or the whole domain if no zoom
- niz=imax-imin+1
- njz=jmax-jmin+1
- nkz=kmax-kmin+1
-
- IF (nk == 0 ) nk = 1 ; kext=1 ! assume a 2D variable
- IF (nt == 0 ) nt = 1 ; itime=1 ! assume a 1 time frame file
- ! allocate arrays
- ALLOCATE (h(nk), rtime(nt), rlon(niz,njz),rlat(niz,njz))
-
- ! Look for variable name starting with dep
- nvars=getnvar(cfilein)
- ALLOCATE (cvarnames(nvars), typvar(nvars))
- cvarnames=getvarname(cfilein,nvars,typvar)
- DO jvar=1,nvars
- idep=INDEX(cvarnames(jvar),'dep') + INDEX(cvarnames(jvar),'lev')
- IF (idep /= 0 ) EXIT
- END DO
- IF ( jvar == nvars +1 ) THEN
- ! no depth variable found ... we initialize it to levels
- h=(/(ji,ji=1,nk)/)
- ELSE
- h=getvar1d(cfilein,cvarnames(jvar),nk)
- ENDIF
-
- ! Allocate memory and define ntype : (1) = horizontal i-j slab eventually many layers.
- ! (2) = vertical j-k slab, at a given i
- ! (3) = vertical i-k slab, at a given j
- IF ( (niz /= 1 .AND. njz /= 1 ) .OR. lforcexy ) THEN
- ALLOCATE (v2d(niz,njz) ,lmask(niz,njz))
- ntype=1
- ELSE
- IF ( niz == 1 ) THEN
- ALLOCATE (v2d(njz,nkz),lmask(njz,nkz))
- ntype=2
- ELSE
- ALLOCATE(v2d(niz,nkz),lmask(niz,nkz))
- ntype=3
- ENDIF
- ENDIF
-
- ! read latitude, longitude from the header
- rlon=getvar(cfilein,'nav_lon',1,niz,njz,imin,jmin)
- rlat=getvar(cfilein,'nav_lat',1,niz,njz,imin,jmin)
-
- DO
- ndim=getvdim(cfilein,cvar)+1 ! getvdim gives ndim-1 !
- PRINT *,TRIM(cvar),' with multiplying factor of ', rfact
- ! ndim <=3 corresponds to purely 2D variables (x,y) or (x,y,t)
- IF ( ndim <= 3 ) THEN
- kmin=1 ; kmax=1 ; nkz=1
- ENDIF
- spval=getatt(cfilein,cvar,'missing_value')
-
- SELECT CASE (ntype)
- CASE (1)
- ipmin=imin ; ipmax=imax; jpmin=jmin; jpmax=jmax
- SELECT CASE (ndim)
- CASE( 2,3,4 ) ! assume x,y variable
- PRINT 9000,'time level dep MAX: i long j lat MaxValue MIN: i long j lat MinValue'
- DO jt=1,nt
- DO jk =kmin,kmax
- v2d(:,:)=getvar(cfilein,cvar,jk,niz,njz,kimin=imin,kjmin=jmin,ktime=jt)
- lmask(:,:)=.TRUE. ; WHERE ( v2d == spval ) lmask=.FALSE.
- ilmax=MAXLOC(v2d,lmask)
- ilmin=MINLOC(v2d,lmask)
- i1=ilmax(1) ; j1=ilmax(2)
- i2=ilmin(1) ; j2=ilmin(2)
- PRINT 9003, jt, jk, h(jk),i1+imin -1, rlon(i1,j1),j1+jmin -1,rlat(i1,j1),v2d(i1,j1)*rfact, &
- & i2+imin -1, rlon(i2,j2),j2+jmin -1,rlat(i2,j2),v2d(i2,j2)*rfact
- END DO
- END DO
- EXIT
-
- CASE DEFAULT
- PRINT *,' Non mapable variables x-y :('
- cvar='none'
- END SELECT
-
- CASE (2)
- SELECT CASE (ndim)
- CASE( 4 ) ! assume x,y,z,t variable
- ipmin=jmin ; ipmax=jmax; jpmin=kmin; jpmax=kmax
- v2d(:,:)=getvaryz(cfilein,cvar,imin,njz,nkz,jmin,kmin)
- lmask(:,:)=.TRUE. ; WHERE ( v2d == 0 ) lmask=.FALSE.
- ilmax=MAXLOC(v2d,lmask)
- ilmin=MINLOC(v2d,lmask)
- i1=ilmax(1) ; j1=ilmax(2)
- i2=ilmin(1) ; j2=ilmin(2)
- ! sorry for nice identation but if not .. rhodes complains
- PRINT 9000,' i-slab MAX: i long j lat k dep MaxValue MIN: i long j lat k dep MinValue'
- PRINT 9002, imin, imin, rlon(1,i1),i1+jmin -1,rlat(1,i1),j1+kmin-1, h(j1+kmin-1), v2d(i1,j1)*rfact, &
- & imin, rlon(1,i2),i2+jmin -1,rlat(1,i2),j2+kmin-1, h(j2+kmin-1), v2d(i2,j2)*rfact
- EXIT
- CASE DEFAULT
- PRINT *,' Non mapable variables x-z or y-z :('
- cvar='none'
- END SELECT
-
- CASE (3)
- SELECT CASE (ndim)
- CASE( 4 ) ! assume x,y,z,t variable
- ipmin=imin ; ipmax=imax; jpmin=kmin; jpmax=kmax
- v2d(:,:)=getvarxz(cfilein,cvar,jmin,niz,nkz,imin,kmin)
- lmask(:,:)=.TRUE. ; WHERE ( v2d == 0 ) lmask=.FALSE.
- ilmax=MAXLOC(v2d,lmask)
- ilmin=MINLOC(v2d,lmask)
- i1=ilmax(1) ; j1=ilmax(2)
- i2=ilmin(1) ; j2=ilmin(2)
- PRINT 9000,' j-slab MAX: i long j lat k dep MaxValue MIN: i long j lat k dep MinValue'
- PRINT 9002, jmin, i1, rlon(i1,1),jmin,rlat(i1,1),j1+kmin-1, h(j1+kmin-1), v2d(i1,j1)*rfact, &
- & i2, rlon(i2,1),jmin,rlat(i2,1),j2+kmin-1, h(j2+kmin-1), v2d(i2,j2)*rfact
- EXIT
- CASE DEFAULT
- PRINT *,' Non mapable variables x-z or y-z :('
- cvar='none'
- END SELECT
-
- CASE DEFAULT
- PRINT *,' ntype = ',ntype, ' is not defined ' ; STOP
- END SELECT ! ntype
- ENDDO
-
-9000 FORMAT(a)
-9001 FORMAT(i4,1x,f7.2,5x,i5,f8.2, i5, f7.2, e14.5, 5x,i5,f8.2, i5, f7.2, e14.5)
-9002 FORMAT(i4,9x, i5,f8.2, i5, f7.2, i5, f8.2, e14.5, 6x, i5,f8.2, i5, f7.2, i5, f8.2, e14.5 )
-9003 FORMAT(I5, x,i5,1x,f7.2,5x,i5,f8.2, i5, f7.2, e14.5, 5x,i5,f8.2, i5, f7.2, e14.5)
-
-END PROGRAM cdfmax_sp
diff --git a/cdfmaxmoc.f90 b/cdfmaxmoc.f90
index 5c67cf8..6193e73 100644
--- a/cdfmaxmoc.f90
+++ b/cdfmaxmoc.f90
@@ -1,212 +1,208 @@
PROGRAM cdfmaxmoc
- !!---------------------------------------------------------------------------------------------------
- !! *** PROGRAM cdfmaxmoc ***
- !!
- !! ** Purpose : Compute the maximum of the overturning fonction from a file calculated by cdfmoc
+ !!======================================================================
+ !! *** PROGRAM cdfmaxmoc ***
+ !!=====================================================================
+ !! ** Purpose : Compute the maximum of the overturning fonction from
+ !! a file calculated by cdfmoc
!!
- !! ** Method : maxovt 'ovtfile' latmin latmax depmin depmax
- !! return ovtmaximum and ovt minimum in the defined range.
- !! Also give location of those extrema
- !! works for Atlantic and Global MOC
- !!
- !! * history:
- !! July 2005 : original : J.M. Molines
- !! November : modified and adapted to cdf output R. Dussin.
- !!---------------------------------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
+ !! ** Method : A spatial window, limited by latmin latmax depmin depmax
+ !! given on the command line, is used to determnine the
+ !! maximum and minimum of the MOC as well as their
+ !! respective depth and latitude.
!!
+ !! History : 2.1 : 07/2005 : J.M. Molines : Original code
+ !! : 11/2009 : R. Dussin : Netcdf output
+ !! 3.0 : 03/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
!
- INTEGER :: jj, jk ! dummy loop index
- INTEGER :: npjglo, npk ! size of the overturning
- INTEGER :: narg, iargc ! line command stuff
- INTEGER :: jmin, jmax, kmin, kmax ! (latitude, depth) window where to look at extrema
- INTEGER :: jlatmin, jlatmax, kdmin, kdmax ! index of found extrema
- INTEGER :: iminloc(3), imaxloc(3) ! temporary array to use with minloc/maxloc
- ! added to write in netcdf
- INTEGER :: kx=1, ky=1, kz=1 ! dims of netcdf output file
- INTEGER :: nboutput=6 ! number of values to write in cdf output
- INTEGER :: ncout, ierr ! for netcdf output
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
+ INTEGER(KIND=4) :: jj, jk ! dummy loop index
+ INTEGER(KIND=4) :: npjglo, npk ! size of the overturning
+ INTEGER(KIND=4) :: narg, iargc ! line command stuff
+ INTEGER(KIND=4) :: iarg ! line command stuff
+ INTEGER(KIND=4) :: ijmin, ijmax ! latitude window where to look at extrema
+ INTEGER(KIND=4) :: ikmin, ikmax ! depth window where to look at extrema
+ INTEGER(KIND=4) :: ilatmin, ilatmax ! index of found extrema (latitude)
+ INTEGER(KIND=4) :: idepmin, idepmax ! index of found extrema (depth )
+ INTEGER(KIND=4) :: nx=1, ny=1, nz=1 ! dims of netcdf output file
+ INTEGER(KIND=4) :: nvarout=6 ! number of values to write in cdf output
+ INTEGER(KIND=4) :: ncout, ierr ! for netcdf output
+ INTEGER(KIND=4), DIMENSION(3) :: iminloc, imaxloc ! work arrays for minloc and maxloc
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! netcdf output
!
- REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: zomoc ! zonal MOC (1,npjglo,jpk)
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rlat ! latitude (1, npjglo)
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth read in the header
- REAL(KIND=4) :: ovtmax, ovtmin !
- REAL(KIND=4) :: rlatmin, rlatmax, depmin , depmax
- ! added to write in netcdf
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dumlon, dumlat
- REAL(KIND=4), DIMENSION (1) :: tim ! time counter
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar ! structure of output
+ REAL(KIND=4) :: ovtmax, ovtmin ! max/ min of MOC ( Sv)
+ REAL(KIND=4) :: rlatmin, rlatmax ! latitude limits for searching
+ REAL(KIND=4) :: rdepmin, rdepmax ! depth limits for searching
+ REAL(KIND=4), DIMENSION(1) :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth read in the header
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon, rdumlat ! dummy array for output
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rlat ! latitude (1, npjglo)
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: rmoc ! MOC (1, npjglo, jpk)
!
- CHARACTER(LEN=256) :: cdum, cfile, comment, cbasin, cvar
- ! added to write in netcdf
- CHARACTER(LEN=256) :: cfileoutnc='maxmoc.nc'
- ! added to write in netcdf
- LOGICAL :: lwrtcdf=.TRUE.
-
- ! * main program
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output
+ !
+ CHARACTER(LEN=256) :: cf_moc ! input file
+ CHARACTER(LEN=256) :: cf_ncout='maxmoc.nc' ! output file
+ CHARACTER(LEN=256) :: cldum ! dummy string for I/O
+ CHARACTER(LEN=256) :: cbasin, cv_in ! basin name and cdf variable name
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
narg=iargc()
- IF (narg == 6) THEN
- CALL getarg(1,cfile)
- CALL getarg(2,cbasin)
- CALL getarg(3,cdum)
- READ(cdum,*) rlatmin
- CALL getarg(4,cdum)
- READ(cdum,*) rlatmax
- CALL getarg(5,cdum)
- READ(cdum,*) depmin
- CALL getarg(6,cdum)
- READ(cdum,*) depmax
- ELSE
- PRINT *,' USAGE: cdfmaxmoc ''ovt_file.nc'' cbasin latmin latmax depmin depmax '
- PRINT *,' cbasin is one of atl glo inp ind or pac '
- PRINT *,' Output on standard output by default and maxmoc.nc '
+
+ IF ( narg /= 6 ) THEN
+ PRINT *,' usage : cdfmaxmoc OVT-file cbasin latmin latmax depmin depmax'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the maximum and minimum of the overturning, from file IVT-file,'
+ PRINT *,' for oceanic basin specified by cbasin, and in the geographical frame '
+ PRINT *,' defined by latmin latmax, depmin, depmax.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' OVT-file : overturning file produced by cdfmoc, with of w/o sub basins.'
+ PRINT *,' cbasin : name of oceanic subbasin as defined in ',TRIM(cn_fbasins)
+ PRINT *,' usually it can be one of atl, glo, inp, ind or pac'
+ PRINT *,' glo means no subbasins.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_ncout)
+ PRINT *,' 6 variables : '
+ PRINT *,' maxmoc, minmoc ( sv ) : max and min of overturning'
+ PRINT *,' latmaxmoc latminmoc ( deg) : latitudes of max and min.'
+ PRINT *,' depmaxmoc depminmoc ( m) : depth of max amd min .'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfmoc '
+ PRINT *,' '
STOP
ENDIF
- npjglo=getdim(cfile,'y')
- npk=getdim(cfile,'depth')
+ CALL getarg(1, cf_moc) ! input moc file
+ CALL getarg(2, cbasin) ! basin name
+ CALL getarg(3, cldum ) ; READ(cldum,*) rlatmin ! searching window : latmin
+ CALL getarg(4, cldum ) ; READ(cldum,*) rlatmax ! searching window : latmax
+ CALL getarg(5, cldum ) ; READ(cldum,*) rdepmin ! searching window : depth min
+ CALL getarg(6, cldum ) ; READ(cldum,*) rdepmax ! searching window : depth max
+
+ IF ( chkfile(cf_moc) ) STOP ! missing file
+
+ npjglo = getdim(cf_moc, cn_y)
+ npk = getdim(cf_moc, cn_z)
- ALLOCATE ( zomoc (1,npjglo,npk) ,gdepw(npk), rlat(1,npjglo))
- gdepw(:) = -getvar1d(cfile,'depthw',npk)
- rlat(:,:) = getvar(cfile,'nav_lat',1,1,npjglo)
+ ALLOCATE ( rmoc(1,npjglo,npk), gdepw(npk), rlat(1,npjglo))
+ gdepw(:) = -getvar1d(cf_moc, cn_vdepthw, npk )
+ rlat(:,:) = getvar (cf_moc, cn_vlat2d, 1, 1, npjglo)
SELECT CASE (cbasin)
- CASE ('atl')
- cvar='zomsfatl'
- CASE ('glo')
- cvar='zomsfglo'
- CASE ('pac')
- cvar='zomsfpac'
- CASE ('inp')
- cvar='zomsfinp'
- CASE ('ind')
- cvar='zomsfind'
- CASE DEFAULT
- STOP 'basin not found'
+ CASE ('atl') ; cv_in=cn_zomsfatl
+ CASE ('glo') ; cv_in=cn_zomsfglo
+ CASE ('pac') ; cv_in=cn_zomsfpac
+ CASE ('inp') ; cv_in=cn_zomsfinp
+ CASE ('ind') ; cv_in=cn_zomsfind
+ CASE DEFAULT ; STOP 'basin not found'
END SELECT
- IF(lwrtcdf) THEN
-
- ALLOCATE ( typvar(nboutput), ipk(nboutput), id_varout(nboutput) )
- ALLOCATE (dumlon(1,1) , dumlat(1,1) )
-
- dumlon(:,:)=0.
- dumlat(:,:)=0.
-
- DO jj=1,nboutput
- ipk(jj)=1
- ENDDO
-
- ! define new variables for output
- typvar(1)%name='maxmoc'
- typvar(1)%units='Sverdrup'
- typvar%missing_value=99999.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar%scale_factor= 1.
- typvar%add_offset= 0.
- typvar%savelog10= 0.
- typvar(1)%long_name='Maximum_Overturing'
- typvar(1)%short_name='maxmoc'
- typvar%online_operation='N/A'
- typvar%axis='T'
-
- typvar(2)%name='minmoc'
- typvar(2)%units='Sverdrup'
- typvar(2)%valid_min= -1000.
- typvar(2)%valid_max= 1000.
- typvar(2)%long_name='Minimum_Overtuning'
- typvar(2)%short_name='minmoc'
-
- typvar(3)%name='latmaxmoc'
- typvar(3)%units='Degrees'
- typvar(3)%valid_min= -90.
- typvar(3)%valid_max= 90.
- typvar(3)%long_name='Latitude_of_Maximum_Overturing'
- typvar(3)%short_name='latmaxmoc'
-
- typvar(4)%name='latminmoc'
- typvar(4)%units='Degrees'
- typvar(4)%valid_min= -1000.
- typvar(4)%valid_max= 1000.
- typvar(4)%long_name='Latitude_of_Minimum_Overtuning'
- typvar(4)%short_name='latminmoc'
-
- typvar(5)%name='depthmaxmoc'
- typvar(5)%units='Meters'
- typvar(5)%valid_min= -10000.
- typvar(5)%valid_max= 0.
- typvar(5)%long_name='Depth_of_Maximum_Overturing'
- typvar(5)%short_name='depthmaxmoc'
-
- typvar(6)%name='depthminmoc'
- typvar(6)%units='Meters'
- typvar(6)%valid_min= -10000.
- typvar(6)%valid_max= 0.
- typvar(6)%long_name='Depth_of_Minimum_Overtuning'
- typvar(6)%short_name='depthminmoc'
-
- ENDIF
+ ALLOCATE ( stypvar(nvarout), ipk(nvarout), id_varout(nvarout) )
+ ALLOCATE ( rdumlon(1,1) , rdumlat(1,1) )
+
+ rdumlon(:,:)=0.
+ rdumlat(:,:)=0.
+
+ DO jj=1,nvarout
+ ipk(jj)=1
+ ENDDO
+
+ ! define new variables for output
+ ! all variables :
+ stypvar%rmissing_value = 99999.
+ stypvar%scale_factor = 1.
+ stypvar%add_offset = 0.
+ stypvar%savelog10 = 0.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'T'
+
+ ! each pair of variables
+ stypvar(1)%cname = 'maxmoc' ; stypvar(2)%cname = 'minmoc'
+ stypvar(1)%clong_name = 'Maximum_Overturing' ; stypvar(2)%clong_name = 'Minimum_Overtuning'
+ stypvar(1)%cshort_name = 'maxmoc' ; stypvar(2)%cshort_name = 'minmoc'
+ stypvar(1:2)%cunits = 'Sverdrup'
+ stypvar(1:2)%valid_min = -1000.
+ stypvar(1:2)%valid_max = 1000.
+
+ stypvar(3)%cname = 'latmaxmoc' ; stypvar(4)%cname = 'latminmoc'
+ stypvar(3)%clong_name = 'Latitude_of_Maximum_Overturing' ; stypvar(4)%clong_name = 'Latitude_of_Minimum_Overtuning'
+ stypvar(3)%cshort_name = 'latmaxmoc' ; stypvar(4)%cshort_name = 'latminmoc'
+ stypvar(3:4)%cunits = 'Degrees'
+ stypvar(3:4)%valid_min = -90.
+ stypvar(3:4)%valid_max = 90.
+
+ stypvar(5)%cname = 'depthmaxmoc' ; stypvar(6)%cname = 'depthminmoc'
+ stypvar(5)%clong_name = 'Depth_of_Maximum_Overturing' ; stypvar(6)%clong_name = 'Depth_of_Minimum_Overtuning'
+ stypvar(5)%cshort_name = 'depthmaxmoc' ; stypvar(6)%cshort_name = 'depthminmoc'
+ stypvar(5:6)%cunits = 'Meters'
+ stypvar(5:6)%valid_min = -10000.
+ stypvar(5:6)%valid_max = 0.
DO jk=1,npk
- zomoc (:,:,jk) = getvar(cfile,cvar,jk,1,npjglo)
+ rmoc(:,:,jk) = getvar(cf_moc, cv_in, jk, 1, npjglo)
END DO
- ! look for jmin-jmax :
+ ! define window in index limit
+ ! look for ijmin-ijmax :
DO jj=1, npjglo
- IF ( rlat(1,jj) <= rlatmin ) jmin = jj
- IF ( rlat(1,jj) <= rlatmax ) jmax = jj
+ IF ( rlat(1,jj) <= rlatmin ) ijmin = jj
+ IF ( rlat(1,jj) <= rlatmax ) ijmax = jj
END DO
- ! look for kmin kmax
+ ! look for ikmin ikmax
DO jk=1,npk
- IF ( gdepw(jk) <= depmin ) kmin = jk
- IF ( gdepw(jk) <= depmax ) kmax = jk
+ IF ( gdepw(jk) <= rdepmin ) ikmin = jk
+ IF ( gdepw(jk) <= rdepmax ) ikmax = jk
END DO
! look for max/min overturning
- ovtmax = MAXVAL(zomoc(1,jmin:jmax,kmin:kmax))
- ovtmin = MINVAL(zomoc(1,jmin:jmax,kmin:kmax))
+ ovtmax = MAXVAL(rmoc(1,ijmin:ijmax,ikmin:ikmax))
+ ovtmin = MINVAL(rmoc(1,ijmin:ijmax,ikmin:ikmax))
! find location of min/max
- iminloc =MINLOC(zomoc(:,jmin:jmax,kmin:kmax))
- imaxloc =MAXLOC(zomoc(:,jmin:jmax,kmin:kmax))
+ iminloc =MINLOC(rmoc(:,ijmin:ijmax,ikmin:ikmax))
+ imaxloc =MAXLOC(rmoc(:,ijmin:ijmax,ikmin:ikmax))
! results from minloc/maxloc is relative to the sub -array given as arguments
- jlatmin= iminloc(2)+jmin -1 ; jlatmax = imaxloc(2)+jmin -1
- kdmin = iminloc(3)+kmin -1 ; kdmax = imaxloc(3)+kmin -1
-
- ! PRINT * , 'latmin = ', rlat(1,jmin), 'latmax= ', rlat(1,jmax)
- ! PRINT *, 'Dep min = ', gdepw(kmin), 'Dep max = ',gdepw(kmax)
- PRINT *,' Maximum ', ovtmax ,' Sv latitude ', rlat(1,jlatmax),' depth = ', gdepw(kdmax)
- PRINT *,' Minimum ', ovtmin ,' Sv latitude ', rlat(1,jlatmin),' depth = ', gdepw(kdmin)
-
- IF(lwrtcdf) THEN
-
- ! create output fileset
- ncout =create(cfileoutnc,'none',kx,ky,kz,cdep='depthw')
- ierr= createvar(ncout,typvar,nboutput,ipk,id_varout )
- ierr= putheadervar(ncout, cfile,kx, &
- ky,kz,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw)
- tim=getvar1d(cfile,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ! netcdf output
- ierr = putvar0d(ncout,id_varout(1), REAL(ovtmax) )
- ierr = putvar0d(ncout,id_varout(2), REAL(ovtmin) )
- ierr = putvar0d(ncout,id_varout(3), REAL(rlat(1,jlatmax)) )
- ierr = putvar0d(ncout,id_varout(4), REAL(rlat(1,jlatmin)) )
- ierr = putvar0d(ncout,id_varout(5), REAL(gdepw(kdmax)) )
- ierr = putvar0d(ncout,id_varout(6), REAL(gdepw(kdmin)) )
-
- ierr = closeout(ncout)
-
- ENDIF
+ ilatmin = iminloc(2) + ijmin -1 ; ilatmax = imaxloc(2) + ijmin -1
+ idepmin = iminloc(3) + ikmin -1 ; idepmax = imaxloc(3) + ikmin -1
+
+ PRINT *,' Maximum ', ovtmax ,' Sv latitude ', rlat(1,ilatmax),' depth = ', gdepw(idepmax)
+ PRINT *,' Minimum ', ovtmin ,' Sv latitude ', rlat(1,ilatmin),' depth = ', gdepw(idepmin)
+
+ ! create output fileset
+ ncout = create (cf_ncout, 'none', nx, ny, nz, cdep=cn_vdepthw )
+ ierr = createvar (ncout, stypvar, nvarout, ipk, id_varout )
+
+ ierr = putheadervar(ncout, cf_moc, nx, ny, nz, &
+ pnavlon=rdumlon, pnavlat=rdumlat, pdep=gdepw )
+
+ tim = getvar1d(cf_moc,cn_vtimec, 1 )
+ ierr = putvar1d(ncout, tim, 1, 'T')
+
+ ! netcdf output
+ ierr = putvar0d(ncout,id_varout(1), REAL(ovtmax) )
+ ierr = putvar0d(ncout,id_varout(2), REAL(ovtmin) )
+ ierr = putvar0d(ncout,id_varout(3), REAL(rlat(1,ilatmax)) )
+ ierr = putvar0d(ncout,id_varout(4), REAL(rlat(1,ilatmin)) )
+ ierr = putvar0d(ncout,id_varout(5), REAL(gdepw(idepmax)) )
+ ierr = putvar0d(ncout,id_varout(6), REAL(gdepw(idepmin)) )
+
+ ierr = closeout(ncout)
END PROGRAM cdfmaxmoc
diff --git a/cdfmean-full.f90 b/cdfmean-full.f90
deleted file mode 100644
index 6c1eaec..0000000
--- a/cdfmean-full.f90
+++ /dev/null
@@ -1,173 +0,0 @@
-PROGRAM cdfmean_full
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmean-full ***
- !!
- !! ** Purpose : Compute the Mean Value over the ocean
- !! FULL STEPS
- !!
- !! ** Method : compute the sum ( V * e1 *e2 * e3 *mask )/ sum( e1 * e2 * e3 *mask )
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (Oct. 2005)
- !! Adapted from Partial steps (october 2006)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jk, ik
- INTEGER :: imin=0, imax=0, jmin=0, jmax=0 !: domain limitation for computation
- INTEGER :: kmin=0, kmax=0 !: domain limitation for computation
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvpk !: vertical levels in working variable
-
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: e31d !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, e3, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: npiglo x npjglo
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep !: depth
-
- REAL(KIND=8) :: zvol, zsum, zvol2d, zsum2d, zsurf
- CHARACTER(LEN=256) :: cfilev , cdum
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmask='mask.nc'
- CHARACTER(LEN=256) :: cvar, cvartype
- CHARACTER(LEN=20) :: ce1, ce2, ce3, cvmask, cvtype, cdep
-
-
- INTEGER :: istatus
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmean-full ncfile cdfvar T| U | V | F | W [imin imax jmin jmax kmin kmax] '
- PRINT *,' Computes the mean value of the field (3D, weighted) '
- PRINT *,' imin imax jmin jmax kmin kmax can be given in option '
- PRINT *,' if imin = 0 then ALL i are taken'
- PRINT *,' if jmin = 0 then ALL j are taken'
- PRINT *,' if kmin = 0 then ALL k are taken'
- PRINT *,' FULL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on standard output'
- STOP
- ENDIF
-
- CALL getarg (1, cfilev)
- CALL getarg (2, cvar)
- CALL getarg (3, cvartype)
-
- IF (narg > 3 ) THEN
- IF ( narg /= 9 ) THEN
- PRINT *, ' ERROR : You must give 6 optional values (imin imax jmin jmax kmin kmax)'
- STOP
- ELSE
- ! input optional imin imax jmin jmax
- CALL getarg ( 4,cdum) ; READ(cdum,*) imin
- CALL getarg ( 5,cdum) ; READ(cdum,*) imax
- CALL getarg ( 6,cdum) ; READ(cdum,*) jmin
- CALL getarg ( 7,cdum) ; READ(cdum,*) jmax
- CALL getarg ( 8,cdum) ; READ(cdum,*) kmin
- CALL getarg ( 9,cdum) ; READ(cdum,*) kmax
- ENDIF
- ENDIF
-
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
- nvpk = getvdim(cfilev,cvar)
- IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF
- IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF
- IF (kmin /= 0 ) THEN ; npk =kmax -kmin + 1; ELSE ; kmin=1 ; ENDIF
-
- IF (nvpk == 2 ) nvpk = 1
- IF (nvpk == 3 ) nvpk = npk
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'nvpk =', nvpk
-
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo), e3(npiglo,npjglo) ,e31d(npk))
- ALLOCATE ( gdep(npk) )
-
- SELECT CASE (TRIM(cvartype))
- CASE ( 'T' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3t'
- cvmask='tmask'
- cdep='gdept'
- CASE ( 'U' )
- ce1='e1u'
- ce2='e2u'
- ce3='e3t'
- cvmask='umask'
- cdep='gdept'
- CASE ( 'V' )
- ce1='e1v'
- ce2='e2v'
- ce3='e3t'
- cvmask='vmask'
- cdep='gdept'
- CASE ( 'F' )
- ce1='e1f'
- ce2='e2f'
- ce3='e3t'
- cvmask='fmask'
- cdep='gdept'
- CASE ( 'W' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3w'
- cvmask='tmask'
- cdep='gdepw'
- CASE DEFAULT
- PRINT *, 'this type of variable is not known :', trim(cvartype)
- STOP
- END SELECT
-
- e1(:,:) = getvar(coordhgr, ce1, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- e2(:,:) = getvar(coordhgr, ce2, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- e31d(:) = getvare3(coordzgr,ce3,npk)
- gdep(:) = getvare3(coordzgr,cdep,npk)
-
- zvol=0.d0
- zsum=0.d0
- DO jk = 1,nvpk
- ik = jk+kmin-1
- ! Get velocities v at ik
- zv(:,:)= getvar(cfilev, cvar, ik ,npiglo,npjglo,kimin=imin,kjmin=jmin)
- zmask(:,:)=getvar(cmask,cvmask,ik,npiglo,npjglo,kimin=imin,kjmin=jmin)
-! zmask(:,npjglo)=0.
-
- ! get e3 at level ik ( ps...)
- e3(:,:) = e31d(ik)
-
- !
- zsurf=sum(e1 * e2 * zmask)
- zvol2d=sum(e1 * e2 * e3 * zmask)
- zvol=zvol+zvol2d
- zsum2d=sum(zv*e1*e2*e3*zmask)
- zsum=zsum+zsum2d
- IF (zvol2d /= 0 )THEN
- PRINT *, ' Mean value at level ',ik,'(',gdep(ik),' m) ',zsum2d/zvol2d, 'surface = ',zsurf/1.e6,' km^2'
- ELSE
- PRINT *, ' No points in the water at level ',ik,'(',gdep(ik),' m) '
- ENDIF
-
- END DO
- PRINT * ,' Mean value over the ocean: ', zsum/zvol
-
- END PROGRAM cdfmean_full
diff --git a/cdfmean.f90 b/cdfmean.f90
index b81f40a..a5f227c 100644
--- a/cdfmean.f90
+++ b/cdfmean.f90
@@ -1,277 +1,457 @@
PROGRAM cdfmean
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmean ***
+ !!======================================================================
+ !! *** PROGRAM cdfmean ***
+ !!=====================================================================
+ !! ** Purpose : Compute the Mean Value over the ocean or part of the
+ !! ocean (spatial mean).
!!
- !! ** Purpose : Compute the Mean Value over the ocean
- !! PARTIAL STEPS
- !!
- !! ** Method : compute the sum ( V * e1 *e2 * e3 *mask )/ sum( e1 * e2 * e3 *mask )
+ !! ** Method : mean= sum( V * e1 *e2 * e3 *mask )/ sum( e1 * e2 * e3 *mask ))
+ !! Partial cell version
!!
- !!
- !! history ;
- !! Original : J.M. Molines (Oct. 2005)
- !! R. Dussin (Jul 2009) : add cdf output
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 10/2005 : J.M. Molines : Original code
+ !! : 2.1 : 07/2009 : R. Dussin : Netcdf output
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, ik, jt, jj
- INTEGER :: imin=0, imax=0, jmin=0, jmax=0 !: domain limitation for computation
- INTEGER :: kmin=0, kmax=0 !: domain limitation for computation
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk, nt !: size of the domain
- INTEGER :: nvpk !: vertical levels in working variable
- INTEGER :: numout=10 !: logical unit for output file
- ! added to write in netcdf
- INTEGER :: kx=1, ky=1 ! dims of netcdf output file
- INTEGER :: nvars=2 ! number of values to write in cdf output
- INTEGER :: ncout, ierr ! for netcdf output
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
- !
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, e3, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: npiglo x npjglo
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep !: depth
- ! added to write in netcdf
- REAL(KIND=4) :: threedmeanout, pmissing_value
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dumlon, dumlat, dummymean
- REAL(KIND=4), DIMENSION (1) :: tim ! time counter
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: meanout
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar ! structure of output
- !
- REAL(KIND=8) :: zvol, zsum, zvol2d, zsum2d, zsurf
- CHARACTER(LEN=256) :: cfilev , cdum
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmask='mask.nc'
- CHARACTER(LEN=256) :: cvar, cvartype, cdep
- CHARACTER(LEN=20) :: ce1, ce2, ce3, cvmask, cvtype
- CHARACTER(LEN=256) :: cfilout='out.txt'
- ! added to write in netcdf
- CHARACTER(LEN=256) :: cfileoutnc='cdfmean.nc'
- CHARACTER(LEN=256) :: cdunits, cdlong_name, cdshort_name
- ! added to write in netcdf
- LOGICAL :: lwrtcdf=.TRUE.
-
-
- INTEGER :: istatus
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
+
+ INTEGER(KIND=4) :: jk, jt, jvar ! dummy loop index
+ INTEGER(KIND=4) :: ik, ii, ivar !
+ INTEGER(KIND=4) :: iimin=0, iimax=0 ! domain limitation for computation
+ INTEGER(KIND=4) :: ijmin=0, ijmax=0 ! domain limitation for computation
+ INTEGER(KIND=4) :: ikmin=0, ikmax=0 ! domain limitation for computation
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npiglo_fi ! size of the domain from input file
+ INTEGER(KIND=4) :: npjglo_fi ! size of the domain from input file
+ INTEGER(KIND=4) :: npk_fi ! size of the domain from input file
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvpk ! vertical levels in working variable
+ INTEGER(KIND=4) :: numout=10 ! logical unit for mean output file
+ INTEGER(KIND=4) :: numvar=11 ! logical unit for variance output file
+ INTEGER(KIND=4) :: ikx=1, iky=1 ! dims of netcdf output file
+ INTEGER(KIND=4) :: nvars ! number of values to write in cdf output
+ INTEGER(KIND=4) :: ncout, ierr ! for netcdf output
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout
+
+ REAL(KIND=4) :: zspval ! missing value
+ REAL(KIND=4), DIMENSION(1,1) :: rdummy ! dummy variable
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1, e2, e3, zv ! metrics, velocity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! npiglo x npjglo
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon, rdumlat ! dummy lon/lat for output file
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdummymean ! array for mean value on output file
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdep ! depth
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zdep ! depth of the whole vertical levels
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! 1d vertical spacing
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ REAL(KIND=8) :: dvol, dsum, dsurf ! cumulated values
+ REAL(KIND=8) :: dvol2d, dsum2d !
+ REAL(KIND=8) :: dvar2d, dvar ! for variance computing
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvmeanout ! spatial mean
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvariance ! spatial variance
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvmeanout3d ! global 3D mean value
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvariance3d ! global 3D mean variance
+
+ CHARACTER(LEN=256) :: cv_nam ! current variable name
+ CHARACTER(LEN=256) :: cv_dep ! deptht name
+ CHARACTER(LEN=20) :: cv_e1, cv_e2 ! horizontal metrics names
+ CHARACTER(LEN=20) :: cv_e3, cv_e31d ! vertical metrics names
+ CHARACTER(LEN=20) :: cv_msk ! mask variable name
+ CHARACTER(LEN=256) :: cf_in ! input file name
+ CHARACTER(LEN=256) :: cf_out = 'cdfmean.txt' ! ASCII output file for mean
+ CHARACTER(LEN=256) :: cf_var = 'cdfvar.txt' ! ASCII output file for variance
+ CHARACTER(LEN=256) :: cf_ncout = 'cdfmean.nc' ! NCDF output file
+ CHARACTER(LEN=256) :: cf_zerom = 'zeromean.nc' ! NCDF output file with zeromean field
+ CHARACTER(LEN=256) :: ctype ! type of C-grid point to work with
+ CHARACTER(LEN=256) :: clunits ! attribute of output file : units
+ CHARACTER(LEN=256) :: cllong_name ! " long name
+ CHARACTER(LEN=256) :: clshort_name ! " short name
+ CHARACTER(LEN=256) :: cglobal ! " global
+ CHARACTER(LEN=256) :: cldum ! dummy char variable
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! list of file names
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvarin ! structure of input data
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvarzero ! structure of zeromean output
+
+ LOGICAL :: lfull = .false.! full step flag
+ LOGICAL :: lvar = .false.! variance flag
+ LOGICAL :: lzeromean = .false.! zero mean flag
+ LOGICAL :: lnodep = .false.! no depth flag
+ LOGICAL :: lchk ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmean ncfile cdfvar T| U | V | F | W [imin imax jmin jmax kmin kmax] '
- PRINT *,' Computes the mean value of the field (3D, weighted) '
- PRINT *,' imin imax jmin jmax kmin kmax can be given in option '
- PRINT *,' if imin = 0 then ALL i are taken'
- PRINT *,' if jmin = 0 then ALL j are taken'
- PRINT *,' if kmin = 0 then ALL k are taken'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on standard output'
+ PRINT *,' usage : cdfmean IN-file IN-var T|U|V|F|W [imin imax jmin jmax kmin kmax]'
+ PRINT *,' ... [-full] [-var] [-zeromean] '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes the mean value of the field (3D, weighted). For 3D fields,'
+ PRINT *,' a horizontal mean for each level is also given. If a spatial window'
+ PRINT *,' is specified, the mean value is computed only in this window.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : input netcdf file.'
+ PRINT *,' IN-var : name of netcdf variable to work with.'
+ PRINT *,' T|U|V|F|W : position of cdfvar on the C-grid'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [imin imax jmin jmax kmin kmax] : spatial windows where mean value '
+ PRINT *,' is computed:'
+ PRINT *,' if imin = 0 then ALL i are taken'
+ PRINT *,' if jmin = 0 then ALL j are taken'
+ PRINT *,' if kmin = 0 then ALL k are taken'
+ PRINT *,' [ -full ] : compute the mean for full steps, instead of default '
+ PRINT *,' partial steps.'
+ PRINT *,' [ -var ] : also compute the spatial variance of cdfvar '
+ PRINT *,' [ -zeromean ] : create a file with cdfvar having a zero spatial mean.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' Files ', TRIM(cn_fhgr),', ', TRIM(cn_fzgr),', ', TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' - netcdf file : ', TRIM(cf_ncout)
+ PRINT *,' variables : mean_cdfvar, mean_3D_cdfvar '
+ PRINT *,' [var_cdfvar, var_3D_cdfvar, in case of -var]'
+ PRINT *,' - netcdf file : ', TRIM(cf_zerom),' [ in case of -zeromean option]'
+ PRINT *,' variables : cdfvar'
+ PRINT *,' - ASCII files : ', TRIM(cf_out)
+ PRINT *,' [ ',TRIM(cf_var),', in case of -var ]'
+ PRINT *,' - all output on ASCII files are also sent to standard output.'
STOP
ENDIF
+
! Open standard output with recl=256 to avoid wrapping of long lines (ifort)
OPEN(6,FORM='FORMATTED',RECL=256) ! ifort
-! OPEN(6,FORM='FORMATTED') ! gfortran
-
- CALL getarg (1, cfilev)
- CALL getarg (2, cvar)
- CALL getarg (3, cvartype)
-
- IF (narg > 3 ) THEN
- IF ( narg /= 9 ) THEN
- PRINT *, ' ERROR : You must give 6 optional values (imin imax jmin jmax kmin kmax)'
- STOP
- ELSE
- ! input optional imin imax jmin jmax
- CALL getarg ( 4,cdum) ; READ(cdum,*) imin
- CALL getarg ( 5,cdum) ; READ(cdum,*) imax
- CALL getarg ( 6,cdum) ; READ(cdum,*) jmin
- CALL getarg ( 7,cdum) ; READ(cdum,*) jmax
- CALL getarg ( 8,cdum) ; READ(cdum,*) kmin
- CALL getarg ( 9,cdum) ; READ(cdum,*) kmax
- ENDIF
- ENDIF
+ ! OPEN(6,FORM='FORMATTED') ! gfortran
+
+ cglobal = 'Partial step computation'
+ ijarg = 1 ; ii = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum ) ; ijarg = ijarg + 1
+ SELECT CASE (cldum)
+ CASE ('-full' )
+ lfull = .true.
+ cglobal = 'full step computation'
+ CASE ('-var' )
+ lvar = .true.
+ CASE ('-zeromean' )
+ lzeromean = .true.
+ CASE DEFAULT
+ ii=ii+1
+ SELECT CASE (ii)
+ CASE ( 1 ) ; cf_in = cldum
+ CASE ( 2 ) ; cv_nam = cldum
+ CASE ( 3 ) ; ctype = cldum
+ CASE ( 4 ) ; READ(cldum,*) iimin
+ CASE ( 5 ) ; READ(cldum,*) iimax
+ CASE ( 6 ) ; READ(cldum,*) ijmin
+ CASE ( 7 ) ; READ(cldum,*) ijmax
+ CASE ( 8 ) ; READ(cldum,*) ikmin
+ CASE ( 9 ) ; READ(cldum,*) ikmax
+ CASE DEFAULT
+ PRINT *, ' ERROR : Too many arguments ...'
+ STOP
+ END SELECT
+ END SELECT
+ END DO
+
+ lchk = chkfile(cn_fhgr)
+ lchk = chkfile(cn_fzgr) .OR. lchk
+ lchk = chkfile(cn_fmsk) .OR. lchk
+ lchk = chkfile(cf_in ) .OR. lchk
+ IF ( lchk ) STOP ! missing file
- cdep='none'
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth',cdtrue=cdep,kstatus=istatus)
-
- IF (istatus /= 0 ) THEN
- npk = getdim (cfilev,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfilev,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- npk = getdim (cfilev,'nav_lev',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
+ cv_dep = 'none'
+ npiglo = getdim (cf_in, cn_x)
+ npjglo = getdim (cf_in, cn_y)
+ npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr)
+
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in, 'z', cdtrue=cv_dep, kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in, 'sigma', cdtrue=cv_dep, kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in, 'nav_lev', cdtrue=cv_dep, kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
PRINT *,' assume file with no depth'
npk=0
- ENDIF
+ ENDIF
ENDIF
ENDIF
ENDIF
- nt = getdim (cfilev,'time')
- nvpk = getvdim(cfilev,cvar)
- IF (npk == 0 ) THEN ; npk = 1 ; ENDIF ! no depth dimension ==> 1 level
- IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF
- IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF
- IF (kmin /= 0 ) THEN ; npk =kmax -kmin + 1; ELSE ; kmin=1 ; ENDIF
+ npt = getdim (cf_in, cn_t)
+ nvpk = getvdim(cf_in, cv_nam)
+ ! save original npiglo, npiglo
+ npiglo_fi = npiglo
+ npjglo_fi = npjglo
+ npk_fi = npk
+
+ IF (npk == 0 ) THEN ; lnodep = .true.; npk = 1 ; ENDIF ! no depth dimension ==> 1 level
+ IF (iimin /= 0 ) THEN ; npiglo = iimax -iimin + 1; ELSE ; iimin=1 ; ENDIF
+ IF (ijmin /= 0 ) THEN ; npjglo = ijmax -ijmin + 1; ELSE ; ijmin=1 ; ENDIF
+ IF (ikmin /= 0 ) THEN ; npk = ikmax -ikmin + 1; ELSE ; ikmin=1 ; ENDIF
IF (nvpk == 2 ) nvpk = 1
IF (nvpk == 3 ) nvpk = npk
- WRITE(6, *) 'npiglo=', npiglo
- WRITE(6, *) 'npjglo=', npjglo
- WRITE (6,*) 'npk =', npk
- WRITE (6,*) 'nt =', nt
- WRITE (6,*) 'nvpk =', nvpk
- WRITE (6,*) 'depth dim name is ', TRIM(cdep)
+ WRITE(6, *) 'npiglo = ', npiglo
+ WRITE(6, *) 'npjglo = ', npjglo
+ WRITE(6, *) 'npk = ', npk
+ WRITE(6, *) 'npt = ', npt
+ WRITE(6, *) 'nvpk = ', nvpk
+ WRITE(6, *) 'depth dim name is ', TRIM(cv_dep)
! Allocate arrays
ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo), e3(npiglo,npjglo) )
- ALLOCATE ( gdep (npk) )
- SELECT CASE (TRIM(cvartype))
- CASE ( 'T' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3t_ps'
- cvmask='tmask'
- cdep='gdept'
- CASE ( 'U' )
- ce1='e1u'
- ce2='e2u'
- ce3='e3t_ps'
- cvmask='umask'
- cdep='gdept'
- CASE ( 'V' )
- ce1='e1v'
- ce2='e2v'
- ce3='e3t_ps'
- cvmask='vmask'
- cdep='gdept'
- CASE ( 'F' )
- ce1='e1f'
- ce2='e2f'
- ce3='e3t_ps'
- cvmask='fmask'
- cdep='gdept'
- CASE ( 'W' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3w_ps'
- cvmask='tmask'
- cdep='gdepw'
- CASE DEFAULT
- PRINT *, 'this type of variable is not known :', TRIM(cvartype)
- STOP
+ ALLOCATE ( zv (npiglo,npjglo) )
+ ALLOCATE ( e1 (npiglo,npjglo), e2(npiglo,npjglo), e3(npiglo,npjglo) )
+ ALLOCATE ( gdep (npk), e31d(npk), tim(npt) , dvariance3d(npt), dvmeanout3d(npt) )
+ ALLOCATE ( zdep(npk_fi) )
+
+ SELECT CASE (TRIM(ctype))
+ CASE ( 'T' )
+ cv_e1 = cn_ve1t
+ cv_e2 = cn_ve2t
+ cv_e3 = 'e3t_ps'
+ cv_e31d = cn_ve3t
+ cv_msk = 'tmask'
+ cv_dep = cn_gdept
+ CASE ( 'U' )
+ cv_e1 = cn_ve1u
+ cv_e2 = cn_ve2u
+ cv_e3 = 'e3t_ps'
+ cv_e31d = cn_ve3t
+ cv_msk = 'umask'
+ cv_dep = cn_gdept
+ CASE ( 'V' )
+ cv_e1 = cn_ve1v
+ cv_e2 = cn_ve2v
+ cv_e3 = 'e3t_ps'
+ cv_e31d = cn_ve3t
+ cv_msk = 'vmask'
+ cv_dep = cn_gdept
+ CASE ( 'F' )
+ cv_e1 = cn_ve1f
+ cv_e2 = cn_ve2f
+ cv_e3 = 'e3t_ps'
+ cv_e31d = cn_ve3t
+ cv_msk = 'fmask'
+ cv_dep = cn_gdept
+ CASE ( 'W' )
+ cv_e1 = cn_ve1t
+ cv_e2 = cn_ve2t
+ cv_e3 = 'e3w_ps'
+ cv_e31d = cn_ve3w
+ cv_msk = 'tmask'
+ cv_dep = cn_gdepw
+ CASE DEFAULT
+ PRINT *, 'this type of variable is not known :', TRIM(ctype)
+ STOP
END SELECT
- e1(:,:) = getvar(coordhgr, ce1, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- e2(:,:) = getvar(coordhgr, ce2, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- gdep(:) = getvare3(coordzgr,cdep,npk)
-
- IF(lwrtcdf) THEN
- ALLOCATE ( typvar(nvars), ipk(nvars), id_varout(nvars) )
- ALLOCATE (dumlon(kx,ky) , dumlat(kx,ky), dummymean(kx,ky) )
- ALLOCATE ( meanout(npk) )
-
- dumlon(:,:)=0.
- dumlat(:,:)=0.
-
- ipk(1)=npk ! mean for each level
- ipk(2)=1 ! 3D mean
-
- ierr=getvaratt (cfilev,cvar,cdunits, &
- pmissing_value, cdlong_name, cdshort_name)
-
- ! define new variables for output
- typvar(1)%name='mean_'//TRIM(cvar)
- typvar%units=TRIM(cdunits)
- typvar%missing_value=99999.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar%scale_factor= 1.
- typvar%add_offset= 0.
- typvar%savelog10= 0.
- typvar(1)%long_name='mean_'//TRIM(cdlong_name)
- typvar(1)%short_name='mean_'//TRIM(cdshort_name)
- typvar%online_operation='N/A'
- typvar%axis='ZT'
-
- typvar(2)%name='mean_3D'//TRIM(cvar)
- typvar(2)%long_name='mean_3D'//TRIM(cdlong_name)
- typvar(2)%short_name='mean_3D'//TRIM(cdshort_name)
- typvar%online_operation='N/A'
- typvar%axis='T'
- ENDIF
-
-
- OPEN(numout,FILE=cfilout)
-
- DO jt=1,nt
- zvol=0.d0
- zsum=0.d0
- DO jk = 1,nvpk
- ik = jk+kmin-1
- ! Get velocities v at ik
-! zv(:,:)= getvar(cfilev, cvar, ik ,npiglo,npjglo,kimin=imin,kjmin=jmin)
- zv(:,:)= getvar(cfilev, cvar, ik ,npiglo,npjglo,kimin=imin,kjmin=jmin,ktime=jt)
- zmask(:,:)=getvar(cmask,cvmask,ik,npiglo,npjglo,kimin=imin,kjmin=jmin)
- ! zmask(:,npjglo)=0.
- ! get e3 at level ik ( ps...)
- e3(:,:) = getvar(coordzgr, ce3, ik,npiglo,npjglo,kimin=imin,kjmin=jmin, ldiom=.TRUE.)
-
- !
- zsurf=SUM(e1 * e2 * zmask)
- zvol2d=SUM(e1 * e2 * e3 * zmask)
- zvol=zvol+zvol2d
- zsum2d=SUM(zv*e1*e2*e3*zmask)
- zsum=zsum+zsum2d
- IF (zvol2d /= 0 )THEN
- WRITE(6,*)' Mean value at level ',ik,'(',gdep(ik),' m) ',zsum2d/zvol2d, 'surface = ',zsurf/1.e6,' km^2'
- WRITE(numout,9004) gdep(ik),ik,zsum2d/zvol2d
- IF (lwrtcdf) meanout(jk)=zsum2d/zvol2d
- ELSE
- WRITE(6,*) ' No points in the water at level ',ik,'(',gdep(ik),' m) '
- IF (lwrtcdf) meanout(jk)=99999.
- ENDIF
- END DO
- WRITE(6,*) ' Mean value over the ocean: ', zsum/zvol, jt
- threedmeanout=zsum/zvol
- END DO
- CLOSE(1)
-9004 FORMAT(f9.2,' ',i2,' ',f9.2)
-
- IF(lwrtcdf) THEN
-
- ! create output fileset
- ncout =create(cfileoutnc,'none',kx,ky,npk,cdep=cdep)
- ierr= createvar(ncout,typvar,nvars,ipk,id_varout )
- ierr= putheadervar(ncout, cfilev ,kx, &
- ky,npk,pnavlon=dumlon,pnavlat=dumlat,pdep=gdep,cdep=cdep)
- tim=getvar1d(cfilev,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ! netcdf output
- DO jk=1, nvpk
- dummymean(1,1)=meanout(jk)
- ierr = putvar(ncout, id_varout(1), dummymean, jk, kx, ky )
- END DO
-
- ierr=putvar0d(ncout,id_varout(2), threedmeanout )
-
- ierr = closeout(ncout)
-
- ENDIF
-
- END PROGRAM cdfmean
+ e1(:,:) = getvar (cn_fhgr, cv_e1, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin)
+ e2(:,:) = getvar (cn_fhgr, cv_e2, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin)
+ IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cv_e31d, npk)
+ zdep(:) = getvare3(cn_fzgr, cv_dep, npk_fi)
+ gdep(:) = zdep(ikmin:npk - ikmin + 1)
+
+ IF ( lvar ) THEN
+ nvars = 4 ! space for variance too
+ ELSE
+ nvars = 2 ! default value
+ ENDIF
+
+ ALLOCATE ( stypvar(nvars), ipk(nvars), id_varout(nvars) )
+ ALLOCATE ( rdumlon(ikx,iky), rdumlat(ikx,iky), rdummymean(ikx,iky) )
+ ALLOCATE ( dvmeanout(npk) )
+ IF ( lvar ) ALLOCATE ( dvariance(npk) )
+
+ rdumlon(:,:) = 0.
+ rdumlat(:,:) = 0.
+
+ ipk(1) = npk ! mean for each level
+ ipk(2) = 1 ! 3D mean
+ IF ( lvar ) THEN
+ ipk(3) = npk ! variance for each level
+ ipk(4) = 1 ! 3D variance
+ ENDIF
+
+ ierr=getvaratt (cf_in, cv_nam, clunits, zspval, cllong_name, clshort_name)
+
+ ! define new variables for output
+ stypvar%cunits = TRIM(clunits)
+ stypvar%rmissing_value = 99999.
+ stypvar%valid_min = -1000.
+ stypvar%valid_max = 1000.
+ stypvar%scale_factor = 1.
+ stypvar%add_offset = 0.
+ stypvar%savelog10 = 0.
+ stypvar%conline_operation = 'N/A'
+
+ stypvar(1)%cname = 'mean_'//TRIM(cv_nam)
+ stypvar(1)%clong_name = 'mean_'//TRIM(cllong_name)
+ stypvar(1)%cshort_name = 'mean_'//TRIM(clshort_name)
+ stypvar(1)%caxis = 'ZT'
+
+ stypvar(2)%cname = 'mean_3D'//TRIM(cv_nam)
+ stypvar(2)%clong_name = 'mean_3D'//TRIM(cllong_name)
+ stypvar(2)%cshort_name = 'mean_3D'//TRIM(clshort_name)
+ stypvar(2)%caxis = 'T'
+
+ IF ( lvar) THEN
+ stypvar(3)%cunits = TRIM(clunits)//'^2'
+ stypvar(3)%cname = 'var_'//TRIM(cv_nam)
+ stypvar(3)%clong_name = 'var_'//TRIM(cllong_name)
+ stypvar(3)%cshort_name = 'var_'//TRIM(clshort_name)
+ stypvar(3)%caxis = 'ZT'
+
+ stypvar(4)%cunits = TRIM(clunits)//'^2'
+ stypvar(4)%cname = 'var_3D'//TRIM(cv_nam)
+ stypvar(4)%clong_name = 'var_3D'//TRIM(cllong_name)
+ stypvar(4)%cshort_name = 'var_3D'//TRIM(clshort_name)
+ stypvar(4)%caxis = 'T'
+ ENDIF
+
+ OPEN(numout,FILE=cf_out)
+ IF ( lvar ) OPEN(numvar,FILE=cf_var)
+ ! create output fileset
+ ncout = create (cf_ncout, 'none', ikx, iky, npk, cdep=cv_dep)
+ ierr = createvar (ncout, stypvar, nvars, ipk, id_varout, cdglobal=TRIM(cglobal) )
+ ierr = putheadervar(ncout, cf_in, ikx, iky, npk, pnavlon=rdumlon, pnavlat=rdumlat, pdep=gdep, cdep=cv_dep)
+ tim = getvar1d(cf_in, cn_vtimec, npt)
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ DO jt=1,npt
+ dvol = 0.d0
+ dsum = 0.d0
+ dvar = 0.d0
+ DO jk = 1, nvpk
+ ik = jk+ikmin-1
+ ! Get velocities v at ik
+ zv (:,:) = getvar(cf_in, cv_nam, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jt)
+ zmask(:,:) = getvar(cn_fmsk, cv_msk, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin )
+ IF ( lfull ) THEN
+ e3(:,:) = e31d(jk)
+ ELSE
+ e3(:,:) = getvar(cn_fzgr, cv_e3, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ldiom=.TRUE.)
+ ENDIF
+ !
+ dsurf = SUM(DBLE( e1 * e2 * zmask))
+ dvol2d = SUM(DBLE( e1 * e2 * e3 * zmask))
+ dvol = dvol + dvol2d
+ dsum2d = SUM(DBLE(zv * e1 * e2 * e3 * zmask))
+ dvar2d = SUM(DBLE(zv * zv * e1 * e2 * e3 * zmask))
+ dsum = dsum + dsum2d
+ dvar = dvar + dvar2d
+
+ IF (dvol2d /= 0 )THEN
+ dvmeanout(jk) = dsum2d/dvol2d
+ WRITE(6,*)' Mean value at level ',ik,'(',gdep(ik),' m) ',dvmeanout(jk), 'surface = ',dsurf/1.e6,' km^2'
+ WRITE(numout,9004) gdep(ik), ik, dvmeanout(jk)
+ IF ( lvar ) THEN
+ dvariance(jk) = dvar2d/dvol2d - dvmeanout(jk) * dvmeanout(jk)
+ WRITE(6,*)' Variance value at level ',ik,'(',gdep(ik),' m) ',dvariance(jk), 'surface = ',dsurf/1.e6,' km^2'
+ WRITE(numvar,9004) gdep(ik), ik, dvariance(jk)
+ ENDIF
+ ELSE
+ WRITE(6,*) ' No points in the water at level ',ik,'(',gdep(ik),' m) '
+ dvmeanout(jk) = 99999.
+ dvariance(jk) = 99999.
+ ENDIF
+
+ rdummymean(1,1) = dvmeanout(jk)
+ ierr = putvar(ncout, id_varout(1), rdummymean, jk, ikx, iky, ktime=jt )
+ IF ( lvar ) THEN
+ rdummymean(1,1) = dvariance(jk)
+ ierr = putvar(ncout, id_varout(3), rdummymean, jk, ikx, iky, ktime=jt )
+ ENDIF
+ END DO
+
+ dvmeanout3d(jt) = dsum / dvol
+ WRITE(6,*) ' Mean value over the ocean: ', dvmeanout3d(jt), jt
+ rdummy(:,:) = dvmeanout3d(jt)
+ ierr = putvar0d(ncout, id_varout(2), rdummy, ktime=jt )
+
+ IF ( lvar ) THEN
+ dvariance3d(jt) = dvar/dvol - dsum / dvol * dsum / dvol
+ WRITE(6,*) ' Variance over the ocean: ', dvariance3d(jt), jt
+ rdummy(:,:) = dvariance3d(jt)
+ ierr = putvar0d(ncout, id_varout(4), rdummy, ktime=jt )
+ ENDIF
+
+ END DO ! time loop
+
+ CLOSE(numout)
+ IF ( lvar ) CLOSE(numvar)
+
+ ierr = closeout(ncout)
+9004 FORMAT(f9.2,' ',i2,' ',f9.2)
+
+ ! -zeromean option activated : rest the spatial mean computed above for each timeframe
+ ! from the original variable, and output the result to zeromean.nc
+ ! This replaces exactly the cdfzeromean tool
+ ! The mean value which is used here is eventually computed on a reduced region
+ IF ( lzeromean ) THEN
+ DEALLOCATE ( zv, zmask, id_varout, ipk )
+ npiglo = npiglo_fi ; npjglo = npjglo_fi
+ ALLOCATE (zv(npiglo,npjglo), zmask(npiglo,npjglo) )
+
+ ! re-read file and rest mean value from the variable and store on file
+ nvars = getnvar(cf_in)
+ ALLOCATE ( stypvarin(nvars), cv_names(nvars), stypvarzero(1) )
+ ALLOCATE ( id_varout(1), ipk(1), stypvarzero(1) )
+ cv_names(:) = getvarname(cf_in, nvars, stypvarin)
+
+ ! look for the working variable
+ DO jvar = 1, nvars
+ IF ( TRIM(cv_names(jvar)) == TRIM(cv_nam) ) EXIT
+ END DO
+ ivar = jvar
+
+ ipk(1) = nvpk
+ stypvarzero(1)%cname = cv_nam
+ stypvarzero%cunits = stypvarin(ivar)%cunits
+ stypvarzero%rmissing_value = stypvarin(ivar)%rmissing_value
+ stypvarzero%valid_min = stypvarin(ivar)%valid_min - MAXVAL(dvmeanout3d)
+ stypvarzero%valid_max = stypvarin(ivar)%valid_max - MINVAL(dvmeanout3d)
+ stypvarzero(1)%clong_name = stypvarin(ivar)%clong_name//' zero mean '
+ stypvarzero(1)%cshort_name = cv_nam
+ stypvarzero%conline_operation = 'N/A'
+ stypvarzero%caxis = stypvarin(ivar)%caxis
+
+ ik=nvpk
+ IF ( lnodep ) ik = 0 ! no depth variable in input file : the same in output file
+ ncout = create (cf_zerom, cf_in, npiglo, npjglo, ik )
+ ierr = createvar (ncout , stypvarzero , 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, ik , pdep=zdep)
+ tim = getvar1d(cf_in, cn_vtimec, npt)
+
+ DO jt=1,npt
+ DO jk = 1, nvpk
+ ik = jk+ikmin-1
+ zv (:,:) = getvar(cf_in, cv_nam, ik, npiglo, npjglo, ktime=jt)
+ zmask(:,:) = getvar(cn_fmsk, cv_msk, ik, npiglo, npjglo)
+
+ WHERE (zmask /= 0 ) zv(:,:) = zv(:,:) - dvmeanout3d(jt)
+ ierr = putvar(ncout, id_varout(1), zv, ik, npiglo, npjglo, ktime=jt )
+ END DO
+ END DO
+
+ ierr=putvar1d(ncout, tim, npt,'T')
+ ierr=closeout(ncout )
+
+ ENDIF
+
+END PROGRAM cdfmean
diff --git a/cdfmeanvar.f90 b/cdfmeanvar.f90
deleted file mode 100644
index 1dd52b4..0000000
--- a/cdfmeanvar.f90
+++ /dev/null
@@ -1,184 +0,0 @@
-PROGRAM cdfmeanvar
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmeanvar ***
- !!
- !! ** Purpose : Compute the Mean Value and variance over the ocean
- !! PARTIAL STEPS
- !!
- !! ** Method : compute the sum ( V * e1 *e2 * e3 *mask )/ sum( e1 * e2 * e3 *mask )
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (Oct. 2005)
- !! J.M. Molines Add variance Nov. 2006
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jk, ik, jt
- INTEGER :: imin=0, imax=0, jmin=0, jmax=0 !: domain limitation for computation
- INTEGER :: kmin=0, kmax=0 !: domain limitation for computation
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo,npk,nt !: size of the domain
- INTEGER :: nvpk !: vertical levels in working variable
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, e3, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: npiglo x npjglo
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep !: depth
-
- REAL(KIND=8) :: zvol, zsum, zvol2d, zsum2d, zsurf, zvar, zvar2d
- CHARACTER(LEN=256) :: cfilev , cdum
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmask='mask.nc'
- CHARACTER(LEN=256) :: cvar, cvartype
- CHARACTER(LEN=20) :: ce1, ce2, ce3, cvmask, cvtype, cdep
-
- INTEGER :: istatus
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmeanvar ncfile cdfvar T| U | V | F | W [imin imax jmin jmax kmin kmax] '
- PRINT *,' Computes the mean value, and the spatial variance of the field (3D, weighted) '
- PRINT *,' imin imax jmin jmax kmin kmax can be given in option '
- PRINT *,' if imin = 0 then ALL i are taken'
- PRINT *,' if jmin = 0 then ALL j are taken'
- PRINT *,' if kmin = 0 then ALL k are taken'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on standard output'
- STOP
- ENDIF
-
- CALL getarg (1, cfilev)
- CALL getarg (2, cvar)
- CALL getarg (3, cvartype)
-
- IF (narg > 3 ) THEN
- IF ( narg /= 9 ) THEN
- PRINT *, ' ERROR : You must give 6 optional values (imin imax jmin jmax kmin kmax)'
- STOP
- ELSE
- ! input optional imin imax jmin jmax
- CALL getarg ( 4,cdum) ; READ(cdum,*) imin
- CALL getarg ( 5,cdum) ; READ(cdum,*) imax
- CALL getarg ( 6,cdum) ; READ(cdum,*) jmin
- CALL getarg ( 7,cdum) ; READ(cdum,*) jmax
- CALL getarg ( 8,cdum) ; READ(cdum,*) kmin
- CALL getarg ( 9,cdum) ; READ(cdum,*) kmax
- ENDIF
- ENDIF
-
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
- nvpk = getvdim(cfilev,cvar)
- nt = getdim (cfilev,'time_counter')
-
- IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF
- IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF
- IF (kmin /= 0 ) THEN ; npk =kmax -kmin + 1; ELSE ; kmin=1 ; ENDIF
-
- IF (nvpk == 2 ) nvpk = 1
- IF (nvpk == 3 ) nvpk = npk
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'nvpk =', nvpk
- PRINT *, 'nt =', nt
-
- IF ((npk .EQ. 0) .AND. (nt .GT. 1)) THEN
- npk=1
- PRINT *, 'W A R N I N G : you used a forcing field'
- END IF
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo), e3(npiglo,npjglo) )
- ALLOCATE ( gdep(npk) )
- SELECT CASE (TRIM(cvartype))
- CASE ( 'T' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3t_ps'
- cvmask='tmask'
- cdep='gdept'
- CASE ( 'U' )
- ce1='e1u'
- ce2='e2u'
- ce3='e3t_ps'
- cvmask='umask'
- cdep='gdept'
- CASE ( 'V' )
- ce1='e1v'
- ce2='e2v'
- ce3='e3t_ps'
- cvmask='vmask'
- cdep='gdept'
- CASE ( 'F' )
- ce1='e1f'
- ce2='e2f'
- ce3='e3t_ps'
- cvmask='fmask'
- cdep='gdept'
- CASE ( 'W' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3w_ps'
- cvmask='tmask'
- cdep='gdepw'
- CASE DEFAULT
- PRINT *, 'this type of variable is not known :', trim(cvartype)
- STOP
- END SELECT
-
- e1(:,:) = getvar(coordhgr, ce1, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- e2(:,:) = getvar(coordhgr, ce2, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- gdep(:) = getvare3(coordzgr,cdep,npk)
-
- zvol=0.d0
- zsum=0.d0
- DO jt = 1,nt
- DO jk = 1,nvpk
- ik = jk+kmin-1
- ! Get velocities v at ik
- zv(:,:)= getvar(cfilev, cvar, ik ,npiglo,npjglo,kimin=imin,kjmin=jmin, ktime=jt)
- IF ( nvpk /= 1 .OR. jt == 1 ) THEN
- ! if there is only one level do not read mask and e3 every time step ...
- zmask(:,:)=getvar(cmask,cvmask,ik,npiglo,npjglo,kimin=imin,kjmin=jmin)
- ! get e3 at level ik ( ps...)
- e3(:,:) = getvar(coordzgr, ce3, ik,npiglo,npjglo,kimin=imin,kjmin=jmin, ldiom=.true.)
- END IF
- !
- zsurf=sum(e1 * e2 * zmask)
- zvol2d=sum(e1 * e2 * e3 * zmask)
- zvol=zvol+zvol2d
- zsum2d=sum(zv*e1*e2*e3*zmask)
- zvar2d=sum(zv*zv*e1*e2*e3*zmask)
- zsum=zsum+zsum2d
- zvar=zvar+zvar2d
- IF (zvol2d /= 0 )THEN
- PRINT *, ' Mean value at level ',ik,'(',gdep(ik),' m) ',zsum2d/zvol2d, 'surface = ',zsurf/1.e6,' km^2 jt=', jt
- PRINT *, ' Mean value2 at level ',ik,'(',gdep(ik),' m) ',zvar2d/zvol2d, 'variance=', &
- & zvar2d/zvol2d - (zsum2d/zvol2d)*(zsum2d/zvol2d)
- ELSE
- PRINT *, ' No points in the water at level ',ik,'(',gdep(ik),' m) '
- ENDIF
- END DO
- END DO
-
- PRINT * ,' Mean value over the ocean: ', zsum/zvol
- PRINT * ,' Global variance over the ocean: ', zvar/zvol - (zsum/zvol)*(zsum/zvol)
- PRINT * ,' Global std dev over the ocean: ', sqrt(zvar/zvol - (zsum/zvol)*(zsum/zvol))
-
-END PROGRAM cdfmeanvar
diff --git a/cdfmhst-full.f90 b/cdfmhst-full.f90
deleted file mode 100644
index 3030a0f..0000000
--- a/cdfmhst-full.f90
+++ /dev/null
@@ -1,359 +0,0 @@
-PROGRAM cdfmhst_full
- !!--------------------------------------------------------------------
- !! *** PROGRAM cdfmhst_full ***
- !!
- !! ** Purpose : Compute Meridional Heat Salt Transport.
- !! FULL STEP version
- !!
- !! ** Method : Starts from the mean VT, VS fields computed by cdfvT
- !! Use a basin mask file
- !!
- !!
- !! history :
- !! Original : J.M. Molines (jan. 2005)
- !! J.M. Molines apr. 2005 : use modules
- !!--------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jj,jk !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: numout = 10
- INTEGER, DIMENSION(2) :: iloc
- LOGICAL :: llglo = .false. !: indicator for presence of new_maskglo.nc file
-
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask, e1v, gphiv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
-
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e3t
- REAL(KIND=4) :: zpoints
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwk , ztrp, ztrps, zwks
- REAL(KIND=8) ,DIMENSION(:) , ALLOCATABLE :: zonal_heat_glo, zonal_heat_atl, zonal_heat_pac,&
- & zonal_heat_ind, zonal_heat_aus, zonal_heat_med
- REAL(KIND=8) ,DIMENSION(:) , ALLOCATABLE :: zonal_salt_glo, zonal_salt_atl, zonal_salt_pac,&
- & zonal_salt_ind, zonal_salt_aus, zonal_salt_med, zmtrp
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='zonal_heat_trp.dat', cfileouts='zonal_salt_trp.dat'
- ! to be put in namelist eventually
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cbasinmask='new_maskglo.nc'
-
- ! NC output
- INTEGER :: npvar=1
- INTEGER :: jbasins, js, jvar !: dummy loop index
- INTEGER :: ncout, nbasins, ierr
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
-
- REAL(KIND=4), PARAMETER :: rpspval=9999.99
- REAL(KIND=4), DIMENSION(1) :: gdep
- REAL(KIND=4), DIMENSION (1) :: tim
-
- CHARACTER(LEN=256) :: cfileoutnc='mhst.nc', cdum
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarname !: array of var name for input
- CHARACTER(LEN=4),DIMENSION(5) :: cbasin=(/'_glo','_atl','_inp','_ind','_pac'/)
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar !: structure for attributes
-
-
- ! constants
- REAL(KIND=4),PARAMETER :: rau0=1000., rcp=4000.
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmhst_full VTfile [MST]'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc, new_maskglo.nc must be in te current directory'
- PRINT *,' Output on zonal_heat_trp.dat and zonal_salt_trp.dat'
- STOP
- ENDIF
-
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npvar=1
- IF ( narg == 2 ) THEN
- CALL getarg(2,cdum)
- IF ( cdum /= 'MST' ) THEN
- PRINT *,' unknown option :', TRIM(cdum) ; STOP
- ENDIF
- npvar=2
- ENDIF
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE ( zwk(npiglo,npjglo) ,zmask(npiglo,npjglo),zvt(npiglo,npjglo) )
- ALLOCATE ( zwks(npiglo,npjglo) ,zvs(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo),e3t(npk), gphiv(npiglo,npjglo))
- ALLOCATE ( ztrp(npiglo,npjglo))
- ALLOCATE ( ztrps(npiglo,npjglo))
- ALLOCATE ( zonal_heat_glo(npjglo), zonal_heat_atl(npjglo), zonal_heat_pac(npjglo))
- ALLOCATE ( zonal_heat_ind(npjglo), zonal_heat_aus(npjglo), zonal_heat_med(npjglo) )
- ALLOCATE ( zonal_salt_glo(npjglo), zonal_salt_atl(npjglo), zonal_salt_pac(npjglo))
- ALLOCATE ( zonal_salt_ind(npjglo), zonal_salt_aus(npjglo), zonal_salt_med(npjglo) )
- ALLOCATE ( zmtrp(npjglo) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
-
- ! Read metrics and latitudes
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- e3t(:) = getvare3(coordzgr,'e3t',npk)
- gdep(:) = getvare3(coordzgr, 'depthv' ,1)
-
- iloc=maxloc(gphiv)
- dumlat(1,:) = gphiv(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
-
-
- ztrp(:,:)= 0
- ztrps(:,:)= 0
- DO jk = 1,npk
- PRINT *,'level ',jk
- ! Get temperature and salinity at jk
- zvt(:,:)= getvar(cfilet, 'vomevt', jk ,npiglo,npjglo)
- zvs(:,:)= getvar(cfilet, 'vomevs', jk ,npiglo,npjglo)
-
- ! get e3v at level jk
- zwk(:,:) = zvt(:,:)*e1v(:,:)*e3t(jk)
- zwks(:,:) = zvs(:,:)*e1v(:,:)*e3t(jk)
-
- ! integrates vertically
- ztrp(:,:) = ztrp(:,:) + zwk(:,:) * rau0*rcp
- ztrps(:,:) = ztrps(:,:) + zwks(:,:)
-
- END DO ! loop to next level
-
- ! global
- zmask(:,:)=getvar('mask.nc','vmask',1,npiglo,npjglo)
- DO jj=1,npjglo
- zonal_heat_glo(jj)= SUM( ztrp(2:npiglo-1,jj)*zmask(2:npiglo-1,jj))
- zonal_salt_glo(jj)= SUM( ztrps(2:npiglo-1,jj)*zmask(2:npiglo-1,jj))
- zpoints = SUM(zmask(2:npiglo-1,jj))
- END DO
-
- ! Detects newmaskglo file
- INQUIRE( FILE=cbasinmask, EXIST=llglo )
-
- nbasins=1
- IF ( llglo) THEN ! 5 basins
- nbasins=5
- ENDIF
-
- ! Allocate output variables
- ALLOCATE(typvar(nbasins*npvar),cvarname(nbasins*npvar))
- ALLOCATE(ipk(nbasins*npvar),id_varout(nbasins*npvar))
- ipk(:)=1 ! all output variables have only 1 level !
- DO jbasins = 1,nbasins
- SELECT CASE ( npvar )
- CASE ( 1 ) ! only MHT is output
- cvarname(jbasins) = 'zomht'//TRIM(cbasin(jbasins))
- typvar(jbasins)%name=cvarname(jbasins)
- typvar(jbasins)%units='PW'
- typvar(jbasins)%missing_value=rpspval
- typvar(jbasins)%valid_min=-10.
- typvar(jbasins)%valid_max=20
- typvar(jbasins)%long_name='Meridional Heat Transport '//TRIM(cbasin(jbasins))
- typvar(jbasins)%short_name=cvarname(jbasins)
- typvar(jbasins)%online_operation='N/A'
- typvar(jbasins)%axis='TY'
- CASE ( 2 ) ! both MHT and MST (meridional Salt Transport )
- cvarname(jbasins) = 'zomht'//TRIM(cbasin(jbasins))
- typvar(jbasins)%name=cvarname(jbasins)
- typvar(jbasins)%units='PW'
- typvar(jbasins)%missing_value=rpspval
- typvar(jbasins)%valid_min=-10.
- typvar(jbasins)%valid_max=20
- typvar(jbasins)%long_name='Meridional Heat Transport '//TRIM(cbasin(jbasins))
- typvar(jbasins)%short_name=cvarname(jbasins)
- typvar(jbasins)%online_operation='N/A'
- typvar(jbasins)%axis='TY'
- ! MST
- cvarname(nbasins+jbasins) = 'zomst'//TRIM(cbasin(jbasins))
- typvar(nbasins+jbasins)%name=cvarname(nbasins+jbasins)
- typvar(nbasins+jbasins)%units='T/sec'
- typvar(nbasins+jbasins)%missing_value=rpspval
- typvar(nbasins+jbasins)%valid_min=-10.e9
- typvar(nbasins+jbasins)%valid_max=20.e9
- typvar(nbasins+jbasins)%long_name='Meridional Salt Transport '//TRIM(cbasin(jbasins))
- typvar(nbasins+jbasins)%short_name=cvarname(nbasins+jbasins)
- typvar(nbasins+jbasins)%online_operation='N/A'
- typvar(nbasins+jbasins)%axis='TY'
- CASE DEFAULT
- PRINT * ,' This program is not ready for npvar > 2 ' ; STOP
- END SELECT
- END DO
-
- IF ( llglo ) THEN
- ! Zonal mean with mask
- ! Atlantic
- zmask(:,:)=getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- DO jj=1,npjglo
- zonal_heat_atl(jj) = SUM( ztrp(:,jj) *zmask(:,jj))
- zonal_salt_atl(jj) = SUM( ztrps(:,jj) *zmask(:,jj))
- zpoints = SUM(zmask(:,jj))
- END DO
-
- ! Pacific
- zmask(:,:)=getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- DO jj=1,npjglo
- zonal_heat_pac(jj)= SUM( ztrp(:,jj)*zmask(:,jj))
- zonal_salt_pac(jj)= SUM( ztrps(:,jj)*zmask(:,jj))
- zpoints = SUM(zmask(:,jj))
- END DO
-
- ! Indian
- zmask(:,:)=getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
- DO jj=1,npjglo
- zonal_heat_ind(jj)= SUM( ztrp(:,jj)*zmask(:,jj))
- zonal_salt_ind(jj)= SUM( ztrps(:,jj)*zmask(:,jj))
- zpoints = SUM(zmask(:,jj))
- END DO
-
- ! Austral
- zonal_heat_aus = 0.
- zonal_salt_aus = 0.
-! zmask(:,:)=getvar(cbasinmask,'tmaskant',1,npiglo,npjglo)
-! DO jj=1,npjglo
-! zonal_heat_aus(jj)= SUM( ztrp(:,jj)*zmask(:,jj))
-! zonal_salt_aus(jj)= SUM( ztrps(:,jj)*zmask(:,jj))
-! zpoints = SUM(zmask(:,jj))
-! END DO
-
-! ! Med
- zonal_heat_med = 0.
- zonal_salt_med = 0.
-
-! zmask(:,:)=getvar(cbasinmask,'tmaskmed',1,npiglo,npjglo)
-! DO jj=1,npjglo
-! zonal_heat_med(jj)= SUM( ztrp(:,jj)*zmask(:,jj))
-! zonal_salt_med(jj)= SUM( ztrps(:,jj)*zmask(:,jj))
-! zpoints = SUM(zmask(:,jj))
-! END DO
- ENDIF
-
- ! Output file
- ! create output fileset
- ncout = create(cfileoutnc, cfilet, 1,npjglo,1,cdep='depthv')
- ierr = createvar(ncout ,typvar,nbasins*npvar, ipk,id_varout )
- ierr = putheadervar(ncout, cfilet,1,npjglo,1,pnavlon=dumlon,pnavlat=dumlat,pdep=gdep)
- tim = getvar1d(cfilet,'time_counter',1)
- ierr = putvar1d(ncout,tim,1,'T')
-
- DO jvar=1,npvar ! MHT [ and MST ] (1 or 2 )
- IF ( jvar == 1 ) THEN
- ! MHT
- js=1
- zmtrp(:)=zonal_heat_glo(:)/1.e15 ! GLO
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js=js+1
- IF ( nbasins == 5 ) THEN
- zmtrp(:)=zonal_heat_atl(:)/1.e15 ! ATL
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js=js+1
- zmtrp(:)=zonal_heat_ind(:) + zonal_heat_pac(:)/1.e15 ! INP
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js=js+1
- zmtrp(:)=zonal_heat_ind(:)/1.e15 ! IND
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js=js+1
- zmtrp(:)=zonal_heat_pac(:)/1.e15 ! PAC
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js=js+1
- ENDIF
- ELSE
- ! MST
- zmtrp(:)=zonal_salt_glo(:)/1.e6 ! GLO
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js = js + 1
- IF ( nbasins == 5 ) THEN
- zmtrp(:)=zonal_salt_atl(:)/1.e6 ! ATL
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js = js + 1
- zmtrp(:)=zonal_salt_ind(:) + zonal_salt_pac(:)/1.e6 ! INP
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js = js + 1
- zmtrp(:)=zonal_salt_ind(:)/1.e6 ! IND
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js = js + 1
- zmtrp(:)=zonal_salt_pac(:)/1.e6 ! PAC
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js = js + 1
- ENDIF
- ENDIF
- END DO
- ierr=closeout(ncout)
-
- OPEN(numout,FILE=cfileout)
- WRITE(numout,*)'% FULL STEP COMPUTATION'
- WRITE(numout,*)'% Zonal heat transport (integrated alon I-model coordinate) (in Pw)'
- IF ( llglo ) THEN
- WRITE(numout,*)'! J Global Atlantic Pacific Indian Mediteranean Austral '
- DO jj=npjglo, 1, -1
- WRITE(numout,9000) jj, &
- dumlat(1,jj), zonal_heat_glo(jj)/1e15 , &
- zonal_heat_atl(jj)/1e15, &
- zonal_heat_pac(jj)/1e15, &
- zonal_heat_ind(jj)/1e15, &
- zonal_heat_med(jj)/1e15, &
- zonal_heat_aus(jj)/1e15
- END DO
- ELSE
- WRITE(numout,*)'! J Global '
- DO jj=npjglo, 1, -1
- WRITE(numout,9000) jj, &
- dumlat(1,jj), zonal_heat_glo(jj)/1e15
- END DO
- ENDIF
- !
- CLOSE(numout)
-
- OPEN(numout,FILE=cfileouts)
- WRITE(numout,*)'% FULL STEP COMPUTATION'
- WRITE(numout,*)'% Zonal salt transport (integrated alon I-model coordinate) (in 10^6 kg/s)'
- IF ( llglo ) THEN
- WRITE(numout,*)' ! J Global Atlantic Pacific Indian Mediteranean Austral '
- !
- DO jj=npjglo, 1, -1
- WRITE(numout,9001) jj, &
- dumlat(1,jj), zonal_salt_glo(jj)/1e6 , &
- zonal_salt_atl(jj)/1e6, &
- zonal_salt_pac(jj)/1e6, &
- zonal_salt_ind(jj)/1e6, &
- zonal_salt_med(jj)/1e6, &
- zonal_salt_aus(jj)/1e6
- END DO
- ELSE
- WRITE(numout,*)' J Global '
- DO jj=npjglo, 1, -1
- WRITE(numout,9001) jj, &
- dumlat(1,jj), zonal_salt_glo(jj)/1e6
- ENDDO
- ENDIF
-
- CLOSE(numout)
-
-
-9000 FORMAT(I4,6(1x,f9.3,1x,f8.4))
-9001 FORMAT(I4,6(1x,f9.2,1x,f9.3))
-
-END PROGRAM cdfmhst_full
diff --git a/cdfmhst.f90 b/cdfmhst.f90
index c328d3e..a9ebccc 100644
--- a/cdfmhst.f90
+++ b/cdfmhst.f90
@@ -1,365 +1,418 @@
PROGRAM cdfmhst
- !!--------------------------------------------------------------------
- !! *** PROGRAM cdfmhst ***
+ !!======================================================================
+ !! *** PROGRAM cdfmhst ***
+ !!=====================================================================
+ !! ** Purpose : Compute Meridional Heat Salt Transport.
!!
- !! ** Purpose : Compute Meridional Heat Salt Transport.
- !!
- !! ** Method : Starts from the mean VT, VS fields computed by cdfvT
- !! The program looks for the file "new_maskglo.nc". If it does not exist,
- !! only the calculation over all the domain is performed (this is adequate
- !! for a basin configuration like NATL4).
+ !! ** Method : Starts from the mean VT, VS fields computed by cdfvT.
+ !! Zonal and vertical integration are performed for these
+ !! quantities. If a sub-basin mask is provided, then a
+ !! meridional H/S transoport is computed for each sub basin.
!!
- !!
- !! history :
- !! Original : J.M. Molines (jan. 2005)
- !! J.M. Molines apr. 2005 : use modules
- !! A.M. Treguier (april 2006) adaptation to NATL4 case
- !! J.M. Molines ( April 2007) : add netcdf output
- !!--------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 01/2005 : J.M. Molines : Original code
+ !! : 04/2005 : A.M. Treguier : adaptation to regional config
+ !! : 04/2007 : J.M. Molines : add netcdf output
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jj,jk !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: numout = 10
- INTEGER, DIMENSION(2) :: iloc
- LOGICAL :: llglo = .false. !: indicator for presence of new_maskglo.nc file
-
-
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask, e1v, e3v ,gphiv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
-
- REAL(KIND=4) :: zpoints
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwk , ztrp, ztrps, zwks
- REAL(KIND=8) ,DIMENSION(:) , ALLOCATABLE :: zonal_heat_glo, zonal_heat_atl, zonal_heat_pac,&
- & zonal_heat_ind, zonal_heat_aus, zonal_heat_med
- REAL(KIND=8) ,DIMENSION(:) , ALLOCATABLE :: zonal_salt_glo, zonal_salt_atl, zonal_salt_pac,&
- & zonal_salt_ind, zonal_salt_aus, zonal_salt_med, zmtrp
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='zonal_heat_trp.dat', cfileouts='zonal_salt_trp.dat'
- ! to be put in namelist eventually
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cbasinmask='new_maskglo.nc'
-
- ! NC output
- INTEGER :: npvar=1
- INTEGER :: jbasins, js, jvar !: dummy loop index
- INTEGER :: ncout, nbasins, ierr
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
-
- REAL(KIND=4), PARAMETER :: rpspval=9999.99
- REAL(KIND=4), DIMENSION(1) :: gdep
- REAL(KIND=4), DIMENSION (1) :: tim
-
- CHARACTER(LEN=256) :: cfileoutnc='mhst.nc', cdum
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarname !: array of var name for input
- CHARACTER(LEN=4),DIMENSION(5) :: cbasin=(/'_glo','_atl','_inp','_ind','_pac'/)
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar !: structure for attributes
-
- ! constants
- REAL(KIND=4),PARAMETER :: rau0=1000., rcp=4000.
+
+ INTEGER(KIND=4) :: jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: jbasins, jvar ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg ! argument counter
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: numouth = 10 ! logical unit for heat
+ INTEGER(KIND=4) :: numouts = 11 ! logical unit for salt
+ INTEGER(KIND=4) :: npvar=1 ! number of variables type
+ INTEGER(KIND=4) :: nbasins ! number of basins
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: ivar ! variable index
+ INTEGER(KIND=4), DIMENSION(2) :: iloc ! working array
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! for output variables
+
+ REAL(KIND=4), PARAMETER :: pprau0 = 1000. ! reference density
+ REAL(KIND=4), PARAMETER :: pprcp = 4000. ! specific heat
+ REAL(KIND=4), PARAMETER :: ppspval= 9999.99 ! missing value
+
+ REAL(KIND=4), DIMENSION(1) :: gdep ! dummy depth array
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! 1D e3t for full step
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e3v, gphiv ! metrics and latitude
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvt, zvs ! transport components
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon ! dummy longitude = 0.
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlat ! latitude for i = north pole
+
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_glo ! zonal integral
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_atl ! zonal integral
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_pac
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_ind
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_aus
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_heat_med
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_glo
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_atl
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_pac
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_ind
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_aus
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dzonal_salt_med
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dmtrp ! transport in PW ir kT/s
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwkh, dtrph ! working variables
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtrps, dwks ! working variables
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for attributes
+
+ CHARACTER(LEN=256) :: cf_vtfil ! input VT file name
+ CHARACTER(LEN=256) :: cf_outh='zonal_heat_trp.dat'
+ CHARACTER(LEN=256) :: cf_outs='zonal_salt_trp.dat'
+ CHARACTER(LEN=256) :: cf_outnc='mhst.nc'
+ CHARACTER(LEN=256) :: cv_zomht='zomht' ! MHT variable name
+ CHARACTER(LEN=256) :: cv_zomst='zomst' ! MST variable name
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+ CHARACTER(LEN=4), DIMENSION(5) :: cbasin=(/'_glo','_atl','_inp','_ind','_pac'/)
+ CHARACTER(LEN=80), DIMENSION(:), ALLOCATABLE :: cvarname ! varname arrays
+
+ LOGICAL :: llglo = .FALSE. ! flag for sub basin file
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ LOGICAL :: lfull = .FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
!! Read command line and output usage message if not compliant.
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmhst VTfile [MST] '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc, new_maskglo.nc must be in te current directory'
- PRINT *,' ASCII Output on zonal_heat_trp.dat and zonal_salt_trp.dat'
- PRINT *,' NetCDF Output on mhst.nc with variables :'
- PRINT *,' zomht_glo, zomht_atl, zomht_inp, zomht_pac'
- PRINT *,' and in case of MST option :'
- PRINT *,' zomst_glo, zomst_atl, zomst_inp, zomst_pac'
+ PRINT *,' usage : cdfmhst VT-file [MST] [-full]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the meridional heat/salt transport as a function of '
+ PRINT *,' latitude. If the file ',TRIM(cn_fbasins),' is provided, the meridional '
+ PRINT *,' heat/salt transport for each sub-basin is also computed.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' VT-file : netcdf file containing the mean value of the products'
+ PRINT *,' U.S, U.T, V.S and V.T (obtained with cdfvT).'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [MST ] : output flag for meridional salt transport on netcdf files.'
+ PRINT *,' If not specified, only the MHT is output.'
+ PRINT *,' [-full ] : to be set for full step case.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fhgr),', ',TRIM(cn_fzgr),' and ',TRIM(cn_fmsk)
+ PRINT *,' If ',TRIM(cn_fbasins),' is also available, sub-basin meridional transports'
+ PRINT *,' are also computed.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' ASCII files : ', TRIM(cf_outh),' : Meridional Heat Transport'
+ PRINT *,' ', TRIM(cf_outs),' : Meridional Salt Transport'
+ PRINT *,' netcdf file : ', TRIM(cf_outnc)
+ PRINT *,' variables : ( [... ] : MST option ) '
+ PRINT *,' ', TRIM(cv_zomht),cbasin(1),' : Meridional Heat Transport (global)'
+ PRINT *,' [ ', TRIM(cv_zomst),cbasin(1),' : Meridional Salt Transport (global) ] '
+ PRINT *,' If ',TRIM(cn_fbasins),' is available, per basin meridional transport '
+ PRINT *,' are also available:'
+ DO jbasins=2, 5
+ PRINT *,' ', TRIM(cv_zomht),cbasin(jbasins),' : Meridional Heat Transport'
+ PRINT *,' [ ', TRIM(cv_zomst),cbasin(jbasins),' : Meridional Salt Transport ]'
+ END DO
STOP
ENDIF
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npvar=1
- IF ( narg == 2 ) THEN
- CALL getarg(2,cdum)
- IF ( cdum /= 'MST' ) THEN
- PRINT *,' unknown option :', TRIM(cdum) ; STOP
- ENDIF
- npvar=2
+ npvar = 1 ! default value ( no MST output)
+ ijarg = 1
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg+1
+ SELECT CASE ( cldum)
+ CASE ( 'MST' ) ; npvar =2
+ CASE ( '-full' ) ; lfull = .TRUE.
+ CASE DEFAULT ; cf_vtfil = cldum
+ END SELECT
+ END DO
+
+ ! check for missing files
+ lchk = lchk .OR. chkfile( cn_fhgr )
+ lchk = lchk .OR. chkfile( cn_fzgr )
+ lchk = lchk .OR. chkfile( cn_fmsk )
+ lchk = lchk .OR. chkfile( cf_vtfil)
+ IF ( lchk ) STOP ! missing files
+
+ ! check for sub basin file and set appropriate variables
+ nbasins = 1
+ IF ( .NOT. chkfile(cn_fbasins) ) THEN
+ llglo = .TRUE.
+ nbasins = 5
ENDIF
+ npiglo = getdim (cf_vtfil, cn_x)
+ npjglo = getdim (cf_vtfil, cn_y)
+ npk = getdim (cf_vtfil, cn_z)
+ npt = getdim (cf_vtfil, cn_t)
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
! Allocate arrays
- ALLOCATE ( zwk(npiglo,npjglo) ,zmask(npiglo,npjglo),zvt(npiglo,npjglo) )
- ALLOCATE ( zwks(npiglo,npjglo) ,zvs(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo), gphiv(npiglo,npjglo))
- ALLOCATE ( ztrp(npiglo,npjglo))
- ALLOCATE ( ztrps(npiglo,npjglo))
- ALLOCATE ( zonal_heat_glo(npjglo), zonal_heat_atl(npjglo), zonal_heat_pac(npjglo) )
- ALLOCATE ( zonal_heat_ind(npjglo), zonal_heat_aus(npjglo) , zonal_heat_med(npjglo) )
- ALLOCATE ( zonal_salt_glo(npjglo), zonal_salt_atl(npjglo), zonal_salt_pac(npjglo) )
- ALLOCATE ( zonal_salt_ind(npjglo), zonal_salt_aus(npjglo), zonal_salt_med(npjglo) )
- ALLOCATE ( zmtrp(npjglo) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
-
- ! create output fileset
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gdep(:) = getvare3(coordzgr, 'nav_lev' ,1)
-
- iloc=maxloc(gphiv)
- dumlat(1,:) = gphiv(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
-
-
- ztrp(:,:)= 0
- ztrps(:,:)= 0
- DO jk = 1,npk
- PRINT *,'level ',jk
- ! Get temperature and salinity at jk
- zvt(:,:)= getvar(cfilet, 'vomevt', jk ,npiglo,npjglo)
- zvs(:,:)= getvar(cfilet, 'vomevs', jk ,npiglo,npjglo)
-
- ! get e3v at level jk
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- zwk(:,:) = zvt(:,:)*e1v(:,:)*e3v(:,:)
- zwks(:,:) = zvs(:,:)*e1v(:,:)*e3v(:,:)
-
- ! integrates vertically
- ztrp(:,:) = ztrp(:,:) + zwk(:,:) * rau0*rcp
- ztrps(:,:) = ztrps(:,:) + zwks(:,:)
-
- END DO ! loop to next level
-
- ! global
- zmask(:,:)=getvar('mask.nc','vmask',1,npiglo,npjglo)
- DO jj=1,npjglo
- zonal_heat_glo(jj)= SUM( ztrp(2:npiglo-1,jj)*zmask(2:npiglo-1,jj))
- zonal_salt_glo(jj)= SUM( ztrps(2:npiglo-1,jj)*zmask(2:npiglo-1,jj))
- zpoints = SUM(zmask(2:npiglo-1,jj))
- END DO
-
- ! Detects newmaskglo file
- INQUIRE( FILE=cbasinmask, EXIST=llglo )
-
- nbasins=1
- IF ( llglo) THEN ! 5 basins
- nbasins=5
- ENDIF
-
+ ALLOCATE ( tim(npt) )
+ ALLOCATE ( dwkh(npiglo,npjglo), zmask(npiglo,npjglo), zvt(npiglo,npjglo) )
+ ALLOCATE ( dwks(npiglo,npjglo), zvs(npiglo,npjglo) )
+ ALLOCATE ( e1v(npiglo,npjglo), e3v(npiglo,npjglo), gphiv(npiglo,npjglo))
+ ALLOCATE ( dtrph(npiglo,npjglo))
+ ALLOCATE ( dtrps(npiglo,npjglo))
+ ALLOCATE ( dzonal_heat_glo(npjglo), dzonal_heat_atl(npjglo), dzonal_heat_pac(npjglo) )
+ ALLOCATE ( dzonal_heat_ind(npjglo), dzonal_heat_aus(npjglo), dzonal_heat_med(npjglo) )
+ ALLOCATE ( dzonal_salt_glo(npjglo), dzonal_salt_atl(npjglo), dzonal_salt_pac(npjglo) )
+ ALLOCATE ( dzonal_salt_ind(npjglo), dzonal_salt_aus(npjglo), dzonal_salt_med(npjglo) )
+ ALLOCATE ( dmtrp(npjglo) )
+ ALLOCATE ( rdumlon(1,npjglo), rdumlat(1,npjglo))
+
+ IF ( lfull ) ALLOCATE ( e31d(npk) )
+
+ e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo)
+ gphiv(:,:) = getvar(cn_fhgr, cn_gphiv, 1, npiglo, npjglo)
+ gdep(:) = 0. ! dummy depth for netcdf output
+
+ IF ( lfull ) e31d = getvare3(cn_fzgr, cn_ve3t, npk )
+
+ iloc = MAXLOC( gphiv )
+ rdumlat(1,:) = gphiv(iloc(1),:)
+ rdumlon(:,:) = 0. ! set the dummy longitude to 0
+
+ ! prepare output netcdf output file
! Allocate output variables
- ALLOCATE(typvar(nbasins*npvar),cvarname(nbasins*npvar))
- ALLOCATE(ipk(nbasins*npvar),id_varout(nbasins*npvar))
+ ALLOCATE(stypvar(nbasins*npvar), cvarname(nbasins*npvar) )
+ ALLOCATE( ipk(nbasins*npvar), id_varout(nbasins*npvar) )
+
ipk(:)=1 ! all output variables have only 1 level !
DO jbasins = 1,nbasins
- SELECT CASE ( npvar )
- CASE ( 1 ) ! only MHT is output
- cvarname(jbasins) = 'zomht'//TRIM(cbasin(jbasins))
- typvar(jbasins)%name=cvarname(jbasins)
- typvar(jbasins)%units='PW'
- typvar(jbasins)%missing_value=rpspval
- typvar(jbasins)%valid_min=-10.
- typvar(jbasins)%valid_max=20
- typvar(jbasins)%long_name='Meridional Heat Transport '//TRIM(cbasin(jbasins))
- typvar(jbasins)%short_name=cvarname(jbasins)
- typvar(jbasins)%online_operation='N/A'
- typvar(jbasins)%axis='TY'
- CASE ( 2 ) ! both MHT and MST (meridional Salt Transport )
- cvarname(jbasins) = 'zomht'//TRIM(cbasin(jbasins))
- typvar(jbasins)%name=cvarname(jbasins)
- typvar(jbasins)%units='PW'
- typvar(jbasins)%missing_value=rpspval
- typvar(jbasins)%valid_min=-10.
- typvar(jbasins)%valid_max=20
- typvar(jbasins)%long_name='Meridional Heat Transport '//TRIM(cbasin(jbasins))
- typvar(jbasins)%short_name=cvarname(jbasins)
- typvar(jbasins)%online_operation='N/A'
- typvar(jbasins)%axis='TY'
- ! MST
- cvarname(nbasins+jbasins) = 'zomst'//TRIM(cbasin(jbasins))
- typvar(nbasins+jbasins)%name=cvarname(nbasins+jbasins)
- typvar(nbasins+jbasins)%units='T/sec'
- typvar(nbasins+jbasins)%missing_value=rpspval
- typvar(nbasins+jbasins)%valid_min=-10.e9
- typvar(nbasins+jbasins)%valid_max=20.e9
- typvar(nbasins+jbasins)%long_name='Meridional Salt Transport '//TRIM(cbasin(jbasins))
- typvar(nbasins+jbasins)%short_name=cvarname(nbasins+jbasins)
- typvar(nbasins+jbasins)%online_operation='N/A'
- typvar(nbasins+jbasins)%axis='TY'
- CASE DEFAULT
- PRINT * ,' This program is not ready for npvar > 2 ' ; STOP
- END SELECT
- END DO
-
- IF ( llglo ) THEN
- ! Zonal mean with mask
- ! Atlantic
- zmask(:,:)=getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- DO jj=1,npjglo
- zonal_heat_atl(jj) = SUM( ztrp(:,jj) *zmask(:,jj))
- zonal_salt_atl(jj) = SUM( ztrps(:,jj) *zmask(:,jj))
- zpoints = SUM(zmask(:,jj))
- END DO
- ! Pacific
- zmask(:,:)=getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- DO jj=1,npjglo
- zonal_heat_pac(jj)= SUM( ztrp(:,jj)*zmask(:,jj))
- zonal_salt_pac(jj)= SUM( ztrps(:,jj)*zmask(:,jj))
- zpoints = SUM(zmask(:,jj))
- END DO
+ cvarname(jbasins) = TRIM(cv_zomht)//TRIM(cbasin(jbasins))
+ stypvar(jbasins)%cname = cvarname(jbasins)
+ stypvar(jbasins)%cunits = 'PW'
+ stypvar(jbasins)%rmissing_value = ppspval
+ stypvar(jbasins)%valid_min = -10.
+ stypvar(jbasins)%valid_max = 20
+ stypvar(jbasins)%clong_name = 'Meridional Heat Transport '//TRIM(cbasin(jbasins))
+ stypvar(jbasins)%cshort_name = cvarname(jbasins)
+ stypvar(jbasins)%conline_operation = 'N/A'
+ stypvar(jbasins)%caxis = 'TY'
+
+ IF ( npvar == 2 ) THEN
+ ! MST
+ ivar = nbasins+jbasins
+ cvarname(ivar) = TRIM(cv_zomst)//TRIM(cbasin(jbasins))
+ stypvar(ivar )%cname = cvarname(ivar)
+ stypvar(ivar )%cunits = 'T/sec'
+ stypvar(ivar )%rmissing_value = ppspval
+ stypvar(ivar )%valid_min = -10.e9
+ stypvar(ivar )%valid_max = 20.e9
+ stypvar(ivar )%clong_name = 'Meridional Salt Transport '//TRIM(cbasin(jbasins))
+ stypvar(ivar )%cshort_name = cvarname(ivar)
+ stypvar(ivar )%conline_operation = 'N/A'
+ stypvar(ivar )%caxis = 'TY'
+ ENDIF
+ END DO
- ! Indian
- zmask(:,:)=getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
+ ! create output fileset
+ ncout = create (cf_outnc, cf_vtfil, 1, npjglo, 1, cdep='depthv' )
+ ierr = createvar (ncout, stypvar, nbasins*npvar, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_vtfil, 1, npjglo, 1, pnavlon=rdumlon, pnavlat=rdumlat, pdep=gdep)
+
+ tim = getvar1d (cf_vtfil, cn_vtimec, npt )
+ ierr = putvar1d (ncout, tim, npt, 'T')
+
+ OPEN(numouth,FILE=cf_outh,FORM='FORMATTED', RECL=256) ! to avoid wrapped line with ifort
+ OPEN(numouts,FILE=cf_outs,FORM='FORMATTED', RECL=256) ! to avoid wrapped line with ifort
+
+ DO jt=1, npt
+ dtrph(:,:) = 0.d0
+ dtrps(:,:) = 0.d0
+ DO jk = 1,npk
+ PRINT *,'level ',jk
+ ! Get temperature and salinity at jk
+ zvt(:,:)= getvar(cf_vtfil, cn_vomevt, jk, npiglo, npjglo, ktime=jt)
+ zvs(:,:)= getvar(cf_vtfil, cn_vomevs, jk, npiglo, npjglo, ktime=jt)
+
+ ! get e3v at level jk
+ IF ( lfull ) THEN
+ e3v(:,:) = e31d(jk)
+ ELSE
+ e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+ dwkh(:,:) = zvt(:,:)*e1v(:,:)*e3v(:,:)*1.d0
+ dwks(:,:) = zvs(:,:)*e1v(:,:)*e3v(:,:)*1.d0
+
+ ! integrates vertically
+ dtrph(:,:) = dtrph(:,:) + dwkh(:,:) * pprau0 * pprcp
+ dtrps(:,:) = dtrps(:,:) + dwks(:,:)
+
+ END DO ! loop to next level
+
+ ! global
+ zmask(:,:) = getvar(cn_fmsk, 'vmask', 1, npiglo, npjglo)
DO jj=1,npjglo
- zonal_heat_ind(jj)= SUM( ztrp(:,jj)*zmask(:,jj))
- zonal_salt_ind(jj)= SUM( ztrps(:,jj)*zmask(:,jj))
- zpoints = SUM(zmask(:,jj))
+ dzonal_heat_glo(jj) = SUM( dtrph(2:npiglo-1,jj)*zmask(2:npiglo-1,jj) )
+ dzonal_salt_glo(jj) = SUM( dtrps(2:npiglo-1,jj)*zmask(2:npiglo-1,jj) )
END DO
- ! Austral
- zonal_heat_aus = 0.
- zonal_salt_aus = 0.
-! zmask(:,:)=getvar(cbasinmask,'tmaskant',1,npiglo,npjglo)
-! DO jj=1,npjglo
-! zonal_heat_aus(jj)= SUM( ztrp(:,jj)*zmask(:,jj))
-! zonal_salt_aus(jj)= SUM( ztrps(:,jj)*zmask(:,jj))
-! zpoints = SUM(zmask(:,jj))
-! END DO
-
-! ! Med
- zonal_heat_med = 0.
- zonal_salt_med = 0.
-
-! zmask(:,:)=getvar(cbasinmask,'tmaskmed',1,npiglo,npjglo)
-! DO jj=1,npjglo
-! zonal_heat_med(jj)= SUM( ztrp(:,jj)*zmask(:,jj))
-! zonal_salt_med(jj)= SUM( ztrps(:,jj)*zmask(:,jj))
-! zpoints = SUM(zmask(:,jj))
-! END DO
- ENDIF
-
- ! Output file
- ! create output fileset
- ncout = create(cfileoutnc, cfilet, 1,npjglo,1,cdep='depthv')
- ierr = createvar(ncout ,typvar,nbasins*npvar, ipk,id_varout )
- ierr = putheadervar(ncout, cfilet,1,npjglo,1,pnavlon=dumlon,pnavlat=dumlat,pdep=gdep)
- tim = getvar1d(cfilet,'time_counter',1)
- ierr = putvar1d(ncout,tim,1,'T')
-
- DO jvar=1,npvar ! MHT [ and MST ] (1 or 2 )
- IF ( jvar == 1 ) THEN
- ! MHT
- js=1
- zmtrp(:)=zonal_heat_glo(:)/1.e15 ! GLO
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js=js+1
- IF ( nbasins == 5 ) THEN
- zmtrp(:)=zonal_heat_atl(:)/1.e15 ! ATL
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js=js+1
- zmtrp(:)=(zonal_heat_ind(:) + zonal_heat_pac(:))/1.e15 ! INP
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js=js+1
- zmtrp(:)=zonal_heat_ind(:)/1.e15 ! IND
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js=js+1
- zmtrp(:)=zonal_heat_pac(:)/1.e15 ! PAC
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js=js+1
- ENDIF
- ELSE
- ! MST
- zmtrp(:)=zonal_salt_glo(:)/1.e6 ! GLO
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js = js + 1
- IF ( nbasins == 5 ) THEN
- zmtrp(:)=zonal_salt_atl(:)/1.e6 ! ATL
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js = js + 1
- zmtrp(:)=(zonal_salt_ind(:) + zonal_salt_pac(:))/1.e6 ! INP
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js = js + 1
- zmtrp(:)=zonal_salt_ind(:)/1.e6 ! IND
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js = js + 1
- zmtrp(:)=zonal_salt_pac(:)/1.e6 ! PAC
- WHERE ( zmtrp == 0 ) zmtrp=rpspval
- ierr=putvar(ncout,id_varout(js),REAL(zmtrp), 1,1,npjglo)
- js = js + 1
- ENDIF
- ENDIF
- END DO
- ierr=closeout(ncout)
-
- OPEN(numout,FILE=cfileout,FORM='FORMATTED', RECL=256) ! to avoid wrapped line with ifort
- WRITE(numout,*)'! Zonal heat transport (integrated alon I-model coordinate) (in Pw)'
- IF ( llglo ) THEN
- WRITE(numout,*)'! J Global Atlantic Pacific Indian Mediteranean Austral '
- DO jj=npjglo, 1, -1
- WRITE(numout,9000) jj, &
- dumlat(1,jj), zonal_heat_glo(jj)/1e15 , &
- zonal_heat_atl(jj)/1e15, &
- zonal_heat_pac(jj)/1e15, &
- zonal_heat_ind(jj)/1e15, &
- zonal_heat_med(jj)/1e15, &
- zonal_heat_aus(jj)/1e15
- END DO
- ELSE
- WRITE(numout,*)'! J Global '
- DO jj=npjglo, 1, -1
- WRITE(numout,9000) jj, &
- dumlat(1,jj), zonal_heat_glo(jj)/1e15
+ IF ( llglo ) THEN
+ ! Zonal mean with mask
+ ! Atlantic
+ zmask(:,:) = getvar(cn_fbasins, 'tmaskatl', 1, npiglo, npjglo)
+ DO jj=1,npjglo
+ dzonal_heat_atl(jj) = SUM( dtrph(:,jj)*zmask(:,jj) )
+ dzonal_salt_atl(jj) = SUM( dtrps(:,jj)*zmask(:,jj) )
+ END DO
+
+ ! Pacific
+ zmask(:,:) = getvar(cn_fbasins, 'tmaskpac', 1, npiglo, npjglo)
+ DO jj=1,npjglo
+ dzonal_heat_pac(jj) = SUM( dtrph(:,jj)*zmask(:,jj) )
+ dzonal_salt_pac(jj) = SUM( dtrps(:,jj)*zmask(:,jj) )
+ END DO
+
+ ! Indian
+ zmask(:,:) = getvar(cn_fbasins, 'tmaskind', 1, npiglo, npjglo)
+ DO jj=1,npjglo
+ dzonal_heat_ind(jj) = SUM( dtrph(:,jj)*zmask(:,jj) )
+ dzonal_salt_ind(jj) = SUM( dtrps(:,jj)*zmask(:,jj) )
+ END DO
+
+ ! Austral
+ dzonal_heat_aus = 0.d0
+ dzonal_salt_aus = 0.d0
+ ! zmask(:,:)=getvar(cn_fbasins,'tmaskant',1,npiglo,npjglo)
+ ! DO jj=1,npjglo
+ ! dzonal_heat_aus(jj)= SUM( dtrph(:,jj)*zmask(:,jj))
+ ! dzonal_salt_aus(jj)= SUM( dtrps(:,jj)*zmask(:,jj))
+ ! END DO
+
+ ! ! Med
+ dzonal_heat_med = 0.d0
+ dzonal_salt_med = 0.d0
+
+ ! zmask(:,:)=getvar(cn_fbasins,'tmaskmed',1,npiglo,npjglo)
+ ! DO jj=1,npjglo
+ ! dzonal_heat_med(jj)= SUM( dtrph(:,jj)*zmask(:,jj))
+ ! dzonal_salt_med(jj)= SUM( dtrps(:,jj)*zmask(:,jj))
+ ! END DO
+ ENDIF
+
+
+ DO jvar=1,npvar ! MHT [ and MST ] (1 or 2 )
+ IF ( jvar == 1 ) THEN
+ ! MHT
+ ivar=1
+ dmtrp(:) = dzonal_heat_glo(:)/1.d15 ! GLO
+ WHERE ( dmtrp == 0 ) dmtrp = ppspval
+ ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), 1, 1, npjglo, ktime=jt)
+ ivar=ivar+1
+ IF ( nbasins == 5 ) THEN
+ dmtrp(:) = dzonal_heat_atl(:)/1.d15 ! ATL
+ WHERE ( dmtrp == 0 ) dmtrp = ppspval
+ ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), 1, 1, npjglo, ktime=jt)
+ ivar=ivar+1
+ dmtrp(:) = (dzonal_heat_ind(:) + dzonal_heat_pac(:))/1.d15 ! INP
+ WHERE ( dmtrp == 0 ) dmtrp = ppspval
+ ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), 1, 1, npjglo, ktime=jt)
+ ivar=ivar+1
+ dmtrp(:) = dzonal_heat_ind(:)/1.d15 ! IND
+ WHERE ( dmtrp == 0 ) dmtrp = ppspval
+ ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), 1, 1, npjglo, ktime=jt)
+ ivar=ivar+1
+ dmtrp(:) = dzonal_heat_pac(:)/1.d15 ! PAC
+ WHERE ( dmtrp == 0 ) dmtrp = ppspval
+ ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), 1, 1, npjglo, ktime=jt)
+ ivar=ivar+1
+ ENDIF
+ ELSE
+ ! MST
+ dmtrp(:) = dzonal_salt_glo(:)/1.d6 ! GLO
+ WHERE ( dmtrp == 0 ) dmtrp = ppspval
+ ierr=putvar(ncout, id_varout(ivar), REAL(dmtrp), 1, 1, npjglo, ktime=jt)
+ ivar=ivar+1
+ IF ( nbasins == 5 ) THEN
+ dmtrp(:) = dzonal_salt_atl(:)/1.d6 ! ATL
+ WHERE ( dmtrp == 0 ) dmtrp = ppspval
+ ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), 1, 1, npjglo, ktime=jt)
+ ivar=ivar+1
+ dmtrp(:) = (dzonal_salt_ind(:) + dzonal_salt_pac(:))/1.d6 ! INP
+ WHERE ( dmtrp == 0 ) dmtrp = ppspval
+ ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), 1, 1, npjglo, ktime=jt)
+ ivar=ivar+1
+ dmtrp(:) = dzonal_salt_ind(:)/1.d6 ! IND
+ WHERE ( dmtrp == 0 ) dmtrp = ppspval
+ ierr = putvar(ncout, id_varout(ivar), REAL(dmtrp), 1, 1, npjglo, ktime=jt)
+ ivar=ivar+1
+ dmtrp(:) = dzonal_salt_pac(:)/1.d6 ! PAC
+ WHERE ( dmtrp == 0 ) dmtrp = ppspval
+ ierr=putvar(ncout, id_varout(ivar), REAL(dmtrp), 1, 1, npjglo, ktime=jt)
+ ivar=ivar+1
+ ENDIF
+ ENDIF
END DO
- ENDIF
- !
- CLOSE(numout)
-
- OPEN(numout,FILE=cfileouts,FORM='FORMATTED', RECL=256) ! to avoid wrapped line with ifort
- WRITE(numout,*)' ! Zonal salt transport (integrated alon I-model coordinate) (in 10^6 kg/s)'
- IF ( llglo ) THEN
- WRITE(numout,*)' ! J Global Atlantic Pacific Indian Mediteranean Austral '
- !
- DO jj=npjglo, 1, -1
- WRITE(numout,9001) jj, &
- dumlat(1,jj), zonal_salt_glo(jj)/1e6 , &
- zonal_salt_atl(jj)/1e6, &
- zonal_salt_pac(jj)/1e6, &
- zonal_salt_ind(jj)/1e6, &
- zonal_salt_med(jj)/1e6, &
- zonal_salt_aus(jj)/1e6
- END DO
- ELSE
- WRITE(numout,*)' J Global '
- DO jj=npjglo, 1, -1
- WRITE(numout,9001) jj, &
- dumlat(1,jj), zonal_salt_glo(jj)/1e6
- ENDDO
- ENDIF
-
- CLOSE(numout)
+ WRITE(numouth,*)'! Zonal heat transport (integrated alon I-model coordinate) (in Pw)'
+ IF ( llglo ) THEN
+ WRITE(numouth,*)'! J Global Atlantic Pacific Indian Mediteranean Austral '
+ WRITE(numouth,*)' ! time : ', jt
+ DO jj=npjglo, 1, -1
+ WRITE(numouth,9000) jj, &
+ rdumlat(1,jj), dzonal_heat_glo(jj)/1d15 , &
+ dzonal_heat_atl(jj)/1d15, &
+ dzonal_heat_pac(jj)/1d15, &
+ dzonal_heat_ind(jj)/1d15, &
+ dzonal_heat_med(jj)/1d15, &
+ dzonal_heat_aus(jj)/1d15
+ END DO
+ ELSE
+ WRITE(numouth,*)'! J Global '
+ WRITE(numouth,*)' ! time : ', jt
+ DO jj=npjglo, 1, -1
+ WRITE(numouth,9000) jj, &
+ rdumlat(1,jj), dzonal_heat_glo(jj)/1d15
+ END DO
+ ENDIF
+ !
+ WRITE(numouts,*)' ! Zonal salt transport (integrated alon I-model coordinate) (in 10^6 kg/s)'
+ IF ( llglo ) THEN
+ WRITE(numouts,*)' ! J Global Atlantic Pacific Indian Mediteranean Austral '
+ WRITE(numouts,*)' ! time : ', jt
+ !
+ DO jj=npjglo, 1, -1
+ WRITE(numouts,9001) jj, &
+ rdumlat(1,jj), dzonal_salt_glo(jj)/1d6 , &
+ dzonal_salt_atl(jj)/1d6, &
+ dzonal_salt_pac(jj)/1d6, &
+ dzonal_salt_ind(jj)/1d6, &
+ dzonal_salt_med(jj)/1d6, &
+ dzonal_salt_aus(jj)/1d6
+ END DO
+ ELSE
+ WRITE(numouts,*)' J Global '
+ WRITE(numouts,*)' ! time : ', jt
+ DO jj=npjglo, 1, -1
+ WRITE(numouts,9001) jj, &
+ rdumlat(1,jj), dzonal_salt_glo(jj)/1d6
+ ENDDO
+ ENDIF
+
+ ENDDO ! time loop
+ ierr = closeout(ncout)
+ CLOSE(numouth)
+ CLOSE(numouts)
9000 FORMAT(I4,6(1x,f9.3,1x,f8.4))
9001 FORMAT(I4,6(1x,f9.2,1x,f9.3))
-
END PROGRAM cdfmhst
diff --git a/cdfmht_gsop.f90 b/cdfmht_gsop.f90
index 232de4e..3a1bbf6 100644
--- a/cdfmht_gsop.f90
+++ b/cdfmht_gsop.f90
@@ -72,7 +72,7 @@ PROGRAM cdfmht_gsop
CHARACTER(LEN=256) :: cfilet, cfilev , cfileoutnc='gsopmht.nc'
CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cbasinmask='new_maskglo.nc'
CHARACTER(LEN=256) ,DIMENSION(jpgsop) :: cvarname_gsop !: array of var name for output
- TYPE(variable), DIMENSION(jpgsop) :: typvar !: modif Alb 26/11/08 structure for attributes
+ TYPE(variable), DIMENSION(jpgsop) :: stypvar !: modif Alb 26/11/08 structure for attributes
LOGICAL :: llglo = .false. !: indicator for presence of new_maskglo.nc file
INTEGER :: istatus
@@ -111,57 +111,57 @@ PROGRAM cdfmht_gsop
! define new variables for output
- typvar(1)%name= 'zobtmhta'
- typvar(1)%units='PetaWatt'
- typvar(1)%missing_value=99999.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar(1)%scale_factor= 1.
- typvar(1)%add_offset= 0.
- typvar(1)%savelog10= 0.
- typvar(1)%long_name='Barotropic_Merid_HeatTransport'
- typvar(1)%short_name='zobtmhta'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TY'
-
- typvar(2)%name= 'zoshmhta'
- typvar(2)%units='PetaWatt'
- typvar(2)%missing_value=99999.
- typvar(2)%valid_min= -1000.
- typvar(2)%valid_max= 1000.
- typvar(2)%scale_factor= 1.
- typvar(2)%add_offset= 0.
- typvar(2)%savelog10= 0.
- typvar(2)%long_name='GeoShear_Merid_HeatTransport'
- typvar(2)%short_name='zoshmhta'
- typvar(2)%online_operation='N/A'
- typvar(2)%axis='TY'
-
- typvar(3)%name= 'zoagmhta'
- typvar(3)%units='PetaWatt'
- typvar(3)%missing_value=99999.
- typvar(3)%valid_min= -1000.
- typvar(3)%valid_max= 1000.
- typvar(3)%scale_factor= 1.
- typvar(3)%add_offset= 0.
- typvar(3)%savelog10= 0.
- typvar(3)%long_name='Ageo_Merid_HeatTransport'
- typvar(3)%short_name='zoagmhta'
- typvar(3)%online_operation='N/A'
- typvar(3)%axis='TY'
-
- typvar(4)%name= 'zomhtatl'
- typvar(4)%units='PetaWatt'
- typvar(4)%missing_value=99999.
- typvar(4)%valid_min= -1000.
- typvar(4)%valid_max= 1000.
- typvar(4)%scale_factor= 1.
- typvar(4)%add_offset= 0.
- typvar(4)%savelog10= 0.
- typvar(4)%long_name='Meridional_HeatTransport_Atlantic'
- typvar(4)%short_name='zomhtatl'
- typvar(4)%online_operation='N/A'
- typvar(4)%axis='TY'
+ stypvar(1)%cname= 'zobtmhta'
+ stypvar(1)%cunits='PetaWatt'
+ stypvar(1)%rmissing_value=99999.
+ stypvar(1)%valid_min= -1000.
+ stypvar(1)%valid_max= 1000.
+ stypvar(1)%scale_factor= 1.
+ stypvar(1)%add_offset= 0.
+ stypvar(1)%savelog10= 0.
+ stypvar(1)%clong_name='Barotropic_Merid_HeatTransport'
+ stypvar(1)%cshort_name='zobtmhta'
+ stypvar(1)%conline_operation='N/A'
+ stypvar(1)%caxis='TY'
+
+ stypvar(2)%cname= 'zoshmhta'
+ stypvar(2)%cunits='PetaWatt'
+ stypvar(2)%rmissing_value=99999.
+ stypvar(2)%valid_min= -1000.
+ stypvar(2)%valid_max= 1000.
+ stypvar(2)%scale_factor= 1.
+ stypvar(2)%add_offset= 0.
+ stypvar(2)%savelog10= 0.
+ stypvar(2)%clong_name='GeoShear_Merid_HeatTransport'
+ stypvar(2)%cshort_name='zoshmhta'
+ stypvar(2)%conline_operation='N/A'
+ stypvar(2)%caxis='TY'
+
+ stypvar(3)%cname= 'zoagmhta'
+ stypvar(3)%cunits='PetaWatt'
+ stypvar(3)%rmissing_value=99999.
+ stypvar(3)%valid_min= -1000.
+ stypvar(3)%valid_max= 1000.
+ stypvar(3)%scale_factor= 1.
+ stypvar(3)%add_offset= 0.
+ stypvar(3)%savelog10= 0.
+ stypvar(3)%clong_name='Ageo_Merid_HeatTransport'
+ stypvar(3)%cshort_name='zoagmhta'
+ stypvar(3)%conline_operation='N/A'
+ stypvar(3)%caxis='TY'
+
+ stypvar(4)%cname= 'zomhtatl'
+ stypvar(4)%cunits='PetaWatt'
+ stypvar(4)%rmissing_value=99999.
+ stypvar(4)%valid_min= -1000.
+ stypvar(4)%valid_max= 1000.
+ stypvar(4)%scale_factor= 1.
+ stypvar(4)%add_offset= 0.
+ stypvar(4)%savelog10= 0.
+ stypvar(4)%clong_name='Meridional_HeatTransport_Atlantic'
+ stypvar(4)%cshort_name='zomhtatl'
+ stypvar(4)%conline_operation='N/A'
+ stypvar(4)%caxis='TY'
ipk_gsop(1) = npk
ipk_gsop(2) = npk
@@ -210,7 +210,7 @@ PROGRAM cdfmht_gsop
! create output fileset
ncout =create(cfileoutnc, cfilev,1,npjglo,1,cdep='depthw')
- ierr= createvar(ncout ,typvar,jpgsop, ipk_gsop,id_varout_gsop )
+ ierr= createvar(ncout ,stypvar,jpgsop, ipk_gsop,id_varout_gsop )
ierr= putheadervar(ncout, cfilev,1, npjglo,1,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw)
tim=getvar1d(cfilev,'time_counter',1)
ierr=putvar1d(ncout,tim,1,'T')
diff --git a/cdfmkmask-zone.f90 b/cdfmkmask-zone.f90
deleted file mode 100644
index 3ac4f31..0000000
--- a/cdfmkmask-zone.f90
+++ /dev/null
@@ -1,142 +0,0 @@
-PROGRAM cdfmkmask_zone
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmkmask_zone ***
- !!
- !! ** Purpose: Build mask file from a salinity output
- !!
- !! ** Method: Read vosaline and set tmask to 1 where sal is not 0
- !! then umask, vmask and fmask are deduced from tmask
- !! REM: the result may be locally different for fmask than
- !! fmask produced online as there are computed on line
- !!
- !! history:
- !! Original : J.M. Molines November 2005
- !! P. Mathiot (2008) from cdfmkmask limit to a particular area
- !! comment : JMM : can be merge easily with cdfmkmask (using optional zoom)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: ji,jj,jk,jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc , ntags !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(4) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: zmask,zmask2, lon, lat !: 2D mask at current level
-
- CHARACTER(LEN=256) ,DIMENSION(4) :: cvarname !: array of var name
- CHARACTER(LEN=256) :: cfilet, cline,cfileout, cdum
- TYPE(variable), DIMENSION(4) :: typvar
- REAL(KIND=4) ,DIMENSION(1) :: timean
-
- INTEGER :: ncout, npt
- INTEGER :: istatus
- REAL(4) :: ss, rlonmax, rlonmin, rlatmax, rlatmin
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmkmask-zone gridT lonmin lonmax latmin latmax fileout'
- STOP
- ENDIF
-
- CALL getarg (1, cfilet)
- CALL getarg (2, cdum ); READ(cdum,*) rlonmin
- CALL getarg (3, cdum ); READ(cdum,*) rlonmax
- CALL getarg (4, cdum ); READ(cdum,*) rlatmin
- CALL getarg (5, cdum ); READ(cdum,*) rlatmax
- CALL getarg (6, cfileout)
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- print *, npiglo, npjglo, npk
-
- ipk(1:4) = npk
- typvar(1)%name='tmask'
- typvar(2)%name='umask'
- typvar(3)%name='vmask'
- typvar(4)%name='fmask'
- typvar(1:4)%units='1/0'
- typvar(1:4)%missing_value=9999.
- typvar(1:4)%valid_min= 0.
- typvar(1:4)%valid_max= 1.
- typvar(1)%long_name='tmask'
- typvar(2)%long_name='umask'
- typvar(3)%long_name='vmask'
- typvar(4)%long_name='fmask'
- typvar(1)%short_name='tmask'
- typvar(2)%short_name='umask'
- typvar(3)%short_name='vmask'
- typvar(4)%short_name='fmask'
- typvar(1:4)%online_operation='N/A'
- typvar(1:4)%axis='TZYX'
- typvar(1:4)%precision='i2'
-
- ncout =create(cfileout, cfilet,npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,4, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet, npiglo, npjglo,npk)
-
-
- ALLOCATE (zmask(npiglo,npjglo),zmask2(npiglo,npjglo), lon(npiglo,npjglo), lat(npiglo,npjglo))
-
- lat(:,:)= getvar(cfilet, 'nav_lat', 1 ,npiglo, npjglo)
- lon(:,:)= getvar(cfilet, 'nav_lon', 1 ,npiglo, npjglo)
-
- npt= 0
- DO jk=1, npk
- zmask(:,:)= getvar(cfilet, 'vosaline', jk ,npiglo, npjglo)
- WHERE (zmask > 0 ) zmask = 1
-
- IF (rlonmax > rlonmin) THEN
- WHERE (lon > rlonmax ) zmask = 0
- WHERE (lon < rlonmin ) zmask = 0
- ELSE
- WHERE (lon < rlonmin .AND. lon > rlonmax ) zmask = 0
- END IF
- WHERE (lat > rlatmax ) zmask = 0
- WHERE (lat < rlatmin ) zmask = 0
-
- ierr=putvar(ncout,id_varout(1), zmask, jk ,npiglo, npjglo)
- ! now umask
- zmask2=0.
- DO ji=1,npiglo-1
- DO jj=1,npjglo
- zmask2(ji,jj)=zmask(ji,jj)*zmask(ji+1,jj)
- END DO
- END DO
- ierr=putvar(ncout,id_varout(2), zmask2, jk ,npiglo, npjglo)
-
- ! now vmask
- zmask2=0.
- DO ji=1,npiglo
- DO jj=1,npjglo-1
- zmask2(ji,jj)=zmask(ji,jj)*zmask(ji,jj+1)
- END DO
- END DO
- ierr=putvar(ncout,id_varout(3), zmask2, jk ,npiglo, npjglo)
-
- !now fmask
- zmask2=0.
- DO ji=1,npiglo-1
- DO jj=1,npjglo-1
- zmask2(ji,jj)=zmask(ji,jj)*zmask(ji,jj+1)*zmask(ji+1,jj)*zmask(ji+1,jj+1)
- END DO
- END DO
- ierr=putvar(ncout,id_varout(4), zmask2, jk ,npiglo, npjglo)
- END DO ! loop to next level
- timean(:)=0.
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
-
-
-END PROGRAM cdfmkmask_zone
diff --git a/cdfmkmask.f90 b/cdfmkmask.f90
index c47828c..4e7584f 100644
--- a/cdfmkmask.f90
+++ b/cdfmkmask.f90
@@ -1,122 +1,201 @@
PROGRAM cdfmkmask
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmkmask ***
+ !!======================================================================
+ !! *** PROGRAM cdfmkmask ***
+ !!=====================================================================
+ !! ** Purpose : Build mask file from a salinity output
!!
- !! ** Purpose: Build mask file from a salinity output
- !!
- !! ** Method: Read vosaline and set tmask to 1 where sal is not 0
+ !! ** Method : Read vosaline and set tmask to 1 where sal is not 0
!! then umask, vmask and fmask are deduced from tmask
!! REM: the result may be locally different for fmask than
!! fmask produced online as there are computed on line
+ !! merged with cdfmkmask-zone by adding a zoom option. When
+ !! used with -zoom option, the mask is 0 outside the zoom
+ !! area.
!!
- !! history:
- !! Original : J.M. Molines November 2005
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2005 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk,jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc , ntags !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(4) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: zmask,zmask2 !: 2D mask at current level
-
- CHARACTER(LEN=256) ,DIMENSION(4) :: cvarname !: array of var name
- CHARACTER(LEN=256) :: cfilet, cline,cfileout='mask_sal.nc'
- TYPE(variable), DIMENSION(4) :: typvar
- REAL(KIND=4) ,DIMENSION(1) :: timean
-
- INTEGER :: ncout, npt
- INTEGER :: istatus
- REAL(4) :: ss
-
- !! Read command line
- narg= iargc()
+
+ INTEGER(KIND=4) :: ji, jj, jk ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc, ijarg !
+ INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(4) :: ipk, id_varout ! outptut variables : number of levels,
+
+
+ REAL(KIND=4) :: rlonmin, rlonmax ! limit in longitude
+ REAL(KIND=4) :: rlatmin, rlatmax ! limit in latitude
+ REAL(KIND=4), DIMENSION(1) :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask, zmask ! 2D mask at current level
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rlon, rlat ! latitude and longitude
+
+ CHARACTER(LEN=256) :: cf_tfil ! file name
+ CHARACTER(LEN=256) :: cf_out = 'mask_sal.nc' ! output file
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ TYPE (variable), DIMENSION(4) :: stypvar ! output attribute
+
+ LOGICAL :: lzoom = .false. ! zoom flag
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmkmask gridT '
+ PRINT *,' usage : cdfmkmask T-file [-zoom lonmin lonmax latmin latmax] ...'
+ PRINT *,' ... [-o OUT-file ]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Build a mask file from vosaline array read from the input file.'
+ PRINT *,' It assumes that land salinity values are set to 0.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with salinity.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-zoom lonmin lonmax latmin latmax] : geographical windows used to'
+ PRINT *,' limit the area where the mask is builded. Outside'
+ PRINT *,' this area, the mask is set to 0.'
+ PRINT *,' [-o OUT-file ] : output file name to be used in place of standard'
+ PRINT *,' name [ ',TRIM(cf_out),' ]'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out), ' or OUT-file.'
+ PRINT *,' variables : tmask, umask, vmask, fmask'
+ PRINT *,' fmask can differ from standard fmask because it does not'
+ PRINT *,' reflect the slip/noslip lateral condition.'
STOP
ENDIF
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- print *, npiglo, npjglo, npk
-
- ipk(1:4) = npk
- typvar(1)%name='tmask'
- typvar(2)%name='umask'
- typvar(3)%name='vmask'
- typvar(4)%name='fmask'
- typvar(1:4)%units='1/0'
- typvar(1:4)%missing_value=9999.
- typvar(1:4)%valid_min= 0.
- typvar(1:4)%valid_max= 1.
- typvar(1)%long_name='tmask'
- typvar(2)%long_name='umask'
- typvar(3)%long_name='vmask'
- typvar(4)%long_name='fmask'
- typvar(1)%short_name='tmask'
- typvar(2)%short_name='umask'
- typvar(3)%short_name='vmask'
- typvar(4)%short_name='fmask'
- typvar(1:4)%online_operation='N/A'
- typvar(1:4)%axis='TZYX'
- typvar(1:4)%precision='i2'
-
- ncout =create(cfileout, cfilet,npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,4, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet, npiglo, npjglo,npk)
-
-
- ALLOCATE (zmask(npiglo,npjglo),zmask2(npiglo,npjglo))
-
- npt= 0
+ ijarg = 1
+ CALL getarg (ijarg, cf_tfil) ; ijarg = ijarg + 1
+
+ DO WHILE ( ijarg <= narg )
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ !
+ CASE ( '-zoom' ) ! read a zoom area
+ lzoom = .true.
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rlonmin
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rlonmax
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rlatmin
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) rlatmax
+ !
+ CASE ( '-o' ) ! change output file name
+ CALL getarg (ijarg, cf_out) ; ijarg = ijarg + 1
+ !
+ CASE DEFAULT
+ PRINT *, 'ERROR : unknown option :', TRIM(cldum)
+ STOP
+ END SELECT
+ ENDDO
+
+ IF ( chkfile(cf_tfil) ) STOP ! missing file
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+
+ PRINT *,' npiglo = ', npiglo
+ PRINT *,' npjglo = ', npjglo
+ PRINT *,' npk = ', npk
+
+
+ ipk(1:4) = npk
+ stypvar(1)%cname = 'tmask'
+ stypvar(2)%cname = 'umask'
+ stypvar(3)%cname = 'vmask'
+ stypvar(4)%cname = 'fmask'
+
+ stypvar(1:4)%cunits = '1/0'
+ stypvar(1:4)%rmissing_value = 9999.
+ stypvar(1:4)%valid_min = 0.
+ stypvar(1:4)%valid_max = 1.
+
+ stypvar(1)%clong_name = 'tmask'
+ stypvar(2)%clong_name = 'umask'
+ stypvar(3)%clong_name = 'vmask'
+ stypvar(4)%clong_name = 'fmask'
+
+ stypvar(1)%cshort_name = 'tmask'
+ stypvar(2)%cshort_name = 'umask'
+ stypvar(3)%cshort_name = 'vmask'
+ stypvar(4)%cshort_name = 'fmask'
+
+ stypvar(1:4)%conline_operation = 'N/A'
+ stypvar(1:4)%caxis = 'TZYX'
+ stypvar(1:4)%cprecision = 'i2'
+
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk)
+ ierr = createvar (ncout, stypvar, 4, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk)
+
+ ALLOCATE (tmask(npiglo,npjglo), zmask(npiglo,npjglo))
+
+ IF ( lzoom ) THEN
+ ALLOCATE (rlon(npiglo,npjglo), rlat(npiglo,npjglo))
+ rlon(:,:) = getvar(cf_tfil, cn_vlon2d, 1, npiglo, npjglo)
+ rlat(:,:) = getvar(cf_tfil, cn_vlat2d, 1, npiglo, npjglo)
+ ENDIF
+
DO jk=1, npk
- zmask(:,:)= getvar(cfilet, 'vosaline', jk ,npiglo, npjglo)
- WHERE (zmask > 0 ) zmask = 1
- WHERE (zmask <=0 ) zmask = 0
- ierr=putvar(ncout,id_varout(1), zmask, jk ,npiglo, npjglo)
- ! now umask
- zmask2=0.
+ ! tmask
+ tmask(:,:) = getvar(cf_tfil, 'vosaline', jk, npiglo, npjglo)
+ WHERE (tmask > 0 ) tmask = 1
+ WHERE (tmask <=0 ) tmask = 0
+
+ IF ( lzoom ) THEN
+ IF (rlonmax > rlonmin) THEN
+ WHERE (rlon > rlonmax ) tmask = 0
+ WHERE (rlon < rlonmin ) tmask = 0
+ ELSE
+ WHERE (rlon < rlonmin .AND. rlon > rlonmax ) tmask = 0
+ END IF
+
+ WHERE (rlat > rlatmax ) tmask = 0
+ WHERE (rlat < rlatmin ) tmask = 0
+ ENDIF
+ ierr = putvar(ncout, id_varout(1), tmask, jk ,npiglo, npjglo)
+ ! umask
+ zmask = 0.
DO ji=1,npiglo-1
DO jj=1,npjglo
- zmask2(ji,jj)=zmask(ji,jj)*zmask(ji+1,jj)
+ zmask(ji,jj) = tmask(ji,jj)*tmask(ji+1,jj)
END DO
END DO
- ierr=putvar(ncout,id_varout(2), zmask2, jk ,npiglo, npjglo)
-
- ! now vmask
- zmask2=0.
+ ierr = putvar(ncout, id_varout(2), zmask, jk ,npiglo, npjglo)
+ ! vmask
+ zmask=0.
DO ji=1,npiglo
DO jj=1,npjglo-1
- zmask2(ji,jj)=zmask(ji,jj)*zmask(ji,jj+1)
+ zmask(ji,jj) = tmask(ji,jj)*tmask(ji,jj+1)
END DO
END DO
- ierr=putvar(ncout,id_varout(3), zmask2, jk ,npiglo, npjglo)
-
- !now fmask
- zmask2=0.
+ ierr = putvar(ncout, id_varout(3), zmask, jk, npiglo, npjglo)
+ !fmask
+ zmask=0.
DO ji=1,npiglo-1
DO jj=1,npjglo-1
- zmask2(ji,jj)=zmask(ji,jj)*zmask(ji,jj+1)*zmask(ji+1,jj)*zmask(ji+1,jj+1)
+ zmask(ji,jj) = tmask(ji,jj)*tmask(ji,jj+1)*tmask(ji+1,jj)*tmask(ji+1,jj+1)
END DO
END DO
- ierr=putvar(ncout,id_varout(4), zmask2, jk ,npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(4), zmask, jk, npiglo, npjglo)
END DO ! loop to next level
- timean(:)=0.
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
+ tim(:) = 0.
+ ierr = putvar1d(ncout, tim, 1,'T')
+ ierr = closeout(ncout )
END PROGRAM cdfmkmask
diff --git a/cdfmltmask.f90 b/cdfmltmask.f90
index b92f128..c9769a6 100644
--- a/cdfmltmask.f90
+++ b/cdfmltmask.f90
@@ -1,75 +1,101 @@
PROGRAM cdfmltmask
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmltmask ***
+ !!======================================================================
+ !! *** PROGRAM cdfmltmask ***
+ !!=====================================================================
+ !! ** Purpose : multiplication of file by a mask (0,1)
!!
- !! ** Purpose : multiplication of file by a mask (0,1)
- !!
- !!
- !! * history:
- !! Original : Melanie JUZA (june 2007)
- !! Modified : Pierre Mathiot(june 2007) update for forcing fields
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 06/2007 : M. Juza : Original code
+ !! : 2.1 : 06/2007 : P. Mathiot : add forcing capabilities
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, jt, jkk
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk,npt !: size of the domain
- INTEGER :: nvpk !: vertical levels in working variable
- INTEGER :: npkmask !: vertical levels in mask file
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zv !: cvar at jk level
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: mask at jk level
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zvmask !: masked cvar at jk level
- REAL(KIND=4) :: spval !: missing value
-
- CHARACTER(LEN=256) :: cunits, clname, csname !: attributes units, long_name, short_name
- CHARACTER(LEN=256) :: cfilev , cfilemask, ctmp
- CHARACTER(LEN=256) :: cvar, cvartype, cdep
- CHARACTER(LEN=20) :: cvmask
-
- INTEGER :: istatus
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvpk ! vertical levels in working variable
+ INTEGER(KIND=4) :: npkmask ! vertical levels in mask file
+
+ REAL(KIND=4) :: zspval ! missing value attribute
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zv ! cv_in at jk level
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask at jk level
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvmask ! masked cv_in at jk level
+
+ CHARACTER(LEN=256) :: cunits ! units attribute
+ CHARACTER(LEN=256) :: clname ! long_name attribute
+ CHARACTER(LEN=256) :: csname ! short_name attribute
+ CHARACTER(LEN=256) :: cf_in ! input file name
+ CHARACTER(LEN=256) :: cf_msk ! input mask file name
+ CHARACTER(LEN=256) :: cv_in ! cdf variable name
+ CHARACTER(LEN=256) :: cvartype ! variable position on Cgrid
+ CHARACTER(LEN=256) :: cv_dep ! depth dim name
+ CHARACTER(LEN=256) :: ctmp ! dummy string
+ CHARACTER(LEN=20) :: cv_msk ! mask variable name
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmltmask ncfile maskfile cdfvar T| U | V | F | W | P'
- PRINT *,' Mask the file '
- PRINT *,' output on ncfile_masked'
- PRINT *,' Point type P correspond to polymask'
+ PRINT *,' usage : cdfmltmask IN-file MSK-file IN-var T| U | V | F | W | P'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Multiply IN-var of IN-file by the mask corresponding to the'
+ PRINT *,' C-grid point position given as last argument.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : input netcdf file.'
+ PRINT *,' MSK-file : input netcdf mask file.'
+ PRINT *,' IN-var : input variable name.'
+ PRINT *,' T| U | V | F | W | P : C-grid position of IN-var'
+ PRINT *,' P indicate a polygon mask created by cdfpoly.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none, all are given as arguments.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' The output file is a copy of the input file with only'
+ PRINT *,' the requested variable masked.'
+ PRINT *,' netcdf file : IN-file_masked'
+ PRINT *,' variables : IN-var (same as input).'
STOP
ENDIF
- CALL getarg (1, cfilev)
- CALL getarg (2, cfilemask)
- CALL getarg (3, cvar)
- CALL getarg (4, cvartype)
+ CALL getarg (1, cf_in )
+ CALL getarg (2, cf_msk )
+ CALL getarg (3, cv_in )
+ CALL getarg (4, cvartype )
+
+ IF ( chkfile (cf_in) .OR. chkfile(cf_msk) ) STOP ! missing files
! append _masked to input file name and copy initial file to new file, which will be modified
! using dd more efficient than cp for big files
- ctmp=TRIM(cfilev)//'_masked'
- CALL system(' dd bs=10000000 if='//TRIM(cfilev)//' of='//TRIM(ctmp) )
- cfilev=ctmp
- print *, TRIM(cfilev)
-
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth',cdtrue=cdep, kstatus=istatus) ; !print *, istatus
- IF (istatus /= 0 ) THEN
- npk = getdim (cfilev,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfilev,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- npk = getdim (cfilev,'nav_lev',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
+ ctmp = TRIM(cf_in)//'_masked'
+ CALL system(' dd bs=10000000 if='//TRIM(cf_in)//' of='//TRIM(ctmp) )
+ cf_in = ctmp
+
+ PRINT *,' Working on copy : ', TRIM(cf_in)
+
+ npiglo = getdim (cf_in,cn_x)
+ npjglo = getdim (cf_in,cn_y)
+ npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr)
+
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in, 'z', cdtrue=cv_dep, kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in, 'sigma', cdtrue=cv_dep, kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in, 'nav_lev', cdtrue=cv_dep, kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
PRINT *,' assume file with no depth'
npk=0
ENDIF
@@ -77,76 +103,76 @@ PROGRAM cdfmltmask
ENDIF
ENDIF
- npkmask = getdim (cfilemask,'depth',cdtrue=cdep, kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npkmask = getdim (cfilemask,'z',cdtrue=cdep,kstatus=istatus) ; !print *, istatus
- IF ( istatus /= 0 ) THEN
- npkmask = getdim (cfilemask,'nav_lev',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
+ npkmask = getdim (cf_msk, cn_z, cdtrue=cv_dep, kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ npkmask = getdim (cf_msk, 'z', cdtrue=cv_dep, kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npkmask = getdim (cf_msk, 'nav_lev', cdtrue=cv_dep, kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
PRINT *,' assume file with no depth'
npkmask=0
ENDIF
ENDIF
ENDIF
- npt = getdim (cfilev,'time')
- nvpk = getvdim(cfilev,cvar)
+ npt = getdim (cf_in, cn_t )
+ nvpk = getvdim(cf_in, cv_in)
IF (nvpk == 2 ) nvpk = 1
IF (nvpk == 3 ) nvpk = npk
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'npt =', npt
- PRINT *, 'nvpk =', nvpk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+ PRINT *, 'nvpk = ', nvpk
IF (npk==0) npk=1
! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE(zvmask(npiglo,npjglo))
+ ALLOCATE( zmask(npiglo,npjglo) )
+ ALLOCATE( zv (npiglo,npjglo) )
+ ALLOCATE(zvmask(npiglo,npjglo) )
SELECT CASE (TRIM(cvartype))
CASE ( 'T' )
- cvmask='tmask'
+ cv_msk='tmask'
CASE ( 'U' )
- cvmask='umask'
+ cv_msk='umask'
CASE ( 'V' )
- cvmask='vmask'
+ cv_msk='vmask'
CASE ( 'F' )
- cvmask='fmask'
+ cv_msk='fmask'
CASE ( 'W' )
- cvmask='tmask'
+ cv_msk='tmask'
CASE ( 'P' ) ! for polymask
- cvmask='polymask'
+ cv_msk='polymask'
CASE DEFAULT
PRINT *, 'this type of variable is not known :', TRIM(cvartype)
STOP
END SELECT
IF ( npkmask <= 1 ) THEN
- zmask(:,:)=getvar(cfilemask,cvmask,1,npiglo,npjglo)
+ zmask(:,:) = getvar(cf_msk, cv_msk, 1, npiglo, npjglo)
ENDIF
+
DO jt = 1, npt
IF (MOD(jt,100)==0) PRINT *, jt,'/', npt
DO jk = 1,nvpk
- ! Read cvar
- zv(:,:)= getvar(cfilev, cvar, jk ,npiglo,npjglo, ktime=jt)
+ ! Read cv_in
+ zv(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt)
IF ( npkmask > 1 ) THEN
! Read mask
- zmask(:,:)=getvar(cfilemask,cvmask,jk,npiglo,npjglo)
+ zmask(:,:) = getvar(cf_msk, cv_msk, jk, npiglo, npjglo)
ENDIF
- ! Multiplication of cvar by mask at level jk
- zvmask=zv*zmask
- ! Writing on the original file
- istatus=putvar(cfilev,cvar,jk,npiglo,npjglo,1,1,ktime=jt, ptab=zvmask)
+ ! Multiplication of cv_in by mask at level jk
+ zvmask = zv * zmask
+ ! Writing on the copy of original file
+ ierr = putvar(cf_in, cv_in, jk, npiglo, npjglo, 1, 1, ktime=jt, ptab=zvmask)
END DO
END DO
- ! set missing value attribute for cvar as 0.
- istatus = getvaratt (cfilev,cvar,cunits,spval,clname,csname)
- istatus = cvaratt (cfilev,cvar,cunits,0.,clname,csname)
-
+ ! set missing value attribute for cv_in as 0.
+ ierr = getvaratt (cf_in, cv_in, cunits, zspval, clname, csname)
+ ierr = cvaratt (cf_in, cv_in, cunits, 0., clname, csname)
END PROGRAM cdfmltmask
diff --git a/cdfmoc-full.f90 b/cdfmoc-full.f90
deleted file mode 100644
index 955cc0b..0000000
--- a/cdfmoc-full.f90
+++ /dev/null
@@ -1,201 +0,0 @@
-PROGRAM cdfmoc_full
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmoc_full ***
- !!
- !! ** Purpose : Compute the Meridional Overturning Cell (MOC)
- !! FULL STEPS
- !!
- !! ** Method : The MOC is computed from the V velocity field, integrated
- !! from the bottom to the surface, then zonally averaged with
- !! eventual masking for oceanic basins.
- !! In the present version the masking corresponds to the global
- !! configuration. MOC for Global, Atlantic, Indo-Pacific, Indian,Pacific ocean
- !! Results are saved on moc.nc file with variables name respectively
- !! zomsfglo, zomsfatl, zomsfinp, zomsfind, zomsfpac
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (Nov. 2005)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jpbasins=5
- INTEGER :: jbasin, jj, jk ,ji !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout, np
- INTEGER :: numout=10
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout !
- INTEGER, DIMENSION(2) :: iloc
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, gphiv, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw ,e3v !: deptw
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo
- REAL(KIND=4), DIMENSION (1) :: tim
-
- REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: zomsf !: jpbasins x npjglo x npk
-
- CHARACTER(LEN=256) :: cfilev , cfileoutnc='moc.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cbasinmask='new_maskglo.nc'
- TYPE(variable) ,DIMENSION(:), ALLOCATABLE :: typvar !: structure for attribute
-
- LOGICAL :: llglo = .false. !: indicator for presence of new_maskglo.nc file
-
- INTEGER :: istatus
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoc-full V file '
- PRINT *,' Computes the MOC for oceanic basins as described in new_maskglo.nc'
- PRINT *,' FULL STEPS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,new_maskglo.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on moc.nc: '
- PRINT *,' variables zomsfglo : Global ocean '
- PRINT *,' variables zomsfatl : Atlantic Ocean '
- PRINT *,' variables zomsfinp : Indo Pacific '
- PRINT *,' variables zomsfind : Indian Ocean alone'
- PRINT *,' variables zomsfpac : Pacific Ocean alone'
- STOP
- ENDIF
-
- CALL getarg (1, cfilev)
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
-
- ! Detects newmaskglo file
- INQUIRE( FILE='new_maskglo.nc', EXIST=llglo )
- IF (llglo) THEN
- jpbasins = 5
- ELSE
- jpbasins = 1
- ENDIF
-
- ALLOCATE ( typvar(jpbasins), ipk(jpbasins), id_varout(jpbasins) )
-
- ! define new variables for output ( must update att.txt)
- typvar(1)%name= 'zomsfglo'
- typvar%units='Sverdrup'
- typvar%missing_value=99999.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar(1)%long_name='Meridional_Overt.Cell_Global'
- typvar(1)%short_name='zomsfglo'
- typvar%online_operation='N/A'
- typvar%axis='TZY'
- ipk(1) = npk
-
- IF (llglo ) THEN
- typvar(2)%name= 'zomsfatl'
- typvar(2)%long_name='Meridional_Overt.Cell_Atlantic'
- typvar(2)%short_name='zomsfatl'
-
- typvar(3)%name= 'zomsfinp'
- typvar(3)%long_name='Meridional_Overt.Cell_IndoPacif'
- typvar(3)%short_name='zomsfinp'
-
- typvar(4)%name= 'zomsfind'
- typvar(4)%long_name='Meridional_Overt.Cell_Indian'
- typvar(4)%short_name='zomsfind'
-
- typvar(5)%name= 'zomsfpac'
- typvar(5)%long_name='Meridional_Overt.Cell_pacif'
- typvar(5)%short_name='zomspac'
-
- ipk(2) = npk ! 2D
- ipk(3) = npk ! 2D
- ipk(4) = npk ! 2D
- ipk(5) = npk ! 2D
- ENDIF
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(jpbasins,npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npk), gphiv(npiglo,npjglo) ,gdepw(npk) )
- ALLOCATE ( zomsf(jpbasins, npjglo, npk) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
-
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
- gdepw(:) = -1.* gdepw(:)
- e3v(:) = getvare3(coordzgr, 'e3t', npk)
-
- iloc=maxloc(gphiv)
- dumlat(1,:) = gphiv(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
-
- ! create output fileset
- ncout =create(cfileoutnc, cfilev, 1,npjglo,npk,cdep='depthw')
- ierr= createvar(ncout ,typvar ,jpbasins, ipk,id_varout )
- ierr= putheadervar(ncout, cfilev,1, npjglo,npk,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw)
- tim=getvar1d(cfilev,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
-
- ! reading the masks
- ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif
- zmask(1,:,:)=getvar('mask.nc','vmask',1,npiglo,npjglo)
- IF (llglo) THEN
- zmask(2,:,:)=getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- zmask(4,:,:)=getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
- zmask(5,:,:)=getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- zmask(3,:,:)=zmask(5,:,:)+zmask(4,:,:)
- ! ensure that there are no overlapping on the masks
- WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1
- ENDIF
-
- ! initialize moc to 0
- zomsf(:,:,:) = 0.
-
- DO jk = 1,npk-1
- PRINT *,'level ',jk
- ! Get velocities v at jk
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
-
-
- ! integrates 'zonally' (along i-coordinate)
- DO ji=1,npiglo
- ! For all basins
- DO jbasin = 1, jpbasins
- DO jj=1,npjglo
- zomsf(jbasin,jj,jk)=zomsf(jbasin,jj,jk) - e1v(ji,jj)*e3v(jk)* zmask(jbasin,ji,jj)*zv(ji,jj)
- ENDDO
- END DO
- END DO
- END DO
-
- ! integrates vertically from bottom to surface
- DO jk=npk-1 , 1 , -1
- zomsf(:,:,jk) = zomsf(:,:,jk+1) + zomsf(:,:,jk)/1.e6
- END DO ! loop to next level
-
- ! netcdf output
- DO jbasin= 1, jpbasins
- DO jk =1, npk
- ierr = putvar (ncout, id_varout(jbasin),REAL(zomsf(jbasin,:,jk)), jk,1,npjglo)
- END DO
- END DO
-
- ierr = closeout(ncout)
-
- END PROGRAM cdfmoc_full
diff --git a/cdfmoc.f90 b/cdfmoc.f90
index eb476e0..1165531 100644
--- a/cdfmoc.f90
+++ b/cdfmoc.f90
@@ -1,211 +1,627 @@
PROGRAM cdfmoc
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmoc ***
+ !!======================================================================
+ !! *** PROGRAM cdfmoc ***
+ !!=====================================================================
+ !! ** Purpose : Compute the Meridional Overturning Cell (MOC)
!!
- !! ** Purpose : Compute the Meridional Overturning Cell (MOC)
- !! PARTIAL STEPS
- !!
- !! ** Method : The MOC is computed from the V velocity field, integrated
- !! from the bottom to the surface, then zonally averaged with
- !! eventual masking for oceanic basins.
- !! The program looks for the file "new_maskglo.nc". If it does not exist,
- !! only the calculation over all the domain is performed (this is adequate
- !! for a basin configuration like NATL4).
- !! In new_maskglo.nc the masking corresponds to the global
- !! configuration. MOC for Global, Atlantic, Indo-Pacific, Indian,Pacific ocean
- !! Results are saved on moc.nc file with variables name respectively
- !! zomsfglo, zomsfatl, zomsfinp, zomsfind, zomsfpac
+ !! ** Method : The MOC is computed from the V velocity field, integrated
+ !! from the bottom to the surface, then zonally averaged with
+ !! eventual masking for oceanic basins.
+ !! The program looks for the file "new_maskglo.nc". If it
+ !! does not exist, only the calculation over all the domain
+ !! is performed (this is adequate for a basin configuration).
+ !! In new_maskglo.nc the masking corresponds to the global
+ !! configuration. MOC for Global, Atlantic, Indo-Pacific,
+ !! Indian, Pacific ocean.
+ !! Results are saved on moc.nc file with variables name
+ !! respectively zomsfglo, zomsfatl, zomsfinp, zomsfind, zomsfpac
!!
+ !! History : 2.1 : 07/2005 : J.M. Molines : Original code
+ !! : 04/2006 : A.M. Treguier : Adaptation to NATL4 case
+ !! : 09/2007 : G. Smith : MOC decomposition
+ !! : 01/2008 : A. Lecointre : MOC decomposition adaptation
+ !! 3.0 : 03/2011 : J.M. Molines : Merge all MOC prog, Doctor norm + Lic.
!!
- !! history ;
- !! Original : J.M. Molines (jul. 2005)
- !! A.M. Treguier (april 2006) adaptation to NATL4 case
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! References : For MOC decomposition : Lee & Marotzke (1998),
+ !! Baehr, Hirschi, Beismann & Marotzke (2004),
+ !! Cabanes, Lee, & Fu (2007), Koehl & Stammer (2007).
+ !! See also the powerpoint presentation by Tony Lee at the third
+ !! CLIVAR-GSOP intercomparison available at :
+ !! http://www.clivar.org/organization/gsop/synthesis/mit/talks/lee_MOC_comparison.ppt
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ USE eos
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jpbasins
- INTEGER :: jbasin, jj, jk ,ji !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout, np
- INTEGER :: numout=10
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout !
- INTEGER, DIMENSION(2) :: iloc
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, e3v, gphiv, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw !: deptw
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo
- REAL(KIND=4), DIMENSION (1) :: tim
-
- REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: zomsf !: jpbasins x npjglo x npk
-
- CHARACTER(LEN=256) :: cfilev , cfileoutnc='moc.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cbasinmask='new_maskglo.nc'
- TYPE(variable) ,DIMENSION(:), ALLOCATABLE :: typvar !: structure for attribute
- LOGICAL :: llglo = .false. !: indicator for presence of new_maskglo.nc file
-
- INTEGER :: istatus
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
+
+ INTEGER(KIND=2), DIMENSION(:,:,:), ALLOCATABLE :: ibmask ! nbasins x npiglo x npjglo
+ INTEGER(KIND=2), DIMENSION(:,:), ALLOCATABLE :: ivmask ! ivmask (used to mask e3v)
+
+ INTEGER(KIND=4) :: npglo, npatl, npinp
+ INTEGER(KIND=4) :: npind, nppac
+ INTEGER(KIND=4) :: jbasin, jj, jk ! dummy loop index
+ INTEGER(KIND=4) :: ji, jt ! dummy loop index
+ INTEGER(KIND=4) :: nbasins, ibasin ! number of sub basins
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! command line browser
+ INTEGER(KIND=4) :: ijarg, ii ! " "
+ INTEGER(KIND=4) :: npiglo,npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! out put file id
+ INTEGER(KIND=4) :: nvarout ! number of output variables
+ INTEGER(KIND=4) :: ijvar ! index for output variable
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! output variables info
+ INTEGER(KIND=4), DIMENSION(2) :: iloc ! working integer array
+
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: e3v ! Vertical e3v masked by vmask
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, gphiv ! metrics, velocity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zv ! meridional velocity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon ! dummy longitude = 0.
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlat ! latitude for i = north pole
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depthw
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept ! deptht
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! e3 1D : used if full step
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter array
+
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc ! nbasins x npjglo x npk
+
+ CHARACTER(LEN=256) :: cf_vfil ! meridional velocity file
+ CHARACTER(LEN=256) :: cf_moc = 'moc.nc' ! output file name
+ CHARACTER(LEN=256) :: cglobal ! Global attribute for output file
+ CHARACTER(LEN=256) :: cldum ! dummy char variable
+
+ TYPE(variable) ,DIMENSION(:), ALLOCATABLE :: stypvar ! structure for attribute
+
+ LOGICAL :: lbas = .FALSE. ! new_maskglo.nc file flag
+ LOGICAL :: lfull = .FALSE. ! full step flag
+ LOGICAL :: lchk = .FALSE. ! check for missing files
+ LOGICAL :: ldec = .FALSE. ! check for missing files
+
+ ! Variables used only when MOC decomposition is requested
+ INTEGER(KIND=2), DIMENSION(:,:), ALLOCATABLE :: iumask ! iumask (used if decomposition)
+ INTEGER(KIND=2), DIMENSION(:,:), ALLOCATABLE :: itmask ! itmask (used if decomposition)
+
+ INTEGER(KIND=4) :: itmp, iup, ido ! up and down index for work
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1u ! used if ldec
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hdep ! total depth at v point
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zcoef ! coefficient for geostrophic calc
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp ! temperature
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsal ! salinity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsig0 ! density
+ REAL(KIND=4) :: zmsv
+ REAL(KIND=4) :: rpi ! pi
+ REAL(KIND=4) :: grav = 9.81 ! gravity
+ REAL(KIND=4) :: rau0 = 1025. ! mean density
+
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc_sh ! nbasins x npjglo x npk
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc_bt ! nbasins x npjglo x npk
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc_btw ! nbasins x npjglo x npk
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc_ag ! nbasins x npjglo x npk
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dvgeo ! npiglo x npjglo x 2
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dvbt ! Barotropic velocity
+ REAL(KIND=8) :: dgeo ! Barotropic velocity
+
+ CHARACTER(LEN=256) :: cf_tfil ! Grid T file (case of decomposition)
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoc V file '
- PRINT *,' Computes the MOC for oceanic basins as described in new_maskglo.nc'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,new_maskglo.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on moc.nc: '
- PRINT *,' variables zomsfglo : Global ocean '
- PRINT *,' variables zomsfatl : Atlantic Ocean '
- PRINT *,' variables zomsfinp : Indo Pacific '
- PRINT *,' variables zomsfind : Indian Ocean alone'
- PRINT *,' variables zomsfpac : Pacific Ocean alone'
+ PRINT *,' usage : cdfmoc V_file [-full] [-decomp ] [T_file] '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes the MOC for oceanic sub basins as described '
+ PRINT *,' in ',TRIM(cn_fbasins)
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' V_file : file with meridional velocity component.'
+ PRINT *,' T_file : file with temperature and salinity'
+ PRINT *,' (required only for -decomp option).'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-full ] : use full step instead of default partial step'
+ PRINT *,' [-decomp ] : decompose MOC in 3 components: Geostrophic,'
+ PRINT *,' Barotropic, Ageostrophic). For this option a '
+ PRINT *,' gridT file is required.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' Files ',TRIM(cn_fhgr),' ', TRIM(cn_fhgr),' and ', TRIM(cn_fmsk)
+ PRINT *,' File ',TRIM(cn_fbasins),'. If this latter file is not available '
+ PRINT *,' only the MOC for the global domain is computed'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_moc)
+ PRINT *,' variables ',TRIM( cn_zomsfglo),' : Global ocean '
+ PRINT *,' variables ',TRIM( cn_zomsfatl),' : Atlantic Ocean '
+ PRINT *,' variables ',TRIM( cn_zomsfinp),' : Indo Pacific '
+ PRINT *,' variables ',TRIM( cn_zomsfind),' : Indian Ocean alone'
+ PRINT *,' variables ',TRIM( cn_zomsfpac),' : Pacific Ocean alone'
+ PRINT *,' '
+ PRINT *,' If decomposition is required , ( option -decomp ) add 3 additional'
+ PRINT *,' variables per basin with suffixes _sh, _bt, _ag.'
STOP
ENDIF
- CALL getarg (1, cfilev)
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
+ cglobal = 'Partial step computation'
+ ijarg = 1 ; ii = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg (ijarg, cldum) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
+ CASE ('-full')
+ lfull = .TRUE.
+ cglobal = 'Full step computation'
+ CASE ('-decomp')
+ ldec = .TRUE.
+ CASE DEFAULT
+ ii=ii+1
+ SELECT CASE (ii)
+ CASE ( 1 ) ; cf_vfil = cldum
+ CASE ( 2 ) ; cf_tfil = cldum
+ CASE DEFAULT
+ PRINT*, 'ERROR : Too many arguments ...'
+ STOP
+ END SELECT
+ END SELECT
+ END DO
+
+ lchk = lchk .OR. chkfile ( cn_fhgr )
+ lchk = lchk .OR. chkfile ( cn_fzgr )
+ lchk = lchk .OR. chkfile ( cn_fmsk )
+ lchk = lchk .OR. chkfile ( cf_vfil )
+ IF ( ldec ) lchk = lchk .OR. chkfile ( TRIM(cf_tfil) )
+ IF ( lchk ) STOP ! missing file(s)
- ! Detects newmaskglo file
- INQUIRE( FILE='new_maskglo.nc', EXIST=llglo )
- IF (llglo) THEN
- jpbasins = 5
+ npiglo = getdim (cf_vfil,cn_x)
+ npjglo = getdim (cf_vfil,cn_y)
+ npk = getdim (cf_vfil,cn_z)
+ npt = getdim (cf_vfil,cn_t)
+
+ PRINT *, 'Working with cdfmoc ...'
+ PRINT *, ' npiglo =', npiglo
+ PRINT *, ' npjglo =', npjglo
+ PRINT *, ' npk =', npk
+ PRINT *, ' npt =', npt
+
+ ! Detects newmaskglo file
+ lbas = .NOT. chkfile (cn_fbasins )
+
+ IF (lbas) THEN
+ nbasins = 5
ELSE
- jpbasins = 1
- ENDIF
-
- ALLOCATE ( typvar(jpbasins), ipk(jpbasins), id_varout(jpbasins) )
-
- ! define new variables for output
- typvar(1)%name= 'zomsfglo'
- typvar%units='Sverdrup'
- typvar%missing_value=99999.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar%scale_factor= 1.
- typvar%add_offset= 0.
- typvar%savelog10= 0.
- typvar(1)%long_name='Meridional_Overt.Cell_Global'
- typvar(1)%short_name='zomsfglo'
- typvar%online_operation='N/A'
- typvar%axis='TZY'
-
- ipk(1) = npk ! 2D
-
- IF (llglo) THEN
- typvar(2)%name= 'zomsfatl'
- typvar(2)%long_name='Meridional_Overt.Cell_Atlantic'
- typvar(2)%short_name='zomsfatl'
-
- typvar(3)%name= 'zomsfinp'
- typvar(3)%long_name='Meridional_Overt.Cell_IndoPacif'
- typvar(3)%short_name='zomsfinp'
-
- typvar(4)%name= 'zomsfind'
- typvar(4)%long_name='Meridional_Overt.Cell_Indian'
- typvar(4)%short_name='zomsfind'
-
- typvar(5)%name= 'zomsfpac'
- typvar(5)%long_name='Meridional_Overt.Cell_pacif'
- typvar(5)%short_name='zomspac'
-
- ipk(2) = npk ! 2D
- ipk(3) = npk ! 2D
- ipk(4) = npk ! 2D
- ipk(5) = npk ! 2D
+ nbasins = 1
ENDIF
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ IF ( ldec ) THEN
+ nvarout=nbasins * 4 ! total, _sh, _bt, _ag
+ ELSE
+ nvarout=nbasins ! total
+ ENDIF
- ! Allocate arrays
- ALLOCATE ( zmask(jpbasins,npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo), gphiv(npiglo,npjglo) ,gdepw(npk) )
- ALLOCATE ( zomsf(jpbasins, npjglo, npk) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
+ ALLOCATE ( stypvar(nvarout), ipk(nvarout), id_varout(nvarout) )
+ ! define new variables for output
+ ! all variables
+ stypvar%cunits = 'Sverdrup'
+ stypvar%rmissing_value = 99999.
+ stypvar%valid_min = -1000.
+ stypvar%valid_max = 1000.
+ stypvar%scale_factor = 1.
+ stypvar%add_offset = 0.
+ stypvar%savelog10 = 0.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TZY'
+ ipk(:) = npk ! All variables are vertical slices 1 x npjglo x npk
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
- gdepw(:) = -1.* gdepw(:)
+ ii=1 ; ibasin=1
+ PRINT *, 'Variable ',ii,' is zomsfglo'
+ npglo=ibasin ; ibasin = ibasin + 1
+ stypvar(ii)%cname = TRIM(cn_zomsfglo)
+ stypvar(ii)%clong_name = 'Meridional_Overt.Cell_Global'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfglo)
+ ii=ii+1
- iloc=maxloc(gphiv)
- dumlat(1,:) = gphiv(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
+ IF ( ldec ) THEN
+ PRINT *, 'Variable ',ii,' is zomsfglo_sh'
+ stypvar(ii)%cname = TRIM(cn_zomsfglo)//'_sh'
+ stypvar(ii)%clong_name = 'GeoShear_Merid_StreamFunction'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfglo)//'_sh'
+ ii= ii+1
+ PRINT *, 'Variable ',ii,' is zomsfglo_bt'
+ stypvar(ii)%cname = TRIM(cn_zomsfglo)//'_bt'
+ stypvar(ii)%clong_name = 'Barotropic_Merid_StreamFunction'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfglo)//'_bt'
+ ii= ii+1
+ PRINT *, 'Variable ',ii,' is zomsfglo_ag'
+ stypvar(ii)%cname = TRIM(cn_zomsfglo)//'_ag'
+ stypvar(ii)%clong_name = 'Ageostoph_Merid_StreamFunction'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfglo)//'_ag'
+ ii= ii+1
+ ENDIF
- ! create output fileset
- ncout =create(cfileoutnc, 'none', 1,npjglo,npk,cdep='depthw')
- ierr= createvar(ncout ,typvar,jpbasins, ipk,id_varout )
- ierr= putheadervar(ncout, cfilev,1, npjglo,npk,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw)
- tim=getvar1d(cfilev,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
+ IF (lbas) THEN
+ npatl=ibasin ; ibasin = ibasin + 1
+ PRINT *, 'Variable ',ii,' is zomsfatl'
+ stypvar(ii)%cname = TRIM(cn_zomsfatl)
+ stypvar(ii)%clong_name = 'Meridional_Overt.Cell_Atlantic'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfatl)
+ ii= ii+1
+ IF ( ldec ) THEN
+ PRINT *, 'Variable ',ii,' is zomsfatl_sh'
+ stypvar(ii)%cname = TRIM(cn_zomsfatl)//'_sh'
+ stypvar(ii)%clong_name = 'GeoShear_Merid_StreamFunction_Atlantic'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfatl)//'_sh'
+ ii= ii+1
+ PRINT *, 'Variable ',ii,' is zomsfatl_bt'
+ stypvar(ii)%cname = TRIM(cn_zomsfatl)//'_bt'
+ stypvar(ii)%clong_name = 'Barotropic_Merid_StreamFunction_Atlantic'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfatl)//'_bt'
+ ii= ii+1
+ PRINT *, 'Variable ',ii,' is zomsfatl_ag'
+ stypvar(ii)%cname = TRIM(cn_zomsfatl)//'_ag'
+ stypvar(ii)%clong_name = 'Ageostroph_Merid_StreamFunction_Atlantic'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfatl)//'_ag'
+ ii= ii+1
+ ENDIF
+ npinp=ibasin ; ibasin = ibasin + 1
+ PRINT *, 'Variable ',ii,' is zomsfinp'
+ stypvar(ii)%cname = TRIM(cn_zomsfinp)
+ stypvar(ii)%clong_name = 'Meridional_Overt.Cell_IndoPacif'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfinp)
+ ii= ii+1
- ! reading the masks
- ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif
- zmask(1,:,:)=getvar('mask.nc','vmask',1,npiglo,npjglo)
- IF ( llglo ) THEN
- zmask(2,:,:)=getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- zmask(4,:,:)=getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
- zmask(5,:,:)=getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- zmask(3,:,:)=zmask(5,:,:)+zmask(4,:,:)
- ! ensure that there are no overlapping on the masks
- WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1
- ! change global mask for GLOBAL periodic condition
- zmask(1,1,:) = 0.
- zmask(1,npiglo,:) = 0.
+ IF ( ldec ) THEN
+ PRINT *, 'Variable ',ii,' is zomsfinp_sh'
+ stypvar(ii)%cname = TRIM(cn_zomsfinp)//'_sh'
+ stypvar(ii)%clong_name = 'GeoShear_Merid_StreamFunction_IndoPacif'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfinp)//'_sh'
+ ii= ii+1
+ PRINT *, 'Variable ',ii,' is zomsfinp_bt'
+ stypvar(ii)%cname = TRIM(cn_zomsfinp)//'_bt'
+ stypvar(ii)%clong_name = 'Barotropic_Merid_StreamFunction_IndoPacif'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfinp)//'_bt'
+ ii= ii+1
+ PRINT *, 'Variable ',ii,' is zomsfinp_ag'
+ stypvar(ii)%cname = TRIM(cn_zomsfinp)//'_ag'
+ stypvar(ii)%clong_name = 'Ageostroph_Merid_StreamFunction_IndoPacif'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfinp)//'_ag'
+ ii= ii+1
+ ENDIF
+
+ npind=ibasin ; ibasin = ibasin + 1
+ PRINT *, 'Variable ',ii,' is zomsfind'
+ stypvar(ii)%cname = TRIM(cn_zomsfind)
+ stypvar(ii)%clong_name = 'Meridional_Overt.Cell_Indian'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfind)
+ ii= ii+1
+
+ IF ( ldec ) THEN
+ PRINT *, 'Variable ',ii,' is zomsfind_sh'
+ stypvar(ii)%cname = TRIM(cn_zomsfind)//'_sh'
+ stypvar(ii)%clong_name = 'GeoShear_Merid_StreamFunction_Indian'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfind)//'_sh'
+ ii= ii+1
+ PRINT *, 'Variable ',ii,' is zomsfind_bt'
+ stypvar(ii)%cname = TRIM(cn_zomsfind)//'_bt'
+ stypvar(ii)%clong_name = 'Barotropic_Merid_StreamFunction_Indian'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfind)//'_bt'
+ ii= ii+1
+ PRINT *, 'Variable ',ii,' is zomsfind_ag'
+ stypvar(ii)%cname = TRIM(cn_zomsfind)//'_ag'
+ stypvar(ii)%clong_name = 'Ageostroph_Merid_StreamFunction_Indian'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfind)//'_ag'
+ ii= ii+1
+ ENDIF
+
+ nppac=ibasin ; ibasin = ibasin + 1
+ PRINT *, 'Variable ',ii,' is zomsfpac'
+ stypvar(ii)%cname = TRIM(cn_zomsfpac)
+ stypvar(ii)%clong_name = 'Meridional_Overt.Cell_pacif'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfpac)
+ ii= ii+1
+
+ IF ( ldec ) THEN
+ PRINT *, 'Variable ',ii,' is zomsfpac_sh'
+ stypvar(ii)%cname = TRIM(cn_zomsfpac)//'_sh'
+ stypvar(ii)%clong_name = 'GeoShear_Merid_StreamFunction_Pacif'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfpac)//'_sh'
+ ii= ii+1
+ PRINT *, 'Variable ',ii,' is zomsfpac_bt'
+ stypvar(ii)%cname = TRIM(cn_zomsfpac)//'_bt'
+ stypvar(ii)%clong_name = 'Barotropic_Merid_StreamFunction_Pacif'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfpac)//'_bt'
+ ii= ii+1
+ PRINT *, 'Variable ',ii,' is zomsfpac_ag'
+ stypvar(ii)%cname = TRIM(cn_zomsfpac)//'_ag'
+ stypvar(ii)%clong_name = 'Ageostroph_Merid_StreamFunction_Pacif'
+ stypvar(ii)%cshort_name = TRIM(cn_zomsfpac)//'_ag'
+ ENDIF
+ ENDIF
+
+ ! Allocate arrays
+ ALLOCATE ( ibmask(nbasins, npiglo, npjglo) )
+ ALLOCATE ( zv(npiglo, npjglo), e1v(npiglo,npjglo), e3v(npiglo,npjglo,npk) )
+ ALLOCATE ( gphiv(npiglo,npjglo) )
+ ALLOCATE ( rdumlon(1,npjglo), rdumlat(1,npjglo))
+ ALLOCATE ( gdepw(npk), gdept(npk), e31d(npk) )
+ ALLOCATE ( tim(npt) )
+ ALLOCATE ( dmoc( nbasins, npjglo, npk ) )
+ ALLOCATE ( ivmask(npiglo, npjglo) )
+ IF ( ldec ) THEN
+ ALLOCATE ( iumask(npiglo, npjglo) )
+ ALLOCATE ( itmask(npiglo, npjglo) )
+ ALLOCATE ( ztemp(npiglo, npjglo) )
+ ALLOCATE ( zsal(npiglo, npjglo) )
+ ALLOCATE ( zsig0(npiglo, npjglo) )
+ ALLOCATE ( e1u(npiglo, npjglo) )
+ ALLOCATE ( zcoef(npiglo, npjglo) )
+ ALLOCATE ( dvbt(npiglo, npjglo), hdep(npiglo,npjglo) )
+ ALLOCATE ( dmoc_sh(nbasins, npjglo, npk) )
+ ALLOCATE ( dmoc_bt(nbasins, npjglo, npk) )
+ ALLOCATE ( dmoc_btw(nbasins, npjglo, npk) )
+ ALLOCATE ( dmoc_ag(nbasins, npjglo, npk) )
+ ALLOCATE ( dvgeo(npiglo, npjglo, 2 ) )
ENDIF
+
+ e1v(:,:) = getvar (cn_fhgr, cn_ve1v, 1, npiglo,npjglo)
+ gphiv(:,:) = getvar (cn_fhgr, cn_gphiv, 1, npiglo,npjglo)
+ gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk )
+ gdepw(:) = -1.* gdepw(:)
+ DO jk= 1, npk
+ ! save e3v masked with vmask as 3d array
+ e3v(:,:,jk) = get_e3v(jk)
+ END DO
+
+ IF ( ldec ) gdept(:) = getvare3(cn_fzgr, cn_gdept, npk )
+ IF ( ldec ) e1u(:,:) = getvar (cn_fhgr, cn_ve1u, 1, npiglo,npjglo)
+ IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk)
+
+ iloc=MAXLOC(gphiv)
+ rdumlat(1,:) = gphiv(iloc(1),:)
+ rdumlon(:,:) = 0. ! set the dummy longitude to 0
+
+ ! create output fileset
+ ncout = create ( cf_moc, 'none', 1, npjglo, npk, cdep=cn_vdepthw )
+ ierr = createvar ( ncout, stypvar, nvarout, ipk, id_varout, cdglobal=TRIM(cglobal) )
+ ierr = putheadervar( ncout, cf_vfil, 1, npjglo, npk, pnavlon=rdumlon, pnavlat=rdumlat, pdep=gdepw)
+ tim = getvar1d ( cf_vfil, cn_vtimec, npt )
+ ierr = putvar1d ( ncout, tim, npt, 'T')
- ! initialize moc to 0
- zomsf(:,:,:) = 0.
-
- DO jk = 1,npk-1
- ! Get velocities v at jk
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
-
- ! get e3v at level jk ( ps...)
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo,ldiom=.true.)
-
- ! integrates 'zonally' (along i-coordinate)
- DO ji=1,npiglo
- ! For all basins
- DO jbasin = 1, jpbasins
- DO jj=1,npjglo
- zomsf(jbasin,jj,jk)=zomsf(jbasin,jj,jk) - e1v(ji,jj)*e3v(ji,jj)* zmask(jbasin,ji,jj)*zv(ji,jj)
- ENDDO
- END DO
+ ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif
+ ibmask(npglo,:,:) = getvar(cn_fmsk, 'vmask', 1, npiglo, npjglo)
+ IF ( lbas ) THEN
+ ibmask(npatl,:,:) = getvar(cn_fbasins, 'tmaskatl', 1, npiglo, npjglo)
+ ibmask(npind,:,:) = getvar(cn_fbasins, 'tmaskind', 1, npiglo, npjglo)
+ ibmask(nppac,:,:) = getvar(cn_fbasins, 'tmaskpac', 1, npiglo, npjglo)
+ ibmask(npinp,:,:) = ibmask(nppac,:,:) + ibmask(npind,:,:) ! indo pacific mask
+ ! ensure that there are no overlapping on the masks
+ WHERE(ibmask(npinp,:,:) > 0 ) ibmask(npinp,:,:) = 1
+ ! change global mask for GLOBAL periodic condition
+ ibmask(1,1, :) = 0.
+ ibmask(1,npiglo,:) = 0.
+ ENDIF
+
+ DO jt = 1, npt
+ ! --------------------------
+ ! 1) Compute total MOC: dmoc
+ ! --------------------------
+ dmoc(:,:,:) = 0.d0 ! initialize moc to 0
+ IF ( ldec) THEN ; dvbt=0.d0 ; hdep=0.0 ; dmoc_bt=0.d0 ; ENDIF
+ DO jk = 1, npk-1
+ ! Get velocities v at jk, time = jt
+ zv(:,:)= getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt)
+
+ IF ( ldec ) THEN
+ ! compute barotropic component when requested
+ ! this contribution is computed here in order to use zv(jk)
+ dvbt(:,:) = dvbt(:,:) + e3v(:,:,jk)*zv(:,:)*1.d0
+ hdep(:,:) = hdep(:,:) + e3v(:,:,jk)
+ ENDIF
+
+ ! integrates 'zonally' (along i-coordinate)
+ DO ji=1,npiglo
+ ! For all basins
+ DO jbasin = 1, nbasins
+ DO jj=1,npjglo
+ dmoc(jbasin,jj,jk)=dmoc(jbasin,jj,jk) - &
+ & e1v(ji,jj)*e3v(ji,jj,jk)* ibmask(jbasin,ji,jj)*zv(ji,jj)*1.d0
+ ENDDO
+ END DO
+ END DO
END DO
- END DO
- ! integrates vertically from bottom to surface
- DO jk=npk-1 , 1 , -1
- zomsf(:,:,jk) = zomsf(:,:,jk+1) + zomsf(:,:,jk)/1.e6
- END DO ! loop to next level
+ ! integrates vertically from bottom to surface
+ DO jk = npk-1, 1, -1
+ dmoc(:,:,jk) = dmoc(:,:,jk+1) + dmoc(:,:,jk)/1.d6
+ END DO
- ! netcdf output
- DO jbasin= 1, jpbasins
- DO jk =1, npk
- ierr = putvar (ncout, id_varout(jbasin),REAL(zomsf(jbasin,:,jk)), jk,1,npjglo)
- END DO
- END DO
+ IF ( ldec ) THEN
+ !--------------------------------------------------
+ ! 2) compute extra term if decomposition requested
+ !--------------------------------------------------
+ ! 2.1 : Barotropic MOC : dmoc_bt
+ ! """"""""""""""""""""
+ ! compute vertical mean of the meridional velocity
+ WHERE ( hdep /= 0 )
+ dvbt(:,:) = dvbt(:,:) / hdep(:,:)
+ ELSEWHERE
+ dvbt(:,:) = 0.d0
+ ENDWHERE
+
+ DO jk=1, npk-1
+
+ ! integrates 'zonally' (along i-coordinate)
+ DO ji=1,npiglo
+ ! For all basins
+ DO jbasin = 1, nbasins
+ DO jj=1,npjglo
+ dmoc_bt(jbasin,jj,jk)=dmoc_bt(jbasin,jj,jk) - &
+ & e1v(ji,jj)*e3v(ji,jj,jk)* ibmask(jbasin,ji,jj)*dvbt(ji,jj)
+ ENDDO
+ END DO
+ END DO
+ END DO
+ ! integrates vertically from bottom to surface
+ DO jk = npk-1, 1, -1
+ dmoc_bt(:,:,jk) = dmoc_bt(:,:,jk+1) + dmoc_bt(:,:,jk)/1.d6
+ END DO
+
+ ! 2.2 : Geostrophic Shear MOC : dmoc_sh
+ ! """""""""""""""""""""""""""""
+ ! using equation 2.7 of Lecointre (2008
+ ! f. Dv/Dz = -g/rau0. Drho/Dx
+ rau0 = 1025.0
+ grav = 9.81
+ rpi = ACOS( -1.)
+ zcoef(:,:) = 2*2*rpi/( 24.0 * 3600. )* SIN ( rpi * gphiv(:,:) /180.0) ! f at v point
+ WHERE ( zcoef /= 0 )
+ zcoef(:,:) = -grav/ rau0 / zcoef(:,:)
+ ELSEWHERE
+ zcoef(:,:) = 0.
+ END WHERE
+
+ dvgeo(:,:,:) = 0.0
+ dvbt(:,:) = 0.d0
+ iup = 1 ; ido = 2
+ DO jk=npk-1, 1, -1
+ iumask(:,:) = getvar(cn_fmsk, 'umask', jk, npiglo, npjglo)
+ itmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo)
+ ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt )
+ zsal(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt )
+ zsig0(:,:) = sigmai (ztemp, zsal, gdept(jk), npiglo, npjglo )* itmask(:,:)
+
+ ! dgeo is Drho/dx at V point ( average on the 4 neighbours U points)
+ ! thus, dgeo is -f.rau0/g. Dv/Dz
+ DO jj = 2, npjglo -1
+ DO ji = 2, npiglo -1
+ zmsv = 1. / MAX (1, iumask(ji-1,jj+1)+iumask(ji,jj+1)+iumask(ji-1,jj)+iumask(ji,jj) )
+ dgeo = ( ( zsig0(ji, jj+1) - zsig0(ji-1,jj+1) ) * iumask(ji-1, jj+1) / e1u(ji-1, jj+1) &
+ & +( zsig0(ji+1,jj+1) - zsig0(ji ,jj+1) ) * iumask(ji, jj+1) / e1u(ji, jj+1) &
+ & +( zsig0(ji, jj ) - zsig0(ji-1,jj ) ) * iumask(ji-1, jj ) / e1u(ji-1, jj ) &
+ & +( zsig0(ji+1,jj ) - zsig0(ji, jj ) ) * iumask(ji, jj ) / e1u(ji, jj ) )*1.d0
+ !
+ ! dvgeo is the geostrophic velocity at w point(jk) obtained by vertical integration of Dv/Dz
+ ! between bottom and jk
+ dvgeo(ji,jj,iup) = dvgeo(ji,jj,ido) + zcoef(ji,jj) * dgeo * zmsv * ibmask(npglo,ji,jj) *e3v(ji,jj,jk)
+ ! zv is the geostrophic velocity located at v-level (jk)
+ zv(ji,jj) = 0.5 *( dvgeo(ji,jj,iup) + dvgeo(ji,jj,ido) )
+ ENDDO
+ ENDDO
+ ! compute the vertical mean of geostrophic velocity
+ ! for memory management purpose we re-use dvbt which is not used any longer.
+ dvbt(:,:) = dvbt(:,:) + e3v(:,:,jk)*zv(:,:)*1.d0
+
+ ! integrates 'zonally' (along i-coordinate)
+ DO ji=1,npiglo
+ ! For all basins
+ DO jbasin = 1, nbasins
+ DO jj=1,npjglo
+ dmoc_sh(jbasin,jj,jk)=dmoc_sh(jbasin,jj,jk) - &
+ & e1v(ji,jj)*e3v(ji,jj,jk)* ibmask(jbasin,ji,jj)*zv(ji,jj)*1.d0
+ ENDDO
+ END DO
+ END DO
+ ! swap up and down for next level computation
+ itmp=iup ; iup = ido ; ido = itmp
+ ENDDO ! end of level loop
+
+ WHERE ( hdep /=0 )
+ dvbt(:,:) = dvbt(:,:) / hdep(:,:)
+ ELSEWHERE
+ dvbt(:,:) = 0.d0
+ END WHERE
+
+ ! 2.2.1 : Barotropic Geostrophic Shear MOC : dmoc_btw
+ ! """"""""""""""""""""""""""""""""""""""""""
+ ! compute corresponding MOC for this unwanted pseudo barotropic contribution
+ dmoc_btw(:,:,:) = 0.d0
+ DO jk=1, npk-1
+
+ ! integrates 'zonally' (along i-coordinate)
+ DO ji=1,npiglo
+ ! For all basins
+ DO jbasin = 1, nbasins
+ DO jj=1,npjglo
+ dmoc_btw(jbasin,jj,jk)=dmoc_btw(jbasin,jj,jk) - &
+ & e1v(ji,jj)*e3v(ji,jj,jk)* ibmask(jbasin,ji,jj)*dvbt(ji,jj)
+ ENDDO
+ END DO
+ END DO
+ END DO
+
+ ! apply correction to dmoc_sh
+ dmoc_sh(:,:,:) = dmoc_sh(:,:,:) - dmoc_btw(:,:,:)
+
+ ! integrates vertically from bottom to surface
+ DO jk = npk-1, 1, -1
+ dmoc_sh(:,:,jk) = dmoc_sh(:,:,jk+1) + dmoc_sh(:,:,jk)/1.e6
+ END DO !
+
+ ! 2.3 : Barotropic Geostrophic Shear MOC : dmoc_ag
+ ! ----------------------------------------
+ ! compute ageostrophic component
+ ! AGEO = MOC total Geo-Shear Barotropic
+ dmoc_ag(:,:,:) = dmoc(:,:,:) - dmoc_sh(:,:,:) - dmoc_bt(:,:,:)
+ ENDIF
+
+ ! netcdf output
+ ijvar=1
+ DO jbasin = 1, nbasins
+ DO jk = 1, npk
+ ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc(jbasin,:,jk)), jk, 1, npjglo, ktime=jt)
+ END DO
+ ijvar = ijvar + 1
+ IF ( ldec ) THEN
+! print *, dmoc_sh(jbasin,60,10)
+ DO jk = 1, npk
+ ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc_sh(jbasin,:,jk)), jk, 1, npjglo, ktime=jt)
+ END DO
+! print *, dmoc_bt(jbasin,60,10)
+ ijvar = ijvar + 1
+ DO jk = 1, npk
+ ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc_bt(jbasin,:,jk)), jk, 1, npjglo, ktime=jt)
+ END DO
+! print *, dmoc_ag(jbasin,60,10)
+ ijvar = ijvar + 1
+ DO jk = 1, npk
+ ierr = putvar (ncout, id_varout(ijvar), REAL(dmoc_ag(jbasin,:,jk)), jk, 1, npjglo, ktime=jt)
+ END DO
+ ijvar = ijvar + 1
+ ENDIF
+ END DO
+ ENDDO ! time loop
ierr = closeout(ncout)
+CONTAINS
+ FUNCTION get_e3v(kk)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION get_e3 ***
+ !!
+ !! ** Purpose : Send back e3v at level kk selecting
+ !! full step or partial step case
+ !!
+ !! ** Method : check for global flag lfull
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kk ! level to work with
+ REAL(KIND=4), DIMENSION(npiglo,npjglo) :: get_e3v
+
+ ivmask(:,:) = getvar(cn_fmsk, 'vmask', jk, npiglo, npjglo)
+ IF ( lfull ) THEN
+ get_e3v(:,:) = e31d(jk)
+ ELSE
+ get_e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+ get_e3v(:,:) = get_e3v(:,:) * ivmask(:,:)
+
+ END FUNCTION get_e3v
- END PROGRAM cdfmoc
+
+
+END PROGRAM cdfmoc
diff --git a/cdfmoc_gsop.f90 b/cdfmoc_gsop.f90
deleted file mode 100644
index 338ae59..0000000
--- a/cdfmoc_gsop.f90
+++ /dev/null
@@ -1,424 +0,0 @@
-PROGRAM cdfmoc_gsop
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmoc_gsop ***
- !!
- !! ** Purpose : Compute the Meridional Overturning Cell (MOC)
- !! Components for GSOP intercomparison
- !! PARTIAL STEPS
- !!
- !! ** Method : The MOC is computed from the V velocity field, integrated
- !! from the bottom to the surface, then zonally averaged with
- !! eventual masking for oceanic basins.
- !! In the present version the masking corresponds to the global
- !! configuration. MOC for Global, Atlantic, Indo-Pacific, Indian,Pacific ocean
- !! Results are saved on moc.nc file with variables name respectively
- !! zomsfglo, zomsfatl, zomsfinp, zomsfind, zomsfpac
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (jul. 2005)
- !! G.C. Smith ( Sep 2007) Added MOC decomposition following :
- !! Lee & Marotzke (1998), Baehr, Hirschi, Beismann, & Marotzke (2004), Cabanes, Lee, & Fu (2007), !! Koehl & Stammer (2007).
- !! See also the powerpoint presentation by Tony Lee at the third CLIVAR-GSOP intercomparison
- !! available at : http://www.clivar.org/organization/gsop/synthesis/mit/talks/lee_MOC_comparison.ppt
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jpbasins ! =5 modif Alb 29/11/08 pour fonctionner avec MERA
- INTEGER, PARAMETER :: jpgsop=4
- INTEGER :: jgsop, jbasin, jj, jk ,ji !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout, np
- INTEGER :: numout=10
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout !
- INTEGER, DIMENSION(jpgsop) :: ipk_gsop, id_varout_gsop !
- INTEGER, DIMENSION(2) :: iloc
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1u, e1v, e3v, gphiv, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: Hdep, vbt
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: btsf
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: ztemp,zsal,tmask,umask,vmask, vgeoz
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zsig0
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: vgeo,vgeosh,vfull,vmaskz,tmaskz
- REAL(KIND=4) :: rau0, grav, f0, fcor, zmsv, zphv, rpi
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: e3vz
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: deptht, gdepw !: deptw
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zzmask !: npiglo x npjglo
- REAL(KIND=4), DIMENSION (1) :: tim
-
- REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: zomsf !: jpbasins x npjglo x npk
- REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: zomsf_gsop !: jpgsop x npjglo x npk
-
- CHARACTER(LEN=256) :: cfilet, cfilev , cfileoutnc='gsopmoc.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cbasinmask='new_maskglo.nc'
- CHARACTER(LEN=256) ,DIMENSION(jpgsop) :: cvarname_gsop !: array of var name for output
- TYPE(variable), DIMENSION(jpgsop) :: typvar !: modif Alb 26/11/08 structure for attributes
- LOGICAL :: llglo = .false. !: indicator for presence of new_maskglo.nc file
- INTEGER :: istatus
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoc V file Tfile'
- PRINT *,' Computes the MOC for oceanic basins as described in new_maskglo.nc'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,new_maskglo.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on moc.nc: '
- PRINT *,' variables zomsfglo : Global ocean '
- PRINT *,' variables zomsfatl : Atlantic Ocean '
- PRINT *,' variables zomsfinp : Indo Pacific '
- PRINT *,' variables zomsfind : Indian Ocean alone'
- PRINT *,' variables zomsfpac : Pacific Ocean alone'
- STOP
- ENDIF
-
- CALL getarg (1, cfilev)
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
- CALL getarg (2, cfilet)
-
- ! Detects newmaskglo file modif Alb 29/11/08 pour MERA
- INQUIRE( FILE='new_maskglo.nc', EXIST=llglo )
- IF (llglo) THEN
- jpbasins = 5
- ELSE
- jpbasins = 1
- ENDIF
-
- ! define new variables for output ( must update att.txt)
-
- typvar(1)%name= 'zobtmsfa'
- typvar(1)%units='Sverdrup'
- typvar(1)%missing_value=99999.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar(1)%scale_factor= 1.
- typvar(1)%add_offset= 0.
- typvar(1)%savelog10= 0.
- typvar(1)%long_name='Barotropic_Merid_StreamFunction'
- typvar(1)%short_name='zobtmsfa'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZY'
-
- typvar(2)%name= 'zoshmsfa'
- typvar(2)%units='Sverdrup'
- typvar(2)%missing_value=99999.
- typvar(2)%valid_min= -1000.
- typvar(2)%valid_max= 1000.
- typvar(2)%scale_factor= 1.
- typvar(2)%add_offset= 0.
- typvar(2)%savelog10= 0.
- typvar(2)%long_name='GeoShear_Merid_StreamFunction'
- typvar(2)%short_name='zoshmsfa'
- typvar(2)%online_operation='N/A'
- typvar(2)%axis='TZY'
-
- typvar(3)%name= 'zoagmsfa'
- typvar(3)%units='Sverdrup'
- typvar(3)%missing_value=99999.
- typvar(3)%valid_min= -1000.
- typvar(3)%valid_max= 1000.
- typvar(3)%scale_factor= 1.
- typvar(3)%add_offset= 0.
- typvar(3)%savelog10= 0.
- typvar(3)%long_name='Ageo_Merid_StreamFunction'
- typvar(3)%short_name='zoagmsfa'
- typvar(3)%online_operation='N/A'
- typvar(3)%axis='TZY'
-
- typvar(4)%name= 'zomsfatl'
- typvar(4)%units='Sverdrup'
- typvar(4)%missing_value=99999.
- typvar(4)%valid_min= -1000.
- typvar(4)%valid_max= 1000.
- typvar(4)%scale_factor= 1.
- typvar(4)%add_offset= 0.
- typvar(4)%savelog10= 0.
- typvar(4)%long_name='Meridional_Overt.Cell_Atlantic'
- typvar(4)%short_name='zomsfatl'
- typvar(4)%online_operation='N/A'
- typvar(4)%axis='TZY'
-
- ipk_gsop(1) = npk
- ipk_gsop(2) = npk
- ipk_gsop(3) = npk
- ipk_gsop(4) = npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(jpbasins,npiglo,npjglo) )
- ALLOCATE ( tmask(npiglo,npjglo) )
- ALLOCATE ( umask(npiglo,npjglo) )
- ALLOCATE ( vmask(npiglo,npjglo) )
- ALLOCATE ( vmaskz(npiglo,npjglo,npk) )
- ALLOCATE ( tmaskz(npiglo,npjglo,npk) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e1u(npiglo,npjglo),e1v(npiglo,npjglo),e3v(npiglo,npjglo), gphiv(npiglo,npjglo) ,gdepw(npk) )
- ALLOCATE ( Hdep(npiglo,npjglo), vbt(npiglo,npjglo) )
- ALLOCATE ( ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsig0(npiglo,npjglo) )
- ALLOCATE ( btsf(npjglo,npk) )
- ALLOCATE ( vgeo(npiglo,npjglo,npk) )
- ALLOCATE ( vfull(npiglo,npjglo,npk) )
- ALLOCATE ( vgeosh(npiglo,npjglo,npk) )
- ALLOCATE ( vgeoz(npiglo,npjglo) )
- ALLOCATE ( e3vz(npiglo,npjglo,npk) )
- ALLOCATE ( zomsf(jpbasins, npjglo, npk) )
- ALLOCATE ( zomsf_gsop(jpgsop, npjglo, npk) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
- ALLOCATE ( deptht(npk) )
- ALLOCATE ( zzmask(npiglo,npjglo) )
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e1u(:,:) = getvar(coordhgr, 'e1u', 1,npiglo,npjglo)
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- deptht(:) = getvare3(coordzgr, 'gdept',npk)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
- gdepw(:) = -1.* gdepw(:)
-
- iloc=maxloc(gphiv)
- dumlat(1,:) = gphiv(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
-
- ! create output fileset
- ncout =create(cfileoutnc, cfilev,1,npjglo,npk,cdep='depthw')
- ierr= createvar(ncout ,typvar,jpgsop, ipk_gsop,id_varout_gsop )
- ierr= putheadervar(ncout, cfilev,1, npjglo,npk,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw)
- tim=getvar1d(cfilev,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ! reading the masks
- ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif
-
-zmask=0
-zmask(1,:,:)=getvar('mask.nc','vmask',1,npiglo,npjglo)
-
-IF (llglo) THEN
-
- zmask(2,:,:)=getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- zmask(4,:,:)=getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
- zmask(5,:,:)=getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- zmask(3,:,:)=zmask(5,:,:)+zmask(4,:,:)
- ! ensure that there are no overlapping on the masks
- WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1
-
-ELSE
-
-zmask(2,:,:)=getvar('mask.nc','tmask',1,npiglo,npjglo)
-
-ENDIF
-
- ! initialize moc to 0
- zomsf(:,:,:) = 0.
- zomsf_gsop(:,:,:) = 0.
- vbt(:,:) = 0.0
- Hdep(:,:) = 0.0
- btsf(:,:) = 0.0
- vgeo(:,:,:)=0.0
- vfull(:,:,:)=0.0
-
- ! Constants for geostrophic calc
- rau0 = 1025.0
- grav = 9.81
- rpi = 3.14159
- f0 = 2.0*(2.0*rpi)/(24.0*3600.0)
-
- ! Get velocities v and e3v_ps and masks at all levels
- DO jk = 1,npk
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- vfull(:,:,jk) = zv(:,:)
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo)
- e3vz(:,:,jk) = e3v(:,:)
- vmask(:,:)=getvar('mask.nc','vmask',jk,npiglo,npjglo)
- vmaskz(:,:,jk) = vmask(:,:)
- tmask(:,:)=getvar('mask.nc','tmask',jk,npiglo,npjglo)
- tmaskz(:,:,jk) = tmask(:,:)
- ENDDO
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! CALCUL OF THE TOTAL AMOC
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- DO jk = 1,npk-1
- ! Integrates 'zonally' (along i-coordinate)
- DO ji=1,npiglo
- ! For all basins
- DO jbasin = 1, jpbasins
- DO jj=1,npjglo
- zomsf(jbasin,jj,jk)=zomsf(jbasin,jj,jk) - vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(jbasin,ji,jj)*vfull(ji,jj,jk)/1.e6
- ENDDO ! loop to next latitude
- END DO ! loop to next basin
- END DO ! loop to next longitude
- ENDDO ! loop to next level
- ! Integrates vertically from bottom to surface
- DO jk=npk-1 , 1 , -1
- zomsf(:,:,jk) = zomsf(:,:,jk+1) + zomsf(:,:,jk)
- END DO ! loop to next level
- ! Save variable in zomsf_gsop
- zomsf_gsop(4,:,:) = zomsf(2,:,:)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! CALCUL OF THE BAROTROPIC AMOC
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- ! Calcul barotropic velocity, assuming barotropic velocity is zero at the
- ! bottom
- DO jk = 1,npk-1
- DO ji=1,npiglo
- DO jj=1,npjglo
- vbt(ji,jj) = vbt(ji,jj) + e3vz(ji,jj,jk)*zmask(2,ji,jj)*vfull(ji,jj,jk)*vmaskz(ji,jj,jk) ! hardwire to jbasin=2
- Hdep(ji,jj) = Hdep(ji,jj) + e3vz(ji,jj,jk)*zmask(2,ji,jj)*vmaskz(ji,jj,jk)
- ENDDO ! loop to next latitude
- ENDDO ! loop to next longitude
- ENDDO ! loop to next level
-
- ! Normalize barotropic velocity
- DO ji=1,npiglo
- DO jj=1,npjglo
- IF ( Hdep(ji,jj) > 0.0 ) THEN
- vbt(ji,jj) = vbt(ji,jj)/Hdep(ji,jj)
- ELSE
- IF ( vbt(ji,jj) /= 0.0 ) THEN
- print *, 'Is something wrong?, ji,jj=',ji,jj
- ENDIF
- vbt(ji,jj) = 0.0
- ENDIF
- ENDDO ! loop to next latitude
- ENDDO ! loop to next longitude
-
- ! Integrate zonally the barotropic velocity
- DO jk=1, npk
- DO jj=1,npjglo
- DO ji=1,npiglo
- btsf(jj,jk) = btsf(jj,jk) - vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vbt(ji,jj)/1.e6
- ENDDO
- ENDDO
- ENDDO
- ! Now Integrate vertically to get barotropic AMOC
- DO jk=npk-1 , 1 , -1
- btsf(:,jk) = btsf(:,jk+1) + btsf(:,jk)
- END DO ! loop to next level
- ! Save variable in zomsf_gsop
- zomsf_gsop(1,:,:) = btsf(:,:)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! CALCUL OF THE GEOSTROPHIC AMOC
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- DO jk = 1,npk-1
- ! Calculate density
- ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo)
- zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo)
- zzmask=1
- WHERE(zsal(:,:)* zmask(2,:,:) == 0 ) zzmask = 0
- ! geostrophic calculation must use in situ density gradient
- zsig0(:,:) = sigmai ( ztemp,zsal,deptht(jk),npiglo,npjglo )* zzmask(:,:)
-
- ! Calculate Geostrophic velocity
- ! value at v points is average of values at u points
- DO ji = 2, npiglo-1
- DO jj = 2, npjglo-1
- IF ( gphiv(ji,jj) == 0.0 ) THEN
- vgeo(ji,jj,jk) = 0.0
- ELSE
- zmsv = 1. / MAX( tmaskz(ji,jj+1,jk)*tmaskz(ji-1,jj+1,jk) + tmaskz(ji+1,jj+1,jk)*tmaskz(ji,jj+1,jk) &
- + tmaskz(ji,jj,jk)*tmaskz(ji-1,jj,jk) + tmaskz(ji+1,jj,jk)*tmaskz(ji,jj,jk) , 1. )
- zphv = ( zsig0(ji ,jj+1) - zsig0(ji-1,jj+1) ) * tmaskz(ji ,jj+1,jk)*tmaskz(ji-1,jj+1,jk) / e1u(ji-1,jj+1) &
- + ( zsig0(ji+1,jj+1) - zsig0(ji ,jj+1) ) * tmaskz(ji+1,jj+1,jk)*tmaskz(ji ,jj+1,jk) / e1u(ji ,jj+1) &
- + ( zsig0(ji ,jj ) - zsig0(ji-1,jj ) ) * tmaskz(ji ,jj ,jk)*tmaskz(ji-1,jj ,jk) / e1u(ji-1,jj ) &
- + ( zsig0(ji+1,jj ) - zsig0(ji ,jj ) ) * tmaskz(ji+1,jj ,jk)*tmaskz(ji ,jj ,jk) / e1u(ji ,jj )
- zphv = (1. / rau0) * zphv * zmsv * vmaskz(ji,jj,jk)
- fcor = f0*SIN(rpi*gphiv(ji,jj)/180.0)
- vgeo(ji,jj,jk) = -grav*zphv/fcor*e3vz(ji,jj,jk)*zmask(2,ji,jj)
- ENDIF
- ENDDO ! loop to next latitude
- ENDDO ! loop to next longitude
- ENDDO ! loop to next level
-
- ! Vertical shear-velocity: Remove vertical average
- vgeoz(:,:) = 0.0
- vgeosh(:,:,:)=0.0
- DO ji=1, npiglo
- DO jj = 1, npjglo
- ! Integrate vertically to get geostrophic velocity referenced to bottom
- DO jk = npk-1,1,-1
- vgeo(ji,jj,jk) = vgeo(ji,jj,jk+1) + vgeo(ji,jj,jk)
- ENDDO
- ! Calculate vertical sum
- DO jk = 1, npk
- vgeoz(ji,jj) = vgeoz(ji,jj) + vgeo(ji,jj,jk)*zmask(2,ji,jj)*e3vz(ji,jj,jk)*vmaskz(ji,jj,jk)
- ENDDO
- ! Remove total depth to get vertical mean
- IF ( Hdep(ji,jj) > 0.0 ) THEN
- vgeoz(ji,jj) = vgeoz(ji,jj)/Hdep(ji,jj)
- ELSE
- vgeoz(ji,jj) = 0.0
- ENDIF
- ! Remove vertical mean from geostrophic velocity to get geostrophic vertical shear velocity.
- DO jk = 1, npk
- vgeosh(ji,jj,jk) = zmask(2,ji,jj)*vgeo(ji,jj,jk) - vgeoz(ji,jj)
- ENDDO
- ENDDO ! loop to next latitude
- ENDDO ! loop to next longitude
- ! Calculate vertical shear geostrophic AMOC - integrate over x
- DO jk=1, npk
- DO jj=1,npjglo
- DO ji=1,npiglo
- zomsf_gsop(2,jj,jk) = zomsf_gsop(2,jj,jk) - vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vgeosh(ji,jj,jk)/1.e6
- ENDDO
- ENDDO
- ENDDO
- ! Integrate vertically to get GEOSTROPHIC AMOC
- DO jk=npk-1 , 1 , -1
- zomsf_gsop(2,:,jk) = zomsf_gsop(2,:,jk+1) + zomsf_gsop(2,:,jk)
- END DO ! loop to next level
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! CALCUL OF THE AGEOSTROPHIC AMOC
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- ! Calculate Ageostrophic meridional transport as residual
- ! SFag = MOC - SFshear - SFbarotropic
- zomsf_gsop(3,:,:) = zomsf_gsop(4,:,:) - zomsf_gsop(2,:,:) - zomsf_gsop(1,:,:)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- jj = 190 ; jk = 26 ; ji=50
- FIND26: DO jj=1,npjglo
- IF ( dumlat(1,jj) > 26.0 ) EXIT FIND26
- ENDDO FIND26
- print *, 'MOC:zomsf(2,jj,jk) = ', zomsf(2,jj,jk)
- print *, 'BT:zomsf_gsop(1,jj,jk) = ', zomsf_gsop(1,jj,jk)
- print *, 'SH:zomsf_gsop(2,jj,jk) = ', zomsf_gsop(2,jj,jk)
- print *, 'AG:zomsf_gsop(3,jj,jk) = ', zomsf_gsop(3,jj,jk)
-
- !---------------------------------
- ! netcdf output
- !---------------------------------
-
- !print *, 'Writing netcdf...'
- DO jgsop = 1, jpgsop
- DO jk=1,npk
- ierr = putvar (ncout, id_varout_gsop(jgsop),REAL(zomsf_gsop(jgsop,:,jk)), jk,1,npjglo)
- ENDDO
- ENDDO
-
- ierr = closeout(ncout)
-
-END PROGRAM cdfmoc_gsop
diff --git a/cdfmoc_gsop_x.f90 b/cdfmoc_gsop_x.f90
deleted file mode 100644
index 7f292e9..0000000
--- a/cdfmoc_gsop_x.f90
+++ /dev/null
@@ -1,507 +0,0 @@
-PROGRAM cdfmoc_gsop_x
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmoc_gsop ***
- !!
- !! ** Purpose : Compute the Meridional Overturning Cell (MOC)
- !! Components for GSOP intercomparison
- !! PARTIAL STEPS
- !!
- !! ** Method : The MOC is computed from the V velocity field, integrated
- !! from the bottom to the surface, then zonally averaged with
- !! eventual masking for oceanic basins.
- !! In the present version the masking corresponds to the global
- !! configuration. MOC for Global, Atlantic, Indo-Pacific, Indian,Pacific ocean
- !! Results are saved on moc.nc file with variables name respectively
- !! zomsfglo, zomsfatl, zomsfinp, zomsfind, zomsfpac
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (jul. 2005)
- !! G.C. Smith ( Sep 2007) Added MOC decomposition following :
- !! Lee & Marotzke (1998), Baehr, Hirschi, Beismann, & Marotzke (2004), Cabanes, Lee, & Fu (2007), !! Koehl & Stammer (2007).
- !! See also the powerpoint presentation by Tony Lee at the third CLIVAR-GSOP intercomparison
- !! available at : http://www.clivar.org/organization/gsop/synthesis/mit/talks/lee_MOC_comparison.ppt
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jpbasins ! =5 modif Alb 29/11/08 pour fonctionner avec MERA
- INTEGER, PARAMETER :: jpgsop=4
- INTEGER :: jgsop, jbasin, jj, jk ,ji !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout, np
- INTEGER :: numout=10
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout !
- INTEGER, DIMENSION(jpgsop) :: ipk_gsop, id_varout_gsop !
- INTEGER, DIMENSION(2) :: iloc
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1u, e1v, e3v, gphiv, glamv, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: Hdep, vbt
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: btsf
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: btsf_x
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: ztemp,zsal,tmask,umask,vmask, vgeoz
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zsig0
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: vgeo,vgeosh,vfull,vmaskz,tmaskz
- REAL(KIND=4) :: rau0, grav, f0, fcor, zmsv, zphv, rpi
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: e3vz
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: deptht, gdepw !: deptw
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zzmask !: npiglo x npjglo
- REAL(KIND=4), DIMENSION (1) :: tim
-
- REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: zomsf !: jpbasins x npjglo x npk
- REAL(KIND=8) ,DIMENSION(:,:,:,:) , ALLOCATABLE :: zomsf_x !: jpbasins x npiglo x npjglo x npk
- REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: zomsf_gsop !: jpgsop x npjglo x npk
- REAL(KIND=8) ,DIMENSION(:,:,:,:) , ALLOCATABLE :: zomsf_gsop_x !: jpgsop x npiglo x npjglo x npk
-
- CHARACTER(LEN=256) :: cfilet, cfilev , cfileoutnc='gsopmoc.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cbasinmask='new_maskglo.nc'
- CHARACTER(LEN=256) ,DIMENSION(jpgsop) :: cvarname_gsop !: array of var name for output
- TYPE(variable), DIMENSION(jpgsop) :: typvar !: modif Alb 26/11/08 structure for attributes
- LOGICAL :: llglo = .false. !: indicator for presence of new_maskglo.nc file
- INTEGER :: istatus
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoc V file Tfile'
- PRINT *,' Computes the MOC for oceanic basins as described in new_maskglo.nc'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,new_maskglo.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on moc.nc: '
- PRINT *,' variables zomsfglo : Global ocean '
- PRINT *,' variables zomsfatl : Atlantic Ocean '
- PRINT *,' variables zomsfinp : Indo Pacific '
- PRINT *,' variables zomsfind : Indian Ocean alone'
- PRINT *,' variables zomsfpac : Pacific Ocean alone'
- STOP
- ENDIF
-
- CALL getarg (1, cfilev)
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
- CALL getarg (2, cfilet)
-
- ! Detects newmaskglo file modif Alb 29/11/08 pour MERA
- INQUIRE( FILE='new_maskglo.nc', EXIST=llglo )
- IF (llglo) THEN
- jpbasins = 5
- ELSE
- jpbasins = 1
- ENDIF
-
- ! define new variables for output ( must update att.txt)
-
-! typvar(1)%name= 'zobtmsfa'
-! typvar(1)%units='Sverdrup'
-! typvar(1)%missing_value=99999.
-! typvar(1)%valid_min= -1000.
-! typvar(1)%valid_max= 1000.
-! typvar(1)%scale_factor= 1.
-! typvar(1)%add_offset= 0.
-! typvar(1)%savelog10= 0.
-! typvar(1)%long_name='Barotropic_Merid_StreamFunction'
-! typvar(1)%short_name='zobtmsfa'
-! typvar(1)%online_operation='N/A'
-! typvar(1)%axis='TZY'
-
-! typvar(2)%name= 'zoshmsfa'
-! typvar(2)%units='Sverdrup'
-! typvar(2)%missing_value=99999.
-! typvar(2)%valid_min= -1000.
-! typvar(2)%valid_max= 1000.
-! typvar(2)%scale_factor= 1.
-! typvar(2)%add_offset= 0.
-! typvar(2)%savelog10= 0.
-! typvar(2)%long_name='GeoShear_Merid_StreamFunction'
-! typvar(2)%short_name='zoshmsfa'
-! typvar(2)%online_operation='N/A'
-! typvar(2)%axis='TZY'
-
-! typvar(3)%name= 'zoagmsfa'
-! typvar(3)%units='Sverdrup'
-! typvar(3)%missing_value=99999.
-! typvar(3)%valid_min= -1000.
-! typvar(3)%valid_max= 1000.
-! typvar(3)%scale_factor= 1.
-! typvar(3)%add_offset= 0.
-! typvar(3)%savelog10= 0.
-! typvar(3)%long_name='Ageo_Merid_StreamFunction'
-! typvar(3)%short_name='zoagmsfa'
-! typvar(3)%online_operation='N/A'
-! typvar(3)%axis='TZY'
-
-! typvar(4)%name= 'zomsfatl'
-! typvar(4)%units='Sverdrup'
-! typvar(4)%missing_value=99999.
-! typvar(4)%valid_min= -1000.
-! typvar(4)%valid_max= 1000.
-! typvar(4)%scale_factor= 1.
-! typvar(4)%add_offset= 0.
-! typvar(4)%savelog10= 0.
-! typvar(4)%long_name='Meridional_Overt.Cell_Atlantic'
-! typvar(4)%short_name='zomsfatl'
-! typvar(4)%online_operation='N/A'
-! typvar(4)%axis='TZY'
-
-! ipk_gsop(1) = npk
-! ipk_gsop(2) = npk
-! ipk_gsop(3) = npk
-! ipk_gsop(4) = npk
-
- typvar(1)%name= 'zobtmsfa_x'
- typvar(1)%units='Sverdrup'
- typvar(1)%missing_value=99999.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar(1)%scale_factor= 1.
- typvar(1)%add_offset= 0.
- typvar(1)%savelog10= 0.
- typvar(1)%long_name='Barotropic_Merid_StreamFunction_x'
- typvar(1)%short_name='zobtmsfa_x'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
- typvar(2)%name= 'zoshmsfa_x'
- typvar(2)%units='Sverdrup'
- typvar(2)%missing_value=99999.
- typvar(2)%valid_min= -1000.
- typvar(2)%valid_max= 1000.
- typvar(2)%scale_factor= 1.
- typvar(2)%add_offset= 0.
- typvar(2)%savelog10= 0.
- typvar(2)%long_name='GeoShear_Merid_StreamFunction_x'
- typvar(2)%short_name='zoshmsfa_x'
- typvar(2)%online_operation='N/A'
- typvar(2)%axis='TZYX'
-
- typvar(3)%name= 'zoagmsfa_x'
- typvar(3)%units='Sverdrup'
- typvar(3)%missing_value=99999.
- typvar(3)%valid_min= -1000.
- typvar(3)%valid_max= 1000.
- typvar(3)%scale_factor= 1.
- typvar(3)%add_offset= 0.
- typvar(3)%savelog10= 0.
- typvar(3)%long_name='Ageo_Merid_StreamFunction_x'
- typvar(3)%short_name='zoagmsfa_x'
- typvar(3)%online_operation='N/A'
- typvar(3)%axis='TZYX'
-
- typvar(4)%name= 'zomsfatl_x'
- typvar(4)%units='Sverdrup'
- typvar(4)%missing_value=99999.
- typvar(4)%valid_min= -1000.
- typvar(4)%valid_max= 1000.
- typvar(4)%scale_factor= 1.
- typvar(4)%add_offset= 0.
- typvar(4)%savelog10= 0.
- typvar(4)%long_name='Meridional_Overt.Cell_Atlantic_x'
- typvar(4)%short_name='zomsfatl_x'
- typvar(4)%online_operation='N/A'
- typvar(4)%axis='TZYX'
-
- ipk_gsop(1) = npk
- ipk_gsop(2) = npk
- ipk_gsop(3) = npk
- ipk_gsop(4) = npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(jpbasins,npiglo,npjglo) )
- ALLOCATE ( tmask(npiglo,npjglo) )
- ALLOCATE ( umask(npiglo,npjglo) )
- ALLOCATE ( vmask(npiglo,npjglo) )
- ALLOCATE ( vmaskz(npiglo,npjglo,npk) )
- ALLOCATE ( tmaskz(npiglo,npjglo,npk) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e1u(npiglo,npjglo),e1v(npiglo,npjglo),e3v(npiglo,npjglo), gphiv(npiglo,npjglo) ,glamv(npiglo,npjglo),gdepw(npk) )
- ALLOCATE ( Hdep(npiglo,npjglo), vbt(npiglo,npjglo) )
- ALLOCATE ( ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsig0(npiglo,npjglo) )
- ALLOCATE ( btsf(npjglo,npk) )
- ALLOCATE ( btsf_x(npiglo,npjglo,npk) )
- ALLOCATE ( vgeo(npiglo,npjglo,npk) )
- ALLOCATE ( vfull(npiglo,npjglo,npk) )
- ALLOCATE ( vgeosh(npiglo,npjglo,npk) )
- ALLOCATE ( vgeoz(npiglo,npjglo) )
- ALLOCATE ( e3vz(npiglo,npjglo,npk) )
- ALLOCATE ( zomsf(jpbasins, npjglo, npk) )
- ALLOCATE ( zomsf_x(jpbasins, npiglo,npjglo, npk) )
- ALLOCATE ( zomsf_gsop(jpgsop, npjglo, npk) )
- ALLOCATE ( zomsf_gsop_x(jpgsop, npiglo,npjglo, npk) )
- ALLOCATE ( dumlon(npiglo,npjglo) , dumlat(npiglo,npjglo))
- ALLOCATE ( deptht(npk) )
- ALLOCATE ( zzmask(npiglo,npjglo) )
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e1u(:,:) = getvar(coordhgr, 'e1u', 1,npiglo,npjglo)
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- glamv(:,:) = getvar(coordhgr, 'glamv', 1,npiglo,npjglo)
- deptht(:) = getvare3(coordzgr, 'gdept',npk)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
- gdepw(:) = -1.* gdepw(:)
-
- iloc=maxloc(gphiv)
- dumlat(:,:) = gphiv(:,:)
- dumlon(:,:) = glamv(:,:)
-
- ! create output fileset
-! ncout =create(cfileoutnc, cfilev,1,npjglo,npk,cdep='depthw')
- ncout =create(cfileoutnc, cfilev, npiglo,npjglo,npk,cdep='depthw')
- ierr= createvar(ncout ,typvar,jpgsop, ipk_gsop,id_varout_gsop )
-! ierr= putheadervar(ncout, cfilev,1, npjglo,npk,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw)
- ierr= putheadervar(ncout, cfilev,npiglo, npjglo,npk,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw)
- tim=getvar1d(cfilev,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ! reading the masks
- ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif
-
-zmask=0
-zmask(1,:,:)=getvar('mask.nc','vmask',1,npiglo,npjglo)
-
-IF (llglo) THEN
-
- zmask(2,:,:)=getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- zmask(4,:,:)=getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
- zmask(5,:,:)=getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- zmask(3,:,:)=zmask(5,:,:)+zmask(4,:,:)
- ! ensure that there are no overlapping on the masks
- WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1
-
-ELSE
-
-zmask(2,:,:)=getvar('mask.nc','tmask',1,npiglo,npjglo)
-
-ENDIF
-
- ! initialize moc to 0
- zomsf(:,:,:) = 0.
- zomsf_x(:,:,:,:) = 0.
- zomsf_gsop(:,:,:) = 0.
- zomsf_gsop_x(:,:,:,:) = 0.
- vbt(:,:) = 0.0
- Hdep(:,:) = 0.0
- btsf(:,:) = 0.0
- btsf_x(:,:,:) = 0.0
- vgeo(:,:,:)=0.0
- vfull(:,:,:)=0.0
-
- ! Constants for geostrophic calc
- rau0 = 1025.0
- grav = 9.81
- rpi = 3.14159
- f0 = 2.0*(2.0*rpi)/(24.0*3600.0)
-
- ! Get velocities v and e3v_ps and masks at all levels
- DO jk = 1,npk
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- vfull(:,:,jk) = zv(:,:)
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo)
- e3vz(:,:,jk) = e3v(:,:)
- vmask(:,:)=getvar('mask.nc','vmask',jk,npiglo,npjglo)
- vmaskz(:,:,jk) = vmask(:,:)
- tmask(:,:)=getvar('mask.nc','tmask',jk,npiglo,npjglo)
- tmaskz(:,:,jk) = tmask(:,:)
- ENDDO
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! CALCUL OF THE TOTAL AMOC
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- DO jk = 1,npk-1
- ! Integrates 'zonally' (along i-coordinate)
- DO ji=1,npiglo
- ! For all basins
- DO jbasin = 1, jpbasins
- DO jj=1,npjglo
- zomsf(jbasin,jj,jk)=zomsf(jbasin,jj,jk) - vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(jbasin,ji,jj)*vfull(ji,jj,jk)/1.e6
- zomsf_x(jbasin,ji,jj,jk) = zomsf(jbasin,jj,jk)
- ENDDO ! loop to next latitude
- END DO ! loop to next basin
- END DO ! loop to next longitude
- ENDDO ! loop to next level
- ! Integrates vertically from bottom to surface
- DO jk=npk-1 , 1 , -1
- zomsf(:,:,jk) = zomsf(:,:,jk+1) + zomsf(:,:,jk)
- zomsf_x(:,:,:,jk) = zomsf_x(:,:,:,jk+1) + zomsf_x(:,:,:,jk)
- END DO ! loop to next level
- ! Save variable in zomsf_gsop
- zomsf_gsop(4,:,:) = zomsf(2,:,:)
- zomsf_gsop_x(4,:,:,:) = zomsf_x(2,:,:,:)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! CALCUL OF THE BAROTROPIC AMOC
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- ! Calcul barotropic velocity, assuming barotropic velocity is zero at the
- ! bottom
- DO jk = 1,npk-1
- DO ji=1,npiglo
- DO jj=1,npjglo
- vbt(ji,jj) = vbt(ji,jj) + e3vz(ji,jj,jk)*zmask(2,ji,jj)*vfull(ji,jj,jk)*vmaskz(ji,jj,jk) ! hardwire to jbasin=2
- Hdep(ji,jj) = Hdep(ji,jj) + e3vz(ji,jj,jk)*zmask(2,ji,jj)*vmaskz(ji,jj,jk)
- ENDDO ! loop to next latitude
- ENDDO ! loop to next longitude
- ENDDO ! loop to next level
-
- ! Normalize barotropic velocity
- DO ji=1,npiglo
- DO jj=1,npjglo
- IF ( Hdep(ji,jj) > 0.0 ) THEN
- vbt(ji,jj) = vbt(ji,jj)/Hdep(ji,jj)
- ELSE
- IF ( vbt(ji,jj) /= 0.0 ) THEN
- print *, 'Is something wrong?, ji,jj=',ji,jj
- ENDIF
- vbt(ji,jj) = 0.0
- ENDIF
- ENDDO ! loop to next latitude
- ENDDO ! loop to next longitude
-
- ! Integrate zonally the barotropic velocity
- DO jk=1, npk
- DO jj=1,npjglo
- DO ji=1,npiglo
- btsf(jj,jk) = btsf(jj,jk) - vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vbt(ji,jj)/1.e6
- btsf_x(ji,jj,jk) = btsf(jj,jk)
- END DO
- ENDDO
- ENDDO
- ! Now Integrate vertically to get barotropic AMOC
- DO jk=npk-1 , 1 , -1
- btsf(:,jk) = btsf(:,jk+1) + btsf(:,jk)
- btsf_x(:,:,jk) = btsf_x(:,:,jk+1) + btsf_x(:,:,jk)
- END DO ! loop to next level
- ! Save variable in zomsf_gsop
- zomsf_gsop(1,:,:) = btsf(:,:)
- zomsf_gsop_x(1,:,:,:) = btsf_x(:,:,:)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! CALCUL OF THE GEOSTROPHIC AMOC
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- DO jk = 1,npk-1
- ! Calculate density
- ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo)
- zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo)
- zzmask=1
- WHERE(zsal(:,:)* zmask(2,:,:) == 0 ) zzmask = 0
- ! geostrophic calculation must use in situ density gradient
- zsig0(:,:) = sigmai ( ztemp,zsal,deptht(jk),npiglo,npjglo )* zzmask(:,:)
-
- ! Calculate Geostrophic velocity
- ! value at v points is average of values at u points
- DO ji = 2, npiglo-1
- DO jj = 2, npjglo-1
- IF ( gphiv(ji,jj) == 0.0 ) THEN
- vgeo(ji,jj,jk) = 0.0
- ELSE
- zmsv = 1. / MAX( tmaskz(ji,jj+1,jk)*tmaskz(ji-1,jj+1,jk) + tmaskz(ji+1,jj+1,jk)*tmaskz(ji,jj+1,jk) &
- + tmaskz(ji,jj,jk)*tmaskz(ji-1,jj,jk) + tmaskz(ji+1,jj,jk)*tmaskz(ji,jj,jk) , 1. )
- zphv = ( zsig0(ji ,jj+1) - zsig0(ji-1,jj+1) ) * tmaskz(ji ,jj+1,jk)*tmaskz(ji-1,jj+1,jk) / e1u(ji-1,jj+1) &
- + ( zsig0(ji+1,jj+1) - zsig0(ji ,jj+1) ) * tmaskz(ji+1,jj+1,jk)*tmaskz(ji ,jj+1,jk) / e1u(ji ,jj+1) &
- + ( zsig0(ji ,jj ) - zsig0(ji-1,jj ) ) * tmaskz(ji ,jj ,jk)*tmaskz(ji-1,jj ,jk) / e1u(ji-1,jj ) &
- + ( zsig0(ji+1,jj ) - zsig0(ji ,jj ) ) * tmaskz(ji+1,jj ,jk)*tmaskz(ji ,jj ,jk) / e1u(ji ,jj )
- zphv = (1. / rau0) * zphv * zmsv * vmaskz(ji,jj,jk)
- fcor = f0*SIN(rpi*gphiv(ji,jj)/180.0)
- vgeo(ji,jj,jk) = -grav*zphv/fcor*e3vz(ji,jj,jk)*zmask(2,ji,jj)
- ENDIF
- ENDDO ! loop to next latitude
- ENDDO ! loop to next longitude
- ENDDO ! loop to next level
-
- ! Vertical shear-velocity: Remove vertical average
- vgeoz(:,:) = 0.0
- vgeosh(:,:,:)=0.0
- DO ji=1, npiglo
- DO jj = 1, npjglo
- ! Integrate vertically to get geostrophic velocity referenced to bottom
- DO jk = npk-1,1,-1
- vgeo(ji,jj,jk) = vgeo(ji,jj,jk+1) + vgeo(ji,jj,jk)
- ENDDO
- ! Calculate vertical sum
- DO jk = 1, npk
- vgeoz(ji,jj) = vgeoz(ji,jj) + vgeo(ji,jj,jk)*zmask(2,ji,jj)*e3vz(ji,jj,jk)*vmaskz(ji,jj,jk)
- ENDDO
- ! Remove total depth to get vertical mean
- IF ( Hdep(ji,jj) > 0.0 ) THEN
- vgeoz(ji,jj) = vgeoz(ji,jj)/Hdep(ji,jj)
- ELSE
- vgeoz(ji,jj) = 0.0
- ENDIF
- ! Remove vertical mean from geostrophic velocity to get geostrophic vertical shear velocity.
- DO jk = 1, npk
- vgeosh(ji,jj,jk) = zmask(2,ji,jj)*vgeo(ji,jj,jk) - vgeoz(ji,jj)
- ENDDO
- ENDDO ! loop to next latitude
- ENDDO ! loop to next longitude
- ! Calculate vertical shear geostrophic AMOC - integrate over x
- DO jk=1, npk
- DO jj=1,npjglo
- DO ji=1,npiglo
- zomsf_gsop(2,jj,jk) = zomsf_gsop(2,jj,jk) - vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vgeosh(ji,jj,jk)/1.e6
- zomsf_gsop_x(2,ji,jj,jk) = zomsf_gsop(2,jj,jk)
- ENDDO
- ENDDO
- ENDDO
- ! Integrate vertically to get GEOSTROPHIC AMOC
- DO jk=npk-1 , 1 , -1
- zomsf_gsop(2,:,jk) = zomsf_gsop(2,:,jk+1) + zomsf_gsop(2,:,jk)
- zomsf_gsop_x(2,:,:,jk) = zomsf_gsop_x(2,:,:,jk+1) + zomsf_gsop_x(2,:,:,jk)
- END DO ! loop to next level
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! CALCUL OF THE AGEOSTROPHIC AMOC
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- ! Calculate Ageostrophic meridional transport as residual
- ! SFag = MOC - SFshear - SFbarotropic
- zomsf_gsop(3,:,:) = zomsf_gsop(4,:,:) - zomsf_gsop(2,:,:) - zomsf_gsop(1,:,:)
- zomsf_gsop_x(3,:,:,:) = zomsf_gsop_x(4,:,:,:) - zomsf_gsop_x(2,:,:,:) - zomsf_gsop_x(1,:,:,:)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- jj = 190 ; jk = 26 ; ji=50
- FIND26: DO jj=1,npjglo
- IF ( dumlat(1,jj) > 26.0 ) EXIT FIND26
- ENDDO FIND26
- print *, 'MOC:zomsf(2,jj,jk) = ', zomsf(2,jj,jk)
- print *, 'BT:zomsf_gsop(1,jj,jk) = ', zomsf_gsop(1,jj,jk)
- print *, 'SH:zomsf_gsop(2,jj,jk) = ', zomsf_gsop(2,jj,jk)
- print *, 'AG:zomsf_gsop(3,jj,jk) = ', zomsf_gsop(3,jj,jk)
- print *, 'MOC:zomsf_x(2,ji,jj,jk) = ', zomsf_x(2,ji,jj,jk)
- print *, 'BT:zomsf_gsop_x(1,ji,jj,jk) = ', zomsf_gsop_x(1,ji,jj,jk)
- print *, 'SH:zomsf_gsop_x(2,ji,jj,jk) = ', zomsf_gsop_x(2,ji,jj,jk)
- print *, 'AG:zomsf_gsop_x(3,ji,jj,jk) = ', zomsf_gsop_x(3,ji,jj,jk)
-
- !---------------------------------
- ! netcdf output
- !---------------------------------
-
- !print *, 'Writing netcdf...'
- DO jgsop = 1, jpgsop
- DO jk=1,npk
-! ierr = putvar (ncout, id_varout_gsop(jgsop),REAL(zomsf_gsop(jgsop,:,jk)), jk,1,npjglo)
- ierr = putvar (ncout, id_varout_gsop(jgsop),REAL(zomsf_gsop_x(jgsop,:,:,jk)),jk,npiglo,npjglo)
- ENDDO
- ENDDO
-
- ierr = closeout(ncout)
-
-END PROGRAM cdfmoc_gsop_x
diff --git a/cdfmocatl.f90 b/cdfmocatl.f90
deleted file mode 100644
index dc7c7d8..0000000
--- a/cdfmocatl.f90
+++ /dev/null
@@ -1,156 +0,0 @@
-PROGRAM cdfmocatl
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmocatl ***
- !!
- !! ** Purpose : Compute the Meridional Overturning Cell (MOC)
- !! PARTIAL STEPS
- !!
- !! ** Method : The MOC is computed from the V velocity field, integrated
- !! from the bottom to the surface, then zonally averaged with
- !! eventual masking for oceanic basins.
- !! Results are saved on moc.nc file with variable name zomsfatl
- !! This version is intended to be used with Atlantic-only configurations
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (jul. 2005)
- !! Atlantic Only : J.M. Molines (Nov. 2005)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER, PARAMETER :: jpbasins=1 !: atlantic only !!
- INTEGER :: jbasin, jj, jk ,ji !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout, np
- INTEGER :: numout=10
- INTEGER, DIMENSION(jpbasins) :: ipk, id_varout !
- INTEGER, DIMENSION(2) :: iloc
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, e3v, gphiv, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw !: deptw
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo
- REAL(KIND=4), DIMENSION (1) :: tim
-
- REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: zomsf !: jpbasins x npjglo x npk
-
- CHARACTER(LEN=256) :: cfilev , cfileoutnc='moc.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc'
- TYPE(variable), DIMENSION(jpbasins) :: typvar !: structure for attribures
-
-
- INTEGER :: istatus
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoc V file '
- PRINT *,' Computes the MOC for a mono basin oceanic configuration'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on moc.nc: '
- PRINT *,' variables zomsfatl : Atlantic Ocean '
- STOP
- ENDIF
-
- CALL getarg (1, cfilev)
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
-
- ! define new variables for output ( must update att.txt)
- typvar(1)%name= 'zomsfatl'
- typvar(1)%units='Sverdrup'
- typvar(1)%missing_value=99999.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar(1)%long_name='Meridional_Overt.Cell_Atlantic'
- typvar(1)%short_name='zomsfatl'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZY'
-
-
- ipk(1) = npk !
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(jpbasins,npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo), gphiv(npiglo,npjglo) ,gdepw(npk) )
- ALLOCATE ( zomsf(jpbasins, npjglo, npk) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
-
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
- gdepw(:) = -1.* gdepw(:)
-
- iloc=maxloc(gphiv)
- dumlat(1,:) = gphiv(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
-
- ! create output fileset
- ncout =create(cfileoutnc, cfilev, 1,npjglo,npk,cdep='depthw')
- ierr= createvar(ncout ,typvar ,jpbasins, ipk,id_varout )
- ierr= putheadervar(ncout, cfilev,1, npjglo,npk,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw)
- tim=getvar1d(cfilev,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
-
- ! reading the masks
- zmask(1,:,:)=getvar('mask.nc','vmask',1,npiglo,npjglo)
-
- ! initialize moc to 0
- zomsf(:,:,:) = 0.
-
- DO jk = 1,npk-1
- PRINT *,'level ',jk
- ! Get velocities v at jk
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
-
- ! get e3v at level jk ( ps...)
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
-
- ! integrates 'zonally' (along i-coordinate)
- DO ji=1,npiglo
- ! For all basins
- DO jbasin = 1, jpbasins
- DO jj=1,npjglo
- zomsf(jbasin,jj,jk)=zomsf(jbasin,jj,jk) - e1v(ji,jj)*e3v(ji,jj)* zmask(jbasin,ji,jj)*zv(ji,jj)
- ENDDO
- END DO
- END DO
- END DO
-
- ! integrates vertically from bottom to surface
- DO jk=npk-1 , 1 , -1
- zomsf(:,:,jk) = zomsf(:,:,jk+1) + zomsf(:,:,jk)/1.e6
- END DO ! loop to next level
-
- ! netcdf output
- DO jbasin= 1, jpbasins
- DO jk =1, npk
- ierr = putvar (ncout, id_varout(jbasin),REAL(zomsf(jbasin,:,jk)), jk,1,npjglo)
- END DO
- END DO
-
- ierr = closeout(ncout)
-
- END PROGRAM cdfmocatl
diff --git a/cdfmocsig-full.f90 b/cdfmocsig-full.f90
deleted file mode 100644
index bfefaf7..0000000
--- a/cdfmocsig-full.f90
+++ /dev/null
@@ -1,247 +0,0 @@
-PROGRAM cdfmocsig_full
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmocsig_full ***
- !!
- !! ** Purpose : Compute the Meridional Overturning Cell (MOC)
- !! FULL STEPS in density coordinates (s1)
- !!
- !! ** Method : The MOC is computed from the V velocity field, integrated
- !! from the bottom to the surface, then zonally averaged with
- !! eventual masking for oceanic basins.
- !! In the present version the masking corresponds to the global
- !! configuration. MOC for Global, Atlantic, Indo-Pacific, Indian,Pacific ocean
- !! Results are saved on moc.nc file with variables name respectively
- !! zomsfglo, zomsfatl, zomsfinp, zomsfind, zomsfpac
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (jul. 2005)
- !! moc in density : A.M. Treguier ( Nov. 2005)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
-! FOR sigma 1 as the density coordinate
-! REAL(KIND=4), PARAMETER :: pref = 1000 !: reference for density
-! INTEGER, PARAMETER :: jpbin = 88 !: density bins
-! REAL(KIND=4), PARAMETER :: s1min = 24,s1scal=0.1 !: reference for density
- REAL(KIND=4), PARAMETER :: pref = 2000 !: reference for density
- INTEGER, PARAMETER :: jpbin = 158 !: density bins
- REAL(KIND=4), PARAMETER :: s1min = 30,s1scal=0.05 !: reference for density
-
- INTEGER, PARAMETER :: jpbasins=5
- INTEGER :: jbasin, jj, jk ,ji, jkk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout, np
- INTEGER :: numout=10
- INTEGER, DIMENSION(jpbasins) :: id_varout , ipk !
- INTEGER, DIMENSION(2) :: iloc
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, gphiv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zt,zs, zv, e3v !: metrics, velocity
- INTEGER, DIMENSION (:,:), ALLOCATABLE :: ibin !: integer value corresponding to the density for binning
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zttmp,zstmp, zmask2d !: arrays to call sigmai and mask it
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw !: deptw
- REAL(KIND=4), DIMENSION (jpbin) :: sigma !: density coordinate
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zread !: jpi,1,jpk
- REAL(KIND=4), DIMENSION (1) :: tim
-
- REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zdens !: density
- REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zomsftmp !: temporary transport array
- REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: zomsf !: jpbasins x npjglo x npk
-
- CHARACTER(LEN=256) :: cfilev , cfilet, cfileoutnc='mocsig.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cbasinmask='new_maskglo.nc'
- TYPE(variable) ,DIMENSION(jpbasins) :: typvar !: structure for attribute
-
- REAL (KIND=4) :: ztrans
-
- INTEGER :: istatus
- LOGICAL :: lprint = .false.
-
- ! constants
- lprint = .false.
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmocsig V file T file'
- PRINT *,' Computes the MOC for oceanic basins as described in new_maskglo.nc'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,new_maskglo.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on moc.nc: '
- PRINT *,' variables zomsfglo : Global ocean '
- PRINT *,' variables zomsfatl : Atlantic Ocean '
- PRINT *,' variables zomsfinp : Indo Pacific '
- PRINT *,' variables zomsfind : Indian Ocean alone'
- PRINT *,' variables zomsfpac : Pacific Ocean alone'
- STOP
- ENDIF
- !! density coordinate is sigma1.
- !! bins are by 0.1 from 24 to 32.6 = 87 bins
-
- CALL getarg (1, cfilev)
- CALL getarg (2, cfilet)
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
-
- ! define densities at middle of bins
- DO ji=1,jpbin
- sigma(ji) = s1min +(ji-0.5)*s1scal
- ENDDO
- IF (lprint) print *, ' min density:',sigma(1), ' max density:', sigma(jpbin)
-
- typvar(1)%name= 'zomsfglo'
- typvar%units='Sverdrup'
- typvar%missing_value=99999.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar(1)%long_name='Meridional_Overt.Cell_Global'
- typvar(1)%short_name='zomsfglo'
- typvar%online_operation='N/A'
- typvar%axis='TZY'
-
- typvar(2)%name= 'zomsfatl'
- typvar(2)%long_name='Meridional_Overt.Cell_Atlantic'
- typvar(2)%short_name='zomsfatl'
-
- typvar(3)%name= 'zomsfinp'
- typvar(3)%long_name='Meridional_Overt.Cell_IndoPacif'
- typvar(3)%short_name='zomsfinp'
-
- typvar(4)%name= 'zomsfind'
- typvar(4)%long_name='Meridional_Overt.Cell_Indian'
- typvar(4)%short_name='zomsfind'
-
- typvar(5)%name= 'zomsfpac'
- typvar(5)%long_name='Meridional_Overt.Cell_pacif'
- typvar(5)%short_name='zomspac'
-
-
- ipk(1:jpbasins) = jpbin
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(jpbasins,npiglo,npjglo) )
- ALLOCATE ( zv (npiglo,npjglo), zt(npiglo,npjglo), zs(npiglo,npjglo))
- ALLOCATE ( e3v(npiglo,npjglo) )
- ALLOCATE ( ibin(npiglo, npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo), gphiv(npiglo,npjglo) ,gdepw(npk) )
- ALLOCATE ( zomsf(jpbasins, npjglo, jpbin) )
- ALLOCATE ( zomsftmp(jpbin,npiglo) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
- ALLOCATE ( zdens(npiglo,npjglo))
- ALLOCATE ( zmask2d(npiglo,npjglo), zttmp(npiglo,npjglo))
-
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
- gdepw(:) = -1.* gdepw(:)
-
- iloc=maxloc(gphiv)
- dumlat(1,:) = gphiv(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
-
- ! create output fileset
- IF (lprint) PRINT *, ' ready to create file:',trim( cfileoutnc), ' from reference:',trim(cfilev )
- ncout =create(cfileoutnc, cfilev, 1,npjglo,jpbin,cdep='sigma_1')
- IF (lprint) PRINT *, ' ready to create variables:'
- ierr= createvar(ncout ,typvar ,jpbasins, ipk ,id_varout )
- IF (lprint) PRINT *, ' writing variables headers:'
- ierr= putheadervar(ncout, cfilev,1, npjglo,jpbin,pnavlon=dumlon,pnavlat=dumlat,pdep=sigma)
- IF (lprint) PRINT *, ' writing time_counter:'
- tim=getvar1d(cfilev,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
-
- ! reading the masks
- ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif
-! zmask(1,:,:)=getvar('mask.nc','vmask',1,npiglo,npjglo)
- zmask(1,:,:)= 1.
- zmask(2,:,:)=getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- zmask(4,:,:)=getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
- zmask(5,:,:)=getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- zmask(3,:,:)=zmask(5,:,:)+zmask(4,:,:)
- ! ensure that there are no overlapping on the masks
- WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1
-
- ! initialize moc to 0
- zomsf(:,:,:) = 0.
-
- DO jk = 1,npk-1
- ! for testing purposes only loop from 2 to 400
- IF (lprint) PRINT *,' working at depth ',jk
- ! Get velocities v at jj
- zv(:,:)= getvar(cfilev, 'vomecrty', jk,npiglo,npjglo)
- zt(:,:)= getvar(cfilet, 'votemper', jk,npiglo,npjglo)
- zs(:,:)= getvar(cfilet, 'vosaline', jk,npiglo,npjglo)
- ! get e3v at latitude jj
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo )
- !
- ! finds density
- !
- zmask2d = 1
- WHERE(zt ==0) zmask2d = 0
- zdens = sigmai(zt,zs,pref,npiglo,npjglo)
- zttmp= zdens* zmask2d !: convert to single precision
- ibin(:,:) = ifix( (zttmp-s1min)/s1scal )
- ibin(:,:) = max( ibin(:,:) ,1)
- ibin(:,:) = min(ibin(:,:),jpbin)
- DO jj=2,npjglo-1
- zomsftmp = 0
- ! converts transport in "k" to transport in "sigma"
- ! indirect adresssing - do it once and not for each basin!
- DO ji=2,npiglo-1
- ztrans = e1v(ji,jj)*e3v(ji,jj)*zv(ji,jj)
- zomsftmp(ibin(ji,jj),ji)=zomsftmp(ibin(ji,jj),ji) - ztrans
- END DO
- ! integrates 'zonally' (along i-coordinate)
- ! add to zomsf the contributions from level jk at all densities jkk
- DO jkk =1,jpbin
- DO ji=2,npiglo-1
- DO jbasin= 1, jpbasins
- ! For all basins
- ztrans = zomsftmp(jkk,ji) * zmask(jbasin,ji,jj)
- zomsf(jbasin,jj,jkk)=zomsf(jbasin,jj,jkk ) + ztrans
- ENDDO
- END DO
- END DO
- ! end of loop on latitude for filling zomsf
- END DO
- ! end of loop on depths for calculating transports
- END DO
-
-! integrates vertically from bottom to surface
- zomsf(:,:,jpbin) = zomsf(:,:,jpbin)/1.e6
- DO jk=jpbin-1,1,-1
- zomsf(:,:,jk) = zomsf(:,:,jk+1) + zomsf(:,:,jk)/1.e6
- END DO ! loop to next level
-
- ! netcdf output
- DO jbasin= 1, jpbasins
- DO jk =1, jpbin
- ierr = putvar (ncout, id_varout(jbasin),REAL(zomsf(jbasin,:,jk)), jk,1,npjglo)
- END DO
- END DO
-
- ierr = closeout(ncout)
-
- END PROGRAM cdfmocsig
-
diff --git a/cdfmocsig.f90 b/cdfmocsig.f90
index 69a926f..a875f08 100644
--- a/cdfmocsig.f90
+++ b/cdfmocsig.f90
@@ -1,320 +1,401 @@
PROGRAM cdfmocsig
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmocsig ***
+ !!======================================================================
+ !! *** PROGRAM cdfmocsig ***
+ !!=====================================================================
+ !! ** Purpose : Compute the Meridional Overturning Cell (MOC)
+ !! using density bins.
!!
- !! ** Purpose : Compute the Meridional Overturning Cell (MOC)
- !! PARTIAL STEPS in density coordinates.
- !!
- !! ** Method : The MOC is computed from the V velocity field, collected in density bins,
- !! (reference depth is given as the 3rd argument) and integrated
- !! throughout the density bins, then zonally averaged with
- !! eventual masking for oceanic basins.
- !! In the present version the masking corresponds to the global
- !! configuration. MOC for Global, Atlantic, Indo-Pacific, Indian,Pacific ocean
- !! Results are saved on mocsig.nc file with variables name respectively
- !! zomsfglo, zomsfatl, zomsfinp, zomsfind, zomsfpac.
- !! If no new_maskglo.nc file found, then the mask.nc file is used and
- !! only zomsfglo is computed.
+ !! ** Method : The MOC is computed from the V velocity field, collected in density bins,
+ !! (reference depth is given as the 3rd argument) and integrated
+ !! throughout the density bins, then zonally averaged with
+ !! eventual masking for oceanic basins.
+ !! In the present version the masking corresponds to the global
+ !! configuration. MOC for Global, Atlantic, Indo-Pacific, Indian,Pacific ocean
+ !! Results are saved on mocsig.nc file with variables name respectively
+ !! zomsfglo, zomsfatl, zomsfinp, zomsfind, zomsfpac.
+ !! If no new_maskglo.nc file found, then the mask.nc file is used and
+ !! only zomsfglo is computed.
+
!!
- !! history :
- !! Original : J.M. Molines (jul. 2005)
- !! moc in density : A.M. Treguier ( Nov. 2005)
- !! choice of reference depth, improvements: C. Dufour (March 2010)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2005 : A.M. Treguier : Original code from cdfmoc
+ !! : 03/2010 : C. Dufour : Choice of depth reference
+ !! improvements
+ !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ USE modutils
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- ! FOR sigma 1 as the density coordinate
- CHARACTER(LEN=256) :: cdref !: depth reference for density read in argument
- REAL(KIND=4) :: pref=0. !: depth reference for density used in the code
- INTEGER :: jpbin !: density bins
- REAL(KIND=4) :: s1min, s1scal !: reference for density
-
- INTEGER :: jpbasins
- INTEGER :: jbasin, jj, jk ,ji, jkk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc, iarg !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout, np
- INTEGER :: numout=10
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout !
- INTEGER, DIMENSION(2) :: iloc
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, gphiv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zt, zs, zv, zveiv, e3v !: metrics, velocity
- INTEGER, DIMENSION (:,:), ALLOCATABLE :: ibin !: integer value corresponding to the density for binning
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zttmp,zstmp, zmask2d !: arrays to call sigmai and mask it
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw !: deptw
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: sigma !: density coordinate
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zread !: jpi,1,jpk
- REAL(KIND=4), DIMENSION (1) :: tim
-
- REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zdens !: density
- REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zomsftmp !: temporary transport array
- REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: zomsf !: jpbasins x npjglo x npk
-
- CHARACTER(LEN=256) :: cfilev , cfilet, cfileoutnc='mocsig.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cbasinmask='new_maskglo.nc'
- CHARACTER(LEN=255) :: cglobal !: Global attribute to trace the building command.
- TYPE(variable) ,DIMENSION(:), ALLOCATABLE :: typvar
- LOGICAL :: llglo = .false. !: indicator for presence of new_maskglo.nc file
-
- REAL (KIND=4) :: ztrans
-
- INTEGER :: istatus
- LOGICAL :: lprint = .false.
- LOGICAL :: leiv = .false.
-
- ! constants
- lprint = .false.
- !! Read command line and output usage message if not compliant.
+ INTEGER(KIND=2), DIMENSION (:,:,:), ALLOCATABLE :: ibmask ! nbasins x npiglo x npjglo
+ INTEGER(KIND=2), DIMENSION (:,:), ALLOCATABLE :: itmask ! tmask from salinity field
+
+ INTEGER(KIND=4) :: jbasin, jj, jk ! dummy loop index
+ INTEGER(KIND=4) :: ji, jt, jbin ! dummy loop index
+ INTEGER(KIND=4) :: nbins ! number of density bins
+ INTEGER(KIND=4) :: npglo, npatl, npinp ! basins index (mnemonics)
+ INTEGER(KIND=4) :: npind, nppac ! " "
+ INTEGER(KIND=4) :: nbasins ! number of basins
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc, iarg ! command line browsing
+ INTEGER(KIND=4) :: ijarg, ii ! " "
+ INTEGER(KIND=4) :: npiglo,npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(2) :: iloc ! working array
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! output variable levels and id
+ INTEGER(KIND=4), DIMENSION (:,:), ALLOCATABLE :: ibin ! remaping density in bin number
+
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, gphiv ! horizontal metrics, latitude
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zt, zs ! temperature, salinity
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zv, zveiv ! velocity and bolus velocity
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e3v ! vertical metrics
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: rdumlon ! dummy longitude = 0.
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: rdumlat ! latitude for i = north pole
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zttmp ! arrays to call sigmai and mask it
+ REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: sigma ! density coordinate
+ REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: e31d ! vertical level (full step)
+ REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4) :: pref=0. ! depth reference for pot. density
+ REAL(KIND=4) :: sigmin ! minimum density for bining
+ REAL(KIND=4) :: sigstp ! density step for bining
+
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dmoc ! nbasins x npjglo x npk
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dens ! density
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmoc_tmp ! temporary transport array
+
+ CHARACTER(LEN=256) :: cf_vfil ! meridional velocity file
+ CHARACTER(LEN=256) :: cf_tfil ! temperature/salinity file
+ CHARACTER(LEN=256) :: cf_moc='mocsig.nc' ! output file
+ CHARACTER(LEN=255) :: cglobal ! Global attribute
+ CHARACTER(LEN=256) :: cldum ! dummy char variable
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! output var properties
+
+ LOGICAL, DIMENSION(3) :: lbin ! flag for bin specifications
+ LOGICAL :: lbas = .FALSE. ! flag for basins file
+ LOGICAL :: lprint = .FALSE. ! flag for extra print
+ LOGICAL :: leiv = .FALSE. ! flag for Eddy Induced Velocity (GM)
+ LOGICAL :: lfull = .FALSE. ! flag for full step
+ LOGICAL :: lchk = .FALSE. ! flag for missing file
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmocsig V_file T_file depth_ref [-eiv]'
- PRINT *,' Computes the MOC for oceanic basins as described in new_maskglo.nc'
- PRINT *,' Last arguments is the reference depth for potential density, in m'
- PRINT *,' actually only 0 1000 or 2000 are allowed'
- PRINT *,' Option -eiv : takes into account VEIV Meridional eddy induced velocity'
- PRINT *,' -> To be used only if Gent and McWilliams parameterization has been used '
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,new_maskglo.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on mocsig.nc: '
- PRINT *,' variables zomsfglo : Global ocean '
- PRINT *,' variables zomsfatl : Atlantic Ocean '
- PRINT *,' variables zomsfinp : Indo Pacific '
- PRINT *,' variables zomsfind : Indian Ocean alone'
- PRINT *,' variables zomsfpac : Pacific Ocean alone'
- PRINT *,' If new_maskglo.nc is not present mask file is used and only zomsfglo is'
- PRINT *,' produced'
+ PRINT *,' usage : cdfmocsig V_file T_file depth_ref [-eiv] [-full] ... '
+ PRINT *,' ... [-sigmin sigmin] [-sigstp sigstp] [-nbins nbins] [-v] '
+ PRINT *,' PURPOSE : '
+ PRINT *,' Computes the MOC in density-latitude coordinates. The global value'
+ PRINT *,' is always computed. Values for oceanic sub-basins are calculated'
+ PRINT *,' if the file ', TRIM(cn_fbasins), ' is provided.'
+ PRINT *,' Last arguments is the reference depth for potential density, in m.'
+ PRINT *,' Actually only 0 1000 or 2000 are available with standard values for'
+ PRINT *,' density bins. If you specify another reference depth, you must also'
+ PRINT *,' specify the minimum density, the bin size and the number of bins,'
+ PRINT *,' with the options -sigmin, -sigstp, -nbins'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' V_file : Netcdf gridV file'
+ PRINT *,' T_file : Netcdf gridT file'
+ PRINT *,' depth_ref : reference depth for density '
+ PRINT *,' for depth values of 0 1000 or 2000, pre-defined limits for'
+ PRINT *,' minimum density, number of density bins and width of density'
+ PRINT *,' bins are provided. For other reference depth, you must use'
+ PRINT *,' -sigmin, -sigstp and -nbins options (see below).'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-eiv ] : takes into account VEIV Meridional eddy induced velocity'
+ PRINT *,' -> To be used only if Gent and McWilliams parameterization '
+ PRINT *,' has been used '
+ PRINT *,' [ -full ] : Works with full step instead of standard partial steps'
+ PRINT *,' [ -sigmin ] : Specify minimum of density for bining'
+ PRINT *,' [ -sigstp ] : Specify density step for bining'
+ PRINT *,' [ -nbins ] : Specify the number of density bins you want'
+ PRINT *,' [ -v ] : Verbose option for more info during execution'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' Files ', TRIM(cn_fzgr),', ',TRIM(cn_fhgr),', ', TRIM(cn_fmsk)
+ PRINT *,' File ', TRIM(cn_fbasins),' is optional [sub basins masks]'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_moc)
+ PRINT *,' variables ',TRIM( cn_zomsfglo),' : Global ocean '
+ PRINT *,' variables ',TRIM( cn_zomsfatl),' : Atlantic Ocean '
+ PRINT *,' variables ',TRIM( cn_zomsfinp),' : Indo Pacific '
+ PRINT *,' variables ',TRIM( cn_zomsfind),' : Indian Ocean alone'
+ PRINT *,' variables ',TRIM( cn_zomsfpac),' : Pacific Ocean alone'
+ PRINT *,' If file ',TRIM(cn_fbasins),' is not present, ',TRIM(cn_fmsk),' file'
+ PRINT *,' is used and only ',TRIM( cn_zomsfglo),' is produced.'
STOP
ENDIF
- !! density coordinate is sigma1.
- !! bins are by 0.1 from 24 to 32.6 = 87 bins
-
- CALL getarg (1, cfilev)
- CALL getarg (2, cfilet)
- CALL getarg (3, cdref)
- READ(cdref,*) pref
- IF (narg > 3 ) THEN
- iarg=4
- leiv=.TRUE.
- ENDIF
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
+ cglobal = 'Partial step computation'
+ lbin=(/.TRUE.,.TRUE.,.TRUE./)
+ ijarg = 1 ; ii = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg (ijarg, cldum) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
+ CASE ('-full')
+ lfull = .TRUE.
+ cglobal = 'Full step computation'
+ CASE ('-eiv')
+ leiv = .TRUE.
+ CASE ('-sigmin')
+ CALL getarg (ijarg, cldum) ; ijarg=ijarg+1 ; READ(cldum,*) sigmin
+ lbin(1) = .FALSE.
+ CASE ('-nbins')
+ CALL getarg (ijarg, cldum) ; ijarg=ijarg+1 ; READ(cldum,*) nbins
+ lbin(2) = .FALSE.
+ CASE ('-sigstp')
+ CALL getarg (ijarg, cldum) ; ijarg=ijarg+1 ; READ(cldum,*) sigstp
+ lbin(3) = .FALSE.
+ CASE ('-v')
+ lprint = .TRUE.
+ CASE DEFAULT
+ ii=ii+1
+ SELECT CASE (ii)
+ CASE ( 1 ) ; cf_vfil = cldum
+ CASE ( 2 ) ; cf_tfil = cldum
+ CASE ( 3 ) ; READ(cldum,*) pref
+ CASE DEFAULT
+ STOP 'ERROR : Too many arguments ...'
+ END SELECT
+ END SELECT
+ END DO
+
+ ! check file existence
+ lchk = lchk .OR. chkfile ( cn_fhgr )
+ lchk = lchk .OR. chkfile ( cn_fzgr )
+ lchk = lchk .OR. chkfile ( cn_fmsk )
+ lchk = lchk .OR. chkfile ( cf_vfil )
+ lchk = lchk .OR. chkfile ( cf_tfil )
+ IF ( lchk ) STOP ! missing file(s)
+
+ ! re-use lchk for binning control : TRUE if no particular binning specified
+ lchk = lbin(1) .OR. lbin(2) .OR. lbin(3)
+
+ npiglo = getdim (cf_vfil,cn_x)
+ npjglo = getdim (cf_vfil,cn_y)
+ npk = getdim (cf_vfil,cn_z)
+ npt = getdim (cf_vfil,cn_t)
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
!setting up the building command in global attribute
- WRITE(cglobal,'(a,1x,a,1x,a,1x,a) ') 'cdfmocsig', TRIM(cfilev), TRIM(cfilet), TRIM(cdref)
- ! Detects newmaskglo file
- INQUIRE( FILE='new_maskglo.nc', EXIST=llglo )
- IF (llglo) THEN
- jpbasins = 5
+ CALL SetGlobalAtt(cglobal, 'A') ! append command name to global attribute
+
+ ! Detects newmaskglo file
+ lbas = .NOT. chkfile (cn_fbasins )
+
+ IF (lbas) THEN
+ nbasins = 5
ELSE
- jpbasins = 1
+ nbasins = 1
ENDIF
- ALLOCATE ( typvar(jpbasins), ipk(jpbasins), id_varout(jpbasins) )
-
- ! Define density parameters
- IF ( pref==0 ) THEN
- IF (lprint) PRINT *, ' to be implemented soon... '
- jpbin = 52
- s1min = 23
- s1scal=0.1
- ELSE IF ( pref==1000 ) THEN
- jpbin = 88
- s1min = 24
- s1scal=0.1
- ELSE IF ( pref==2000 ) THEN
- jpbin = 158
- s1min = 30
- s1scal=0.05
- ELSE
- IF (lprint) PRINT *, ' this value of depth_ref is not yet implemented '
+ ALLOCATE ( stypvar(nbasins), ipk(nbasins), id_varout(nbasins) )
+
+ IF ( lchk ) THEN ! use default bins definition according to pref
+ ! Define density parameters
+ SELECT CASE ( INT(pref) )
+ CASE ( 0 )
+ nbins = 52
+ sigmin = 23.
+ sigstp = 0.1
+ CASE ( 1000 )
+ nbins = 88
+ sigmin = 24.
+ sigstp = 0.1
+ CASE ( 2000)
+ nbins = 158
+ sigmin = 30.
+ sigstp = 0.05
+ CASE DEFAULT
+ PRINT *,' This value of depth_ref (',pref,') is not implemented as standard'
+ PRINT *,' You must use the -sigmin, -sigstp and -nbins options to precise'
+ PRINT *,' the density bining you want to use.'
+ STOP
+ END SELECT
ENDIF
+ PRINT '(a,f6.1,a)', ' For reference depth ', pref, ' m, '
+ PRINT '(a,f5.2,a,f5.2,a,i3)', ' You are using -sigmin ', sigmin,' -sigstp ', sigstp,' -nbins ', nbins
- ALLOCATE ( sigma(jpbin) )
+ ALLOCATE ( sigma(nbins) )
! define densities at middle of bins
- DO ji=1,jpbin
- sigma(ji) = s1min +(ji-0.5)*s1scal
+ DO ji=1,nbins
+ sigma(ji) = sigmin +(ji-0.5)*sigstp
ENDDO
- IF (lprint) print *, ' min density:',sigma(1), ' max density:', sigma(jpbin)
- ! define new variables for output ( must update att.txt)
-
- typvar(1)%name= 'zomsfglo'
- typvar%units='Sverdrup'
- typvar%missing_value=99999.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar%scale_factor= 1.
- typvar%add_offset= 0.
- typvar%savelog10= 0.
- typvar(1)%long_name='Meridional_Overt.Cell_Global'
- typvar(1)%short_name='zomsfglo'
- typvar%online_operation='N/A'
- typvar%axis='TZY'
-
- ipk(1) = npk ! 2D
-
- IF (llglo) THEN
- typvar(2)%name= 'zomsfatl'
- typvar(2)%long_name='Meridional_Overt.Cell_Atlantic'
- typvar(2)%short_name='zomsfatl'
-
- typvar(3)%name= 'zomsfinp'
- typvar(3)%long_name='Meridional_Overt.Cell_IndoPacif'
- typvar(3)%short_name='zomsfinp'
-
- typvar(4)%name= 'zomsfind'
- typvar(4)%long_name='Meridional_Overt.Cell_Indian'
- typvar(4)%short_name='zomsfind'
-
- typvar(5)%name= 'zomsfpac'
- typvar(5)%long_name='Meridional_Overt.Cell_pacif'
- typvar(5)%short_name='zomspac'
-
- ipk(2) = npk ! 2D
- ipk(3) = npk ! 2D
- ipk(4) = npk ! 2D
- ipk(5) = npk ! 2D
+ IF (lprint) PRINT *, ' min density:',sigma(1), ' max density:', sigma(nbins)
+
+ !global ; Atlantic ; Indo-Pacif ; Indian ; Pacif
+ npglo= 1 ; npatl=2 ; npinp=3 ; npind=4 ; nppac=5
+
+ ! Common to all variables :
+ stypvar%cunits = 'Sverdrup'
+ stypvar%rmissing_value = 99999.
+ stypvar%valid_min = -1000.
+ stypvar%valid_max = 1000.
+ stypvar%scale_factor = 1.
+ stypvar%add_offset = 0.
+ stypvar%savelog10 = 0.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TZY'
+
+ ipk(:) = npk
+
+ ! Global basin
+ stypvar(npglo)%cname = cn_zomsfglo
+ stypvar(npglo)%clong_name = 'Meridional_Overt.Cell_Global'
+ stypvar(npglo)%cshort_name = cn_zomsfglo
+
+ IF (lbas) THEN
+ stypvar(npatl)%cname = cn_zomsfatl
+ stypvar(npatl)%clong_name = 'Meridional_Overt.Cell_Atlantic'
+ stypvar(npatl)%cshort_name = cn_zomsfatl
+
+ stypvar(npinp)%cname = cn_zomsfinp
+ stypvar(npinp)%clong_name = 'Meridional_Overt.Cell_IndoPacif'
+ stypvar(npinp)%cshort_name = cn_zomsfinp
+
+ stypvar(npind)%cname = cn_zomsfind
+ stypvar(npind)%clong_name = 'Meridional_Overt.Cell_Indian'
+ stypvar(npind)%cshort_name = cn_zomsfind
+
+ stypvar(nppac)%cname = cn_zomsfpac
+ stypvar(nppac)%clong_name = 'Meridional_Overt.Cell_pacif'
+ stypvar(nppac)%cshort_name = cn_zomsfpac
ENDIF
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
! Allocate arrays
- ALLOCATE ( zmask(jpbasins,npiglo,npjglo) )
+ ALLOCATE ( ibmask(nbasins,npiglo,npjglo) )
ALLOCATE ( zv (npiglo,npjglo), zt(npiglo,npjglo), zs(npiglo,npjglo))
- IF ( leiv ) THEN
- ALLOCATE ( zveiv (npiglo,npjglo))
- END IF
ALLOCATE ( e3v(npiglo,npjglo) )
ALLOCATE ( ibin(npiglo, npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo), gphiv(npiglo,npjglo) ,gdepw(npk) )
- ALLOCATE ( zomsf(jpbasins, npjglo, jpbin) )
- ALLOCATE ( zomsftmp(jpbin,npiglo) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
- ALLOCATE ( zdens(npiglo,npjglo))
- ALLOCATE ( zmask2d(npiglo,npjglo), zttmp(npiglo,npjglo))
+ ALLOCATE ( e1v(npiglo,npjglo), gphiv(npiglo,npjglo) )
+ ALLOCATE ( dmoc(nbasins, npjglo, nbins) )
+ ALLOCATE ( dmoc_tmp(nbins,npiglo) )
+ ALLOCATE ( rdumlon(1,npjglo) , rdumlat(1,npjglo))
+ ALLOCATE ( dens(npiglo,npjglo))
+ ALLOCATE ( itmask(npiglo,npjglo), zttmp(npiglo,npjglo))
+ ALLOCATE ( tim(npt), e31d(npk) )
+ IF ( leiv ) THEN
+ ALLOCATE ( zveiv (npiglo,npjglo))
+ END IF
+
+ e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo)
+ gphiv(:,:) = getvar(cn_fhgr, cn_gphiv, 1, npiglo, npjglo)
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
- gdepw(:) = -1.* gdepw(:)
+ IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk)
- iloc=maxloc(gphiv)
- dumlat(1,:) = gphiv(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
+ iloc = MAXLOC(gphiv)
+ rdumlat(1,:) = gphiv(iloc(1),:)
+ rdumlon(:,:) = 0. ! set the dummy longitude to 0
! create output fileset
- IF (lprint) PRINT *, ' ready to create file:',trim( cfileoutnc), ' from reference:',trim(cfilev )
- ncout =create(cfileoutnc, cfilev, 1,npjglo,jpbin,cdep='sigma')
- IF (lprint) PRINT *, ' ready to create variables:'
- ierr= createvar(ncout ,typvar ,jpbasins, ipk ,id_varout ,cdglobal=cglobal)
- IF (lprint) PRINT *, ' writing variables headers:'
- ierr= putheadervar(ncout, cfilev,1, npjglo,jpbin,pnavlon=dumlon,pnavlat=dumlat,pdep=sigma)
- IF (lprint) PRINT *, ' writing time_counter:'
- tim=getvar1d(cfilev,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
+! ncout = create (cf_moc, cf_vfil, 1, npjglo, nbins, cdep='sigma')
+ ncout = create (cf_moc, 'none', 1, npjglo, nbins, cdep='sigma')
+ ierr = createvar (ncout, stypvar, nbasins, ipk ,id_varout, cdglobal=cglobal)
+ ierr = putheadervar(ncout, cf_vfil, 1, npjglo, nbins, pnavlon=rdumlon, pnavlat=rdumlat, pdep=sigma)
+ tim = getvar1d(cf_vfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
! reading the masks
- ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif
- zmask(1,:,:)=getvar('mask.nc','vmask',1,npiglo,npjglo)
- ! zmask(1,:,:)= 1.
- IF ( llglo ) THEN
- zmask(2,:,:)=getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- zmask(4,:,:)=getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
- zmask(5,:,:)=getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- zmask(3,:,:)=zmask(5,:,:)+zmask(4,:,:)
+ ibmask(npglo,:,:) = getvar(cn_fmsk, 'vmask', 1, npiglo, npjglo)
+
+ IF ( lbas ) THEN
+ ibmask(npatl,:,:) = getvar(cn_fbasins, 'tmaskatl', 1, npiglo, npjglo)
+ ibmask(npind,:,:) = getvar(cn_fbasins, 'tmaskind', 1, npiglo, npjglo)
+ ibmask(nppac,:,:) = getvar(cn_fbasins, 'tmaskpac', 1, npiglo, npjglo)
+ ibmask(npinp,:,:) = ibmask(nppac,:,:) + ibmask(npind,:,:)
! ensure that there are no overlapping on the masks
- WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1
+ WHERE(ibmask(npinp,:,:) > 0 ) ibmask(npinp,:,:) = 1
! change global mask for GLOBAL periodic condition
- zmask(1,1,:) = 0.
- zmask(1,npiglo,:) = 0.
+ ibmask(1,1, :) = 0.
+ ibmask(1,npiglo,:) = 0.
ENDIF
- ! initialize moc to 0
- zomsf(:,:,:) = 0.
-
- DO jk = 1,npk-1
- ! for testing purposes only loop from 2 to 400
- IF (lprint) PRINT *,' working at depth ',jk
- ! Get velocities v at jj
- zv(:,:)= getvar(cfilev, 'vomecrty', jk,npiglo,npjglo)
- IF ( leiv ) THEN
- zveiv(:,:)= getvar(cfilev, 'vomeeivv', jk,npiglo,npjglo)
- END IF
- zt(:,:)= getvar(cfilet, 'votemper', jk,npiglo,npjglo)
- zs(:,:)= getvar(cfilet, 'vosaline', jk,npiglo,npjglo)
- ! get e3v at latitude jj
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- !
- ! finds density
- !
- zmask2d = 1
- WHERE(zt ==0) zmask2d = 0
- zdens = sigmai(zt,zs,pref,npiglo,npjglo)
- zttmp= zdens* zmask2d !: convert to single precision
- ibin(:,:) = ifix( (zttmp-s1min)/s1scal )
- ibin(:,:) = max( ibin(:,:) ,1)
- ibin(:,:) = min(ibin(:,:),jpbin)
- DO jj=2,npjglo-1
- zomsftmp = 0
- ! converts transport in "k" to transport in "sigma"
- ! indirect adresssing - do it once and not for each basin!
- DO ji=2,npiglo-1
- IF ( leiv ) THEN
- ztrans = e1v(ji,jj)*e3v(ji,jj)*(zv(ji,jj)+zveiv(ji,jj))
- ELSE
- ztrans = e1v(ji,jj)*e3v(ji,jj)*zv(ji,jj)
- END IF
- zomsftmp(ibin(ji,jj),ji)=zomsftmp(ibin(ji,jj),ji) - ztrans
- END DO
- ! integrates 'zonally' (along i-coordinate)
- ! add to zomsf the contributions from level jk at all densities jkk
- DO jkk =1,jpbin
+ DO jt=1, npt
+ ! initialize moc to 0
+ dmoc(:,:,:) = 0.d0
+
+ DO jk=1,npk-1
+ ! for testing purposes only loop from 2 to 400
+ IF (lprint) PRINT *,' working at depth ',jk
+ ! Get velocities v at jj
+ zv(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo)
+ IF ( leiv ) THEN
+ zveiv(:,:) = getvar(cf_vfil, cn_vomeeivv, jk, npiglo,npjglo)
+ zv(:,:) = zv(:,:) + zveiv(:,:)
+ END IF
+ zt(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo)
+ zs(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo)
+
+ ! get e3v at latitude jj
+ IF ( lfull ) THEN
+ e3v(:,:) = e31d(jk)
+ ELSE
+ e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+ !
+ ! finds density
+ itmask = 1
+ WHERE ( zs == 0 ) itmask = 0
+ dens = sigmai(zt, zs, pref, npiglo, npjglo)
+ zttmp = dens* itmask ! convert to single precision
+ ! find bin numbers
+ ibin(:,:) = INT( (zttmp-sigmin)/sigstp )
+ ibin(:,:) = MAX( ibin(:,:), 1 )
+ ibin(:,:) = MIN( ibin(:,:), nbins)
+
+ DO jj=2,npjglo-1
+ dmoc_tmp = 0
+ ! converts transport in "k" to transport in "sigma"
+ ! indirect adresssing - do it once and not for each basin!
DO ji=2,npiglo-1
- DO jbasin= 1, jpbasins
- ! For all basins
- ztrans = zomsftmp(jkk,ji) * zmask(jbasin,ji,jj)
- zomsf(jbasin,jj,jkk)=zomsf(jbasin,jj,jkk ) + ztrans
- ENDDO
+ dmoc_tmp(ibin(ji,jj),ji)=dmoc_tmp(ibin(ji,jj),ji) - e1v(ji,jj)*e3v(ji,jj)*zv(ji,jj)
+ END DO
+ ! integrates 'zonally' (along i-coordinate)
+ ! add to dmoc the contributions from level jk at all densities jbin
+ DO jbin =1,nbins
+ DO ji=2,npiglo-1
+ DO jbasin= 1, nbasins
+ ! For all basins
+ dmoc(jbasin,jj,jbin)=dmoc(jbasin,jj,jbin ) + dmoc_tmp(jbin,ji) * ibmask(jbasin,ji,jj)
+ ENDDO
+ END DO
END DO
+ ! end of loop on latitude for filling dmoc
END DO
- ! end of loop on latitude for filling zomsf
+ ! end of loop on depths for calculating transports
END DO
- ! end of loop on depths for calculating transports
- END DO
- ! integrates vertically from bottom to surface
- zomsf(:,:,jpbin) = zomsf(:,:,jpbin)/1.e6
- DO jk=jpbin-1,1,-1
- zomsf(:,:,jk) = zomsf(:,:,jk+1) + zomsf(:,:,jk)/1.e6
- END DO ! loop to next level
+ ! integrates across bins from highest to lowest density
+ dmoc(:,:,nbins) = dmoc(:,:,nbins)/1.e6
+ DO jk=nbins-1, 1, -1
+ dmoc(:,:,jk) = dmoc(:,:,jk+1) + dmoc(:,:,jk)/1.e6
+ END DO ! loop to next bin
- ! netcdf output
- DO jbasin= 1, jpbasins
- DO jk =1, jpbin
- ierr = putvar (ncout, id_varout(jbasin),REAL(zomsf(jbasin,:,jk)), jk,1,npjglo)
+ ! netcdf output
+ DO jbasin = 1, nbasins
+ DO jk = 1, nbins
+ ierr = putvar (ncout, id_varout(jbasin), REAL(dmoc(jbasin,:,jk)), jk, 1, npjglo)
+ END DO
END DO
- END DO
+
+ ENDDO ! time loop
ierr = closeout(ncout)
diff --git a/cdfmoy.f90 b/cdfmoy.f90
index efd0b22..80d165f 100644
--- a/cdfmoy.f90
+++ b/cdfmoy.f90
@@ -1,80 +1,189 @@
PROGRAM cdfmoy
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfmoy ***
+ !!======================================================================
+ !! *** PROGRAM cdfmoy ***
+ !!=====================================================================
+ !! ** Purpose : Compute mean values for all the variables in a bunch
+ !! of cdf files given as argument
+ !! Store the results on a 'similar' cdf file.
!!
- !! ** Purpose: Compute mean values for all the variables in a bunch
- !! of cdf files given as argument
- !! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: Try to avoid 3 d arrays
- !!
- !! history :
- !! Original code : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (Apr 2005 ) put all NCF stuff in module
- !! now valid for grid T U V W icemod
- !! Modified : P. Mathiot (June 2007) update for forcing fields
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
+ !! ** Method : Also store the mean squared values for the nn_sqdvar
+ !! variables belonging to cn_sqdvar(:), than can be changed
+ !! in the nam_cdf_names namelist if wished.
+ !! Optionally order 3 moments for some variables can be
+ !! computed.
!!
+ !! History : 2.0 : 11/2004 : J.M. Molines : Original code
+ !! : 2.1 : 06/2007 : P. Mathiot : Modif for forcing fields
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! varchk2 : check if variable is candidate for square mean
+ !! varchk3 : check if variable is candidate for cubic mean
+ !! zeromean : substract mean value from input field
+ !!----------------------------------------------------------------------
USE cdfio
-
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!-----------------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv , jtt,jkk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER :: ntframe !: Cumul of time frame
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout,&
- & id_varout2
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: tab, tab2 !: Arrays for cumulated values
- REAL(KIND=8) :: total_time
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean, rmean2
- REAL(KIND=4),DIMENSION(1) :: timean
- REAL(KIND=4),DIMENSION(365) :: tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout, cfileout2 !: file name
- CHARACTER(LEN=256) :: cdep
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname2 !: array of var22 name for output
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar, typvar2
- INTEGER :: ncout, ncout2
- INTEGER :: istatus
- LOGICAL :: lcaltmean
+ INTEGER(KIND=4) :: jk, jfil ! dummy loop index
+ INTEGER(KIND=4) :: jvar, jv, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! browsing command line
+ INTEGER(KIND=4) :: nfil ! number of files to average
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvars ! number of variables in a file
+ INTEGER(KIND=4) :: ntframe ! cumul of time frame
+ INTEGER(KIND=4) :: ncout ! ncid of output files
+ INTEGER(KIND=4) :: ncout2 ! ncid of output files
+ INTEGER(KIND=4) :: ncout3 ! ncid of output files
+ INTEGER(KIND=4) :: nperio=4 ! ncid of output files
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of vertical level for each var
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! varid's of average vars
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout2 ! varid's of sqd average vars
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout3 ! varid's of cub average vars
- !!
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! array to read a layer of data
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rmean ! average
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rmean2 ! squared average
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rmean3 ! cubic average
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zspval_in ! time counter
+ REAL(KIND=4), DIMENSION(1) :: timean ! mean time
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtab, dtab2 ! arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtab3 ! arrays for cumulated values
+ REAL(KIND=8) :: dtotal_time ! to compute mean time
+
+ CHARACTER(LEN=256) :: cf_in ! input file names
+ CHARACTER(LEN=256) :: cf_out = 'cdfmoy.nc' ! output file for average
+ CHARACTER(LEN=256) :: cf_out2 = 'cdfmoy2.nc' ! output file for squared average
+ CHARACTER(LEN=256) :: cf_out3 = 'cdfmoy3.nc' ! output file for squared average
+ CHARACTER(LEN=256) :: cv_dep ! depth dimension name
+ CHARACTER(LEN=256) :: cldum ! dummy string argument
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cf_list ! list of input files
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nam ! array of var name
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nam2 ! array of var2 name for output
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nam3 ! array of var3 name for output
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! attributes for average values
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar2 ! attributes for square averaged values
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar3 ! attributes for cubic averaged values
+
+ LOGICAL :: lcaltmean ! mean time computation flag
+ LOGICAL :: lspval0 = .false. ! cdfmoy_chsp flag
+ LOGICAL :: lcubic = .false. ! 3rd momment computation
+ LOGICAL :: lzermean = .false. ! flag for zero-mean process
+ LOGICAL :: lchk = .false. ! flag for missing files
+ !!----------------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoy ''list_of_ioipsl_model_output_files'' '
+ PRINT *,' usage : cdfmoy list_of_model_files [-spval0] [-cub ] [-zeromean]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the time average of a list of files given as arguments.'
+ PRINT *,' The program assume that all files in the list are of same'
+ PRINT *,' type (shape, variables etc...). '
+ PRINT *,' For some variables, the program also compute the time average '
+ PRINT *,' of the squared variables, which is used in other cdftools '
+ PRINT *,' (cdfeke, cdfrmsssh, cdfstdevw, cdfstddevts ... The actual variables'
+ PRINT *,' selected for squared average are :'
+ PRINT '(10x,"- ",a)' , (TRIM(cn_sqdvar(jv)), jv=1, nn_sqdvar)
+ PRINT *,' This selection can be adapted with the nam_cdf_namelist process.'
+ PRINT *,' (See cdfnamelist -i for details).'
+ PRINT *,' If you want to compute the average of already averaged files,'
+ PRINT *,' consider using cdfmoy_weighted instead, in order to take into'
+ PRINT *,' account a particular weight for each file in the list.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' A list of similar model output files. '
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ -spval0 ] : set missing_value attribute to 0 for all output'
+ PRINT *,' variables and take care of the input missing_value.'
+ PRINT *,' This option is usefull if missing_values differ from files '
+ PRINT *,' to files; it was formely done by cdfmoy_chsp).'
+ PRINT *,' [ -cub ] : use this option if you want to compute third order moment'
+ PRINT *,' for the eligible variables, which are at present :'
+ PRINT '(15x,"- ",a)' , (TRIM(cn_cubvar(jv)), jv=1, nn_cubvar)
+ PRINT *,' This selection can be adapted with the nam_cdf_namelist process.'
+ PRINT *,' (See cdfnamelist -i for details).'
+ PRINT *,' [ -zeromean ] : with this option, the spatial mean value for each '
+ PRINT *,' time frame is substracted from the original field previous '
+ PRINT *,' averaging, square averaging and eventually cubic averaging'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' If -zeromean option is used, need ', TRIM(cn_fhgr),' and ',TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out),' and ',TRIM(cf_out2)
+ PRINT *,' variables : are the same than in the input files. For squared averages'
+ PRINT *,' _sqd is append to the original variable name.'
+ PRINT *,' IF -cub option is used, the file ', TRIM(cf_out3),' is also created'
+ PRINT *,' with _cub append to the original variable name.'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfmoy_weighted, cdfstdev'
+ PRINT *,' '
STOP
ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
-
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- npk = getdim (cfile,'nav_lev',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- npk = getdim (cfile,'levels',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
+
+
+ ALLOCATE ( cf_list(narg) )
+ ! look for -spval0 option and set up cf_list, nfil
+ ijarg = 1
+ nfil = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-spval0' ) ! option to reset spval to 0 in the output files
+ lspval0 = .true.
+ CASE ( '-cub' ) ! option to reset spval to 0 in the output files
+ lcubic = .true.
+ CASE ( '-zeromean' ) ! option to reset spval to 0 in the output files
+ lzermean = .true.
+ CASE DEFAULT ! then the argument is a file
+ nfil = nfil + 1
+ cf_list(nfil) = TRIM(cldum)
+ END SELECT
+ END DO
+
+ IF ( lzermean ) THEN
+ lchk = lchk .OR. chkfile ( cn_fhgr )
+ lchk = lchk .OR. chkfile ( cn_fmsk )
+ IF ( lchk ) STOP ! missing files
+ ENDIF
+
+ ! Initialisation from 1rst file (all file are assume to have the same geometry)
+ ! time counter can be different for each file in the list. It is read in the
+ ! loop for files
+
+ cf_in = cf_list(1)
+ IF ( chkfile (cf_in) ) STOP ! missing file
+
+ npiglo = getdim (cf_in, cn_x)
+ npjglo = getdim (cf_in, cn_y)
+ npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr)
+
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in, 'z',cdtrue=cv_dep,kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in,'nav_lev',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in,'levels',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
PRINT *,' assume file with no depth'
npk=0
ENDIF
@@ -82,116 +191,280 @@ PROGRAM cdfmoy
ENDIF
ENDIF
ENDIF
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
- ALLOCATE( tab(npiglo,npjglo), tab2(npiglo,npjglo), v2d(npiglo,npjglo) )
+ ALLOCATE( dtab(npiglo,npjglo), dtab2(npiglo,npjglo), v2d(npiglo,npjglo) )
ALLOCATE( rmean(npiglo,npjglo), rmean2(npiglo,npjglo) )
+ IF ( lcubic ) THEN
+ ALLOCATE( dtab3(npiglo,npjglo), rmean3(npiglo,npjglo) )
+ ENDIF
- nvars = getnvar(cfile)
- PRINT *,' nvars =', nvars
+ nvars = getnvar(cf_in)
+ PRINT *,' nvars = ', nvars
- ALLOCATE (cvarname(nvars), cvarname2(nvars) )
- ALLOCATE (typvar(nvars), typvar2(nvars) )
+ ALLOCATE (cv_nam(nvars), cv_nam2(nvars) )
+ ALLOCATE (stypvar(nvars), stypvar2(nvars) )
ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars), id_varout2(nvars) )
+ IF ( lcubic ) THEN
+ ALLOCATE (cv_nam3(nvars), stypvar3(nvars), id_varout3(nvars) )
+ ENDIF
+
+ ! get list of variable names and collect attributes in stypvar (optional)
+ cv_nam(:) = getvarname(cf_in,nvars,stypvar)
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ IF ( lspval0 ) THEN
+ ALLOCATE ( zspval_in(nvars) )
+ zspval_in(:) = stypvar(:)%rmissing_value
+ stypvar(:)%rmissing_value = 0.
+ ENDIF
+ IF ( lcubic) THEN
+ ! force votemper to be squared saved
+ nn_sqdvar = nn_sqdvar + 1
+ cn_sqdvar(nn_sqdvar) = TRIM(cn_votemper)
+ ENDIF
DO jvar = 1, nvars
! variables that will not be computed or stored are named 'none'
- IF (cvarname(jvar) /= 'vozocrtx' .AND. &
- cvarname(jvar) /= 'vomecrty' .AND. &
- cvarname(jvar) /= 'vovecrtz' .AND. &
- cvarname(jvar) /= 'sossheig' ) THEN
- cvarname2(jvar) ='none'
+ IF ( varchk2 ( cv_nam(jvar) ) ) THEN
+ cv_nam2(jvar) = TRIM(cv_nam(jvar))//'_sqd'
+ stypvar2(jvar)%cname = TRIM(stypvar(jvar)%cname)//'_sqd' ! name
+ stypvar2(jvar)%cunits = '('//TRIM(stypvar(jvar)%cunits)//')^2' ! unit
+ stypvar2(jvar)%rmissing_value = stypvar(jvar)%rmissing_value ! missing_value
+ stypvar2(jvar)%valid_min = 0. ! valid_min = zero
+ stypvar2(jvar)%valid_max = stypvar(jvar)%valid_max**2 ! valid_max *valid_max
+ stypvar2(jvar)%scale_factor = 1.
+ stypvar2(jvar)%add_offset = 0.
+ stypvar2(jvar)%savelog10 = 0.
+ stypvar2(jvar)%clong_name = TRIM(stypvar(jvar)%clong_name)//'_Squared' !
+ stypvar2(jvar)%cshort_name = TRIM(stypvar(jvar)%cshort_name)//'_sqd' !
+ stypvar2(jvar)%conline_operation = TRIM(stypvar(jvar)%conline_operation)
+ stypvar2(jvar)%caxis = TRIM(stypvar(jvar)%caxis)
ELSE
- cvarname2(jvar)=TRIM(cvarname(jvar))//'_sqd'
- typvar2(jvar)%name = TRIM(typvar(jvar)%name)//'_sqd' ! name
- typvar2(jvar)%units = '('//TRIM(typvar(jvar)%units)//')^2' ! unit
- typvar2(jvar)%missing_value = typvar(jvar)%missing_value ! missing_value
- typvar2(jvar)%valid_min = 0. ! valid_min = zero
- typvar2(jvar)%valid_max = typvar(jvar)%valid_max**2 ! valid_max *valid_max
- typvar2(jvar)%scale_factor= 1.
- typvar2(jvar)%add_offset= 0.
- typvar2(jvar)%savelog10= 0.
- typvar2(jvar)%long_name =TRIM(typvar(jvar)%long_name)//'_Squared' !
- typvar2(jvar)%short_name = TRIM(typvar(jvar)%short_name)//'_sqd' !
- typvar2(jvar)%online_operation = TRIM(typvar(jvar)%online_operation)
- typvar2(jvar)%axis = TRIM(typvar(jvar)%axis)
-
+ cv_nam2(jvar) = 'none'
END IF
+ ! check for cubic average
+ IF ( lcubic ) THEN
+ IF ( varchk3 ( cv_nam(jvar) ) ) THEN
+ cv_nam3(jvar) = TRIM(cv_nam(jvar))//'_cub'
+ stypvar3(jvar)%cname = TRIM(stypvar(jvar)%cname)//'_cub' ! name
+ stypvar3(jvar)%cunits = '('//TRIM(stypvar(jvar)%cunits)//')^3' ! unit
+ stypvar3(jvar)%rmissing_value = stypvar(jvar)%rmissing_value ! missing_value
+ stypvar3(jvar)%valid_min = 0. ! valid_min = zero
+ stypvar3(jvar)%valid_max = stypvar(jvar)%valid_max**3 ! valid_max *valid_max
+ stypvar3(jvar)%scale_factor = 1.
+ stypvar3(jvar)%add_offset = 0.
+ stypvar3(jvar)%savelog10 = 0.
+ stypvar3(jvar)%clong_name = TRIM(stypvar(jvar)%clong_name)//'_Cubed' !
+ stypvar3(jvar)%cshort_name = TRIM(stypvar(jvar)%cshort_name)//'_cub' !
+ stypvar3(jvar)%conline_operation = TRIM(stypvar(jvar)%conline_operation)
+ stypvar3(jvar)%caxis = TRIM(stypvar(jvar)%caxis)
+ ELSE
+ cv_nam3(jvar) = 'none'
+ END IF
+ ENDIF
+
+
END DO
id_var(:) = (/(jv, jv=1,nvars)/)
! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
- typvar2(:)%name=cvarname2
-
- ! create output fileset
- cfileout='cdfmoy.nc'
- cfileout2='cdfmoy2.nc'
- ! create output file taking the sizes in cfile
+ ipk(:) = getipk (cf_in,nvars,cdep=cv_dep)
+ WHERE( ipk == 0 ) cv_nam='none'
+ stypvar (:)%cname = cv_nam
+ stypvar2(:)%cname = cv_nam2
+ IF ( lcubic ) stypvar3(:)%cname = cv_nam3
- ncout =create(cfileout, cfile,npiglo,npjglo,npk,cdep=cdep)
- ncout2=create(cfileout2,cfile,npiglo,npjglo,npk,cdep=cdep)
+ ! create output file taking the sizes in cf_in
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep)
+ ierr = createvar (ncout , stypvar, nvars, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk, cdep=cv_dep)
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- ierr= createvar(ncout2, typvar2, nvars, ipk, id_varout2)
+ ncout2 = create (cf_out2, cf_in, npiglo, npjglo, npk, cdep=cv_dep)
+ ierr = createvar (ncout2, stypvar2, nvars, ipk, id_varout2 )
+ ierr = putheadervar(ncout2, cf_in, npiglo, npjglo, npk, cdep=cv_dep)
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk,cdep=cdep)
- ierr= putheadervar(ncout2, cfile, npiglo, npjglo, npk,cdep=cdep)
+ IF ( lcubic) THEN
+ ncout3 = create (cf_out3, cf_in, npiglo, npjglo, npk, cdep=cv_dep)
+ ierr = createvar (ncout3, stypvar3, nvars, ipk, id_varout3 )
+ ierr = putheadervar(ncout3, cf_in, npiglo, npjglo, npk, cdep=cv_dep)
+ ENDIF
lcaltmean=.TRUE.
DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' ) THEN
+ IF ( cv_nam(jvar) == cn_vlon2d .OR. & ! nav_lon
+ cv_nam(jvar) == cn_vlat2d ) THEN ! nav_lat
! skip these variable
ELSE
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar)
+ PRINT *,' Working with ', TRIM(cv_nam(jvar)), ipk(jvar)
DO jk = 1, ipk(jvar)
PRINT *,'level ',jk
- tab(:,:) = 0.d0 ; tab2(:,:) = 0.d0 ; total_time = 0.; ntframe=0
- DO jt = 1, narg
- CALL getarg (jt, cfile)
- nt = getdim (cfile,'time_counter')
+ dtab(:,:) = 0.d0 ; dtab2(:,:) = 0.d0 ; dtotal_time = 0.
+ IF ( lcubic ) THEN ; dtab3(:,:) = 0.d0 ; ENDIF
+ ntframe = 0
+ DO jfil = 1, nfil
+ cf_in = cf_list(jfil)
+ IF ( jk == 1 ) THEN
+ IF ( chkfile (cf_in) ) STOP ! missing file
+ ENDIF
+
+ npt = getdim (cf_in, cn_t)
IF ( lcaltmean ) THEN
- tim=getvar1d(cfile,'time_counter',nt)
- total_time = total_time + SUM(tim(1:nt) )
+ ALLOCATE ( tim(npt) )
+ tim = getvar1d(cf_in, cn_vtimec, npt)
+ dtotal_time = dtotal_time + SUM(DBLE(tim(:)))
+ DEALLOCATE (tim )
END IF
- DO jtt=1,nt
- ntframe=ntframe+1
- jkk=jk
- ! If forcing fields is without depth dimension
- IF (npk==0) jkk=jtt
- v2d(:,:)= getvar(cfile, cvarname(jvar), jkk ,npiglo, npjglo,ktime=jtt )
- tab(:,:) = tab(:,:) + v2d(:,:)
- IF (cvarname2(jvar) /= 'none' ) tab2(:,:) = tab2(:,:) + v2d(:,:)*v2d(:,:)
+ DO jt=1,npt
+ ntframe = ntframe + 1
+ v2d(:,:) = getvar(cf_in, cv_nam(jvar), jk ,npiglo, npjglo,ktime=jt )
+ IF ( lspval0 ) WHERE (v2d == zspval_in(jvar)) v2d = 0. ! change missing values to 0
+ IF ( lzermean ) CALL zeromean (jk, v2d )
+ dtab(:,:) = dtab(:,:) + v2d(:,:)*1.d0
+ IF (cv_nam2(jvar) /= 'none' ) dtab2(:,:) = dtab2(:,:) + v2d(:,:)*v2d(:,:)*1.d0
+ IF ( lcubic ) THEN
+ IF (cv_nam3(jvar) /= 'none' ) dtab3(:,:) = dtab3(:,:) + v2d(:,:)*v2d(:,:)*v2d(:,:) *1.d0
+ ENDIF
ENDDO
END DO
! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = tab(:,:)/ntframe
- IF (cvarname2(jvar) /= 'none' ) rmean2(:,:) = tab2(:,:)/ntframe
+ rmean(:,:) = dtab(:,:)/ntframe
+ IF (cv_nam2(jvar) /= 'none' ) rmean2(:,:) = dtab2(:,:)/ntframe
+ IF ( lcubic ) THEN
+ IF (cv_nam3(jvar) /= 'none' ) rmean3(:,:) = dtab3(:,:)/ntframe
+ ENDIF
+
! store variable on outputfile
- ierr = putvar(ncout, id_varout(jvar) ,rmean, jk, npiglo, npjglo, kwght=ntframe)
- IF (cvarname2(jvar) /= 'none' ) ierr = putvar(ncout2,id_varout2(jvar),rmean2, jk,npiglo, npjglo, kwght=ntframe)
+ ierr = putvar(ncout, id_varout(jvar), rmean, jk, npiglo, npjglo, kwght=ntframe)
+ IF (cv_nam2(jvar) /= 'none' ) THEN
+ ierr = putvar(ncout2, id_varout2(jvar), rmean2, jk, npiglo, npjglo, kwght=ntframe)
+ ENDIF
+
+ IF ( lcubic) THEN
+ IF (cv_nam3(jvar) /= 'none' ) THEN
+ ierr = putvar(ncout3, id_varout3(jvar), rmean3, jk, npiglo, npjglo, kwght=ntframe)
+ ENDIF
+ ENDIF
+
IF (lcaltmean ) THEN
- timean(1)= total_time/ntframe
- ierr=putvar1d(ncout,timean,1,'T')
- ierr=putvar1d(ncout2,timean,1,'T')
+ timean(1) = dtotal_time/ntframe
+ ierr = putvar1d(ncout, timean, 1, 'T')
+ ierr = putvar1d(ncout2, timean, 1, 'T')
+ IF (lcubic) ierr = putvar1d(ncout3, timean, 1, 'T')
END IF
+
lcaltmean=.FALSE. ! tmean already computed
END DO ! loop to next level
END IF
END DO ! loop to next var in file
- istatus = closeout(ncout)
- istatus = closeout(ncout2)
+ ierr = closeout(ncout)
+ ierr = closeout(ncout2)
+ IF ( lcubic ) ierr = closeout(ncout3 )
+
+CONTAINS
+
+ LOGICAL FUNCTION varchk2 ( cd_var )
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION varchk2 ***
+ !!
+ !! ** Purpose : Return true if cd_var is candidate for mean squared value
+ !!
+ !! ** Method : List of candidate is established in modcdfnames, and
+ !! can be changed via the nam_cdf_names namelist
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cd_var
+
+ INTEGER(KIND=4) :: jv
+ !!----------------------------------------------------------------------
+ varchk2 = .FALSE.
+ DO jv = 1, nn_sqdvar
+ IF ( cd_var == cn_sqdvar(jv) ) THEN
+ varchk2 = .TRUE.
+ exit
+ ENDIF
+ ENDDO
+
+ END FUNCTION varchk2
+
+ LOGICAL FUNCTION varchk3 ( cd_var )
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION varchk3 ***
+ !!
+ !! ** Purpose : Return true if cd_var is candidate for cubic mean average
+ !!
+ !! ** Method : List of candidate is established in modcdfnames, and
+ !! can be changed via the nam_cdf_names namelist
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cd_var
+
+ INTEGER(KIND=4) :: jv
+ !!----------------------------------------------------------------------
+ varchk3 = .FALSE.
+ DO jv = 1, nn_cubvar
+ IF ( cd_var == cn_cubvar(jv) ) THEN
+ varchk3 = .TRUE.
+ exit
+ ENDIF
+ ENDDO
+
+ END FUNCTION varchk3
+
+ SUBROUTINE zeromean(kk, ptab)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE zeromean ***
+ !!
+ !! ** Purpose : Computes the spatial average of argument and
+ !! and substract it from the field
+ !!
+ !! ** Method : requires the horizontal metrics
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT( in) :: kk
+ REAL(KIND=4), DIMENSION(:,:), INTENT(inout) :: ptab
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE, SAVE :: ze2, ze1, tmask, tmask0
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE, SAVE :: dareas
+ REAL(KIND=8), SAVE :: darea
+ REAL(KIND=8) :: dmean
+
+ LOGICAL, SAVE :: lfirst=.true.
+ !!----------------------------------------------------------------------
+
+ IF (lfirst) THEN
+ lfirst=.false.
+ ! read e1 e2 and tmask ( assuming this prog only deal with T-points)
+ ALLOCATE ( ze1(npiglo, npjglo), ze2(npiglo,npjglo) )
+ ALLOCATE ( tmask(npiglo,npjglo), tmask0(npiglo,npjglo) )
+ ALLOCATE ( dareas(npiglo,npjglo) )
+
+ ze1(:,:) = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo)
+ ze2(:,:) = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo)
+ dareas(:,:) = ze1(:,:) * ze2(:,:) *1.d0
+ ENDIF
+ tmask0(:,:) = getvar(cn_fmsk, 'tmask', kk, npiglo, npjglo)
+ tmask = tmask0
+ tmask(1,:)=0 ; tmask(npiglo,:)=0 ; tmask(:,1) = 0.; tmask(:,npjglo) = 0
+
+ IF ( nperio == 3 .OR. nperio == 4 ) THEN
+ tmask(npiglo/2+1:npiglo,npjglo-1) = 0.
+ ENDIF
+
+
+ darea = SUM( dareas * tmask )
+
+ IF ( darea /= 0.d0 ) THEN
+ dmean = SUM( ptab * dareas ) / darea
+ ELSE
+ dmean = 0.d0
+ ENDIF
+
+ WHERE ( ptab /= 0 ) ptab = ( ptab - dmean ) * tmask0
+
+ END SUBROUTINE zeromean
END PROGRAM cdfmoy
diff --git a/cdfmoy3.f90 b/cdfmoy3.f90
deleted file mode 100644
index 17676c1..0000000
--- a/cdfmoy3.f90
+++ /dev/null
@@ -1,261 +0,0 @@
-PROGRAM cdfmoy3
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfmoy3 ***
- !!
- !! ** Purpose: Compute mean values of ssh ssh^2 and ssh^3
- !! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: Try to avoid 3 d arrays
- !!
- !! history :
- !! Original code : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (Apr 2005 ) put all NCF stuff in module
- !! now valid for grid T U V W icemod
- !! Modified : P. Mathiot (June 2007) update for forcing fields
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- USE cdfio
-
- IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv , jtt,jkk , jarg !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER :: ntframe !: Cumul of time frame
- INTEGER, PARAMETER :: jperio=4 ! ORCA025
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout,&
- & id_varout2,&
- & id_varout3
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: tab, tab2,tab3 !: Arrays for cumulated values
- REAL(KIND=8) :: total_time
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean, rmean2, rmean3
- REAL(KIND=4),DIMENSION(1) :: timean
- REAL(KIND=4),DIMENSION(365) :: tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout, cfileout2, cfileout3 !: file name
- CHARACTER(LEN=256) :: cdep
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname2 !: array of var22 name for output
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname3 !: array of var3 name for output
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar, typvar2, typvar3
-
- INTEGER :: ncout, ncout2, ncout3
- INTEGER :: istatus
- LOGICAL :: lcaltmean, l_mean=.false.
-
- !!
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoy3 [-m] ''list_of_ioipsl_model_output_files'' '
- PRINT *,' If -m option is used, spatial mean is substract from each field '
- PRINT *,' In this compilation jperio = ', jperio
- STOP
- ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
- IF ( cfile == '-m' ) THEN
- l_mean=.true.
- CALL getarg (2, cfile) ! read the first file name then
- jarg=2
- ENDIF
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
-
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- PRINT *,' assume file with no depth'
- npk=0
- ENDIF
- ENDIF
- ENDIF
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- npk=1
-
- ALLOCATE( tab(npiglo,npjglo), tab2(npiglo,npjglo), tab3(npiglo,npjglo) )
- ALLOCATE( v2d(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo), rmean2(npiglo,npjglo), rmean3(npiglo,npjglo) )
-
- nvars = getnvar(cfile)
- PRINT *,' nvars =', nvars
-
- ALLOCATE (cvarname(nvars), cvarname2(nvars) , cvarname3(nvars) )
- ALLOCATE (typvar(nvars), typvar2(nvars) , typvar3(nvars) )
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars), id_varout2(nvars) ,id_varout3(nvars) )
-
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
- WHERE( cvarname /= 'sossheig'.and. cvarname /= 'votemper' ) cvarname='none'
-
- DO jvar = 1, nvars
- ! variables that will not be computed or stored are named 'none'
- IF (cvarname(jvar) /= 'sossheig' .AND. cvarname(jvar) /= 'votemper') THEN
- cvarname2(jvar) ='none'
- cvarname3(jvar) ='none'
- ELSE
- cvarname2(jvar)=TRIM(cvarname(jvar))//'_sqd'
- typvar2(jvar)%name = TRIM(typvar(jvar)%name)//'_sqd' ! name
- typvar2(jvar)%units = '('//TRIM(typvar(jvar)%units)//')^2' ! unit
- typvar2(jvar)%missing_value = typvar(jvar)%missing_value ! missing_value
- typvar2(jvar)%valid_min = 0. ! valid_min = zero
- typvar2(jvar)%valid_max = typvar(jvar)%valid_max**2 ! valid_max *valid_max
- typvar2(jvar)%scale_factor= 1.
- typvar2(jvar)%add_offset= 0.
- typvar2(jvar)%savelog10= 0.
- typvar2(jvar)%long_name =TRIM(typvar(jvar)%long_name)//'_Squared' !
- typvar2(jvar)%short_name = TRIM(typvar(jvar)%short_name)//'_sqd' !
- typvar2(jvar)%online_operation = TRIM(typvar(jvar)%online_operation)
- typvar2(jvar)%axis = TRIM(typvar(jvar)%axis)
-
- cvarname3(jvar)=TRIM(cvarname(jvar))//'_cub'
- typvar3(jvar)%name = TRIM(typvar(jvar)%name)//'_cub' ! name
- typvar3(jvar)%units = '('//TRIM(typvar(jvar)%units)//')^3' ! unit
- typvar3(jvar)%missing_value = typvar(jvar)%missing_value ! missing_value
- typvar3(jvar)%valid_min = 0. ! valid_min = zero
- typvar3(jvar)%valid_max = typvar(jvar)%valid_max**3 ! valid_max *valid_max
- typvar3(jvar)%scale_factor= 1.
- typvar3(jvar)%add_offset= 0.
- typvar3(jvar)%savelog10= 0.
- typvar3(jvar)%long_name =TRIM(typvar(jvar)%long_name)//'_Cubic' !
- typvar3(jvar)%short_name = TRIM(typvar(jvar)%short_name)//'_cub' !
- typvar3(jvar)%online_operation = TRIM(typvar(jvar)%online_operation)
- typvar3(jvar)%axis = TRIM(typvar(jvar)%axis)
-
-
- END IF
- END DO
-
- id_var(:) = (/(jv, jv=1,nvars)/)
- ! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
- WHERE( ipk == 0 ) cvarname='none'
- WHERE(ipk > 1 ) ipk = 1
- typvar(:)%name=cvarname
- typvar2(:)%name=cvarname2
- typvar3(:)%name=cvarname3
-
- ! create output fileset
- cfileout='cdfmoy.nc'
- cfileout2='cdfmoy2.nc'
- cfileout3='cdfmoy3.nc'
- ! create output file taking the sizes in cfile
-
- ncout =create(cfileout, cfile,npiglo,npjglo,npk,cdep=cdep)
- ncout2=create(cfileout2,cfile,npiglo,npjglo,npk,cdep=cdep)
- ncout3=create(cfileout3,cfile,npiglo,npjglo,npk,cdep=cdep)
-
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- ierr= createvar(ncout2, typvar2, nvars, ipk, id_varout2)
- ierr= createvar(ncout3, typvar3, nvars, ipk, id_varout3)
-
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk,cdep=cdep)
- ierr= putheadervar(ncout2, cfile, npiglo, npjglo, npk,cdep=cdep)
- ierr= putheadervar(ncout3, cfile, npiglo, npjglo, npk,cdep=cdep)
-
- lcaltmean=.TRUE.
- DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' .OR. cvarname2(jvar) == 'none' ) THEN
- ! skip these variable
- ELSE
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar)
- DO jk = 1, ipk(jvar)
- PRINT *,'level ',jk
- tab(:,:) = 0.d0 ; tab2(:,:) = 0.d0 ; tab3(:,:) = 0.d0
- total_time = 0.; ntframe=0
- DO jt = jarg, narg
- CALL getarg (jt, cfile)
- nt = getdim (cfile,'time_counter')
- IF ( lcaltmean ) THEN
- tim=getvar1d(cfile,'time_counter',nt)
- total_time = total_time + SUM(tim(1:nt) )
- END IF
- DO jtt=1,nt
- ntframe=ntframe+1
- jkk=jk
- ! If forcing fields is without depth dimension
- IF (npk==0) jkk=jtt
- v2d(:,:)= getvar(cfile, cvarname(jvar), jkk ,npiglo, npjglo,ktime=jtt )
- IF (l_mean ) CALL zeromean(v2d)
- tab(:,:) = tab(:,:) + v2d(:,:)
- IF (cvarname2(jvar) /= 'none' ) tab2(:,:) = tab2(:,:) + v2d(:,:)*v2d(:,:)
- IF (cvarname3(jvar) /= 'none' ) tab3(:,:) = tab3(:,:) + v2d(:,:)*v2d(:,:)*v2d(:,:)
- ENDDO
- END DO
- ! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = tab(:,:)/ntframe
- IF (cvarname2(jvar) /= 'none' ) rmean2(:,:) = tab2(:,:)/ntframe
- IF (cvarname3(jvar) /= 'none' ) rmean3(:,:) = tab3(:,:)/ntframe
- ! store variable on outputfile
- ierr = putvar(ncout, id_varout(jvar) ,rmean, jk, npiglo, npjglo)
- IF (cvarname2(jvar) /= 'none' ) ierr = putvar(ncout2,id_varout2(jvar),rmean2, jk,npiglo, npjglo)
- IF (cvarname3(jvar) /= 'none' ) ierr = putvar(ncout3,id_varout3(jvar),rmean3, jk,npiglo, npjglo)
- IF (lcaltmean ) THEN
- timean(1)= total_time/ntframe
- ierr=putvar1d(ncout,timean,1,'T')
- ierr=putvar1d(ncout2,timean,1,'T')
- ierr=putvar1d(ncout3,timean,1,'T')
- END IF
- lcaltmean=.FALSE. ! tmean already computed
- END DO ! loop to next level
- END IF
- END DO ! loop to next var in file
-
- istatus = closeout(ncout)
- istatus = closeout(ncout2)
- istatus = closeout(ncout3)
- CONTAINS
-
- SUBROUTINE zeromean(ptab)
- REAL(KIND=4), DIMENSION(:,:), INTENT(inout) :: ptab
- LOGICAL, SAVE :: lfirst=.true.
- CHARACTER(LEN=256) :: chgr='mesh_hgr.nc', cmask='mask.nc'
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE, SAVE :: ei, at, tmask,tmask0
- REAL(KIND=8), SAVE :: area
- REAL(KIND=8) :: zmean
-
- IF (lfirst) THEN
- lfirst=.false.
- ! read e1 e2 and tmask ( assuming this prog only deal with T-points)
- ALLOCATE ( at(npiglo, npjglo), ei(npiglo,npjglo), tmask(npiglo,npjglo), tmask0(npiglo,npjglo) )
- at(:,:) = getvar(chgr,'e1t',1,npiglo,npjglo)
- ei(:,:) = getvar(chgr,'e2t',1,npiglo,npjglo)
- tmask0(:,:) = getvar(cmask,'tmask',1,npiglo,npjglo)
- tmask=tmask0
- tmask(1,:)=0 ; tmask(npiglo,:)=0 ; tmask(:,1) = 0.; tmask(:,npjglo) = 0
- IF ( jperio == 3 .OR. jperio == 4 ) THEN
- tmask(npiglo/2+1:npiglo,npjglo-1) = 0.
- ENDIF
- at(:,:) = at(:,:)*ei(:,:)*tmask(:,:) ! surface of model cell
- area=sum(at)
- ENDIF
- zmean=sum(v2d*at)/area
- PRINT *,'jt zmean', jt, zmean
- ptab=(ptab-zmean) * tmask0
-
- END SUBROUTINE zeromean
-
-
-
-
-
-END PROGRAM cdfmoy3
diff --git a/cdfmoy_annual.f90 b/cdfmoy_annual.f90
deleted file mode 100644
index 41f7c3c..0000000
--- a/cdfmoy_annual.f90
+++ /dev/null
@@ -1,143 +0,0 @@
-PROGRAM cdfmoy_annual
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfmoy_annual ***
- !!
- !! ** Purpose: Compute annual mean values from monthly mean
- !!
- !! ** Method: monthly mean were computed (cdfmoy) with all dumps that fall within a montn
- !! thus, all month have different weigth : Feb = 5. March, Dec. = 7 other = 6
- !!
- !! history :
- !! Original code : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (Apr 2005 ) put all NCF stuff in module
- !! now valid for grid T U V W icemod
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- USE cdfio
-
- IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout
- INTEGER, DIMENSION(12) :: iweight=(/6,5,7,6,6,6,6,6,6,6,6,7/)
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: tab !: Arrays for cumulated values
- REAL(KIND=8) :: total_time
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean
- REAL(KIND=4),DIMENSION(1) :: timean, tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout !: file name
- CHARACTER(LEN=256) :: cdep
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar
-
- INTEGER :: ncout
- INTEGER :: istatus
-
- !!
-
- !! Read command line
- narg= iargc()
- IF ( narg /= 12 ) THEN
- PRINT *,' Usage : cdfmoy_annual ''12 monthly files'' '
- STOP
- ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
-
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
-! STOP 'depth dimension name not suported'
- PRINT *,' assume file with no depth'
- npk=0
- ENDIF
- ENDIF
- ENDIF
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( tab(npiglo,npjglo), v2d(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo) )
-
- nvars = getnvar(cfile)
- PRINT *,' nvars =', nvars
-
- ALLOCATE (cvarname(nvars))
- ALLOCATE (typvar(nvars) )
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars) )
-
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
-
-
- id_var(:) = (/(jv, jv=1,nvars)/)
- ! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
-
- ! create output fileset
- cfileout='cdfmoy_annual.nc'
- ! create output file taking the sizes in cfile
-
- ncout =create(cfileout, cfile,npiglo,npjglo,npk,cdep=cdep)
-
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
-
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk,cdep=cdep)
-
- DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' ) THEN
- ! skip these variable
- ELSE
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar)
- DO jk = 1, ipk(jvar)
- PRINT *,'level ',jk
- tab(:,:) = 0.d0 ; total_time = 0.
- DO jt = 1, narg
- IF (jk == 1 .AND. jvar == nvars ) THEN
- tim=getvar1d(cfile,'time_counter',1)
- total_time = total_time + tim(1)
- END IF
- CALL getarg (jt, cfile)
- v2d(:,:)= getvar(cfile, cvarname(jvar), jk ,npiglo, npjglo )
- tab(:,:) = tab(:,:) + iweight(jt)* v2d(:,:)
- END DO
- ! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = tab(:,:)/73.
- ! store variable on outputfile
- ierr = putvar(ncout, id_varout(jvar) ,rmean, jk, npiglo, npjglo)
- IF (jk == 1 .AND. jvar == nvars ) THEN
- timean(1)= total_time/narg
- ierr=putvar1d(ncout,timean,1,'T')
- END IF
- END DO ! loop to next level
- END IF
- END DO ! loop to next var in file
-
- istatus = closeout(ncout)
-
-
-END PROGRAM cdfmoy_annual
diff --git a/cdfmoy_chsp.f90 b/cdfmoy_chsp.f90
deleted file mode 100644
index eb0a506..0000000
--- a/cdfmoy_chsp.f90
+++ /dev/null
@@ -1,198 +0,0 @@
-PROGRAM cdfmoy_chsp
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfmoy_chsp ***
- !!
- !! ** Purpose: Compute mean values for all the variables in a bunch
- !! of cdf files given as argument
- !! Store the results on a 'similar' cdf file.
- !! Change the initial sp val to 0 in the output file
- !!
- !! ** Method: Try to avoid 3 d arrays
- !!
- !! history :
- !! Original code : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (Apr 2005 ) put all NCF stuff in module
- !! now valid for grid T U V W icemod
- !! Modified : P. Mathiot (June 2007) update for forcing fields
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- USE cdfio
-
- IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv , jtt,jkk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER :: ntframe !: Cumul of time frame
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout,&
- & id_varout2
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: tab, tab2 !: Arrays for cumulated values
- REAL(KIND=8) :: total_time
- REAL(KIND=4) ,DIMENSION(:), ALLOCATABLE :: spval_in
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean, rmean2
- REAL(KIND=4),DIMENSION(1) :: timean
- REAL(KIND=4),DIMENSION(365) :: tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout, cfileout2 !: file name
- CHARACTER(LEN=256) :: cdep
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname2 !: array of var22 name for output
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar, typvar2
-
- INTEGER :: ncout, ncout2
- INTEGER :: istatus
- LOGICAL :: lcaltmean
-
- !!
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoy ''list_of_ioipsl_model_output_files'' '
- STOP
- ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
-
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- PRINT *,' assume file with no depth'
- npk=0
- ENDIF
- ENDIF
- ENDIF
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( tab(npiglo,npjglo), tab2(npiglo,npjglo), v2d(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo), rmean2(npiglo,npjglo) )
-
- nvars = getnvar(cfile)
- PRINT *,' nvars =', nvars
-
- ALLOCATE (cvarname(nvars), cvarname2(nvars) , spval_in(nvars) )
- ALLOCATE (typvar(nvars), typvar2(nvars) )
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars), id_varout2(nvars) )
-
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
- DO jvar=1,nvars
- spval_in(jvar)= typvar(jvar)%missing_value
- typvar(jvar)%missing_value=0.
- END DO
-
- DO jvar = 1, nvars
- ! variables that will not be computed or stored are named 'none'
- IF (cvarname(jvar) /= 'vozocrtx' .AND. &
- cvarname(jvar) /= 'vomecrty' .AND. &
- cvarname(jvar) /= 'vovecrtz' .AND. &
- cvarname(jvar) /= 'sossheig' ) THEN
- cvarname2(jvar) ='none'
- ELSE
- cvarname2(jvar)=TRIM(cvarname(jvar))//'_sqd'
- typvar2(jvar)%name = TRIM(typvar(jvar)%name)//'_sqd' ! name
- typvar2(jvar)%units = '('//TRIM(typvar(jvar)%units)//')^2' ! unit
- typvar2(jvar)%missing_value = typvar(jvar)%missing_value ! missing_value
- typvar2(jvar)%valid_min = 0. ! valid_min = zero
- typvar2(jvar)%valid_max = typvar(jvar)%valid_max**2 ! valid_max *valid_max
- typvar2(jvar)%scale_factor= 1.
- typvar2(jvar)%add_offset= 0.
- typvar2(jvar)%savelog10= 0.
- typvar2(jvar)%long_name =TRIM(typvar(jvar)%long_name)//'_Squared' !
- typvar2(jvar)%short_name = TRIM(typvar(jvar)%short_name)//'_sqd' !
- typvar2(jvar)%online_operation = TRIM(typvar(jvar)%online_operation)
- typvar2(jvar)%axis = TRIM(typvar(jvar)%axis)
-
- END IF
- END DO
-
- id_var(:) = (/(jv, jv=1,nvars)/)
- ! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
- typvar2(:)%name=cvarname2
-
- ! create output fileset
- cfileout='cdfmoy.nc'
- cfileout2='cdfmoy2.nc'
- ! create output file taking the sizes in cfile
-
- ncout =create(cfileout, cfile,npiglo,npjglo,npk,cdep=cdep)
- ncout2=create(cfileout2,cfile,npiglo,npjglo,npk,cdep=cdep)
-
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- ierr= createvar(ncout2, typvar2, nvars, ipk, id_varout2)
-
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk,cdep=cdep)
- ierr= putheadervar(ncout2, cfile, npiglo, npjglo, npk,cdep=cdep)
-
- lcaltmean=.TRUE.
- DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' ) THEN
- ! skip these variable
- ELSE
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar)
- DO jk = 1, ipk(jvar)
- PRINT *,'level ',jk
- tab(:,:) = 0.d0 ; tab2(:,:) = 0.d0 ; total_time = 0.; ntframe=0
- DO jt = 1, narg
- CALL getarg (jt, cfile)
- nt = getdim (cfile,'time_counter')
- IF ( lcaltmean ) THEN
- tim=getvar1d(cfile,'time_counter',nt)
- total_time = total_time + SUM(tim(1:nt) )
- END IF
- DO jtt=1,nt
- ntframe=ntframe+1
- jkk=jk
- ! If forcing fields is without depth dimension
- IF (npk==0) jkk=jtt
- v2d(:,:)= getvar(cfile, cvarname(jvar), jkk ,npiglo, npjglo,ktime=jtt )
- WHERE (v2d == spval_in(jvar)) v2d=0.
- tab(:,:) = tab(:,:) + v2d(:,:)
- IF (cvarname2(jvar) /= 'none' ) tab2(:,:) = tab2(:,:) + v2d(:,:)*v2d(:,:)
- ENDDO
- END DO
- ! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = tab(:,:)/ntframe
- IF (cvarname2(jvar) /= 'none' ) rmean2(:,:) = tab2(:,:)/ntframe
- ! store variable on outputfile
- ierr = putvar(ncout, id_varout(jvar) ,rmean, jk, npiglo, npjglo)
- IF (cvarname2(jvar) /= 'none' ) ierr = putvar(ncout2,id_varout2(jvar),rmean2, jk,npiglo, npjglo)
- IF (lcaltmean ) THEN
- timean(1)= total_time/ntframe
- ierr=putvar1d(ncout,timean,1,'T')
- ierr=putvar1d(ncout2,timean,1,'T')
- END IF
- lcaltmean=.FALSE. ! tmean already computed
- END DO ! loop to next level
- END IF
- END DO ! loop to next var in file
-
- istatus = closeout(ncout)
- istatus = closeout(ncout2)
-
-
-END PROGRAM cdfmoy_chsp
diff --git a/cdfmoy_freq.f90 b/cdfmoy_freq.f90
index ad851ee..be419c6 100644
--- a/cdfmoy_freq.f90
+++ b/cdfmoy_freq.f90
@@ -1,196 +1,208 @@
PROGRAM cdfmoy_freq
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfmoy ***
+ !!======================================================================
+ !! *** PROGRAM cdfmoy_freq ***
+ !!=====================================================================
+ !! ** Purpose : Mainly in case of forcing file (gathered as yearly file)
+ !! compute annual mean, monthl mean or diurnal means.
!!
- !! ** Purpose: Compute mean values for all the variables in a bunch
- !! of cdf files given as argument
- !! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: Try to avoid 3 d arrays
- !!
- !! history :
- !! Original code : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (Apr 2005 ) put all NCF stuff in module
- !! now valid for grid T U V W icemod
- !! Modified : P. Mathiot (June 2007) update for forcing fields
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
+ !! ** Method : Detect the frequency of the input file according to the
+ !! number of fields in the file.
!!
+ !! History : 2.1 : 06/2007 : P. Mathiot : Original code from cdfmoy
+ !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: nt_in, nt_out, nmois
- INTEGER :: jk,jt,jvar, jv , jtt,jkk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER :: ntframe !: Cumul of time frame
- INTEGER, DIMENSION(12) :: njm
-
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: tab !: Arrays for cumulated values
- REAL(KIND=8) :: total_time
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean
- REAL(KIND=4),DIMENSION(1) :: time
- REAL(KIND=4),DIMENSION(365) :: tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout !: file name
- CHARACTER(LEN=256) :: cdep, cfreq_out, cfreq_in
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var nam
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar
- INTEGER :: ncout, ncout2
- INTEGER :: istatus
- LOGICAL :: lcaltmean
+ INTEGER(KIND=4) :: nt_in, nt_out
+ INTEGER(KIND=4) :: jk, jvar ! dummy loop index
+ INTEGER(KIND=4) :: jv, jtt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: itime ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc !
+ INTEGER(KIND=4) :: ijmonth
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk ,npt ! size of the domain
+ INTEGER(KIND=4) :: nvars ! Number of variables in a file
+ INTEGER(KIND=4) :: ntframe ! Cumul of time frame
+ INTEGER(KIND=4) :: ncout, ncout2
+ INTEGER(KIND=4), DIMENSION(12) :: njm
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var, ipk, id_varout
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, rmean
+ REAL(KIND=4), DIMENSION(1) :: time
+ REAL(KIND=4), DIMENSION(365) :: tim
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtab ! Arrays for cumulated values
+ REAL(KIND=8) :: dtotal_time
+
+ CHARACTER(LEN=256) :: cf_in !
+ CHARACTER(LEN=256) :: cf_out ! file name
+ CHARACTER(LEN=256) :: cv_dep
+ CHARACTER(LEN=256) :: cfreq_out, cfreq_in
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var nam
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar
- !!
+ LOGICAL :: lcaltmean
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoy_freq forcing_field frequency (monthly or daily or annual)'
+ PRINT *,' usage : cdfmoy_freq IN-file output_frequency'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute annual mean or monthly mean or daily mean from a yearly'
+ PRINT *,' input forcing file given on input.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : netcdf input file corresponding to 1 year of forcing variable '
+ PRINT *,' output_frequency : either one of montly, daily or annual.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : cdfmoy_outputFreaquency.nc'
+ PRINT *,' variables : same as variables in input file.'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfmoy, cdfmoy_weighted'
+ PRINT *,' '
STOP
ENDIF
- !!
+
!! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
+ CALL getarg (1, cf_in )
CALL getarg (2, cfreq_out)
- IF (TRIM(cfreq_out) .EQ. 'daily') nt_out=365 !
- IF (TRIM(cfreq_out) .EQ. 'monthly') nt_out=12 !
- IF (TRIM(cfreq_out) .EQ. 'annual') nt_out=1 !
- IF ((TRIM(cfreq_out) .NE. 'annual') .AND. (TRIM(cfreq_out) .NE. 'daily') .AND. (TRIM(cfreq_out) .NE. 'monthly')) THEN
- PRINT *, 'Pb : this frequency is not allowed, used please daily, monthly or annual'
+ IF ( chkfile ( cf_in ) ) STOP ! missing file
+
+ SELECT CASE ( cfreq_out )
+ CASE ('daily' ) ; nt_out = 365
+ CASE ('monthly' ) ; nt_out = 12
+ CASE ('annual' ) ; nt_out = 1
+ CASE DEFAULT
+ PRINT *, 'Pb : this frequency is not allowed, please use daily, monthly or annual'
STOP
- END IF
-
+ END SELECT
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
+ npiglo= getdim (cf_in, cn_x )
+ npjglo= getdim (cf_in, cn_y )
+ npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
PRINT *,' assume file with no depth'
npk=0
ENDIF
ENDIF
ENDIF
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
- ALLOCATE( tab(npiglo,npjglo), v2d(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo))
+ ALLOCATE( dtab(npiglo,npjglo), v2d(npiglo,npjglo) )
+ ALLOCATE( rmean(npiglo,npjglo) )
- nvars = getnvar(cfile)
+ nvars = getnvar(cf_in)
PRINT *,' nvars =', nvars
- ALLOCATE (cvarname(nvars))
- ALLOCATE (typvar(nvars))
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars))
+ ALLOCATE (cv_names(nvars) )
+ ALLOCATE (stypvar(nvars) )
+ ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars))
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ ! get list of variable names and collect attributes in stypvar (optional)
+ cv_names(:)=getvarname(cf_in, nvars, stypvar)
id_var(:) = (/(jv, jv=1,nvars)/)
! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
+ ipk(:) = getipk (cf_in, nvars, cdep=cv_dep)
!
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
+ WHERE( ipk == 0 ) cv_names='none'
+ stypvar(:)%cname = cv_names
- PRINT *, '',cvarname
+ PRINT *, '',cv_names
! create output fileset
- cfileout='cdfmoy_'//TRIM(cfreq_out)//'.nc'
- ! create output file taking the sizes in cfile
-
- ncout =create(cfileout, cfile,npiglo,npjglo, 0)
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, 0)
- time=getvar1d(cfile,'time_counter',1)
- ierr=putvar1d(ncout,time,1,'T')
-
-
- nt = getdim (cfile,'time_counter')
- nt_in=nt
- IF (nt==1460) THEN
- PRINT *, 'Frequency of this file : 6h '
-! cfreq_in='6h'
-! nfreq_in=6
- END IF
- IF (nt==365) THEN
- PRINT *, 'Frequency of this file : daily '
-! cfreq_in='daily'
-! nfreq_in=24
- END IF
- IF (nt==12) THEN
- PRINT *, 'Frequency of this file : monthly '
-! cfreq_in='monthly'
-! nfreq_in=720
- END IF
+ cf_out = 'cdfmoy_'//TRIM(cfreq_out)//'.nc'
+ ! create output file taking the sizes in cf_in
+
+ ncout = create (cf_out, cf_in, npiglo, npjglo, 0 )
+ ierr = createvar (ncout, stypvar, nvars, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, 0 )
+
+ time=getvar1d(cf_in, cn_vtimec, 1)
+ ierr=putvar1d(ncout, time, 1, 'T')
- IF (nt .LE. nt_out) THEN
+ npt = getdim (cf_in, cn_t)
+ nt_in = npt
+
+ SELECT CASE ( npt )
+ CASE ( 1460 ) ; PRINT *, 'Frequency of this file : 6h '
+ CASE ( 365 ) ; PRINT *, 'Frequency of this file : daily '
+ CASE ( 12 ) ; PRINT *, 'Frequency of this file : monthly '
+ END SELECT
+
+ IF (npt <= nt_out) THEN
PRINT *, 'You don''t need to use it, or it is impossible'
STOP
END IF
- jt=0
+
+ itime=0
njm= (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
+
DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' .OR. cvarname(jvar) == 'none') THEN
+ IF ( cv_names(jvar) == cn_vlon2d .OR. &
+ cv_names(jvar) == cn_vlat2d .OR. cv_names(jvar) == 'none') THEN
! skip these variable
ELSE
- PRINT *,' Working with ', TRIM(cvarname(jvar))
- tab(:,:) = 0.d0 ; total_time = 0.; ntframe=0; nmois=1
- DO jtt=1,nt_in
+ PRINT *,' Working with ', TRIM(cv_names(jvar))
+ dtab(:,:) = 0.d0 ; dtotal_time = 0.d0; ntframe=0; ijmonth=1
+ DO jtt=1, nt_in
ntframe=ntframe+1
! If forcing fields is without depth dimension
- v2d(:,:)= getvar(cfile, cvarname(jvar), jtt ,npiglo, npjglo,ktime=jtt )
- tab(:,:) = tab(:,:) + v2d(:,:)
- !PRINT *, '',v2d(100,100), tab(100,100), ntframe
+ v2d(:,:) = getvar(cf_in, cv_names(jvar), 1, npiglo, npjglo, ktime=jtt )
+ dtab(:,:) = dtab(:,:) + v2d(:,:)*1.d0
+
IF (nt_out==12) THEN
- IF (ntframe .EQ. njm(nmois)*nt_in/365) THEN
- PRINT *, nmois, jtt,'/',nt
- jt=jt+1
+ IF ( ntframe == njm(ijmonth) * nt_in/365 ) THEN
+ PRINT *, ijmonth, jtt,'/',npt
+ itime=itime+1
! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = tab(:,:)/ntframe
+ rmean(:,:) = dtab(:,:)/ntframe
! store variable on outputfile
- ierr = putvar(ncout, id_varout(jvar) ,rmean, jt, npiglo, npjglo, jt)
- tab(:,:) = 0.d0 ; total_time = 0.; ntframe=0; nmois=nmois+1
+ ierr = putvar(ncout, id_varout(jvar) ,rmean, itime, npiglo, npjglo, itime)
+ dtab(:,:) = 0.d0 ; dtotal_time = 0.; ntframe=0; ijmonth=ijmonth+1
END IF
ELSE
- !PRINT *, jtt,'/',nt,' et on enregistre tous les ',nt_in/nt_out
IF (MOD(jtt,nt_in/nt_out)==0) THEN
- jt=jt+1
- PRINT *, jtt,'/',nt,' dumping every ',nt_in/nt_out
+ itime=itime+1
+ PRINT *, jtt,'/',npt,' dumping every ',nt_in/nt_out
! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = tab(:,:)/ntframe
- PRINT *, '',rmean(100,100)
+ rmean(:,:) = dtab(:,:)/ntframe
! store variable on outputfile
- ierr = putvar(ncout, id_varout(jvar) ,rmean, jt, npiglo, npjglo, jt)
- tab(:,:) = 0.d0 ; total_time = 0.; ntframe=0
+ ierr = putvar(ncout, id_varout(jvar) ,rmean, itime, npiglo, npjglo, itime)
+ dtab(:,:) = 0.d0 ; dtotal_time = 0.; ntframe=0
END IF
END IF
ENDDO
END IF
END DO ! loop to next var in file
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
END PROGRAM cdfmoy_freq
diff --git a/cdfmoy_mpp.f90 b/cdfmoy_mpp.f90
deleted file mode 100644
index 381d67a..0000000
--- a/cdfmoy_mpp.f90
+++ /dev/null
@@ -1,282 +0,0 @@
-PROGRAM cdfmoy_mpp
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfmoy_mpp ***
- !!
- !! ** Purpose: Compute mean values for all the variables in a bunch
- !! of cdf files given as argument
- !! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: Try to avoid 3 d arrays
- !!
- !! history :
- !! Original code : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (Apr 2005 ) put all NCF stuff in module
- !! now valid for grid T U V W icemod
- !! Modified : P. Mathiot (June 2007) update for forcing fields
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- USE cdfio
- USE mpi
-
- IMPLICIT NONE
- ! MPI stuff
- INTEGER :: jt,jjp, ji, ii ! loop counters
- INTEGER :: ierror, iproc, nproc, narea
- INTEGER, DIMENSION(:), ALLOCATABLE :: nptag
- INTEGER :: irest, ntag, nused_proc, ndimtag , ntask
- CHARACTER(LEN=256) :: cdum
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: ctags ! tag list
- CHARACTER(LEN=256), DIMENSION(:,:) , ALLOCATABLE:: cptag ! processor tag list
- LOGICAL :: lwp
- !
- !
- INTEGER :: jk,jvar, jv , jtt,jkk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER :: ntframe, ntframe_tot !: Cumul of time frame
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout,&
- & id_varout2
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: tab, tab2 !: Arrays for cumulated values
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: tabtot, tab2tot !: Arrays for cumulated values
- REAL(KIND=8) :: total_time, total_timetot
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean, rmean2
- REAL(KIND=4),DIMENSION(1) :: timean
- REAL(KIND=4),DIMENSION(365) :: tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout, cfileout2 !: file name
- CHARACTER(LEN=256) :: cdep
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname2 !: array of var22 name for output
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar, typvar2
-
- INTEGER :: ncout, ncout2
- INTEGER :: istatus
- LOGICAL :: lcaltmean
-
- !! * Initialization
-
- ! Initialize MPI
- CALL mpi_init(ierror)
- CALL mpi_comm_rank(mpi_comm_world,iproc,ierror)
- CALL mpi_comm_size(mpi_comm_world,nproc,ierror)
- narea = iproc + 1
- lwp=( narea == 1 )
- !!
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- IF ( lwp ) THEN
- PRINT *,' Usage : cdfmoy_mpp ''list_of_ioipsl_model_output_files'' '
- ENDIF
- CALL mpi_finalize(ierror)
- STOP
- ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
-
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- PRINT *,' assume file with no depth'
- npk=0
- ENDIF
- ENDIF
- ENDIF
-
-
- IF ( lwp ) THEN
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- ENDIF
-
- ALLOCATE( tab(npiglo,npjglo), tab2(npiglo,npjglo), v2d(npiglo,npjglo) )
- ALLOCATE( tabtot(npiglo,npjglo), tab2tot(npiglo,npjglo))
- ALLOCATE( rmean(npiglo,npjglo), rmean2(npiglo,npjglo) )
-
- nvars = getnvar(cfile)
- PRINT *,' nvars =', nvars
-
- ALLOCATE (cvarname(nvars), cvarname2(nvars) )
- ALLOCATE (typvar(nvars), typvar2(nvars) )
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars), id_varout2(nvars) )
-
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
-
- DO jvar = 1, nvars
- ! variables that will not be computed or stored are named 'none'
- IF (cvarname(jvar) /= 'vozocrtx' .AND. &
- cvarname(jvar) /= 'vomecrty' .AND. &
- cvarname(jvar) /= 'vovecrtz' .AND. &
- cvarname(jvar) /= 'sossheig' ) THEN
- cvarname2(jvar) ='none'
- ELSE
- cvarname2(jvar)=TRIM(cvarname(jvar))//'_sqd'
- typvar2(jvar)%name = TRIM(typvar(jvar)%name)//'_sqd' ! name
- typvar2(jvar)%units = '('//TRIM(typvar(jvar)%units)//')^2' ! unit
- typvar2(jvar)%missing_value = typvar(jvar)%missing_value ! missing_value
- typvar2(jvar)%valid_min = 0. ! valid_min = zero
- typvar2(jvar)%valid_max = typvar(jvar)%valid_max**2 ! valid_max *valid_max
- typvar2(jvar)%scale_factor= 1.
- typvar2(jvar)%add_offset= 0.
- typvar2(jvar)%savelog10= 0.
- typvar2(jvar)%long_name =TRIM(typvar(jvar)%long_name)//'_Squared' !
- typvar2(jvar)%short_name = TRIM(typvar(jvar)%short_name)//'_sqd' !
- typvar2(jvar)%online_operation = TRIM(typvar(jvar)%online_operation)
- typvar2(jvar)%axis = TRIM(typvar(jvar)%axis)
-
- END IF
- END DO
-
- id_var(:) = (/(jv, jv=1,nvars)/)
- ! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
- typvar2(:)%name=cvarname2
-
- ! create output fileset
- cfileout='cdfmoy.nc'
- cfileout2='cdfmoy2.nc'
- ! create output file taking the sizes in cfile
-
- IF ( lwp) THEN
- ncout =create(cfileout, cfile,npiglo,npjglo,npk,cdep=cdep)
- ncout2=create(cfileout2,cfile,npiglo,npjglo,npk,cdep=cdep)
-
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- ierr= createvar(ncout2, typvar2, nvars, ipk, id_varout2)
-
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk,cdep=cdep)
- ierr= putheadervar(ncout2, cfile, npiglo, npjglo, npk,cdep=cdep)
- END IF
-
- ! Allocate space for taglist
- ALLOCATE ( ctags(narg) )
-
- DO jt=1,narg
- CALL getarg(jt,ctags(jt))
- END DO
-
- !! * Dispatch the tags among the processors
-
- ! Max number of tags per processors
- irest = MOD(narg, nproc)
- ntag = narg / nproc
- nused_proc = nproc
-
- IF ( ntag == 0 ) THEN ! when there are more proc than tags
- ntag = 1 ! each working proc takes 1 tag
- irest = 0 ! no tags left
- nused_proc= narg ! number of used proc is less than nproc
- END IF
-
- ! maximum possible tags per procs
- ndimtag = ntag ; IF ( irest /= 0 ) ndimtag = ndimtag + 1 ! irest task will be reparted
-
- ! Allocate space
- ALLOCATE (cptag(nproc,ndimtag) ) ! list of tags for each proc
- ALLOCATE (nptag(nproc) ) ! number of tags per proc
-
- nptag(:) = 0
- nptag(1:nused_proc) = ntag
-
- ! reparts the remaining tags on the first irest proc
- DO jjp= 1, irest
- nptag(jjp) = nptag(jjp) + 1
- END DO
-
- ! build processor tag list
- ii= 0
- DO jjp = 1, nused_proc
- DO jt = 1, nptag(jjp)
- ii = ii + 1
- cptag(jjp,jt) = ctags(ii)
- END DO
- END DO
-!!!
- !! * Dispatch the work ..
- ntask = nptag(narea)
-
-
- lcaltmean=.TRUE.
- DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' ) THEN
- ! skip these variable
- ELSE
- IF (lwp) PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar)
- DO jk = 1, ipk(jvar)
- IF (lwp) PRINT *,'level ',jk
- tab(:,:) = 0.d0 ; tab2(:,:) = 0.d0 ; total_time = 0.; ntframe=0
- DO jt = 1, ntask
- cfile=cptag(narea,jt)
- nt = getdim (cfile,'time_counter')
- IF ( lcaltmean ) THEN
- tim=getvar1d(cfile,'time_counter',nt)
- total_time = total_time + SUM(tim(1:nt) )
- END IF
- DO jtt=1,nt
- ntframe=ntframe+1
- jkk=jk
- ! If forcing fields is without depth dimension
- IF (npk==0) jkk=jtt
- v2d(:,:)= getvar(cfile, cvarname(jvar), jkk ,npiglo, npjglo,ktime=jtt )
- tab(:,:) = tab(:,:) + v2d(:,:)
- IF (cvarname2(jvar) /= 'none' ) tab2(:,:) = tab2(:,:) + v2d(:,:)*v2d(:,:)
- ENDDO
- END DO
- ! ! finish with level jk ; compute mean (assume spval is 0 )
- ! rmean(:,:) = tab(:,:)/ntframe
- ! IF (cvarname2(jvar) /= 'none' ) rmean2(:,:) = tab2(:,:)/ntframe
- ! ! store variable on outputfile
- ! collect total number of frames
- CALL MPI_REDUCE(ntframe, ntframe_tot,1,MPI_INTEGER,MPI_SUM,0,MPI_COMM_WORLD,ierr)
- CALL MPI_REDUCE(total_time, total_timetot,1,MPI_DOUBLE_PRECISION,MPI_SUM,0,MPI_COMM_WORLD,ierr)
- ! Collect sum of tab
- CALL MPI_REDUCE(tab,tabtot,npiglo*npjglo,MPI_DOUBLE_PRECISION, MPI_SUM,0,MPI_COMM_WORLD,ierr)
- IF (cvarname2(jvar) /= 'none' ) THEN
- CALL MPI_REDUCE(tab2,tab2tot,npiglo*npjglo,MPI_DOUBLE_PRECISION, MPI_SUM,0,MPI_COMM_WORLD,ierr)
- ENDIF
- IF (lwp) THEN
- rmean(:,:)=tabtot/ntframe_tot
- IF (cvarname2(jvar) /= 'none' ) rmean2(:,:)=tab2tot/ntframe_tot
- ierr = putvar(ncout, id_varout(jvar) ,rmean, jk, npiglo, npjglo)
- IF (cvarname2(jvar) /= 'none' ) ierr = putvar(ncout2,id_varout2(jvar),rmean2, jk,npiglo, npjglo)
- IF (lcaltmean ) THEN
- timean(1)= total_timetot/ntframe_tot
- ierr=putvar1d(ncout,timean,1,'T')
- ierr=putvar1d(ncout2,timean,1,'T')
- END IF
- ENDIF
- lcaltmean=.FALSE. ! tmean already computed
- END DO ! loop to next level
- END IF
- END DO ! loop to next var in file
-
- IF (lwp) THEN
- istatus = closeout(ncout)
- istatus = closeout(ncout2)
- ENDIF
- CALL mpi_finalize(ierror)
-
- END PROGRAM cdfmoy_mpp
diff --git a/cdfmoy_sal2_temp2.f90 b/cdfmoy_sal2_temp2.f90
deleted file mode 100644
index 871406c..0000000
--- a/cdfmoy_sal2_temp2.f90
+++ /dev/null
@@ -1,169 +0,0 @@
-PROGRAM cdfmoy
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfmoy ***
- !!
- !! ** Purpose: Compute mean values for all the variables in a bunch
- !! of cdf files given as argument
- !! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: Try to avoid 3 d arrays
- !!
- !! history :
- !! Original code : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (Apr 2005 ) put all NCF stuff in module
- !! now valid for grid T U V W icemod
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- USE cdfio
-
- IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout,&
- & id_varout2
- REAL(KIND=16) , DIMENSION (:,:), ALLOCATABLE :: tab, tab2 !: Arrays for cumulated values
- REAL(KIND=8) :: total_time
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean, rmean2
- REAL(KIND=4),DIMENSION(1) :: timean, tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout, cfileout2 !: file name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname2 !: array of var22 name for output
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar, typvar2
-
- INTEGER :: ncout, ncout2
- INTEGER :: istatus
-
- !!
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoy ''list_of_ioipsl_model_output_files'' '
- STOP
- ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',kstatus=istatus)
- IF (istatus /= 0 ) STOP 'depth dimension name not suported'
- ENDIF
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( tab(npiglo,npjglo), tab2(npiglo,npjglo), v2d(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo), rmean2(npiglo,npjglo) )
-
- nvars = getnvar(cfile)
- PRINT *,' nvars =', nvars
-
- ALLOCATE (cvarname(nvars), cvarname2(nvars) )
- ALLOCATE (typvar(nvars), typvar2(nvars) )
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars), id_varout2(nvars) )
-
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
-
- DO jvar = 1, nvars
- ! variables that will not be computed or stored are named 'none'
- IF (cvarname(jvar) /= 'vozocrtx' .AND. &
- cvarname(jvar) /= 'vomecrty' .AND. &
- cvarname(jvar) /= 'vovecrtz' .AND. &
- cvarname(jvar) /= 'sossheig' .AND. &
- cvarname(jvar) /= 'votemper' .AND. &
- cvarname(jvar) /= 'vosaline' ) THEN
- cvarname2(jvar) ='none'
- ELSE
- cvarname2(jvar)=TRIM(cvarname(jvar))//'_sqd'
- typvar2(jvar)%name = TRIM(typvar(jvar)%name)//'_sqd' ! name
- typvar2(jvar)%units = '('//TRIM(typvar(jvar)%units)//')^2' ! unit
- typvar2(jvar)%missing_value = typvar(jvar)%missing_value ! missing_value
- typvar2(jvar)%valid_min = 0. ! valid_min = zero
- typvar2(jvar)%valid_max = typvar(jvar)%valid_max**2 ! valid_max *valid_max
- typvar2(jvar)%long_name =TRIM(typvar(jvar)%long_name)//'_Squared' !
- typvar2(jvar)%short_name = TRIM(typvar(jvar)%short_name)//'_sqd' !
- typvar2(jvar)%online_operation = TRIM(typvar(jvar)%online_operation)
- typvar2(jvar)%axis = TRIM(typvar(jvar)%axis)
-
- END IF
- END DO
-
- id_var(:) = (/(jv, jv=1,nvars)/)
- ! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars)
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
- typvar2(:)%name=cvarname2
-
- ! create output fileset
- cfileout='cdfmoy.nc'
- cfileout2='cdfmoy2.nc'
- ! create output file taking the sizes in cfile
-
- ncout =create(cfileout, cfile,npiglo,npjglo,npk)
- ncout2=create(cfileout2,cfile,npiglo,npjglo,npk)
-
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- ierr= createvar(ncout2, typvar2, nvars, ipk, id_varout2)
-
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk)
- ierr= putheadervar(ncout2, cfile, npiglo, npjglo, npk)
-
- DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' ) THEN
- ! skip these variable
- ELSE
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar)
- DO jk = 1, ipk(jvar)
- PRINT *,'level ',jk
- tab(:,:) = 0.d0 ; tab2(:,:) = 0.d0 ; total_time = 0.
- DO jt = 1, narg
- IF (jk == 1 .AND. jvar == nvars ) THEN
- tim=getvar1d(cfile,'time_counter',1)
- total_time = total_time + tim(1)
- END IF
- CALL getarg (jt, cfile)
- v2d(:,:)= getvar(cfile, cvarname(jvar), jk ,npiglo, npjglo )
- tab(:,:) = tab(:,:) + v2d(:,:)
- IF (cvarname2(jvar) /= 'none' ) tab2(:,:) = tab2(:,:) + v2d(:,:)*v2d(:,:)
- END DO
- ! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = tab(:,:)/narg
- IF (cvarname2(jvar) /= 'none' ) rmean2(:,:) = tab2(:,:)/narg
- ! store variable on outputfile
- ierr = putvar(ncout, id_varout(jvar) ,rmean, jk, npiglo, npjglo)
- IF (cvarname2(jvar) /= 'none' ) ierr = putvar(ncout2,id_varout2(jvar),rmean2, jk,npiglo, npjglo)
- IF (jk == 1 .AND. jvar == nvars ) THEN
- timean(1)= total_time/narg
- ierr=putvar1d(ncout,timean,1,'T')
- ierr=putvar1d(ncout2,timean,1,'T')
- END IF
- END DO ! loop to next level
- END IF
- END DO ! loop to next var in file
-
- istatus = closeout(ncout)
- istatus = closeout(ncout2)
-
-
-END PROGRAM cdfmoy
diff --git a/cdfmoy_sp.f90 b/cdfmoy_sp.f90
deleted file mode 100644
index 22b9620..0000000
--- a/cdfmoy_sp.f90
+++ /dev/null
@@ -1,196 +0,0 @@
-PROGRAM cdfmoy_sp
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfmoy_sp ***
- !!
- !! ** Purpose: Compute mean values for all the variables in a bunch
- !! of cdf files given as argument
- !! Store the results on a 'similar' cdf file.
- !! TAKE CARE of the special values
- !!
- !! ** Method: Try to avoid 3 d arrays
- !!
- !! history :
- !! Original code : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (Apr 2005 ) put all NCF stuff in module
- !! now valid for grid T U V W icemod
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout,&
- & id_varout2
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: tab, tab2 !: Arrays for cumulated values
- REAL(KIND=8) :: total_time
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean, rmean2
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: spval !: special value (land point)
- REAL(KIND=4),DIMENSION(1) :: timean, tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout, cfileout2 !: file name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname2 !: array of var22 name for output
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar, typvar2
-
- INTEGER :: ncout, ncout2
- INTEGER :: istatus
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoy_sp ''list_of_ioipsl_model_output_files'' '
- PRINT *,' In this version of cdfmoy, spval are taken into account'
- PRINT *,' (in the standard version they are assumed to be 0 )'
- STOP
- ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',kstatus=istatus)
- IF (istatus /= 0 ) STOP 'depth dimension name not suported'
- ENDIF
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( tab(npiglo,npjglo), tab2(npiglo,npjglo), v2d(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo), rmean2(npiglo,npjglo) )
-
- nvars = getnvar(cfile)
- PRINT *,' nvars =', nvars
-
- ALLOCATE (cvarname(nvars), cvarname2(nvars) ,spval(nvars) )
- ALLOCATE (typvar(nvars), typvar2(nvars) )
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars), id_varout2(nvars) )
-
- cvarname(:)=getvarname(cfile,nvars,typvar)
-
- DO jvar = 1, nvars
- ! variables that will not be computed or stored are named 'none'
- IF (cvarname(jvar) /= 'vozocrtx' .AND. &
- cvarname(jvar) /= 'vomecrty' .AND. &
- cvarname(jvar) /= 'vovecrtz' .AND. &
- cvarname(jvar) /= 'sossheig' ) THEN
- cvarname2(jvar) ='none'
- ELSE
- cvarname2(jvar)=TRIM(cvarname(jvar))//'_sqd'
- typvar2(jvar)%name = TRIM(typvar(jvar)%name)//'_sqd' ! name
- typvar2(jvar)%units = '('//TRIM(typvar(jvar)%units)//')^2' ! unit
- typvar2(jvar)%missing_value = typvar(jvar)%missing_value ! missing_value
- typvar2(jvar)%valid_min = 0. ! valid_min = zero
- typvar2(jvar)%valid_max = typvar(jvar)%valid_max**2 ! valid_max *valid_max
- typvar2(jvar)%long_name =TRIM(typvar(jvar)%long_name)//'_Squared' !
- typvar2(jvar)%short_name = TRIM(typvar(jvar)%short_name)//'_sqd' !
- typvar2(jvar)%online_operation = TRIM(typvar(jvar)%online_operation)
- typvar2(jvar)%axis = TRIM(typvar(jvar)%axis)
-
- END IF
- END DO
-
- id_var(:) = (/(jv, jv=1,nvars)/)
- ! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars)
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
- typvar2(:)%name=cvarname2
- ! get missing_value attribute
- spval(:) = 0.
- DO jvar=1,nvars
- spval(jvar) = getatt( cfile,cvarname(jvar),'missing_value')
- ENDDO
-
- ! create output fileset
- cfileout='cdfmoy.nc'
- cfileout2='cdfmoy2.nc'
- ! create output file taking the sizes in cfile
-
- ncout =create(cfileout, cfile,npiglo,npjglo,npk)
- ncout2=create(cfileout2,cfile,npiglo,npjglo,npk)
-
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- ierr= createvar(ncout2, typvar2, nvars, ipk, id_varout2)
-
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk)
- ierr= putheadervar(ncout2, cfile, npiglo, npjglo, npk)
-
- DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' .OR. &
- cvarname(jvar) == 'none' ) THEN
- ! skip these variable
- ELSE
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar)
- DO jk = 1, ipk(jvar)
- PRINT *,'level ',jk
- tab(:,:) = 0.d0 ; tab2(:,:) = 0.d0 ; total_time = 0.
- DO jt = 1, narg
- IF (jk == 1 .AND. jvar == nvars ) THEN
- tim=getvar1d(cfile,'time_counter',1)
- total_time = total_time + tim(1)
- END IF
- CALL getarg (jt, cfile)
- v2d(:,:)= getvar(cfile, cvarname(jvar), jk ,npiglo, npjglo )
- WHERE(v2d /= spval(jvar) )
- tab(:,:) = tab(:,:) + v2d(:,:)
- ELSEWHERE
- tab(:,:) = spval(jvar)
- END WHERE
- IF (cvarname2(jvar) /= 'none' ) THEN
- WHERE( v2d /= spval(jvar) )
- tab2(:,:) = tab2(:,:) + v2d(:,:)*v2d(:,:)
- ELSEWHERE
- tab2(:,:) = spval(jvar)
- ENDWHERE
- END IF
- END DO
- ! finish with level jk ; compute mean
- WHERE( tab /= spval(jvar) )
- rmean(:,:) = tab(:,:)/narg
- ELSEWHERE
- rmean(:,:) = spval(jvar)
- END WHERE
- IF (cvarname2(jvar) /= 'none' ) THEN
- WHERE (tab2 /= spval(jvar) )
- rmean2(:,:) = tab2(:,:)/narg
- ELSEWHERE
- rmean2(:,:) = spval(jvar)
- END WHERE
- END IF
-
- ! store variable on outputfile
- ierr = putvar(ncout, id_varout(jvar) ,rmean, jk, npiglo, npjglo)
- IF (cvarname2(jvar) /= 'none' ) ierr = putvar(ncout2,id_varout2(jvar),rmean2, jk,npiglo, npjglo)
- IF (jk == 1 .AND. jvar == nvars ) THEN
- timean(1)= total_time/narg
- ierr=putvar1d(ncout,timean,1,'T')
- ierr=putvar1d(ncout2,timean,1,'T')
- END IF
- END DO ! loop to next level
- END IF
- END DO ! loop to next var in file
-
- istatus = closeout(ncout)
- istatus = closeout(ncout2)
-
-
-END PROGRAM cdfmoy_sp
diff --git a/cdfmoy_weighted.f90 b/cdfmoy_weighted.f90
index 4b3f69c..8f2ad22 100644
--- a/cdfmoy_weighted.f90
+++ b/cdfmoy_weighted.f90
@@ -1,76 +1,126 @@
PROGRAM cdfmoy_weighted
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfmoy_weighted ***
+ !!======================================================================
+ !! *** PROGRAM cdfmoy_weighted ***
+ !!=====================================================================
+ !! ** Purpose : Compute weighted mean values from already processed
+ !! mean files (by cdfmoy)
!!
- !! ** Purpose: Compute weighted mean values from monthly mean
- !!
- !! ** Method: monthly mean were computed (cdfmoy) with all dumps that fall within a montn
- !! thus, all month have different weigth : Feb = 5. March, Dec. = 7 other = 6
- !!
- !! history :
- !! Original code : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (Apr 2005 ) put all NCF stuff in module
- !! now valid for grid T U V W icemod
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
+ !! ** Method : The weight of each file is the number of elements used
+ !! when computing the time average.
!!
+ !! History : 2.1 : 11/2009 : J.M. Molines : Original code
+ !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !! function : comments
+ !! setweight : return weight for given variable and file
+ !!----------------------------------------------------------------------
USE cdfio
-
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv !: dummy loop index
- INTEGER :: ierr,idum !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout
- INTEGER, DIMENSION(:), ALLOCATABLE :: iweight
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: tab !: Arrays for cumulated values
- REAL(KIND=8) :: total_time, sumw
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean
- REAL(KIND=4),DIMENSION(1) :: timean, tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout !: file name
- CHARACTER(LEN=256) :: cdep
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cdummy !: array of var name
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar, typvardum
- INTEGER :: ncout
- INTEGER :: istatus
+ INTEGER(KIND=4) :: jk, jt, jvar ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain
+ INTEGER(KIND=4) :: nvars ! number of variables in a file
+ INTEGER(KIND=4) :: ntags ! number of tags to process
+ INTEGER(KIND=4) :: iweight ! variable weight
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! array of input var id's
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! array of output var levels
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! array of output var id's
+
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: v2d ! array to read a layer of data
+ REAL(KIND=4), DIMENSION(1) :: timean, tim ! time counter
+
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dtab ! array for cumulated values
+ REAL(KIND=8) :: dtotal_time, dsumw ! cumulated times and weights
+
+ CHARACTER(LEN=256) :: cf_in ! current input file name
+ CHARACTER(LEN=256) :: cf_out='cdfmoy_weighted.nc' ! output file name
+ CHARACTER(LEN=256) :: cv_dep ! name of depth variable
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for output var attributes
- !!
+ LOGICAL :: lold5d ! flag for old5d output
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line
narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoy_weighted ''list of files'' '
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfmoy_weighted list of files [-old5d ]'
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute weight average of files. The weight for each file is'
+ PRINT *,' read from the iweight attribute. In particular, this attribute'
+ PRINT *,' is set to the number of elements used when computing a time'
+ PRINT *,' average (cdfmoy program). A primary application is thus for'
+ PRINT *,' computing annual mean from monthly means.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' The list of files to be averaged, which are supposed to be of'
+ PRINT *,' the same type and to contain the same variables. This list MUST'
+ PRINT *,' be given before any options'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-old5d ] : This option is used to mimic/replace the cdfmoy_annual'
+ PRINT *,' which is no longer available. With this option, 12 monthly'
+ PRINT *,' files must be given, and it is assumed that the monthly'
+ PRINT *,' means were computed from 5d output of a simulation using'
+ PRINT *,' a noleap calendar ( weights are fixed, predetermined)'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : same as in the input files'
STOP
ENDIF
- ALLOCATE (iweight(narg) ) ! as maby weights as files
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
-
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- npk = getdim (cfile,'nav_lev',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- npk = getdim (cfile,'levels',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
+
+ ! scan command line and check if files exist
+ ijarg = 1
+ ntags = narg
+ DO WHILE ( ijarg <= narg )
+ CALL getarg ( ijarg, cldum ) ; ijarg = ijarg +1
+ SELECT CASE ( cldum )
+ CASE ( '-old5d' )
+ lold5d = .TRUE.
+ ntags = ntags - 1
+ CASE DEFAULT
+ cf_in = cldum
+ IF ( chkfile (cldum ) ) STOP ! missing file
+ END SELECT
+ ENDDO
+
+ ! additional check in case of old_5d averaged files
+ IF ( lold5d ) THEN
+ IF ( ntags /= 12 ) THEN
+ PRINT *,' ERROR : exactly 12 monthly files are required for -old5d option'
+ STOP
+ ENDIF
+ ENDIF
+
+ npiglo = getdim (cf_in, cn_x )
+ npjglo = getdim (cf_in, cn_y )
+ npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr )
+
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'z',cdtrue=cv_dep, kstatus=ierr )
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in,'nav_lev',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in,'levels',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
PRINT *,' assume file with no depth'
npk=0
ENDIF
@@ -79,80 +129,96 @@ PROGRAM cdfmoy_weighted
ENDIF
ENDIF
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
- ALLOCATE( tab(npiglo,npjglo), v2d(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo) )
+ ALLOCATE( dtab(npiglo,npjglo), v2d(npiglo,npjglo) )
- nvars = getnvar(cfile)
+ nvars = getnvar(cf_in)
PRINT *,' nvars =', nvars
- ALLOCATE (cvarname(nvars),cdummy(nvars) )
- ALLOCATE (typvar(nvars), typvardum(nvars) )
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars) )
+ ALLOCATE (cv_names(nvars) )
+ ALLOCATE (stypvar(nvars) )
+ ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars) )
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ ! get list of variable names and collect attributes in stypvar (optional)
+ cv_names(:) = getvarname(cf_in, nvars, stypvar)
+ id_var(:) = (/(jvar, jvar=1,nvars)/)
- id_var(:) = (/(jv, jv=1,nvars)/)
! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
+ ipk(:) = getipk(cf_in, nvars, cdep=cv_dep)
+ WHERE( ipk == 0 ) cv_names='none'
+ stypvar(:)%cname = cv_names
- ! create output fileset
- cfileout='cdfmoy_weighted.nc'
- ! create output file taking the sizes in cfile
-
- ncout =create(cfileout, cfile,npiglo,npjglo,npk,cdep=cdep)
-
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
-
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk,cdep=cdep)
+ ! create output file taking the sizes in cf_in
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep )
+ ierr = createvar (ncout , stypvar, nvars, ipk, id_varout )
+ ierr = putheadervar(ncout , cf_in, npiglo, npjglo, npk, cdep=cv_dep )
DO jvar = 1,nvars
- ! fill iweight for each variables: need to scan all the input files
- DO jt=1,narg ! this is far from optimal : think about a special function
- ! for retrieving an attribute of a variable
- CALL getarg(jt,cfile)
- cdummy(:)=getvarname(cfile,nvars,typvardum)
- iweight(jt)=typvardum(jvar)%iwght
- ENDDO
- PRINT *, iweight
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' ) THEN
+ IF ( cv_names(jvar) == cn_vlon2d .OR. &
+ cv_names(jvar) == cn_vlat2d ) THEN
! skip these variable
ELSE
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar)
+ PRINT *,' Working with ', TRIM(cv_names(jvar)), ipk(jvar)
DO jk = 1, ipk(jvar)
- PRINT *,'level ',jk
- tab(:,:) = 0.d0 ; total_time = 0. ; sumw=0.
- DO jt = 1, narg
- sumw = sumw + iweight(jt)
+ PRINT *,'Level ',jk
+ dtab(:,:) = 0.d0 ; dtotal_time = 0.d0 ; dsumw=0.d0
+
+ DO jt = 1, ntags
+ CALL getarg (jt, cf_in)
+
+ iweight = setweight(cf_in, jt, cv_names(jvar))
+ dsumw = dsumw + iweight
+ v2d(:,:) = getvar(cf_in, cv_names(jvar), jk ,npiglo, npjglo )
+ dtab(:,:) = dtab(:,:) + iweight * v2d(:,:)
+
IF (jk == 1 .AND. jvar == nvars ) THEN
- tim=getvar1d(cfile,'time_counter',1)
- total_time = total_time + tim(1)
+ tim = getvar1d(cf_in, cn_vtimec, 1 )
+ dtotal_time = dtotal_time + tim(1)
END IF
- CALL getarg (jt, cfile)
- v2d(:,:)= getvar(cfile, cvarname(jvar), jk ,npiglo, npjglo )
- tab(:,:) = tab(:,:) + iweight(jt)* v2d(:,:)
END DO
+
! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = tab(:,:)/sumw
! store variable on outputfile
- ierr = putvar(ncout, id_varout(jvar) ,rmean, jk, npiglo, npjglo,kwght=INT(sumw) )
+ ierr = putvar(ncout, id_varout(jvar), SNGL(dtab(:,:)/dsumw), jk, npiglo, npjglo, kwght=INT(dsumw) )
IF (jk == 1 .AND. jvar == nvars ) THEN
- timean(1)= total_time/narg
- ierr=putvar1d(ncout,timean,1,'T')
+ timean(1) = dtotal_time/ntags
+ ierr = putvar1d(ncout, timean, 1, 'T')
END IF
END DO ! loop to next level
END IF
END DO ! loop to next var in file
- istatus = closeout(ncout)
-
+ ierr = closeout(ncout)
+
+ CONTAINS
+
+ INTEGER(KIND=4) FUNCTION setweight( cdfile, kt, cdvar )
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION setweight ***
+ !!
+ !! ** Purpose : Return the weight of cdvar in cdfile
+ !!
+ !! ** Method : Get attribute iweight from cdfvar in cdfile.
+ !! If lold5d is true, assume weight for 5d build monthly
+ !! means. If iweight not found 1 is return.
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfile
+ INTEGER(KIND=4), INTENT(in) :: kt
+ CHARACTER(LEN=*), INTENT(in) :: cdvar
+
+ INTEGER(KIND=4), DIMENSION(12) :: iweight5d=(/6,5,7,6,6,6,6,6,6,6,6,7/)
+ !!----------------------------------------------------------------------
+ IF ( lold5d ) THEN
+ setweight = iweight5d(kt)
+ ELSE
+ setweight = getatt( cdfile, cdvar, 'iweight')
+ IF ( setweight == 0 ) setweight = 1
+ ENDIF
+
+ END FUNCTION setweight
END PROGRAM cdfmoy_weighted
diff --git a/cdfmoyt.f90 b/cdfmoyt.f90
index 993bb0b..d47870c 100644
--- a/cdfmoyt.f90
+++ b/cdfmoyt.f90
@@ -1,196 +1,300 @@
PROGRAM cdfmoyt
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfmoyt ***
+ !!======================================================================
+ !! *** PROGRAM cdfmoyt ***
+ !!=====================================================================
+ !! ** Purpose : Compute mean values for all the variables in a bunch
+ !! of cdf files given as arguments.
+ !! Store the results on a 'similar' cdf file. This version
+ !! differ from cdfmoy, because if the input files have many
+ !! time frames in it, the output file will have the same
+ !! number of time frames, each being the average accross the
+ !! input files.
!!
- !! ** Purpose: Compute mean values for all the variables in a bunch
- !! of cdf files given as argument
- !! Store the results on a 'similar' cdf file.
- !! For a given file no mean values are computed from various time
- !! frames in a file. FOr instance, for 12 month data files,
- !! cdfmoyt will produce a 12 month mean file, each month in the resulting file
- !! being the mean value for this given month
- !!
- !! ** Method: Try to avoid 3 d arrays
- !!
- !! history :
- !! Original code : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (Apr 2005 ) put all NCF stuff in module
- !! now valid for grid T U V W icemod
- !! Modified : P. Mathiot (June 2007) update for forcing fields
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
+ !! ** Method : Also store the mean squared values for the nn_sqdvar
+ !! variables belonging to cn_sqdvar(:), than can be changed
+ !! in the nam_cdf_names namelist if wished.
!!
+ !! History : 2.0 : 11/2004 : J.M. Molines : Original code
+ !! : 2.1 : 06/2007 : P. Mathiot : Modif for forcing fields
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! varchk2 : check if variable is candidate for square mean
+ !!----------------------------------------------------------------------
USE cdfio
-
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!-----------------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv , jtt,jkk , jrec !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout,&
- & id_varout2
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: tab, tab2 !: Arrays for cumulated values
- REAL(KIND=8) , DIMENSION (:) , ALLOCATABLE :: total_time
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean, rmean2
- REAL(KIND=4),DIMENSION(:),ALLOCATABLE :: timean
- REAL(KIND=4),DIMENSION(:),ALLOCATABLE :: tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout, cfileout2 !: file name
- CHARACTER(LEN=256) :: cdep
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname2 !: array of var22 name for output
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar, typvar2
-
- INTEGER :: ncout, ncout2
- INTEGER :: istatus
- LOGICAL :: lcaltmean
- !!
+ INTEGER(KIND=4) :: jk, jfil, jrec ! dummy loop index
+ INTEGER(KIND=4) :: jvar, jv, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: inpt ! working integer
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! browsing command line
+ INTEGER(KIND=4) :: nfil ! number of files to average
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvars ! number of variables in a file
+ INTEGER(KIND=4) :: ntframe ! cumul of time frame
+ INTEGER(KIND=4) :: ncout, ncout2 ! ncid of output files
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of vertical level for each var
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! varid's of average vars
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout2 ! varid's of sqd average vars
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! array to read a layer of data
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zspval_in ! input missing value
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtab, dtab2 ! arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dtotal_time ! to compute mean time
+
+ CHARACTER(LEN=256) :: cf_in ! input file names
+ CHARACTER(LEN=256) :: cf_out = 'cdfmoy.nc' ! output file for average
+ CHARACTER(LEN=256) :: cf_out2 = 'cdfmoy2.nc' ! output file for squared average
+ CHARACTER(LEN=256) :: cv_dep ! depth dimension name
+ CHARACTER(LEN=256) :: cldum ! dummy string argument
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cf_list ! list of input files
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nam ! array of var name
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nam2 ! array of var2 name for output
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! attributes for average values
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar2 ! attributes for square averaged values
+
+ LOGICAL :: lspval0 = .FALSE. ! cdfmoy_chsp flag
+ !!----------------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmoyt ''list_of_ioipsl_model_output_files'' '
+ PRINT *,' usage : cdfmoyt list_of_model_files [-spval0] '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the time average of a list of files given as arguments.'
+ PRINT *,' This program handle multi time-frame files is such a way that'
+ PRINT *,' the output files are also multi time-frame, each frame being'
+ PRINT *,' the average across the files given in the list.'
+ PRINT *,' '
+ PRINT *,' The program assume that all files in the list are of same'
+ PRINT *,' type (shape, variables , and number of time frames ). '
+ PRINT *,' For some variables, the program also compute the time average '
+ PRINT *,' of the squared variables, which is used in other cdftools '
+ PRINT *,' (cdfeke, cdfrmsssh, cdfstdevw, cdfstddevts ... The actual variables'
+ PRINT *,' selected for squared average are :'
+ PRINT '(10x,"- ",a)' , (TRIM(cn_sqdvar(jv)), jv=1, nn_sqdvar)
+ PRINT *,' This selection can be adapted with the nam_cdf_namelist process.'
+ PRINT *,' (See cdfnamelist -i for details).'
+ PRINT *,' If you want to compute the average of already averaged files,'
+ PRINT *,' consider using cdfmoy_weighted instead, in order to take into'
+ PRINT *,' account a particular weight for each file in the list.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' A list of similar model output files. '
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ -spval0 ] : set missing_value attribute to 0 for all output'
+ PRINT *,' variables and take care of the input missing_value.'
+ PRINT *,' This option is usefull if missing_values differ from files '
+ PRINT *,' to files; it was formely done by cdfmoy_chsp).'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none '
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out),' and ',TRIM(cf_out2)
+ PRINT *,' variables : are the same than in the input files. For squared averages'
+ PRINT *,' _sqd is append to the original variable name.'
STOP
ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
- nt = getdim (cfile,'time_counter')
-
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- PRINT *,' assume file with no depth'
- npk=0
+
+ ALLOCATE ( cf_list(narg) )
+ ! look for -spval0 option and set up cf_list, nfil
+ ijarg = 1
+ nfil = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-spval0' ) ! option to reset spval to 0 in the output files
+ lspval0 = .TRUE.
+ CASE DEFAULT ! then the argument is a file
+ nfil = nfil + 1
+ cf_list(nfil) = TRIM(cldum)
+ END SELECT
+ END DO
+ ! Initialisation from 1rst file (all file are assume to have the same geometry)
+ ! time counter can be different for each file in the list. It is read in the
+ ! loop for files
+
+ IF ( chkfile (cf_list(1)) ) STOP ! missing file
+
+ npiglo = getdim (cf_in,cn_x)
+ npjglo = getdim (cf_in,cn_y)
+ npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr)
+ npt = getdim (cf_in,cn_t)
+
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in,'nav_lev',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in,'levels',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ PRINT *,' assume file with no depth'
+ npk=0
+ ENDIF
+ ENDIF
ENDIF
ENDIF
ENDIF
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ ! check that all files have the same number of time frames
+ ierr = 0
+ DO jfil = 1, nfil
+ IF ( chkfile (cf_list(jfil) ) ) STOP ! missing file
+ inpt = getdim (cf_list(jfil), cn_t)
+ IF ( inpt /= npt ) THEN
+ PRINT *, 'File ',TRIM(cf_list(jfil) ),' has ',inpt,' time frames instead of ', npt
+ ierr = ierr + 1
+ ENDIF
+ ENDDO
+ IF ( ierr /= 0 ) STOP ! frame numbers mismatch
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
- ALLOCATE( tab(npiglo,npjglo), tab2(npiglo,npjglo), v2d(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo), rmean2(npiglo,npjglo) )
- ALLOCATE ( total_time(nt) ,timean(nt), tim(nt) )
+ ALLOCATE( dtab(npiglo,npjglo), dtab2(npiglo,npjglo), v2d(npiglo,npjglo) )
+ ALLOCATE( dtotal_time(npt), tim(npt) )
- nvars = getnvar(cfile)
- PRINT *,' nvars =', nvars
+ nvars = getnvar(cf_in)
+ PRINT *,' nvars = ', nvars
- ALLOCATE (cvarname(nvars), cvarname2(nvars) )
- ALLOCATE (typvar(nvars), typvar2(nvars) )
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars), id_varout2(nvars) )
+ ALLOCATE (cv_nam(nvars), cv_nam2(nvars) )
+ ALLOCATE (stypvar(nvars), stypvar2(nvars) )
+ ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars), id_varout2(nvars) )
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ ! get list of variable names and collect attributes in stypvar (optional)
+ cv_nam(:) = getvarname(cf_in,nvars, stypvar)
+
+ IF ( lspval0 ) THEN
+ ALLOCATE ( zspval_in(nvars) )
+ zspval_in(:) = stypvar(:)%rmissing_value
+ stypvar(:)%rmissing_value = 0.
+ ENDIF
DO jvar = 1, nvars
! variables that will not be computed or stored are named 'none'
- IF (cvarname(jvar) /= 'vozocrtx' .AND. &
- cvarname(jvar) /= 'vomecrty' .AND. &
- cvarname(jvar) /= 'vovecrtz' .AND. &
- cvarname(jvar) /= 'sossheig' .AND. &
- cvarname(jvar) /= 'sst' ) THEN
- cvarname2(jvar) ='none'
+ IF ( varchk2 ( cv_nam(jvar) ) ) THEN
+ cv_nam2(jvar) = TRIM(cv_nam(jvar))//'_sqd'
+ stypvar2(jvar)%cname = TRIM(stypvar(jvar)%cname)//'_sqd' ! name
+ stypvar2(jvar)%cunits = '('//TRIM(stypvar(jvar)%cunits)//')^2' ! unit
+ stypvar2(jvar)%rmissing_value = stypvar(jvar)%rmissing_value ! missing_value
+ stypvar2(jvar)%valid_min = 0. ! valid_min = zero
+ stypvar2(jvar)%valid_max = stypvar(jvar)%valid_max**2 ! valid_max *valid_max
+ stypvar2(jvar)%scale_factor = 1.
+ stypvar2(jvar)%add_offset = 0.
+ stypvar2(jvar)%savelog10 = 0.
+ stypvar2(jvar)%clong_name = TRIM(stypvar(jvar)%clong_name)//'_Squared' !
+ stypvar2(jvar)%cshort_name = TRIM(stypvar(jvar)%cshort_name)//'_sqd' !
+ stypvar2(jvar)%conline_operation = TRIM(stypvar(jvar)%conline_operation)
+ stypvar2(jvar)%caxis = TRIM(stypvar(jvar)%caxis)
ELSE
- cvarname2(jvar)=TRIM(cvarname(jvar))//'_sqd'
- typvar2(jvar)%name = TRIM(typvar(jvar)%name)//'_sqd' ! name
- typvar2(jvar)%units = '('//TRIM(typvar(jvar)%units)//')^2' ! unit
- typvar2(jvar)%missing_value = typvar(jvar)%missing_value ! missing_value
- typvar2(jvar)%valid_min = 0. ! valid_min = zero
- typvar2(jvar)%valid_max = typvar(jvar)%valid_max**2 ! valid_max *valid_max
- typvar2(jvar)%scale_factor= 1.
- typvar2(jvar)%add_offset= 0.
- typvar2(jvar)%savelog10= 0.
- typvar2(jvar)%long_name =TRIM(typvar(jvar)%long_name)//'_Squared' !
- typvar2(jvar)%short_name = TRIM(typvar(jvar)%short_name)//'_sqd' !
- typvar2(jvar)%online_operation = TRIM(typvar(jvar)%online_operation)
- typvar2(jvar)%axis = TRIM(typvar(jvar)%axis)
-
+ cv_nam2(jvar) = 'none'
END IF
END DO
id_var(:) = (/(jv, jv=1,nvars)/)
! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
- typvar2(:)%name=cvarname2
-
- ! create output fileset
- cfileout='cdfmoy.nc'
- cfileout2='cdfmoy2.nc'
- ! create output file taking the sizes in cfile
-
- ncout =create(cfileout, cfile,npiglo,npjglo,npk,cdep=cdep)
- ncout2=create(cfileout2,cfile,npiglo,npjglo,npk,cdep=cdep)
-
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- ierr= createvar(ncout2, typvar2, nvars, ipk, id_varout2)
-
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk,cdep=cdep)
- ierr= putheadervar(ncout2, cfile, npiglo, npjglo, npk,cdep=cdep)
-
- total_time = 0.
- DO jrec = 1, nt
- lcaltmean=.TRUE.
- DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' ) THEN
- ! skip these variable
- ELSE
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar)
- DO jk = 1, ipk(jvar)
- PRINT *,'JREC=', jrec, 'level ',jk
- tab(:,:) = 0.d0 ; tab2(:,:) = 0.d0
- DO jt = 1, narg
- CALL getarg (jt, cfile)
- IF ( lcaltmean ) THEN
- tim=getvar1d(cfile,'time_counter',nt)
- total_time(jrec) = total_time(jrec) + tim(jrec)
- END IF
- jkk=jk
- ! If forcing fields is without depth dimension
-! IF (npk==0) jkk=jrec
- v2d(:,:)= getvar(cfile, cvarname(jvar), jkk ,npiglo, npjglo,ktime=jrec )
- tab(:,:) = tab(:,:) + v2d(:,:)
- IF (cvarname2(jvar) /= 'none' ) tab2(:,:) = tab2(:,:) + v2d(:,:)*v2d(:,:)
- END DO
- ! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = tab(:,:)/narg
- IF (cvarname2(jvar) /= 'none' ) rmean2(:,:) = tab2(:,:)/narg
- ! store variable on outputfile
- ierr = putvar(ncout, id_varout(jvar) ,rmean, jkk, npiglo, npjglo,ktime=jrec)
- IF (cvarname2(jvar) /= 'none' ) ierr = putvar(ncout2,id_varout2(jvar),rmean2, jkk,npiglo, npjglo,ktime=jrec)
- IF (lcaltmean ) THEN
- timean(jrec)= total_time(jrec)/narg
- END IF
- lcaltmean=.FALSE. ! tmean already computed
- END DO ! loop to next level
- END IF
- END DO ! loop to next var in file
+ ipk(:) = getipk (cf_in,nvars,cdep=cv_dep)
+ WHERE( ipk == 0 ) cv_nam='none'
+ stypvar( :)%cname = cv_nam
+ stypvar2(:)%cname = cv_nam2
+
+ ! create output file taking the sizes in cf_in
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep)
+ ierr = createvar (ncout , stypvar, nvars, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk, cdep=cv_dep)
+
+ ncout2 = create (cf_out2, cf_in, npiglo, npjglo, npk, cdep=cv_dep)
+ ierr = createvar (ncout2, stypvar2, nvars, ipk, id_varout2 )
+ ierr = putheadervar(ncout2, cf_in, npiglo, npjglo, npk, cdep=cv_dep)
+
+ ! Compute the mean time for each mean frame
+ dtotal_time(:) = 0.d0
+ DO jfil = 1, nfil
+ cf_in = cf_list(jfil)
+ tim(:) = getvar1d(cf_in, cn_vtimec, npt)
+ dtotal_time(:) = dtotal_time(:) + tim (:)
END DO
- ierr=putvar1d(ncout,timean,nt,'T')
- ierr=putvar1d(ncout2,timean,nt,'T')
+ tim(:) = dtotal_time(:)/ nfil
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = putvar1d(ncout2, tim, npt, 'T')
+
+ DO jrec = 1, npt
+
+ DO jvar = 1,nvars
+ IF ( cv_nam(jvar) == cn_vlon2d .OR. & ! nav_lon
+ cv_nam(jvar) == cn_vlat2d ) THEN ! nav_lat
+ ! skip these variable
+ ELSE
+ PRINT *,' Working with ', TRIM(cv_nam(jvar)), ipk(jvar)
+ DO jk = 1, ipk(jvar)
+ PRINT *,'level ',jk
+ dtab(:,:) = 0.d0 ; dtab2(:,:) = 0.d0
+ ntframe = 0
+ DO jfil = 1, nfil
+ cf_in = cf_list(jfil)
+ v2d(:,:) = getvar(cf_in, cv_nam(jvar), jk, npiglo, npjglo, ktime=jrec )
+ IF ( lspval0 ) WHERE (v2d == zspval_in(jvar)) v2d = 0. ! change missing values to 0
+ dtab(:,:) = dtab(:,:) + v2d(:,:)
+ IF (cv_nam2(jvar) /= 'none' ) dtab2(:,:) = dtab2(:,:) + v2d(:,:)*v2d(:,:)
+ END DO
+
+ ! store variable on outputfile
+ ierr = putvar(ncout, id_varout(jvar), SNGL(dtab(:,:)/nfil), jk, npiglo, npjglo, kwght=nfil, ktime = jrec )
+ IF (cv_nam2(jvar) /= 'none' ) THEN
+ ierr = putvar(ncout2, id_varout2(jvar), SNGL(dtab2(:,:)/nfil), jk, npiglo, npjglo, kwght=nfil, ktime=jrec)
+ ENDIF
+
+ END DO ! loop to next level
+ END IF
+ END DO ! loop to next var in file
+ END DO ! loop to next record in input file
+
+ ierr = closeout(ncout)
+ ierr = closeout(ncout2)
+
+CONTAINS
+
+ LOGICAL FUNCTION varchk2 ( cd_var )
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION varchk2 ***
+ !!
+ !! ** Purpose : Return true if cd_var is candidate for mean squared value
+ !!
+ !! ** Method : List of candidate is established in modcdfnames, and
+ !! can be changed via the nam_cdf_names namelist
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cd_var
- istatus = closeout(ncout)
- istatus = closeout(ncout2)
+ INTEGER(KIND=4) :: jv
+ !!----------------------------------------------------------------------
+ varchk2 = .FALSE.
+ DO jv = 1, nn_sqdvar
+ IF ( cd_var == cn_sqdvar(jv) ) THEN
+ varchk2 = .TRUE.
+ EXIT
+ ENDIF
+ ENDDO
+ END FUNCTION varchk2
END PROGRAM cdfmoyt
diff --git a/cdfmoyuv.f90 b/cdfmoyuv.f90
deleted file mode 100644
index 52c367a..0000000
--- a/cdfmoyuv.f90
+++ /dev/null
@@ -1,193 +0,0 @@
-PROGRAM cdfmoyuv
- !!---------------------------------------------------------------------------
- !! *** PROGRAM cdfbti ***
- !!
- !! ** Purpose: Compute the temporal mean of u,v,u2,v2 and uv on the T point
- !! Useful for the programm cdfbti which compute the transfert of
- !! barotropic instability energy
- !!
- !! history :
- !! Original : A. Melet (Feb 2008)
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: ji,jj,jk, jt, ntframe, total_time, ilev
- INTEGER :: npiglo, npjglo, npk, nt, ntags
- INTEGER :: imin, imax, jmin, jmax, npil, npjl
- INTEGER :: narg, iargc, ncout, ierr
- INTEGER, DIMENSION(5) :: ipk, id_varout !
-
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: u2d, v2d, uvn
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: un, vn, u2n, v2n
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: umask, vmask
- REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: tabu, tabv, tabu2, tabv2, tabuv
- REAL(KIND=4) ,DIMENSION(1) :: tim
-
- CHARACTER(LEN=256) :: cfileu, cfilev, cvaru, cvarv, config , ctag
- CHARACTER(LEN=256) :: cfileout='moyuv.nc', cdum
-
- TYPE (variable), DIMENSION(5) :: typvar !: structure for attibutes
-
- !!
- narg = iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' USAGE : cdfmoyuv config imin imax jmin jmax ''list_of_tags'' '
- PRINT *,' Produce a cdf file moyuv.nc with uvbar variable on T point'
- PRINT *,' and ubar, u2bar on U point, and vbar, v2bar on V point '
- PRINT *,' for the region defined by imin imax jmin jmax'
- PRINT *,' '
- STOP
- ENDIF
-
- ntags = narg - 5 ! first five arguments are not tags
- !! Initialisation from 1st file (all file are assume to have the same
- !geometry)
- CALL getarg (1, config)
- CALL getarg (2, cdum) ; READ(cdum,*) imin
- CALL getarg (3, cdum) ; READ(cdum,*) imax
- CALL getarg (4, cdum) ; READ(cdum,*) jmin
- CALL getarg (5, cdum) ; READ(cdum,*) jmax
- CALL getarg (6, ctag)
- WRITE(cfileu,'(a,"_",a,"_gridU.nc")') TRIM(config),TRIM(ctag)
-
- PRINT *,TRIM(cfileu)
- npiglo = getdim (cfileu,'x')
- npjglo = getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
- nt = getdim(cfileu,'time_counter')
-
- IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF
- IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF
-
- ! define new variables for output ( must update att.txt)
-
- typvar(1)%name='ubar'
- typvar(1)%long_name='temporal mean of u on U point'
- typvar(1)%short_name='ubar'
-
- typvar(2)%name='vbar'
- typvar(2)%long_name='temporal mean of v on V point'
- typvar(2)%short_name='vbar'
-
- typvar(3)%name='u2bar'
- typvar(3)%long_name='temporal mean of u * u on U point'
- typvar(3)%short_name='u2bar'
-
- typvar(4)%name='v2bar'
- typvar(4)%long_name='temporal mean of v * v on V point'
- typvar(4)%short_name='v2bar'
-
- typvar(5)%name='uvbar'
- typvar(5)%long_name='temporal mean of u * v on T point'
- typvar(5)%short_name='uvbar'
-
- typvar%units='m2.s-2'
- typvar%missing_value=0.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar%online_operation='N/A'
- typvar%axis='TYX'
-
- ipk(1) = npk
- ipk(2) = npk
- ipk(3) = npk
- ipk(4) = npk
- ipk(5) = npk
-
- PRINT *, 'npiglo =',npiglo
- PRINT *, 'npjglo =',npjglo
- PRINT *, 'npk =',npk
- PRINT *, 'nt =',nt
-
- !test if lev exists
- IF ((npk==0) .AND. (ilev .GT. 0) ) THEN
- PRINT *, 'Problem : npk = 0 and lev > 0 STOP'
- STOP
- END IF
-
- ! create output fileset
- ncout =create(cfileout, cfileu, npiglo,npjglo,npk)
- ierr= createvar(ncout ,typvar,5, ipk,id_varout )
- ierr= putheadervar(ncout, cfileu, npiglo, npjglo,npk)
-
- ! Allocate the memory
- ALLOCATE ( u2d(npiglo,npjglo) , v2d(npiglo,npjglo) )
- ALLOCATE ( un(npiglo,npjglo) , tabu(npiglo,npjglo) )
- ALLOCATE ( vn(npiglo,npjglo) , tabv(npiglo,npjglo) )
- ALLOCATE ( u2n(npiglo,npjglo) , tabu2(npiglo,npjglo) )
- ALLOCATE ( v2n(npiglo,npjglo) , tabv2(npiglo,npjglo) )
- ALLOCATE ( uvn(npiglo,npjglo) , tabuv(npiglo,npjglo) )
- ALLOCATE ( umask(npiglo,npjglo) , vmask(npiglo,npjglo) )
-
- DO jk=1, npk
- PRINT *,' level ',jk
- total_time = 0.; ntframe=0
- tabu(:,:) = 0.d0 ; tabv(:,:) = 0.d0 ; tabuv(:,:) = 0.d0
- tabu2(:,:) = 0.d0 ; tabv2(:,:) = 0.d0
- tim=getvar1d(cfileu,'time_counter',nt)
- total_time = total_time + SUM(tim(1:nt) )
- un(:,:) = 0.d0
- vn(:,:) = 0.d0
- u2n(:,:) = 0.d0
- v2n(:,:) = 0.d0
- uvn(:,:) = 0.d0
-
- DO jt= 6, narg
- ntframe=ntframe+1
- CALL getarg (jt, ctag)
- WRITE(cfileu,'(a,"_",a,"_gridU.nc")') TRIM(config),TRIM(ctag)
- WRITE(cfilev,'(a,"_",a,"_gridV.nc")') TRIM(config),TRIM(ctag)
-
- u2d(:,:)= getvar(cfileu, 'vozocrtx', jk , &
- & npiglo, npjglo, kimin=imin, kjmin=jmin, ktime=1 )
- v2d(:,:)= getvar(cfilev, 'vomecrty', jk , &
- & npiglo, npjglo, kimin=imin, kjmin=jmin, ktime=1 )
-
- tabu(:,:) = tabu(:,:) + u2d(:,:)
- tabu2(:,:) = tabu2(:,:) + u2d(:,:) * u2d(:,:)
- tabv(:,:) = tabv(:,:) + v2d(:,:)
- tabv2(:,:) = tabv2(:,:) + v2d(:,:) * v2d(:,:)
-
- DO jj = jmin+1, npjglo
- DO ji = imin+1, npiglo
- umask(ji,jj)=0.
- umask(ji,jj)=u2d(ji,jj)*u2d(ji-1,jj)
- vmask(ji,jj)=0.
- vmask(ji,jj)=v2d(ji,jj)*v2d(ji,jj-1)
- IF (umask(ji,jj) /= 0.) umask(ji,jj)=1.
- IF (vmask(ji,jj) /= 0.) vmask(ji,jj)=1.
-
- tabuv(ji-imin,jj-jmin) = tabuv(ji-imin,jj-jmin) &
- & + 0.5 * umask(ji,jj) * (u2d(ji,jj)+u2d(ji-1,jj)) &
- & * 0.5 * vmask(ji,jj) * (v2d(ji,jj)+v2d(ji,jj-1))
- END DO
- END DO
- END DO
- un(:,:) = tabu(:,:) / ntframe
- vn(:,:) = tabv(:,:) / ntframe
- u2n(:,:) = tabu2(:,:) / ntframe
- v2n(:,:) = tabv2(:,:) / ntframe
- uvn(:,:) = tabuv(:,:) / ntframe
- ! sauvegarde
- ierr = putvar(ncout, id_varout(1) ,un, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(2) ,vn, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(3) ,u2n, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(4) ,v2n, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(5) ,uvn, jk, npiglo, npjglo, &
- & ktime=1)
- END DO
- ierr = closeout(ncout)
-
-END PROGRAM cdfmoyuv
-
diff --git a/cdfmoyuvwt.f90 b/cdfmoyuvwt.f90
index 0bb5865..aee88ff 100644
--- a/cdfmoyuvwt.f90
+++ b/cdfmoyuvwt.f90
@@ -1,326 +1,346 @@
PROGRAM cdfmoyuvwt
- !!---------------------------------------------------------------------------
- !! *** PROGRAM cdfbti ***
+ !!======================================================================
+ !! *** PROGRAM cdfmoyuvwt ***
+ !!=====================================================================
+ !! ** Purpose : Compute mean values of some quantities, required for
+ !! other cdftools ( cdfbci, cdfbti and cdfnrjcomp).
+ !! At U point : ubar, u2bar
+ !! At V point : vbar, v2bar
+ !! At W point : wbar
+ !! AT T point : tbar, t2bar, uvbar, utbar, vtbar, wtbar
!!
- !! ** Purpose: Compute the temporal mean of u,v,u2,v2 and uv on the T point
- !! Useful for the programm cdfbti which compute the transfert of
- !! barotropic instability energy
+ !! ** Method : take care of double precision on product
!!
- !! history :
- !! Original : A. Melet (Feb 2008)
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 02/2008 : A. Melet : Original code
+ !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, jt, ntframe, ilev
- INTEGER :: npiglo, npjglo, npk, nt, ntags
- INTEGER :: imin, imax, jmin, jmax, npil, npjl
- INTEGER :: narg, iargc, ncout, ierr
- INTEGER, DIMENSION(11) :: ipk, id_varout !
-
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: u2d, v2d
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: w2d, t2d
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: wxz, txz
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: un, vn, u2n, v2n, uvn
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: wn, tn, utn, vtn, t2n
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: wtn, zzz
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: umask, vmask, tmask, wmask
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: t1mask, w1mask
- REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: tabu, tabv, tabu2, tabv2, tabuv
- REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: tabw, tabt, tabut, tabvt, tabt2
- REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: tabwt
- REAL(KIND=4) ,DIMENSION(1) :: tim
- REAL(kind=4), DIMENSION(:,:,:), ALLOCATABLE :: wtab
- REAL(KIND=8) :: total_time
-
- CHARACTER(LEN=256) :: cfileu, cfilev, cvaru, cvarv, config , ctag
- CHARACTER(LEN=256) :: cfilew, cfilet, cavarw, cvart
- CHARACTER(LEN=256) :: cfileout='moyuvwt.nc', cdum
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: ctabtag
-
- TYPE (variable), DIMENSION(11) :: typvar !: structure for attibutes
+ INTEGER(KIND=4), PARAMETER :: jp_var = 11
+ INTEGER(KIND=4) :: ji, jj, jk, jt, jtt
+ INTEGER(KIND=4) :: ntframe
+ INTEGER(KIND=4) :: npiglo, npjglo
+ INTEGER(KIND=4) :: npk, npt, ntags
+ INTEGER(KIND=4) :: iimin, iimax, ijmin, ijmax
+ INTEGER(KIND=4) :: iup=1, idwn=2
+ INTEGER(KIND=4) :: narg, iargc, ijarg
+ INTEGER(KIND=4) :: ncout
+ INTEGER(KIND=4) :: ierr
+ INTEGER(KIND=4), DIMENSION(jp_var) :: ipk, id_varout !
+
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: w2d
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: u2d, v2d, t2d
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtabu, dtabv, dtabu2, dtabv2, dtabuv
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtabw, dtabt, dtabut, dtabvt, dtabt2
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtabwt
+ REAL(KIND=8) :: dcoef
+ REAL(KIND=8) :: dtotal_time
+
+ CHARACTER(LEN=256) :: cf_ufil, cf_vfil
+ CHARACTER(LEN=256) :: cf_wfil, cf_tfil
+ CHARACTER(LEN=256) :: cf_out='moyuvwt.nc'
+ CHARACTER(LEN=256) :: cldum
+ CHARACTER(LEN=256) :: config , ctag
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: ctabtag
+
+ TYPE (variable), DIMENSION(jp_var) :: stypvar ! structure for attibutes
+
+ LOGICAL :: llnam_nemo = .FALSE.
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
!!
narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' USAGE : cdfmoyuv config imin imax jmin jmax ''list_of_tags'' '
- PRINT *,' Produce a cdf file moyuv.nc with uvbar variable on T point'
- PRINT *,' and ubar, u2bar on U point, and vbar, v2bar on V point '
- PRINT *,' for the region defined by imin imax jmin jmax'
- PRINT *,' '
+ PRINT *,' usage : cdfmoyuv CONFCASE [-zoom imin imax jmin jmax ] ''list of tags'' '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute temporal mean fields for velocity components (u,v,w) and'
+ PRINT *,' temperature (t), as well as second order moments ( u2, v2, t2, uv, ut,'
+ PRINT *,' vt, wt).'
+ PRINT *,' These fields are required in other cdftools which computes either '
+ PRINT *,' barotropic (cdfbti) or baroclinic (cdfbci) instabilities, and a global'
+ PRINT *,' energy balance (cdfnrjcomp)'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' CONFCASE : the root name for the data files. Grid files are assumed to'
+ PRINT *,' be gridT, gridU, gridV, gridW. ( grid_T, grid_U, grid_V and'
+ PRINT *,' grid_W are also supported.'
+ PRINT *,' List_of_tags : The list of time tags corresponding to the time serie'
+ PRINT *,' whose mean is being computed.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-zoom imin imax jmin jmax ] : limit the mean computation to the '
+ PRINT *,' specified sub area.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : There are 11 variables produced by this program.'
+ PRINT *,' tbar, t2bar : mean t (Kelvin) and mean t^2 (K^2) [T-point]'
+ PRINT *,' ubar, u2bar : mean u (m/s) and mean u^2 (m2/s2) [U-point]'
+ PRINT *,' vbar, v2bar : mean v (m/s) and mean v^2 (m2/s2) [V-point]'
+ PRINT *,' wbar : mean w (m/s) [W-point]'
+ PRINT *,' uvbar : mean product u . v (m2/s2) [T-point]'
+ PRINT *,' utbar, vtbar, wtbar : mean product [uvw].t (m/s.K) [T-point]'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfbti, cdfbci and cdfnrjcomp'
+ PRINT *,' '
STOP
ENDIF
- ntags = narg - 5 ! first five arguments are not tags
- ALLOCATE (ctabtag(ntags) )
- !! Initialisation from 1st file (all file are assume to have the same
- !geometry)
- CALL getarg (1, config)
- CALL getarg (2, cdum) ; READ(cdum,*) imin
- CALL getarg (3, cdum) ; READ(cdum,*) imax
- CALL getarg (4, cdum) ; READ(cdum,*) jmin
- CALL getarg (5, cdum) ; READ(cdum,*) jmax
- CALL getarg (6, ctag)
- WRITE(cfileu,'(a,"_",a,"_gridU.nc")') TRIM(config),TRIM(ctag)
- ctabtag(1)=ctag
-
- DO jt=7,narg
- CALL getarg(jt,ctag)
- ctabtag(jt-5)=ctag
+ iimin=0 ; ijmin=0
+ iimax=0 ; ijmax=0
+ ijarg = 1 ; ntags=-1
+ ALLOCATE (ctabtag ( narg ) ) ! allocate string array for tags ( OK: it is an over-estimate).
+
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg +1
+ SELECT CASE (cldum)
+ CASE ( '-zoom' )
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg +1 ; READ(cldum,*) iimin
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg +1 ; READ(cldum,*) iimax
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg +1 ; READ(cldum,*) ijmin
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg +1 ; READ(cldum,*) ijmax
+ CASE DEFAULT
+ ntags=ntags+1
+ SELECT CASE ( ntags )
+ CASE (0) ; config = cldum
+ CASE DEFAULT
+ ctabtag(ntags) = cldum
+ END SELECT
+ END SELECT
+ END DO
+
+ ! check if all files exists
+ DO jt=1, ntags
+ ctag = ctabtag(jt)
+
+ ! check U-file
+ WRITE(cf_ufil,'(a,"_",a,"_gridU.nc")') TRIM(config),TRIM(ctag)
+ IF ( chkfile (cf_ufil ) ) THEN
+ WRITE(cf_ufil,'(a,"_",a,"_grid_U.nc")') TRIM(config),TRIM(ctag)
+ IF ( chkfile (cf_ufil ) ) STOP ! missing gridU or grid_U file
+ llnam_nemo=.TRUE. ! assume all files are nemo style ...
+ ENDIF
+
+ ! check V-file
+ WRITE(cf_vfil,'(a,"_",a,"_gridV.nc")') TRIM(config),TRIM(ctag)
+ IF ( chkfile (cf_vfil ) ) THEN
+ WRITE(cf_vfil,'(a,"_",a,"_grid_V.nc")') TRIM(config),TRIM(ctag)
+ IF ( chkfile (cf_vfil ) ) STOP ! missing gridV or grid_V file
+ ENDIF
+
+ ! check W-file
+ WRITE(cf_wfil,'(a,"_",a,"_gridW.nc")') TRIM(config),TRIM(ctag)
+ IF ( chkfile (cf_wfil ) ) THEN
+ WRITE(cf_wfil,'(a,"_",a,"_grid_W.nc")') TRIM(config),TRIM(ctag)
+ IF ( chkfile (cf_wfil ) ) STOP ! missing gridW or grid_W file
+ ENDIF
+
+ ! check T-file
+ WRITE(cf_tfil,'(a,"_",a,"_gridT.nc")') TRIM(config),TRIM(ctag)
+ IF ( chkfile (cf_tfil ) ) THEN
+ WRITE(cf_tfil,'(a,"_",a,"_grid_T.nc")') TRIM(config),TRIM(ctag)
+ IF ( chkfile (cf_tfil ) ) STOP ! missing gridT or grid_T file
+ ENDIF
END DO
- PRINT *,TRIM(cfileu)
- npiglo = getdim (cfileu,'x')
- npjglo = getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
- nt = getdim(cfileu,'time_counter')
+ ! assume all input files have same spatial size
+ npiglo = getdim (cf_ufil, cn_x )
+ npjglo = getdim (cf_ufil, cn_y )
+ npk = getdim (cf_ufil, cn_z )
- IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF
- IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF
+ ! modify sizes with respect to zoomed area
+ IF (iimin /= 0 ) THEN ; npiglo=iimax -iimin + 1 ; ELSE ; iimin=1 ; iimax=npiglo ; ENDIF
+ IF (ijmin /= 0 ) THEN ; npjglo=ijmax -ijmin + 1 ; ELSE ; ijmin=1 ; ijmax=npjglo ; ENDIF
! define new variables for output ( must update att.txt)
- typvar(1)%name='ubar'
- typvar(1)%long_name='temporal mean of u on U point'
- typvar(1)%short_name='ubar'
-
- typvar(2)%name='vbar'
- typvar(2)%long_name='temporal mean of v on V point'
- typvar(2)%short_name='vbar'
-
- typvar(3)%name='u2bar'
- typvar(3)%long_name='temporal mean of u * u on U point'
- typvar(3)%short_name='u2bar'
-
- typvar(4)%name='v2bar'
- typvar(4)%long_name='temporal mean of v * v on V point'
- typvar(4)%short_name='v2bar'
-
- typvar(5)%name='uvbar'
- typvar(5)%long_name='temporal mean of u * v on T point'
- typvar(5)%short_name='uvbar'
-
- typvar(6)%name='wbar'
- typvar(6)%long_name='temporal mean of w on W point'
- typvar(6)%short_name='wbar'
-
- typvar(7)%name='tbar'
- typvar(7)%long_name='temporal mean of T on T point in K'
- typvar(7)%short_name='tbar'
-
- typvar(8)%name='utbar'
- typvar(8)%long_name='temporal mean of u * T (in K) on T point'
- typvar(8)%short_name='utbar'
-
- typvar(9)%name='vtbar'
- typvar(9)%long_name='temporal mean of v * T (in K) on T point'
- typvar(9)%short_name='vtbar'
-
- typvar(10)%name='t2bar'
- typvar(10)%long_name='temporal mean of T * T on T point in K^2'
- typvar(10)%short_name='t2bar'
-
- typvar(11)%name='wtbar'
- typvar(11)%long_name='temporal mean of w * T (in K) on T point'
- typvar(11)%short_name='wtbar'
-
- typvar%units=''
- typvar%missing_value=0.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar%online_operation='N/A'
- typvar%axis='TYX'
+ stypvar( 1)%cname = 'ubar'
+ stypvar( 1)%clong_name = 'temporal mean of u on U point'
+ stypvar( 1)%cshort_name = 'ubar'
+ stypvar( 1)%cunits = 'm/s'
+
+ stypvar( 2)%cname = 'vbar'
+ stypvar( 2)%clong_name = 'temporal mean of v on V point'
+ stypvar( 2)%cshort_name = 'vbar'
+ stypvar( 2)%cunits = 'm/s'
+
+ stypvar( 3)%cname = 'u2bar'
+ stypvar( 3)%clong_name = 'temporal mean of u * u on U point'
+ stypvar( 3)%cshort_name = 'u2bar'
+ stypvar( 3)%cunits = 'm2/s2'
+
+ stypvar( 4)%cname = 'v2bar'
+ stypvar( 4)%clong_name = 'temporal mean of v * v on V point'
+ stypvar( 4)%cshort_name = 'v2bar'
+ stypvar( 4)%cunits = 'm2/s2'
+
+ stypvar( 5)%cname = 'uvbar'
+ stypvar( 5)%clong_name = 'temporal mean of u * v on T point'
+ stypvar( 5)%cshort_name = 'uvbar'
+ stypvar( 5)%cunits = 'm2/s2'
+
+ stypvar( 6)%cname = 'wbar'
+ stypvar( 6)%clong_name = 'temporal mean of w on W point'
+ stypvar( 6)%cshort_name = 'wbar'
+ stypvar( 6)%cunits = 'm/s'
+
+ stypvar( 7)%cname = 'tbar'
+ stypvar( 7)%clong_name = 'temporal mean of T on T point in K'
+ stypvar( 7)%cshort_name = 'tbar'
+ stypvar( 7)%cunits = 'K'
+
+ stypvar( 8)%cname = 'utbar'
+ stypvar( 8)%clong_name = 'temporal mean of u * T (in K) on T point'
+ stypvar( 8)%cshort_name = 'utbar'
+ stypvar( 8)%cunits = 'm/s.K'
+
+ stypvar( 9)%cname = 'vtbar'
+ stypvar( 9)%clong_name = 'temporal mean of v * T (in K) on T point'
+ stypvar( 9)%cshort_name = 'vtbar'
+ stypvar( 9)%cunits = 'm/s.K'
+
+ stypvar(10)%cname = 't2bar'
+ stypvar(10)%clong_name = 'temporal mean of T * T on T point in K^2'
+ stypvar(10)%cshort_name = 't2bar'
+ stypvar(10)%cunits = 'K2'
+
+ stypvar(11)%cname = 'wtbar'
+ stypvar(11)%clong_name = 'temporal mean of w * T (in K) on T point'
+ stypvar(11)%cshort_name = 'wtbar'
+ stypvar(11)%cunits = 'm/s.K'
+
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = -1000.
+ stypvar%valid_max = 1000.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TYX'
ipk(:) = npk
- PRINT *, 'npiglo =',npiglo
- PRINT *, 'npjglo =',npjglo
- PRINT *, 'npk =',npk
- PRINT *, 'nt =',nt
-
- !test if lev exists
- IF ((npk==0) .AND. (ilev .GT. 0) ) THEN
- PRINT *, 'Problem : npk = 0 and lev > 0 STOP'
- STOP
- END IF
+ PRINT *, ' npiglo = ', npiglo
+ PRINT *, ' npjglo = ', npjglo
+ PRINT *, ' npk = ', npk
! create output fileset
- ncout =create(cfileout, cfileu, npiglo,npjglo,npk)
- ierr= createvar(ncout ,typvar,11, ipk,id_varout )
- ierr= putheadervar(ncout, cfileu, npiglo, npjglo,npk)
-
+ ncout = create (cf_out, cf_ufil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, jp_var, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_ufil, npiglo, npjglo, npk )
+
! Allocate the memory
- ALLOCATE ( u2d(npiglo,npjglo) , v2d(npiglo,npjglo) )
- ALLOCATE ( t2d(npiglo,npjglo) , w2d(npiglo,npjglo) )
- ALLOCATE ( un(npiglo,npjglo) , tabu(npiglo,npjglo) )
- ALLOCATE ( vn(npiglo,npjglo) , tabv(npiglo,npjglo) )
- ALLOCATE ( u2n(npiglo,npjglo) , tabu2(npiglo,npjglo) )
- ALLOCATE ( v2n(npiglo,npjglo) , tabv2(npiglo,npjglo) )
- ALLOCATE ( t2n(npiglo,npjglo) , tabt2(npiglo,npjglo) )
- ALLOCATE ( uvn(npiglo,npjglo) , tabuv(npiglo,npjglo) )
- ALLOCATE ( tn(npiglo,npjglo) , tabt(npiglo,npjglo) )
- ALLOCATE ( wn(npiglo,npjglo) , tabw(npiglo,npjglo) )
- ALLOCATE ( utn(npiglo,npjglo) , tabut(npiglo,npjglo) )
- ALLOCATE ( vtn(npiglo,npjglo) , tabvt(npiglo,npjglo) )
- ALLOCATE ( wtn(npiglo,npk) , tabwt(npiglo,npk), zzz(npiglo,1) )
-
- ALLOCATE ( umask(npiglo,npjglo) , vmask(npiglo,npjglo) )
- ALLOCATE ( tmask(npiglo,npjglo) , wmask(npiglo,npjglo) )
- ALLOCATE ( t1mask(npiglo,npk) , w1mask(npiglo,npk) )
- ALLOCATE ( txz(npiglo,npk) , wxz(npiglo,npk) )
- ALLOCATE ( wtab(npiglo, npjglo, npk) )
-
- DO jk=1, npk
+ ALLOCATE ( u2d(npiglo,npjglo), v2d(npiglo,npjglo) )
+ ALLOCATE ( t2d(npiglo,npjglo), w2d(npiglo,npjglo,2) )
+
+ ALLOCATE ( dtabu(npiglo,npjglo), dtabu2(npiglo,npjglo), dtabut(npiglo,npjglo) )
+ ALLOCATE ( dtabv(npiglo,npjglo), dtabv2(npiglo,npjglo), dtabvt(npiglo,npjglo) )
+ ALLOCATE ( dtabt(npiglo,npjglo), dtabt2(npiglo,npjglo) )
+ ALLOCATE ( dtabw(npiglo,npjglo), dtabwt(npiglo,npjglo) )
+ ALLOCATE ( dtabuv(npiglo,npjglo) )
+
+ DO jk=1, npk-1 ! level npk is masked for T U V and is 0 for W ( bottom ) !
PRINT *,' level ',jk
- total_time = 0.d0; ntframe=0
- tabu(:,:) = 0.d0 ; tabv(:,:) = 0.d0 ; tabuv(:,:) = 0.d0
- tabu2(:,:) = 0.d0 ; tabv2(:,:) = 0.d0 ; tabt(:,:) = 0.d0
- tabw(:,:) = 0.d0 ; tabut(:,:) = 0.d0 ; tabvt(:,:) = 0.d0
- tabt2(:,:) = 0.d0
- un(:,:) = 0.d0
- vn(:,:) = 0.d0
- u2n(:,:) = 0.d0
- v2n(:,:) = 0.d0
- uvn(:,:) = 0.d0
- tn(:,:) = 0.d0
- wn(:,:) = 0.d0
- utn(:,:) = 0.d0
- vtn(:,:) = 0.d0
- t2n(:,:) = 0.d0
-
- DO jt= 6, narg
- ntframe=ntframe+1
- ctag=ctabtag(jt-5)
- WRITE(cfileu,'(a,"_",a,"_gridU.nc")') TRIM(config),TRIM(ctag)
- WRITE(cfilev,'(a,"_",a,"_gridV.nc")') TRIM(config),TRIM(ctag)
- WRITE(cfilew,'(a,"_",a,"_gridW.nc")') TRIM(config),TRIM(ctag)
- WRITE(cfilet,'(a,"_",a,"_gridT.nc")') TRIM(config),TRIM(ctag)
- IF ( jk == 1 ) THEN
- tim=getvar1d(cfileu,'time_counter',nt)
- total_time = total_time + SUM(tim(1:nt) )
+ dtotal_time = 0.d0 ; ntframe=0
+ dtabu(:,:) = 0.d0 ; dtabv(:,:) = 0.d0 ; dtabuv(:,:) = 0.d0
+ dtabu2(:,:) = 0.d0 ; dtabv2(:,:) = 0.d0 ; dtabt(:,:) = 0.d0
+ dtabw(:,:) = 0.d0 ; dtabut(:,:) = 0.d0 ; dtabvt(:,:) = 0.d0
+ dtabt2(:,:) = 0.d0 ; dtabwt(:,:) = 0.d0
+
+ DO jt= 1, ntags
+ ctag = ctabtag(jt)
+ IF ( llnam_nemo ) THEN
+ WRITE(cf_ufil,'(a,"_",a,"_grid_U.nc")') TRIM(config),TRIM(ctag)
+ WRITE(cf_vfil,'(a,"_",a,"_grid_V.nc")') TRIM(config),TRIM(ctag)
+ WRITE(cf_wfil,'(a,"_",a,"_grid_W.nc")') TRIM(config),TRIM(ctag)
+ WRITE(cf_tfil,'(a,"_",a,"_grid_T.nc")') TRIM(config),TRIM(ctag)
+ ELSE ! drakkar style
+ WRITE(cf_ufil,'(a,"_",a,"_gridU.nc")') TRIM(config),TRIM(ctag)
+ WRITE(cf_vfil,'(a,"_",a,"_gridV.nc")') TRIM(config),TRIM(ctag)
+ WRITE(cf_wfil,'(a,"_",a,"_gridW.nc")') TRIM(config),TRIM(ctag)
+ WRITE(cf_tfil,'(a,"_",a,"_gridT.nc")') TRIM(config),TRIM(ctag)
ENDIF
-
- u2d(:,:)= getvar(cfileu, 'vozocrtx', jk , &
- & npiglo, npjglo, kimin=imin, kjmin=jmin, ktime=1 )
- v2d(:,:)= getvar(cfilev, 'vomecrty', jk , &
- & npiglo, npjglo, kimin=imin, kjmin=jmin, ktime=1 )
- w2d(:,:)= getvar(cfilew, 'vovecrtz', jk , &
- & npiglo, npjglo, kimin=imin, kjmin=jmin, ktime=1 )
- t2d(:,:)= getvar(cfilet, 'votemper', jk , &
- & npiglo, npjglo, kimin=imin, kjmin=jmin, ktime=1 )
-
- tabu(:,:) = tabu(:,:) + u2d(:,:)
- tabu2(:,:) = tabu2(:,:) + u2d(:,:) * u2d(:,:)
- tabv(:,:) = tabv(:,:) + v2d(:,:)
- tabv2(:,:) = tabv2(:,:) + v2d(:,:) * v2d(:,:)
- tabw(:,:) = tabw(:,:) + w2d(:,:)
- tabt(:,:) = tabt(:,:) + (t2d(:,:)+273.15)
- tabt2(:,:) = tabt2(:,:) + (t2d(:,:)+273.15)*(t2d(:,:)+273.15)
-
- DO jj = jmin+1, npjglo
- DO ji = imin+1, npiglo
- umask(ji,jj)=0.
- umask(ji,jj)=u2d(ji,jj)*u2d(ji-1,jj)
- vmask(ji,jj)=0.
- vmask(ji,jj)=v2d(ji,jj)*v2d(ji,jj-1)
- wmask(ji,jj)=0.
- wmask(ji,jj)=w2d(ji,jj)
- tmask(ji,jj)=0.
- tmask(ji,jj)=t2d(ji,jj)
- IF (umask(ji,jj) /= 0.) umask(ji,jj)=1.
- IF (vmask(ji,jj) /= 0.) vmask(ji,jj)=1.
- IF (tmask(ji,jj) /= 0.) tmask(ji,jj)=1.
- IF (wmask(ji,jj) /= 0.) wmask(ji,jj)=1.
-
- tabuv(ji-imin,jj-jmin) = tabuv(ji-imin,jj-jmin) &
- & + 0.5 * umask(ji,jj) * (u2d(ji,jj)+u2d(ji-1,jj)) &
- & * 0.5 * vmask(ji,jj) * (v2d(ji,jj)+v2d(ji,jj-1))
- tabut(ji-imin,jj-jmin) = tabut(ji-imin,jj-jmin) &
- & + 0.5 * umask(ji,jj) * (u2d(ji,jj)+u2d(ji-1,jj)) &
- & * tmask(ji,jj) * (t2d(ji,jj)+273.15)
- tabvt(ji-imin,jj-jmin) = tabvt(ji-imin,jj-jmin) &
- & + 0.5 * vmask(ji,jj) * (v2d(ji,jj)+v2d(ji,jj-1)) &
- & * tmask(ji,jj) * (t2d(ji,jj)+273.15)
-
- END DO
- END DO
- END DO
-
- un(:,:) = tabu(:,:) / ntframe
- vn(:,:) = tabv(:,:) / ntframe
- u2n(:,:) = tabu2(:,:) / ntframe
- v2n(:,:) = tabv2(:,:) / ntframe
- uvn(:,:) = tabuv(:,:) / ntframe
- tn(:,:) = tabt(:,:) / ntframe
- wn(:,:) = tabw(:,:) / ntframe
- utn(:,:) = tabut(:,:) / ntframe
- vtn(:,:) = tabvt(:,:) / ntframe
- t2n(:,:) = tabt2(:,:) / ntframe
- ! sauvegarde
- ierr = putvar(ncout, id_varout(1) ,un, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(2) ,vn, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(3) ,u2n, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(4) ,v2n, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(5) ,uvn, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(6) ,wn, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(7) ,tn, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(8) ,utn, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(9) ,vtn, jk, npiglo, npjglo, &
- & ktime=1)
- ierr = putvar(ncout, id_varout(10) ,t2n, jk, npiglo, npjglo, &
- & ktime=1)
+ IF ( jk == 1 ) THEN
+ npt = getdim(cf_ufil, cn_t)
+ ALLOCATE ( tim(npt) )
+ tim=getvar1d(cf_ufil, cn_vtimec, npt)
+ dtotal_time = dtotal_time + SUM(DBLE(tim))
+ DEALLOCATE ( tim )
+ ENDIF
+ DO jtt = 1, npt
+ ntframe = ntframe+1
+ u2d(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jtt )
+ v2d(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jtt )
+ w2d(:,:,iup) = getvar(cf_wfil, cn_vovecrtz, jk, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jtt )
+ w2d(:,:,idwn) = getvar(cf_wfil, cn_vovecrtz, jk+1, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jtt )
+ t2d(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ktime=jtt )
+ WHERE ( t2d /= 0. ) t2d = t2d + 273.15 ! from C to K
+
+ dtabu(:,:) = dtabu(:,:) + u2d(:,:)
+ dtabu2(:,:) = dtabu2(:,:) + u2d(:,:) * u2d(:,:) * 1.d0
+ dtabv(:,:) = dtabv(:,:) + v2d(:,:)
+ dtabv2(:,:) = dtabv2(:,:) + v2d(:,:) * v2d(:,:) * 1.d0
+ dtabw(:,:) = dtabw(:,:) + w2d(:,:,iup)
+ dtabt(:,:) = dtabt(:,:) + t2d(:,:)
+ dtabt2(:,:) = dtabt2(:,:) + t2d(:,:) * t2d(:,:) * 1.d0
+
+ DO jj = npjglo, 2 , -1
+ DO ji = npiglo, 2 , -1
+ ! put u, v on T point ( note the loops starting from the end for using u2d and v2d as tmp array)
+ u2d(ji,jj) = 0.5 * ( u2d(ji,jj) + u2d(ji-1,jj ) )
+ v2d(ji,jj) = 0.5 * ( v2d(ji,jj) + v2d(ji, jj-1) )
+ END DO
+ END DO
+ u2d(1,:) = 0. ; u2d(:,1) = 0.
+ v2d(1,:) = 0. ; v2d(:,1) = 0.
+ w2d(:,:,iup) = 0.5 * ( w2d(:,:,iup) + w2d(:,:,idwn) ) ! W at T point
+
+ dtabuv(:,:) = dtabuv(:,:) + u2d(:,:) * v2d(:,:) * 1.d0
+ dtabut(:,:) = dtabut(:,:) + u2d(:,:) * t2d(:,:) * 1.d0
+ dtabvt(:,:) = dtabvt(:,:) + v2d(:,:) * t2d(:,:) * 1.d0
+ dtabwt(:,:) = dtabwt(:,:) + w2d(:,:,iup) * t2d(:,:) * 1.d0
+
+ END DO ! jtt
+ END DO ! tags
+
+ dcoef = 1.d0 / ntframe
+
+ ! save on file
+ ierr = putvar(ncout, id_varout( 1), REAL(dtabu * dcoef), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout( 2), REAL(dtabv * dcoef), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout( 3), REAL(dtabu2* dcoef), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout( 4), REAL(dtabv2* dcoef), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout( 5), REAL(dtabuv* dcoef), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout( 6), REAL(dtabw * dcoef), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout( 7), REAL(dtabt * dcoef), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout( 8), REAL(dtabut* dcoef), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout( 9), REAL(dtabvt* dcoef), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout(10), REAL(dtabt2* dcoef), jk, npiglo, npjglo )
+ ierr = putvar(ncout, id_varout(11), REAL(dtabwt* dcoef), jk, npiglo, npjglo )
+
+ END DO ! loop on level
+
+ ! fill up empty last level
+ dtabu = 0.d0 ! reset this dummy array to 0 for npk output
+ DO jk= 1, jp_var
+ ierr = putvar(ncout, id_varout(jk), REAL(dtabu), npk, npiglo, npjglo )
END DO
- ! this is done for everybody, dont bother the time for next variables
- tim(1)= total_time/ntframe
- ierr=putvar1d(ncout,tim,1,'T')
-
- DO jj = jmin+1, jmax ! jj global
- print *, 'JJ=',jj
- ntframe=0
- tabwt(:,:) = 0.d0
- wtn(:,:) = 0.d0
- wxz(:,:) = 0.d0
- txz(:,:) = 0.d0
- DO jt= 6, narg
- ntframe=ntframe+1
- ctag=ctabtag(jt-5)
- WRITE(cfilet,'(a,"_",a,"_gridT.nc")') TRIM(config),TRIM(ctag)
- WRITE(cfilew,'(a,"_",a,"_gridW.nc")') TRIM(config),TRIM(ctag)
-
- wxz(:,:)=getvarxz(cfilew,'vovecrtz',jj,npiglo,npk, kimin=imin,kkmin=1,ktime=1)
- txz(:,:)=getvarxz(cfilet,'votemper',jj,npiglo,npk, kimin=imin,kkmin=1,ktime=1)
-
- DO jk=1, npk-1
- w1mask(:,jk) = wxz(:,jk) * wxz(:,jk+1)
- t1mask(:,jk) = txz(:,jk)
- WHERE ( w1mask(:,jk) /= 0.) w1mask(:,jk)=1.
- WHERE ( t1mask(:,jk) /= 0.) t1mask(:,jk)=1.
- tabwt(:,jk) = tabwt(:,jk) + t1mask(:,jk)*(txz(:,jk)+273.15) &
- & *0.5* w1mask(:,jk)* ( wxz(:,jk) + wxz(:,jk+1))
- END DO
- END DO
- wtn(:,:) = tabwt(:,:) / ntframe
- wtab(:,jj-jmin+1,:)= wtn(:,:)
- END DO
- DO jk=1,npk
- ierr = putvar(ncout, id_varout(11) ,wtab(:,:,jk), jk, npiglo, npjglo )
- END DO
+
+ ierr = putvar1d(ncout, (/REAL(dtotal_time*dcoef)/), 1, 'T')
ierr = closeout(ncout)
diff --git a/cdfmppini.f90 b/cdfmppini.f90
index 83f85c6..f419342 100644
--- a/cdfmppini.f90
+++ b/cdfmppini.f90
@@ -1,65 +1,114 @@
PROGRAM cdfmppini
- !!---------------------------------------------------------------------------
- !! *** PROGRAM cdfmppini ***
- !!
- !! Purpose: off line domain decomposition using mesh_hgr
- !!
- !! Method : just an incapsulation of mpp_ini from NEMO
- !!
- !! history : original, J.M. Molines, May 2010
- !!---------------------------------------------------------------------------
+ !!======================================================================
+ !! *** PROGRAM cdfmppini ***
+ !!=====================================================================
+ !! ** Purpose : off line domain decomposition using mesh_hgr
+ !!
+ !! ** Method : just an incapsulation of mpp_ini from NEMO
+ !!
+ !! History : 2.1 : 05/2010 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! mpp_init2 Nemo routine for mpp initialisation
+ !!----------------------------------------------------------------------
USE cdfio
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER, PARAMETER :: wp=8 ! working precision
- INTEGER :: jpni, jpnj, jpnij
- INTEGER :: jpreci=1 , jprecj=1
- INTEGER :: jpi, jpj, jpiglo,jpjglo
- INTEGER :: jperio=6, jv
-
- INTEGER , DIMENSION(:,:), ALLOCATABLE :: imask
- INTEGER , DIMENSION(:), ALLOCATABLE :: nimppt, njmppt, nlcit, nlcjt
- INTEGER , DIMENSION(:), ALLOCATABLE :: nldit, nldjt, nleit, nlejt
- INTEGER , DIMENSION(:), ALLOCATABLE :: nbondi, nbondj, icount
-
- INTEGER :: narg, iargc, numout=6
- CHARACTER(LEN=80) :: cdum, cmask='mask.nc', cbathy='bathy_meter.nc', cfich='m'
- CHARACTER(LEN=80) :: cvar, czgr='mesh_zgr.nc'
- LOGICAL :: lwp=.true.
-
+ ! REM : some of the doctor rules are not followed because we want to use
+ ! the mpp_init2 routine almost out of the box, thus we need to define
+ ! variables which are parameters in NEMO, with the same name (jp..)
+
+ INTEGER(KIND=4), PARAMETER :: wp=8 ! working precision
+ INTEGER(KIND=4) :: jpni, jpnj, jpnij
+ INTEGER(KIND=4) :: jpreci=1 , jprecj=1
+ INTEGER(KIND=4) :: jpi, jpj, jpiglo, jpjglo
+ INTEGER(KIND=4) :: jperio=6, jv
+ INTEGER(KIND=4) :: narg, iargc, numout=6
+ INTEGER(KIND=4) :: ijarg, ireq
+ INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: imask
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: nimppt, njmppt, nlcit, nlcjt
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: nldit, nldjt, nleit, nlejt
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: nbondi, nbondj, icount
+
+
+ CHARACTER(LEN=80) :: cf_msk='m'
+ CHARACTER(LEN=80) :: cf_out='mppini.txt'
+ CHARACTER(LEN=80) :: cv_in
+ CHARACTER(LEN=80) :: cldum
+
+ LOGICAL :: lwp=.true.
!----------------------------------------------------------------------------
- narg=iargc()
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg < 2 ) THEN
- PRINT *,'USAGE: cdfmppini jpni jpnj [m/b]'
- PRINT *,' optional argument: '
- PRINT *,' m (default) : take mask from mask.nc (tmask)'
- PRINT *,' b : take mask from bathy_level.nc (Bathymetry)'
- PRINT *,' z : take mask from mesh_zgr.nc (mbathy)'
- PRINT *,' mask.nc is used for tmask (default) or m specified'
- PRINT *,' bathy_meter.nc is used if b specified'
- PRINT *,' mesh_zgr is used if z specified'
- PRINT *,' Output is done on mppini.txt file'
- STOP
+ PRINT *,' usage : cdfmppini jpni jpnj [m/b/z] [-jperio jperio]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Perform the mpp initialisation with NEMO routine mpp_init2 and'
+ PRINT *,' give some statistics about the domains. Save the layout on a '
+ PRINT *,' text file.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' jpni : number of domains in the i direction.'
+ PRINT *,' jpnj : number of domains in the j direction.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [m/b/z] : use one of these letter to choose the land/sea mask.'
+ PRINT *,' m : take mask from ',TRIM(cn_fmsk),' (tmask) [ default ]'
+ PRINT *,' b : take mask from ',TRIM(cn_fbathymet),' (Bathymetry)'
+ PRINT *,' z : take mask from ',TRIM(cn_fzgr),' (mbathy)'
+ PRINT *,' Default is ',TRIM(cf_msk)
+ PRINT *,' [-jperio jperio ] : specify jperio. '
+ PRINT '(a,i2)',' default value is ', jperio
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' one of ',TRIM(cn_fmsk),', ',TRIM(cn_fbathymet),' or ',TRIM(cn_fzgr),' according to option'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' - Standard output'
+ PRINT *,' - ASCII file ', TRIM(cf_out)
+ STOP
ENDIF
- CALL getarg(1,cdum) ; READ(cdum,*) jpni
- CALL getarg(2,cdum) ; READ(cdum,*) jpnj
- IF ( narg == 3 ) CALL getarg(3, cfich)
-
- SELECT CASE ( cfich)
- CASE ('m'); cdum=cmask ; cvar='tmask'
- CASE ('b'); cdum=cbathy ; cvar='Bathymetry'
- CASE ('z'); cdum=czgr ; cvar='mbathy'
- END SELECT
-
+ cf_msk = cn_fmsk ; cv_in='tmask'
+ ijarg=1 ; ireq=0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
+ CASE( 'm' ) ; cf_msk=cn_fmsk ; cv_in='tmask'
+ CASE( 'b' ) ; cf_msk=cn_fbathymet ; cv_in='Bathymetry'
+ CASE( 'z' ) ; cf_msk=cn_fzgr ; cv_in='mbathy'
+ CASE( '-jperio' )
+ CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) jperio
+ CASE DEFAULT
+ ireq = ireq+1
+ SELECT CASE ( ireq )
+ CASE ( 1 ) ; READ(cldum,*) jpni
+ CASE ( 2 ) ; READ(cldum,*) jpnj
+ CASE DEFAULT ; PRINT *,' Too many arguments.'; STOP
+ END SELECT
+ END SELECT
+ END DO
+
+ IF ( chkfile (cf_msk )) STOP ! missing file
- jpiglo= getdim (cdum,'x')
- jpjglo= getdim (cdum,'y')
+ jpiglo = getdim (cf_msk,cn_x)
+ jpjglo = getdim (cf_msk,cn_y)
jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci
jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj
ALLOCATE ( imask(jpiglo,jpjglo) )
- imask(:,:)=getvar(cdum,cvar,1,jpiglo,jpjglo)
+ imask(:,:) = getvar(cf_msk, cv_in, 1, jpiglo, jpjglo)
WHERE (imask <= 0 ) imask = 0
WHERE (imask > 0 ) imask = 1
CALL mpp_init2
@@ -80,14 +129,13 @@ PROGRAM cdfmppini
WHERE(nbondi == jv ) icount=1
PRINT *,' NBONDI = ', jv,' : ', sum(icount)
ENDDO
+
DO jv=-1,2
icount=0
WHERE(nbondj == jv ) icount=1
PRINT *,' NBONDJ = ', jv,' : ', sum(icount)
ENDDO
-
-
CONTAINS
@@ -132,27 +180,27 @@ CONTAINS
!! 9.0 ! 04-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1
!!----------------------------------------------------------------------
!!
- INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices
- INTEGER :: inum = 99 ! temporary logical unit
- INTEGER :: &
+ INTEGER(KIND=4) :: ji, jj, jn, jproc, jarea ! dummy loop indices
+ INTEGER(KIND=4) :: inum = 99 ! temporary logical unit
+ INTEGER(KIND=4) :: &
ii, ij, ifreq, il1, il2, & ! temporary integers
icont, ili, ilj, & ! " "
isurf, ijm1, imil, & ! " "
iino, ijno, iiso, ijso, & ! " "
iiea, ijea, iiwe, ijwe, & ! " "
iresti, irestj, iproc ! " "
- INTEGER :: nreci, nrecj, nperio
- INTEGER, DIMENSION(10000) :: iint, ijnt
- INTEGER, DIMENSION(:), ALLOCATABLE :: iin, ijn
- INTEGER, DIMENSION(jpni,jpnj) :: &
+ INTEGER(KIND=4) :: nreci, nrecj, nperio
+ INTEGER(KIND=4), DIMENSION(10000) :: iint, ijnt
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: iin, ijn
+ INTEGER(KIND=4), DIMENSION(jpni,jpnj) :: &
iimppt, ijmppt, ilci , ilcj , & ! temporary workspace
ipproc, ibondj, ibondi, & ! " "
ilei , ilej , ildi , ildj , & ! " "
ioea , iowe , ioso , iono ! " "
REAL(wp) :: zidom , zjdom ! temporary scalars
- INTEGER :: nono, noso, noea, nowe
- INTEGER, DIMENSION(:), ALLOCATABLE :: ii_nono, ii_noso, ii_noea, ii_nowe
+ INTEGER(KIND=4) :: nono, noso, noea, nowe
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ii_nono, ii_noso, ii_noea, ii_nowe
! 0. initialisation
! -----------------
@@ -416,7 +464,7 @@ CONTAINS
! Save processor layout in ascii file
IF (lwp) THEN
- OPEN (inum, FILE='mppini.txt', FORM='FORMATTED', RECL=255)
+ OPEN (inum, FILE=cf_out, FORM='FORMATTED', RECL=255)
WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpiglo,jpjglo
WRITE(inum,'(a)') 'RANK nlci nlcj nldi nldj nlei nlej nimpp njmpp nono noso nowe noea nbondi nbondj '
@@ -428,11 +476,11 @@ CONTAINS
WRITE(inum,'(15i5)') jproc-1, nlcit(jproc), nlcjt(jproc), &
- nldit(jproc), nldjt(jproc), &
- nleit(jproc), nlejt(jproc), &
- nimppt(jproc), njmppt(jproc),&
- ii_nono(jproc), ii_noso(jproc), ii_nowe(jproc), ii_noea(jproc) ,&
- nbondi(jproc), nbondj(jproc)
+ nldit(jproc), nldjt(jproc), &
+ nleit(jproc), nlejt(jproc), &
+ nimppt(jproc), njmppt(jproc),&
+ ii_nono(jproc), ii_noso(jproc), ii_nowe(jproc), ii_noea(jproc) ,&
+ nbondi(jproc), nbondj(jproc)
END DO
CLOSE(inum)
END IF
diff --git a/cdfmsk.f90 b/cdfmsk.f90
index 355a22e..8b0ae87 100644
--- a/cdfmsk.f90
+++ b/cdfmsk.f90
@@ -1,60 +1,75 @@
PROGRAM cdfmsk
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmsk ***
+ !!======================================================================
+ !! *** PROGRAM cdfmsk ***
+ !!=====================================================================
+ !! ** Purpose : Computes the number of land points from the mask
!!
- !! ** Purpose: Computes the number of land points from the mask
- !!
- !! ** Method: Try to avoid 3 d arrays
- !!
- !! history:
- !! Original : J.M. Molines May 2005
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 05/2005 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk,jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc , ntags !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: zmask !: 2D mask at current level
-
- CHARACTER(LEN=256) ,DIMENSION(1) :: cvarname !: array of var name
- CHARACTER(LEN=256) :: cfilet
-
- INTEGER :: ncout, npt
- INTEGER :: istatus
- REAL(4) :: ss
-
- !! Read command line
- narg= iargc()
+
+ INTEGER(KIND=4) :: jk ! dummy loop index
+ INTEGER(KIND=4) :: npoint ! number of points
+ INTEGER(KIND=4) :: narg, iargc ! browse line
+ INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain
+
+ REAL(KIND=4) :: zss !
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level
+
+ CHARACTER(LEN=256) :: cf_msk ! file name
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfmsk MSK-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the number of ocean points, land points and display'
+ PRINT *,' some statistics.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' MSK-file : input mask file (which contains tmask)'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none apart the mask file passed as argument.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' Standard output'
+ STOP
+ ENDIF
IF ( narg == 0 ) THEN
PRINT *,' Usage : cdfmsk maskfile '
STOP
ENDIF
+
+ CALL getarg (1, cf_msk)
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'z')
+ IF ( chkfile(cf_msk) ) STOP ! missing file
+
+ npiglo = getdim (cf_msk, cn_x)
+ npjglo = getdim (cf_msk, cn_y)
+ npk = getdim (cf_msk, cn_z)
ALLOCATE (zmask(npiglo,npjglo))
- npt= 0
+ npoint = 0
DO jk=1, npk
- zmask(:,:)= getvar(cfilet, 'tmask', jk ,npiglo, npjglo)
- ss=sum(zmask)
- print *, jk, ss, ss/npiglo/npjglo*100,' % H'
- npt = npt + ss
- END DO ! loop to next level
- PRINT *, ' Number of Ocean points :', npt,' ',(1.*npt)/npiglo/npjglo/npk*100,' %'
- PRINT *, ' Number of Land points :', npiglo*npjglo*npk - npt,' ',(npiglo*npjglo*npk -1.*npt)/npiglo/npjglo/npk*100,' %'
+ zmask(:,:) = getvar(cf_msk, 'tmask', jk ,npiglo, npjglo)
+ zss = SUM(zmask)
+ npoint = npoint + zss
+ END DO
+
+ PRINT *, ' Number of Ocean points :', npoint ,' ',(1.*npoint )/npiglo/npjglo/npk*100,' %'
+ PRINT *, ' Number of Land points :', npiglo*npjglo*npk - npoint ,' ',(npiglo*npjglo*npk -1.*npoint )/npiglo/npjglo/npk*100,' %'
END PROGRAM cdfmsk
diff --git a/cdfmsksal.f90 b/cdfmsksal.f90
deleted file mode 100644
index da17ed5..0000000
--- a/cdfmsksal.f90
+++ /dev/null
@@ -1,78 +0,0 @@
-PROGRAM cdfmsksal
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmsksal ***
- !!
- !! ** Purpose: Computes the number of land points from the gridT file
- !!
- !! ** Method: Try to avoid 3 d arrays gridT file Work with vosaline
- !!
- !! history:
- !! Original : J.M. Molines November 2005
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: ji,jj,jk,jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc , ntags !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: zmask !: 2D mask at current level
-
- CHARACTER(LEN=256) ,DIMENSION(1) :: cvarname !: array of var name
- CHARACTER(LEN=256) :: cfilet, cline
-
- INTEGER :: ncout, npt
- INTEGER :: istatus
- REAL(4) :: ss
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmsksal gridT '
- STOP
- ENDIF
-
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- PRINT *, 'NPIGLO ', npiglo
- PRINT *, 'NPJGLO ', npjglo
- PRINT *, 'NPK ', npk
-
- ALLOCATE (zmask(npiglo,npjglo))
-
- npt= 0
-! DO jk=1, npk
- DO jk=1, 1
- zmask(:,:)= getvar(cfilet, 'vosaline', jk ,npiglo, npjglo)
- WHERE (zmask > 0 ) zmask = 1
- ss=sum(zmask)
- print *, jk, ss, ss/npiglo/npjglo*100,' % H'
- npt = npt + ss
- END DO ! loop to next level
- OPEN (10, FILE='tmask.bimg',FORM='UNFORMATTED')
- cline='tmask(1) from '//trim(cfilet)//' (cdfmsksal)'
- WRITE(10) cline
- WRITE(10) cline
- WRITE(10) cline
- WRITE(10) cline
- WRITE(10) npiglo, npjglo,1,1,1,0
- WRITE(10) 1.,1.,1.,1., 9999.
- WRITE(10) 0.
- WRITE(10) 0.
- WRITE(10)(( zmask(ji,jj),ji=1,npiglo),jj=1,npjglo)
- CLOSE(10)
-
- PRINT *, ' Number of Ocean points :', npt,' ',(1.*npt)/npiglo/npjglo/npk*100,' %'
- PRINT *, ' Number of Land points :', npiglo*npjglo*npk - npt,' ',(npiglo*npjglo*npk -1.*npt)/npiglo/npjglo/npk*100,' %'
-
-END PROGRAM cdfmsksal
diff --git a/cdfmxl-full.f90 b/cdfmxl-full.f90
deleted file mode 100644
index 12d9b50..0000000
--- a/cdfmxl-full.f90
+++ /dev/null
@@ -1,181 +0,0 @@
-PROGRAM cdfmxl_full
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfmxl_full ***
- !!
- !! ** Purpose: Compute mixed layer depth
- !! FULL STEP VERSION
- !!
- !! ** Method: Try to avoid 3 d arrays.
- !! - compute surface properties
- !! - initialize depths and model levels number
- !! - from bottom to top compute rho and
- !! check if rho > rho_surf +rho_c
- !! where rho_c is a density criteria given as argument
- !! Full step version differ from PS only for the
- !! reading of the mbathy array
- !!
- !! history :
- !! Original : J.M. Molines (October 2005)
- !! Full stp : F. Castruccio, J.M. Molines (December 2006)
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: ji,jj,jk, ik1, ik2, ikt
- INTEGER :: narg, iargc
- INTEGER :: npiglo, npjglo, npk
- INTEGER , DIMENSION(:,:), ALLOCATABLE :: mbathy !: number of w levels in water <= npk
- INTEGER , DIMENSION(:,:), ALLOCATABLE :: nmln1 ,& !: last level where rho > rho + rho_c1
- & nmln2 ,& !: last level where rho > rho + rho_c2
- & nmlnt !: last level where temp > temp +temp_c (temp_c<0)
-
- REAL(KIND=4) :: rho_c1=0.01, rho_c2=0.03, temp_c=-0.2
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp, & !: temperatures
- & sal, & !: salinity
- & rho, & !: current density
- & rho_surf, & !: surface density
- & tem_surf, & !: surface temperature
- & hmlp1 , & !: mixed layer depth based on density criterium 1
- & hmlp2 , & !: mixed layer depth based on density criterium 2
- & hmlt , & !: mixed layer depth based on Temp Criterium
- & zmask_surf , & !: mixed layer depth
- & zmask !: tmask at current level
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw !: depth of w levels
-
- CHARACTER(LEN=256) :: cfilet, coordzgr='mesh_zgr.nc'
- CHARACTER(LEN=256) :: cbathy='bathy_level.nc'
-
- ! output stuff
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(3) :: ipk, id_varout !: only one output variable
- REAL(KIND=4), DIMENSION(1) :: tim,dep !: time output
- CHARACTER(LEN=256) :: cfileout='mxl.nc'
-
- TYPE(variable), DIMENSION(3) :: typvar !: structure for attributes
-
- !! 0- Get started ..
- !!
- ! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 1 ) THEN
- PRINT *,' Usage : cdfmxl-full gridTfile '
- PRINT *,' FULL STEP VERSION : bathy_level.nc '
- PRINT *,' Files mesh_zgr.nc must be in the current directory'
- PRINT *,' Output on mxl.nc '
- PRINT *,' variable somxl010 = mld on density criterium 0.01'
- PRINT *,' variable somxl030 = mld on density criterium 0.03'
- PRINT *,' variable somxlt02 = mld on temperature criterium -0.2'
- STOP
- ENDIF
- CALL getarg (1, cfilet)
-
- ! read dimensions
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- dep(1) = 0.
- ipk(:)= npk ! all variables ( output are 2D)
-
- typvar(1)%name= 'somxl010'
- typvar(2)%name= 'somxl030'
- typvar(3)%name= 'somxlt02'
- typvar%units='m'
- typvar%missing_value=0.
- typvar%valid_min= 0.
- typvar%valid_max= 7000.
- typvar(1)%long_name='Mixed_Layer_Depth_on_0.01_rho_crit'
- typvar(2)%long_name='Mixed_Layer_Depth_on_0.03_rho_crit'
- typvar(3)%long_name='Mixed_Layer_Depth_on_-0.2_temp_crit'
- typvar(1)%short_name='somxl010'
- typvar(2)%short_name='somxl030'
- typvar(3)%short_name='somxlt02'
- typvar%online_operation='N/A'
- typvar%axis='TYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE (temp(npiglo,npjglo), sal(npiglo,npjglo), rho(npiglo,npjglo))
- ALLOCATE (rho_surf(npiglo,npjglo) ,tem_surf(npiglo,npjglo))
- ALLOCATE (zmask(npiglo,npjglo),zmask_surf(npiglo,npjglo) )
- ALLOCATE (hmlp1(npiglo,npjglo),hmlp2(npiglo,npjglo), hmlt(npiglo,npjglo) )
- ALLOCATE (mbathy(npiglo,npjglo) )
- ALLOCATE (nmln1(npiglo,npjglo), nmln2(npiglo,npjglo),nmlnt(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
-
- ! read mbathy and gdepw use real temp(:,:) as template (getvar is used for real only)
- temp(:,:) = getvar(cbathy,'Bathy_level',1, npiglo, npjglo)
- mbathy(:,:) = temp(:,:)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- !! 1- Get surface properties
- !!
- ! read surface T and S and deduce land-mask from salinity
- temp(:,:) = getvar(cfilet, 'votemper', 1 ,npiglo,npjglo)
- sal (:,:) = getvar(cfilet, 'vosaline', 1 ,npiglo,npjglo)
- zmask(:,:) = 1.; WHERE ( sal == 0. ) zmask = 0.
- zmask_surf(:,:) = zmask(:,:)
-
- ! compute rho_surf
- rho_surf(:,:) = sigma0 ( temp,sal,npiglo,npjglo )* zmask(:,:)
- tem_surf(:,:) = temp(:,:)
-
- ! Initialization to the number of w ocean point mbathy
- nmln1(:,:) = mbathy(:,:)
- nmln2(:,:) = mbathy(:,:)
- nmlnt(:,:) = mbathy(:,:)
-
- !! 2- determine mixed layer
- !!
- ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1)
- ! (rhop defined at t-point, thus jk-1 for w-level just above)
- DO jk = npk-1, 2, -1
- temp(:,:) = getvar(cfilet, 'votemper', jk ,npiglo,npjglo)
- sal (:,:) = getvar(cfilet, 'vosaline', jk ,npiglo,npjglo)
- zmask(:,:) = 1. ; WHERE ( sal == 0. ) zmask = 0.
- rho(:,:) = sigma0 ( temp,sal,npiglo,npjglo )* zmask(:,:)
-
- DO jj = 1, npjglo
- DO ji = 1, npiglo
- IF( rho(ji,jj) > rho_surf(ji,jj) + rho_c1 ) nmln1(ji,jj) = jk
- IF( rho(ji,jj) > rho_surf(ji,jj) + rho_c2 ) nmln2(ji,jj) = jk
- IF( ABS(temp(ji,jj) - tem_surf(ji,jj)) > ABS( temp_c) ) nmlnt(ji,jj) = jk
- END DO
- END DO
- END DO
-
- ! Mixed layer depth
- DO jj = 1, npjglo
- DO ji = 1, npiglo
- ik1 = nmln1(ji,jj) ; ik2 = nmln2(ji,jj) ; ikt = nmlnt(ji,jj)
- hmlp1 (ji,jj) = gdepw(ik1) * zmask_surf(ji,jj)
- hmlp2 (ji,jj) = gdepw(ik2) * zmask_surf(ji,jj)
- hmlt (ji,jj) = gdepw(ikt) * zmask_surf(ji,jj)
- END DO
- END DO
-
- !! 3- Write output file
- !!
- ncout = create(cfileout, cfilet, npiglo,npjglo,1)
- ierr = createvar(ncout ,typvar ,3, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,1,pdep=dep)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr = putvar(ncout, id_varout(1) ,hmlp1, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(2) ,hmlp2, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(3) ,hmlt , 1,npiglo, npjglo)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ierr=closeout(ncout)
-
-
-END PROGRAM cdfmxl_full
diff --git a/cdfmxl.f90 b/cdfmxl.f90
index 88120fb..8c87e4b 100644
--- a/cdfmxl.f90
+++ b/cdfmxl.f90
@@ -1,184 +1,206 @@
PROGRAM cdfmxl
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfmxl ***
+ !!======================================================================
+ !! *** PROGRAM cdfmxl ***
+ !!=====================================================================
+ !! ** Purpose : Compute mixed layer depth
!!
- !! ** Purpose: Compute mixed layer depth
- !!
- !! ** Method: Try to avoid 3 d arrays.
- !! - compute surface properties
- !! - initialize depths and model levels number
- !! - from bottom to top compute rho and
- !! check if rho > rho_surf +rho_c
- !! where rho_c is a density criteria given as argument
+ !! ** Method : - compute surface properties
+ !! - initialize depths and model levels number
+ !! - from bottom to top compute rho and
+ !! check if rho > rho_surf +rho_c
+ !! where rho_c is a density criteria given as argument
!!
- !! history :
- !! Original : J.M. Molines (October 2005)
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 10/2005 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, ik1, ik2, ikt
- INTEGER :: narg, iargc
- INTEGER :: npiglo, npjglo, npk
- INTEGER , DIMENSION(:,:), ALLOCATABLE :: mbathy !: number of w levels in water <= npk
- INTEGER , DIMENSION(:,:), ALLOCATABLE :: nmln1 ,& !: last level where rho > rho + rho_c1
- & nmln2 ,& !: last level where rho > rho + rho_c2
- & nmlnt !: last level where temp > temp +temp_c (temp_c<0)
-
- REAL(KIND=4) :: rho_c1=0.01, rho_c2=0.03, temp_c=-0.2
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temp, & !: temperatures
- & sal, & !: salinity
- & rho, & !: current density
- & rho_surf, & !: surface density
- & tem_surf, & !: surface temperature
- & hmlp1 , & !: mixed layer depth based on density criterium 1
- & hmlp2 , & !: mixed layer depth based on density criterium 2
- & hmlt , & !: mixed layer depth based on Temp Criterium
- & zmask_surf , & !: mixed layer depth
- & zmask !: tmask at current level
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw !: depth of w levels
-
- CHARACTER(LEN=256) :: cfilet, coordzgr='mesh_zgr.nc'
- CHARACTER(LEN=256) :: cbathy='bathy_level.nc'
-
- ! output stuff
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(3) :: ipk, id_varout !: only one output variable
- REAL(KIND=4), DIMENSION(1) :: tim,dep !: time output
- CHARACTER(LEN=256) :: cfileout='mxl.nc'
-
- TYPE(variable), DIMENSION(3) :: typvar !: structure for attributes
-
- LOGICAL :: lexist !: flag for existence of bathy_level file
-
- !! 0- Get started ..
- !!
- ! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 1 ) THEN
- PRINT *,' Usage : cdfmxl gridTfile '
- PRINT *,' Files mesh_zgr.nc must be in the current directory ^**'
- PRINT *,' Output on mxl.nc '
- PRINT *,' variable somxl010 = mld on density criterium 0.01'
- PRINT *,' variable somxl030 = mld on density criterium 0.03'
- PRINT *,' variable somxlt02 = mld on temperature criterium -0.2'
- PRINT *,' ^** : In case of FULL STEP run, bathy_level.nc must also be in the directory'
+
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ik1, ik2, ikt ! k vertical index of mixed layers
+ INTEGER(KIND=4) :: narg, iargc ! browse line
+ INTEGER(KIND=4) :: npiglo, npjglo ! domain size
+ INTEGER(KIND=4) :: npk, npt ! domain size
+ INTEGER(KIND=4) :: ncout, ierr ! ncid of output file, error status
+ INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: mbathy ! number of w levels in water <= npk
+ INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmln1 ! last level where rho > rho + rho_c1
+ INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmln2 ! last level where rho > rho + rho_c1
+ INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmlnt ! last level where rho > rho + rho_c1
+ INTEGER(KIND=4), DIMENSION(3) :: ipk, id_varout ! levels and varid's of output vars
+
+ REAL(KIND=4) :: rho_c1=0.01 ! 1rst density criterium
+ REAL(KIND=4) :: rho_c2=0.03 ! 2nd density criterium
+ REAL(KIND=4) :: temp_c=-0.2 ! temperature criterium
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rtem ! temperature
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rsal ! salinity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rho ! density
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rho_surf ! surface density
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tem_surf ! surface temperature
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask_surf ! surface tmask
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! level tmask
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmlp1 ! mxl depth based on density criterium 1
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmlp2 ! mxl depth based on density criterium 2
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmlt ! mxl depth based on temperature criterium
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of w levels
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(1) :: rdep ! dummy depth for output
+
+ CHARACTER(LEN=256) :: cf_tfil ! input T file
+ CHARACTER(LEN=256) :: cf_out='mxl.nc'! output file name
+
+ TYPE(variable), DIMENSION(3) :: stypvar ! structure for attributes
+
+ LOGICAL :: lexist ! flag for existence of bathy_level file
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfmxl T-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute 3 estimates of the mixed layer depth from temperature'
+ PRINT *,' and salinity given in the input file, based on 3 different criteria:'
+ PRINT *,' 1- Density criterium (0.01 kg/m3 difference between surface and MLD)'
+ PRINT *,' 2- Density criterium (0.03 kg/m3 difference between surface and MLD)'
+ PRINT *,' 3- Temperature criterium (0.2 C absolute difference between surface '
+ PRINT *,' and MLD)'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : input netcd file (gridT)'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fzgr)
+ PRINT *,' In case of FULL STEP configuration, ',TRIM(cn_fbathylev),' is also required.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : somxl010 = mld on density criterium 0.01'
+ PRINT *,' somxl030 = mld on density criterium 0.03'
+ PRINT *,' mld on temperature criterium -0.2'
STOP
ENDIF
- CALL getarg (1, cfilet)
+
+ CALL getarg (1, cf_tfil)
+
+ IF ( chkfile(cf_tfil) .OR. chkfile(cn_fzgr) ) STOP ! missing file
! read dimensions
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- dep(1) = 0.
- ipk(:)= npk ! all variables ( output are 2D)
-
- typvar(1)%name= 'somxl010'
- typvar(2)%name= 'somxl030'
- typvar(3)%name= 'somxlt02'
- typvar%units='m'
- typvar%missing_value=0.
- typvar%valid_min= 0.
- typvar%valid_max= 7000.
- typvar(1)%long_name='Mixed_Layer_Depth_on_0.01_rho_crit'
- typvar(2)%long_name='Mixed_Layer_Depth_on_0.03_rho_crit'
- typvar(3)%long_name='Mixed_Layer_Depth_on_-0.2_temp_crit'
- typvar(1)%short_name='somxl010'
- typvar(2)%short_name='somxl030'
- typvar(3)%short_name='somxlt02'
- typvar%online_operation='N/A'
- typvar%axis='TYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE (temp(npiglo,npjglo), sal(npiglo,npjglo), rho(npiglo,npjglo))
- ALLOCATE (rho_surf(npiglo,npjglo) ,tem_surf(npiglo,npjglo))
- ALLOCATE (zmask(npiglo,npjglo),zmask_surf(npiglo,npjglo) )
- ALLOCATE (hmlp1(npiglo,npjglo),hmlp2(npiglo,npjglo), hmlt(npiglo,npjglo) )
- ALLOCATE (mbathy(npiglo,npjglo) )
- ALLOCATE (nmln1(npiglo,npjglo), nmln2(npiglo,npjglo),nmlnt(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
-
- ! read mbathy and gdepw use real temp(:,:) as template (getvar is used for real only)
- INQUIRE (FILE=cbathy, EXIST=lexist)
- IF ( lexist ) THEN
- temp(:,:) = getvar(cbathy,'Bathy_level',1, npiglo, npjglo)
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
+
+ rdep(1) = 0.
+
+ ipk(:) = 1
+ stypvar(1)%cname = 'somxl010'
+ stypvar(2)%cname = 'somxl030'
+ stypvar(3)%cname = 'somxlt02'
+ stypvar%cunits = 'm'
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = 0.
+ stypvar%valid_max = 7000.
+ stypvar(1)%clong_name = 'Mixed_Layer_Depth_on_0.01_rho_crit'
+ stypvar(2)%clong_name = 'Mixed_Layer_Depth_on_0.03_rho_crit'
+ stypvar(3)%clong_name = 'Mixed_Layer_Depth_on_-0.2_temp_crit'
+ stypvar(1)%cshort_name = 'somxl010'
+ stypvar(2)%cshort_name = 'somxl030'
+ stypvar(3)%cshort_name = 'somxlt02'
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE (rtem(npiglo,npjglo), rsal(npiglo,npjglo), rho(npiglo,npjglo) )
+ ALLOCATE (rho_surf(npiglo,npjglo), tem_surf(npiglo,npjglo) )
+ ALLOCATE (tmask(npiglo,npjglo), tmask_surf(npiglo,npjglo) )
+ ALLOCATE (hmlp1(npiglo,npjglo), hmlp2(npiglo,npjglo), hmlt(npiglo,npjglo) )
+ ALLOCATE (mbathy(npiglo,npjglo) )
+ ALLOCATE (nmln1(npiglo,npjglo), nmln2(npiglo,npjglo), nmlnt(npiglo,npjglo))
+ ALLOCATE (gdepw(npk), tim(npt) )
+
+ ! read mbathy and gdepw use real rtem(:,:) as template (getvar is used for real only)
+ IF ( chkfile( cn_fbathylev) ) THEN
+ PRINT *, 'Read mbathy in ', TRIM(cn_fzgr),' ...'
+ rtem(:,:) = getvar(cn_fzgr, 'mbathy', 1, npiglo, npjglo)
ELSE
- temp(:,:) = getvar(coordzgr,'mbathy',1, npiglo, npjglo)
+ rtem(:,:) = getvar(cn_fbathylev, cn_bathylev, 1, npiglo, npjglo)
ENDIF
- mbathy(:,:) = temp(:,:)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- !! 1- Get surface properties
- !!
- ! read surface T and S and deduce land-mask from salinity
- temp(:,:) = getvar(cfilet, 'votemper', 1 ,npiglo,npjglo)
- sal (:,:) = getvar(cfilet, 'vosaline', 1 ,npiglo,npjglo)
- zmask(:,:) = 1.; WHERE ( sal == 0. ) zmask = 0.
- zmask_surf(:,:) = zmask(:,:)
-
- ! compute rho_surf
- rho_surf(:,:) = sigma0 ( temp,sal,npiglo,npjglo )* zmask(:,:)
- tem_surf(:,:) = temp(:,:)
-
- ! Initialization to the number of w ocean point mbathy
- nmln1(:,:) = mbathy(:,:)
- nmln2(:,:) = mbathy(:,:)
- nmlnt(:,:) = mbathy(:,:)
-
- !! 2- determine mixed layer
- !!
- ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1)
- ! (rhop defined at t-point, thus jk-1 for w-level just above)
- DO jk = npk-1, 2, -1
- temp(:,:) = getvar(cfilet, 'votemper', jk ,npiglo,npjglo)
- sal (:,:) = getvar(cfilet, 'vosaline', jk ,npiglo,npjglo)
- zmask(:,:) = 1. ; WHERE ( sal == 0. ) zmask = 0.
- rho(:,:) = sigma0 ( temp,sal,npiglo,npjglo )* zmask(:,:)
-
- DO jj = 1, npjglo
- DO ji = 1, npiglo
- IF( rho(ji,jj) > rho_surf(ji,jj) + rho_c1 ) nmln1(ji,jj) = jk
- IF( rho(ji,jj) > rho_surf(ji,jj) + rho_c2 ) nmln2(ji,jj) = jk
- IF( ABS(temp(ji,jj) - tem_surf(ji,jj)) > ABS( temp_c) ) nmlnt(ji,jj) = jk
- END DO
- END DO
- END DO
-
- ! Mixed layer depth
- DO jj = 1, npjglo
- DO ji = 1, npiglo
- ik1 = nmln1(ji,jj) ; ik2 = nmln2(ji,jj) ; ikt = nmlnt(ji,jj)
- hmlp1 (ji,jj) = gdepw(ik1) * zmask_surf(ji,jj)
- hmlp2 (ji,jj) = gdepw(ik2) * zmask_surf(ji,jj)
- hmlt (ji,jj) = gdepw(ikt) * zmask_surf(ji,jj)
- END DO
- END DO
-
- !! 3- Write output file
- !!
- ncout = create(cfileout, cfilet, npiglo,npjglo,1)
- ierr = createvar(ncout ,typvar ,3, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,1,pdep=dep)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr = putvar(ncout, id_varout(1) ,hmlp1, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(2) ,hmlp2, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(3) ,hmlt , 1,npiglo, npjglo)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ierr=closeout(ncout)
+ mbathy(:,:) = rtem(:,:)
+ gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk)
+
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1 )
+ ierr = createvar (ncout, stypvar, 3, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=rdep)
+
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ DO jt=1,npt
+ ! read surface T and S and deduce land-mask from salinity
+ rtem( :,:) = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=jt )
+ rsal (:,:) = getvar(cf_tfil, cn_vosaline, 1, npiglo, npjglo, ktime=jt )
+ IF (jt == 1 ) THEN
+ tmask(:,:) = 1.; WHERE ( rsal == 0. ) tmask = 0.
+ tmask_surf(:,:) = tmask(:,:)
+ ENDIF
+
+ ! compute rho_surf
+ rho_surf(:,:) = sigma0 (rtem, rsal, npiglo, npjglo )* tmask(:,:)
+ tem_surf(:,:) = rtem(:,:)
+
+ ! Initialization to the number of w ocean point mbathy
+ nmln1(:,:) = mbathy(:,:)
+ nmln2(:,:) = mbathy(:,:)
+ nmlnt(:,:) = mbathy(:,:)
+
+ ! compute mixed layer depth
+ ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1)
+ ! (rhop defined at t-point, thus jk-1 for w-level just above)
+ DO jk = npk-1, 2, -1
+ rtem (:,:) = getvar(cf_tfil, cn_votemper, jk ,npiglo, npjglo, ktime=jt)
+ rsal (:,:) = getvar(cf_tfil, cn_vosaline, jk ,npiglo, npjglo, ktime=jt)
+ tmask(:,:) = 1. ; WHERE ( rsal == 0. ) tmask = 0.
+ rho (:,:) = sigma0 (rtem, rsal, npiglo, npjglo )* tmask(:,:)
+
+ DO jj = 1, npjglo
+ DO ji = 1, npiglo
+ IF( rho(ji,jj) > rho_surf(ji,jj) + rho_c1 ) nmln1(ji,jj) = jk
+ IF( rho(ji,jj) > rho_surf(ji,jj) + rho_c2 ) nmln2(ji,jj) = jk
+ IF( ABS(rtem(ji,jj) - tem_surf(ji,jj)) > ABS( temp_c) ) nmlnt(ji,jj) = jk
+ END DO
+ END DO
+ END DO
+
+ ! Mixed layer depth
+ DO jj = 1, npjglo
+ DO ji = 1, npiglo
+ ik1 = nmln1(ji,jj) ; ik2 = nmln2(ji,jj) ; ikt = nmlnt(ji,jj)
+ hmlp1 (ji,jj) = gdepw(ik1) * tmask_surf(ji,jj)
+ hmlp2 (ji,jj) = gdepw(ik2) * tmask_surf(ji,jj)
+ hmlt (ji,jj) = gdepw(ikt) * tmask_surf(ji,jj)
+ END DO
+ END DO
+
+ ierr = putvar(ncout, id_varout(1), hmlp1, 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(2), hmlp2, 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(3), hmlt , 1, npiglo, npjglo, ktime=jt)
+
+ END DO ! time loop
+
+ ierr = closeout(ncout)
END PROGRAM cdfmxl
diff --git a/cdfmxlhcsc.f90 b/cdfmxlhcsc.f90
index 077b71a..0f4be59 100644
--- a/cdfmxlhcsc.f90
+++ b/cdfmxlhcsc.f90
@@ -1,261 +1,289 @@
PROGRAM cdfmxlhcsc
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfmxlhcsc ***
+ !!======================================================================
+ !! *** PROGRAM cdfmxlhcsc ***
+ !!=====================================================================
+ !! ** Purpose : Compute mixed layer depth and the heat and salt contents
+ !! in the mixed layer. There is an option to limit this
+ !! computation between hmin and ml depth. For that, hmin is
+ !! given as last argument (>0) with no arguments, hmin is
+ !! supposed to be 0.
!!
- !! ** Purpose: Compute mixed layer depth and the heat and salt contents
- !! in the mixed layer. There is an option to limit this computation
- !! between hmin and ml depth. For that, hmin is given as last argument (>0)
- !! with no arguments, hmin os supposed to be 0.
- !!
- !! ** Method to compute MLD:
- !! Try to avoid 3 d arrays.
- !! - compute surface properties
- !! - initialize depths and model levels number
- !! - from bottom to top compute rho and
- !! check if rho > rho_surf +rho_c
- !! where rho_c is a density criteria given as argument
- !! ** Method to compute HC/SC in MLD:
- !! Compute the sum ( rho cp T * e1 * e2 * e3 * mask )
- !! ( cp S * e1 * e2 * e3 * mask )
- !! for the MLD computed before, or in the water volume between hmin and MLD
+ !! ** Method : This program is a merge of cdfmxl, cdfmxlheatc and
+ !! cdfmxlsaltc.
+ !! MXL computation:
+ !! - compute surface properties
+ !! - initialize depths and model levels number
+ !! - from bottom to top compute rho and
+ !! check if rho > rho_surf +rho_c, where rho_c is a
+ !! density criteria given as argument
+ !! Heat Content and Salt Content:
+ !! HC = sum ( rho cp T * e1 * e2 * e3 * tmask )
+ !! SC = sum ( rho S * e1 * e2 * e3 * tmask )
+ !! where the sum is limited to the MXL, between hmin and
+ !! MLD
!!
- !! history :
- !! cdfmxl.f90 : Original : J.M. Molines (October 2005)
- !! cdfmxlheatc.f90 : Original : J.M. Molines (April 2006)
- !! Merging programs : M. Juza ( April 2007 )
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- !! * Modules used
+ !! History : 2.1 : 04/2007 : M. Juza : Merging of the programs
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, ik
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo, npjglo, npk !: size of the domain
- INTEGER , DIMENSION(:,:), ALLOCATABLE :: mbathy !: number of w levels in water <= npk
- INTEGER , DIMENSION(:,:), ALLOCATABLE :: nmln !: last level where rho > rho + val_crit
- !: or temp > temp + val_crit
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE ::temp, & !: temperatures
- & sal, & !: salinity
- & rho, & !: current density
- & rho_surf, & !: surface density
- & tem_surf, & !: surface temperature
- & hmld , & !: mixed layer depth based on criterium
- & zmask_surf , & !: mixed layer depth
- & zmask !: tmask at current level
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw !: depth of w levels
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: mask,zt,zs,e3
- REAL(KIND=8), PARAMETER :: rprho0=1020., rpcp=4000.
- REAL(KIND=8) :: zvol,zsum,zvol2d,zsurf, zsal3d
- REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: zmxlheatc,zmxlsaltc
- REAL(KIND=4) :: val, hmin = 0.
-
- TYPE(variable),DIMENSION(3) :: typvar !: extension for attributes
-
- CHARACTER(LEN=256) :: cfilet,critere,cdum
- CHARACTER(LEN=256) :: coordzgr='mesh_zgr.nc', coordhgr='mesh_hgr.nc' , cmask='mask.nc'
-
- ! output stuff
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(3) :: ipk, id_varout !: only one output variable
- REAL(KIND=4), DIMENSION(1) :: tim,dep !: time output
- CHARACTER(LEN=256), DIMENSION(3) :: cvarname
- CHARACTER(LEN=256) :: cfileout='mxlhcsc.nc'
-
- !! 0- Get started ..
- !!
- ! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 1 ) THEN
- PRINT *,' Usage : cdfmxlhcsc gridTfile crit val [hmin] '
- PRINT *,' crit = ''temperature'' or ''density'' criterium '
- PRINT *,' val = value of the criterium '
- PRINT *,' [hmin] = optional. If given limit depth integral from hmin to mld'
- PRINT *,' [hmin] = 0 by defaul, ie, compute over the whole mixed layer'
- PRINT *,'Compute MLD and HC/SC in the MLD'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc , mask.nc must be in the current directory'
- PRINT *,' Output on mxlhcsc.nc '
- PRINT *,' Output variables : - somxl010 (mld based on density criterium 0.01)'
- PRINT *,' (2D) or somxl030 (mld on density criterium 0.03)'
- PRINT *,' or somxlt02 (mld on temperature criterium -0.2)'
- PRINT *,' - somxlheatc (heat content computed in the MLD)'
- PRINT *,' - somxlsaltc (salt content computed in the MLD)'
+
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ik ! level indirect index
+ INTEGER(KIND=4) :: narg, iargc ! browse line
+ INTEGER(KIND=4) :: npiglo, npjglo ! domain size
+ INTEGER(KIND=4) :: npk, npt ! domaine size
+ INTEGER(KIND=4) :: ncout, ierr ! ncid of output file an error status
+ INTEGER(KIND=4), DIMENSION(3) :: ipk, id_varout ! levels and varid's of output vars
+ INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: mbathy ! number of w levels in water <= npk
+ INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: nmln ! last level where rho > rho + val_crit
+ ! or rtem > rtem + val_crit
+ REAL(KIND=4), PARAMETER :: rprho0=1020. ! reference density
+ REAL(KIND=4), PARAMETER :: rpcp=4000. ! specific heat of water
+ REAL(KIND=4) :: val ! criteria value
+ REAL(KIND=4) :: hmin = 0. ! minimum depth for vertical integration
+ REAL(KIND=4), DIMENSION(1) :: rdep ! dummy depth output
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of w points
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics (full step)
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rtem ! temperature
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rsal ! salinity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rho ! density (sigma-0)
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rho_surf ! surface density
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tem_surf ! surface temperature
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hmld ! mixed layer depth
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask_surf ! surface tmask
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! land sea mask of temperature
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3 ! vertical metrics
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmxlheatc ! mxl heat content
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmxlsaltc ! mxl salt content
+
+ TYPE(variable), DIMENSION(3) :: stypvar ! output attributes
+
+ CHARACTER(LEN=256) :: cf_tfil ! input file
+ CHARACTER(LEN=256) :: cf_out='mxlhcsc.nc' ! output file
+ CHARACTER(LEN=256) :: criteria ! type of criteria used for mld
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ LOGICAL :: lchk ! flag for missing files
+ LOGICAL :: lfull=.FALSE. ! flag for full step
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfmxlhcsc T-file criteria value [hmin]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the mixed layer depth, the heat content and salt content.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf input file for temperature and salinity (gridT).'
+ PRINT *,' criteria : one of temperature, t, T for temperature criteria.'
+ PRINT *,' or density, d, D for density criteria.'
+ PRINT *,' value : value of the criteria (eg: 0.2 for temp, 0.01 or 0.03 for dens)'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ hmin ] : limit the vertical integral from hmin to mld. By default, '
+ PRINT *,' hmin is set to 0 so that the integral is performed on the'
+ PRINT *,' whole mixed layer.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fhgr),' ',TRIM(cn_fzgr),' and ',TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : - somxl010 (mld based on density criterium 0.01)'
+ PRINT *,' (2D) or somxl030 (mld on density criterium 0.03)'
+ PRINT *,' or somxlt02 (mld on temperature criterium -0.2)'
+ PRINT *,' - somxlheatc (heat content computed in the MLD)'
+ PRINT *,' - somxlsaltc (salt content computed in the MLD)'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfmxl, cdfmxlheatc and cdfmxlsaltc.'
+ PRINT *,' '
STOP
ENDIF
- CALL getarg (1, cfilet)
- CALL getarg (2, critere)
- CALL getarg (3, cdum) ; READ(cdum,*) val
- IF ( narg == 4 ) THEN ; CALL getarg (4, cdum) ; READ(cdum,*) hmin ; ENDIF
+
+ CALL getarg (1, cf_tfil )
+ CALL getarg (2, criteria )
+ CALL getarg (3, cldum ) ; READ(cldum,*) val
+ IF ( narg == 4 ) THEN ; CALL getarg (4, cldum) ; READ(cldum,*) hmin ; ENDIF
+
+ lchk = chkfile (cn_fhgr)
+ lchk = chkfile (cn_fzgr) .OR. lchk
+ lchk = chkfile (cn_fmsk) .OR. lchk
+ lchk = chkfile (cf_tfil) .OR. lchk
+ IF ( lchk ) STOP ! missing files
! read dimensions
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
+ npiglo = getdim (cf_tfil, cn_x)
+ npjglo = getdim (cf_tfil, cn_y)
+ npk = getdim (cf_tfil, cn_z)
+ npt = getdim (cf_tfil, cn_t)
- dep(1) = 0.
- ipk(:) = 1
+ rdep(1) = 0.
+ ipk(:) = 1
! Variable Mixed Layer Depth
- IF ( critere == 'temperature' .AND. val==-0.2) THEN
- typvar(1) %name = 'somxlt02'
- typvar(1) %short_name = 'somxlt02'
- ELSE IF ( critere == 'density' .AND. val==0.01) THEN
- typvar(1) %name = 'somxl010'
- typvar(1) %short_name = 'somxl010'
- ELSE IF ( critere == 'density' .AND. val==0.03) THEN
- typvar(1) %name = 'somxl030'
- typvar(1) %short_name = 'somxl030'
- ENDIF
- typvar(1) %units = 'm'
- typvar(1) %long_name = ' Mixed Layer Depth'
- ! Variable Heat Content
- typvar(2) %name = 'somxlheatc'
- typvar(2) %units = '10^9 J/m2'
- typvar(2) %long_name = 'Mixed_Layer_Heat_Content'
- typvar(2) %short_name = 'somxlheatc'
- ! Variable Salt Content
- typvar(3) %name = 'somxlsaltc'
- typvar(3) %units = '10^6 kg/m2'
- typvar(3) %long_name = 'Mixed_Layer_Salt_Content'
- typvar(3) %short_name = 'somxlsaltc'
+ SELECT CASE ( criteria)
+ !
+ CASE ( 'Temperature', 'temperature', 't', 'T' )
+ WRITE(cldum,'(a,i2.2)' ) 'somxlt', INT(ABS(val)*10)
+ !
+ CASE ( 'Density', 'density', 'd', 'D' )
+ WRITE(cldum,'(a,i3.3)' ) 'somxl', INT((val)*1000)
+ !
+ CASE DEFAULT
+ PRINT *,TRIM(criteria),' : criteria not understood'
+ STOP
+ END SELECT
+ stypvar(1)%cname = TRIM(cldum)
+ stypvar(1)%cshort_name = TRIM(cldum)
+ stypvar(1)%cunits = 'm'
+ stypvar(1)%clong_name = 'Mixed Layer Depth'
- !PRINT *, 'npiglo=', npiglo
- !PRINT *, 'npjglo=', npjglo
- !PRINT *, 'npk =', npk
+ ! Variable Heat Content
+ stypvar(2)%cname = 'somxlheatc'
+ stypvar(2)%cunits = '10^9 J/m2'
+ stypvar(2)%clong_name = 'Mixed_Layer_Heat_Content'
+ stypvar(2)%cshort_name = 'somxlheatc'
+ ! Variable Salt Content
+ stypvar(3)%cname = 'somxlsaltc'
+ stypvar(3)%cunits = '10^6 kg/m2'
+ stypvar(3)%clong_name = 'Mixed_Layer_Salt_Content'
+ stypvar(3)%cshort_name = 'somxlsaltc'
! Allocate arrays
- ALLOCATE (temp(npiglo,npjglo),sal(npiglo,npjglo))
- ALLOCATE (zmask(npiglo,npjglo),zmask_surf(npiglo,npjglo))
- ALLOCATE (mbathy(npiglo,npjglo))
- ALLOCATE (nmln(npiglo,npjglo),hmld(npiglo,npjglo))
- ALLOCATE (mask(npiglo,npjglo))
- ALLOCATE (zmxlheatc(npiglo,npjglo),zmxlsaltc(npiglo,npjglo))
- ALLOCATE (zt(npiglo,npjglo),zs(npiglo,npjglo))
- ALLOCATE (e3(npiglo,npjglo))
- ALLOCATE (gdepw(npk))
-
- ! read mbathy and gdepw use real temp(:,:) as template (getvar is used for real only)
- temp(:,:) = getvar(coordzgr,'mbathy',1, npiglo, npjglo)
- mbathy(:,:) = temp(:,:)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- ! Initialization to the number of w ocean point mbathy
- nmln(:,:) = mbathy(:,:)
-
- !! 1- Get surface properties
- !!
- ! read surface T and S and deduce land-mask from salinity
- temp(:,:) = getvar(cfilet, 'votemper', 1 ,npiglo,npjglo)
- sal (:,:) = getvar(cfilet, 'vosaline', 1 ,npiglo,npjglo)
- zmask(:,:) = 1.; WHERE ( sal == 0. ) zmask = 0.
- zmask_surf(:,:) = zmask(:,:)
-
-
- SELECT CASE ( critere )
- CASE ( 'temperature','Temperature' ) !!!!! Temperature criterium
- ! temp_surf
- ALLOCATE (tem_surf(npiglo,npjglo))
- tem_surf(:,:) = temp(:,:)
-
- ! Last w-level at which ABS(temp-temp_surf)>=ABS(val) (starting from jpk-1)
- ! (temp defined at t-point, thus jk-1 for w-level just above)
- DO jk = npk-1, 2, -1
- temp(:,:) = getvar(cfilet, 'votemper', jk ,npiglo,npjglo)
- DO jj = 1, npjglo
- DO ji = 1, npiglo
- IF( ABS(temp(ji,jj) - tem_surf(ji,jj)) > ABS(val) ) nmln(ji,jj) = jk
- ENDDO
+ ALLOCATE (rtem(npiglo,npjglo),rsal(npiglo,npjglo) )
+ ALLOCATE (tmask(npiglo,npjglo),tmask_surf(npiglo,npjglo) )
+ ALLOCATE (mbathy(npiglo,npjglo) )
+ ALLOCATE (nmln(npiglo,npjglo),hmld(npiglo,npjglo) )
+ ALLOCATE (dmxlheatc(npiglo,npjglo),dmxlsaltc(npiglo,npjglo))
+ ALLOCATE (e3(npiglo,npjglo) )
+ ALLOCATE (gdepw(npk), tim(npt) )
+
+ ! read mbathy and gdepw use real rtem(:,:) as template (getvar is used for real only)
+ INQUIRE (FILE=cn_fbathylev, EXIST=lfull)
+ IF ( lfull ) THEN
+ rtem(:,:) = getvar(cn_fbathylev, cn_bathylev, 1, npiglo, npjglo)
+ ALLOCATE ( e31d(npk) )
+ ELSE
+ rtem(:,:) = getvar(cn_fzgr, 'mbathy', 1, npiglo, npjglo)
+ ENDIF
+
+ mbathy(:,:) = rtem(:,:)
+ gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk)
+ IF ( lfull ) e31d = getvare3(cn_fzgr, cn_ve3t, npk )
+
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1 )
+ ierr = createvar (ncout, stypvar, 3, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=rdep)
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ DO jt = 1, npt ! major time loop
+ ! MXL computation
+ !---------------
+ ! Initialization to the number of w ocean point mbathy
+ nmln(:,:) = mbathy(:,:)
+
+ ! read surface tmask
+ tmask_surf(:,:) = getvar(cn_fmsk, 'tmask', 1, npiglo, npjglo)
+
+ SELECT CASE ( criteria )
+ !
+ CASE ( 'temperature', 'Temperature', 'T', 't' ) ! Temperature criteria
+ ! temp_surf
+ IF (.NOT. ALLOCATED ( tem_surf) ) ALLOCATE (tem_surf(npiglo,npjglo))
+ tem_surf(:,:) = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=jt )
+
+ ! Last w-level at which ABS(rtem-tem_surf)>=ABS(val) (starting from jpk-1)
+ ! (rtem defined at t-point, thus jk-1 for w-level just above)
+ DO jk = npk-1, 2, -1
+ rtem(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt)
+ WHERE ( ABS(rtem - tem_surf) > ABS(val) ) nmln = jk
+ ENDDO
+ !
+ CASE ( 'density', 'Density', 'D', 'd' ) ! Density criteria
+ ! compute rho_surf
+ IF ( .NOT. ALLOCATED( rho_surf ) ) ALLOCATE (rho_surf(npiglo,npjglo) )
+ IF ( .NOT. ALLOCATED( rho ) ) ALLOCATE (rho (npiglo,npjglo) )
+ rtem(:,:) = getvar(cf_tfil, cn_votemper, 1, npiglo, npjglo, ktime=jt)
+ rsal(:,:) = getvar(cf_tfil, cn_vosaline, 1, npiglo, npjglo, ktime=jt)
+ rho_surf(:,:) = sigma0 (rtem, rsal, npiglo, npjglo )* tmask_surf(:,:)
+
+ ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1)
+ ! (rhop defined at t-point, thus jk-1 for w-level just above)
+ DO jk = npk-1, 2, -1
+ rtem( :,:) = getvar(cf_tfil, cn_votemper, jk ,npiglo, npjglo, ktime=jt)
+ rsal( :,:) = getvar(cf_tfil, cn_vosaline, jk ,npiglo, npjglo, ktime=jt)
+ tmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo )
+ rho( :,:) = sigma0 (rtem, rsal, npiglo, npjglo ) * tmask(:,:)
+ WHERE ( rho > rho_surf + val ) nmln = jk
+ ENDDO
+ !
+ CASE DEFAULT
+ PRINT *,' ERROR: Criterium on ', TRIM(criteria),' not suported' ; STOP
+ !
+ END SELECT
+
+ !! Determine mixed layer depth
+ DO jj = 1, npjglo
+ DO ji = 1, npiglo
+ ik = nmln(ji,jj)
+ hmld (ji,jj) = gdepw(ik) * tmask_surf(ji,jj)
ENDDO
ENDDO
+ !!Compute heat and salt contents in the mixed layer depth
+ !!-------------------------------------------------------
+ !!
+ dmxlheatc(:,:) = 0.d0
+ dmxlsaltc(:,:) = 0.d0
- CASE ( 'density', 'Density' ) !!!!! Density criterium
- ! compute rho_surf
- ALLOCATE (rho(npiglo,npjglo))
- ALLOCATE (rho_surf(npiglo,npjglo))
- rho_surf(:,:) = sigma0 ( temp,sal,npiglo,npjglo )* zmask(:,:)
-
- ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1)
- ! (rhop defined at t-point, thus jk-1 for w-level just above)
- DO jk = npk-1, 2, -1
- temp(:,:) = getvar(cfilet, 'votemper', jk ,npiglo,npjglo)
- sal (:,:) = getvar(cfilet, 'vosaline', jk ,npiglo,npjglo)
- zmask(:,:) = 1. ; WHERE ( sal == 0. ) zmask = 0.
- rho(:,:) = sigma0 ( temp,sal,npiglo,npjglo )* zmask(:,:)
- DO jj = 1, npjglo
- DO ji = 1, npiglo
- IF( rho(ji,jj) > rho_surf(ji,jj) + val ) nmln(ji,jj) = jk
- ENDDO
- ENDDO
- ENDDO
-
- CASE DEFAULT
- PRINT *,' ERROR: Criterium on ', TRIM(critere),' not suported' ; STOP
- END SELECT
-
- !! 2- Determine mixed layer depth
- DO jj = 1, npjglo
- DO ji = 1, npiglo
- ik = nmln(ji,jj)
- hmld (ji,jj) = gdepw(ik) * zmask_surf(ji,jj)
- ENDDO
- ENDDO
+ DO jk = 1,npk
+ ! Get temperature and salinity at jk
+ rtem(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt)
+ rsal(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt)
+ tmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo )
- !! 3- Compute heat and salt contents in the mixed layer depth
- !!
- zvol=0.d0
- zsum=0.d0
- zmxlheatc(:,:)=0.d0
- zmxlsaltc(:,:)=0.d0
- DO jk = 1,npk
- ! Get temperature and salinity at jk
- zt(:,:) = getvar(cfilet, 'votemper',jk ,npiglo,npjglo)
- zs(:,:) = getvar(cfilet, 'vosaline',jk ,npiglo,npjglo)
- mask(:,:)= getvar(cmask, 'tmask', jk ,npiglo,npjglo)
- ! Get e3 at level jk (ps...)
- e3(:,:) = getvar(coordzgr,'e3t_ps', jk ,npiglo,npjglo, ldiom=.true.)
- ! e3 is used as a flag for the mixed layer; it is 0 outside the mixed layer
- e3(:,:)=MAX(0.,MIN(e3,hmld-gdepw(jk)) + MIN(e3,gdepw(jk)+e3-hmin)-e3)
-
- ! JMM : I think next line is useless as the masking of the product by e3...
- WHERE ( e3 == 0 ) mask = 0.
- ! Heat and salt contents
- zvol2d=SUM(e3*mask)
- zmxlheatc(:,:)=zmxlheatc(:,:) + zt*e3*mask
- zmxlsaltc(:,:)=zmxlsaltc(:,:) + zs*e3*mask
- ! We want to scan all deptht from to to bottom and as we eventually skip between surf and hmin ...
-! IF ( zvol2d /= 0 ) THEN
-! ! go on !
-! ELSE
-! ! no more layer below !
-! EXIT ! get out of the jk loop
-! ENDIF
-
- ENDDO
-
- !! Heat and salt contents (10^9.J/m2 and 10^6.kg/m2)
- zmxlheatc = zmxlheatc*rprho0*rpcp*(10.)**(-9)
- zmxlsaltc = zmxlsaltc*rprho0*(10.)**(-6)
-
-
- !! 4- Write output file
- !!
- ncout = create(cfileout, cfilet, npiglo,npjglo,1)
- ierr = createvar(ncout ,typvar,3, ipk,id_varout )
- ierr = putheadervar(ncout, cfilet,npiglo, npjglo,1,pdep=dep)
- tim = getvar1d(cfilet,'time_counter',1)
- ierr = putvar(ncout, id_varout(1) ,hmld, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(2) ,REAL(zmxlheatc), 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(3) ,REAL(zmxlsaltc), 1,npiglo, npjglo)
- ierr = putvar1d(ncout,tim,1,'T')
+ IF ( lfull ) THEN
+ e3(:,:) = e31d(jk)
+ ELSE
+ ! Get e3 at level jk (ps...)
+ e3(:,:) = getvar(cn_fzgr, 'e3t_ps', jk ,npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+
+ ! e3 is used as a flag for the mixed layer; it is 0 outside the mixed layer
+ e3(:,:) = MAX(0., MIN(e3, hmld-gdepw(jk) ) + MIN(e3, gdepw(jk)+ e3-hmin) - e3)
+
+ ! Heat and salt contents
+ dmxlheatc(:,:) = dmxlheatc(:,:) + rtem * e3 * tmask *1.d0
+ dmxlsaltc(:,:) = dmxlsaltc(:,:) + rsal * e3 * tmask *1.d0
+
+ END DO
+
+ !! Heat and salt contents (10^9.J/m2 and 10^6.kg/m2)
+ dmxlheatc = dmxlheatc *rprho0 *rpcp * 1.d-9
+ dmxlsaltc = dmxlsaltc *rprho0 * 1.d-6
+
+ ierr = putvar(ncout, id_varout(1), hmld, 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(2), REAL(dmxlheatc), 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(3), REAL(dmxlsaltc), 1, npiglo, npjglo, ktime=jt)
+
+ END DO ! time loop
ierr = closeout(ncout)
diff --git a/cdfmxlheatc-full.f90 b/cdfmxlheatc-full.f90
deleted file mode 100644
index 13565b9..0000000
--- a/cdfmxlheatc-full.f90
+++ /dev/null
@@ -1,138 +0,0 @@
-PROGRAM cdfmxlheatc_full
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmxlheatc_full ***
- !!
- !! ** Purpose : Compute the heat content in the mixed layer
- !! FULL STEPS
- !!
- !! ** Method : compute the sum ( rho cp T * e1 *e2 * e3 *mask )
- !! for the mixed layer stored into gridT file
- !!
- !!
- !! history ;
- !! Original : J.M. Molines ( 2006) April
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jk
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zt !: metrics, temperature
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e32d
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: e3
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmxl !: mxl depth
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: npiglo x npjglo
- REAL(KIND=4),DIMENSION(:), ALLOCATABLE :: gdepw !:
-
- REAL(KIND=8), PARAMETER :: rprho0=1020., rpcp=4000.
- REAL(KIND=8) :: zvol, zsum, zvol2d, zsum2d, zsurf
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zmxlheatc !: mxl depth
-
- CHARACTER(LEN=256) :: cfilet
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmask='mask.nc'
-
- ! Output stuff
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(1) :: ipk, id_varout !: only one output variable
- REAL(KIND=4), DIMENSION(1) :: tim,dep !: time output
- CHARACTER(LEN=256) :: cfileout='mxlheatc.nc'
-
- TYPE(variable), DIMENSION(1) :: typvar !: extension for attributes
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmxlheatc-full gridTfile '
- PRINT *,' Computes the heat content in the mixed layer (Joules)'
- PRINT *,' FULL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output ncdf file mxlheatc.nc, variable 2D somxlheatc'
- STOP
- ENDIF
-
- CALL getarg (1, cfilet)
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- dep(1) = 0.
- ipk(:) = 1
- typvar(1)%name = 'somxlheatc'
- typvar(1)%units = 'J/m2'
- typvar(1)%missing_value = 0.
- typvar(1)%valid_min = -1.e15
- typvar(1)%valid_max = 1.e15
- typvar(1)%long_name ='Mixed_Layer_Heat_Content'
- typvar(1)%short_name = 'somxlheatc'
- typvar(1)%online_operation = 'N/A'
- typvar(1)%axis = 'TYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) , zmxlheatc(npiglo, npjglo) )
- ALLOCATE ( zt(npiglo,npjglo) ,zmxl(npiglo,npjglo) )
- ALLOCATE ( e3(npk) ,e32d(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
-
- ! Initialize output file
- ncout = create(cfileout, cfilet, npiglo,npjglo,1)
- ierr=createvar(ncout ,typvar,1, ipk,id_varout )
- ierr=putheadervar(ncout, cfilet,npiglo, npjglo,1,pdep=dep)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ! Read vertical depth at w point
- gdepw(:)=getvare3(coordzgr,'gdepw',npk)
- e3(:) = getvare3(coordzgr,'e3t',npk)
-
- ! Read Mixed Layer Depth in the gridT file
- ! Note that it is usually a mean value (5-day mean for instance). Therefore,
- ! in general it is not a particular value of gdepw.
- zmxl(:,:)=getvar(cfilet,'somxl010',1,npiglo,npjglo)
-
- zvol=0.d0
- zsum=0.d0
- zmxlheatc(:,:)=0.d0
- DO jk = 1,npk
- e32d(:,:)=e3(jk)
- ! Get temperatures at jk
- zt(:,:)= getvar(cfilet, 'votemper', jk ,npiglo,npjglo)
- zmask(:,:)=getvar(cmask,'tmask',jk,npiglo,npjglo)
-
-
- ! e3 is used as a flag for the mixed layer; It is 0 outside the mixed layer
- e32d(:,:)=MAX ( 0., MIN(e32d,zmxl-gdepw(jk) ) )
- WHERE ( e32d == 0 ) zmask = 0.
-
- zvol2d=SUM( e32d * zmask)
- zmxlheatc(:,:)=zmxlheatc(:,:)+ zt*e32d*zmask
-
- IF (zvol2d /= 0 )THEN
- ! go on !
- ELSE
- ! no more layer below !
- EXIT ! get out of the jk loop
- ENDIF
-
- END DO
-
- ! Output to netcdf file : J/m2
- zmxlheatc=zmxlheatc*rprho0*rpcp
- ierr = putvar(ncout, id_varout(1) ,REAL(zmxlheatc), 1,npiglo, npjglo)
- ierr=closeout(ncout)
-
-END PROGRAM cdfmxlheatc_full
diff --git a/cdfmxlheatc.f90 b/cdfmxlheatc.f90
index ce4c425..f2bc33e 100644
--- a/cdfmxlheatc.f90
+++ b/cdfmxlheatc.f90
@@ -1,136 +1,177 @@
PROGRAM cdfmxlheatc
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmxlheatc ***
+ !!======================================================================
+ !! *** PROGRAM cdfmxlheatc ***
+ !!=====================================================================
+ !! ** Purpose : Compute the heat content in the mixed layer. Work for
+ !! partial steps (default) or full step (-full option)
!!
- !! ** Purpose : Compute the heat content in the mixed layer
- !! PARTIAL STEPS
- !!
- !! ** Method : compute the sum ( rho cp T * e1 *e2 * e3 *mask )
- !! for the mixed layer stored into gridT file
+ !! ** Method : compute the sum ( rho cp T * e1 *e2 * e3 *mask )
+ !! for the mixed layer stored into gridT file
!!
- !!
- !! history ;
- !! Original : J.M. Molines ( 2006) April
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 04/2006 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ USE modutils
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e3, zt !: metrics, temperature
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmxl !: mxl depth
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: npiglo x npjglo
- REAL(KIND=4),DIMENSION(:), ALLOCATABLE :: gdepw !:
-
- REAL(KIND=8), PARAMETER :: rprho0=1020., rpcp=4000.
- REAL(KIND=8) :: zvol, zsum, zvol2d, zsum2d, zsurf
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zmxlheatc !: mxl depth
-
- CHARACTER(LEN=256) :: cfilet
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmask='mask.nc'
-
- ! Output stuff
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(1) :: ipk, id_varout !: only one output variable
- REAL(KIND=4), DIMENSION(1) :: tim,dep !: time output
- CHARACTER(LEN=256) :: cfileout='mxlheatc.nc'
-
- TYPE(variable), DIMENSION(1) :: typvar !: extension for attributes
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
+
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain,
+ INTEGER(KIND=4) :: ncout, ierr ! ncid and error status
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid's of output vars
+
+ REAL(KIND=4), PARAMETER :: rprho0=1020. ! rho reference density
+ REAL(KIND=4), PARAMETER :: rpcp=4000. ! calorific capacity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3 ! metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zt ! temperature in the MXL
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmxl ! depth of the MXL
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! vertical levels
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metric full
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(1) :: rdep ! dummy depth output
+
+ REAL(KIND=8) :: dvol ! total volume
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmxlheatc ! heat content
+
+ CHARACTER(LEN=256) :: cf_tfil ! input file name
+ CHARACTER(LEN=256) :: cf_out='mxlheatc.nc'! output file
+ CHARACTER(LEN=256) :: cv_out='somxlheatc' ! output file
+ CHARACTER(LEN=256) :: cglobal ! global attribute
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ TYPE(variable), DIMENSION(1) :: stypvar ! stucture for attributes (output)
+
+ LOGICAL :: lfull=.FALSE. ! full step flag
+ LOGICAL :: lchk ! file existence flag (true if missing)
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmxlheatc gridTfile '
- PRINT *,' Computes the heat content in the mixed layer (Joules)'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output ncdf file mxlheatc.nc, variable 2D somxlheatc'
+ PRINT *,' usage : cdfmxlheatc T-file [-full]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computed the heat content in the mixed layer (Joules/m2).'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf input file with temperature and mld (gridT).'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ -full ] : for full step configurations, default is partial step.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fzgr),' and ',TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_out),' (Joules/m2)'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfmxl, cdfmxlhcsc and cdfmxlsaltc.'
+ PRINT *,' '
STOP
ENDIF
- CALL getarg (1, cfilet)
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- dep(1) = 0.
- ipk(:) = 1
- typvar(1)%name = 'somxlheatc'
- typvar(1)%units = 'J/m2'
- typvar(1)%missing_value = 0.
- typvar(1)%valid_min = -1.e15
- typvar(1)%valid_max = 1.e15
- typvar(1)%long_name ='Mixed_Layer_Heat_Content'
- typvar(1)%short_name = 'somxlheatc'
- typvar(1)%online_operation = 'N/A'
- typvar(1)%axis = 'TYX'
+ ijarg = 1
+ CALL getarg (ijarg, cf_tfil ) ; ijarg = ijarg + 1
+ DO WHILE ( ijarg <= narg )
+ CALL getarg (ijarg, cldum ) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-full' ) ; lfull = .true.
+ CASE DEFAULT ; PRINT *, TRIM(cldum),' : unknown option' ; STOP
+ END SELECT
+ END DO
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ lchk = chkfile (cn_fzgr)
+ lchk = chkfile (cn_fmsk) .OR. lchk
+ lchk = chkfile (cf_tfil) .OR. lchk
+ IF ( lchk ) STOP ! missing files
+
+ CALL SetGlobalAtt( cglobal)
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
+
+ rdep(1) = 0.
+ ipk(:) = 1
+ stypvar(1)%cname = cv_out
+ stypvar(1)%cunits = 'J/m2'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = -1.e15
+ stypvar(1)%valid_max = 1.e15
+ stypvar(1)%clong_name = 'Mixed_Layer_Heat_Content'
+ stypvar(1)%cshort_name = cv_out
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) , zmxlheatc(npiglo, npjglo) )
- ALLOCATE ( zt(npiglo,npjglo) ,zmxl(npiglo,npjglo) )
+ ALLOCATE ( zmask(npiglo,npjglo), dmxlheatc(npiglo, npjglo) )
+ ALLOCATE ( zt(npiglo,npjglo), zmxl(npiglo,npjglo) )
ALLOCATE ( e3(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
+ ALLOCATE ( gdepw(npk), tim(npt) )
+
+ IF ( lfull ) ALLOCATE ( e31d(npk) )
! Initialize output file
- ncout = create(cfileout, cfilet, npiglo,npjglo,1)
- ierr=createvar(ncout ,typvar,1, ipk,id_varout )
- ierr=putheadervar(ncout, cfilet,npiglo, npjglo,1,pdep=dep)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ! Read vertical depth at w point
- gdepw(:)=getvare3(coordzgr,'gdepw',npk)
-
- ! Read Mixed Layer Depth in the gridT file
- ! Note that it is usually a mean value (5-day mean for instance). Therefore,
- ! in general it is not a particular value of gdepw.
- zmxl(:,:)=getvar(cfilet,'somxl010',1,npiglo,npjglo)
-
- zvol=0.d0
- zsum=0.d0
- zmxlheatc(:,:)=0.d0
- DO jk = 1,npk
- ! Get temperatures at jk
- zt(:,:)= getvar(cfilet, 'votemper', jk ,npiglo,npjglo)
- zmask(:,:)=getvar(cmask,'tmask',jk,npiglo,npjglo)
-
- ! get e3 at level jk ( ps...)
- e3(:,:) = getvar(coordzgr, 'e3t_ps', jk,npiglo,npjglo, ldiom=.true.)
-
- ! e3 is used as a flag for the mixed layer; It is 0 outside the mixed layer
- e3(:,:)=MAX ( 0., MIN(e3,zmxl-gdepw(jk) ) )
- WHERE ( e3 == 0 ) zmask = 0.
-
- zvol2d=SUM( e3 * zmask)
- zmxlheatc(:,:)=zmxlheatc(:,:)+ zt*e3*zmask
-
- IF (zvol2d /= 0 )THEN
- ! go on !
- ELSE
- ! no more layer below !
- EXIT ! get out of the jk loop
- ENDIF
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1)
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout, cdglobal=cglobal )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=rdep)
+
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk)
+ IF ( lfull ) e31d( :) = getvare3(cn_fzgr, cn_ve3t, npk)
+
+
+ dvol = 0.d0
+ dmxlheatc(:,:) = 0.d0
+
+ DO jt=1,npt
+ zmxl( :,:) = getvar(cf_tfil, cn_somxl010, 1, npiglo, npjglo, ktime=jt)
+ DO jk = 1, npk
+ ! Get temperatures at jk
+ zt( :,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt)
+ zmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo)
+
+ ! get e3 at level jk ( ps...)
+ IF ( lfull ) THEN ; e3(:,:) = e31d(jk)
+ ELSE ; e3(:,:) = getvar(cn_fzgr, 'e3t_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+
+ ! e3 is used as a flag for the mixed layer; It is 0 outside the mixed layer
+ e3(:,:)= MAX ( 0., MIN(e3, zmxl-gdepw(jk) ) )
+ WHERE ( e3 == 0 ) zmask = 0.
+
+ dvol = SUM( DBLE(e3 * zmask) )
+ dmxlheatc = zt * e3 * zmask * 1.d0 + dmxlheatc
+
+ IF (dvol == 0 ) EXIT ! no more layer below get out of the jk loop
+ END DO
+ ! Output to netcdf file : J/m2
+ dmxlheatc = rprho0*rpcp*dmxlheatc
+ ierr = putvar(ncout, id_varout(1), REAL(dmxlheatc), 1, npiglo, npjglo, ktime=jt)
END DO
- ! Output to netcdf file : J/m2
- zmxlheatc=zmxlheatc*rprho0*rpcp
- ierr = putvar(ncout, id_varout(1) ,REAL(zmxlheatc), 1,npiglo, npjglo)
- ierr=closeout(ncout)
+ ierr = closeout(ncout)
END PROGRAM cdfmxlheatc
diff --git a/cdfmxlsaltc.f90 b/cdfmxlsaltc.f90
index 14b2557..1b839a5 100644
--- a/cdfmxlsaltc.f90
+++ b/cdfmxlsaltc.f90
@@ -1,133 +1,190 @@
PROGRAM cdfmxlsaltc
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfmxlsaltc ***
+ !!======================================================================
+ !! *** PROGRAM cdfmxlsaltc ***
+ !!=====================================================================
+ !! ** Purpose : Compute the salt content in the mixed layer. Work for
+ !! partial steps (default) or full step (-full option)
!!
- !! ** Purpose : Compute the salt content in the mixed layer
- !! PARTIAL STEPS
- !!
- !! ** Method : compute the sum ( S * e1 *e2 * e3 *mask )
- !! for the mixed layer stored into gridT file
+ !! ** Method : compute the sum ( rho S * e1 *e2 * e3 *mask )
+ !! for the mixed layer stored into gridT file
!!
- !!
- !! history ;
- !! Original : J.M. Molines ( 2006) April
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 04/2006 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modutils
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e3, zs !: metrics, salinity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmxl !: mxl depth
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: npiglo x npjglo
- REAL(KIND=4),DIMENSION(:), ALLOCATABLE :: gdepw !:
-
- REAL(KIND=8), PARAMETER :: rprho0=1020., rpcp=4000.
- REAL(KIND=8) :: zvol2d
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zmxlsaltc !: mxl salt content
-
- CHARACTER(LEN=256) :: cfilet
- CHARACTER(LEN=256) :: coordzgr='mesh_zgr.nc',cmask='mask.nc'
-
- ! Output stuff
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(1) :: ipk, id_varout !: only one output variable
- REAL(KIND=4), DIMENSION(1) :: tim,dep !: time output
- CHARACTER(LEN=256) :: cfileout='mxlsaltc.nc'
-
- TYPE(variable), DIMENSION(1) :: typvar !: stucture for attributes
- !! Read command line and output usage message if not compliant.
- narg= iargc()
+
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain,
+ INTEGER(KIND=4) :: ncout, ierr ! ncid and error status
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid's of output vars
+
+ REAL(KIND=4), PARAMETER :: rprho0=1020. ! rho reference density
+ REAL(KIND=4), PARAMETER :: rpcp=4000. ! calorific capacity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3 ! metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zs ! temperature in the MXL
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmxl ! depth of the MXL
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! vertical levels
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metric full
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(1) :: rdep ! dummy depth output
+
+ REAL(KIND=8) :: dvol ! total volume
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmxlsaltc ! heat content
+
+ CHARACTER(LEN=256) :: cf_tfil ! input file name
+ CHARACTER(LEN=256) :: cf_out='mxlsaltc.nc'! output file
+ CHARACTER(LEN=256) :: cv_out='somxlsaltc' ! input file name
+ CHARACTER(LEN=256) :: cglobal ! global attribute
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ TYPE(variable), DIMENSION(1) :: stypvar ! stucture for attributes (output)
+
+ LOGICAL :: lfull=.false. ! full step flag
+ LOGICAL :: lchk ! file existence flag (true if missing)
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfmxlsaltc gridTfile '
- PRINT *,' Computes the salt content in the mixed layer (kg/m2)'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output ncdf file mxlsaltc.nc, variable 2D somxlsaltc'
+ PRINT *,' usage : cdfmxlsaltc T-file [-full ]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the salt content in the mixed layer.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with salinity and mixed layer deptht.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-full ] : indicate a full step configuration.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fzgr),' and ', TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_out),' (kg/m2 )'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfmxl, cdfmxlhcsc, cdfmxlheatc '
+ PRINT *,' '
STOP
ENDIF
- CALL getarg (1, cfilet)
+ ijarg = 1 ; ireq = 0
+
+ DO WHILE ( ijarg <= narg )
+ CALL getarg (ijarg, cldum ) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-full' ) ; lfull = .true.
+ CASE ( '-partial' ) ; lfull = .false.
+ CASE DEFAULT
+ ireq=ireq+1
+ SELECT CASE ( ireq )
+ CASE ( 1 ) ; cf_tfil=cldum
+ CASE DEFAULT ; PRINT *,' Too many arguments'
+ END SELECT
+ END SELECT
+ END DO
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
+ lchk = chkfile (cn_fzgr)
+ lchk = chkfile (cn_fmsk) .OR. lchk
+ lchk = chkfile (cf_tfil ) .OR. lchk
+ IF ( lchk ) STOP ! missing files
+
+ CALL SetGlobalAtt( cglobal )
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
+
+ rdep(1) = 0.
+ ipk(:) = 1
+ stypvar(1)%cname = cv_out
+ stypvar(1)%cunits = 'kg/m2'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = 0
+ stypvar(1)%valid_max = 1.e9
+ stypvar(1)%clong_name = 'Mixed_Layer_Salt_Content'
+ stypvar(1)%cshort_name = cv_out
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
- dep(1) = 0.
- ipk(:) = 1
- typvar(1)%name= 'somxlsaltc'
- typvar(1)%units='kg/m2'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 1.e9
- typvar(1)%long_name='Mixed_Layer_Salt_Content'
- typvar(1)%short_name='somxlsaltc'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
+ ! Allocate arrays
+ ALLOCATE ( zmask(npiglo,npjglo), dmxlsaltc(npiglo, npjglo) )
+ ALLOCATE ( zs(npiglo,npjglo), zmxl(npiglo,npjglo) )
+ ALLOCATE ( e3(npiglo,npjglo) )
+ ALLOCATE ( gdepw(npk), tim(npt) )
+ IF ( lfull ) ALLOCATE ( e31d(npk) )
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ ! Initialize output file
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1 )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout, cdglobal=cglobal )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=rdep )
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) , zmxlsaltc(npiglo, npjglo) )
- ALLOCATE ( zs(npiglo,npjglo) ,zmxl(npiglo,npjglo) )
- ALLOCATE ( e3(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
- ! Initialize output file
- ncout = create(cfileout, cfilet, npiglo,npjglo,1)
- ierr=createvar(ncout ,typvar,1, ipk,id_varout )
- ierr=putheadervar(ncout, cfilet,npiglo, npjglo,1,pdep=dep)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ! Read vertical depth at w point
- gdepw(:) = getvare3(coordzgr,'gdepw',npk)
-
- ! Read Mixed Layer Depth in the gridT file
- ! Note that it is usually a mean value (5-day mean for instance). Therefore,
- ! in general it is not a particular value of gdepw.
- zmxl(:,:)=getvar(cfilet,'somxl010',1,npiglo,npjglo)
-
- zmxlsaltc(:,:)=0.d0
- DO jk = 1,npk
- ! Get temperatures at jk
- zs(:,:)= getvar(cfilet, 'vosaline', jk ,npiglo,npjglo)
- zmask(:,:)=getvar(cmask,'tmask',jk,npiglo,npjglo)
-
- ! get e3 at level jk ( ps...)
- e3(:,:) = getvar(coordzgr, 'e3t_ps', jk,npiglo,npjglo, ldiom=.true.)
-
- ! e3 is used as a flag for the mixed layer; It is 0 outside the mixed layer
- e3(:,:)=MAX ( 0., MIN(e3,zmxl-gdepw(jk) ) )
- WHERE ( e3 == 0 ) zmask = 0.
-
- zvol2d=SUM( e3 * zmask)
- zmxlsaltc(:,:)=zmxlsaltc(:,:)+ zs*e3*zmask
-
- IF (zvol2d /= 0 )THEN
- ! go on !
- ELSE
- ! no more layer below !
- EXIT ! get out of the jk loop
- ENDIF
+ gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk)
+ IF ( lfull ) e31d( :) = getvare3(cn_fzgr, cn_ve3t, npk)
+
+
+ dvol = 0.d0
+ dmxlsaltc(:,:) = 0.d0
+
+ DO jt=1,npt
+ zmxl( :,:) = getvar(cf_tfil, cn_somxl010, 1, npiglo, npjglo, ktime=jt)
+ DO jk = 1, npk
+ zs( :,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt)
+ zmask(:,:) = getvar(cn_fmsk, 'tmask', jk, npiglo, npjglo )
+
+ ! get e3 at level jk ( ps...)
+ IF ( lfull ) THEN
+ e3(:,:) = e31d(jk)
+ ELSE
+ e3(:,:) = getvar(cn_fzgr, 'e3t_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+
+ ! e3 is used as a flag for the mixed layer; It is 0 outside the mixed layer
+ e3(:,:)=MAX ( 0., MIN(e3, zmxl-gdepw(jk) ) )
+ WHERE ( e3 == 0 ) zmask = 0.
+
+ dvol = SUM( DBLE(e3 * zmask) )
+ dmxlsaltc = zs * e3 * zmask * 1.d0 + dmxlsaltc
+
+ IF (dvol /= 0 )THEN
+ ! go on !
+ ELSE
+ ! no more layer below !
+ EXIT ! get out of the jk loop
+ ENDIF
+
+ END DO
+ ! Output to netcdf file : Kg/m2
+ dmxlsaltc = rprho0*dmxlsaltc
+ ierr = putvar(ncout, id_varout(1), REAL(dmxlsaltc), 1, npiglo, npjglo, ktime=jt)
END DO
- ! Output to netcdf file : kg/m2
- zmxlsaltc=zmxlsaltc*rprho0
- ierr = putvar(ncout, id_varout(1) ,REAL(zmxlsaltc), 1,npiglo, npjglo)
- ierr=closeout(ncout)
+ ierr = closeout(ncout)
END PROGRAM cdfmxlsaltc
diff --git a/cdfnamelist.f90 b/cdfnamelist.f90
new file mode 100644
index 0000000..fba609a
--- /dev/null
+++ b/cdfnamelist.f90
@@ -0,0 +1,108 @@
+PROGRAM cdfnamelist
+ !!======================================================================
+ !! *** PROGRAM cdfnamelist ***
+ !!=====================================================================
+ !! ** Purpose : Give informations on the namelist mechanism implemented
+ !! in CDFTOOLS_3.
+ !! Write a template namelist for CDFTOOLS_3.0, usefull
+ !! to change default file names, variable or dimension
+ !! names.
+ !!
+ !! ** Method :
+ !!
+ !! History : 3.0 : 01/2011 : J.M. Molines : Original code
+ !!----------------------------------------------------------------------
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
+ IMPLICIT NONE
+
+ INTEGER(KIND=4) :: narg, iargc, ijarg
+
+ CHARACTER(LEN=80) :: cldum
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
+
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfnamelist [-i] [-p]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Give information [-i option] on the namelist mechanism implemented'
+ PRINT *,' in CDFTOOLS v3. Write a namelist template [-p option ] to initialize'
+ PRINT *,' the mechanism.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ -i ] : print informations '
+ PRINT *,' [ -p ] : write a template namelist.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' with option -p, print a template namelist : PrintCdfNames.namlist'
+ PRINT *,' '
+ STOP
+ ENDIF
+
+ ijarg = 1
+ DO WHILE ( ijarg <= narg )
+ CALL getarg( ijarg, cldum ) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-i' )
+ CALL InfoUseNamelist()
+ CASE ( '-p' )
+ CALL PrintCdfNames()
+ CASE DEFAULT
+ PRINT *, TRIM(cldum),' : unknown option in cdfnamelist '
+ END SELECT
+ END DO
+
+CONTAINS
+
+ SUBROUTINE InfoUseNamelist()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE InfoUseNamelist ***
+ !!
+ !! ** Purpose : Print detailed info on the use of namelist in
+ !! CDFTOOLS_3.0
+ !!
+ !!----------------------------------------------------------------------
+ PRINT *,' In CDFTOOLS_3 the variable names, dimension names, mesh_mask'
+ PRINT *,' file names can be customized via a system of namelist.'
+ PRINT *,' A call to ReadCdfNames at the begining of the program allows'
+ PRINT *,' the update of the names used in the program.'
+ PRINT *,' If there is no need for changing names, then it is not necessary'
+ PRINT *,' to give a namelist, the default values are OK.'
+ PRINT *,' '
+ PRINT *,' If you need to change any of the default values, then you can'
+ PRINT *,' use the namelist system to make this change effective. Doing do'
+ PRINT *,' some rules are to be followed for proper use.'
+ PRINT *,' '
+ PRINT *,'NAMELIST EDITING'
+ PRINT *,' To have a template of a CDFTOOLS_3 namelist, use the statement'
+ PRINT *,' cdfnamelist -p '
+ PRINT *,' This will give you a template namelist (PrintCdfNames.namlist)'
+ PRINT *,' that you have to customized for your application.'
+ PRINT *,' Some comments are made within this namelist for particular blocks.'
+ PRINT *,' '
+ PRINT *,'NAME AND LOCATION OF THE NAMELIST'
+ PRINT *,' The default name of the namelist read by ReadCdfNames is '
+ PRINT *,' nam_cdf_names'
+ PRINT *,' ReadCdfNames look for the namelist in the current directory (./)'
+ PRINT *,' and, if not found there, in the $HOME/CDFTOOLS_cfg/ directory'
+ PRINT *,' The name of the namelist can be changed setting the environment'
+ PRINT *,' variable NAM_CDF_NAMES to the desired value.'
+ PRINT *,' '
+
+ END SUBROUTINE InfoUseNamelist
+
+END PROGRAM cdfnamelist
diff --git a/cdfnan.f90 b/cdfnan.f90
index a65e4d4..b74216a 100644
--- a/cdfnan.f90
+++ b/cdfnan.f90
@@ -1,70 +1,92 @@
PROGRAM cdfnan
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfnan ***
+ !!======================================================================
+ !! *** PROGRAM cdfnan ***
+ !!=====================================================================
+ !! ** Purpose : Replace the nan values by spval or another value
+ !! given in argument
!!
- !! ** Purpose: Replace the nan values by spval or another value given in argument
- !!
- !! history :
- !! Original : J.M. Molines from cdfcsp
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- !! * Modules used
+ !! History : 2.1 : 05/2010 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jf,jk,jvar, jt, jkk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: ncid, narg, iargc !:
- INTEGER :: npiglo,npjglo, npk , nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER , DIMENSION(:), ALLOCATABLE :: ipk !: arrays of vertical level for each var
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var !: arrays of var id
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: tab !: Arrays for cumulated values
- REAL(KIND=4) :: spval, replace
- CHARACTER(LEN=256) :: cfile !: file name
- CHARACTER(LEN=256) :: cunits, clname, csname
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
-
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar !: type for attributes
- LOGICAL :: l_replace=.false.
-
- INTEGER :: istatus
-
-
- !! Read command line
+
+ INTEGER(KIND=4) :: jk, jvar, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line
+ INTEGER(KIND=4) :: ncid ! ncid of input file for rewrite
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvars ! Number of variables in a file
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of vertical level for each var
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id
+
+ REAL(KIND=4) :: zspval, replace ! spval, replace value
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tab ! Arrays for data
+
+ CHARACTER(LEN=256) :: cldum ! dummy string for getarg
+ CHARACTER(LEN=256) :: cf_inout ! file name
+ CHARACTER(LEN=256) :: cunits, clname, csname ! attributes
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! type for attributes
+
+ LOGICAL :: l_replace = .false. ! flag for replace value
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfnan ''list_of_ioipsl_model_output_files''[-value replace] '
- PRINT *,' Option -value must be the last on the line'
- PRINT *,' When used, it replace Nan by this value instead of the spval'
+ PRINT *,' usage : cdfnan list_of_model_output_files [-value replace] '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Detect NaN values in the input files, and change them to '
+ PRINT *,' either spval (missing_value) or the value given as option.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' list of model output files. They must be of same type and have'
+ PRINT *,' similar sizes. CAUTION : input files are rewritten !'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-value replace ] : use replace instead of missing_value for'
+ PRINT *,' changing NaN.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : input file is rewritten without NaN.'
+ PRINT *,' variables : same name as input.'
STOP
ENDIF
- PRINT *, 'narg=', narg
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- IF ( narg >= 2 ) THEN
- CALL getarg ( narg - 1, cfile)
- IF (TRIM(cfile) == '-value' ) THEN
- CALL getarg(narg,cfile) ; READ(cfile,*) replace ; l_replace=.true.
- narg=narg -2
- ENDIF
- ENDIF
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',kstatus=istatus)
- nt = getdim (cfile,'time_counter')
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',kstatus=istatus)
- IF (istatus /= 0 ) THEN
- PRINT *, "ASSUME NO VERTICAL DIMENSIONS !"
- npk=0
+
+ ijarg=1
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE (cldum)
+ CASE ('-value' )
+ CALL getarg( ijarg, cldum) ; ijarg = ijarg+1 ;
+ READ(cldum,*) replace ; l_replace=.true.
+ CASE DEFAULT
+ CALL getarg( ijarg, cf_inout)
+ ijarg = ijarg + 1
+ END SELECT
+ END DO
+ IF ( chkfile (cf_inout) ) STOP ! missing file
+
+ npiglo = getdim (cf_inout, cn_x )
+ npjglo = getdim (cf_inout, cn_y )
+ npk = getdim (cf_inout, cn_z, kstatus=ierr)
+
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_inout,'z',kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ PRINT *, 'ASSUME NO VERTICAL DIMENSIONS !'
+ npk=0
ENDIF
ENDIF
@@ -74,50 +96,56 @@ PROGRAM cdfnan
ALLOCATE( tab(npiglo,npjglo) )
- nvars = getnvar(cfile)
-
- ALLOCATE (cvarname(nvars), id_var(nvars),ipk(nvars), typvar(nvars))
-
- print *,' in getvarname'
- cvarname(:)=getvarname(cfile,nvars,typvar)
- print *,' in getipk'
- ipk(:) = getipk(cfile,nvars)
- print *,' done'
- id_var(:) = getvarid(cfile,nvars)
-
- DO jf = 1, narg
- CALL getarg (jf, cfile)
- PRINT *, 'Change NaN on file ', cfile
- ncid = ncopen(cfile)
- nt = getdim (cfile,'time_counter')
- DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' .OR. &
- cvarname(jvar) == 'time_counter' .OR. &
- cvarname(jvar) == 'deptht' .OR. &
- cvarname(jvar) == 'depthu' .OR. &
- cvarname(jvar) == 'depthv' ) THEN
- ! skip these variable
- ELSE
- IF ( l_replace ) THEN
- spval=replace
+ nvars = getnvar(cf_inout)
+
+ ALLOCATE (cv_names(nvars), id_var(nvars),ipk(nvars), stypvar(nvars))
+
+ cv_names(:) = getvarname(cf_inout,nvars,stypvar)
+ ipk(:) = getipk(cf_inout,nvars)
+ id_var(:) = getvarid(cf_inout,nvars)
+
+ !re scan argument list
+ ijarg = 1
+ DO WHILE (ijarg <= narg )
+ CALL getarg (ijarg, cf_inout) ; ijarg = ijarg + 1
+ IF ( chkfile (cf_inout) ) STOP ! missing file
+
+ SELECT CASE ( cf_inout)
+ CASE ('-value' )
+ ! replace already read, just skip
+ ijarg = ijarg + 1
+ CASE DEFAULT ! reading files
+ PRINT *, 'Change NaN on file ', cf_inout
+ ncid = ncopen(cf_inout)
+ npt = getdim (cf_inout,cn_t)
+
+ DO jvar = 1,nvars
+ IF ( cv_names(jvar) == cn_vlon2d .OR. &
+ & cv_names(jvar) == cn_vlat2d .OR. &
+ & cv_names(jvar) == cn_vtimec .OR. &
+ & cv_names(jvar) == cn_vdeptht .OR. &
+ & cv_names(jvar) == cn_vdepthu .OR. &
+ & cv_names(jvar) == cn_vdepthv ) THEN
+ ! skip these variable
ELSE
- ierr = getvaratt (cfile,cvarname(jvar),cunits,spval,clname,csname)
- ENDIF
+ IF ( l_replace ) THEN
+ zspval=replace
+ ELSE
+ ierr = getvaratt (cf_inout, cv_names(jvar), cunits, zspval, clname, csname)
+ ENDIF
- DO jt=1,nt
- DO jk = 1, ipk(jvar)
- jkk=jk
- IF (npk == 0 ) jkk=jt
- tab(:,:) = getvar(cfile, cvarname(jvar), jkk ,npiglo, npjglo, ktime=jt )
- WHERE( isnan(tab(:,:)) ) tab(:,:) = spval
- ierr = putvar(ncid, id_var(jvar) ,tab, jkk, npiglo, npjglo, ktime=jt)
- ENDDO
- END DO
- ENDIF
- ENDDO
+ DO jt=1,npt
+ DO jk = 1, ipk(jvar)
+ tab(:,:) = getvar(cf_inout, cv_names(jvar), jk, npiglo, npjglo, ktime=jt )
+ WHERE( isnan(tab(:,:)) ) tab(:,:) = zspval
+ ierr = putvar(ncid, id_var(jvar), tab, jk, npiglo, npjglo, ktime=jt)
+ ENDDO
+ END DO
+ ENDIF
+ ENDDO
+ END SELECT
ENDDO
- istatus = closeout(ncid)
+ ierr = closeout(ncid)
END PROGRAM cdfnan
diff --git a/cdfnorth_unfold.f90 b/cdfnorth_unfold.f90
index a4557e9..3f21ed1 100644
--- a/cdfnorth_unfold.f90
+++ b/cdfnorth_unfold.f90
@@ -1,81 +1,114 @@
PROGRAM cdfnorth_unfold
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfnorth_unfold ***
- !!
- !! ** Purpose: Unfold the arctic ocean in an ORCA like configuration
+ !!======================================================================
+ !! *** PROGRAM cdfnorth_unfold ***
+ !!=====================================================================
+ !! ** Purpose : Unfold the arctic ocean in an ORCA like configuration
!! for all the variables of the file given in the arguments
- !!
- !! ** Method: read the filename, the limit of the extracted zone, and
+ !!
+ !! ** Method : read the filename, the limit of the extracted zone, and
!! the type of pivot to use and the C-grid point of variables
!!
- !! history :
- !! Original code : J.M. Molines (Apr. 2010 )
- !!-------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
+ !! History : 2.1 : 04/2010 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
!!
+ !! unfold unfold the north pole of orca grid
+ !! chkisig function to determine if the variable changes sign
+ !! when folded
+ !!----------------------------------------------------------------------
USE cdfio
-
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk,jt,jvar, jv , jtt,jkk !: dummy loop index
- INTEGER :: ji, ij !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER :: ijatl, ijpacif, npiarctic, npjarctic, isig
- INTEGER :: ipivot
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: tab
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: tablon,tablat
- REAL(KIND=4) :: zrat
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: v2d !: Array to read a layer of data
- REAL(KIND=4),DIMENSION(:), ALLOCATABLE :: tim, gdep
-
- CHARACTER(LEN=256) :: cfile ,cfileout !: file name
- CHARACTER(LEN=256) :: cdep, cdum, cpivot, ctype
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar
-
- INTEGER :: ncout
- INTEGER :: istatus
- LOGICAL :: lcaltmean, lchk=.false.
- !!
- !! Read command line
- narg= iargc()
- IF ( narg /= 5 ) THEN
- PRINT *,' Usage : cdfnorth_unfold filename jatl jpacif pivot Cgrid_point'
- PRINT *, ' example: cdfnorth_unfold ORCA025-G70_y2000m10d02_gridT.nc 766 766 T T'
- PRINT *, ' a file named unfold.nc will be created '
+ INTEGER(KIND=4) :: jk, jt, jvar, jv ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! browse line
+ INTEGER(KIND=4) :: npiglo, npjglo, npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvars ! Number of variables in a file
+ INTEGER(KIND=4) :: ijatl, ijpacif ! j starting position in atl and pacif
+ INTEGER(KIND=4) :: npiarctic, npjarctic ! size of the output arrays file
+ INTEGER(KIND=4) :: isig ! change sign indicator
+ INTEGER(KIND=4) :: nipivot ! i position of pivot
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's (input)
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! level and varid of output var
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tab ! output array
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tablon, tablat ! output longitude and latitude
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! Array to read a layer of data
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ CHARACTER(LEN=256) :: cf_in ! input file name
+ CHARACTER(LEN=256) :: cf_out='unfold.nc' ! output file names
+ CHARACTER(LEN=256) :: cv_dep ! depth name
+ CHARACTER(LEN=256) :: cpivot ! pivot position
+ CHARACTER(LEN=256) :: ctype ! variable position
+ CHARACTER(LEN=256) :: cglobal ! variable position
+ CHARACTER(LEN=256) :: cldum ! dummy string
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! output var attribute
+
+ LOGICAL :: lchk=.false. ! flag for consistency check
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
+ IF ( narg /=5 ) THEN
+ PRINT *,' usage : cdfnorth_unfold IN-file jatl jpacif pivot Cgrid_point'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Unfold the Artic Ocean in an ORCA configuration. Produce a netcdf'
+ PRINT *,' file with the Artic ocean as a whole. The area can be adjusted on'
+ PRINT *,' both Atlantic and Pacific sides.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : netcdf file to be unfolded.'
+ PRINT *,' jatl : J index to start the unfold process in the Atlantic.'
+ PRINT *,' jpacif : J index to start the unfold process in the Pacific.'
+ PRINT *,' pivot : type of pivot for the north fold condition ( T or F )'
+ PRINT *,' Cgrid_point : grid point where the variables in the input file are'
+ PRINT *,' located. If all variables in a single file are not on'
+ PRINT *,' the same C-grid location, there might be a problem ...'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : same name and units than in the input file.'
STOP
ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
- CALL getarg (2, cdum) ; READ(cdum,*) ijatl
- CALL getarg (3, cdum) ; READ(cdum,*) ijpacif
+
+ CALL getarg (1, cf_in )
+ CALL getarg (2, cldum ) ; READ(cldum,*) ijatl
+ CALL getarg (3, cldum ) ; READ(cldum,*) ijpacif
CALL getarg (4, cpivot)
CALL getarg (5, ctype )
+
+ IF ( chkfile(cf_in) ) STOP ! missing file
+ WRITE(cglobal,9000) 'cdfnorth_unfold ',TRIM(cf_in), ijatl, ijpacif, TRIM(cpivot), TRIM(ctype)
+9000 FORMAT(a,a,2i5,a,1x,a)
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
- nt = getdim (cfile,'time', kstatus=istatus)
+ npiglo = getdim (cf_in, cn_x )
+ npjglo = getdim (cf_in, cn_y )
+ npt = getdim (cf_in, cn_t )
+ npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
- npk = getdim (cfile,'nav_lev',cdtrue=cdep,kstatus=istatus)
- IF ( istatus /= 0 ) THEN
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'z',cdtrue=cv_dep,kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cf_in,'nav_lev',cdtrue=cv_dep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
PRINT *,' assume file with no depth'
npk=0
ENDIF
@@ -84,211 +117,212 @@ PROGRAM cdfnorth_unfold
ENDIF
! to be improved
- npiarctic=npiglo/2
- ipivot=npiglo/2
+ npiarctic = npiglo/2
+ nipivot = npiglo/2
SELECT CASE ( cpivot )
- CASE ( 'T','t') ; npjarctic=(npjglo-ijatl+1) + (npjglo -ijpacif +1) -3
- CASE ( 'F','f') ; npjarctic=(npjglo-ijatl+1) + (npjglo -ijpacif +1) -2
+ CASE ( 'T','t') ; npjarctic=(npjglo-ijatl+1) + (npjglo -ijpacif +1) -3
+ CASE ( 'F','f') ; npjarctic=(npjglo-ijatl+1) + (npjglo -ijpacif +1) -2
END SELECT
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'nt =', nt
-
- ALLOCATE( tab(npiarctic, npjarctic), v2d(npiglo,npjglo), tim(nt), gdep(npk) )
+ ALLOCATE( tab(npiarctic, npjarctic), v2d(npiglo,npjglo), tim(npt) )
ALLOCATE( tablon(npiarctic, npjarctic), tablat(npiarctic, npjarctic) )
- nvars = getnvar(cfile)
- PRINT *,' nvars =', nvars
+ nvars = getnvar(cf_in)
+ PRINT *,' nvars = ', nvars
- ALLOCATE (cvarname(nvars) )
- ALLOCATE (typvar(nvars) )
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars) )
+ ALLOCATE (cv_names(nvars) )
+ ALLOCATE (stypvar(nvars) )
+ ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars) )
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ ! get list of variable names and collect attributes in stypvar (optional)
+ cv_names(:) = getvarname(cf_in, nvars, stypvar)
id_var(:) = (/(jv, jv=1,nvars)/)
! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
+ ipk(:) = getipk (cf_in, nvars, cdep=cv_dep)
+
+ WHERE( ipk == 0 ) cv_names = 'none'
+ stypvar(:)%cname = cv_names
- v2d=getvar(cfile, 'nav_lon',1, npiglo,npjglo)
+ v2d=getvar(cf_in, cn_vlon2d, 1, npiglo, npjglo)
CALL unfold(v2d ,tablon, ijatl, ijpacif, cpivot, ctype, 1)
- v2d=getvar(cfile, 'nav_lat',1, npiglo,npjglo)
- CALL unfold(v2d ,tablat, ijatl, ijpacif, cpivot, ctype, 1)
- ! create output fileset
- cfileout='unfold.nc'
- ! create output file taking the sizes in cfile
+ v2d=getvar(cf_in, cn_vlat2d, 1, npiglo, npjglo)
+ CALL unfold(v2d ,tablat, ijatl, ijpacif, cpivot, ctype, 1)
- ncout =create(cfileout, cfile,npiarctic,npjarctic,npk,cdep=cdep)
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- tim=getvar1d(cfile,'time_counter',nt)
- ! gdep=getvar1d(cfile,cdep,npk)
+ ! create output file taking the sizes in cf_in
+ ncout = create (cf_out, cf_in, npiarctic, npjarctic, npk, cdep=cv_dep)
+ ierr = createvar (ncout, stypvar, nvars, ipk, id_varout, cdglobal=TRIM(cglobal) )
+ ierr = putheadervar(ncout, cf_in, npiarctic, npjarctic, npk, pnavlon=tablon, pnavlat=tablat, cdep=cv_dep)
- ierr= putheadervar(ncout , cfile, npiarctic,npjarctic, npk,pnavlon=tablon, pnavlat=tablat, cdep=cdep)
- ierr=putvar1d(ncout,tim,nt,'T')
- ! ierr=putvar1d(ncout,gdep,npk,'D')
+ tim = getvar1d(cf_in, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
DO jvar = 1,nvars
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar)
+ PRINT *,' Working with ', TRIM(cv_names(jvar)), ipk(jvar)
DO jk = 1, ipk(jvar)
PRINT *,'level ',jk
tab(:,:) = 0.
isig = 1
- DO jtt=1,nt
- jkk=jk
- ! If forcing fields is without depth dimension
- IF (npk==0) jkk=jtt
- v2d(:,:)= getvar(cfile, cvarname(jvar), jkk ,npiglo, npjglo,ktime=jtt )
- IF ( jk == 1 ) THEN ! look for correct isig
+ DO jt=1,npt
+ v2d(:,:) = getvar(cf_in, cv_names(jvar), jk, npiglo, npjglo, ktime=jt )
+
+ IF ( jk == 1 .AND. jt == 1) THEN ! look for correct isig
isig=chkisig( cpivot, ctype, v2d, lchk)
PRINT *,'ISIG=', isig
ENDIF
CALL unfold(v2d, tab, ijatl, ijpacif, cpivot, ctype, isig)
- ierr = putvar(ncout, id_varout(jvar) ,tab, jkk, npiarctic, npjarctic)
+ ierr = putvar(ncout, id_varout(jvar), tab, jk, npiarctic, npjarctic)
ENDDO
END DO ! loop to next level
END DO ! loop to next var in file
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
CONTAINS
- FUNCTION chkisig (cdpivot, cdtype, ptab, ldchk)
- !!-------------------------------------------------------------------------
- !! *** FUNCTION chkisig ***
+
+
+ INTEGER(KIND=4) FUNCTION chkisig (cdpivot, cdtype, ptab, ldchk)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION chkisig ***
!!
- !! Purpose: from the input data determine if the field is to be multiplied
- !! -1 in the unfolding process or not.
- !! if ldchk is true, proceed to an extended check of the overlaping
- !! rows.
- !!-------------------------------------------------------------------------
- CHARACTER(LEN=*), INTENT(in) :: cdpivot, cdtype
- REAL(KIND=4),DIMENSION(:,:), INTENT(in) :: ptab
- LOGICAL, INTENT(in) :: ldchk
- INTEGER :: chkisig
+ !! ** Purpose : from the input data determine if the field is to be
+ !! multiplied by -1 in the unfolding process or not.
+ !! if ldchk is true, proceed to an extended check of the
+ !! overlaping area (not written yet)
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdpivot, cdtype
+ REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: ptab
+ LOGICAL, INTENT(in) :: ldchk
!
- REAL(KIND=4) :: zrat
+ INTEGER(KIND=4) :: ii, ij
+ REAL(KIND=4) :: zrat
+ !!----------------------------------------------------------------------
IF ( ldchk ) THEN
- PRINT *,' Full check not written yet ' ; stop
+ PRINT *,' Full check not written yet ' ; STOP
ELSE
SELECT CASE ( cdpivot)
CASE ( 'T','t')
SELECT CASE (cdtype )
CASE ( 'T','t')
- ji=1
- DO WHILE ( ptab(ji,npjglo-1) == 0 .AND. ji < npiglo )
- ji=ji+1
+ ii = 1
+ DO WHILE ( ptab(ii,npjglo-1) == 0 .AND. ii < npiglo )
+ ii = ii+1
ENDDO
- IF ( ji /= npiglo ) THEN
- ij=2*ipivot - ji +2
- zrat= ptab(ij,npjglo-1) / ptab(ji,npjglo-1)
+ IF ( ii /= npiglo ) THEN
+ ij = 2*nipivot - ii +2
+ zrat = ptab(ij,npjglo-1) / ptab(ii,npjglo-1)
IF ( ABS(zrat) /= 1. ) THEN
- PRINT *, 'INCOHERENT value in T point ', TRIM(cvarname(jvar)), zrat
- istatus=closeout(ncout)
- stop
+ PRINT *, 'INCOHERENT value in T point ', TRIM(cv_names(jvar)), zrat
+ ierr = closeout(ncout)
+ STOP
ELSE
- chkisig=zrat
+ chkisig = zrat
ENDIF
ENDIF
CASE ( 'U','u')
- ji=1
- DO WHILE ( ptab(ji,npjglo-1) == 0 .AND. ji < npiglo )
- ji=ji+1
+ ii = 1
+ DO WHILE ( ptab(ii,npjglo-1) == 0 .AND. ii < npiglo )
+ ii = ii+1
ENDDO
- ij=2*ipivot - ji + 1
- zrat= ptab(ij,npjglo-1) / ptab(ji,npjglo-1)
+ ij = 2*nipivot - ii + 1
+ zrat = ptab(ij,npjglo-1) / ptab(ii,npjglo-1)
IF ( ABS(zrat) /= 1. ) THEN
- PRINT *, 'INCOHERENT value in U point ', TRIM(cvarname(jvar)), zrat
- istatus=closeout(ncout)
- stop
+ PRINT *, 'INCOHERENT value in U point ', TRIM(cv_names(jvar)), zrat
+ ierr = closeout(ncout)
+ STOP
ELSE
chkisig=zrat
ENDIF
CASE ( 'V','v')
- ji=1
- DO WHILE ( ptab(ji,npjglo-1) == 0 .AND. ji < npiglo )
- ji=ji+1
+ ii = 1
+ DO WHILE ( ptab(ii,npjglo-1) == 0 .AND. ii < npiglo )
+ ii = ii+1
ENDDO
- ij=2*ipivot - ji + 2
- zrat= ptab(ij,npjglo-2) / ptab(ji,npjglo-1)
+ ij = 2*nipivot - ii + 2
+ zrat = ptab(ij,npjglo-2) / ptab(ii,npjglo-1)
IF ( ABS(zrat) /= 1. ) THEN
- PRINT *, 'INCOHERENT value in V point ', TRIM(cvarname(jvar)), zrat
- istatus=closeout(ncout)
- stop
+ PRINT *, 'INCOHERENT value in V point ', TRIM(cv_names(jvar)), zrat
+ ierr = closeout(ncout)
+ STOP
ELSE
chkisig=zrat
ENDIF
END SELECT
CASE ( 'F','f')
- PRINT *, 'F pivot not done yet ' ; stop
+ PRINT *, 'F pivot not done yet ' ; STOP
END SELECT
ENDIF
+
END FUNCTION chkisig
+
SUBROUTINE unfold( ptabin, ptabout, kjatl, kjpacif, cdpivot, cdtype, ksig)
- !!------------------------------------------------------------------------
- !! ** SUBROUTINE unfol **
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE unfold ***
+ !!
+ !! ** Purpose : unfold the north pole
!!
- !! Purpose : unfold the north pole
!! -----------------------------------------------------------------------
- REAL(KIND=4), DIMENSION(npiglo,npjglo) , INTENT(in) :: ptabin
+ REAL(KIND=4), DIMENSION(npiglo,npjglo), INTENT(in ) :: ptabin
REAL(KIND=4), DIMENSION(npiarctic,npjarctic), INTENT(out) :: ptabout
- INTEGER, INTENT(in) :: kjatl
- INTEGER, INTENT(in) :: kjpacif
- INTEGER, INTENT(in) :: ksig
- CHARACTER(LEN=*), INTENT(in) :: cdpivot
- CHARACTER(LEN=*), INTENT(in) :: cdtype
- !!
- ! local variables :
- INTEGER :: jj, ipivot, ij, ijn, ji, ii
+ INTEGER(KIND=4), INTENT(in ) :: kjatl
+ INTEGER(KIND=4), INTENT(in ) :: kjpacif
+ CHARACTER(LEN=*), INTENT(in ) :: cdpivot
+ CHARACTER(LEN=*), INTENT(in ) :: cdtype
+ INTEGER(KIND=4), INTENT(in ) :: ksig
+
+ INTEGER(KIND=4) :: ji, jj
+ INTEGER(KIND=4) :: ipivot
+ INTEGER(KIND=4) :: ijn, ii, ij
+ !! -----------------------------------------------------------------------
!
ipivot=npiglo/2
DO jj=kjatl, npjglo
- ij=jj-kjatl+1
- ptabout(:,ij) = ptabin (ipivot:npiglo,jj)
+ ij = jj-kjatl+1
+ ptabout(:,ij) = ptabin(ipivot:npiglo,jj)
ENDDO
+
ijn=ij
+
SELECT CASE ( cdpivot )
CASE ('T','t') ! pivot
- SELECT CASE ( cdtype)
+ SELECT CASE ( cdtype )
CASE ('T','t')
DO jj=npjglo-3,kjpacif, -1
ij= ijn + ( npjglo - 3 - jj ) +1 ! 2 *npjglo - kjatl -1 -jj
DO ji = 2, npiarctic
- ! ii = 2*ipivot -ji +2 -ipivot +1
ii = ipivot - ji + 3
- ptabout(ji,ij)= ksig * ptabin(ii, jj)
+ ptabout(ji,ij) = ksig * ptabin(ii, jj)
ENDDO
ENDDO
CASE ('V','v')
DO jj=npjglo-4,kjpacif-1, -1
ij= ijn + ( npjglo - 4 - jj ) +1 ! 2 *npjglo - kjatl -1 -jj
DO ji = 2, npiarctic
- ! ii = 2*ipivot -ji +2 -ipivot +1
ii = ipivot - ji + 3
- ptabout(ji,ij)= ksig * ptabin(ii, jj)
+ ptabout(ji,ij) = ksig * ptabin(ii, jj)
ENDDO
ENDDO
CASE ('U','u')
DO jj=npjglo-3,kjpacif, -1
ij= ijn + ( npjglo - 3 - jj ) +1 ! 2 *npjglo - kjatl -1 -jj
DO ji = 1, npiarctic
- ! ii = 2*ipivot -ji + 1 -ipivot + 1
ii = ipivot -ji + 2
- ptabout(ji,ij)= ksig * ptabin(ii, jj)
+ ptabout(ji,ij) = ksig * ptabin(ii, jj)
ENDDO
ENDDO
END SELECT
CASE ('F','f') ! pivot
- PRINT * , ' Not yet done for F pivot ' ; stop
+ PRINT * , ' Not yet done for F pivot ' ; STOP
END SELECT
END SUBROUTINE unfold
diff --git a/cdfnrjcomp.f90 b/cdfnrjcomp.f90
index 2705b37..623f41f 100644
--- a/cdfnrjcomp.f90
+++ b/cdfnrjcomp.f90
@@ -1,143 +1,156 @@
PROGRAM cdfnrjcomp
- !!---------------------------------------------------------------------------
- !! *** PROGRAM cdfnrjcomp ***
- !!
- !! ** Purpose: Compute the terms for energy components
+ !!======================================================================
+ !! *** PROGRAM cdfnrjcomp ***
+ !!=====================================================================
+ !! ** Purpose : Compute the terms for energy components
!! (Mean Kinetic Energy, Eddy Kinetic Energy,
!! Mean Potential Energy, Eddy Potential Energy )
- !! compute : tbar,ubar,vbar,anotsqrt,anousqrt,anovsqrt
+ !! compute : tbar, ubar, vbar, anotsqrt, anousqrt, anovsqrt
!!
- !! history :
- !! Original : A. Melet (Feb 2008)
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 02/2008 : A. Melet : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, jt, ilev
- INTEGER :: npiglo, npjglo, npk, nt
- INTEGER :: narg, iargc, ncout, ierr
- INTEGER, DIMENSION(6) :: ipk, id_varout !
-
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: un, vn, u2n, v2n
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: tn, t2n, anotsqrt
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: umask, vmask
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: anousqrt, anovsqrt
- REAL(KIND=4) ,DIMENSION(1) :: tim
-
- CHARACTER(LEN=256) :: cfile
- CHARACTER(LEN=256) :: cfileout='nrjcomp.nc'
- TYPE (variable), DIMENSION(6) :: typvar !: structure for attibutes
+ INTEGER(KIND=4) :: ji, jj, jk ! dummy loop index
+ INTEGER(KIND=4) :: npiglo, npjglo ! domain size
+ INTEGER(KIND=4) :: npk, npt ! domain size
+ INTEGER(KIND=4) :: narg, iargc ! browse line
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(6) :: ipk, id_varout ! level and varid's of output var
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn, u2n, v2n
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tn, t2n, anotsqrt
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: umask, vmask
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: anousqrt, anovsqrt
+ REAL(KIND=4), DIMENSION(1) :: tim ! time counter
+
+ CHARACTER(LEN=256) :: cf_in ! input filename
+ CHARACTER(LEN=256) :: cf_out='nrjcomp.nc' ! output file name
+ TYPE (variable), DIMENSION(6) :: stypvar ! structure for attibutes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
!!
narg = iargc()
IF ( narg /= 1 ) THEN
- PRINT *,' USAGE : cdfnrjcomp file'
- PRINT *,' Produce a cdf file nrjcomp.nc with variables'
- PRINT *,' tbar,ubar,vbar,anotsqrt,anousqrt,anovsqrt on T point'
- PRINT *,' file is from cdfmoyuvwt'
- PRINT *,' the mean must have been computed on a period long enough'
- PRINT *,' for the statistics to be meaningful'
- PRINT *,' '
- PRINT *,' if file is in grid B or C, check the code (PM)'
+ PRINT *,' usage : cdfnrjcomp IN-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute contributing terms of the energy equation at T-points.'
+ PRINT *,' Input file contains mean values processed by cdfmoyuvwt.'
+ PRINT *,' The means must have been computed on long enough period'
+ PRINT *,' for the statistics to be meaningful'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : netcdf file produced by cdfmoyuvwt.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' all variables are located at T point.'
+ PRINT *,' variables : tbar : mean temperature '
+ PRINT *,' ubar : mean zonal velocity'
+ PRINT *,' vbar : mean meridional velocity'
+ PRINT *,' anotsqrt : mean squared temperature anomaly'
+ PRINT *,' anousqrt : mean squared zonal velocity anomaly'
+ PRINT *,' anovsqrt : mean squared meridional velocity anomaly'
STOP
ENDIF
- CALL getarg(1, cfile)
- npiglo = getdim(cfile,'x')
- npjglo = getdim(cfile,'y')
- npk = getdim(cfile,'depth')
- nt = getdim(cfile,'time_counter')
-
- PRINT *, 'npiglo =',npiglo
- PRINT *, 'npjglo =',npjglo
- PRINT *, 'npk =',npk
- PRINT *, 'nt =',nt
-
- ! define new variables for output ( must update att.txt)
- typvar(1)%name='tbar'
- typvar(1)%long_name='temporal mean of the temperature on T point'
- typvar(1)%short_name='tbar'
-
- typvar(2)%name='ubar'
- typvar(2)%long_name='temporal mean of the zonal velocity on T point'
- typvar(2)%short_name='ubar'
-
- typvar(3)%name='vbar'
- typvar(3)%long_name='temporal mean of the meridional velocity on T point'
- typvar(3)%short_name='vbar'
-
- typvar(4)%name='anotsqrt'
- typvar(4)%long_name='temporal mean of the square of the temperature anomaly on T point (*1000)'
- typvar(4)%short_name='anotsqrt'
-
- typvar(5)%name='anousqrt'
- typvar(5)%long_name='temporal mean of the square of the zonal speed anomaly on T point (*1000)'
- typvar(5)%short_name='anousqrt'
+ CALL getarg(1, cf_in)
- typvar(6)%name='anovsqrt'
- typvar(6)%long_name='temporal mean of the square of the meridional speed anomaly on T point (*1000)'
- typvar(6)%short_name='anovsqrt'
+ IF ( chkfile(cf_in) ) STOP ! missing file
+ npiglo = getdim(cf_in,cn_x)
+ npjglo = getdim(cf_in,cn_y)
+ npk = getdim(cf_in,cn_z)
+ npt = getdim(cf_in,cn_t)
- typvar%units=' '
- typvar%missing_value=0.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar%online_operation='N/A'
- typvar%axis='TYX'
-
- ipk(:) = npk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ! define new variables for output
+ ipk(:) = npk
+ stypvar(1)%cname = 'tbar'
+ stypvar(1)%clong_name = 'temporal mean of the temperature on T point'
+ stypvar(1)%cshort_name = 'tbar'
+
+ stypvar(2)%cname = 'ubar'
+ stypvar(2)%clong_name = 'temporal mean of the zonal velocity on T point'
+ stypvar(2)%cshort_name = 'ubar'
+
+ stypvar(3)%cname = 'vbar'
+ stypvar(3)%clong_name = 'temporal mean of the meridional velocity on T point'
+ stypvar(3)%cshort_name = 'vbar'
+
+ stypvar(4)%cname = 'anotsqrt'
+ stypvar(4)%clong_name = 'temporal mean of the square of the temperature anomaly on T point (*1000)'
+ stypvar(4)%cshort_name = 'anotsqrt'
+
+ stypvar(5)%cname = 'anousqrt'
+ stypvar(5)%clong_name = 'temporal mean of the square of the zonal speed anomaly on T point (*1000)'
+ stypvar(5)%cshort_name = 'anousqrt'
+
+ stypvar(6)%cname = 'anovsqrt'
+ stypvar(6)%clong_name = 'temporal mean of the square of the meridional speed anomaly on T point (*1000)'
+ stypvar(6)%cshort_name = 'anovsqrt'
+
+ stypvar%cunits = ' '
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = -1000.
+ stypvar%valid_max = 1000.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TZYX'
- !test if lev exists
- IF ((npk==0) .AND. (ilev .GT. 0) ) THEN
- PRINT *, 'Problem : npk = 0 and lev > 0 STOP'
- STOP
- END IF
-
! create output fileset
- ncout =create(cfileout, cfile, npiglo,npjglo,npk)
- ierr= createvar(ncout ,typvar,6, ipk,id_varout )
- ierr= putheadervar(ncout, cfile, npiglo, npjglo,npk)
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 6, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk )
! Allocate the memory
- ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) )
- ALLOCATE ( umask(npiglo,npjglo) , vmask(npiglo,npjglo) )
- ALLOCATE ( u2n(npiglo,npjglo) , v2n(npiglo,npjglo) )
- ALLOCATE ( anousqrt(npiglo,npjglo) , anovsqrt(npiglo,npjglo) )
- ALLOCATE ( tn(npiglo,npjglo) , t2n(npiglo,npjglo) )
+ ALLOCATE ( un(npiglo,npjglo), vn(npiglo,npjglo) )
+ ALLOCATE ( umask(npiglo,npjglo), vmask(npiglo,npjglo) )
+ ALLOCATE ( u2n(npiglo,npjglo), v2n(npiglo,npjglo) )
+ ALLOCATE ( anousqrt(npiglo,npjglo), anovsqrt(npiglo,npjglo) )
+ ALLOCATE ( tn(npiglo,npjglo), t2n(npiglo,npjglo) )
ALLOCATE ( anotsqrt(npiglo,npjglo) )
-
- tim=getvar1d(cfile,'time_counter',nt)
- ierr=putvar1d(ncout,tim,1,'T')
+ tim = getvar1d(cf_in,cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
DO jk=1, npk
PRINT *,' level ',jk
-
- anousqrt(:,:) = 0.d0
- anovsqrt(:,:) = 0.d0
- anotsqrt(:,:) = 0.d0
+ anousqrt(:,:) = 0.0
+ anovsqrt(:,:) = 0.0
+ anotsqrt(:,:) = 0.0
- un(:,:) = getvar(cfile, 'ubar', jk ,npiglo,npjglo, ktime=1)
- vn(:,:) = getvar(cfile, 'vbar', jk ,npiglo,npjglo, ktime=1)
- u2n(:,:) = getvar(cfile, 'u2bar', jk ,npiglo,npjglo, ktime=1)
- v2n(:,:) = getvar(cfile, 'v2bar', jk ,npiglo,npjglo, ktime=1)
- tn(:,:) = getvar(cfile, 'tbar', jk ,npiglo,npjglo, ktime=1)
- t2n(:,:) = getvar(cfile, 't2bar', jk ,npiglo,npjglo, ktime=1)
+ un(:,:) = getvar(cf_in, 'ubar', jk, npiglo, npjglo, ktime=1)
+ vn(:,:) = getvar(cf_in, 'vbar', jk, npiglo, npjglo, ktime=1)
+ u2n(:,:) = getvar(cf_in, 'u2bar', jk, npiglo, npjglo, ktime=1)
+ v2n(:,:) = getvar(cf_in, 'v2bar', jk, npiglo, npjglo, ktime=1)
+ tn(:,:) = getvar(cf_in, 'tbar', jk, npiglo, npjglo, ktime=1)
+ t2n(:,:) = getvar(cf_in, 't2bar', jk, npiglo, npjglo, ktime=1)
! compute the mask
DO jj = 2, npjglo
DO ji = 2, npiglo
- umask(ji,jj)=0.
- vmask(ji,jj)=0.
- umask(ji,jj)= un(ji,jj)*un(ji-1,jj)
- vmask(ji,jj)= vn(ji,jj)*vn(ji,jj-1)
+ umask(ji,jj) = 0.
+ vmask(ji,jj) = 0.
+ umask(ji,jj) = un(ji,jj)*un(ji-1,jj)
+ vmask(ji,jj) = vn(ji,jj)*vn(ji,jj-1)
IF (umask(ji,jj) /= 0.) umask(ji,jj)=1.
IF (vmask(ji,jj) /= 0.) vmask(ji,jj)=1.
ENDDO
@@ -145,24 +158,23 @@ PROGRAM cdfnrjcomp
DO jj = 2, npjglo
DO ji = 2, npiglo ! vector opt.
-
- anotsqrt(ji,jj) = 1000 * ( t2n(ji,jj) - tn(ji,jj) * tn(ji,jj) )
- anousqrt(ji,jj) = 1000/2 * umask(ji,jj)*( ( u2n(ji,jj) - un(ji,jj)*un(ji,jj) ) &
+ anotsqrt(ji,jj) = 1000. * ( t2n(ji,jj) - tn(ji,jj) * tn(ji,jj) )
+ anousqrt(ji,jj) = 1000./2. * umask(ji,jj)*( ( u2n(ji,jj) - un(ji,jj)*un(ji,jj) ) &
& + ( u2n(ji-1,jj) - un(ji-1,jj)*un(ji-1,jj) ) )
- anovsqrt(ji,jj) = 1000/2 * vmask(ji,jj)*( ( v2n(ji,jj) - vn(ji,jj)*vn(ji,jj) ) &
+ anovsqrt(ji,jj) = 1000./2. * vmask(ji,jj)*( ( v2n(ji,jj) - vn(ji,jj)*vn(ji,jj) ) &
& + ( v2n(ji,jj-1) - vn(ji,jj)*vn(ji,jj-1) ) )
-
END DO
END DO
!
- ierr = putvar(ncout, id_varout(1) ,tn, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(2) ,un, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(3) ,vn, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(4) ,anotsqrt, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(5) ,anousqrt, jk, npiglo, npjglo, ktime=1)
- ierr = putvar(ncout, id_varout(6) ,anovsqrt, jk, npiglo, npjglo, ktime=1)
+ ierr = putvar(ncout, id_varout(1), tn, jk, npiglo, npjglo, ktime=1)
+ ierr = putvar(ncout, id_varout(2), un, jk, npiglo, npjglo, ktime=1)
+ ierr = putvar(ncout, id_varout(3), vn, jk, npiglo, npjglo, ktime=1)
+ ierr = putvar(ncout, id_varout(4), anotsqrt, jk, npiglo, npjglo, ktime=1)
+ ierr = putvar(ncout, id_varout(5), anousqrt, jk, npiglo, npjglo, ktime=1)
+ ierr = putvar(ncout, id_varout(6), anovsqrt, jk, npiglo, npjglo, ktime=1)
END DO
+
ierr = closeout(ncout)
END PROGRAM cdfnrjcomp
diff --git a/cdfovide.f90 b/cdfovide.f90
index 7833423..38f4c8d 100644
--- a/cdfovide.f90
+++ b/cdfovide.f90
@@ -1,108 +1,103 @@
PROGRAM cdfovide
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfovide ***
- !!
- !! ** Purpose: Easy tool to perform Temperature, Salinity and velocity
- !! plots along OVIDE section
+ !!======================================================================
+ !! *** PROGRAM cdfovide ***
+ !!=====================================================================
+ !! ** Purpose : Easy tool to perform Temperature, Salinity and velocity
+ !! plots along OVIDE section
!! PARTIAL STEPS version
- !!
- !! ** Method: Works as a standalone file once compiled
- !! Inspired by cdffindij, cdftransportiz
- !! history :
- !! Original : R. Dussin (dec. 2008)
!!
- !!---------------------------------------------------------------------
- !! * Modules used
+ !! ** Method : Works as a standalone file once compiled
+ !! Inspired by cdffindij, cdftransportiz
+ !!
+ !! History : 2.1 : 12/2009 : R. Dussin : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !!----------------------------------------------------------------------
USE cdfio
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo, npjglo, npk !: size of the domain
- INTEGER :: niter, nclass
- INTEGER :: imin, imax, jmin, jmax, k, ik, jk, jclass
- INTEGER :: iloc, jloc
- INTEGER :: iloop, jloop
-
- INTEGER :: nsec=0 ! nb total de points le long de la section
- INTEGER, DIMENSION (:), ALLOCATABLE :: isec, jsec ! indices des points a recuperer
+
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain
+ INTEGER(KIND=4) :: niter
+ INTEGER(KIND=4) :: imin, imax, jmin, jmax, k, ik, jk, jclass
+ INTEGER(KIND=4) :: iloc, jloc
+ INTEGER(KIND=4) :: iloop, jloop
+
+ INTEGER(KIND=4) :: nsec=0 ! nb total de points le long de la section
+ INTEGER(KIND=4), DIMENSION (:), ALLOCATABLE :: isec, jsec ! indices des points a recuperer
- INTEGER, PARAMETER :: nsta=4
- INTEGER, DIMENSION(nsta) :: ista, jsta
- INTEGER, DIMENSION(nsta-1) :: keepn
+ INTEGER(KIND=4), PARAMETER :: nsta=4
+ INTEGER(KIND=4), DIMENSION(nsta) :: ista, jsta
+ INTEGER(KIND=4), DIMENSION(nsta-1) :: ikeepn
- INTEGER ,DIMENSION (:),ALLOCATABLE :: imeter !: limit beetween depth level, in m (nclass -1)
- INTEGER ,DIMENSION (:),ALLOCATABLE :: ilev0,ilev1 !: limit in levels ! nclass
- INTEGER :: numout = 10, numvtrp=11, numhtrp=12, numstrp=14
! broken line stuff
- INTEGER, PARAMETER :: jpseg=10000
- INTEGER :: i0,j0,i1,j1, i, j
- INTEGER :: n,nn, jseg, kk
- INTEGER :: norm_u, norm_v, ist, jst
- INTEGER :: nxtarg
- INTEGER, DIMENSION(nsta-1,jpseg) :: legs1=0, legs2=0
-
- REAL(KIND=8),DIMENSION(nsta) :: lonsta, latsta
+ INTEGER(KIND=4), PARAMETER :: jpseg=10000
+ INTEGER(KIND=4) :: i0,j0,i1,j1, i, j
+ INTEGER(KIND=4) :: n,nn, jseg, kk
+ INTEGER(KIND=4) :: norm_u, norm_v, ist, jst
+ INTEGER(KIND=4) :: nxtarg
+ INTEGER(KIND=4), DIMENSION(nsta-1,jpseg) :: legs1=0, legs2=0
+
+ REAL(KIND=8), DIMENSION(nsta) :: rlonsta, rlatsta
REAL(KIND=8) :: xmin, xmax, ymin, ymax, rdis
REAL(KIND=4) :: glamfound, glamin, glamax
REAL(KIND=8) :: glam0, emax
REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: glam, gphi, e1, e2
REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t, e1u, e2v, e3t
- REAL(KIND=4) :: rxi0,ryj0, rxi1, ryj1
- REAL(KIND=4) :: ai,bi, aj,bj,d
- REAL(KIND=4) :: rxx(jpseg),ryy(jpseg)
+ REAL(KIND=4) :: rxi0, ryj0, rxi1, ryj1
+ REAL(KIND=4) :: ai, bi, aj,bj,d
+ REAL(KIND=4) :: rxx(jpseg), ryy(jpseg)
REAL(KIND=4), DIMENSION(jpseg) :: gla !, gphi
REAL(KIND=8), DIMENSION(jpseg) :: voltrp, heatrp, saltrp
REAL(KIND=8) :: voltrpsum, heatrpsum, saltrpsum
COMPLEX yypt(jpseg), yypti
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, e3v ,gphiv, zv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u ,gphiu, zu, zut, zus !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: temper, saline, zonalu, meridv, navlon, navlat
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: ovidetemper, ovidesaline, ovidezonalu, ovidemeridv
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: lonsec, latsec, dumisec, dumjsec
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1tsec, e1usec, e1vsec, e2tsec, e2usec, e2vsec
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e3tsec, e3usec, e3vsec
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamu, glamv
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw
- REAL(KIND=4) :: rd1, rd2
- REAL(KIND=4) :: udum, vdum
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku,zwkv, zwkut,zwkvt, zwkus,zwkvs
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: ztrpu, ztrpv, ztrput,ztrpvt, ztrpus,ztrpvs
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e3v ,gphiv, zv, zvt, zvs !: mask, metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2u, e3u ,gphiu, zu, zut, zus !: mask, metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: temper, saline, zonalu, meridv, navlon, navlat
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ovidetemper, ovidesaline, ovidezonalu, ovidemeridv
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: lonsec, latsec, dumisec, dumjsec
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1tsec, e1usec, e1vsec, e2tsec, e2usec, e2vsec
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3tsec, e3usec, e3vsec
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamu, glamv
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw
+
! constants
REAL(KIND=4) :: rau0=1000., rcp=4000.
- CHARACTER(LEN=80) :: coord='coordinates.nc', ctype='F'
+ CHARACTER(LEN=80) :: ctype='F'
CHARACTER(LEN=80) :: cfilet , cfileu, cfilev, csection
- CHARACTER(LEN=80) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cdum
- CHARACTER(LEN=80) ,DIMENSION(4) :: cvarname !: array of var name for output
LOGICAL :: lagain, lbord
- LOGICAL :: ltest=.FALSE.
+ LOGICAL :: ltest=.FALSE.
+ LOGICAL :: lchk
! cdf output stuff
CHARACTER(LEN=80) :: cfileoutnc='ovide.nc'
- TYPE(variable) ,DIMENSION(:), ALLOCATABLE :: typvar
- INTEGER :: ierr, ncout
- REAL(KIND=4), DIMENSION (1) :: tim
- INTEGER :: nfield=10
- INTEGER ,DIMENSION (:),ALLOCATABLE :: ipk, id_varout
-
- !!---------------------------------------------------------------------
- !! End of declarations, code begins here
- !!---------------------------------------------------------------------
-
- !!---------------------------------------------------------------------
- !! Command line
- !!---------------------------------------------------------------------
-
- narg= iargc()
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar
+ INTEGER(KIND=4) :: ierr, ncout
+ REAL(KIND=4), DIMENSION(1) :: tim
+ INTEGER(KIND=4) :: nfield=10
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg < 3 ) THEN
- PRINT *,' Usage : cdfovide gridTfile gridUfile gridVfile '
- PRINT *,' Files cordinates.nc, mesh_hgr.nc and mesh_zgr.nc must be in te current directory '
- PRINT *,' Output on netcdf '
+ PRINT *,'usage : cdfovide gridTfile gridUfile gridVfile '
+ PRINT *,' Files ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr),' must be in te current directory '
+ PRINT *,' Output on netcdf file ',TRIM(cfileoutnc)
STOP
ENDIF
@@ -110,20 +105,18 @@ PROGRAM cdfovide
CALL getarg (2, cfileu)
CALL getarg (3, cfilev)
- !! We define what are the 3 segments of OVIDE section
- !! so that the user don't have to worry about it
- !! sec1 : (lonsta1,latsta1) -> (lonsta2,latsta2)
- !! and so on
-
- lonsta(1)=-43.0
- lonsta(2)=-31.3
- lonsta(3)=-12.65
- lonsta(4)=-8.7
+ lchk = chkfile(cn_fhgr)
+ lchk = chkfile(cn_fzgr) .OR. lchk
+ lchk = chkfile(cfilet ) .OR. lchk
+ lchk = chkfile(cfileu ) .OR. lchk
+ lchk = chkfile(cfilev ) .OR. lchk
+ IF ( lchk ) STOP ! missing files
- latsta(1)=60.6
- latsta(2)=58.9
- latsta(3)=40.33
- latsta(4)=40.33
+ ! Location of leg points that define the 3 legs of OVIDE section
+ rlonsta(1) = -43.00 ; rlatsta(1) = 60.60 ! Greenland
+ rlonsta(2) = -31.30 ; rlatsta(2) = 58.90 ! Reykjanes Ridge
+ rlonsta(3) = -12.65 ; rlatsta(3) = 40.33 ! Off Portugal
+ rlonsta(4) = -8.70 ; rlatsta(4) = 40.33 ! Lisboa
PRINT *, '###########################################################'
PRINT *, '# '
@@ -139,33 +132,33 @@ PROGRAM cdfovide
!! Find the indexes of the 3 legs (from cdffindij)
!!---------------------------------------------------------------------
- npiglo= getdim (coord,'x')
- npjglo= getdim (coord,'y')
+ npiglo = getdim (cn_fhgr,cn_x)
+ npjglo = getdim (cn_fhgr,cn_y)
ALLOCATE (glam(npiglo,npjglo), gphi(npiglo,npjglo) )
ALLOCATE (e1(npiglo,npjglo), e2(npiglo,npjglo) )
SELECT CASE ( ctype )
CASE ('T' , 't' )
- glam(:,:) = getvar(coord, 'glamt',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphit',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1t' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2t' ,1,npiglo,npjglo)
+ glam(:,:) = getvar(cn_fhgr, 'glamt',1,npiglo,npjglo)
+ gphi(:,:) = getvar(cn_fhgr, 'gphit',1,npiglo,npjglo)
+ e1 (:,:) = getvar(cn_fhgr, 'e1t' ,1,npiglo,npjglo)
+ e2 (:,:) = getvar(cn_fhgr, 'e2t' ,1,npiglo,npjglo)
CASE ('U','u' )
- glam(:,:) = getvar(coord, 'glamu',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphiu',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1u' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2u' ,1,npiglo,npjglo)
+ glam(:,:) = getvar(cn_fhgr, 'glamu',1,npiglo,npjglo)
+ gphi(:,:) = getvar(cn_fhgr, 'gphiu',1,npiglo,npjglo)
+ e1 (:,:) = getvar(cn_fhgr, 'e1u' ,1,npiglo,npjglo)
+ e2 (:,:) = getvar(cn_fhgr, 'e2u' ,1,npiglo,npjglo)
CASE ('V','v' )
- glam(:,:) = getvar(coord, 'glamv',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphiv',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1v' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2v' ,1,npiglo,npjglo)
+ glam(:,:) = getvar(cn_fhgr, 'glamv',1,npiglo,npjglo)
+ gphi(:,:) = getvar(cn_fhgr, 'gphiv',1,npiglo,npjglo)
+ e1 (:,:) = getvar(cn_fhgr, 'e1v' ,1,npiglo,npjglo)
+ e2 (:,:) = getvar(cn_fhgr, 'e2v' ,1,npiglo,npjglo)
CASE ('F','f' )
- glam(:,:) = getvar(coord, 'glamf',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphif',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1f' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2f' ,1,npiglo,npjglo)
+ glam(:,:) = getvar(cn_fhgr, 'glamf',1,npiglo,npjglo)
+ gphi(:,:) = getvar(cn_fhgr, 'gphif',1,npiglo,npjglo)
+ e1 (:,:) = getvar(cn_fhgr, 'e1f' ,1,npiglo,npjglo)
+ e2 (:,:) = getvar(cn_fhgr, 'e2f' ,1,npiglo,npjglo)
CASE DEFAULT
PRINT *,' ERROR : type of point not known: ', TRIM(ctype)
END SELECT
@@ -179,10 +172,10 @@ PROGRAM cdfovide
!! loop on the 3 legs
DO k = 1,nsta-1
- xmin=lonsta(k)
- ymin=latsta(k)
- xmax=lonsta(k+1)
- ymax=latsta(k+1)
+ xmin=rlonsta(k)
+ ymin=rlatsta(k)
+ xmax=rlonsta(k+1)
+ ymax=rlatsta(k+1)
IF (xmin < 0.) xmin = xmin +360.
IF (xmax < 0.) xmax = xmax +360.
@@ -394,21 +387,21 @@ PROGRAM cdfovide
END IF
! compute the number of total points
- keepn(k)=nn
+ ikeepn(k)=nn
nsec = nsec + nn
END DO !! loop on the 3 legs
! fancy control print
WRITE(*,*) '------------------------------------------------------------'
-WRITE(*,9100) 'leg 1 start at ', lonsta(1) ,'°N ', latsta(1), '°W and ends at ', lonsta(2) ,'°N ', latsta(2), '°W'
+WRITE(*,9100) 'leg 1 start at ', rlonsta(1) ,'°N ', rlatsta(1), '°W and ends at ', rlonsta(2) ,'°N ', rlatsta(2), '°W'
WRITE(*,9101) 'corresponding to F-gridpoints(', ista(1),',',jsta(1),') and (', ista(2),',',jsta(2),')'
WRITE(*,*) '------------------------------------------------------------'
WRITE(*,*) '------------------------------------------------------------'
-WRITE(*,9100) 'leg 2 start at ', lonsta(2) ,'°N ', latsta(2), '°W and ends at ', lonsta(3) ,'°N ', latsta(3), '°W'
+WRITE(*,9100) 'leg 2 start at ', rlonsta(2) ,'°N ', rlatsta(2), '°W and ends at ', rlonsta(3) ,'°N ', rlatsta(3), '°W'
WRITE(*,9101) 'corresponding to F-gridpoints(', ista(2),',',jsta(2),') and (', ista(3),',',jsta(3),')'
WRITE(*,*) '------------------------------------------------------------'
WRITE(*,*) '------------------------------------------------------------'
-WRITE(*,9100) 'leg 3 start at ', lonsta(3) ,'°N ', latsta(3), '°W and ends at ', lonsta(4) ,'°N ', latsta(4), '°W'
+WRITE(*,9100) 'leg 3 start at ', rlonsta(3) ,'°N ', rlatsta(3), '°W and ends at ', rlonsta(4) ,'°N ', rlatsta(4), '°W'
WRITE(*,9101) 'corresponding to F-gridpoints(', ista(3),',',jsta(3),') and (', ista(4),',',jsta(4),')'
WRITE(*,*) '------------------------------------------------------------'
@@ -418,8 +411,8 @@ WRITE(*,*) '------------------------------------------------------------'
ALLOCATE (isec(nsec), jsec(nsec))
DO k=1, nsta-1
- DO iloop=1, keepn(k)
- jloop=iloop + SUM(keepn(1:k)) -keepn(k)
+ DO iloop=1, ikeepn(k)
+ jloop=iloop + SUM(ikeepn(1:k)) -ikeepn(k)
isec(jloop)=legs1(k,iloop)
jsec(jloop)=legs2(k,iloop)
END DO
@@ -448,8 +441,8 @@ WRITE(*,*) '------------------------------------------------------------'
navlon(:,:) = getvar(cfilet, 'nav_lon' ,1,npiglo,npjglo)
navlat(:,:) = getvar(cfilet, 'nav_lat' ,1,npiglo,npjglo)
- e1v(:,:) = getvar(coordhgr, 'e1v',1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u',1,npiglo,npjglo)
+ e1v(:,:) = getvar(cn_fhgr, 'e1v',1,npiglo,npjglo)
+ e2u(:,:) = getvar(cn_fhgr, 'e2u',1,npiglo,npjglo)
! il faut faire un test sur la continuité des segements
! on va prendre T et S comme etant la moyenne du point
@@ -503,8 +496,8 @@ WRITE(*,*) '------------------------------------------------------------'
saline(:,:) = getvar(cfilet, 'vosaline',jk,npiglo,npjglo)
zonalu(:,:) = getvar(cfileu, 'vozocrtx',jk,npiglo,npjglo)
meridv(:,:) = getvar(cfilev, 'vomecrty',jk,npiglo,npjglo)
- e3u(:,:) = getvar(coordzgr, 'e3u_ps',jk,npiglo,npjglo, ldiom=.true.)
- e3v(:,:) = getvar(coordzgr, 'e3v_ps',jk,npiglo,npjglo, ldiom=.true.)
+ e3u(:,:) = getvar(cn_fzgr, 'e3u_ps',jk,npiglo,npjglo, ldiom=.true.)
+ e3v(:,:) = getvar(cn_fzgr, 'e3v_ps',jk,npiglo,npjglo, ldiom=.true.)
DO iloop=1,nsec-1
IF ( jsec(iloop+1) == jsec(iloop) ) THEN ! horizontal segment
@@ -572,69 +565,69 @@ WRITE(*,*) '------------------------------------------------------------'
END DO
END DO
- ALLOCATE ( typvar(nfield), ipk(nfield), id_varout(nfield) )
+ ALLOCATE ( stypvar(nfield), ipk(nfield), id_varout(nfield) )
DO iloop=1,nfield
ipk(iloop) = npk
END DO
! define new variables for output
- typvar(1)%name= 'votemper'
- typvar(1)%units='deg C'
- typvar%missing_value=0.
- typvar(1)%valid_min= -2.
- typvar(1)%valid_max= 40.
- typvar%scale_factor= 1.
- typvar%add_offset= 0.
- typvar%savelog10= 0.
- typvar(1)%long_name='Temperature along OVIDE section'
- typvar(1)%short_name='votemper'
- typvar%online_operation='N/A'
- typvar%axis='TYZ'
-
- typvar(2)%name= 'vosaline'
- typvar(2)%units='PSU'
- typvar(2)%valid_min= 0.
- typvar(2)%valid_max= 50.
- typvar(2)%long_name='Salinity along OVIDE section'
- typvar(2)%short_name='vosaline'
-
- typvar(3)%name= 'vozocrtx'
- typvar(3)%units='m.s-1'
- typvar(3)%valid_min= -20.
- typvar(3)%valid_max= 20.
- typvar(3)%long_name='Zonal velocity along OVIDE section'
- typvar(3)%short_name='vozocrtx'
-
- typvar(4)%name= 'vomecrty'
- typvar(4)%units='m.s-1'
- typvar(4)%valid_min= -20.
- typvar(4)%valid_max= 20.
- typvar(4)%long_name='Meridionnal velocity along OVIDE section'
- typvar(4)%short_name='vomecrty'
-
- typvar(5)%name= 'isec'
- typvar(5)%valid_min= 0.
- typvar(5)%valid_max= npiglo
- typvar(6)%name= 'jsec'
- typvar(6)%valid_min= 0.
- typvar(6)%valid_max= npjglo
- typvar(7)%name= 'e2u'
- typvar(7)%valid_min= MINVAL(e2usec(1,:))
- typvar(7)%valid_max= MAXVAL(e2usec(1,:))
- typvar(8)%name= 'e1v'
- typvar(8)%valid_min= MINVAL(e1vsec(1,:))
- typvar(8)%valid_max= MAXVAL(e1vsec(1,:))
- typvar(9)%name= 'e3u'
- typvar(9)%valid_min= MINVAL(e3usec(:,:))
- typvar(9)%valid_max= MAXVAL(e3usec(:,:))
- typvar(10)%name= 'e3v'
- typvar(10)%valid_min= MINVAL(e3vsec(:,:))
- typvar(10)%valid_max= MAXVAL(e3vsec(:,:))
+ stypvar(1)%cname= 'votemper'
+ stypvar(1)%cunits='deg C'
+ stypvar%rmissing_value=0.
+ stypvar(1)%valid_min= -2.
+ stypvar(1)%valid_max= 40.
+ stypvar%scale_factor= 1.
+ stypvar%add_offset= 0.
+ stypvar%savelog10= 0.
+ stypvar(1)%clong_name='Temperature along OVIDE section'
+ stypvar(1)%cshort_name='votemper'
+ stypvar%conline_operation='N/A'
+ stypvar%caxis='TYZ'
+
+ stypvar(2)%cname= 'vosaline'
+ stypvar(2)%cunits='PSU'
+ stypvar(2)%valid_min= 0.
+ stypvar(2)%valid_max= 50.
+ stypvar(2)%clong_name='Salinity along OVIDE section'
+ stypvar(2)%cshort_name='vosaline'
+
+ stypvar(3)%cname= 'vozocrtx'
+ stypvar(3)%cunits='m.s-1'
+ stypvar(3)%valid_min= -20.
+ stypvar(3)%valid_max= 20.
+ stypvar(3)%clong_name='Zonal velocity along OVIDE section'
+ stypvar(3)%cshort_name='vozocrtx'
+
+ stypvar(4)%cname= 'vomecrty'
+ stypvar(4)%cunits='m.s-1'
+ stypvar(4)%valid_min= -20.
+ stypvar(4)%valid_max= 20.
+ stypvar(4)%clong_name='Meridionnal velocity along OVIDE section'
+ stypvar(4)%cshort_name='vomecrty'
+
+ stypvar(5)%cname= 'isec'
+ stypvar(5)%valid_min= 0.
+ stypvar(5)%valid_max= npiglo
+ stypvar(6)%cname= 'jsec'
+ stypvar(6)%valid_min= 0.
+ stypvar(6)%valid_max= npjglo
+ stypvar(7)%cname= 'e2u'
+ stypvar(7)%valid_min= MINVAL(e2usec(1,:))
+ stypvar(7)%valid_max= MAXVAL(e2usec(1,:))
+ stypvar(8)%cname= 'e1v'
+ stypvar(8)%valid_min= MINVAL(e1vsec(1,:))
+ stypvar(8)%valid_max= MAXVAL(e1vsec(1,:))
+ stypvar(9)%cname= 'e3u'
+ stypvar(9)%valid_min= MINVAL(e3usec(:,:))
+ stypvar(9)%valid_max= MAXVAL(e3usec(:,:))
+ stypvar(10)%cname= 'e3v'
+ stypvar(10)%valid_min= MINVAL(e3vsec(:,:))
+ stypvar(10)%valid_max= MAXVAL(e3vsec(:,:))
! create output fileset
ncout =create(cfileoutnc, 'none', 1,nsec,npk,cdep='depthw')
- ierr= createvar(ncout ,typvar,nfield, ipk,id_varout )
+ ierr= createvar(ncout ,stypvar,nfield, ipk,id_varout )
ierr= putheadervar(ncout, cfilet,1, nsec,npk,pnavlon=lonsec,pnavlat=latsec,pdep=gdepw)
tim=getvar1d(cfilet,'time_counter',1)
ierr=putvar1d(ncout,tim,1,'T')
@@ -683,14 +676,14 @@ CONTAINS
IMPLICIT NONE
!* arguments
REAL(KIND=8),INTENT(in) :: pplon,pplat !: lon and lat of target point
- INTEGER,INTENT (in) :: kpi,kpj !: grid size
- INTEGER,INTENT (inout) :: kpiloc,kpjloc !: nearest point location
+ INTEGER(KIND=4),INTENT (in) :: kpi,kpj !: grid size
+ INTEGER(KIND=4),INTENT (inout) :: kpiloc,kpjloc !: nearest point location
REAL(KIND=8),DIMENSION(kpi,kpj),INTENT(in) :: pphi,plam !: model grid layout
LOGICAL :: ldbord !: reach boundary flag
! * local variables
- INTEGER :: ji,jj,i0,j0,i1,j1
- INTEGER :: itbl
+ INTEGER(KIND=4) :: ji,jj,i0,j0,i1,j1
+ INTEGER(KIND=4) :: itbl
REAL(KIND=4) :: zdist,zdistmin,zdistmin0
LOGICAL, SAVE :: lbordcell, lfirst=.TRUE.
!!
@@ -766,7 +759,7 @@ SUBROUTINE interm_pt (ydpt,k,pai,pbi,paj,pbj,ydpti)
COMPLEX, INTENT(in) :: ydpt(*)
COMPLEX, INTENT(out) :: ydpti
REAL(KIND=4), INTENT(IN) :: pai,pbi,paj,pbj
- INTEGER ,INTENT(in) :: k
+ INTEGER(KIND=4) ,INTENT(in) :: k
! ... local
COMPLEX :: ylptmp1, ylptmp2
REAL(KIND=4) :: za0,zb0,za1,zb1,zd1,zd2
diff --git a/cdfpendep.f90 b/cdfpendep.f90
index 173984c..08e65ec 100644
--- a/cdfpendep.f90
+++ b/cdfpendep.f90
@@ -1,100 +1,140 @@
-PROGRAM cdfpendep_new
- !!-------------------------------------------------------------------
- !! PROGRAM CDFPENDEP
- !! *****************
+PROGRAM cdfpendep
+ !!======================================================================
+ !! *** PROGRAM cdfpendep ***
+ !!=====================================================================
+ !! ** Purpose : Computes penetration depth for passive tracer output.
+ !! This is the ratio between inventory and surface
+ !! concentration.
!!
- !! ** Purpose: Computes penetration depth for passive tracer
- !! output. This is the ratio between inventory
- !! and surface concentration (2D) field
- !!
- !! ** Method: takes TRC files as input
+ !! ** Method : takes TRC files as input
!!
- !! history:
- !! Original: J.M. Molines (Feb. 2008(
- !!-------------------------------------------------------------------
- !! $Rev: 256 $
- !! $Date: 2009-07-21 17:49:27 +0200 (mar 21 jui 2009) $
- !! $Id: cdfpendep.f90 256 2009-07-21 15:49:27Z molines $
- !!--------------------------------------------------------------
- !!
- !! * Modules used
+ !! History : 2.1 : 02/2008 : J.M. Molines : Original code
+ !! : 2.1 : 09/2010 : C. Dufour : Adapation to TOP evolution
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, jarg
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, id_varout
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: trcinv, trcsurf, pendep
- REAL(KIND=4) ,DIMENSION(1) :: timean
-
- CHARACTER(LEN=256) :: cfiletrc, cfiledia, cfileout='pendep.nc' !: file name
- CHARACTER(LEN=256) :: cinv='invcfc' , ctrc='cfc11', cdum
- TYPE(variable), DIMENSION(1) :: typvar
-
- INTEGER :: ncout
- INTEGER :: istatus, ierr
-
- !! Read command line
- narg= iargc()
+
+ INTEGER(KIND=4) :: jt ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! browse command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid's of output vats
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: trcinv, trcsurf ! inventory, surface concentration
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rpendep ! penetration depth
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ CHARACTER(LEN=256) :: cf_trcfil ! tracer file name
+ CHARACTER(LEN=256) :: cf_inv ! inventory file name
+ CHARACTER(LEN=256) :: cf_out='pendep.nc' ! output file
+ CHARACTER(LEN=256) :: cv_inv ! inventory variable name
+ CHARACTER(LEN=256) :: cv_trc ! tracer variable name
+ CHARACTER(LEN=256) :: cglobal ! global attribute
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ TYPE(variable), DIMENSION(1) :: typvar ! structure for attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ cv_inv = cn_invcfc
+ cv_trc = cn_cfc11
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfpendep ''TRC file'' ''DIA file'' [-inv inventory_name -trc trc_name ]'
- PRINT *,' if not given, inventory name is invcfc, and trc name is cfc11 '
- PRINT *,' Output on pendep.nc ,variable pendep (m) '
+ PRINT *,' usage : cdfpendep TRC-file INV-file ... '
+ PRINT *,' ... [-inv inventory_name -trc trc_name ]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the penetration depth for passive tracers. It is the'
+ PRINT *,' ratio between the inventory and the surface concentration of'
+ PRINT *,' the tracer.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' TRC-file : netcdf file with tracer concentration.'
+ PRINT *,' INV-file : netcdf file with inventory of the tracer.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-inv inventory_name ] : specify netcdf variable name for inventory.'
+ PRINT *,' Default is ', TRIM(cv_inv)
+ PRINT *,' [-trc tracer_name ] : specify netcdf variable name for tracer.'
+ PRINT *,' Default is ', TRIM(cv_trc)
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : pendep (m)'
STOP
ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfiletrc)
- CALL getarg (2, cfiledia)
- IF ( narg > 2 ) THEN
- jarg=3
- DO WHILE (jarg <= narg )
- CALL getarg(jarg,cdum)
- SELECT CASE (cdum)
- CASE ('-inv') ; jarg=jarg+1 ; CALL getarg(jarg,cinv) ; jarg=jarg+1
- CASE ('-trc') ; jarg=jarg+1 ; CALL getarg(jarg,ctrc) ; jarg=jarg+1
- CASE DEFAULT ; PRINT *, 'option ', TRIM(cdum),' not understood' ; STOP
- END SELECT
- END DO
- ENDIF
-
- npiglo = getdim (cfiletrc,'x')
- npjglo = getdim (cfiletrc,'y')
- npk = getdim (cfiletrc,'deptht')
-
- ipk(1) = 1
- typvar(1)%name='pendep'
- typvar(1)%units='m'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 10000.
- typvar(1)%long_name='Penetration depth'
- typvar(1)%short_name='pendep'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( trcinv(npiglo,npjglo), trcsurf(npiglo,npjglo), pendep(npiglo,npjglo) )
-
- ncout =create(cfileout, cfiletrc,npiglo,npjglo,1)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfiletrc, npiglo, npjglo,1)
-
- pendep(:,:)=0.
- trcinv(:,:) = getvar(cfiledia,cinv,1 ,npiglo, npjglo)
- trcsurf(:,:) = getvar(cfiletrc,ctrc,1 ,npiglo, npjglo)
- WHERE( trcsurf /= 0 ) pendep=trcinv/trcsurf
- ierr=putvar(ncout,id_varout(1), pendep, 1 ,npiglo, npjglo)
-
- timean=getvar1d(cfiletrc,'time_counter',1)
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
-
-END PROGRAM cdfpendep_new
+
+ ijarg = 1
+ CALL getarg (ijarg, cf_trcfil) ; ijarg = ijarg + 1
+ CALL getarg (ijarg, cf_inv ) ; ijarg = ijarg + 1
+
+ IF ( chkfile(cf_trcfil) .OR. chkfile(cf_inv) ) STOP ! missing file
+
+ DO WHILE ( ijarg <= narg)
+ CALL getarg(ijarg, cldum ) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ('-inv') ; CALL getarg(ijarg, cv_inv) ; ijarg=ijarg+1
+ CASE ('-trc') ; CALL getarg(ijarg, cv_trc) ; ijarg=ijarg+1
+ CASE DEFAULT ; PRINT *, 'option ', TRIM(cldum),' not understood' ; STOP
+ END SELECT
+ END DO
+
+ npiglo = getdim (cf_trcfil,cn_x)
+ npjglo = getdim (cf_trcfil,cn_y)
+ npk = getdim (cf_trcfil,cn_z)
+ npt = getdim (cf_trcfil,cn_t)
+
+ ipk(1) = 1
+ typvar(1)%cname = cn_pendep
+ typvar(1)%cunits = 'm'
+ typvar(1)%rmissing_value = 0.
+ typvar(1)%valid_min = 0.
+ typvar(1)%valid_max = 10000.
+ typvar(1)%clong_name = 'Penetration depth'
+ typvar(1)%cshort_name = cn_pendep
+ typvar(1)%conline_operation = 'N/A'
+ typvar(1)%caxis = 'TYX'
+
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE( trcinv(npiglo,npjglo), trcsurf(npiglo,npjglo), rpendep(npiglo,npjglo) )
+ ALLOCATE( tim(npt) )
+
+ WRITE(cglobal,9000) TRIM(cf_trcfil), TRIM(cf_inv), TRIM(cv_inv), TRIM(cv_trc)
+9000 FORMAT('cdfpendep ',a,' ',a,' -inv ',a,' -trc ',a )
+
+ ncout = create (cf_out, cf_trcfil, npiglo, npjglo, 1)
+ ierr = createvar (ncout, typvar, 1, ipk, id_varout, cdglobal=cglobal )
+ ierr = putheadervar(ncout, cf_trcfil, npiglo, npjglo, 1)
+
+ DO jt = 1,npt
+ rpendep(:,:) = 0.
+ trcinv( :,:) = getvar(cf_inv, cv_inv, 1, npiglo, npjglo, ktime=jt)
+ trcsurf(:,:) = getvar(cf_trcfil, cv_trc, 1, npiglo, npjglo, ktime=jt)
+
+ WHERE( trcsurf /= 0 ) rpendep = trcinv/trcsurf
+ ierr=putvar(ncout, id_varout(1), rpendep, 1, npiglo, npjglo, ktime=jt)
+ END DO
+
+ tim = getvar1d(cf_trcfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = closeout(ncout)
+
+END PROGRAM cdfpendep
diff --git a/cdfpolymask.f90 b/cdfpolymask.f90
index 7c8dc04..e6f3d06 100644
--- a/cdfpolymask.f90
+++ b/cdfpolymask.f90
@@ -1,129 +1,172 @@
PROGRAM cdfpolymask
- !!-------------------------------------------------------------------
- !! *** PROGRAM CDFPOLYMASK ***
+ !!======================================================================
+ !! *** PROGRAM cdfpolymask ***
+ !!=====================================================================
+ !! ** Purpose : Create a nc file with 1 into subareas defined as a
+ !! polygone.
!!
- !! ** Purpose: Create a nc file with 1 into subareas defined as a polygone
- !!
- !! ** Method: Use polylib routine (from finite element mesh generator Trigrid)
- !! Read vertices of polygone in an ascii file an produce a resulting
- !! file the same shape as file givent in argumment (used only for size and
- !! header )
+ !! ** Method : Use polylib routine (from finite element mesh generator
+ !! Trigrid)
+ !! Read vertices of polygone in an ascii file an produce a
+ !! resulting file the same shape as file givent in argumment
+ !! (used only for size and header )
!!
- !! history:
- !! Original: J.M. Molines (July 2007 )
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- !! * Modules used
+ !! History : 2.1 : 07/2007 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! polymask
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, id_varout
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: rpmask
- REAL(KIND=4) ,DIMENSION(1) :: timean
-
- CHARACTER(LEN=256) :: cfile, cpoly, cfileout='polymask.nc' !: file name
- CHARACTER(LEN=256) :: cdum !: dummy arguments
- TYPE(variable), DIMENSION(1) :: typvar
-
- INTEGER :: ncout
- INTEGER :: istatus, ierr
- LOGICAL :: lreverse=.false.
-
- !! Read command line
- narg= iargc()
- IF ( narg < 2 ) THEN
- PRINT *,' Usage : cdfpolymask ''polygon file'' ''reference ncfile'' [-r]'
- PRINT *,' polygons are defined on the I,J grid'
- PRINT *,' Output on polymask.nc ,variable polymask'
- PRINT *,' polymask is 1 inside the polygon 0 outside '
- PRINT *,' If optional argument -r is given, the produced mask file '
- PRINT *,' is reverse : 1 outside the polygon, 0 in the polygon '
- STOP
- ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cpoly)
- CALL getarg (2, cfile)
- IF (narg == 3 ) THEN
- CALL getarg (3, cdum)
- IF ( cdum /= '-r' ) THEN
- PRINT *,' unknown optional arugment (', TRIM(cdum),' )'
- PRINT *,' in actual version only -r -- for reverse -- is recognized '
- STOP
- ELSE
- lreverse=.true.
- ENDIF
- ENDIF
- npiglo = getdim (cfile,'x')
- npjglo = getdim (cfile,'y')
- npk = 1
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line
+ INTEGER(KIND=4) :: npiglo, npjglo, npk ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! output var levels and varid
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rpmask ! mask array
+ REAL(KIND=4), DIMENSION(1) :: tim ! dummy time counter
+
+ CHARACTER(LEN=256) :: cf_ref ! name of reference file
+ CHARACTER(LEN=256) :: cf_poly ! name of ascii poly file
+ CHARACTER(LEN=256) :: cf_out='polymask.nc' ! output file name
+ CHARACTER(LEN=256) :: cldum ! dummy arguments
- ipk(1) = 1
- typvar(1)%name='polymask'
- typvar(1)%units='1/0'
- typvar(1)%missing_value=999.
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 1.
- typvar(1)%long_name='Polymask'
- typvar(1)%short_name='polymask'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
+ TYPE(variable), DIMENSION(1) :: stypvar ! output attribute
+ LOGICAL :: lreverse=.FALSE. ! reverse flag
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
+ narg = iargc()
+ IF ( narg < 2 ) THEN
+ PRINT *,' usage : cdfpolymask POLY-file REF-file [ -r]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Create a maskfile with polymask variable having 1'
+ PRINT *,' inside the polygon, and 0 outside. Option -r revert'
+ PRINT *,' the behaviour (0 inside, 1 outside).'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' POLY-file : input ASCII file describing a polyline in I J grid.'
+ PRINT *,' This file is structured by block, one block corresponding '
+ PRINT *,' to a polygon:'
+ PRINT *,' 1rst line of the block gives a polygon name'
+ PRINT *,' 2nd line gives the number of vertices (nvert) and a dummy 0'
+ PRINT *,' the block finishes with nvert pairs of (I,J) describing '
+ PRINT *,' the polygon vertices.'
+ PRINT *,' REF-file : reference netcdf file for header of polymask file.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ -r ] : revert option. When used, 0 is inside the polygon,'
+ PRINT *,' 1 outside.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : polymask'
+ STOP
+ ENDIF
+
+ ijarg = 1
+ CALL getarg (ijarg, cf_poly) ; ijarg = ijarg + 1
+ CALL getarg (ijarg, cf_ref ) ; ijarg = ijarg + 1
+
+ DO WHILE ( ijarg <= narg )
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-r' ) ; lreverse = .TRUE.
+ CASE DEFAULT
+ PRINT *,' unknown optional arugment (', TRIM(cldum),' )'
+ PRINT *,' in actual version only -r -- for reverse -- is recognized '
+ STOP
+ END SELECT
+ END DO
+
+ IF ( chkfile(cf_poly) .OR. chkfile(cf_ref) ) STOP ! missing files
+
+ npiglo = getdim (cf_ref, cn_x)
+ npjglo = getdim (cf_ref, cn_y)
+ npk = 1
+
+ ipk(1) = 1
+ stypvar(1)%cname = 'polymask'
+ stypvar(1)%cunits = '1/0'
+ stypvar(1)%rmissing_value = 999.
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 1.
+ stypvar(1)%clong_name = 'Polymask'
+ stypvar(1)%cshort_name = 'polymask'
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
ALLOCATE( rpmask(npiglo,npjglo) )
- ncout =create(cfileout, cfile,npiglo,npjglo,npk)
+ ncout = create (cf_out, cf_ref, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_ref, npiglo, npjglo, npk )
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfile, npiglo, npjglo,npk)
+ CALL polymask(cf_poly, rpmask)
- CALL polymask(cpoly, rpmask)
+ ierr = putvar(ncout, id_varout(1), rpmask, 1, npiglo, npjglo)
+ tim(:) = 0.
+ ierr = putvar1d(ncout, tim, 1, 'T')
- ierr=putvar(ncout,id_varout(1), rpmask, 1 ,npiglo, npjglo)
- timean=getvar1d(cfile,'time_counter',1)
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
CONTAINS
+
+
SUBROUTINE polymask( cdpoly, pmask)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE polymask ***
+ !!
+ !! ** Purpose : Build polymask from asci polygon file
+ !!
+ !! ** Method : Use Poly routines and functions from modpoly module
+ !!
+ !!----------------------------------------------------------------------
USE modpoly
- REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: pmask
- CHARACTER(LEN=*), INTENT(in) :: cdpoly
-
- ! *Local variables
- INTEGER :: ji,jj, nfront, jjpoly
- REAL(KIND=4) :: rin, rout
- LOGICAL :: l_in
- CHARACTER(LEN=256), DIMENSION(jpolys) :: carea
+
+ CHARACTER(LEN=*), INTENT(in ) :: cdpoly ! polygon file name
+ REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: pmask ! mask array
+
+ INTEGER(KIND=4) :: ji, jj, jjpoly ! dummy loop index
+ INTEGER(KIND=4) :: infront ! number of
+ REAL(KIND=4) :: zin, zout !
+ CHARACTER(LEN=256), DIMENSION(jpolys) :: cl_area ! name of the areas
+ LOGICAL :: ll_in ! flag for in/out poly
+ !!----------------------------------------------------------------------
IF ( lreverse ) THEN
- rin=0. ; rout=1.
+ zin = 0. ; zout = 1.
ELSE
- rin=1. ; rout=0.
+ zin = 1. ; zout = 0.
ENDIF
- pmask(:,:)=rout
- CALL ReadPoly(cdpoly,nfront, carea)
- DO jjpoly=1, nfront
+
+ pmask(:,:) = zout
+ CALL ReadPoly(cdpoly, infront, cl_area)
+ DO jjpoly=1, infront
CALL PrepPoly(jjpoly)
DO jj=npjglo, 1, -1
DO ji=1,npiglo
- CALL InPoly(jjpoly,float(ji), float(jj), l_in)
- IF (l_in ) pmask(ji,jj)=rin
+ CALL InPoly(jjpoly,float(ji), float(jj), ll_in)
+ IF (ll_in ) pmask(ji,jj) = zin
ENDDO
-! IF ( jj < 405 .AND. jj > 335 ) THEN
-! print '(i4,100i2)', jj, NINT(pmask(170:260,jj))
-! ENDIF
ENDDO
ENDDO
diff --git a/cdfprobe.f90 b/cdfprobe.f90
index b189a56..cf0b332 100644
--- a/cdfprobe.f90
+++ b/cdfprobe.f90
@@ -1,41 +1,67 @@
PROGRAM cdfprobe
- !!----------------------------------------------------------------
- !! *** Program cdfprobe ***
- !!
- !! Purpose : display time series of a variable at a given point
+ !!======================================================================
+ !! *** PROGRAM cdfprobe ***
+ !!=====================================================================
+ !! ** Purpose : Display time series of a variable at a given point
!!
- !! Usage : cdfprobe ncfile i j cdfvar
!!
- !! history:
- !! Original: J.M. Molines Dec. 2006
- !!----------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
+ !! History : 2.1 : 12/2006 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: narg, iargc
- INTEGER :: ilook, jlook, ilevel
- CHARACTER(LEN=256) :: cfile, cdum , cvar
+
+ INTEGER(KIND=4) :: narg, iargc ! browse line
+ INTEGER(KIND=4) :: iilook, ijlook, ilevel ! point to look at
+ CHARACTER(LEN=256) :: cf_in, cldum , cv_in ! file name variable name
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
narg=iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' USAGE: cdfprobe cdf_file i j cdfvar [level]'
- PRINT *,' Display a 2 columns output time(d) value '
- STOP
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfprobe IN-file ilook jlook cdfvar [level]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Display a 2 columns output time (in days), value.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : input file to look for'
+ PRINT *,' ilook jlook : i,j position of the probe.'
+ PRINT *,' cdfvar : name of the cdf variabled to be displayed'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [level] : This optional last argument is used'
+ PRINT *,' to specify a model level, instead of first.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' 2 columns ( time , value ) ASCII output on display'
+ PRINT *,' time are given in days since the begining of the run.'
+ STOP
ENDIF
! Browse command line
- CALL getarg(1, cfile)
- CALL getarg(2, cdum) ; READ(cdum,*) ilook
- CALL getarg(3, cdum) ; READ(cdum,*) jlook
- CALL getarg(4, cvar)
+ CALL getarg(1, cf_in )
+ CALL getarg(2, cldum ) ; READ(cldum,*) iilook
+ CALL getarg(3, cldum ) ; READ(cldum,*) ijlook
+ CALL getarg(4, cv_in )
+
+ IF ( chkfile(cf_in) ) STOP ! missing file
+
IF ( narg == 5 ) THEN
- CALL getarg(5, cdum) ; READ(cdum,*) ilevel
- CALL gettimeseries(cfile,cvar,ilook,jlook,klev=ilevel)
+ CALL getarg(5, cldum) ; READ(cldum,*) ilevel
+ CALL gettimeseries(cf_in, cv_in, iilook, ijlook, klev=ilevel)
ELSE
- CALL gettimeseries(cfile,cvar,ilook,jlook)
+ CALL gettimeseries(cf_in, cv_in, iilook, ijlook )
ENDIF
END PROGRAM cdfprobe
diff --git a/cdfprofile.f90 b/cdfprofile.f90
index 70a6da8..a6c95c7 100644
--- a/cdfprofile.f90
+++ b/cdfprofile.f90
@@ -1,122 +1,139 @@
PROGRAM cdfprofile
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfprofile ***
+ !!======================================================================
+ !! *** PROGRAM cdfprofile ***
+ !!=====================================================================
+ !! ** Purpose : extract a vertical profile from a CDFfile
!!
- !! ** Purpose: extract a verticcal profile from a CDFfile
- !!
- !! ** Method: read (i,j) position of point to extract
+ !! ** Method : read (i,j) position of point to extract
!! read varname
!! print profile
!!
- !!
- !! history :
- !! Original : J.M. Molines June 2005
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 06/2005 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: narg, iargc, istatus
- INTEGER :: jk
- INTEGER :: ilook, jlook
- INTEGER :: npiglo, npjglo, npk, nvars
- ! added to write in netcdf
- INTEGER :: kx=1, ky=1, kz ! dims of netcdf output file
- INTEGER :: jj, jvar, nboutput=1 ! number of values to write in cdf output
- INTEGER :: ncout, ierr ! for netcdf output
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
-
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, lon, lat
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: depth, profile
- ! added to write in netcdf
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dumlon, dumlat
- REAL(KIND=4), DIMENSION (1) :: tim ! time counter
- REAL(KIND=4), DIMENSION (1,1) :: dummymean
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar_input, typvar ! structure of output
-
-
- CHARACTER(LEN=256) :: cdum, cfile, cvar, cdep
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- ! added to write in netcdf
- CHARACTER(LEN=256) :: cfileoutnc='profile.nc'
-
-
- !! Read command line and output usage message if not compliant.
+
+ INTEGER(KIND=4) :: jk, jt, jvar ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc ! argument numbers
+ INTEGER(KIND=4) :: ilook, jlook ! look position
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt, nvars ! vetical, time size, number of variables
+ INTEGER(KIND=4) :: ikx=1, iky=1, ikz ! dims of netcdf output file
+ INTEGER(KIND=4) :: nboutput=1 ! number of variables to write in cdf output
+ INTEGER(KIND=4) :: ncout, ierr ! ncid and error flag for cdfio
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! vertical size and id of output variables
+
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept, rprofile ! depth and profile values
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, rlon, rlat ! 2d data array, longitude, latitude
+ REAL(KIND=4), DIMENSION(1,1) :: rdumlon, rdumlat ! dummy array for output
+ REAL(KIND=4), DIMENSION(1,1) :: rdummy ! dummy array
+
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+ CHARACTER(LEN=256) :: cf_in ! input file
+ CHARACTER(LEN=256) :: cf_out='profile.nc'
+ CHARACTER(LEN=256) :: cv_in, cv_dep ! variable name and depth name
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar_input ! structure of input data
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output data
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
- IF ( narg /= 4 ) THEN
- PRINT *,' Usage : cdfprofile I J file varname '
- PRINT *,' Output on standard output and netcdf'
+ IF ( narg /= 4 ) THEN
+ PRINT *,' usage : cdfprofile I J IN-file IN-var '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Extract a vertical profile at location I J, for a variable'
+ PRINT *,' in an input file.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' I J : I, J position of the point to extract from file.'
+ PRINT *,' IN-file : input file to work with.'
+ PRINT *,' IN-var : variable name whose profile is requested.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none '
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variable : name given as argument.'
+ PRINT *,' Profile is also written on standard output.'
STOP
ENDIF
+ CALL getarg (1, cldum ) ; READ(cldum,*) ilook
+ CALL getarg (2, cldum ) ; READ(cldum,*) jlook
+ CALL getarg (3, cf_in)
+ CALL getarg (4, cv_in)
- CALL getarg (1, cdum)
- READ(cdum,*) ilook
- CALL getarg (2, cdum)
- READ(cdum,*) jlook
- CALL getarg(3, cfile)
- CALL getarg(4, cvar)
+ IF ( chkfile(cf_in) ) STOP ! missing file
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdep)
- nvars = getnvar(cfile)
+ npiglo = getdim (cf_in, cn_x)
+ npjglo = getdim (cf_in, cn_y)
+ npk = getdim (cf_in, cn_z, cv_dep)
+ nvars = getnvar(cf_in)
+ npt = getdim (cf_in, cn_t)
! Allocate arrays
- ALLOCATE( v2d (npiglo,npjglo), depth(npk) ,profile(npk) )
- ALLOCATE ( typvar_input(nvars) ,cvarname(nvars) )
- ALLOCATE ( typvar(nboutput), ipk(nboutput), id_varout(nboutput) )
- ALLOCATE (dumlon(1,1) , dumlat(1,1) ,lon(npiglo,npjglo), lat(npiglo,npjglo))
+ ALLOCATE ( v2d (npiglo,npjglo), gdept(npk), rprofile(npk), tim(npt) )
+ ALLOCATE ( stypvar_input(nvars) ,cv_names(nvars) )
+ ALLOCATE ( stypvar(nboutput), ipk(nboutput), id_varout(nboutput) )
+ ALLOCATE ( rlon(npiglo,npjglo), rlat(npiglo,npjglo))
- lon(:,:)= getvar(cfile, 'nav_lon', 1 ,npiglo,npjglo)
- lat(:,:)= getvar(cfile, 'nav_lat', 1 ,npiglo,npjglo)
+ rlon(:,:)= getvar(cf_in, cn_vlon2d, 1, npiglo, npjglo)
+ rlat(:,:)= getvar(cf_in, cn_vlat2d, 1, npiglo, npjglo)
- dumlon(:,:)=lon(ilook,jlook)
- dumlat(:,:)=lat(ilook,jlook)
+ rdumlon(:,:) = rlon(ilook,jlook)
+ rdumlat(:,:) = rlat(ilook,jlook)
- DO jj=1,nboutput
- ipk(jj)=npk
- ENDDO
+ ipk(:) = npk
- cvarname(:)=getvarname(cfile,nvars,typvar_input)
+ cv_names(:) = getvarname(cf_in, nvars, stypvar_input)
DO jvar = 1, nvars
- IF ( cvarname(jvar) == cvar ) THEN
- typvar=typvar_input(jvar)
- ENDIF
+ IF ( cv_names(jvar) == cv_in ) THEN
+ stypvar=stypvar_input(jvar)
+ EXIT ! found cv_in
+ ENDIF
ENDDO
- depth(:) = getvar1d(cfile,cdep,npk,istatus)
- kz=npk
+ gdept(:) = getvar1d(cf_in, cv_dep, npk, ierr)
+ ikz = npk
! create output fileset
- ncout =create(cfileoutnc,'none',kx,ky,npk,cdep='depth')
- ierr= createvar(ncout,typvar,nboutput,ipk,id_varout )
- ierr= putheadervar(ncout, cfile,kx, &
- ky,kz,pnavlon=dumlon,pnavlat=dumlat,pdep=depth)
- tim=getvar1d(cfile,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- DO jk=1,npk
- v2d (:,:)= getvar(cfile, cvar, jk ,npiglo,npjglo)
- profile(jk) = v2d(ilook,jlook)
- ! netcdf output
- dummymean(1,1)=profile(jk)
- ierr = putvar(ncout, id_varout(1), dummymean, jk, kx, ky )
-
- END DO
- PRINT *, "FILE : ", TRIM(cfile)
- PRINT *, " ", TRIM(cdep)," ", TRIM(cvar),"(",ilook,",",jlook,")"
- DO jk=1, npk
- PRINT *, depth(jk), profile(jk)
+ ncout = create (cf_out, 'none', ikx, iky, npk, cdep='depth')
+ ierr = createvar (ncout, stypvar, nboutput, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_in, ikx, iky, ikz, pnavlon=rdumlon, pnavlat=rdumlat, pdep=gdept)
+
+ tim = getvar1d(cf_in, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ DO jt=1,npt
+ DO jk=1,npk
+ v2d(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt)
+ rprofile(jk) = v2d(ilook,jlook)
+ ! netcdf output
+ rdummy(1,1) = rprofile(jk)
+ ierr = putvar(ncout, id_varout(1), rdummy, jk, ikx, iky, ktime=jt)
+ END DO
+ PRINT *, 'FILE : ', TRIM(cf_in), ' TIME = ', jt
+ PRINT *, ' ', TRIM(cv_dep),' ', TRIM(cv_in),'(',ilook,',',jlook,')'
+
+ DO jk=1, npk
+ PRINT *, gdept(jk), rprofile(jk)
+ END DO
END DO
ierr = closeout(ncout)
-
END PROGRAM cdfprofile
diff --git a/cdfpsi-austral-ssh.f90 b/cdfpsi-austral-ssh.f90
deleted file mode 100644
index 0fea1fc..0000000
--- a/cdfpsi-austral-ssh.f90
+++ /dev/null
@@ -1,232 +0,0 @@
-PROGRAM cdfpsi_open
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfpsi_open ***
- !!
- !! ** Purpose : Compute Barotropic Stream Function
- !! PARTIAL STEPS
- !!
- !! ** Method : Compute the 2D fields ztrpu, ztrpv
- !! as the integral on the vertical of u, v on their
- !! respective points.
- !! Then, starting from the upper left point,
- !! initialize psi from W to E, on the northern line, using ztrpv.
- !! Then, from this first line (N to S) cumulate transport
- !! using ztrpu.
- !! This works in any case. (except perharps when northern line is a
- !! folding line ( orca config)
- !! REM: in this version PSI is not masked, which allows the exact calculation
- !! of barotropic transport just making a difference.
- !! ** Usage : cdfpsi-open fileU fileV [-mask] [-moy]
- !! when option -mask is used, output is masked (by fmask(k=1) )
- !! when option -moy is used, the result is the mean value of the meridional and
- !! and zonal based calculation.
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (May 2005 )
- !! open version J.M. Molines (March 2007 )
- !! $Rev$
- !! $Date$
- !! $Id$
- !!-------------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: ji,jj,jk, jarg !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout
- INTEGER, DIMENSION(3) :: ipk, id_varout !
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e1v, e3v , zv !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u , zu !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamf, gphif
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: sshu, sshv, ztmp
- REAL(KIND=4) ,DIMENSION(1) :: tim
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrpu, ztrpv, psi1, psi2, psissh
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrpussh, ztrpvssh
-
- CHARACTER(LEN=256) :: cfileu ,cfilev, cfileoutnc='psi.nc', cfilet
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cmask='mask.nc'
- CHARACTER(LEN=10) :: coption
-
- TYPE(variable), DIMENSION(3) :: typvar !: structure for attributes
-
- INTEGER :: istatus
- LOGICAL :: lmask=.FALSE., lmoy=.FALSE.
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfpsi_open Ufile Vfile Tfile -mask -moy'
- PRINT *,' Computes the barotropic stream function as the integral of the transport'
- PRINT *,' Option -mask : result are masked (default : no masked) '
- PRINT *,' Option -moy : results is the mean between meridional and zonal calculation'
- PRINT *,' that should be the same if all was perfect ...'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc must be in te current directory'
- PRINT *,' Output on psi.nc, variables sobarstf on f-points'
- STOP
- ENDIF
-
- CALL getarg (1, cfileu )
- CALL getarg (2, cfilev )
- CALL getarg (3, cfilet )
- IF (narg > 3 ) THEN
- DO jarg = 4, narg
- CALL getarg(jarg, coption)
- SELECT CASE ( coption )
- CASE ( '-mask' )
- lmask=.TRUE.
- CASE ( '-moy' )
- lmoy=.TRUE.
- CASE DEFAULT
- PRINT *,' Unknown option : ', TRIM(coption)
- STOP
- END SELECT
- END DO
- ENDIF
-
- npiglo= getdim (cfileu,'x')
- npjglo= getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
-
- ! define new variables for output
- typvar(1)%name= 'sobarstf'
- typvar(2)%name= 'sobarstfssh'
- typvar(3)%name= 'sobarstftotal'
- typvar(:)%units='m3/s'
- typvar(:)%missing_value=0.
- typvar(:)%valid_min= -300.e6
- typvar(:)%valid_max= 300.e6
- typvar(1)%long_name='Barotropic_Stream_Function '
- typvar(2)%long_name='Barotropic_Stream_Function SSH contribution'
- typvar(3)%long_name='Barotropic_Stream_Function total'
- typvar(1)%short_name='sobarstf '
- typvar(2)%short_name='sobarstfssh '
- typvar(3)%short_name='sobarstftotal '
- typvar(:)%online_operation='N/A'
- typvar(:)%axis='TYX'
- ipk(:) = 1 ! 2D ( X, Y , T )
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo), sshu(npiglo,npjglo), sshv(npiglo,npjglo), ztmp(npiglo,npjglo))
- ALLOCATE ( zu(npiglo,npjglo),ztrpu(npiglo,npjglo), psi1(npiglo,npjglo), psi2(npiglo,npjglo) ,psissh(npiglo,npjglo))
- ALLOCATE ( zv(npiglo,npjglo),ztrpv(npiglo,npjglo),ztrpussh(npiglo,npjglo), ztrpvssh(npiglo,npjglo))
- ALLOCATE ( glamf(npiglo,npjglo), gphif(npiglo,npjglo))
-
- glamf(:,:) = getvar(coordhgr, 'glamf',1,npiglo,npjglo)
- gphif(:,:) = getvar(coordhgr, 'gphif',1,npiglo,npjglo)
-
- ! create output fileset
- ncout =create(cfileoutnc, cfileu, npiglo,npjglo,1)
- ierr= createvar(ncout ,typvar,3, ipk,id_varout )
- ierr= putheadervar(ncout, cfileu,npiglo, npjglo,1,glamf, gphif)
- tim=getvar1d(cfileu,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
- zmask(:,:) = getvar(cmask, 'fmask', 1,npiglo,npjglo)
- ! get rid of the free-slip/no-slip condition
- WHERE ( zmask >= 2 ) zmask = 1
-
- ztrpu(:,:)= 0.d0
- ztrpv(:,:)= 0.d0
- ztmp(:,:) = getvar(cfilet, 'sossheig', 1, npiglo,npjglo)
- ! put it on sshu and sshv
- DO jj=1,npjglo
- DO ji=1,npiglo-1
- sshu(ji,jj)=0.5*(ztmp(ji+1,jj) + ztmp(ji,jj) )
- ENDDO
- ENDDO
- DO jj=1,npjglo-1
- DO ji=1,npiglo
- sshv(ji,jj)=0.5*(ztmp(ji,jj+1) + ztmp(ji,jj) )
- ENDDO
- ENDDO
-
-
- DO jk = 1,npk
- ! Get velocity at jk
- zu(:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- ! get e3 at level jk
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- ! integrates vertically
- ztrpu(:,:) = ztrpu(:,:) + zu(:,:)*e2u(:,:)*e3u(:,:) ! zonal transport of each grid cell
- ztrpv(:,:) = ztrpv(:,:) + zv(:,:)*e1v(:,:)*e3v(:,:) ! meridional transport of each grid cell
- IF ( jk == 1 ) THEN
- ztrpussh(:,:)= zu(:,:)*e2u(:,:)*sshu(:,:) ! contrib of SSH
- ztrpvssh(:,:)= zv(:,:)*e1v(:,:)*sshv(:,:) ! contrib of SSH
- ENDIF
- END DO ! loop to next level
-
- ! compute psissh
- ! compute transport along line jj=jpj
- psissh(1,npjglo-1) = ztrpvssh(1,npjglo-1)
- DO ji=2,npiglo
- psissh(ji,npjglo-1) = psissh(ji-1,npjglo-1) + ztrpvssh(ji,npjglo-1)
- END DO
- DO jj=npjglo-2,1,-1
- DO ji=1,npiglo
- psissh(ji,jj)=psissh(ji,jj+1) + ztrpussh(ji,jj+1)
- END DO
- END DO
-
- ! compute transport along line jj=jpj
- psi1(1,npjglo) = ztrpv(1,npjglo)
- DO ji=2,npiglo
- psi1(ji,npjglo) = psi1(ji-1,npjglo) + ztrpv(ji,npjglo)
- END DO
- ! set transport to 0 on Africa ( ji=1241 ; jj= 364 )
- ! Then compute from N to S the transport using zonal contribution
- psi1(:,npjglo)=psi1(:,npjglo) - psi1(1241,npjglo)
- !
- DO jj=npjglo-1,1,-1
- DO ji=1,npiglo
- psi1(ji,jj)=psi1(ji,jj+1) + ztrpu(ji,jj+1)
- END DO
- END DO
-
-
- IF ( lmoy ) THEN
- ! compute transport along line ji=jpi
- psi2(npiglo,npjglo) = psi1(npiglo,npjglo)
- DO jj=npjglo-1, 1, -1
- psi2(npiglo,jj) = psi2(npiglo,jj+1) + ztrpu(npiglo,jj+1)
- END DO
- ! Then compute from W to E the transport using meridional contribution
- DO jj=npjglo,1,-1
- DO ji=npiglo-1,1,-1
- psi2(ji,jj)=psi2(ji+1,jj) - ztrpv(ji+1,jj)
- END DO
- END DO
- psi1=0.5*(psi1 +psi2)
- END IF
-
- IF ( lmask ) psi1=psi1*zmask
- IF ( lmask ) psissh=psissh*zmask
-
- ierr = putvar(ncout, id_varout(1) ,SNGL(psi1), 1, npiglo, npjglo)
- ierr = putvar(ncout, id_varout(2) ,SNGL(psissh), 1, npiglo, npjglo)
- ierr = putvar(ncout, id_varout(3) ,SNGL(psissh+psi1), 1, npiglo, npjglo)
-! ierr = putvar(ncout, id_varout(2) ,SNGL(ztrpu), 1, npiglo, npjglo)
-! ierr = putvar(ncout, id_varout(3) ,SNGL(ztrpv), 1, npiglo, npjglo)
- istatus = closeout (ncout)
-
-END PROGRAM cdfpsi_open
diff --git a/cdfpsi-full.f90 b/cdfpsi-full.f90
deleted file mode 100644
index 3ed92db..0000000
--- a/cdfpsi-full.f90
+++ /dev/null
@@ -1,155 +0,0 @@
-PROGRAM cdfpsi_full
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfpsi_full ***
- !!
- !! ** Purpose : Compute Barotropic Stream Function
- !! FULL STEPS
- !!
- !! ** Method : Compute the 2D fields ztrpu, ztrpv
- !! as the integral on the vertical of u, v on their
- !! respective points.
- !! Then integrate from south to north : ==> psiu
- !! Then integrate from West to East : ==> psiv
- !! (should be almost the same (if no error )
- !! Then normalize the values setting psi (jpi,jpj) = 0
- !! Following Anne-Marie matlab program, we only take psiu.
- !! An alternative could be to average psiu and psiv ...
- !!
- !! history ;
- !! Original : J.M. Molines (May 2005 )
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: ji,jj,jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout
- INTEGER, DIMENSION(1) :: ipk, id_varout !
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e1v, zv !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, zu !: mask, metrics
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: e3t !: full step vertical metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamf, gphif
- REAL(KIND=4) ,DIMENSION(1) :: tim
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrpu, ztrpv, psiu, psiv
-
- CHARACTER(LEN=256) :: cfileu ,cfilev, cfileoutnc='psi.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cmask='mask.nc'
-
- TYPE (variable), DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: istatus
-
- ! constants
- REAL(KIND=4), PARAMETER :: rau0=1000., rcp=4000.
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfpsi Ufile Vfile '
- PRINT *,' Computes the barotropic stream function as the integral of the transport'
- PRINT *,' FULL STEPS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc must be in te current directory'
- PRINT *,' Output on psi.nc, variables sobarstf'
- STOP
- ENDIF
-
- CALL getarg (1, cfileu)
- CALL getarg (2, cfilev)
-
- npiglo= getdim (cfileu,'x')
- npjglo= getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
-
- ! define new variables for output ( must update att.txt)
- typvar(1)%name= 'sobarstf'
- typvar(1)%units='m3/s'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -300.e6
- typvar(1)%valid_max= 300.e6
- typvar(1)%long_name='Barotropic_Stream_Function'
- typvar(1)%short_name='sobarstf'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
-
- ipk(1) = 1 ! 2D ( X, Y , T )
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo) )
- ALLOCATE ( e2u(npiglo,npjglo))
- ALLOCATE ( e3t(npk) )
- ALLOCATE ( zu(npiglo,npjglo),ztrpu(npiglo,npjglo), psiu(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo),ztrpv(npiglo,npjglo), psiv(npiglo,npjglo))
- ALLOCATE ( glamf(npiglo,npjglo), gphif(npiglo,npjglo))
-
- glamf(:,:) = getvar(coordhgr, 'glamf',1,npiglo,npjglo)
- gphif(:,:) = getvar(coordhgr, 'gphif',1,npiglo,npjglo)
-
- ! create output fileset
- ncout =create(cfileoutnc, cfileu, npiglo,npjglo,1)
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfileu,npiglo, npjglo,1,glamf, gphif)
- tim=getvar1d(cfileu,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
- zmask(:,:) = getvar(cmask, 'fmask', 1,npiglo,npjglo)
- ! get rid of the free-slip/no-slip condition
- WHERE ( zmask >= 2 ) zmask = 1
-
- ztrpu(:,:)= 0.d0
- ztrpv(:,:)= 0.d0
- e3t(:) = getvare3(coordzgr,'e3t',npk)
-
- DO jk = 1,npk
- PRINT *,'level ',jk
- ! Get temperature and salinity at jk
- zu(:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
-
- ! integrates vertically
- ztrpu(:,:) = ztrpu(:,:) + zu(:,:)*e2u(:,:)*e3t(jk) ! zonal transport of each grid cell
- ztrpv(:,:) = ztrpv(:,:) + zv(:,:)*e1v(:,:)*e3t(jk) ! meridional transport of each grid cell
-
- END DO ! loop to next level
-
- ! integrate from the south to the north with zonal transport
- psiu(:,:) = 0.d0
-
- DO jj = 2, npjglo
- psiu(:,jj) = psiu(:,jj-1) - ztrpu(:,jj) ! psi at f point
- END DO
-
-
- ! integrate zonally form west to east
- psiv(1,:)=psiu(1,:)
-
- DO ji=2, npiglo
- psiv(ji,:) = psiv(ji-1,:) + ztrpv(ji,:) ! psi at f point
- END DO
- psiu(:,:) = (psiu(:,:) -psiu(npiglo,npjglo) ) * zmask(:,:)
- psiv(:,:) = (psiv(:,:) -psiv(npiglo,npjglo) ) * zmask(:,:)
- psiv=0.5 * (psiu+psiv)
-
- ierr = putvar(ncout, id_varout(1) ,SNGL(psiu), 1, npiglo, npjglo)
-! ierr = putvar(ncout, id_varout(2) ,SNGL(psiv), 1, npiglo, npjglo)
-
- istatus = closeout (ncout)
-
- END PROGRAM cdfpsi_full
diff --git a/cdfpsi-open-zap.f90 b/cdfpsi-open-zap.f90
deleted file mode 100644
index ca170aa..0000000
--- a/cdfpsi-open-zap.f90
+++ /dev/null
@@ -1,182 +0,0 @@
-PROGRAM cdfpsi_open
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfpsi_open ***
- !!
- !! ** Purpose : Compute Barotropic Stream Function
- !! PARTIAL STEPS
- !!
- !! ** Method : Compute the 2D fields ztrpu, ztrpv
- !! as the integral on the vertical of u, v on their
- !! respective points.
- !! Then, starting from the upper left point,
- !! initialize psi from W to E, on the northern line, using ztrpv.
- !! Then, from this first line (N to S) cumulate transport
- !! using ztrpu.
- !! This works in any case. (except perharps when northern line is a
- !! folding line ( orca config)
- !! REM: in this version PSI is not masked, which allows the exact calculation
- !! of barotropic transport just making a difference.
- !! ** Usage : cdfpsi-open fileU fileV [-mask] [-moy]
- !! when option -mask is used, output is masked (by fmask(k=1) )
- !! when option -moy is used, the result is the mean value of the meridional and
- !! and zonal based calculation.
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (May 2005 )
- !! open version J.M. Molines (March 2007 )
- !!-------------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: ji,jj,jk, jarg !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout
- INTEGER, DIMENSION(1) :: ipk, id_varout !
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e1v, e3v , zv !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u , zu !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamf, gphif
- REAL(KIND=4) ,DIMENSION(1) :: tim
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrpu, ztrpv, psi1, psi2
-
- CHARACTER(LEN=256) :: cfileu ,cfilev, cfileoutnc='psi.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cmask='mask.nc'
- CHARACTER(LEN=10) :: coption
-
- TYPE(variable), DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: istatus
- LOGICAL :: lmask=.FALSE., lmoy=.FALSE.
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfpsi_open Ufile Vfile -mask -moy'
- PRINT *,' Computes the barotropic stream function as the integral of the transport'
- PRINT *,' Option -mask : result are masked (default : no masked) '
- PRINT *,' Option -moy : results is the mean between meridional and zonal calculation'
- PRINT *,' that should be the same if all was perfect ...'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc must be in te current directory'
- PRINT *,' Output on psi.nc, variables sobarstf on f-points'
- STOP
- ENDIF
-
- CALL getarg (1, cfileu )
- CALL getarg (2, cfilev )
- IF (narg > 2 ) THEN
- DO jarg = 3, narg
- CALL getarg(jarg, coption)
- SELECT CASE ( coption )
- CASE ( '-mask' )
- lmask=.TRUE.
- CASE ( '-moy' )
- lmoy=.TRUE.
- CASE DEFAULT
- PRINT *,' Unknown option : ', TRIM(coption)
- STOP
- END SELECT
- END DO
- ENDIF
-
- npiglo= getdim (cfileu,'x')
- npjglo= getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
-
- ! define new variables for output
- typvar(1)%name= 'sobarstf'
- typvar(1)%units='m3/s'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -300.e6
- typvar(1)%valid_max= 300.e6
- typvar(1)%long_name='Barotropic_Stream_Function'
- typvar(1)%short_name='sobarstf'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
- ipk(1) = 1 ! 2D ( X, Y , T )
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo))
- ALLOCATE ( zu(npiglo,npjglo),ztrpu(npiglo,npjglo), psi1(npiglo,npjglo), psi2(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo),ztrpv(npiglo,npjglo))
- ALLOCATE ( glamf(npiglo,npjglo), gphif(npiglo,npjglo))
-
- glamf(:,:) = getvar(coordhgr, 'glamf',1,npiglo,npjglo)
- gphif(:,:) = getvar(coordhgr, 'gphif',1,npiglo,npjglo)
-
- ! create output fileset
- ncout =create(cfileoutnc, cfileu, npiglo,npjglo,1)
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfileu,npiglo, npjglo,1,glamf, gphif)
- tim=getvar1d(cfileu,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
- zmask(:,:) = getvar(cmask, 'fmask', 1,npiglo,npjglo)
- ! get rid of the free-slip/no-slip condition
- WHERE ( zmask >= 2 ) zmask = 1
-
- ztrpu(:,:)= 0.d0
- ztrpv(:,:)= 0.d0
- DO jk = 1,npk
- ! Get velocity at jk
- zu(:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- ! get e3 at level jk
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- ! integrates vertically
- ztrpu(:,:) = ztrpu(:,:) + zu(:,:)*e2u(:,:)*e3u(:,:) ! zonal transport of each grid cell
- ztrpv(:,:) = ztrpv(:,:) + zv(:,:)*e1v(:,:)*e3v(:,:) ! meridional transport of each grid cell
- END DO ! loop to next level
-
- ! compute transport along line jj=jpj
- psi1(1,npjglo-1) = ztrpv(1,npjglo-1)
- DO ji=2,npiglo
- psi1(ji,npjglo-1) = psi1(ji-1,npjglo-1) + ztrpv(ji,npjglo-1)
- END DO
- ! Then compute from N to S the transport using zonal contribution
- DO jj=npjglo-2,1,-1
- DO ji=1,npiglo
- psi1(ji,jj)=psi1(ji,jj+1) + ztrpu(ji,jj+1)
- END DO
- END DO
-
-
- IF ( lmoy ) THEN
- ! compute transport along line ji=jpi
- psi2(npiglo,npjglo) = psi1(npiglo,npjglo)
- DO jj=npjglo-1, 1, -1
- psi2(npiglo,jj) = psi2(npiglo,jj+1) + ztrpu(npiglo,jj+1)
- END DO
- ! Then compute from W to E the transport using meridional contribution
- DO jj=npjglo,1,-1
- DO ji=npiglo-1,1,-1
- psi2(ji,jj)=psi2(ji+1,jj) - ztrpv(ji+1,jj)
- END DO
- END DO
- psi1=0.5*(psi1 +psi2)
- END IF
-
- IF ( lmask ) psi1=psi1*zmask
-
- ierr = putvar(ncout, id_varout(1) ,SNGL(psi1), 1, npiglo, npjglo)
- istatus = closeout (ncout)
-
-END PROGRAM cdfpsi_open
diff --git a/cdfpsi-open.f90 b/cdfpsi-open.f90
deleted file mode 100644
index 99bc2a0..0000000
--- a/cdfpsi-open.f90
+++ /dev/null
@@ -1,197 +0,0 @@
-PROGRAM cdfpsi_open
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfpsi_open ***
- !!
- !! ** Purpose : Compute Barotropic Stream Function
- !! PARTIAL STEPS
- !!
- !! ** Method : Compute the 2D fields ztrpu, ztrpv
- !! as the integral on the vertical of u, v on their
- !! respective points.
- !! Then, starting from the upper left point,
- !! initialize psi from W to E, on the northern line, using ztrpv.
- !! Then, from this first line (N to S) cumulate transport
- !! using ztrpu.
- !! This works in any case. (except perharps when northern line is a
- !! folding line ( orca config)
- !! REM: in this version PSI is not masked, which allows the exact calculation
- !! of barotropic transport just making a difference.
- !! ** Usage : cdfpsi-open fileU fileV [-mask] [-moy]
- !! when option -mask is used, output is masked (by fmask(k=1) )
- !! when option -moy is used, the result is the mean value of the meridional and
- !! and zonal based calculation.
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (May 2005 )
- !! open version J.M. Molines (March 2007 )
- !! $Rev$
- !! $Date$
- !! $Id$
- !!-------------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: ji,jj,jk, jarg !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc, iarg !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout
- INTEGER, DIMENSION(1) :: ipk, id_varout !
- INTEGER :: iref=-1, jref=-1
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e1v, e3v , zv !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u , zu !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamf, gphif
- REAL(KIND=4) ,DIMENSION(1) :: tim
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrpu, ztrpv, psi1, psi2
- REAL(KIND=8) :: offset
-
- CHARACTER(LEN=256) :: cfileu ,cfilev, cfileoutnc='psi.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cmask='mask.nc'
- CHARACTER(LEN=10) :: coption
-
- TYPE(variable), DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: istatus
- LOGICAL :: lmask=.FALSE., lmoy=.FALSE.
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfpsi_open Ufile Vfile [-ref iref jref -mask -moy ]'
- PRINT *,' Computes the barotropic stream function as the integral of the transport'
- PRINT *,' Option -mask : result are masked (default : no masked) '
- PRINT *,' Option -moy : results is the mean between meridional and zonal calculation'
- PRINT *,' that should be the same if all was perfect ...'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc must be in te current directory'
- PRINT *,' Output on psi.nc, variables sobarstf on f-points'
- STOP
- ENDIF
-
- CALL getarg (1, cfileu )
- CALL getarg (2, cfilev )
- IF (narg > 2 ) THEN
- iarg=3
- DO WHILE ( iarg <= narg )
- CALL getarg(iarg, coption)
- SELECT CASE ( coption )
- CASE ( '-mask' )
- lmask=.TRUE.
- CASE ( '-moy' )
- lmoy=.TRUE.
- CASE ( '-ref' )
- CALL getarg(iarg+1,coption) ; READ(coption,*) iref
- CALL getarg(iarg+2,coption) ; READ(coption,*)jref ; iarg=iarg+2
- CASE DEFAULT
- PRINT *,' Unknown option : ', TRIM(coption)
- STOP
- END SELECT
- iarg=iarg+1
- END DO
- ENDIF
-
- npiglo= getdim (cfileu,'x')
- npjglo= getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
- IF ( iref == -1 ) iref=npiglo
- IF ( jref == -1 ) jref=npjglo
-
- ! define new variables for output
- typvar(1)%name= 'sobarstf'
- typvar(1)%units='m3/s'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -300.e6
- typvar(1)%valid_max= 300.e6
- typvar(1)%long_name='Barotropic_Stream_Function'
- typvar(1)%short_name='sobarstf'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
- ipk(1) = 1 ! 2D ( X, Y , T )
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo))
- ALLOCATE ( zu(npiglo,npjglo),ztrpu(npiglo,npjglo), psi1(npiglo,npjglo), psi2(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo),ztrpv(npiglo,npjglo))
- ALLOCATE ( glamf(npiglo,npjglo), gphif(npiglo,npjglo))
-
- glamf(:,:) = getvar(coordhgr, 'glamf',1,npiglo,npjglo)
- gphif(:,:) = getvar(coordhgr, 'gphif',1,npiglo,npjglo)
-
- ! create output fileset
- ncout =create(cfileoutnc, cfileu, npiglo,npjglo,1)
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfileu,npiglo, npjglo,1,glamf, gphif)
- tim=getvar1d(cfileu,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
- zmask(:,:) = getvar(cmask, 'fmask', 1,npiglo,npjglo)
- ! get rid of the free-slip/no-slip condition
- WHERE ( zmask >= 2 ) zmask = 1
-
- ztrpu(:,:)= 0.d0
- ztrpv(:,:)= 0.d0
- DO jk = 1,npk
- ! Get velocity at jk
- zu(:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- ! get e3 at level jk
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- ! integrates vertically
- ztrpu(:,:) = ztrpu(:,:) + zu(:,:)*e2u(:,:)*e3u(:,:) ! zonal transport of each grid cell
- ztrpv(:,:) = ztrpv(:,:) + zv(:,:)*e1v(:,:)*e3v(:,:) ! meridional transport of each grid cell
- END DO ! loop to next level
-
- ! compute transport along line jj=jpj
- psi1(1,npjglo-2) = ztrpv(1,npjglo-2)
- DO ji=2,npiglo
- psi1(ji,npjglo-2) = psi1(ji-1,npjglo-2) + ztrpv(ji,npjglo-2)
- END DO
- ! Then compute from N to S the transport using zonal contribution
- DO jj=npjglo-3,1,-1
- DO ji=1,npiglo
- psi1(ji,jj)=psi1(ji,jj+1) + ztrpu(ji,jj+1)
- END DO
- END DO
-
-
- IF ( lmoy ) THEN
- ! compute transport along line ji=jpi
- psi2(npiglo,npjglo) = psi1(npiglo,npjglo)
- DO jj=npjglo-1, 1, -1
- psi2(npiglo,jj) = psi2(npiglo,jj+1) + ztrpu(npiglo,jj+1)
- END DO
- ! Then compute from W to E the transport using meridional contribution
- DO jj=npjglo,1,-1
- DO ji=npiglo-1,1,-1
- psi2(ji,jj)=psi2(ji+1,jj) - ztrpv(ji+1,jj)
- END DO
- END DO
- psi1=0.5*(psi1 +psi2)
- END IF
- ! substract offset to psi. If -ref option not used, offset is the upper right value
- offset = psi1(iref,jref)
- psi1(:,:) = psi1(:,:) - offset
-
- IF ( lmask ) psi1=psi1*zmask
-
- ierr = putvar(ncout, id_varout(1) ,SNGL(psi1), 1, npiglo, npjglo)
- istatus = closeout (ncout)
-
-END PROGRAM cdfpsi_open
diff --git a/cdfpsi-open_AM.f90 b/cdfpsi-open_AM.f90
deleted file mode 100644
index 9bb0bbf..0000000
--- a/cdfpsi-open_AM.f90
+++ /dev/null
@@ -1,151 +0,0 @@
-PROGRAM cdfpsi_open
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfpsi_open_AM ***
- !!
- !! ** Purpose : Compute Barotropic Stream Function
- !! PARTIAL STEPS
- !!
- !! ** Method : Compute the 2D fields ztrpu, ztrpv
- !! as the integral on the vertical of u, v on their
- !! respective points.
- !! Then, starting from the lower left point,
- !! initialize psi from W to E, on the southern line, using ztrpv.
- !! Then, from this first line (S to N) cumulate transport
- !! using ztrpu.
- !! This works in any case. (except perharps when northern line is a
- !! folding line ( orca config)
- !! REM: in this version PSI is not masked by default, which allows the exact calculation
- !! of barotropic transport just making a difference. If the M option is specified
- !! as 3rd argument, then the result is masked.
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (May 2005 )
- !! modified by A. Melet (03/2007) to have South West corner in reference
- !! (land point)
- !!-------------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: ji,jj,jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout
- INTEGER, DIMENSION(1) :: ipk, id_varout !
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e1v, e3v , zv !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u , zu !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamf, gphif
- REAL(KIND=4) ,DIMENSION(1) :: tim
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrpu, ztrpv, psi
-
- CHARACTER(LEN=256) :: cfileu ,cfilev, cfileoutnc='psi.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cmask='mask.nc'
- CHARACTER(LEN=1) :: coption
-
- TYPE(variable), DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: istatus
- LOGICAL :: lmask=.FALSE.
-
- ! constants
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfpsi_open Ufile Vfile [M]'
- PRINT *,' Computes the barotropic stream function as the integral of the transport'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' If M option is specified, result is masked '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc must be in te current directory'
- PRINT *,' Output on psi.nc, variables sobarstf on f-points'
- STOP
- ENDIF
-
- CALL getarg (1, cfileu )
- CALL getarg (2, cfilev )
- IF ( narg == 3 ) lmask=.TRUE.
-
-
- npiglo= getdim (cfileu,'x')
- npjglo= getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
-
- ! define new variables for output
- typvar(1)%name= 'sobarstf'
- typvar(1)%units='m3/s'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -300.e6
- typvar(1)%valid_max= 300.e6
- typvar(1)%long_name='Barotropic_Stream_Function'
- typvar(1)%short_name='sobarstf'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
- ipk(1) = 1 ! 2D ( X, Y , T )
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo))
- ALLOCATE ( zu(npiglo,npjglo),ztrpu(npiglo,npjglo), psi(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo),ztrpv(npiglo,npjglo))
- ALLOCATE ( glamf(npiglo,npjglo), gphif(npiglo,npjglo))
-
- glamf(:,:) = getvar(coordhgr, 'glamf',1,npiglo,npjglo)
- gphif(:,:) = getvar(coordhgr, 'gphif',1,npiglo,npjglo)
-
- ! create output fileset
- ncout =create(cfileoutnc, cfileu, npiglo,npjglo,1)
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfileu,npiglo, npjglo,1,glamf, gphif)
- tim=getvar1d(cfileu,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
- zmask(:,:) = getvar(cmask, 'fmask', 1,npiglo,npjglo)
- ! get rid of the free-slip/no-slip condition
- WHERE ( zmask >= 2 ) zmask = 1
-
- ztrpu(:,:)= 0.d0
- ztrpv(:,:)= 0.d0
- DO jk = 1,npk
- ! Get velocity at jk
- zu(:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- ! get e3 at level jk
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- ! integrates vertically
- ztrpu(:,:) = ztrpu(:,:) + zu(:,:)*e2u(:,:)*e3u(:,:) ! zonal transport of each grid cell
- ztrpv(:,:) = ztrpv(:,:) + zv(:,:)*e1v(:,:)*e3v(:,:) ! meridional transport of each grid cell
- END DO ! loop to next level
-
- ! compute transport along line jj=2
- psi=0.d0
- psi(1,2) = 0.d0
- DO ji=2,npiglo
- psi(ji,2) = psi(ji-1,2) + ztrpv(ji,2)
- END DO
- ! Then compute from S to N the transport using zonal contribution
- DO ji=1,npiglo
- DO jj=3,npjglo
- psi(ji,jj)=psi(ji,jj-1) - ztrpu(ji,jj)
- END DO
- END DO
- IF ( lmask ) psi=psi*zmask
-
- ierr = putvar(ncout, id_varout(1) ,SNGL(psi), 1, npiglo, npjglo)
-
- istatus = closeout (ncout)
-
-END PROGRAM cdfpsi_open
diff --git a/cdfpsi.f90 b/cdfpsi.f90
index 652c656..a634def 100644
--- a/cdfpsi.f90
+++ b/cdfpsi.f90
@@ -1,158 +1,417 @@
PROGRAM cdfpsi
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfpsi ***
+ !!======================================================================
+ !! *** PROGRAM cdfpsi ***
+ !!=====================================================================
+ !! ** Purpose : Compute Barotropic Stream Function
!!
- !! ** Purpose : Compute Barotropic Stream Function
- !! PARTIAL STEPS
- !!
- !! ** Method : Compute the 2D fields ztrpu, ztrpv
- !! as the integral on the vertical of u, v on their
- !! respective points.
- !! Then integrate from south to north : ==> psiu
- !! Then integrate from West to East : ==> psiv
+ !! ** Method : Compute the 2D fields dtrpu, dtrpv as the integral on
+ !! the vertical of u, v on their respective points.
+ !! Then integrate from south to north : ==> dpsiu
+ !! Then integrate from West to East : ==> dpsiv
!! (should be almost the same (if no error ))
- !! Default (appropriate for global model): output psiu;
- !! normalizes the values setting psi (jpi,jpj) = 0
- !! If option "V" is given as last argument, output psiv,
- !! normalizes values setting psi(jpi,1) = 0.
- !! This is appropriate for North Atlantic
+ !! Default (appropriate for global model): output dpsiu;
+ !! normalizes the values setting psi (jpi,jpj) = 0
+ !! If option "V" is given as last argument, output dpsiv,
+ !! normalizes values setting psi(jpi,1) = 0.
+ !! This is appropriate for North Atlantic
!!
- !! history ;
- !! Original : J.M. Molines (May 2005 )
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 05/2005 : J.M. Molines : Original code
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ USE modutils
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout
- INTEGER, DIMENSION(1) :: ipk, id_varout !
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e1v, e3v , zv !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u , zu !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamf, gphif
- REAL(KIND=4) ,DIMENSION(1) :: tim
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: iiref, ijref ! reference i j point
+ INTEGER(KIND=4) :: nvout=1 ! number of output variables
+ INTEGER(KIND=4), DIMENSION(:),ALLOCATABLE :: ipk, id_varout ! levels and id's of output vars
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrpu, ztrpv, psiu, psiv
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e3v ! v metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2u, e3u ! u metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, zv ! velocity components
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamf, gphif ! longitude/latitude
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsshu, zsshv ! ssh at u and v point
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zssh ! temporary array for ssh
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! 1d vertical metrics, full step case
- CHARACTER(LEN=256) :: cfileu ,cfilev, cfileoutnc='psi.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cmask='mask.nc'
- CHARACTER(LEN=1) :: coption
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtrpu, dtrpv ! transport working arrays
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtrpsshu ! transport working arrays
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtrpsshv ! transport working arrays
+ REAL(KIND=8), TARGET, DIMENSION(:,:), ALLOCATABLE :: dpsiu ! BSF ( U computation
+ REAL(KIND=8), TARGET, DIMENSION(:,:), ALLOCATABLE :: dpsiv ! BSF (V computation )
+ REAL(KIND=8), TARGET, DIMENSION(:,:), ALLOCATABLE :: dpsisshu ! BSF ( SSHU computation
+ REAL(KIND=8), TARGET, DIMENSION(:,:), ALLOCATABLE :: dpsisshv ! BSF ( SSHV computation )
+ REAL(KIND=8), POINTER, DIMENSION(:,:) :: dpsi ! point to dpsiu or dpsiv
+ REAL(KIND=8), POINTER, DIMENSION(:,:) :: dpsissh ! point to dpsisshu or dpsisshv
- TYPE(variable), DIMENSION(1) :: typvar !: structure for attributes
+ CHARACTER(LEN=256) :: cf_ufil ! gridU netcdf file name
+ CHARACTER(LEN=256) :: cf_vfil ! gridV netcdf file name
+ CHARACTER(LEN=256) :: cf_tfil ! gridT netcdf file name (-ssh option)
+ CHARACTER(LEN=256) :: cf_out='psi.nc' ! output file name
+ CHARACTER(LEN=256) :: cv_out='sobarstf' ! output variable name
+ CHARACTER(LEN=256) :: cv_outssh='sobarstfssh' ! output variable name
+ CHARACTER(LEN=256) :: cv_outotal='sobarstftotal' ! output variable name
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+ CHARACTER(LEN=256) :: cglobal ! global attribute
- INTEGER :: istatus
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for attributes
- ! constants
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ LOGICAL :: ll_u = .TRUE. ! flag for U integration
+ LOGICAL :: ll_v = .FALSE. ! flag for V integration
+ LOGICAL :: lfull = .FALSE. ! flag for full step config
+ LOGICAL :: lmask = .FALSE. ! flag for masking output
+ LOGICAL :: lmean = .FALSE. ! flag for mean U,V calculation
+ LOGICAL :: lopen = .FALSE. ! flag for open calculation
+ LOGICAL :: lssh = .FALSE. ! flag for ssh computation
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line and output usage message if not compliant.
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfpsi Ufile Vfile <V> (optional argument)'
- PRINT *,' Computes the barotropic stream function as the integral of the transport'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc must be in te current directory'
- PRINT *,' Output on psi.nc, variables sobarstf on f-points'
- PRINT *,' Default works well for a global ORCA grid. use V 3rdargument for North Atlantic'
+ PRINT *,' usage : cdfpsi U-file V-file [V] [-full ] [-mask ] [-mean] ...'
+ PRINT *,' ... [-ssh T-file ] [-open ] [-ref iref jref ]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes the barotropic stream function (a proxy ) as the integral of '
+ PRINT *,' the transport.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' U-file : netcdf file of zonal velocity.'
+ PRINT *,' V-file : netcdf file of meridional velocity.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [V] : use V field instead of U field for integration.'
+ PRINT *,' [ -full ] : indicates a full step case. Default is partial steps.'
+ PRINT *,' [ -mask ] : mask output fields. Note that the land value is significant.'
+ PRINT *,' It correspond to the potential on this continent.'
+ PRINT *,' [ -mean ] : save the average of the computations done with U and V.'
+ PRINT *,' [ -ssh T-file ] : compute the transport in the ''ssh'' layer, using '
+ PRINT *,' surface velocities. Take the ssh from T-file specified in '
+ PRINT *,' this option. This is a experimental option, not certified ...'
+ PRINT *,' [ -open ] : for open domain configuration. See also -ref to set '
+ PRINT *,' reference point.'
+ PRINT *,' [ -ref iref jref ] : Set the reference point in i,j coordinates.'
+ PRINT *,' BSF at reference point is arbitrarly set to zero.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fhgr),' and ', TRIM(cn_fzgr),'.'
+ PRINT *,' ', TRIM(cn_fmsk),' is required only if -mask option used.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_out),' (m3/s )'
+ PRINT *,' If option -ssh is used, 2 additional variables are added to the file :'
+ PRINT *,' ', TRIM(cv_outssh),' (m3/s ) : contribution of SSH'
+ PRINT *,' ', TRIM(cv_outotal),' (m3/s ) : total BSF'
+ PRINT *,' '
STOP
ENDIF
- CALL getarg (1, cfileu )
- CALL getarg (2, cfilev )
- CALL getarg (3, coption )
-
- npiglo= getdim (cfileu,'x')
- npjglo= getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
-
- ! define new variables for output ( must update att.txt)
- typvar(1)%name= 'sobarstf'
- typvar(1)%units='m3/s'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -300.e6
- typvar(1)%valid_max= 300.e6
- typvar(1)%long_name='Barotropic_Stream_Function'
- typvar(1)%short_name='sobarstf'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
- ipk(1) = 1 ! 2D ( X, Y , T )
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- IF ( coption == 'V') PRINT *, ' Use psiv (ex. North Atlantic case)'
+ CALL SetGlobalAtt (cglobal)
+ iiref = -1 ; ijref= -1
+
+ ijarg = 1 ; ireq = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg( ijarg, cldum ) ; ijarg=ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ('-full') ; lfull = .TRUE.
+ CASE ('-mask') ; lmask = .TRUE.
+ CASE ('-mean') ; lmean = .TRUE. ; ll_v=.TRUE. ; ll_u=.TRUE.
+ CASE ('-ssh' ) ; lssh = .TRUE. ; nvout=3
+ CALL getarg( ijarg, cf_tfil ) ; ijarg=ijarg + 1
+ CASE ('-open') ; lopen = .TRUE. ; ll_v=.TRUE. ; ll_u=.TRUE.
+ CASE ('-ref')
+ CALL getarg( ijarg, cldum ) ; ijarg=ijarg + 1 ; READ(cldum,*) iiref
+ CALL getarg( ijarg, cldum ) ; ijarg=ijarg + 1 ; READ(cldum,*) ijref
+
+ CASE DEFAULT
+ ireq = ireq + 1
+ SELECT CASE ( ireq)
+ CASE ( 1 ) ; cf_ufil = cldum
+ CASE ( 2 ) ; cf_vfil = cldum
+ CASE ( 3 ) ; ll_v = .TRUE. ; ll_u = .FALSE.
+ CASE DEFAULT
+ PRINT *, ' Too many arguments !' ; STOP
+ END SELECT
+ END SELECT
+ ENDDO
+
+ lchk = lchk .OR. chkfile( cn_fhgr )
+ lchk = lchk .OR. chkfile( cn_fzgr )
+ IF ( lmask) lchk = lchk .OR. chkfile( cn_fmsk )
+ IF ( lssh ) lchk = lchk .OR. chkfile( cf_tfil )
+ lchk = lchk .OR. chkfile( cf_ufil )
+ lchk = lchk .OR. chkfile( cf_vfil )
+
+ IF ( lchk ) STOP ! missing file
+
+ npiglo = getdim (cf_ufil, cn_x)
+ npjglo = getdim (cf_ufil, cn_y)
+ npk = getdim (cf_ufil, cn_z)
+ npt = getdim (cf_ufil, cn_t)
+
+ IF ( iiref == -1 .OR. ijref == -1 ) THEN
+ iiref=npiglo
+ ijref=npjglo
+ ENDIF
+
+ ALLOCATE (stypvar(nvout), ipk(nvout), id_varout(nvout))
+ ! define new variables for output ( must update att.txt)
+ ipk(:) = 1 ! 2D ( X, Y , T )
+ stypvar(:)%cunits = 'm3/s'
+ stypvar(:)%valid_min = -300.e6
+ stypvar(:)%valid_max = 300.e6
+ stypvar(:)%conline_operation = 'N/A'
+ stypvar(:)%caxis = 'TYX'
+
+ stypvar(1)%cname = cv_out
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%clong_name = 'Barotropic_Stream_Function'
+ stypvar(1)%cshort_name = cv_out
+
+ IF ( lssh ) THEN
+ stypvar(2)%cname = cv_outssh
+ stypvar(2)%rmissing_value = 0.
+ stypvar(2)%clong_name = 'Barotropic_Stream_Function SSH contribution'
+ stypvar(2)%cshort_name = cv_outssh
+
+ stypvar(3)%cname = cv_outotal
+ stypvar(3)%rmissing_value = 0.
+ stypvar(3)%clong_name = 'Barotropic_Stream_Function SSH total'
+ stypvar(3)%cshort_name = cv_outotal
+ ENDIF
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+ PRINT *, ' Option is use :'
+ PRINT *, ' -full :', lfull
+ PRINT *, ' -mask :', lmask
+ PRINT *, ' -mean :', lmean
+ PRINT *, ' -ssh :', lssh
+ PRINT *, ' -open :', lopen
+ PRINT *, ' -ref :', iiref, ijref
+ PRINT *, ' U-comp :', ll_u
+ PRINT *, ' V-comp :', ll_v
! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
+ ALLOCATE ( zmask(npiglo,npjglo) )
ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo))
- ALLOCATE ( zu(npiglo,npjglo),ztrpu(npiglo,npjglo), psiu(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo),ztrpv(npiglo,npjglo), psiv(npiglo,npjglo))
+ ALLOCATE ( zu(npiglo,npjglo),dtrpu(npiglo,npjglo), dpsiu(npiglo,npjglo) )
+ ALLOCATE ( zv(npiglo,npjglo),dtrpv(npiglo,npjglo), dpsiv(npiglo,npjglo) )
ALLOCATE ( glamf(npiglo,npjglo), gphif(npiglo,npjglo))
+ ALLOCATE ( tim(npt))
+ IF ( lfull ) ALLOCATE ( e31d(npk))
+ IF ( lssh ) ALLOCATE ( zssh(npiglo,npjglo), zsshu(npiglo,npjglo), zsshv(npiglo,npjglo))
+ IF ( lssh ) ALLOCATE ( dpsisshu(npiglo,npjglo), dpsisshv(npiglo,npjglo) )
+ IF ( lssh ) ALLOCATE ( dtrpsshu(npiglo,npjglo), dtrpsshv(npiglo,npjglo) )
- glamf(:,:) = getvar(coordhgr, 'glamf',1,npiglo,npjglo)
- gphif(:,:) = getvar(coordhgr, 'gphif',1,npiglo,npjglo)
+ glamf(:,:) = getvar(cn_fhgr, cn_glamf, 1, npiglo, npjglo)
+ gphif(:,:) = getvar(cn_fhgr, cn_gphif, 1, npiglo, npjglo)
! create output fileset
- ncout =create(cfileoutnc, cfileu, npiglo,npjglo,1)
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfileu,npiglo, npjglo,1,glamf, gphif)
- tim=getvar1d(cfileu,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
+ ncout = create (cf_out, cf_ufil, npiglo, npjglo, 1 )
+ ierr = createvar (ncout, stypvar, nvout, ipk, id_varout, cdglobal=TRIM(cglobal) )
+ ierr = putheadervar(ncout, cf_ufil, npiglo, npjglo, 1, glamf, gphif)
+
+ tim = getvar1d(cf_ufil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo)
+ e2u(:,:) = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo)
+ IF ( lmask) THEN
+ zmask(:,:) = getvar(cn_fmsk, 'fmask', 1, npiglo, npjglo)
+ WHERE ( zmask >= 2 ) zmask = 1
+ ENDIF
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
- zmask(:,:) = getvar(cmask, 'fmask', 1,npiglo,npjglo)
+ IF ( lfull) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk )
! get rid of the free-slip/no-slip condition
- WHERE ( zmask >= 2 ) zmask = 1
-
- ztrpu(:,:)= 0.d0
- ztrpv(:,:)= 0.d0
- DO jk = 1,npk
- PRINT *,'level ',jk
- IF ( coption == 'V' ) THEN
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- ztrpv(:,:) = ztrpv(:,:) + zv(:,:)*e1v(:,:)*e3v(:,:) ! meridional transport of each grid cell
+
+ DO jt = 1, npt
+ dtrpu(:,:)= 0.d0
+ dtrpv(:,:)= 0.d0
+ dpsiu(:,:)= 0.d0
+ dpsiv(:,:)= 0.d0
+ IF ( lssh ) THEN
+ zsshu(:,:) = 0.0
+ zsshv(:,:) = 0.0
+ dpsisshu(:,:) = 0.d0
+ dpsisshv(:,:) = 0.d0
+ dtrpsshu(:,:) = 0.d0
+ dtrpsshv(:,:) = 0.d0
+ zssh(:,:) = getvar(cf_tfil, cn_sossheig, 1, npiglo, npjglo, ktime=jt)
+ zsshu(1:npiglo-1, : ) = 0.5*( zssh(2:npiglo,: ) + zssh(1:npiglo-1,: ))
+ zsshv( : ,1:npjglo-1) = 0.5*( zssh(: ,2:npjglo) + zssh(: ,1:npjglo-1))
+ ENDIF
+
+
+ DO jk = 1,npk
+ IF ( ll_v ) THEN
+ zv(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt )
+ IF ( lfull ) THEN ; e3v(:,:) = e31d(jk)
+ ELSE ; e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+ dtrpv(:,:) = dtrpv(:,:) + zv(:,:)*e1v(:,:)*e3v(:,:)*1.d0 ! meridional transport of each grid cell
+ IF ( lssh .AND. (jk == 1 ) ) THEN
+ dtrpsshv(:,:) = dtrpsshv(:,:) + zv(:,:)*e1v(:,:)*zsshv(:,:)*1.d0 ! meridional transport of each grid cell
+ ENDIF
+ ENDIF
+
+ IF ( ll_u) THEN
+ zu(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jt )
+ IF ( lfull ) THEN ; e3u(:,:) = e31d(jk)
+ ELSE ; e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+ dtrpu(:,:) = dtrpu(:,:) + zu(:,:)*e2u(:,:)*e3u(:,:)*1.d0 ! zonal transport of each grid cell
+ IF ( lssh .AND. (jk == 1 ) ) THEN
+ dtrpsshu(:,:) = dtrpsshu(:,:) + zv(:,:)*e2u(:,:)*zsshu(:,:)*1.d0 ! meridional transport of each grid cell
+ ENDIF
+ ENDIF
+ END DO ! loop to next level
+
+ IF ( lopen ) THEN
+ ! This case corresponds to arbitrary configuration: we chose to compute the transport
+ ! across a first line ( eg, ji= 2 or jj= npjglo-1 ), assuming that this starting line is
+ ! in the true ocean. If it is on true land, it is not a problem. But it cannot be on
+ ! arbitrary masked points....
+ IF ( lssh ) THEN
+ dpsisshu(1,npjglo-2) = dtrpsshv(1, npjglo-2)
+ DO ji = 2, npiglo
+ dpsisshu(ji,npjglo-2) = dpsisshu(ji-1,npjglo-2) + dtrpsshv(ji,npjglo-2)
+ END DO
+ ! Then compute the transport with along U starting from this line
+ DO jj= npjglo-3,1,-1
+ DO ji = 1, npiglo
+ dpsisshu(ji,jj) = dpsisshu(ji,jj+1) + dtrpsshu(ji,jj+1)
+ END DO
+ END DO
+ ENDIF
+
+ dpsiu(1,npjglo-2) = dtrpv(1, npjglo-2)
+ DO ji = 2, npiglo
+ dpsiu(ji,npjglo-2) = dpsiu(ji-1,npjglo-2) + dtrpv(ji,npjglo-2)
+ END DO
+ ! Then compute the transport with along U starting from this line
+ DO jj= npjglo-3,1,-1
+ DO ji = 1, npiglo
+ dpsiu(ji,jj) = dpsiu(ji,jj+1) + dtrpu(ji,jj+1)
+ END DO
+ END DO
+
+ IF ( lmean ) THEN ! we need also the other estimate
+ dpsiv(npiglo-2, npjglo) = dtrpu(npiglo-2, npjglo)
+ DO jj= npjglo - 1, 1, -1
+ dpsiv(npiglo-2,jj) = dpsiv(npiglo-2, jj+1) + dtrpu(npiglo-2, jj+1)
+ END DO
+ DO jj=npjglo,1,-1
+ DO ji = npiglo -3,1,-1
+ dpsiv(ji,jj) = dpsiv(ji+1,jj) - dtrpv(ji+1,jj)
+ END DO
+ END DO
+ dpsiu(:,:) = 0.5*(dpsiu(:,:) + dpsiv(:,:))
+
+ IF ( lssh ) THEN
+ dpsisshv(npiglo-2, npjglo) = dtrpsshu(npiglo-2, npjglo)
+ DO jj= npjglo - 1, 1, -1
+ dpsisshv(npiglo-2,jj) = dpsisshv(npiglo-2, jj+1) + dtrpsshu(npiglo-2, jj+1)
+ END DO
+ DO jj=npjglo,1,-1
+ DO ji = npiglo -3,1,-1
+ dpsisshv(ji,jj) = dpsisshv(ji+1,jj) - dtrpsshv(ji+1,jj)
+ END DO
+ END DO
+ dpsisshu(:,:) = 0.5*(dpsisshu(:,:) + dpsisshv(:,:))
+ ENDIF
+ ENDIF
+
+ dpsi => dpsiu
+ IF ( lssh ) dpsissh => dpsisshu
+
+ ELSE
+ ! now perform zonal integration if requested
+ IF ( ll_v ) THEN
+ ! integrate zonally from east to west
+ ! This comfortable with NATL configurations as the eastern most points are land points.
+ dpsiv(npiglo,:)= 0.d0
+ DO ji=npiglo-1,1,-1
+ dpsiv(ji,:) = dpsiv(ji+1,:) - dtrpv(ji,:) ! psi at f point
+ END DO
+ dpsi => dpsiv
+ IF ( lssh ) THEN
+ dpsisshv(npiglo,:)= 0.d0
+ DO ji=npiglo-1,1,-1
+ dpsisshv(ji,:) = dpsisshv(ji+1,:) - dtrpsshv(ji,:) ! psissh at f point
+ END DO
+ dpsissh => dpsisshv
+ ENDIF
+ ENDIF
+
+ ! now perform meridional integration if requested
+ IF ( ll_u ) THEN
+ ! integrate from the south to the north with zonal transport
+ ! This is because on global configuration, line jj=1 is always land (Antarctic)
+ dpsiu(:,:) = 0.d0
+ DO jj = 2, npjglo
+ dpsiu(:,jj) = dpsiu(:,jj-1) - dtrpu(:,jj) ! psi at f point
+ END DO
+ dpsi => dpsiu
+ IF ( lssh ) THEN
+ dpsisshu(:,:) = 0.d0
+ DO jj = 2, npjglo
+ dpsisshu(:,jj) = dpsisshu(:,jj-1) - dtrpsshu(:,jj) ! psissh at f point
+ END DO
+ dpsissh => dpsisshu
+ ENDIF
+ ENDIF
+
+ IF ( lmean) THEN
+ dpsiu(:,:) = 0.5 * ( dpsiu(:,:) + dpsiv(:,:) )
+ dpsi => dpsiu
+ IF ( lssh ) THEN
+ dpsisshu(:,:) = 0.5 * ( dpsisshu(:,:) + dpsisshv(:,:) )
+ dpsissh => dpsisshu
+ ENDIF
+ ENDIF
+ ENDIF
+
+ ! output results after normalization
+ dpsi = dpsi - dpsi(iiref,ijref)
+ IF ( lmask ) THEN
+ PRINT *,' Write masked BSF'
+ ierr = putvar(ncout, id_varout(1), SNGL(dpsi)*zmask(:,:), 1, npiglo, npjglo, ktime=jt)
+ IF ( lssh ) THEN
+ ierr = putvar(ncout, id_varout(2), SNGL(dpsissh )*zmask(:,:), 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(3), SNGL(dpsissh+dpsi)*zmask(:,:), 1, npiglo, npjglo, ktime=jt)
+ ENDIF
ELSE
- ! Get zonal velocity at jk
- zu(:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- ! get e3v at level jk
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
- ! integrates vertically
- ztrpu(:,:) = ztrpu(:,:) + zu(:,:)*e2u(:,:)*e3u(:,:) ! zonal transport of each grid cell
+ PRINT *,' Write BSF'
+ ierr = putvar(ncout, id_varout(1), SNGL(dpsi) , 1, npiglo, npjglo, ktime=jt)
+ IF ( lssh ) THEN
+ ierr = putvar(ncout, id_varout(2), SNGL(dpsissh ), 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(3), SNGL(dpsissh+dpsi), 1, npiglo, npjglo, ktime=jt)
+ ENDIF
ENDIF
- END DO ! loop to next level
-
- IF (coption == 'V' ) THEN
- ! integrate zonally from east to west
- psiv(npiglo,:)= 0.0
- DO ji=npiglo-1,1,-1
- psiv(ji,:) = psiv(ji+1,:) - ztrpv(ji,:) ! psi at f point
- END DO
- psiv(:,:) = psiv(:,:) *zmask(:,:)
- ierr = putvar(ncout, id_varout(1) ,SNGL(psiv), 1, npiglo, npjglo)
-
- ELSE
- ! integrate from the south to the north with zonal transport
- psiu(:,:) = 0.d0
-
- DO jj = 2, npjglo
- psiu(:,jj) = psiu(:,jj-1) - ztrpu(:,jj) ! psi at f point
- END DO
- psiu(:,:) = (psiu(:,:) -psiu(npiglo,npjglo) ) * zmask(:,:)
- ierr = putvar(ncout, id_varout(1) ,SNGL(psiu), 1, npiglo, npjglo)
- ENDIF
-
- istatus = closeout (ncout)
-
- END PROGRAM cdfpsi
+ ENDDO
+
+ ierr = closeout (ncout)
+
+END PROGRAM cdfpsi
diff --git a/cdfpsi_level.f90 b/cdfpsi_level.f90
index 10a882a..da124a4 100644
--- a/cdfpsi_level.f90
+++ b/cdfpsi_level.f90
@@ -75,15 +75,15 @@ PROGRAM cdfpsi_level
npk = getdim (cfileu,'depth')
! define new variables for output ( must update att.txt)
- typvar(1)%name= 'sobarstf'
- typvar(1)%units='m3/s'
- typvar(1)%missing_value=0.
+ typvar(1)%cname= 'sobarstf'
+ typvar(1)%cunits='m3/s'
+ typvar(1)%rmissing_value=0.
typvar(1)%valid_min= -300.e6
typvar(1)%valid_max= 300.e6
- typvar(1)%long_name='Barotropic_Stream_Function'
- typvar(1)%short_name='sobarstf'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
+ typvar(1)%clong_name='Barotropic_Stream_Function'
+ typvar(1)%cshort_name='sobarstf'
+ typvar(1)%conline_operation='N/A'
+ typvar(1)%caxis='TZYX'
ipk(1) = npk ! 3D ( X, Y , Z, T )
PRINT *, 'npiglo=', npiglo
@@ -127,14 +127,14 @@ PROGRAM cdfpsi_level
IF ( coption == 'V' ) THEN
zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- ztrpv(:,:) = zv(:,:)*e1v(:,:)*e3v(:,:) ! meridional transport of each grid cell
+ ztrpv(:,:) = zv(:,:)*e1v(:,:)*e3v(:,:)*1.d0 ! meridional transport of each grid cell
ELSE
! Get zonal velocity at jk
zu(:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
! get e3v at level jk
e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
! integrates vertically
- ztrpu(:,:) = zu(:,:)*e2u(:,:)*e3u(:,:) ! zonal transport of each grid cell
+ ztrpu(:,:) = zu(:,:)*e2u(:,:)*e3u(:,:)*1.d0 ! zonal transport of each grid cell
ENDIF
IF (coption == 'V' ) THEN
@@ -144,8 +144,8 @@ PROGRAM cdfpsi_level
psiv(ji,:) = psiv(ji+1,:) - ztrpv(ji,:) ! psi at f point
END DO
psiv(:,:) = psiv(:,:) *zmask(:,:)
- !ierr = putvar(ncout, id_varout(1) ,REAL(psiv), jk, npiglo, npjglo)
- ierr = putvar(ncout, id_varout(1) ,REAL(ztrpv), jk, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(1) ,REAL(psiv), jk, npiglo, npjglo)
+ !ierr = putvar(ncout, id_varout(1) ,REAL(ztrpv), jk, npiglo, npjglo)
ELSE
! integrate from the south to the north with zonal transport
diff --git a/cdfpv.f90 b/cdfpv.f90
deleted file mode 100644
index 62368fe..0000000
--- a/cdfpv.f90
+++ /dev/null
@@ -1,205 +0,0 @@
-PROGRAM cdfpv
- !! --------------------------------------------------------------
- !! *** PROGRAM CDFPV ***
- !! ** Purpose: This program is used to compute the potential vorticity
- !! from a set of T S U V files.
- !!
- !! ** Method: pv = 1/rho0 * ( f + zeta) d(rho)/d(z)
- !! rho0 = 1020. kg/m3
- !! f is the coriolis factor
- !! zeta is the relative vorticity
- !! Output is done for f (2D) (at f-points)
- !! zeta (3D) at f-points
- !! f/rho0 d(rho)/d(z) (3D) at W points
- !! PV at T point.
- !!
- !! ** Usage :
- !! cdfpv gridT gridU gridV files.
- !! output is done on pv.nc, with variable name
- !! vopv (PV)
- !!
- !! * history:
- !! Original : J.M. Molines for SPEM in Dynamo (1996)
- !! Modif : J-O. Beismann for OPA (1999)
- !! Modif : J.M. Molines for normalization Clipper (March 2000)
- !! : J.M. Molines in cdftools, f90 dor DRAKKAR (Nov. 2005)
- !! ---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Used modules
- USE cdfio
- USE eos
-
- !! * Local declaration
- IMPLICIT NONE
-
- INTEGER :: npiglo, npjglo, npk, npt
- INTEGER :: narg, iargc
- INTEGER :: ji,jj,jk
- INTEGER :: ncout, ierr
- INTEGER :: iup=1 , idown=2, itmp
- INTEGER, DIMENSION(1) :: ipk, id_varout !: for output variables
- !
- REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: sigma, rotn
- REAL(KIND=4), DIMENSION(:,:) , ALLOCATABLE :: ztemp, zsal,un, vn, dsig, rot, fmask, zmask, fcorio, pv,&
- & e1u, e2f, e1f, e2v, e3w, gphit
- REAL(KIND=4), DIMENSION(:) , ALLOCATABLE :: time_tag, h1d, gdepw
- REAL(KIND=4) :: zrot, pi, rho0=1020.
-
- CHARACTER(LEN=256) :: cfilet,cfileu, cfilev, cfilout
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc'
-
- TYPE(variable) , DIMENSION(1) :: typvar !: structure for attributes
- !
-
- !! * Read command line
- narg=iargc()
- IF (narg < 3 ) THEN
- PRINT *, &
- &' >>>> usage: cdfpv gridT gridU gridV files '
- PRINT *,' Output is done on pv.nc'
- PRINT *,' variables vopv '
- PRINT *,' mesh_hgr.nc, mesh_zgr.nc are required'
- STOP
- ENDIF
- CALL getarg(1,cfilet)
- CALL getarg(2,cfileu)
- CALL getarg(3,cfilev)
-
- npiglo=getdim(cfilet,'x')
- npjglo=getdim(cfilet,'y')
- npk =getdim(cfilet,'depth')
- npt =getdim(cfilet,'time')
-
- ALLOCATE( sigma(npiglo,npjglo,2) )
- ALLOCATE ( rotn(npiglo,npjglo,2) )
- ALLOCATE( ztemp(npiglo,npjglo), zsal(npiglo,npjglo) )
- ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo),fcorio(npiglo,npjglo),pv(npiglo,npjglo) )
- ALLOCATE( zmask(npiglo,npjglo), fmask(npiglo,npjglo) ,dsig(npiglo,npjglo), rot(npiglo,npjglo) )
- ALLOCATE( time_tag(npt), h1d(npk) ,gdepw(npk))
- ALLOCATE ( e1u(npiglo,npjglo) , e1f(npiglo,npjglo) ,gphit(npiglo,npjglo))
- ALLOCATE ( e2v(npiglo,npjglo) , e2f(npiglo,npjglo) ,e3w(npiglo,npjglo) )
-
-
- ! read mesh_mask/ time information
- time_tag(:)=getvar1d(cfilet,'time_counter', npt)
- h1d(:)=getvar1d(cfilet,'deptht',npk)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- e1u= getvar(coordhgr, 'e1u', 1,npiglo,npjglo)
- e1f= getvar(coordhgr, 'e1f', 1,npiglo,npjglo)
- e2v= getvar(coordhgr, 'e2v', 1,npiglo,npjglo)
- e2f= getvar(coordhgr, 'e2f', 1,npiglo,npjglo)
- gphit(:,:) = getvar(coordhgr,'gphit',1,npiglo,npjglo)
-
- ! Compute coriolis factor
- pi=ACOS(-1.)
- fcorio(:,:)=4*pi/86400.*SIN(pi/180*gphit(:,:))
-
- ! ... open output file and write header
- ipk(:)=npk
- typvar(1)%name= 'vopv'
- typvar(1)%units='kg.m-4.s-1 x 1e7'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar(1)%long_name='Full_Potential_vorticity'
- typvar(1)%short_name='vopv'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
- cfilout='pv.nc'
-
- ncout = create(cfilout,cfilet ,npiglo,npjglo,npk,cdep='depthw')
- ierr = createvar(ncout, typvar,1,ipk, id_varout )
- ierr = putheadervar(ncout , cfilet, npiglo, npjglo, npk,pdep=gdepw)
- ierr = putvar1d(ncout,time_tag,1,'T')
- pv(:,:) = 0.
- ierr = putvar(ncout,id_varout(1), pv,1,npiglo,npjglo)
-
- ! initialize first level
- ztemp(:,:) = getvar(cfilet,'votemper',1,npiglo,npjglo)
- zsal(:,:) = getvar(cfilet,'vosaline',1,npiglo,npjglo)
- un (:,:) = getvar(cfileu,'vozocrtx',1,npiglo,npjglo)
- vn (:,:) = getvar(cfilev,'vomecrty',1,npiglo,npjglo)
-
- ! compute the mask
- DO jj = 1, npjglo - 1
- DO ji = 1, npiglo - 1
- fmask(ji,jj)=0.
- fmask(ji,jj)= un(ji,jj)*un(ji,jj+1) * vn(ji,jj)*vn(ji+1,jj)
- IF (fmask(ji,jj) /= 0.) fmask(ji,jj)=1.
- ENDDO
- ENDDO
-
- zmask = 1.0
- WHERE(zsal == 0 ) zmask = 0.0
- sigma(:,:,iup) = sigma0 ( ztemp,zsal,npiglo,npjglo )* zmask(:,:)
- rotn(:,:,iup) = 0.
- DO jj = 1, npjglo -1
- DO ji = 1, npiglo -1 ! vector opt.
- rotn(ji,jj,iup) = ( e2v(ji+1,jj ) * vn(ji+1,jj ) - e2v(ji,jj) * vn(ji,jj) &
- & - e1u(ji ,jj+1) * un(ji ,jj+1) + e1u(ji,jj) * un(ji,jj) ) &
- & * fmask(ji,jj) / ( e1f(ji,jj) * e2f(ji,jj) )
- END DO
- END DO
-
- ! Main vertical loop
- DO jk=2,npk
- PRINT *, 'Level ',jk
- ztemp(:,:) = getvar(cfilet,'votemper',jk,npiglo,npjglo)
- zsal(:,:) = getvar(cfilet,'vosaline',jk,npiglo,npjglo)
- un (:,:) = getvar(cfileu,'vozocrtx',jk,npiglo,npjglo)
- vn (:,:) = getvar(cfilev,'vomecrty',jk,npiglo,npjglo)
- e3w (:,:) = getvar(coordzgr,'e3w_ps', jk, npiglo,npjglo, ldiom=.true.)
- WHERE (e3w == 0 ) e3w = 1.
-
- ! compute the mask at level jk
- DO jj = 1, npjglo - 1
- DO ji = 1, npiglo - 1
- fmask(ji,jj)=0.
- fmask(ji,jj)= un(ji,jj)*un(ji,jj+1) * vn(ji,jj)*vn(ji+1,jj)
- IF (fmask(ji,jj) /= 0.) fmask(ji,jj)=1.
- ENDDO
- ENDDO
- zmask=1.0
- WHERE(zsal == 0 ) zmask = 0.0
- sigma(:,:,idown) = sigma0 ( ztemp,zsal,npiglo,npjglo )* zmask(:,:)
-
- ! d(sigma0)/dz at W point ( masked if down level is masked )
- dsig(:,:)=(sigma(:,:,idown) - sigma(:,:,iup)) /e3w *zmask
-
- rotn(:,:,idown) = 0.
- DO jj = 1, npjglo -1
- DO ji = 1, npiglo -1 ! vector opt.
- rotn(ji,jj,idown) = ( e2v(ji+1,jj ) * vn(ji+1,jj ) - e2v(ji,jj) * vn(ji,jj) &
- & - e1u(ji ,jj+1) * un(ji ,jj+1) + e1u(ji,jj) * un(ji,jj) ) &
- & * fmask(ji,jj) / ( e1f(ji,jj) * e2f(ji,jj) )
- END DO
- END DO
-
- ! curl at f point, w level
- rot(:,:)= 0.5*( rotn(:,:,idown) + rotn(:,:,iup) )
-
- ! Full pv:
- DO ji=2,npiglo
- DO jj = 2, npjglo
- zrot=0.25*( rot(ji,jj) + rot(ji-1,jj) + rot(ji,jj-1) + rot(ji-1,jj-1) )
-! pv(ji,jj) = 1/rho0*(fcorio(ji,jj)+zrot)*dsig(ji,jj)*1.e11
- pv(ji,jj) = (fcorio(ji,jj)+zrot)*dsig(ji,jj)*1.e7
- ! pv(ji,jj) = dsig(ji,jj)*1000.
- END DO
- END DO
- ierr = putvar(ncout,id_varout(1), pv,jk,npiglo,npjglo)
-
- ! swap index up and down
- itmp=iup
- iup=idown
- idown=itmp
- END DO
-
- ierr = closeout(ncout)
- PRINT *,'cdfpv completed successfully'
-END PROGRAM cdfpv
diff --git a/cdfpvor-full.f90 b/cdfpvor-full.f90
deleted file mode 100644
index 0108b96..0000000
--- a/cdfpvor-full.f90
+++ /dev/null
@@ -1,239 +0,0 @@
-PROGRAM cdfpvor_full
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfpvor_full ***
- !!
- !! ** Purpose: Compute the Ertel Potential vorticity
- !! FULL STEP VERSION
- !!
- !! ** Method: Try to avoid 3 d arrays : work with 2 levels a a time
- !! Formula :
- !! Qpot = drho/dz * ( f + xsi ) = Qstr + Qrel
- !! * f is the Coriolis factor, computed from the latitudes of the T-grid :
- !! f(i,j) = 2 * omega * sin ( phit(i,j) * pi / 180 )
- !!
- !! * xsi is the relative vorticity (vertical component of the velocity curl),
- !! computed from the relative vorticity of the F-points interpolated at
- !! the T-points :
- !! xsif(i,j) = ( ue(i,j) - ue(i,j+1) - ve(i,j) + ve(i+1,j) ) / areaf(i,j)
- !! with : ue(i,j) = U(i,j) * e1u(i,j)
- !! ve(i,j) = V(i,j) * e2v(i,j)
- !! areaf(i,j) = e1f(i,j) * e2f(i,j)
- !! xsi(i,j) = ( xsif(i-1,j-1) + xsif(i-1,j) + xsif(i,j-1) + xsif(i,j) ) / 4
- !! = ( ue(i-1,j-1) + ue(i,j-1) - ue(i-1,j+1) - ue(i,j+1)
- !! - ve(i-1,j-1) - ve(i-1,j) + ve(i+1,j-1) + ve(i+1,j) )
- !! / 4 / areat(i,j)
- !! with : areat(i,j) = e1t(i,j) * e2t(i,j)
- !!
- !! units : U, V in m.s-1
- !! e1u, e2v, e1f, e2f in m
- !! f, xsi in s-1
- !! Qpot, Qrel, Qstr in kg.m-4.s-1
- !!
- !!
- !! The brunt-vaisala frequency is computed using the
- !! polynomial expression of McDougall (1987):
- !! N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
- !! N2 is then insterpolated at T levels
- !!
- !! history:
- !! Original : A.M Treguier december 2005
- !!--------------------------------------------------------------------
- !! $Rev: 256 $
- !! $Date: 2009-07-21 17:49:27 +0200 (Tue, 21 Jul 2009) $
- !! $Id: cdfpvor.f90 256 2009-07-21 15:49:27Z molines $
- !!--------------------------------------------------------------
- !!
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jk, jj, ji,jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,npt !: size of the domain
- INTEGER :: iup = 1 , idown = 2, itmp
- INTEGER, DIMENSION(3) :: ipk, id_varout
- REAL(kind=8) , DIMENSION(:,:), ALLOCATABLE :: e2v, e1u, e1t, e2t, gphit
- REAL(kind=4) , DIMENSION(:,:), ALLOCATABLE :: un, vn, rotn, zareat, z2fcor , stretch
- REAL(KIND=4) , DIMENSION (:,:,:), ALLOCATABLE :: ztemp, zsal,zwk !: Array to read 2 layer of data
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: &
- zn2 , & !: Brunt Vaissala Frequency (N2)
- tmask, e3w
- REAL(KIND=4) , DIMENSION (:), ALLOCATABLE :: gdepw ,e3w_0
- REAL(KIND=4),DIMENSION(:) ,ALLOCATABLE :: tim
-
- CHARACTER(LEN=256) :: cfilet , cfileu, cfilev, cfileout='pvor.nc' !:
- CHARACTER(LEN=256) :: coordzgr='mesh_zgr.nc' !:
- CHARACTER(LEN=256) :: coord ='mesh_hgr.nc' !:
- TYPE(variable), DIMENSION(3) :: typvar !: structure for attribute
-
- INTEGER :: ncout
- INTEGER :: istatus
- REAL(KIND=4) :: zpi, zomega, rau0sg
- LOGICAL :: lprint
-
- rau0sg = 1020/9.81
- lprint = .false.
-
- !! Read command line
- narg= iargc()
- IF ( narg /= 3 ) THEN
- PRINT *,' Usage : cdfpvor-full gridT gridU gridV'
- PRINT *,' FULL STEP VERSION '
- PRINT *,' Output on pvor.nc, variables vorelvor, vostrvor,vototvor'
- PRINT *,' Need mesh_zgr.nc and coordinates.nc '
- STOP
- ENDIF
-
- CALL getarg (1, cfilet)
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npt = getdim (cfilet,'time')
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'npt =', npt
-
- ALLOCATE ( e1u(npiglo,npjglo) , e1t(npiglo,npjglo) )
- ALLOCATE ( e2v(npiglo,npjglo) , e2t(npiglo,npjglo) )
- ALLOCATE ( gphit(npiglo,npjglo), z2fcor(npiglo,npjglo))
- ALLOCATE ( zareat(npiglo,npjglo), stretch(npiglo,npjglo))
- ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) )
- ALLOCATE ( rotn(npiglo,npjglo) , tmask(npiglo,npjglo) )
- ALLOCATE (gdepw(npk),tim(npt))
-
- e1u= getvar(coord, 'e1u', 1,npiglo,npjglo)
- e1t= getvar(coord, 'e1t', 1,npiglo,npjglo)
- e2v= getvar(coord, 'e2v', 1,npiglo,npjglo)
- e2t= getvar(coord, 'e2t', 1,npiglo,npjglo)
- gphit= getvar(coord, 'gphit', 1,npiglo,npjglo)
- zpi=ACOS(-1.)
- zomega = 2*zpi/(3600*24)
- z2fcor(:,:)=2.0*zomega*SIN(gphit(:,:)*zpi/180.0)
- zareat(:,:) = 4.*e1t(:,:)*e2t(:,:) ! factor of 4 to normalize relative vorticity
-
- IF (lprint) print *, ' reading gdepw in file ', trim(coordzgr)
- gdepw(:) = getvare3(coordzgr, 'gdepw', npk)
- IF (lprint) print *, ' read gdepw in file ', trim(coordzgr)
-
- tim=getvar1d(cfileu,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ALLOCATE (ztemp(npiglo,npjglo,2), zsal(npiglo,npjglo,2))
- ALLOCATE (zwk(npiglo,npjglo,2) )
- ALLOCATE (zn2(npiglo,npjglo) , e3w_0(npk), e3w(npiglo,npjglo))
-
- ! create output fileset
-
- ipk(:)= npk ! Those three variables are 3D
- ! define variable name and attribute
- typvar(1)%name= 'vorelvor'
- typvar(2)%name= 'vostrvor'
- typvar(3)%name= 'vototvor'
- typvar%units='kg.m-4.s-1'
- typvar%missing_value=0.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar(1)%long_name='Relative_component_of_Ertel_PV'
- typvar(2)%long_name='Stretching_component_of_Ertel_PV'
- typvar(3)%long_name='Ertel_potential_vorticity'
- typvar(1)%short_name='vorelvor'
- typvar(2)%short_name='vostrvor'
- typvar(3)%short_name='vototvor'
- typvar%online_operation='N/A'
- typvar%axis='TZYX'
-
-
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
- ierr= createvar (ncout ,typvar,3, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo,npjglo,npk)
-
-
- DO jt=1,npt
- ! 2 levels of T and S are required : iup,idown (with respect to W level)
- ! Compute from bottom to top (for vertical integration)
- PRINT *,'time=',jt,'(days:',tim(jt)/86400.,')'
- ztemp(:,:,idown) = getvar(cfilet, 'votemper', npk-1 ,npiglo, npjglo, ktime=jt)
- zsal( :,:,idown) = getvar(cfilet, 'vosaline', npk-1 ,npiglo, npjglo, ktime=jt)
- IF (lprint) print *, ' read temperature and salinity at bottom '
-
- tim=getvar1d(cfilet,'time_counter',npt)
- ierr=putvar1d(ncout,tim,npt,'T')
- e3w_0(:) = getvare3(coordzgr, 'e3w',npk)
-
-
- ! -------------------------------- LOOP OVER LEVELS
- DO jk = npk-1, 1, -1
- PRINT *,' level ',jk
- ! ------------------------------------RELATIVE VORTICITY FIRST
- IF (lprint) print *, ' trying to read u in file:', trim(cfileu)
- un(:,:) = getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo,ktime=jt)
- IF (lprint) print *, ' trying to read v in file:', trim(cfilev)
- vn(:,:) = getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo,ktime=jt)
- un(:,:) = un(:,:)*e1u(:,:) ; vn(:,:) = vn(:,:)*e2v(:,:) ;
- IF (lprint) print *, ' read u and V OK'
- ! relative vorticity at T point
- rotn(:,:) = 0.
- DO jj = 2, npjglo -1
- DO ji = 2, npiglo -1
- rotn(ji,jj) = ( un(ji-1,jj-1) + un(ji,jj-1) &
- -un(ji-1,jj+1) - un(ji,jj+1) &
- -vn(ji-1,jj-1) - vn(ji-1,jj) &
- +vn(ji+1,jj-1) + vn(ji+1,jj)) &
- /zareat(ji,jj)
- END DO
- END DO
- IF (lprint) print *, ' curl calculated '
- ! now tmask and Vaisala Frequency bn2
- IF ( jk > 1) then
- tmask(:,:)=1.
- ztemp(:,:,iup)= getvar(cfilet, 'votemper', jk-1 ,npiglo, npjglo,ktime=jt)
- WHERE(ztemp(:,:,idown) == 0 ) tmask = 0
- zsal(:,:,iup) = getvar(cfilet, 'vosaline', jk-1 ,npiglo,npjglo,ktime=jt)
- IF (lprint) print *, ' read temperature and salinity '
- e3w(:,:) = e3w_0(jk)
- WHERE (e3w == 0 ) e3w = 1.
-
- zwk(:,:,iup) = &
- & eosbn2 ( ztemp,zsal,gdepw(jk),e3w, npiglo,npjglo ,iup,idown)* tmask(:,:)
- IF (lprint) print *, ' bn2 calculated at w points '
- !
- ! now put zn2 at T level (k )
- WHERE ( zwk(:,:,idown) == 0 )
- zn2(:,:) = zwk(:,:,iup)
- ELSEWHERE
- zn2(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) * tmask(:,:)
- END WHERE
- IF (lprint) print *, ' bn2 put back at T points '
- ENDIF
- !
- ! now rotn will be converted to relative vorticity and zn2 to stretching
- rotn(:,:) = rotn(:,:)* rau0sg * zn2(:,:)
- stretch(:,:) = zn2(:,:) * rau0sg * z2fcor(:,:)
-
- ! write the three variables on file at level k
- ierr = putvar(ncout, id_varout(1) ,rotn*1.e7, jk ,npiglo, npjglo, ktime=jt)
- ierr = putvar(ncout, id_varout(2) ,stretch*1.e7 , jk, npiglo, npjglo , ktime=jt)
- ierr = putvar(ncout, id_varout(3) ,(rotn+stretch)*1.e7 , jk, npiglo, npjglo , ktime=jt)
- IF (lprint) print *, ' three variables written '
- itmp = idown ; idown = iup ; iup = itmp
-
- END DO ! loop to next level
-
- ! set zero at bottom
- rotn(:,:) = 0
- ierr = putvar(ncout, id_varout(1) ,rotn, npk ,npiglo, npjglo, ktime=jt)
- ierr = putvar(ncout, id_varout(2) ,rotn ,npk, npiglo, npjglo , ktime=jt)
- ierr = putvar(ncout, id_varout(3) ,rotn ,npk, npiglo, npjglo , ktime=jt)
- END DO ! loop on time
-
- istatus = closeout(ncout)
-
-END PROGRAM cdfpvor_full
diff --git a/cdfpvor.f90 b/cdfpvor.f90
index 6e12e02..4cc2186 100644
--- a/cdfpvor.f90
+++ b/cdfpvor.f90
@@ -1,237 +1,325 @@
PROGRAM cdfpvor
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfpvor ***
- !!
- !! ** Purpose: Compute the Ertel Potential vorticity
- !!
- !! ** Method: Try to avoid 3 d arrays : work with 2 levels a a time
- !! Formula :
- !! Qpot = drho/dz * ( f + xsi ) = Qstr + Qrel
- !! * f is the Coriolis factor, computed from the latitudes of the T-grid :
- !! f(i,j) = 2 * omega * sin ( phit(i,j) * pi / 180 )
+ !!======================================================================
+ !! *** PROGRAM cdfpvor ***
+ !!=====================================================================
+ !! ** Purpose : Compute the Ertel Potential vorticity
!!
- !! * xsi is the relative vorticity (vertical component of the velocity curl),
- !! computed from the relative vorticity of the F-points interpolated at
- !! the T-points :
- !! xsif(i,j) = ( ue(i,j) - ue(i,j+1) - ve(i,j) + ve(i+1,j) ) / areaf(i,j)
- !! with : ue(i,j) = U(i,j) * e1u(i,j)
- !! ve(i,j) = V(i,j) * e2v(i,j)
- !! areaf(i,j) = e1f(i,j) * e2f(i,j)
- !! xsi(i,j) = ( xsif(i-1,j-1) + xsif(i-1,j) + xsif(i,j-1) + xsif(i,j) ) / 4
- !! = ( ue(i-1,j-1) + ue(i,j-1) - ue(i-1,j+1) - ue(i,j+1)
- !! - ve(i-1,j-1) - ve(i-1,j) + ve(i+1,j-1) + ve(i+1,j) )
- !! / 4 / areat(i,j)
- !! with : areat(i,j) = e1t(i,j) * e2t(i,j)
+ !! ** Method : Formula :
+ !! Qpot = drho/dz * ( f + xsi ) = Qstr + Qrel
+ !! * f is the Coriolis factor, computed from the latitudes of the T-grid :
+ !! f(i,j) = 2 * omega * sin ( phit(i,j) * pi / 180 )
!!
- !! units : U, V in m.s-1
+ !! * xsi is the relative vorticity (vertical component of the velocity curl),
+ !! computed from the relative vorticity of the F-points interpolated at
+ !! the T-points :
+ !! xsif(i,j) = ( ue(i,j) - ue(i,j+1) - ve(i,j) + ve(i+1,j) ) / areaf(i,j)
+ !! with : ue(i,j) = U(i,j) * e1u(i,j)
+ !! ve(i,j) = V(i,j) * e2v(i,j)
+ !! areaf(i,j) = e1f(i,j) * e2f(i,j)
+ !! xsi(i,j) = ( xsif(i-1,j-1) + xsif(i-1,j) + xsif(i,j-1) + xsif(i,j) ) / 4
+ !! = ( ue(i-1,j-1) + ue(i,j-1) - ue(i-1,j+1) - ue(i,j+1)
+ !! - ve(i-1,j-1) - ve(i-1,j) + ve(i+1,j-1) + ve(i+1,j) )
+ !! / 4 / areat(i,j)
+ !! with : areat(i,j) = e1t(i,j) * e2t(i,j)
+ !! units : U, V in m.s-1
!! e1u, e2v, e1f, e2f in m
!! f, xsi in s-1
!! Qpot, Qrel, Qstr in kg.m-4.s-1
!!
- !!
- !! The brunt-vaisala frequency is computed using the
- !! polynomial expression of McDougall (1987):
- !! N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
- !! N2 is then insterpolated at T levels
- !!
- !! history:
- !! Original : A.M Treguier december 2005
- !!--------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- !! * Modules used
+ !! History : 2.1 : 12/2005 : A.M. Treguier : Original code
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic., merge with cdfpv
+ !!-------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, jj, ji,jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,npt !: size of the domain
- INTEGER :: iup = 1 , idown = 2, itmp
- INTEGER, DIMENSION(3) :: ipk, id_varout
- REAL(kind=8) , DIMENSION(:,:), ALLOCATABLE :: e2v, e1u, e1t, e2t, gphit
- REAL(kind=4) , DIMENSION(:,:), ALLOCATABLE :: un, vn, rotn, zareat, z2fcor , stretch
- REAL(KIND=4) , DIMENSION (:,:,:), ALLOCATABLE :: ztemp, zsal,zwk !: Array to read 2 layer of data
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: &
- zn2 , & !: Brunt Vaissala Frequency (N2)
- tmask, e3w
- REAL(KIND=4) , DIMENSION (:), ALLOCATABLE :: gdepw
- REAL(KIND=4),DIMENSION(:) ,ALLOCATABLE :: tim
-
- CHARACTER(LEN=256) :: cfilet , cfileu, cfilev, cfileout='pvor.nc' !:
- CHARACTER(LEN=256) :: coordzgr='mesh_zgr.nc' !:
- CHARACTER(LEN=256) :: coord ='mesh_hgr.nc' !:
- TYPE(variable), DIMENSION(3) :: typvar !: structure for attribute
-
- INTEGER :: ncout
- INTEGER :: istatus
- REAL(KIND=4) :: zpi, zomega, rau0sg
- LOGICAL :: lprint
-
- rau0sg = 1020/9.81
- lprint = .false.
-
- !! Read command line
+
+ INTEGER(KIND=4) :: jk, jj, ji, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: iup=1, idown=2, itmp ! working interger
+ INTEGER(KIND=4) :: ncout ! ncid for output file
+ INTEGER(KIND=4) :: nvar=3 ! number of output variable
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! output variable id's
+
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: ztemp, zsal, zwk ! array to ead 2 layer of data
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zn2 ! Brunt Vaissala frequency
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! tmask from salinity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3w ! vertical metric
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1u, e2v ! horizontal metric
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t ! horizontal metric at T point
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: gphit ! latitude of t point
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! deptht
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! metric for full step
+ REAL(KIND=4) :: zpi, zomega, rau0sg ! physical constant
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dun, dvn ! velocity component and flx
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: drotn ! curl of the velocity
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: d2fcor ! coriolis term at T point
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dstretch ! stretching vorticity
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dareat ! area of T cells
+
+ CHARACTER(LEN=256) :: cf_tfil ! input T file
+ CHARACTER(LEN=256) :: cf_ufil ! input U file
+ CHARACTER(LEN=256) :: cf_vfil ! input V file
+ CHARACTER(LEN=256) :: cf_out='pvor.nc' ! output file
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for attribute
+
+ LOGICAL :: lfull = .FALSE. ! flag for full step
+ LOGICAL :: lertel = .TRUE. ! flag for large scale pv
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
- IF ( narg /= 3 ) THEN
- PRINT *,' Usage : cdfpvor gridT gridU gridV'
- PRINT *,' Output on pvor.nc, variables vorelvor, vostrvor,vototvor'
- PRINT *,' Need mesh_zgr.nc and coordinates.nc '
+ IF ( narg < 2 ) THEN
+ PRINT *,' usage : cdfpvor T-file U-file V-file [-full] [-lspv ]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the Ertel potential vorticity and save the relative '
+ PRINT *,' vorticity, the stretching and the total potential vorticity. '
+ PRINT *,' Qtot = ( f + xsi ) . D(rho)/D(z) = Qstrech + Qrel '
+ PRINT *,' With -lspv option, compute only Qstretch or Large Scale P V '
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file for temperature and salinity. '
+ PRINT *,' U-file : netcdf file for zonal component of the velocity. '
+ PRINT *,' V-file : netcdf file for meridional component of the velocity.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-full ] : indicate a full step configuration. '
+ PRINT *,' [-lspv ] : calculate only the large scale potential vorticity.'
+ PRINT *,' ( replace the old cdflspv tool).'
+ PRINT *,' If used only T-file is required, no need for velocities.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fhgr),' and ',TRIM(cn_fzgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : vorelvor (kg.m-4.s-1 ) relative vorticity'
+ PRINT *,' vostrvor (kg.m-4.s-1 ) stretching vorticity'
+ PRINT *,' vototvor (kg.m-4.s-1 ) total potential vorticity'
+ PRINT *,' Ertel PV are located at T points.'
+ PRINT *,' '
+ PRINT *,' With option -lspv :'
+ PRINT *,' netcdf file : lspv.nc'
+ PRINT *,' variables : volspv (kg.m-4.s-1 ) large scale potential vorticity'
+ PRINT *,' LSPV is located at W points.'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfcurl ( compute only the curl on 1 level)'
+ PRINT *,' '
STOP
ENDIF
- CALL getarg (1, cfilet)
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npt = getdim (cfilet,'time')
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'npt =', npt
-
- ALLOCATE ( e1u(npiglo,npjglo) , e1t(npiglo,npjglo) )
- ALLOCATE ( e2v(npiglo,npjglo) , e2t(npiglo,npjglo) )
- ALLOCATE ( gphit(npiglo,npjglo), z2fcor(npiglo,npjglo))
- ALLOCATE ( zareat(npiglo,npjglo), stretch(npiglo,npjglo))
- ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) )
- ALLOCATE ( rotn(npiglo,npjglo) , tmask(npiglo,npjglo) )
- ALLOCATE (gdepw(npk),tim(npt))
-
- e1u= getvar(coord, 'e1u', 1,npiglo,npjglo)
- e1t= getvar(coord, 'e1t', 1,npiglo,npjglo)
- e2v= getvar(coord, 'e2v', 1,npiglo,npjglo)
- e2t= getvar(coord, 'e2t', 1,npiglo,npjglo)
- gphit= getvar(coord, 'gphit', 1,npiglo,npjglo)
- zpi=ACOS(-1.)
- zomega = 2*zpi/(3600*24)
- z2fcor(:,:)=2.0*zomega*SIN(gphit(:,:)*zpi/180.0)
- zareat(:,:) = 4.*e1t(:,:)*e2t(:,:) ! factor of 4 to normalize relative vorticity
-
- IF (lprint) print *, ' reading gdepw in file ', trim(coordzgr)
- gdepw(:) = getvare3(coordzgr, 'gdepw', npk)
- IF (lprint) print *, ' read gdepw in file ', trim(coordzgr)
-
- tim=getvar1d(cfileu,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
+ ijarg = 1 ; ireq = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg( ijarg, cldum ) ; ijarg = ijarg + 1
+
+ SELECT CASE ( cldum )
+ CASE ( '-full' ) ; lfull = .TRUE.
+ CASE ( '-lspv' ) ; lertel = .FALSE. ; nvar = 1 ; cf_out = 'lspv.nc'
+ CASE DEFAULT
+ ireq=ireq+1
+ SELECT CASE ( ireq )
+ CASE ( 1 ) ; cf_tfil = cldum
+ CASE ( 2 ) ; cf_ufil = cldum
+ CASE ( 3 ) ; cf_vfil = cldum
+ CASE DEFAULT
+ PRINT *,' Too many arguments '; STOP
+ END SELECT
+ END SELECT
+ END DO
+
+ lchk = lchk .OR. chkfile( cn_fzgr)
+ lchk = lchk .OR. chkfile( cn_fhgr)
+ lchk = lchk .OR. chkfile( cf_tfil)
+ IF ( lertel ) THEN
+ lchk = lchk .OR. chkfile( cf_ufil)
+ lchk = lchk .OR. chkfile( cf_vfil)
+ ENDIF
+ IF ( lchk ) STOP ! missing file
+
+ npiglo = getdim (cf_tfil, cn_x)
+ npjglo = getdim (cf_tfil, cn_y)
+ npk = getdim (cf_tfil, cn_z)
+ npt = getdim (cf_tfil, cn_t)
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE ( e1u(npiglo,npjglo), e1t(npiglo,npjglo) )
+ ALLOCATE ( e2v(npiglo,npjglo), e2t(npiglo,npjglo) )
+ ALLOCATE ( gphit(npiglo,npjglo), d2fcor(npiglo,npjglo) )
+ ALLOCATE ( tmask(npiglo,npjglo) )
+ ALLOCATE ( gdepw(npk), tim(npt) )
+
+ ALLOCATE ( dstretch(npiglo,npjglo) )
+ IF ( lertel ) THEN
+ ALLOCATE ( dareat(npiglo,npjglo) )
+ ALLOCATE ( dun(npiglo,npjglo), dvn(npiglo,npjglo) )
+ ALLOCATE ( drotn(npiglo,npjglo) )
+ ENDIF
+ IF ( lfull ) ALLOCATE ( e31d(npk) )
+
+ e1u = getvar(cn_fhgr, cn_ve1u, 1, npiglo, npjglo)
+ e1t = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo)
+ e2v = getvar(cn_fhgr, cn_ve2v, 1, npiglo, npjglo)
+ e2t = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo)
+ gphit = getvar(cn_fhgr, cn_gphit, 1, npiglo, npjglo)
+
+ rau0sg = 1020./9.81
+ zpi = ACOS(-1.)
+ zomega = 2.0 * zpi /(3600*24)
+ d2fcor(:,:) = 2.d0 * zomega * SIN(gphit(:,:)*zpi/180.0)
+ dareat(:,:) = 4.d0 * e1t(:,:) * e2t(:,:) ! factor of 4 to normalize relative vorticity
+
+ gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk)
ALLOCATE (ztemp(npiglo,npjglo,2), zsal(npiglo,npjglo,2))
- ALLOCATE (zwk(npiglo,npjglo,2) )
- ALLOCATE (zn2(npiglo,npjglo) , e3w(npiglo,npjglo))
+ ALLOCATE (zwk(npiglo,npjglo,2) )
+ ALLOCATE (zn2(npiglo,npjglo) , e3w(npiglo,npjglo) )
+ ALLOCATE ( stypvar(nvar), ipk(nvar), id_varout(nvar) )
! create output fileset
ipk(:)= npk ! Those three variables are 3D
- ! define variable name and attribute
- typvar(1)%name= 'vorelvor'
- typvar(2)%name= 'vostrvor'
- typvar(3)%name= 'vototvor'
- typvar%units='kg.m-4.s-1'
- typvar%missing_value=0.
- typvar%valid_min= -1000.
- typvar%valid_max= 1000.
- typvar(1)%long_name='Relative_component_of_Ertel_PV'
- typvar(2)%long_name='Stretching_component_of_Ertel_PV'
- typvar(3)%long_name='Ertel_potential_vorticity'
- typvar(1)%short_name='vorelvor'
- typvar(2)%short_name='vostrvor'
- typvar(3)%short_name='vototvor'
- typvar%online_operation='N/A'
- typvar%axis='TZYX'
-
-
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
- ierr= createvar (ncout ,typvar,3, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo,npjglo,npk)
+ stypvar%cunits = 'kg.m-4.s-1'
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = -1000.
+ stypvar%valid_max = 1000.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TZYX'
+
+ IF (lertel ) THEN
+ ! define variable name and attribute
+ stypvar(1)%cname = 'vorelvor' ; stypvar(1)%clong_name = 'Relative_component_of_Ertel_PV'
+ stypvar(2)%cname = 'vostrvor' ; stypvar(2)%clong_name = 'Stretching_component_of_Ertel_PV'
+ stypvar(3)%cname = 'vototvor' ; stypvar(3)%clong_name = 'Ertel_potential_vorticity'
+
+ stypvar(1)%cshort_name = 'vorelvor'
+ stypvar(2)%cshort_name = 'vostrvor'
+ stypvar(3)%cshort_name = 'vototvor'
+
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, nvar, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
+ ELSE
+ stypvar(1)%cname = 'volspv' ; stypvar(1)%clong_name = 'Large Scale Potential_vorticity'
+ stypvar(1)%cshort_name = 'volspv'
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk, cdep=TRIM(cn_vdepthw) )
+ ierr = createvar (ncout, stypvar, nvar, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk, pdep=gdepw )
+ ENDIF
+
+ IF ( lfull ) e31d = getvare3( cn_fzgr, cn_ve3w, npk )
+ tim = getvar1d(cf_ufil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T' )
DO jt=1,npt
- ! 2 levels of T and S are required : iup,idown (with respect to W level)
- ! Compute from bottom to top (for vertical integration)
+ ! 2 levels of T and S are required : iup,idown (with respect to W level)
+ ! Compute from bottom to top (for vertical integration)
PRINT *,'time=',jt,'(days:',tim(jt)/86400.,')'
- ztemp(:,:,idown) = getvar(cfilet, 'votemper', npk-1 ,npiglo, npjglo, ktime=jt)
- zsal( :,:,idown) = getvar(cfilet, 'vosaline', npk-1 ,npiglo, npjglo, ktime=jt)
- IF (lprint) print *, ' read temperature and salinity at bottom '
-
- tim=getvar1d(cfilet,'time_counter',npt)
- ierr=putvar1d(ncout,tim,npt,'T')
-
- ! -------------------------------- LOOP OVER LEVELS
- DO jk = npk-1, 1, -1
- PRINT *,' level ',jk
- ! ------------------------------------RELATIVE VORTICITY FIRST
- IF (lprint) print *, ' trying to read u in file:', trim(cfileu)
- un(:,:) = getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo,ktime=jt)
- IF (lprint) print *, ' trying to read v in file:', trim(cfilev)
- vn(:,:) = getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo,ktime=jt)
- un(:,:) = un(:,:)*e1u(:,:) ; vn(:,:) = vn(:,:)*e2v(:,:) ;
- IF (lprint) print *, ' read u and V OK'
- ! relative vorticity at T point
- rotn(:,:) = 0.
- DO jj = 2, npjglo -1
- DO ji = 2, npiglo -1
- rotn(ji,jj) = ( un(ji-1,jj-1) + un(ji,jj-1) &
- -un(ji-1,jj+1) - un(ji,jj+1) &
- -vn(ji-1,jj-1) - vn(ji-1,jj) &
- +vn(ji+1,jj-1) + vn(ji+1,jj)) &
- /zareat(ji,jj)
- END DO
- END DO
- IF (lprint) print *, ' curl calculated '
- ! now tmask and Vaisala Frequency bn2
- IF ( jk > 1) then
- tmask(:,:)=1.
- ztemp(:,:,iup)= getvar(cfilet, 'votemper', jk-1 ,npiglo, npjglo,ktime=jt)
- WHERE(ztemp(:,:,idown) == 0 ) tmask = 0
- zsal(:,:,iup) = getvar(cfilet, 'vosaline', jk-1 ,npiglo,npjglo,ktime=jt)
- IF (lprint) print *, ' read temperature and salinity '
- e3w(:,:) = getvar(coordzgr, 'e3w_ps', jk,npiglo, npjglo ,ldiom=.true.)
- WHERE (e3w == 0 ) e3w = 1.
- IF (lprint) print *, ' read e3w_ps in file ' , trim(coordzgr)
-
-
- zwk(:,:,iup) = &
- & eosbn2 ( ztemp,zsal,gdepw(jk),e3w, npiglo,npjglo ,iup,idown)* tmask(:,:)
- IF (lprint) print *, ' bn2 calculated at w points '
- !
- ! now put zn2 at T level (k )
- WHERE ( zwk(:,:,idown) == 0 )
- zn2(:,:) = zwk(:,:,iup)
- ELSEWHERE
- zn2(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) * tmask(:,:)
- END WHERE
- IF (lprint) print *, ' bn2 put back at T points '
+ ztemp(:,:,idown) = getvar(cf_tfil, cn_votemper, npk-1, npiglo, npjglo, ktime=jt)
+ zsal( :,:,idown) = getvar(cf_tfil, cn_vosaline, npk-1, npiglo, npjglo, ktime=jt)
+
+ ! -------------------------------- LOOP OVER LEVELS
+ DO jk = npk-1, 1, -1
+ PRINT *,' level ',jk
+ IF ( lertel ) THEN
+ ! ------------------------------------RELATIVE VORTICITY FIRST
+ dun(:,:) = getvar(cf_ufil, cn_vozocrtx, jk ,npiglo, npjglo, ktime=jt)
+ dvn(:,:) = getvar(cf_vfil, cn_vomecrty, jk ,npiglo, npjglo, ktime=jt)
+ dun(:,:) = dun(:,:)*e1u(:,:)
+ dvn(:,:) = dvn(:,:)*e2v(:,:)
+ ! relative vorticity at T point
+ drotn(:,:) = 0.d0
+ DO jj = 2, npjglo -1
+ DO ji = 2, npiglo -1
+ drotn(ji,jj) = ( dun(ji-1,jj-1) + dun(ji,jj-1) &
+ & -dun(ji-1,jj+1) - dun(ji,jj+1) &
+ & -dvn(ji-1,jj-1) - dvn(ji-1,jj) &
+ & +dvn(ji+1,jj-1) + dvn(ji+1,jj)) &
+ / dareat(ji,jj)
+ END DO
+ END DO
+ ENDIF
+
+ ! now tmask and Vaisala Frequency bn2
+ IF ( jk > 1) THEN
+ tmask(:,:)=1.
+ ztemp(:,:,iup) = getvar(cf_tfil, cn_votemper, jk-1 ,npiglo, npjglo, ktime=jt)
+ zsal(:,:,iup) = getvar(cf_tfil, cn_vosaline, jk-1 ,npiglo, npjglo, ktime=jt)
+ WHERE(zsal(:,:,idown) == 0 ) tmask = 0
+ IF ( lfull ) THEN
+ e3w(:,:) = e31d(jk)
+ ELSE
+ e3w(:,:) = getvar(cn_fzgr, 'e3w_ps', jk, npiglo, npjglo ,ldiom=.TRUE.)
+ ENDIF
+
+ WHERE (e3w == 0 ) e3w = 1.
+
+ zwk(:,:,iup) = eosbn2 ( ztemp, zsal, gdepw(jk), e3w, npiglo, npjglo ,iup, idown)* tmask(:,:)
+ !
+ IF ( lertel ) THEN ! put zn2 at T level (k )
+ WHERE ( zwk(:,:,idown) == 0 )
+ zn2(:,:) = zwk(:,:,iup)
+ ELSEWHERE
+ zn2(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) * tmask(:,:)
+ END WHERE
+ ELSE ! keep bn2 at w points
+ zn2(:,:) = zwk(:,:,iup) * tmask(:,:)
+ ENDIF
+ ENDIF
+ !
+ ! now rotn will be converted to relative vorticity and zn2 to stretching
+ dstretch(:,:) = d2fcor(:,:)* rau0sg * zn2(:,:)
+
+ IF ( lertel ) THEN
+ drotn(:,:) = drotn(:,:) * rau0sg * zn2(:,:)
+ ! write the three variables on file at level k
+ ierr = putvar(ncout, id_varout(1), REAL( drotn )*1.e7, jk, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(2), REAL( dstretch )*1.e7, jk, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(3), REAL((drotn+dstretch))*1.e7, jk, npiglo, npjglo, ktime=jt)
+ ELSE
+ ! save absolute value of dstretch, as in olf cdflspv
+ ierr = putvar(ncout, id_varout(1), REAL( ABS(dstretch) )*1.e7, jk, npiglo, npjglo, ktime=jt)
+ ENDIF
+
+ itmp = idown ; idown = iup ; iup = itmp
+
+ END DO ! loop to next level
+
+ ! set zero at bottom and surface
+ zwk(:,:,1) = 0.e0
+ ierr = putvar(ncout, id_varout(1), zwk(:,:,1), 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(1), zwk(:,:,1), npk, npiglo, npjglo, ktime=jt)
+
+ IF (lertel ) THEN
+ ierr = putvar(ncout, id_varout(2), zwk(:,:,1), 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(3), zwk(:,:,1), 1, npiglo, npjglo, ktime=jt)
+
+ ierr = putvar(ncout, id_varout(2), zwk(:,:,1), npk, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(3), zwk(:,:,1), npk, npiglo, npjglo, ktime=jt)
ENDIF
- !
- ! now rotn will be converted to relative vorticity and zn2 to stretching
- rotn(:,:) = rotn(:,:)* rau0sg * zn2(:,:)
- stretch(:,:) = zn2(:,:) * rau0sg * z2fcor(:,:)
-
- ! write the three variables on file at level k
- ierr = putvar(ncout, id_varout(1) ,rotn*1.e7, jk ,npiglo, npjglo, ktime=jt)
- ierr = putvar(ncout, id_varout(2) ,stretch*1.e7 , jk, npiglo, npjglo , ktime=jt)
- ierr = putvar(ncout, id_varout(3) ,(rotn+stretch)*1.e7 , jk, npiglo, npjglo , ktime=jt)
- IF (lprint) print *, ' three variables written '
- itmp = idown ; idown = iup ; iup = itmp
-
- END DO ! loop to next level
-
- ! set zero at bottom
- rotn(:,:) = 0
- ierr = putvar(ncout, id_varout(1) ,rotn, npk ,npiglo, npjglo, ktime=jt)
- ierr = putvar(ncout, id_varout(2) ,rotn ,npk, npiglo, npjglo , ktime=jt)
- ierr = putvar(ncout, id_varout(3) ,rotn ,npk, npiglo, npjglo , ktime=jt)
END DO ! loop on time
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
END PROGRAM cdfpvor
diff --git a/cdfrhoproj.f90 b/cdfrhoproj.f90
index f589634..a44207a 100644
--- a/cdfrhoproj.f90
+++ b/cdfrhoproj.f90
@@ -1,249 +1,362 @@
PROGRAM cdfrhoproj
- !! --------------------------------------------------------------
- !! *** PROGRAM RHO_VERT_INT ***
- !! ** Purpose: This program is used to project any scalar on the A grid
+ !!======================================================================
+ !! *** PROGRAM cdfrhoproj ***
+ !!=====================================================================
+ !! ** Purpose : This program is used to project any scalar on the A grid
!! onto given isopycnic surfaces.
!!
- !! ** Method: Linear interpolation is used on the vertical to define
- !! the depth of the given isopycn and linear interpolation
- !! is also performed on the scalar to determine its value at
- !! this depth.
+ !! ** Method : Linear interpolation is used on the vertical to define
+ !! the depth of the given isopycn and linear interpolation
+ !! is also performed on the scalar to determine its value at
+ !! this depth.
!!
- !! ** Usage :
- !! cdfrhoproj [-s0 sig0] 'rho file' 'scalar file (*)'
- !!
- !! * history:
- !! Original : J.M. Molines for SPEM in Dynamo (1996)
- !! Modif : J-O. Beismann for OPA (1999)
- !! Modif : J.M. Molines for normalization Clipper (March 2000)
- !! : J.M. Molines in cdftools, f90 dor DRAKKAR (Nov. 2005)
- !! ---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Used modules
+ !! History : : 1996 : J.M. Molines for SPEM in Dynamo
+ !! : 1999 : J.O. Beismann for OPA
+ !! : 2000 : J.M. Molines for normalization
+ !! 2.1 : 11/2005 : J.M. Molines : netcdf
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local declaration
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: npiglo, npjglo, npk, npkk ,npt ,nvars
- INTEGER :: narg, iargc
- INTEGER :: ji,jj,jk,jkk,jfich,k0, jvar
- INTEGER :: istartarg = 1
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(2) :: ipk, id_varout !: for output variables
+ INTEGER(KIND=4) :: ji,jj,jk,jsig,jfich, jvar
+ INTEGER(KIND=4) :: npiglo, npjglo
+ INTEGER(KIND=4) :: npk, npsig, npt
+ INTEGER(KIND=4) :: nvars, nvout=2
+ INTEGER(KIND=4) :: narg, iargc
+ INTEGER(KIND=4) :: ijarg, ireq
+ INTEGER(KIND=4) :: ik0, ijk
+ INTEGER(KIND=4) :: istartarg = 1
+ INTEGER(KIND=4) :: nfilin
+ INTEGER(KIND=4) :: numlev=10
+ INTEGER(KIND=4) :: ncout, ierr
+ INTEGER(KIND=4), DIMENSION(2) :: ipk, id_varout ! for output variables
!
- REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d, alpha
- REAL(KIND=4), DIMENSION(:,:) , ALLOCATABLE :: v2dint, zint, v2d
- REAL(KIND=4), DIMENSION(:) , ALLOCATABLE :: zi, time_tag, h1d
- REAL(KIND=4) :: x1z,y1z,dxz,dyz,P1,P2
- REAL(KIND=4) :: spval=999999.
- REAL(KIND=4) :: spvalz=0.
-
- CHARACTER(LEN=256) :: cline, cfilZI, cfildata, cfilRHOMOD, cvar, cfilout, ctype='T'
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: czvar !: temporary arry for variable name in file
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: zsig, alpha
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2dint, zint, v2d
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: zi, tim, h1d
+ REAL(KIND=4) :: P1, P2
+ REAL(KIND=4) :: zalpha
+ REAL(KIND=4) :: zspvalo=999999.
+ REAL(KIND=4) :: zspvali=0.
+
+ CHARACTER(LEN=256) :: cf_rholev='rho_lev'
+ CHARACTER(LEN=256) :: cf_dta
+ CHARACTER(LEN=256) :: cf_rhofil
+ CHARACTER(LEN=256) :: cf_out
+ CHARACTER(LEN=256) :: cv_in
+ CHARACTER(LEN=256) :: cv_sig
+ CHARACTER(LEN=256) :: ctype='T'
+ CHARACTER(LEN=256) :: cldum
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! temporary arry for variable name in file
- TYPE(variable), DIMENSION(2) :: typvar !: structure for attributes
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typzvar !: structure for attributes
+ TYPE(variable), DIMENSION(2) :: stypvar ! structure for attributes
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypzvar ! structure for attributes
!
- LOGICAL :: lsingle=.false.
+ LOGICAL :: lsingle =.FALSE.
+ LOGICAL :: lchk =.FALSE.
+ LOGICAL :: lisodep =.FALSE.
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+ cv_sig = cn_vosigma0
- !! * Read command line
narg=iargc()
- IF (narg < 3 ) THEN
- PRINT *, &
- &' >>>> usage: cdfrhoproj [-s0 sig0 ] <cvar> <rhofile> <file*> [ T | U | V | W ]'
- PRINT *,' Interpolated files will be file.nc.interp'
- PRINT *,' Isopycnal value are read on a text file ''rho_lev'' '
- PRINT *,' unless the option -s0 is specified with one particular value'
- PRINT *,' cvar specify the name of the cdf variable to interpolate '
- PRINT *,' Model density are taken on file ''rhofile'' '
- PRINT *,' File is the netcdf file holding cvar '
- PRINT *,' Last argument is optional (T by default) and indicate the '
- PRINT *,' C-Grid point corresponding to file.'
- PRINT *,' cvar will be interpolated on T point previous projection on isopycnals'
- STOP
+ IF ( narg < 3 ) THEN
+ PRINT *,' usage : cdfrhoproj IN-var RHO-file List_of_IN-files [VAR-type] ... '
+ PRINT *,' ... [-s0 sig0 ] [-sig sigma_name] [-isodep ]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Project IN-var on isopycnal surfaces defined either by sig0 given'
+ PRINT *,' as argument or on all sigma surfaces defined in ',TRIM(cf_rholev),' ascii file.'
+ PRINT *,' IN-var will be interpolated on the T point of the C-grid, previous'
+ PRINT *,' to projection on isopycnal.'
+ PRINT *,' This cdftool is one of the few using 3D arrays. Further development is '
+ PRINT *,' required to work with vertical slabs instead.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-var : name of the input variable to be projected'
+ PRINT *,' RHO-file : netcdf file with potential density field. If not a sigma0'
+ PRINT *,' file, use -sig option to indicate the name of the density'
+ PRINT *,' variable.'
+ PRINT *,' List_of_IN-file : netcdf files with IN-var '
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-s0 sigma ] : define a single sigma surface on the command line'
+ PRINT *,' instead of reading rho_lev ascii file.'
+ PRINT *,' [VAR-type] : position of IN-var on the C-grid ( either T U V F W )'
+ PRINT *,' default is ''T''.'
+ PRINT *,' [-sig sigma_name] : name of the density variable in RHO_file.'
+ PRINT *,' default is ', TRIM(cv_sig)
+ PRINT *,' [-isodep ] : only compute the isopycnal depth. In this case you must'
+ PRINT *,' still specify a IN-var variable (in fact a dummy name).'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' no metrics, information is taken from depth variable in input files.'
+ PRINT *,' ', TRIM(cf_rholev),' if not using -s0 option.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' There are as many output files as input files.'
+ PRINT *,' netcdf file : IN-file.interp'
+ PRINT *,' variables : VAR-in (unit is the same as input var)'
+ PRINT *,' ', TRIM(cn_vodepiso),' (m) : depth of isopycnal.'
+ PRINT *,' '
+ PRINT *,' If option -isodep is used, only isopycnal depth is output :'
+ PRINT *,' netcdf file : isopycdep.nc'
+ PRINT *,' variables : ',TRIM(cn_vodepiso),' (m) '
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' replace cdfisopycdep when using -isodep option.'
+ PRINT *,' '
+ STOP
ENDIF
- ! seek a -s0 option
- CALL getarg(1,cline)
- IF (cline == '-s0' ) THEN
- npkk = 1
- lsingle=.true.
- istartarg = 3
- CALL getarg(2,cline)
- ALLOCATE (zi(npkk) )
- READ(cline,*) zi(1)
- END IF
- ! read ZI if not single
+
+ ijarg = 1 ; ireq=0 ; nfilin=0
+
+ DO WHILE ( ijarg <= narg )
+ CALL getarg( ijarg, cldum) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
+ CASE ('-s0')
+ npsig = 1 ; lsingle=.TRUE. ; ALLOCATE (zi(npsig) )
+ CALL getarg( ijarg, cldum) ; ijarg=ijarg+1 ; READ(cldum,*) zi(1)
+ CASE ( 'T','t','U','u','V','v','W','w','F','f' )
+ ctype=cldum
+ CASE ('-sig')
+ CALL getarg( ijarg, cv_sig) ; ijarg=ijarg+1
+ CASE ('-isodep') ; lisodep = .TRUE. ; nvout=1 ; cf_out='isopycdep.nc'
+ CASE DEFAULT
+ ireq=ireq+1
+ SELECT CASE (ireq )
+ CASE ( 1 ) ; cv_in = cldum
+ CASE ( 2 ) ; cf_rhofil = cldum
+ CASE DEFAULT
+ ! count the input files
+ nfilin=nfilin+1
+ IF ( nfilin == 1 ) istartarg=ijarg-1
+ END SELECT
+ END SELECT
+ END DO
+
+ lchk = chkfile(cf_rhofil)
+ IF ( .NOT. lsingle ) lchk = lchk .OR. chkfile(cf_rholev)
+ IF ( lchk ) STOP ! missing file
+
IF ( .NOT. lsingle ) THEN
- cfilZI='rho_lev'
- OPEN(10,file=cfilZI)
- READ(10,*) npkk
- ALLOCATE (zi(npkk) )
- DO jkk=1,npkk
- READ(10,*) zi(jkk)
- PRINT *,zi(jkk)
+ OPEN(numlev,FILE=cf_rholev)
+ READ(numlev,*) npsig
+ ALLOCATE ( zi(npsig) )
+ DO jsig=1,npsig
+ READ(numlev,*) zi(jsig)
+ PRINT *,zi(jsig)
END DO
- CLOSE(10)
+ CLOSE(numlev)
ENDIF
- ! Seek for ctype (last argument either T U V or W )
- CALL getarg(narg,ctype)
- SELECT CASE ( ctype)
- CASE ( 'T','t','U','u','V','v','W','w' )
- narg = narg -1 ! last argument is not a file name
- CASE DEFAULT
- ctype='T'
- END SELECT
-
- ! Read variable name
- CALL getarg(istartarg,cvar)
+
! Read Rho file
- CALL getarg(istartarg+1,cfilRHOMOD)
- npiglo=getdim(cfilRHOMOD,'x')
- npjglo=getdim(cfilRHOMOD,'y')
- npk =getdim(cfilRHOMOD,'depth')
- npt =getdim(cfilRHOMOD,'time')
+ npiglo = getdim(cf_rhofil,cn_x)
+ npjglo = getdim(cf_rhofil,cn_y)
+ npk = getdim(cf_rhofil,cn_z)
+ npt = getdim(cf_rhofil,cn_t)
- CALL getarg(istartarg+2, cfildata)
- nvars=getnvar(cfildata)
- ALLOCATE(czvar(nvars), typzvar(nvars))
+ CALL getarg(istartarg, cf_dta)
+ nvars=getnvar(cf_dta)
+ ALLOCATE(cv_names(nvars), stypzvar(nvars))
- czvar(:)=getvarname(cfildata,nvars,typzvar)
+ cv_names(:)=getvarname(cf_dta, nvars, stypzvar)
- ALLOCATE( v3d(npiglo,npjglo,npk), alpha(npiglo, npjglo, npkk) )
+ ALLOCATE( zsig(npiglo,npjglo,npk), alpha(npiglo, npjglo, npsig) )
ALLOCATE( v2dint(npiglo, npjglo), v2d(npiglo,npjglo), zint(npiglo,npjglo) )
- ALLOCATE( time_tag(npt), h1d(npk) )
+ ALLOCATE( tim(npt), h1d(npk) )
- time_tag(:)=getvar1d(cfilRHOMOD,'time_counter', npt)
- h1d(:)=getvar1d(cfilRHOMOD,'deptht',npk)
+ tim(:)=getvar1d(cf_rhofil, cn_vtimec, npt)
+ h1d(:)=getvar1d(cf_rhofil, cn_vdeptht, npk)
DO jk=1,npk
- v3d(:,:,jk) = getvar(cfilRHOMOD,'vosigma0',jk,npiglo,npjglo)
+ zsig(:,:,jk) = getvar(cf_rhofil, cv_sig, jk, npiglo, npjglo)
END DO
!! ** Compute interpolation coefficients as well as the level used
!! to interpolate between
DO ji=1,npiglo
DO jj = 1, npjglo
- jk = 1
- DO jkk=1,npkk
+ ijk = 1
+ DO jsig=1,npsig
! Assume that rho (z) is increasing downward (no inversion)
! Caution with sigma0 at great depth !
- DO WHILE (zi(jkk) >= v3d(ji,jj,jk) .AND. jk <= npk &
- & .AND. v3d(ji,jj,jk) /= spvalz )
- jk=jk+1
+ DO WHILE (zi(jsig) >= zsig(ji,jj,ijk) .AND. ijk <= npk &
+ & .AND. zsig(ji,jj,ijk) /= zspvali )
+ ijk=ijk+1
END DO
- jk=jk-1
- k0=jk
- IF (jk .EQ. 0) THEN
- jk=1
- alpha(ji,jj,jkk) = 0.
- ELSE IF (v3d(ji,jj,jk+1) .EQ. spvalz ) THEN
- k0=0
- alpha(ji,jj,jkk) = 0.
+ ijk=ijk-1
+ ik0=ijk
+ IF (ijk == 0) THEN
+ ijk=1
+ alpha(ji,jj,jsig) = 0.
+ ELSE IF (zsig(ji,jj,ijk+1) == zspvali ) THEN
+ ik0=0
+ alpha(ji,jj,jsig) = 0.
ELSE
- ! ... alpha is always in [0,1]. Adding k0 ( >=1 ) for saving space for k0
- alpha(ji,jj,jkk)= &
- & (zi(jkk)-v3d(ji,jj,jk))/(v3d(ji,jj,jk+1)-v3d(ji,jj,jk)) +k0
+ ! ... alpha is always in [0,1]. Adding ik0 ( >=1 ) for saving space for ik0
+ alpha(ji,jj,jsig)= &
+ & (zi(jsig)-zsig(ji,jj,ijk))/(zsig(ji,jj,ijk+1)-zsig(ji,jj,ijk)) + ik0
ENDIF
END DO
END DO
END DO
+ IF ( lisodep ) THEN
+ ipk(1) = npsig
+ stypvar(1)%cname = cn_vodepiso
+ stypvar(1)%cunits = 'm'
+ stypvar(1)%rmissing_value = 999999.
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 7000.
+ stypvar(1)%clong_name = 'Depth_of_Isopycnals'
+ stypvar(1)%cshort_name = cn_vodepiso
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TRYX'
+
+ ncout = create (cf_out, cf_rhofil, npiglo, npjglo, npsig )
+ ierr = createvar (ncout, stypvar, nvout, ipk, id_varout )
+ ierr = putheadervar(ncout , cf_rhofil, npiglo, npjglo, npsig, pdep=zi )
+
+ DO jsig=1,npsig
+ DO ji=1,npiglo
+ DO jj=1,npjglo
+ ! ik0 is retrieved from alpha, taking the integer part.
+ ! The remnant is alpha.
+ ik0 = INT(alpha(ji,jj,jsig))
+ zalpha = alpha(ji,jj,jsig) - ik0
+ IF (ik0 /= 0) THEN
+ P1 = zsig(ji,jj,ik0 )
+ P2 = zsig(ji,jj,ik0+1)
+ IF (P1 /= zspvali .AND. P2 /= zspvali) THEN
+ zint (ji,jj) = zalpha *h1d(ik0+1) &
+ & +(1-zalpha)*h1d(ik0 )
+ ELSE
+ zint (ji,jj)=zspvalo
+ ENDIF
+ ELSE
+ zint (ji,jj)=zspvalo
+ ENDIF
+ END DO
+ END DO
+ ierr = putvar(ncout, id_varout(1), zint , jsig, npiglo, npjglo)
+ END DO
+ ierr = closeout(ncout )
+ ENDIF
+
!! ** Loop on the scalar files to project on choosen isopycnics surfaces
- DO jfich=istartarg+2,narg
+ DO jfich= 1, nfilin
+ ijarg = istartarg + jfich - 1
- CALL getarg(jfich,cfildata)
- PRINT *,'working with ', TRIM(cfildata)
+ CALL getarg(ijarg, cf_dta)
+ PRINT *,'working with ', TRIM(cf_dta)
+ npt = getdim(cf_dta, cn_t)
IF (npt /= 1 ) THEN
PRINT *,' This program has to be modified for multiple'
PRINT *,' time frames.'
STOP ' Error : npt # 1'
ENDIF
+ tim(:)=getvar1d(cf_dta, cn_vtimec, 1)
DO jk=1,npk
- v2d(:,:) = getvar(cfildata,cvar,jk,npiglo,npjglo)
+ v2d(:,:) = getvar(cf_dta,cv_in,jk,npiglo,npjglo)
SELECT CASE ( ctype )
CASE ('T', 't' )
- v3d(:,:,jk) = v2d(:,:)
+ zsig(:,:,jk) = v2d(:,:)
CASE ('U','u' )
DO ji=2,npiglo
DO jj=1, npjglo
- v3d(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji-1,jj) ) ! put variable on T point
+ zsig(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji-1,jj) ) ! put variable on T point
END DO
END DO
CASE ('V','v' )
DO jj=2,npjglo
DO ji=1, npiglo
- v3d(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji,jj-1) ) ! put variable on T point
+ zsig(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji,jj-1) ) ! put variable on T point
END DO
END DO
CASE('W','w' )
- STOP 'Case W not done yet :( '
+ zint(:,:) = getvar(cf_dta, cv_in, jk+1, npiglo, npjglo)
+ DO jj=1,npjglo
+ DO ji=1, npiglo
+ zsig(ji,jj,jk)=0.5*( v2d(ji,jj) + zint(ji,jj) ) ! put variable on T point
+ END DO
+ END DO
+ CASE('F','f' )
+ DO jj=2,npjglo
+ DO ji=2, npiglo
+ zsig(ji,jj,jk)=0.25*( v2d(ji,jj) + v2d(ji,jj-1) + v2d(ji-1,jj) + v2d(ji-1,jj-1 )) ! put variable on T point
+ END DO
+ END DO
END SELECT
END DO
! ... open output file and write header
- ipk(:)=npkk
+ ipk(:)=npsig
DO jvar=1,nvars
- IF ( cvar == typzvar(jvar)%name ) THEN
- typvar(1)=typzvar(jvar)
+ IF ( cv_in == stypzvar(jvar)%cname ) THEN
+ stypvar(2)=stypzvar(jvar)
EXIT
ENDIF
END DO
- typvar(1)%long_name=TRIM(typvar(1)%long_name)//' on iso sigma'
- typvar(1)%axis='TRYX'
-
- typvar(2)%name= 'vodepiso'
- typvar(2)%units='m'
- typvar(2)%missing_value=999999.
- typvar(2)%valid_min= 0.
- typvar(2)%valid_max= 7000.
- typvar(2)%long_name='Depth_of_Isopycnals'
- typvar(2)%short_name='vodepiso'
- typvar(2)%online_operation='N/A'
- typvar(2)%axis='TRYX'
+ stypvar(2)%clong_name = TRIM(stypvar(2)%clong_name)//' on iso sigma'
+ stypvar(2)%caxis = 'TRYX'
+ stypvar(1)%cname = cn_vodepiso
+ stypvar(1)%cunits = 'm'
+ stypvar(1)%rmissing_value = 999999.
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 7000.
+ stypvar(1)%clong_name = 'Depth_of_Isopycnals'
+ stypvar(1)%cshort_name = cn_vodepiso
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TRYX'
- cfilout=TRIM(cfildata)//'.interp'
+ cf_out=TRIM(cf_dta)//'.interp'
- ncout = create(cfilout,cfilRHOMOD ,npiglo,npjglo,npkk)
- ierr = createvar(ncout, typvar,2,ipk, id_varout )
- ierr = putheadervar(ncout , cfilRHOMOD, npiglo, npjglo, npkk,pdep=zi)
+ ncout = create (cf_out, cf_rhofil, npiglo, npjglo, npsig )
+ ierr = createvar (ncout, stypvar, nvout, ipk, id_varout )
+ ierr = putheadervar(ncout , cf_rhofil, npiglo, npjglo, npsig, pdep=zi )
- DO jkk=1,npkk
+ DO jsig=1,npsig
DO ji=1,npiglo
DO jj=1,npjglo
- ! k0 is retrieved from alpha, taking the integer part.
+ ! ik0 is retrieved from alpha, taking the integer part.
! The remnant is alpha.
- k0=INT(alpha(ji,jj,jkk))
- alpha(ji,jj,jkk) = alpha(ji,jj,jkk) - k0
- IF (k0 /= 0) THEN
- P1=v3d(ji,jj,k0)
- P2=v3d(ji,jj,k0+1)
- IF (P1 /= spvalz .AND. P2 /= spvalz) THEN
- v2dint(ji,jj)=alpha(ji,jj,jkk)*P2 &
- & +(1-alpha(ji,jj,jkk))*P1
- zint (ji,jj)=alpha(ji,jj,jkk)*h1d(k0+1) &
- & +(1-alpha(ji,jj,jkk))*h1d(k0)
+ ik0 = INT(alpha(ji,jj,jsig))
+ zalpha = alpha(ji,jj,jsig) - ik0
+ IF (ik0 /= 0) THEN
+ P1 = zsig(ji,jj,ik0 )
+ P2 = zsig(ji,jj,ik0+1)
+ IF (P1 /= zspvali .AND. P2 /= zspvali) THEN
+ v2dint(ji,jj) = zalpha *P2 &
+ & +(1-zalpha)*P1
+ zint (ji,jj) = zalpha *h1d(ik0+1) &
+ & +(1-zalpha)*h1d(ik0 )
ELSE
- v2dint(ji,jj)=spval
- zint (ji,jj)=spval
+ v2dint(ji,jj)=zspvalo
+ zint (ji,jj)=zspvalo
ENDIF
ELSE
- v2dint(ji,jj)=spval
- zint (ji,jj)=spval
+ v2dint(ji,jj)=zspvalo
+ zint (ji,jj)=zspvalo
ENDIF
END DO
END DO
- ierr = putvar(ncout,id_varout(1), v2dint,jkk,npiglo,npjglo)
- ierr = putvar(ncout,id_varout(2), zint ,jkk,npiglo,npjglo)
+ ierr = putvar(ncout, id_varout(1), zint , jsig, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(2), v2dint, jsig, npiglo, npjglo)
END DO
- ierr = putvar1d(ncout,time_tag,1,'T')
- ierr = closeout(ncout)
+ ierr = putvar1d(ncout, tim, 1, 'T')
+ ierr = closeout(ncout )
END DO ! loop on scalar files
PRINT *,'Projection on isopycns completed successfully'
END PROGRAM cdfrhoproj
diff --git a/cdfrichardson.f90 b/cdfrichardson.f90
new file mode 100644
index 0000000..92a724d
--- /dev/null
+++ b/cdfrichardson.f90
@@ -0,0 +1,224 @@
+PROGRAM cdfrichardson
+ !!======================================================================
+ !! *** PROGRAM cdfrichardson ***
+ !!=====================================================================
+ !! ** Purpose : Compute the Richardson NUmber
+ !! using same algoritm than NEMO
+ !!
+ !! ** Method : Try to avoid 3 d arrays : work with 2 levels at a time
+ !! The Richardson number is computed as
+ !! Ri = N^2/ dz(U)**2
+ !! and dz(U)** [ squared vertical velocity derivative] is :
+ !! dz(ub)*dz(ub) + dz(vb)*dz(vb)
+ !!
+ !! History : 2.0 : 11/2004 : J.M. Molines : Original code
+ !! 2.1 : 04/2005 : J.M. Molines : use cdfio
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ USE cdfio
+ USE modcdfnames ! for cdf variable names
+ USE eos
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
+ IMPLICIT NONE
+
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc, ijarg !
+ INTEGER(KIND=4) :: npiglo, npjglo, npk, npt ! size of the domain
+ INTEGER(KIND=4) :: iup = 1, idown = 2, itmp ! for swapping the levels
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(2) :: ipk, id_varout ! level and id of output variables
+
+ REAL(KIND=4) :: zpi ! 3.14...
+ REAL(KIND=4) :: rspval=0. ! missing_value
+ REAL(KIND=4) :: zcoef, zdku, zdkv, zzri ! working real
+ REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: ztemp, zsal, zwk ! Array to read 2 layer of data
+ REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zu, zv ! Array to read 2 layer of velocities
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zri ! Richardson number
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e3w ! mask and metric
+ REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep, tim, e3w1d ! depth and time
+
+ CHARACTER(LEN=256) :: cldum ! dummy char variable
+ CHARACTER(LEN=256) :: cf_tfil ! input T file name
+ CHARACTER(LEN=256) :: cf_ufil ! input U file name
+ CHARACTER(LEN=256) :: cf_vfil ! input V file name
+ CHARACTER(LEN=256) :: cf_out = 'richardson.nc' ! output file name
+ CHARACTER(LEN=256) :: cglobal ! global attribute
+ CHARACTER(LEN=80) :: cv_e3w = 'e3w_ps' ! e3w variable name (partial step)
+ CHARACTER(LEN=80) :: cv_ric = 'voric' ! cdf variable name for N2
+ CHARACTER(LEN=80) :: cv_dep ! cdf variable name for depth
+
+ TYPE(variable), DIMENSION(1) :: stypvar ! variable attribute
+
+ LOGICAL :: l_w=.FALSE. ! flag for vertical location of ric
+ LOGICAL :: lchk=.TRUE. ! check missing files
+ LOGICAL :: lfull=.FALSE. ! full step flag
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfrichardson gridT gridU gridV [ W ] [-full]'
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the Richardson Number (Ri) according to'
+ PRINT *,' temperature, salinity and velocity components'
+ PRINT *,' given in the input files.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' gridT : input gridT file for temperature and salinity'
+ PRINT *,' gridU : input gridU file for zonal velocity component'
+ PRINT *,' gridV : input gridV file for meridional velocity component'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ W ] : keep N2 at W points. Default is to interpolate N2'
+ PRINT *,' at T point on the vertical'
+ PRINT *,' [ -full ] : indicate a full step configuration instead of'
+ PRINT *,' the default partial steps.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fzgr),' is needed for this program.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_ric)
+ STOP
+ ENDIF
+
+ cglobal = 'Partial step computation'
+
+ ijarg = 1
+ CALL getarg (ijarg, cf_tfil) ; ijarg = ijarg + 1
+ CALL getarg (ijarg, cf_ufil) ; ijarg = ijarg + 1
+ CALL getarg (ijarg, cf_vfil) ; ijarg = ijarg + 1
+
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE (cldum)
+ CASE ('W','w') ; l_w = .TRUE.
+ CASE ('-full') ; lfull = .TRUE. ; cglobal = 'full step computation'
+ CASE DEFAULT ; PRINT *,' Option not understood :', TRIM(cldum) ; STOP
+ END SELECT
+ END DO
+
+ lchk = chkfile (cn_fzgr )
+ lchk = lchk .OR. chkfile (cf_tfil )
+ lchk = lchk .OR. chkfile (cf_ufil )
+ lchk = lchk .OR. chkfile (cf_vfil )
+ IF ( lchk ) STOP ! missing files
+
+ npiglo = getdim (cf_tfil, cn_x)
+ npjglo = getdim (cf_tfil, cn_y)
+ npk = getdim (cf_tfil, cn_z)
+ npt = getdim (cf_tfil, cn_t)
+
+ ipk(1) = npk ! 3D
+ stypvar(1)%cname = cv_ric
+ stypvar(1)%cunits = 'no'
+ stypvar(1)%rmissing_value = rspval
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 50000.
+ stypvar(1)%clong_name = 'Richardson Number'
+ stypvar(1)%cshort_name = cv_ric
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npk =', npk
+ PRINT *, 'npt =', npt
+
+ ALLOCATE (ztemp(npiglo,npjglo,2), zsal(npiglo,npjglo,2) )
+ ALLOCATE (zu(npiglo,npjglo,2), zv(npiglo,npjglo,2) )
+ ALLOCATE (zwk(npiglo,npjglo,2), zmask(npiglo,npjglo) )
+ ALLOCATE (zri(npiglo,npjglo), e3w(npiglo,npjglo) )
+ ALLOCATE (gdep(npk), tim(npt) )
+ zwk(:,:,:) = rspval
+ zri(:,:) = rspval
+
+ IF ( lfull ) ALLOCATE (e3w1d(npk) )
+
+ cv_dep=cn_gdept
+ IF (l_w) cv_dep=cn_gdepw
+
+ gdep(:) = getvare3(cn_fzgr, cv_dep, npk)
+
+ ! create output fileset
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk)
+ ierr = createvar (ncout , stypvar, 1, ipk, id_varout, cdglobal=TRIM(cglobal))
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk, pdep=gdep)
+
+ zpi=ACOS(-1.)
+
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt,'T')
+
+ IF ( lfull ) e3w1d(:) = getvare3(cn_fzgr, cn_ve3w, npk)
+
+ gdep(:) = getvare3(cn_fzgr, cn_gdepw, npk)
+
+ DO jt=1,npt
+ ! 2 levels of T and S are required : iup,idown (with respect to W level)
+ ! Compute from bottom to top (for vertical integration)
+ ztemp(:,:,idown) = getvar(cf_tfil, cn_votemper, npk-1, npiglo, npjglo, ktime=jt)
+ zsal( :,:,idown) = getvar(cf_tfil, cn_vosaline, npk-1, npiglo, npjglo, ktime=jt)
+ zu( :,:,idown) = getvar(cf_ufil, cn_vozocrtx, npk-1, npiglo, npjglo, ktime=jt)
+ zv( :,:,idown) = getvar(cf_vfil, cn_vomecrty, npk-1, npiglo, npjglo, ktime=jt)
+
+ DO jk = npk-1, 2, -1
+ PRINT *,'level ',jk
+ zmask(:,:)=1.
+ ztemp(:,:,iup)= getvar(cf_tfil, cn_votemper, jk-1, npiglo, npjglo, ktime=jt)
+ WHERE(ztemp(:,:,idown) == 0 ) zmask = 0
+ zsal(:,:,iup) = getvar(cf_tfil, cn_vosaline, jk-1, npiglo, npjglo, ktime=jt)
+ zu( :,:,iup) = getvar(cf_ufil, cn_vozocrtx, jk-1, npiglo, npjglo, ktime=jt)
+ zv( :,:,iup) = getvar(cf_vfil, cn_vomecrty, jk-1, npiglo, npjglo, ktime=jt)
+
+
+ IF ( lfull ) THEN
+ e3w(:,:) = e3w1d(jk)
+ ELSE
+ e3w(:,:) = getvar(cn_fzgr, cv_e3w , jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+
+ zwk(:,:,iup) = eosbn2(ztemp, zsal, gdep(jk), e3w, npiglo, npjglo ,iup, idown)* zmask(:,:)
+
+ DO jj = 2, npjglo - 1
+ DO ji = 2, npiglo - 1
+ zcoef = 0.5 / e3w(ji,jj)
+ ! ! shear of horizontal velocity
+ zdku = zcoef * ( zu(ji-1,jj,iup ) + zu(ji,jj,iup ) &
+ & -zu(ji-1,jj,idown) - zu(ji,jj,idown ) )
+ zdkv = zcoef * ( zv(ji,jj-1,iup ) + zv(ji,jj,iup ) &
+ & -zv(ji,jj-1,idown) - zv(ji,jj,idown ) )
+ ! ! richardson number (minimum value set to zero)
+ zzri = zwk(ji,jj,iup) / ( zdku*zdku + zdkv*zdkv + 1.e-20 )
+ zwk(ji,jj,iup) = MAX( zzri, 0.e0 )
+ ENDDO
+ ENDDO
+
+ IF ( .NOT. l_w ) THEN
+ ! now put zri at T level (k )
+ WHERE ( zwk(:,:,idown) == 0 )
+ zri(:,:) = zwk(:,:,iup)
+ ELSEWHERE
+ zri(:,:) = 0.5 * ( zwk(:,:,iup) + zwk(:,:,idown) ) * zmask(:,:)
+ END WHERE
+ ELSE
+ zri(:,:) = zwk(:,:,iup)
+ ENDIF
+
+ WHERE ( zri < 0 .AND. zri /= rspval ) zri = rspval
+ ierr = putvar(ncout, id_varout(1), zri, jk, npiglo, npjglo, ktime=jt )
+ itmp = idown ; idown = iup ; iup = itmp
+
+ END DO ! loop to next level
+ END DO
+
+ ierr = closeout(ncout)
+
+END PROGRAM cdfrichardson
diff --git a/cdfrmsssh.f90 b/cdfrmsssh.f90
index 6d3587c..ea589b1 100644
--- a/cdfrmsssh.f90
+++ b/cdfrmsssh.f90
@@ -1,92 +1,143 @@
PROGRAM cdfrmsssh
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfrmsssh ***
+ !!======================================================================
+ !! *** PROGRAM cdfrmsssh ***
+ !!=====================================================================
+ !! ** Purpose : Compute the RMS of SSH, from the mean squared value.
!!
- !! ** Purpose: Compute RMS SSH
- !!
- !! ** Method: Try to avoid 3 d arrays
+ !! ** Method : Read gridT and gridT2 and compute rms
!!
- !! history :
- !! Original : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines Apr 2005 : use modules
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2004 : J.M. Molines : Original code
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, id_varout
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: u, u2, rms
- REAL(KIND=4) ,DIMENSION(1) :: timean
- CHARACTER(LEN=256) :: cfile ,cfile2 ,cfileout='rms.nc' !: file name
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output variable
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4), DIMENSION(1) :: ipko, id_varout ! output variable
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvbar, zvba2 ! mean and mean2 variable
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsdev ! standard deviation
+
+ CHARACTER(LEN=256) :: cf_in ! input mean file name
+ CHARACTER(LEN=256) :: cf_in2 ! input mean2 file name
+ CHARACTER(LEN=256) :: cf_out = 'rms.nc' ! output file name
+ CHARACTER(LEN=256) :: cv_in, cv_in2 ! input variable names
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+
+ TYPE(variable), DIMENSION(1) :: stypvaro ! output data structure
- TYPE(variable), DIMENSION(1) :: typvar !: structure for attribute
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- INTEGER :: ncout
- INTEGER :: istatus, ierr
+ cv_in = cn_sossheig
- !! Read command line
narg= iargc()
- IF ( narg /= 2 ) THEN
- PRINT *,' Usage : cdfrmsssh ''gridX gridX2'' '
- PRINT *,' Output on rms.nc , variable sossheig_rms '
+ IF ( narg < 2 ) THEN
+ PRINT *,' usage : cdfrmsssh T-file T2-file '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the standard deviation of the SSH from its'
+ PRINT *,' mean value and its mean square value. '
+ PRINT *,' '
+ PRINT *,' Note that what is computed in this program is stictly the'
+ PRINT *,' standard deviation. It is very often called RMS, which is'
+ PRINT *,' an abuse. It is the same only in the case of zero mean value.'
+ PRINT *,' However, for historical reason, the name of this tool, remains'
+ PRINT *,' unchanged: cdfrmsssh'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with mean values for SSH'
+ PRINT *,' T2-file : netcdf file with mean squared values for SSH'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_in)//'_rms, same unit than the input.'
+ PRINT *,' '
+ PRINT *,' SEA ALSO :'
+ PRINT *,' cdfstd, cdfstdevw, cdfstdevts.'
STOP
ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
- CALL getarg (2, cfile2)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth')
-
- ipk(1) = 1
- typvar(1)%name= 'sossheig_rms'
- typvar(1)%units='m'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 100.
- typvar(1)%long_name='RMS_Sea_Surface_height'
- typvar(1)%short_name='sossheig_rms'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( u(npiglo,npjglo), u2(npiglo,npjglo) )
- ALLOCATE( rms(npiglo,npjglo) )
-
- ncout =create(cfileout, cfile,npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfile, npiglo, npjglo, npk)
-
- DO jk = 1, ipk(1)
- u(:,:) = getvar(cfile,'sossheig',jk, npiglo, npjglo)
- u2(:,:) = getvar(cfile2,'sossheig_sqd',jk, npiglo, npjglo)
-
- rms(:,:) = 0.
- DO ji=2, npiglo
- DO jj=2,npjglo
- rms(ji,jj) = SQRT((u2(ji,jj)-u(ji,jj)*u(ji,jj)))
- END DO
- END DO
- ierr=putvar(ncout,id_varout(1), rms, jk, npiglo, npjglo)
+
+ ijarg = 1 ; ireq = 0
+ DO WHILE ( ijarg <= narg)
+ CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
+ CASE DEFAULT
+ ireq = ireq + 1
+ SELECT CASE ( ireq )
+ CASE ( 1 ) ; cf_in = cldum
+ CASE ( 2 ) ; cf_in2 = cldum
+ CASE DEFAULT
+ PRINT *, ' Too many variables ' ; STOP
+ END SELECT
+ END SELECT
+ ENDDO
+
+ ! check existence of files
+ lchk = lchk .OR. chkfile(cf_in )
+ lchk = lchk .OR. chkfile(cf_in2 )
+ IF (lchk ) STOP ! missing file
+
+ npiglo = getdim (cf_in, cn_x)
+ npjglo = getdim (cf_in, cn_y)
+ npk = getdim (cf_in, cn_z)
+ npt = getdim (cf_in, cn_t)
+
+ ipko(1) = 1
+ stypvaro(1)%cname = TRIM(cv_in)//'_rms'
+ stypvaro(1)%cunits = 'm'
+ stypvaro(1)%rmissing_value = 0.
+ stypvaro(1)%valid_min = 0.
+ stypvaro(1)%valid_max = 100.
+ stypvaro(1)%clong_name = 'RMS_Sea_Surface_height'
+ stypvaro(1)%cshort_name = TRIM(cv_in)//'_rms'
+ stypvaro(1)%conline_operation = 'N/A'
+ stypvaro(1)%caxis = 'TYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE( zvbar(npiglo,npjglo), zvba2(npiglo,npjglo) )
+ ALLOCATE( dsdev(npiglo,npjglo), tim(npt) )
+
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvaro, 1, ipko, id_varout )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk )
+
+ cv_in2 = TRIM(cv_in)//'_sqd'
+ DO jt = 1, npt
+ zvbar(:,:) = getvar(cf_in, cv_in, 1, npiglo, npjglo, ktime=jt)
+ zvba2(:,:) = getvar(cf_in2, cv_in2, 1, npiglo, npjglo, ktime=jt)
+
+ dsdev(:,:) = SQRT ( DBLE(zvba2(:,:) - zvbar(:,:)*zvbar(:,:)) )
+
+ ierr = putvar(ncout, id_varout(1), REAL(dsdev), 1, npiglo, npjglo, ktime=jt)
END DO
- timean=getvar1d(cfile,'time_counter',1)
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
+
+ tim = getvar1d(cf_in, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ ierr = closeout(ncout)
END PROGRAM cdfrmsssh
diff --git a/cdfsig0.f90 b/cdfsig0.f90
index 0338e6b..2b67c38 100644
--- a/cdfsig0.f90
+++ b/cdfsig0.f90
@@ -1,112 +1,123 @@
PROGRAM cdfsig0
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfsig0 ***
+ !!======================================================================
+ !! *** PROGRAM cdfsig0 ***
+ !!=====================================================================
+ !! ** Purpose : Compute sigma0 3D field from gridT file
+ !! Store the results on a 'similar' cdf file.
!!
- !! ** Purpose: Compute sigma0 3D field from gridT file
- !! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: Try to avoid 3 d arrays
+ !! ** Method : Use NEMO equation of state
!!
- !! history:
- !! Original : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines Apr 2005 : use modules
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2006 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk, npt !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal ,& !: Array to read a layer of data
- & zsig0 , & !: potential density (sig-0)
- & zmask !: 2D mask at current level
- REAL(KIND=4),DIMENSION(:),ALLOCATABLE :: tim
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='sig0.nc' !:
-
- TYPE(variable) , DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: ncout
- INTEGER :: istatus
- INTEGER, DIMENSION (2) :: ismin, ismax
- REAL(KIND=4) :: sigmin, sigmax
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfsig0 gridT '
- PRINT *,' Output on sig0.nc, variable vosigma0'
- STOP
- ENDIF
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npt = getdim (cfilet,'time')
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4) :: narg, iargc ! browse command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp ! temperature
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsal ! salinity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsig0 ! sigma-0
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
- ipk(:)= npk ! all variables (input and output are 3D)
- typvar(1)%name= 'vosigma0'
- typvar(1)%units='kg/m3'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.001
- typvar(1)%valid_max= 40.
- typvar(1)%long_name='Potential_density:sigma-0'
- typvar(1)%short_name='vosigma0'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
+ CHARACTER(LEN=256) :: cf_tfil ! input filename
+ CHARACTER(LEN=256) :: cf_out='sig0.nc' ! output file name
+ TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'npt =', npt
+ narg = iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfsig0 T-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute potential density (sigma-0) refered to the surface.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with temperature and salinity.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cn_vosigma0), ' ( kg/m3 - 1000 )'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfsigi'
+ STOP
+ ENDIF
- ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsig0(npiglo,npjglo) ,zmask(npiglo,npjglo))
- ALLOCATE (tim(npt))
+ CALL getarg (1, cf_tfil)
+ IF (chkfile(cf_tfil) ) STOP ! missing file
+
+ npiglo = getdim (cf_tfil, cn_x)
+ npjglo = getdim (cf_tfil, cn_y)
+ npk = getdim (cf_tfil, cn_z)
+ npt = getdim (cf_tfil, cn_t)
+
+ ipk(:) = npk ! all variables (input and output are 3D)
+ stypvar(1)%cname = cn_vosigma0
+ stypvar(1)%cunits = 'kg/m3'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = 0.001
+ stypvar(1)%valid_max = 40.
+ stypvar(1)%clong_name = 'Potential_density:sigma-0'
+ stypvar(1)%cshort_name = cn_vosigma0
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE (ztemp(npiglo,npjglo), zsal (npiglo,npjglo) )
+ ALLOCATE (zsig0(npiglo,npjglo), zmask(npiglo,npjglo) )
+ ALLOCATE (tim(npt) )
! create output fileset
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,npk)
- tim=getvar1d(cfilet,'time_counter',npt)
- ierr=putvar1d(ncout,tim,npt,'T')
+ tim=getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr=putvar1d(ncout, tim, npt, 'T')
DO jt=1,npt
- PRINT *,' TIME = ', jt, tim(jt)/86400.,' days'
- DO jk = 1, npk
- zmask(:,:)=1.
+ PRINT *,' TIME = ', jt, tim(jt)/86400.,' days'
+ DO jk = 1, npk
+ zmask(:,:)=1.
- ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo,ktime=jt)
- zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo,ktime=jt)
+ ztemp(:,:)= getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt)
+ zsal(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt)
- WHERE(zsal == 0 ) zmask = 0
+ ! assuming spval is 0
+ WHERE( zsal == 0 ) zmask = 0
- zsig0(:,:) = sigma0 ( ztemp,zsal,npiglo,npjglo )* zmask(:,:)
-
-! sigmin=minval(zsig0(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
-! sigmax=maxval(zsig0(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
-! ismin= minloc(zsig0(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
-! ismax= maxloc(zsig0(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
-! PRINT *,'Level ',jk,': min = ', sigmin,' at ', ismin(1), ismin(2)
-! PRINT *,' : max = ', sigmax,' at ', ismax(1), ismax(2)
+ zsig0(:,:) = sigma0 (ztemp, zsal, npiglo, npjglo )* zmask(:,:)
- ierr = putvar(ncout, id_varout(1) ,zsig0, jk,npiglo, npjglo,ktime=jt)
+ ierr = putvar(ncout, id_varout(1), zsig0, jk, npiglo, npjglo, ktime=jt)
- END DO ! loop to next level
+ END DO ! loop to next level
END DO ! next time frame
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
+
END PROGRAM cdfsig0
diff --git a/cdfsigi.f90 b/cdfsigi.f90
index 2dc0197..2487f14 100644
--- a/cdfsigi.f90
+++ b/cdfsigi.f90
@@ -1,121 +1,132 @@
PROGRAM cdfsigi
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfsigi ***
- !!
- !! ** Purpose: Compute sigmai 3D field from gridT file
+ !!======================================================================
+ !! *** PROGRAM cdfsigi ***
+ !!=====================================================================
+ !! ** Purpose : Compute sigmai 3D field from gridT file
!! Store the results on a 'similar' cdf file.
- !!
+ !!
!! ** Method: read temp and salinity, compute sigma-i
!! using depth given in argument (meters or dbar)
- !!
- !! history:
- !! Original : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines Apr 2005 : use modules
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+
+ !! History : 2.0 : 11/2004 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk , jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk, npt !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal ,& !: Array to read a layer of data
- & zsigi , & !: potential density (sig-i)
- & zmask !: 2D mask at current level
- REAL(KIND=4),DIMENSION(:),ALLOCATABLE :: tim
- REAL(KIND=4) :: prof=0.! in meters
- REAL(KIND=4) :: spval !: missing value
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='sigi.nc' !:
- CHARACTER(LEN=256) :: cdum
-
- TYPE(variable) , DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: ncout
- INTEGER :: istatus
- INTEGER, DIMENSION (2) :: ismin, ismax
- REAL(KIND=4) :: sigmin, sigmax
-
- !! Read command line
- narg= iargc()
+
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4) :: narg, iargc ! browse command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's
+
+ REAL(KIND=4) :: ref_dep ! reference depth in meters
+ REAL(KIND=4) :: zspval ! missing value
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp ! temperature
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsal ! salinity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsigi ! sigma-i
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ CHARACTER(LEN=256) :: cf_tfil ! input filename
+ CHARACTER(LEN=256) :: cf_out='sigi.nc'! output file name
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfsigi gridT Ref_dep(m)'
- PRINT *,' Output on sigi.nc, variable vosigmai'
+ PRINT *,' usage : cdfsigi T-file Ref-dep(m) '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute potential density refered to the depth given in arguments.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with temperature and salinity'
+ PRINT *,' Ref-dep : reference depth in meter.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cn_vosigmai),' (kg/m3 -1000 )'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfsig0'
+ PRINT *,' '
STOP
ENDIF
- CALL getarg (1, cfilet)
- CALL getarg (2, cdum)
- READ(cdum,*) prof
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npt = getdim (cfilet,'time')
+ CALL getarg (1, cf_tfil)
+ CALL getarg (2, cldum) ; READ(cldum,*) ref_dep
+
+ IF ( chkfile(cf_tfil) ) STOP ! missing file
+
+ npiglo = getdim (cf_tfil, cn_x)
+ npjglo = getdim (cf_tfil, cn_y)
+ npk = getdim (cf_tfil, cn_z)
+ npt = getdim (cf_tfil, cn_t)
ipk(:)= npk ! all variables (input and output are 3D)
- typvar(1)%name= 'vosigmai'
- typvar(1)%units='kg/m3'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.001
- typvar(1)%valid_max= 45.
- typvar(1)%long_name='Potential_density:refered to '//TRIM(cdum)//' m'
- typvar(1)%short_name='vosigmai'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'npt =', npt
-
- ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsigi(npiglo,npjglo) ,zmask(npiglo,npjglo))
+ stypvar(1)%cname = cn_vosigmai
+ stypvar(1)%cunits = 'kg/m3'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = 0.001
+ stypvar(1)%valid_max = 45.
+ stypvar(1)%clong_name = 'Potential_density:refered to '//TRIM(cldum)//' m'
+ stypvar(1)%cshort_name = cn_vosigmai
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE (ztemp(npiglo,npjglo), zsal (npiglo,npjglo) )
+ ALLOCATE (zsigi(npiglo,npjglo), zmask(npiglo,npjglo) )
ALLOCATE (tim(npt) )
! create output fileset
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
+ zspval= getatt(cf_tfil, cn_vosaline, cn_missing_value)
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,npk)
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
- spval=getatt(cfilet,'vosaline','missing_value')
-
- tim=getvar1d(cfilet,'time_counter',npt)
- ierr=putvar1d(ncout,tim,npt,'T')
DO jt = 1, npt
PRINT *,'time: ',jt
- DO jk = 1, npk
- zmask(:,:)=1.
+ DO jk = 1, npk
+ zmask(:,:) = 1.
- ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo,ktime=jt)
- zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo,ktime=jt)
+ ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt)
+ zsal( :,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt)
- WHERE(zsal == spval ) zmask = 0
+ WHERE( zsal == zspval ) zmask = 0
- zsigi(:,:) = sigmai ( ztemp,zsal,prof,npiglo,npjglo )* zmask(:,:)
- IF ( npiglo /= 1 .AND. npjglo /= 1 ) THEN
- sigmin=minval(zsigi(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- sigmax=maxval(zsigi(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- ismin= minloc(zsigi(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- ismax= maxloc(zsigi(2:npiglo-1,2:npjglo-1) ,zmask(2:npiglo-1,2:npjglo-1)==1)
- PRINT *,'Level ',jk,': min = ', sigmin,' at ', ismin(1), ismin(2)
- PRINT *,' : max = ', sigmax,' at ', ismax(1), ismax(2)
- ENDIF
+ zsigi(:,:) = sigmai(ztemp, zsal, ref_dep, npiglo, npjglo )* zmask(:,:)
- ierr = putvar(ncout, id_varout(1) ,zsigi, jk,npiglo, npjglo,ktime=jt)
+ ierr = putvar(ncout, id_varout(1), zsigi, jk, npiglo, npjglo, ktime=jt)
- END DO ! loop to next level
+ END DO ! loop to next level
END DO ! loop on time
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
+
END PROGRAM cdfsigi
diff --git a/cdfsiginsitu.f90 b/cdfsiginsitu.f90
index 1efc63f..198e9da 100644
--- a/cdfsiginsitu.f90
+++ b/cdfsiginsitu.f90
@@ -1,110 +1,130 @@
PROGRAM cdfsiginsitu
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfsiginsitu ***
- !!
- !! ** Purpose: Compute sigmainsitu 3D field from gridT file
+ !!======================================================================
+ !! *** PROGRAM cdfsiginsitu ***
+ !!=====================================================================
+ !! ** Purpose : Compute sigma insitu 3D field from gridT file
!! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: read temp and salinity, compute sigmainsitu
- !! using depth given in argument (meters or dbar)
!!
- !! history:
- !! Original : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines Apr 2005 : use modules
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! ** Method: read temp and salinity, compute sigma insitu
+ !! using depth taken from input T file
+
+ !! History : 2.0 : 11/2004 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk,jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,npt !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- real(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal ,& !: Array to read a layer of data
- & zsigi , & !: potential density (sig-i)
- & zmask !: 2D mask at current level
- REAL(KIND=4),DIMENSION(:), ALLOCATABLE :: prof ,tim !: prof (m) and time (sec)
- REAL(KIND=4) :: spval !: missing value
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='siginsitu.nc' !:
- CHARACTER(LEN=256) :: cdum
-
- TYPE(variable) , DIMENSION(1) :: typvar !: structure for attributes
-
- INTEGER :: ncout
- INTEGER :: istatus
- INTEGER, DIMENSION (2) :: ismin, ismax
- REAL(KIND=4) :: sigmin, sigmax
-
- !! Read command line
- narg= iargc()
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4) :: narg, iargc ! browse command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's
+
+ REAL(KIND=4) :: zspval ! missing value
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp ! temperature
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsal ! salinity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zsigi ! sigma-insitu
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! 2D mask at current level
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept ! depth of T points
+
+ CHARACTER(LEN=256) :: cf_tfil ! input filename
+ CHARACTER(LEN=256) :: cf_out='siginsitu.nc' ! output file name
+
+ TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfsiginsitu gridT '
- PRINT *,' Output on siginsitu.nc, variable vosigmainsitu'
- PRINT *,' Depths are taken from input file '
+ PRINT *,' usage : cdfsiginsitu T-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute in situ density from temperature and salinity.'
+ PRINT *,' Depths are taken from input file.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with temperature and salinity.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : vosigmainsitu (kg/m3 -1000 )'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfsig0, cdfsigi '
+ PRINT *,' '
STOP
ENDIF
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npt = getdim (cfilet,'time')
-
- ipk(:)= npk ! all variables (input and output are 3D)
- typvar(1)%name= 'vosigmainsitu'
- typvar(1)%units='kg/m3'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.001
- typvar(1)%valid_max= 45.
- typvar(1)%long_name='in situ density '
- typvar(1)%short_name='vosigmainsitu'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
+ CALL getarg (1, cf_tfil)
+ IF ( chkfile(cf_tfil) ) STOP ! missing file
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'npt =', npt
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
- ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsigi(npiglo,npjglo) ,zmask(npiglo,npjglo))
- ALLOCATE (prof(npk) , tim(npt) )
+ ipk(:)= npk ! all variables (input and output are 3D)
+ stypvar(1)%cname = 'vosigmainsitu'
+ stypvar(1)%cunits = 'kg/m3'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = 0.001
+ stypvar(1)%valid_max = 45.
+ stypvar(1)%clong_name = 'in situ density'
+ stypvar(1)%cshort_name = 'vosigmainsitu'
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE (ztemp(npiglo,npjglo), zsal (npiglo,npjglo) )
+ ALLOCATE (zsigi(npiglo,npjglo), zmask(npiglo,npjglo) )
+ ALLOCATE (gdept(npk), tim(npt) )
! create output fileset
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
+ zspval = getatt(cf_tfil, cn_vosaline, 'missing_value')
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,npk)
- prof(:)=getvar1d(cfilet,'deptht',npk)
- tim=getvar1d(cfilet,'time_counter',npt)
- ierr=putvar1d(ncout,tim,npt,'T')
+ gdept = getvar1d(cf_tfil, cn_vdeptht, npk )
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
- spval=getatt(cfilet,'vosaline','missing_value')
- DO jt=1,npt
- PRINT *,'time ',jt, tim(jt)/86400.,' days'
+ DO jt = 1, npt
+ PRINT *,'time: ',jt
DO jk = 1, npk
- zmask(:,:)=1.
+ zmask(:,:) = 1.
- ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo, ktime=jt)
- zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo, ktime=jt)
+ ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt)
+ zsal( :,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt)
- WHERE(zsal == spval ) zmask = 0
+ WHERE( zsal == zspval ) zmask = 0
- zsigi(:,:) = sigmai ( ztemp,zsal,prof(jk),npiglo,npjglo )* zmask(:,:)
- ierr = putvar(ncout, id_varout(1) ,zsigi, jk,npiglo, npjglo,ktime=jt)
+ zsigi(:,:) = sigmai(ztemp, zsal, gdept(jk), npiglo, npjglo )* zmask(:,:)
+
+ ierr = putvar(ncout, id_varout(1), zsigi, jk, npiglo, npjglo, ktime=jt)
END DO ! loop to next level
- END DO ! loop to next time
+ END DO ! loop on time
+
+ ierr = closeout(ncout)
- istatus = closeout(ncout)
END PROGRAM cdfsiginsitu
diff --git a/cdfsigintegr.f90 b/cdfsigintegr.f90
index e9ea719..a5e3cd3 100644
--- a/cdfsigintegr.f90
+++ b/cdfsigintegr.f90
@@ -1,120 +1,200 @@
PROGRAM cdfsigintegr
- !! --------------------------------------------------------------
- !! *** PROGRAM cdfsigintegr ***
- !! ** Purpose: This program is used to integrate quantities between isopycnals
+ !!======================================================================
+ !! *** PROGRAM cdfsigintegr ***
+ !!=====================================================================
+ !! ** Purpose : This program is used to integrate quantities between
+ !! isopycnals
!!
- !! ** Method: Linear interpolation is used on the vertical to define
- !! the depth of the given isopycn.
- !! Then, the integral is performed from the top of the ocean down to the given
- !! isopycnal. Finaly, by making the difference between 2 isopycnals we obtain
- !! the required quantity.
+ !! ** Method : Linear interpolation is used on the vertical to define
+ !! the depth of the given isopycn.
+ !! Then, the integral is performed from the top of the ocean
+ !! down to the given isopycnal. Finaly, by making the
+ !! difference between 2 isopycnals we obtain the required
+ !! quantity.
!!
- !! ** Usage :
- !! cdfsigintegr 'rho file' 'scalar file (*)'
- !!
- !! * history:
- !! Original : J.M. Molines December 2007 (From cdfrhoproj )
- !! ---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- !! * Used modules
+ !! History : 2.1 : 12/2007 : J.M. Molines : Original code
+ !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local declaration
+ USE modcdfnames
+ USE modutils
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: npiglo, npjglo, npk, npkk ,npt ,nvars
- INTEGER :: narg, iargc
- INTEGER :: ji,jj,jk,jkk,jfich,k0, jvar
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(3) :: ipk, id_varout !: for output variables
- !
- REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d, alpha
- REAL(KIND=4), DIMENSION(:,:) , ALLOCATABLE :: v2d, e3, tmask, dum
- REAL(KIND=4), DIMENSION(:) , ALLOCATABLE :: zi, time_tag, h1d, gdepw
- REAL(KIND=4) :: spval=999999.
- REAL(KIND=4) :: spvalz=0.
- REAL(KIND=4), DIMENSION(:,:,:) , ALLOCATABLE :: zint
- REAL(KIND=8), DIMENSION(:,:,:) , ALLOCATABLE :: v2dint !: double precision for integration
-
- CHARACTER(LEN=256) :: cfilZI, cfildata, cfilRHOMOD, cvar, cfilout, ctype='T'
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: czvar !: temporary arry for variable name in file
- CHARACTER(LEN=256) :: coordzgr='mesh_zgr.nc' !: coordinates files
-
-
- TYPE(variable), DIMENSION(3) :: typvar !: structure for attributes
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typzvar !: structure for attributes
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: jiso, jfich ! dummy loop index
+ INTEGER(KIND=4) :: jvar ! dummy loop index
+ INTEGER(KIND=4) :: npiglo, npjglo ! domain size
+ INTEGER(KIND=4) :: npk, npt ! domain size
+ INTEGER(KIND=4) :: npiso, nvars ! number of isopycnals, variables
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: nfiles ! number of input files
+ INTEGER(KIND=4) :: istrt_arg ! argument number of first input file
+ INTEGER(KIND=4) :: ik0 ! layer index
+ INTEGER(KIND=4) :: ijk ! layer index
+ INTEGER(KIND=4) :: numin=10 ! logical unit for ascii input file
+ INTEGER(KIND=4) :: ncout, ierr ! ncid and status variable
+ INTEGER(KIND=4), DIMENSION(3) :: ipk, id_varout ! levels and id's of output variables
!
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: v3d ! 3D working array (npk)
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: zint ! pseudo 3D working array (2)
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! 2D working array
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3 ! vertical metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmask ! mask of t points from rho
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zdum ! dummy array for I/O
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: rho_lev ! value of isopycnals
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: h1d ! depth of rho points
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of W points
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics in full step
+ REAL(KIND=4) :: zspval=999999. ! output missing value
+ REAL(KIND=4) :: zspvalz ! missing value from rho file
+
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dv2dint ! interpolated value
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dalpha ! 3D coefficient (npiso)
+
+ CHARACTER(LEN=256) :: cf_rholev = 'rho_lev' ! input file for rho surfaces
+ CHARACTER(LEN=256) :: cf_in ! input file for data
+ CHARACTER(LEN=256) :: cf_rho ! input file for density
+ CHARACTER(LEN=256) :: cf_out ! output file
+ CHARACTER(LEN=256) :: cv_in ! name of input variable
+ CHARACTER(LEN=256) :: cldum ! dummy string variable
+ CHARACTER(LEN=256) :: cglobal ! global attribute
+ CHARACTER(LEN=256) :: ctype='T' ! position of variable on C grid
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! temporary arry for variable name in file
+
+ TYPE(variable), DIMENSION(3) :: stypvar ! structure for attributes
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypzvar ! structure for attributes
+
+ LOGICAL :: lfull = .FALSE. ! flag for full step
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! * Read command line
narg=iargc()
- IF (narg < 3 ) THEN
- PRINT *, &
- &' >>>> usage: cdfsigintegr <cvar> <rhofile> <file*> [ T | U | V | W ]'
- PRINT *,' Interpolated files will be file.nc.interp'
- PRINT *,' Isopycnal value are read on a text file ''rho_lev'' (minimum 2)'
- PRINT *,' cvar specify the name of the cdf variable to interpolate '
- PRINT *,' Model density are taken on file ''rhofile'' '
- PRINT *,' File is the netcdf file holding cvar '
- PRINT *,' Last argument is optional (T by default) and indicate the '
- PRINT *,' C-Grid point corresponding to file.'
- PRINT *,' cvar will be interpolated on T point previous projection on isopycnals'
- STOP
+ IF ( narg < 3 ) THEN
+ PRINT *,' usage : cdfsigintegr IN-var RHO-file list_of_files [ VAR-type ] ...'
+ PRINT *,' ... [ -sig sigma_name] [ -full ] '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Take a list of input files with specific IN-var variable, associated'
+ PRINT *,' with a reference density file. A set of isopycnal surfaces is defined'
+ PRINT *,' in an ASCII file (rho_lev by default), using same depth reference than'
+ PRINT *,' the input reference density file. This program computes the integral of'
+ PRINT *,' IN-var between the isopycnals defined in rho_lev. It also gives the '
+ PRINT *,' isopycnal depth and thickness of density layers.'
+ PRINT *,' '
+ PRINT *,' Rho_lev file first line indicates the number of following isopycnals.'
+ PRINT *,' Then a list of the densities is given, one per line.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-var : input variable to be integrated'
+ PRINT *,' RHO-file : netcdf file with already computed density'
+ PRINT *,' list_of_files : a list of model netcdf files containing IN-var.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ VAR-type ] : one of T U V F W which defined the position on'
+ PRINT *,' IN-var in the model C-grid. Default is ', TRIM(ctype)
+ PRINT *,' [ -sig sigma_name ] : give the name of sigma variable in RHO-file.'
+ PRINT *,' Default is ',TRIM(cn_vosigma0)
+ PRINT *,' [ -full ] : indicate a full step configuration.'
+ PRINT *,' [ -rholev file] : indicates name of file defining the limits for '
+ PRINT *,' integration. Default is ', TRIM(cf_rholev)
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fzgr),' and ',TRIM(cf_rholev)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : IN-file.integr'
+ PRINT *,' variables : inv_IN-var : inventory of IN-var from input file.'
+ PRINT *,' ', TRIM(cn_vodepiso),' (m) : depth of isopycnal.'
+ PRINT *,' ', TRIM(cn_isothick),' (m) : thickness of isopycnal layer.'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfrhoproj, cdfsigtrp, cdfisopycdep'
+ PRINT *,' '
+ STOP
ENDIF
- cfilZI='rho_lev'
- OPEN(10,file=cfilZI)
- READ(10,*) npkk
- ALLOCATE (zi(npkk) )
- DO jkk=1,npkk
- READ(10,*) zi(jkk)
- PRINT *,zi(jkk)
- END DO
- CLOSE(10)
-
- ! Seek for ctype (last argument either T U V or W )
- CALL getarg(narg,ctype)
- SELECT CASE ( ctype)
- CASE ( 'T','t','U','u','V','v','W','w' )
- narg = narg -1 ! last argument is not a file name
- CASE DEFAULT
- ctype='T'
- END SELECT
-
- ! Read variable name
- CALL getarg(1,cvar)
- ! Read Rho file
- CALL getarg(2,cfilRHOMOD)
- npiglo=getdim(cfilRHOMOD,'x')
- npjglo=getdim(cfilRHOMOD,'y')
- npk =getdim(cfilRHOMOD,'depth')
- npt =getdim(cfilRHOMOD,'time')
-
- spvalz=getspval(cfilRHOMOD,'vosigma0')
-
- CALL getarg(3, cfildata)
- nvars=getnvar(cfildata)
- ALLOCATE(czvar(nvars), typzvar(nvars))
-
- czvar(:)=getvarname(cfildata,nvars,typzvar)
-
- ALLOCATE( v3d(npiglo,npjglo,npk), alpha(npiglo, npjglo, npkk) ,e3(npiglo,npjglo) )
- ALLOCATE( v2dint(npiglo, npjglo,2), v2d(npiglo,npjglo), zint(npiglo,npjglo,2) )
- ALLOCATE( time_tag(npt), h1d(npk) ,gdepw(npk) ,tmask(npiglo,npjglo), dum(npiglo,npjglo) )
-
- gdepw(:) = getvare3(coordzgr,'gdepw', npk)
-
- time_tag(:)=getvar1d(cfilRHOMOD,'time_counter', npt)
- h1d(:)=getvar1d(cfilRHOMOD,'deptht',npk)
-
+
+ ijarg = 1 ; ireq = 0 ; nfiles = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg( ijarg, cldum ) ; ijarg = ijarg+1
+ SELECT CASE ( cldum )
+ CASE ( 'T','t','U','u','V','v','F','f','W','w' )
+ ctype=cldum
+ CASE ( '-sig ' )
+ CALL getarg( ijarg, cn_vosigma0) ; ijarg = ijarg+1
+ CASE ( '-rholev ')
+ CALL getarg( ijarg, cf_rholev ) ; ijarg = ijarg+1
+ CASE ( '-full ' )
+ lfull = .TRUE.
+ CASE DEFAULT
+ ireq=ireq+1
+ SELECT CASE ( ireq )
+ CASE ( 1 ) ; cv_in = cldum
+ CASE ( 2 ) ; cf_rho = cldum
+ CASE DEFAULT
+ nfiles=nfiles+1
+ IF ( nfiles == 1 ) istrt_arg = ijarg - 1
+ END SELECT
+ END SELECT
+ END DO
+
+ CALL SetGlobalAtt( cglobal )
+
+ ! check for files
+ lchk = lchk .OR. chkfile (cn_fzgr )
+ lchk = lchk .OR. chkfile (cf_rholev )
+ lchk = lchk .OR. chkfile (cf_rho )
+ IF ( lchk ) STOP ! missing file
+
+ ! Read rho level between which the integral is being performed
+ OPEN(numin,file=cf_rholev)
+ READ(numin,*) npiso
+ ALLOCATE (rho_lev(npiso) )
+ DO jiso=1,npiso
+ READ(numin,*) rho_lev(jiso)
+ PRINT *,rho_lev(jiso)
+ END DO
+ CLOSE(numin)
+
+ npiglo = getdim(cf_rho, cn_x)
+ npjglo = getdim(cf_rho, cn_y)
+ npk = getdim(cf_rho, cn_z)
+
+ zspvalz=getspval(cf_rho, cn_vosigma0)
+
+ CALL getarg(istrt_arg, cf_in)
+ IF ( chkfile ( cf_in ) ) STOP ! missing file
+
+ nvars=getnvar(cf_in)
+ ALLOCATE(cv_names(nvars), stypzvar(nvars))
+
+ cv_names(:)=getvarname(cf_in,nvars,stypzvar)
+
+ ALLOCATE( v3d(npiglo,npjglo,npk), dalpha(npiglo,npjglo,npiso), e3(npiglo,npjglo) )
+ ALLOCATE( dv2dint(npiglo,npjglo,2), v2d(npiglo,npjglo), zint(npiglo,npjglo,2) )
+ ALLOCATE( h1d(npk) ,gdepw(npk) ,tmask(npiglo,npjglo), zdum(npiglo,npjglo) )
+ IF ( lfull ) ALLOCATE ( e31d(npk) )
+
+ gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk)
+
+ IF (lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk)
+
+ h1d(:) = getvar1d(cf_rho, cn_vdeptht, npk)
+
! Note, if working with vertical slabs, one may avoid 3D array, but may be slow ...
tmask=1.
DO jk=1,npk
- v3d(:,:,jk) = getvar(cfilRHOMOD,'vosigma0',jk,npiglo,npjglo)
+ v3d(:,:,jk) = getvar(cf_rho, cn_vosigma0, jk, npiglo, npjglo)
IF ( jk == 1 ) THEN
- WHERE (v3d(:,:,jk) == spvalz ) tmask=0.
+ WHERE (v3d(:,:,jk) == zspvalz ) tmask=0.
ENDIF
END DO
@@ -122,160 +202,174 @@ PROGRAM cdfsigintegr
!! to interpolate between
DO ji=1,npiglo
DO jj = 1, npjglo
- jk = 1
- DO jkk=1,npkk
- ! Assume that rho (z) is increasing downward (no inversion)
- ! Caution with sigma0 at great depth !
- DO WHILE (zi(jkk) >= v3d(ji,jj,jk) .AND. jk <= npk &
- & .AND. v3d(ji,jj,jk) /= spvalz )
- jk=jk+1
+ ijk = 1
+ DO jiso=1,npiso
+ ! Assume that rho (z) is increasing downward (no inversion)
+ ! Caution with sigma0 at great depth !
+ DO WHILE (rho_lev(jiso) >= v3d(ji,jj,ijk) .AND. ijk <= npk &
+ & .AND. v3d(ji,jj,ijk) /= zspvalz )
+ ijk = ijk+1
END DO
- jk=jk-1
- k0=jk
- IF (jk .EQ. 0) THEN
- jk=1
- alpha(ji,jj,jkk) = 0.
- ELSE IF (v3d(ji,jj,jk+1) .EQ. spvalz ) THEN
- k0=0
- alpha(ji,jj,jkk) = 0.
+ ijk = ijk-1
+ ik0 = ijk
+ IF (ijk == 0) THEN
+ ijk = 1
+ dalpha(ji,jj,jiso) = 0.d0
+ ELSE IF (v3d(ji,jj,ijk+1) == zspvalz ) THEN
+ ik0 = 0
+ dalpha(ji,jj,jiso) = 0.d0
ELSE
- ! ... alpha is always in [0,1]. Adding k0 ( >=1 ) for saving space for k0
- alpha(ji,jj,jkk)= &
- & (zi(jkk)-v3d(ji,jj,jk))/(v3d(ji,jj,jk+1)-v3d(ji,jj,jk)) +k0
+ ! ... dalpha is always in [0,1]. Adding ik0 ( >=1 ) for saving space for ik0
+ dalpha(ji,jj,jiso)= (rho_lev(jiso)-v3d(ji,jj,ijk))/(v3d(ji,jj,ijk+1)-v3d(ji,jj,ijk)) + ik0
ENDIF
END DO
END DO
END DO
+ ! define header of all files
+ ipk(1)=npiso-1 ; ipk(2)=npiso-1 ; ipk(3)=npiso
+
+ DO jvar=1,nvars
+ IF ( cv_in == stypzvar(jvar)%cname ) THEN
+ stypvar(1)=stypzvar(jvar)
+ EXIT
+ ENDIF
+ END DO
+
+ stypvar(1)%cname = 'inv'//TRIM(stypvar(1)%cname)
+ stypvar(1)%clong_name = TRIM(stypvar(1)%clong_name)//' integrated on sigma bin'
+ stypvar(1)%cunits = TRIM(stypvar(1)%cunits)//'.m'
+ stypvar(1)%rmissing_value = zspval
+ stypvar(1)%caxis = 'TRYX'
+
+ stypvar(2)%cname = TRIM(cn_isothick)
+ stypvar(2)%cunits = 'm'
+ stypvar(2)%rmissing_value = zspval
+ stypvar(2)%valid_min = 0.
+ stypvar(2)%valid_max = 7000.
+ stypvar(2)%clong_name = 'Thickness_of_Isopycnals'
+ stypvar(2)%cshort_name = TRIM(cn_isothick)
+ stypvar(2)%conline_operation = 'N/A'
+ stypvar(2)%caxis = 'TRYX'
+
+ stypvar(3)%cname = TRIM(cn_vodepiso)
+ stypvar(3)%cunits = 'm'
+ stypvar(3)%rmissing_value = zspval
+ stypvar(3)%valid_min = 0.
+ stypvar(3)%valid_max = 7000.
+ stypvar(3)%clong_name = 'Depth_of_Isopycnals'
+ stypvar(3)%cshort_name = TRIM(cn_vodepiso)
+ stypvar(3)%conline_operation = 'N/A'
+ stypvar(3)%caxis = 'TRYX'
+
!! ** Loop on the scalar files to project on choosen isopycnics surfaces
- DO jfich=3,narg
+ DO jfich=istrt_arg, nfiles
- CALL getarg(jfich,cfildata)
- PRINT *,'working with ', TRIM(cfildata)
+ CALL getarg(jfich, cf_in)
+ IF ( chkfile (cf_in) ) STOP ! missing file
+ PRINT *,'working with ', TRIM(cf_in)
- IF (npt /= 1 ) THEN
- PRINT *,' This program has to be modified for multiple'
- PRINT *,' time frames.'
- STOP ' Error : npt # 1'
- ENDIF
-
- DO jk=1,npk
- v2d(:,:) = getvar(cfildata,cvar,jk,npiglo,npjglo)
- SELECT CASE ( ctype )
- CASE ('T', 't' )
- v3d(:,:,jk) = v2d(:,:)
- CASE ('U','u' )
- DO ji=2,npiglo
- DO jj=1, npjglo
- v3d(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji-1,jj) ) ! put variable on T point
+ ! create output file
+ cf_out=TRIM(cf_in)//'.integr'
+
+ ncout = create (cf_out, cf_rho, npiglo, npjglo, npiso )
+ ierr = createvar (ncout, stypvar, 3, ipk, id_varout, cdglobal=cglobal )
+ ierr = putheadervar(ncout, cf_rho, npiglo, npjglo, npiso, pdep=rho_lev )
+
+ ! copy time arrays in output file
+ npt = getdim ( cf_in, cn_t)
+ ALLOCATE ( tim(npt) )
+ tim(:) = getvar1d(cf_in, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ DEALLOCATE ( tim )
+
+ DO jt =1, npt
+ DO jk=1,npk
+ v2d(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime = jt )
+ SELECT CASE ( ctype )
+ CASE ('T', 't' )
+ v3d(:,:,jk) = v2d(:,:)
+ CASE ('U','u' )
+ DO jj=1,npjglo
+ DO ji=2, npiglo
+ v3d(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji-1,jj) ) ! put variable on T point
+ END DO
END DO
- END DO
- CASE ('V','v' )
- DO jj=2,npjglo
- DO ji=1, npiglo
- v3d(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji,jj-1) ) ! put variable on T point
+ CASE ('V','v' )
+ DO jj=2,npjglo
+ DO ji=1, npiglo
+ v3d(ji,jj,jk)=0.5*( v2d(ji,jj) + v2d(ji,jj-1) ) ! put variable on T point
+ END DO
END DO
- END DO
- CASE('W','w' )
- STOP 'Case W not done yet :( '
- END SELECT
- END DO
+ CASE('W','w' )
+ v3d(:,:,jk) = v2d(:,:)
+ v2d(:,:) = getvar(cf_in, cv_in, jk+1, npiglo, npjglo, ktime = jt )
+ v3d(:,:,jk) = 0.5 * ( v3d(:,:,jk) + v2d(:,:) )
+ CASE('F','f' )
+ DO jj = 2, npjglo
+ DO ji = 2, npiglo
+ v3d(:,:,jk) = 0.25*( v2d(ji,jj) + v2d( ji, jj-1) + v2d (ji-1,jj-1) + v2d(ji-1, jj) )
+ END DO
+ END DO
+ END SELECT
+ END DO
- ! ... open output file and write header
- ipk(1)=npkk-1
- ipk(2)=npkk-1
- ipk(3)=npkk
- DO jvar=1,nvars
- IF ( cvar == typzvar(jvar)%name ) THEN
- typvar(1)=typzvar(jvar)
- EXIT
- ENDIF
- END DO
- typvar(1)%name='inv'//TRIM(typvar(1)%name)
- typvar(1)%long_name=TRIM(typvar(1)%long_name)//' integrated on sigma bin'
- typvar(1)%units=TRIM(typvar(1)%units)//'.m'
- typvar(1)%missing_value=spval
- typvar(1)%axis='TRYX'
-
- typvar(2)%name= 'isothick'
- typvar(2)%units='m'
- typvar(2)%missing_value=spval
- typvar(2)%valid_min= 0.
- typvar(2)%valid_max= 7000.
- typvar(2)%long_name='Thickness_of_Isopycnals'
- typvar(2)%short_name='isothick'
- typvar(2)%online_operation='N/A'
- typvar(2)%axis='TRYX'
-
- typvar(3)%name= 'vodepiso'
- typvar(3)%units='m'
- typvar(3)%missing_value=spval
- typvar(3)%valid_min= 0.
- typvar(3)%valid_max= 7000.
- typvar(3)%long_name='Depth_of_Isopycnals'
- typvar(3)%short_name='vodepiso'
- typvar(3)%online_operation='N/A'
- typvar(3)%axis='TRYX'
-
-
- cfilout=TRIM(cfildata)//'.integr'
-
- ncout = create(cfilout,cfilRHOMOD ,npiglo,npjglo,npkk)
- ierr = createvar(ncout, typvar,3,ipk, id_varout )
- ierr = putheadervar(ncout , cfilRHOMOD, npiglo, npjglo, npkk,pdep=zi)
-
- ! Compute integral from surface to isopycnal
- DO jkk=1,npkk
- ! determine isopycnal surface
- DO ji=1,npiglo
- DO jj=1,npjglo
- ! k0 is retrieved from alpha, taking the integer part.
- k0=INT(alpha(ji,jj,jkk)) ; alpha(ji,jj,jkk) = alpha(ji,jj,jkk) - k0
- IF (k0 /= 0) THEN
- zint (ji,jj,1)=alpha(ji,jj,jkk)*h1d(k0+1) &
- & +(1-alpha(ji,jj,jkk))*h1d(k0)
- ELSE
- zint (ji,jj,1)=0. !spval !
- ENDIF
+ ! Compute integral from surface to isopycnal
+ DO jiso=1,npiso
+ ! determine isopycnal surface
+ DO ji=1,npiglo
+ DO jj=1,npjglo
+ ! ik0 is retrieved from dalpha, taking the integer part.
+ ik0=INT(dalpha(ji,jj,jiso)) ; dalpha(ji,jj,jiso) = dalpha(ji,jj,jiso) - ik0
+ IF (ik0 /= 0) THEN
+ zint (ji,jj,1)=dalpha(ji,jj,jiso)*h1d(ik0+1) + (1.d0-dalpha(ji,jj,jiso))*h1d(ik0)
+ ELSE
+ zint (ji,jj,1)=0. !zspval
+ ENDIF
+ END DO
END DO
- END DO
- ! integrate from jk=1 to zint
- v2dint(:,:,1) = 0.d0
-
- DO jk=1,npk-1
- ! get metrixs at level jk
- e3(:,:)=getvar(coordzgr,'e3t_ps',jk,npiglo,npjglo,ldiom=.true.)
- DO ji=1,npiglo
- DO jj=1,npjglo
- IF ( gdepw(jk)+e3(ji,jj) < zint(ji,jj,1) ) THEN ! full cell
- v2dint(ji,jj,1)=v2dint(ji,jj,1) + e3(ji,jj)* v3d(ji,jj,jk)
- ELSE IF (( zint(ji,jj,1) <= gdepw(jk)+e3(ji,jj) ) .AND. (zint(ji,jj,1) > gdepw(jk)) ) THEN
- v2dint(ji,jj,1)=v2dint(ji,jj,1)+ (zint(ji,jj,1) - gdepw(jk) )* v3d(ji,jj,jk)
- ELSE ! below the isopycnal
- ! do nothing for this i j point
+ ! integrate from jk=1 to zint
+ dv2dint(:,:,1) = 0.d0
+
+ DO jk=1,npk-1
+ ! get metrixs at level jk
+ IF ( lfull ) THEN
+ e3(:,:) = e31d(jk)
+ ELSE
+ e3(:,:)=getvar(cn_fzgr,'e3t_ps',jk,npiglo,npjglo,ldiom=.TRUE.)
ENDIF
- END DO
- END DO
- END DO ! end on vertical integral for isopynal jkk
- dum=zint(:,:,1)
+ DO ji=1,npiglo
+ DO jj=1,npjglo
+ IF ( gdepw(jk)+e3(ji,jj) < zint(ji,jj,1) ) THEN ! full cell
+ dv2dint(ji,jj,1)=dv2dint(ji,jj,1) + e3(ji,jj)* v3d(ji,jj,jk)
+ ELSE IF (( zint(ji,jj,1) <= gdepw(jk)+e3(ji,jj) ) .AND. (zint(ji,jj,1) > gdepw(jk)) ) THEN
+ dv2dint(ji,jj,1)=dv2dint(ji,jj,1)+ (zint(ji,jj,1) - gdepw(jk) )* v3d(ji,jj,jk)
+ ELSE ! below the isopycnal
+ ! do nothing for this i j point
+ ENDIF
+ END DO
+ END DO
+ END DO ! end on vertical integral for isopynal jiso
+
+ zdum=zint(:,:,1)
- WHERE (tmask == 0. ) dum=spval
- ierr = putvar(ncout,id_varout(3), dum ,jkk,npiglo,npjglo)
+ WHERE (tmask == 0. ) zdum=zspval
+ ierr = putvar(ncout,id_varout(3), zdum, jiso, npiglo, npjglo, ktime=jt )
- IF (jkk > 1 ) THEN ! compute the difference ie the inventory in the layer between 2 isopycnals
- dum=v2dint(:,:,1) - v2dint(:,:,2) ; WHERE ((tmask == 0.) .OR. (dum < 0 ) ) dum = spval
- ierr = putvar(ncout,id_varout(1), dum,jkk-1,npiglo,npjglo)
+ IF (jiso > 1 ) THEN ! compute the difference ie the inventory in the layer between 2 isopycnals
+ zdum=dv2dint(:,:,1) - dv2dint(:,:,2) ; WHERE ((tmask == 0.) .OR. (zdum < 0 ) ) zdum = zspval
+ ierr = putvar(ncout, id_varout(1), zdum, jiso-1, npiglo, npjglo, ktime=jt)
- dum=zint (:,:,1) - zint (:,:,2) ; WHERE ((tmask == 0.) .OR. (dum < 0 ) ) dum = spval
- ierr = putvar(ncout,id_varout(2), dum,jkk-1,npiglo,npjglo)
- ENDIF
- v2dint(:,:,2)=v2dint(:,:,1)
- zint (:,:,2)=zint (:,:,1)
-
+ zdum=zint (:,:,1) - zint (:,:,2) ; WHERE ((tmask == 0.) .OR. (zdum < 0 ) ) zdum = zspval
+ ierr = putvar(ncout, id_varout(2), zdum, jiso-1, npiglo, npjglo, ktime=jt)
+ ENDIF
+ dv2dint(:,:,2) = dv2dint(:,:,1)
+ zint (:,:,2) = zint (:,:,1)
+
+ END DO
END DO
- ierr = putvar1d(ncout,time_tag,1,'T')
ierr = closeout(ncout)
END DO ! loop on scalar files
- PRINT *,' integral between isopycnals completed successfully'
+ PRINT *,' integral between isopycnals completed successfully'
END PROGRAM cdfsigintegr
diff --git a/cdfsigitrp.f90 b/cdfsigitrp.f90
deleted file mode 100644
index 5805204..0000000
--- a/cdfsigitrp.f90
+++ /dev/null
@@ -1,461 +0,0 @@
-PROGRAM cdfsigitrp
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfsigitrp ***
- !!
- !! ** Purpose: Compute density class Mass Transports across a section
- !! using potential density, refered to a particular depth
- !! PARTIAL STEPS version
- !!
- !! ** Method:
- !! -The begining and end point of the section are given in term of f-points index.
- !! -The program works for zonal or meridional sections.
- !! -The section definitions are given in an ASCII FILE dens_section.dat
- !! foreach sections, 2 lines : (i) : section name (String, no blank)
- !! (ii) : imin imax jmin jmax for the section
- !! -Only vertical slices corrsponding to the sections are read in the files.
- !! read metrics, depth, etc
- !! read normal velocity (either vozocrtx oy vomecrty )
- !! read 2 rows of T and S ( i i+1 or j j+1 )
- !! compute the mean value at velocity point
- !! compute sigmai (reference depth is given as argument).
- !! compute the depths of isopycnal surfaces
- !! compute the transport from surface to the isopycn
- !! compute the transport in each class of density
- !! compute the total transport (for information)
- !!
- !! history :
- !! Original : J.M. Molines March 2006
- !! Original : P. Mathiot 2008 from cdfsigtrp
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nbins !: number of density classes
- INTEGER :: ji, jk, jclass, jsec,jiso , jbin,jarg !: dummy loop index
- INTEGER :: ipos !: working variable
- INTEGER :: narg, iargc, nxtarg !: command line
- INTEGER :: npk, nk !: vertical size, number of wet layers in the section
- INTEGER :: numbimg=10 !: optional bimg logical unit
- INTEGER :: numout=11 !: ascii output
-
- INTEGER :: nsection !: number of sections (overall)
- INTEGER ,DIMENSION(:), ALLOCATABLE :: imina, imaxa, jmina, jmaxa !: sections limits
- INTEGER :: imin, imax, jmin, jmax !: working section limits
- INTEGER :: npts !: working section number of h-points
-
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdept, gdepw !: depth of T and W points
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zs, zt !: salinity and temperature from file
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: tmpm, tmpz !: temporary arrays
-
- ! double precision for cumulative variables and densities
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: eu !: either e1v or e2u
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zu, e3 , zmask !: velocities e3 and umask
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zsig ,gdepu !: density, depth of vel points
- REAL(KIND=8) :: sigma_min, sigma_max,dsigma !: Min and Max for sigma bining
- REAL(KIND=8) :: sigma,zalfa !: current working sigma
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: sigma_lev !: built array with sigma levels
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: hiso !: depth of isopycns
- REAL(KIND=4) :: rdep !: dpeth ref
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwtrp, zwtrpbin, trpbin !: transport arrays
-
- CHARACTER(LEN=256), DIMENSION (:), ALLOCATABLE :: csection !: section name
- CHARACTER(LEN=256) :: cfilet, cfileu, cfilev, cfilesec='dens_section.dat' !: files name
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc' !: coordinates files
- CHARACTER(LEN=256) :: cfilout='trpsig.txt' !: output file
- CHARACTER(LEN=256) :: cdum !: dummy string
-
- LOGICAL :: l_merid !: flag is true for meridional working section
- LOGICAL :: l_print=.FALSE. !: flag for printing additional results
- LOGICAL :: l_bimg=.FALSE. !: flag for bimg output
-
- !! * Initialisations
-
- ! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 6 ) THEN
- PRINT *,' Usage : cdfsigitrp gridTfile gridUfile gridVfile sigma_min sigma_max nbins zref [options]'
- PRINT *,' sigma_min, sigma_max : limit for density bining '
- PRINT *,' nbins : number of bins to use '
- PRINT *, ' zref : depth of sigmai'
- PRINT *,' Possible options :'
- PRINT *,' -print :additional output is send to std output'
- PRINT *,' -bimg : 2D (x=lat/lon, y=sigma) output on bimg file for hiso, cumul trp, trp'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in the current directory'
- PRINT *,' File section.dat must also be in the current directory '
- PRINT *,' Output on trpsig.txt and on standard output '
- STOP
- ENDIF
-
- !! Read arguments
- CALL getarg (1, cfilet)
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
- CALL getarg (4,cdum) ; READ(cdum,*) sigma_min
- CALL getarg (5,cdum) ; READ(cdum,*) sigma_max
- CALL getarg (6,cdum) ; READ(cdum,*) nbins
- CALL getarg (7,cdum) ; READ(cdum,*) rdep
- DO jarg=8, narg
- CALL getarg(jarg,cdum)
- SELECT CASE (cdum)
- CASE ('-print' )
- l_print = .TRUE.
- CASE ('-bimg')
- l_bimg = .TRUE.
- CASE DEFAULT
- PRINT *,' Unknown option ', TRIM(cdum),' ... ignored'
- END SELECT
- END DO
-
- ! Initialise sections from file
- ! first call to get nsection and allocate arrays
- nsection = 0 ; CALL section_init(cfilesec, csection,imina,imaxa,jmina,jmaxa, nsection)
- ALLOCATE ( csection(nsection), imina(nsection), imaxa(nsection), jmina(nsection),jmaxa(nsection) )
- CALL section_init(cfilesec, csection,imina,imaxa,jmina,jmaxa, nsection)
-
- ! Allocate and build sigma levels and section array
- ALLOCATE ( sigma_lev (nbins+1) , trpbin(nsection,nbins) )
-
- sigma_lev(1)=sigma_min
- dsigma=( sigma_max - sigma_min) / nbins
- DO jclass =2, nbins+1
- sigma_lev(jclass)= sigma_lev(1) + (jclass-1) * dsigma
- END DO
-
- ! Look for vertical size of the domain
- npk = getdim (cfilet,'depth')
- ALLOCATE ( gdept(npk), gdepw(npk) )
-
- ! read gdept, gdepw : it is OK even in partial cells, as we never use the bottom gdep
- gdept(:) = getvare3(coordzgr,'gdept', npk)
- gdepw(:) = getvare3(coordzgr,'gdepw', npk)
-
- !! * Main loop on sections
-
- DO jsec=1,nsection
- l_merid=.FALSE.
- imin=imina(jsec) ; imax=imaxa(jsec) ; jmin=jmina(jsec) ; jmax=jmaxa(jsec)
- IF (imin == imax ) THEN ! meridional section
- l_merid=.TRUE.
- npts=jmax-jmin
-
- ELSE IF ( jmin == jmax ) THEN ! zonal section
- npts=imax-imin
-
- ELSE
- PRINT *,' Section ',TRIM(csection(jsec)),' is neither zonal nor meridional :('
- PRINT *,' We skip this section .'
- CYCLE
- ENDIF
-
- ALLOCATE ( zu(npts, npk), zt(npts,npk), zs(npts,npk) ,zsig(npts,0:npk) )
- ALLOCATE ( eu(npts), e3(npts,npk), gdepu(npts, npk), zmask(npts,npk) )
- ALLOCATE ( tmpm(1,npts,2), tmpz(npts,1,2) )
- ALLOCATE ( zwtrp(npts, nbins+1) , hiso(npts,nbins+1), zwtrpbin(npts,nbins) )
-
- zt = 0. ; zs = 0. ; zu = 0. ; gdepu= 0. ; zmask = 0. ; zsig=0.d0
-
- IF (l_merid ) THEN ! meridional section at i=imin=imax
- tmpm(:,:,1)=getvar(coordhgr, 'e2u', 1,1,npts, kimin=imin, kjmin=jmin+1)
- eu(:)=tmpm(1,:,1) ! metrics varies only horizontally
- DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (PS case)
- tmpm(:,:,1)=getvar(coordzgr,'e3u_ps',jk,1,npts, kimin=imin, kjmin=jmin+1, ldiom=.true.)
- e3(:,jk)=tmpm(1,:,1)
- tmpm(:,:,1)=getvar(coordzgr,'e3w_ps',jk,1,npts, kimin=imin, kjmin=jmin+1, ldiom=.true.)
- tmpm(:,:,2)=getvar(coordzgr,'e3w_ps',jk,1,npts, kimin=imin+1, kjmin=jmin+1, ldiom=.true.)
- IF (jk >= 2 ) THEN
- DO ji=1,npts
- gdepu(ji,jk)= gdepu(ji,jk-1) + MIN(tmpm(1,ji,1), tmpm(1,ji,2))
- END DO
- ENDIF
-
- ! Normal velocity
- tmpm(:,:,1)=getvar(cfileu,'vozocrtx',jk,1,npts, kimin=imin, kjmin=jmin+1)
- zu(:,jk)=tmpm(1,:,1)
-
- ! salinity and deduce umask for the section
- tmpm(:,:,1)=getvar(cfilet,'vosaline',jk,1,npts, kimin=imin , kjmin=jmin+1)
- tmpm(:,:,2)=getvar(cfilet,'vosaline',jk,1,npts, kimin=imin+1, kjmin=jmin+1)
- zmask(:,jk)=tmpm(1,:,1)*tmpm(1,:,2)
- WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
- ! do not take special care for land value, as the corresponding velocity point is masked
- zs(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) )
-
- ! limitation to 'wet' points
- IF ( SUM(zs(:,jk)) == 0 ) THEN
- nk=jk ! first vertical point of the section full on land
- EXIT ! as soon as all the points are on land
- ENDIF
-
- ! temperature
- tmpm(:,:,1)=getvar(cfilet,'votemper',jk,1,npts, kimin=imin, kjmin=jmin+1)
- tmpm(:,:,2)=getvar(cfilet,'votemper',jk,1,npts, kimin=imin+1, kjmin=jmin+1)
- zt(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) )
-
- END DO
-
- ELSE ! zonal section at j=jmin=jmax
- tmpz(:,:,1)=getvar(coordhgr, 'e1v', 1,npts,1,kimin=imin, kjmin=jmin)
- eu=tmpz(:,1,1)
- DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (PS case)
- tmpz(:,:,1)=getvar(coordzgr,'e3v_ps',jk, npts, 1, kimin=imin+1, kjmin=jmin, ldiom=.true.)
- e3(:,jk)=tmpz(:,1,1)
- tmpz(:,:,1)=getvar(coordzgr,'e3w_ps',jk,npts,1, kimin=imin+1, kjmin=jmin, ldiom=.true.)
- tmpz(:,:,2)=getvar(coordzgr,'e3w_ps',jk,npts,1, kimin=imin+1, kjmin=jmin+1, ldiom=.true.)
- IF (jk >= 2 ) THEN
- DO ji=1,npts
- gdepu(ji,jk)= gdepu(ji,jk-1) + MIN(tmpz(ji,1,1), tmpz(ji,1,2))
- END DO
- ENDIF
-
- ! Normal velocity
- tmpz(:,:,1)=getvar(cfilev,'vomecrty',jk,npts,1, kimin=imin+1, kjmin=jmin)
- zu(:,jk)=tmpz(:,1,1)
-
- ! salinity and mask
- tmpz(:,:,1)=getvar(cfilet,'vosaline',jk, npts, 1, kimin=imin+1, kjmin=jmin)
- tmpz(:,:,2)=getvar(cfilet,'vosaline',jk, npts, 1, kimin=imin+1, kjmin=jmin+1)
- zmask(:,jk)=tmpz(:,1,1)*tmpz(:,1,2)
- WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
- ! do not take special care for land value, as the corresponding velocity point is masked
- zs(:,jk) = 0.5 * ( tmpz(:,1,1) + tmpz(:,1,2) )
-
- ! limitation to 'wet' points
- IF ( SUM(zs(:,jk)) == 0 ) THEN
- nk=jk ! first vertical point of the section full on land
- EXIT ! as soon as all the points are on land
- ENDIF
-
- ! temperature
- tmpz(:,:,1)=getvar(cfilet,'votemper',jk, npts, 1, kimin=imin+1, kjmin=jmin)
- tmpz(:,:,2)=getvar(cfilet,'votemper',jk, npts, 1, kimin=imin+1, kjmin=jmin+1)
- zt(:,jk) = 0.5 * ( tmpz(:,1,1) + tmpz(:,1,2) )
- END DO
-
- ENDIF
-
- ! compute density only for wet points
- zsig(:,1:nk)=sigmai( zt, zs, rdep, npts, nk)*zmask(:,:)
- zsig(:,0)=zsig(:,1)-1.e-4 ! dummy layer for easy interpolation
-
- ! Some control print
- IF ( l_print ) THEN
- PRINT *,' T (deg C)'
- DO jk=1,nk
- PRINT 9000, jk, (zt(ji,jk),ji=1,npts)
- END DO
-
- PRINT *,' S (PSU)'
- DO jk=1,nk
- PRINT 9000, jk, (zs(ji,jk),ji=1,npts)
- END DO
-
- PRINT *,' SIG (kg/m3 - 1000 )'
- DO jk=1,nk
- PRINT 9000, jk, (zsig(ji,jk),ji=1,npts)
- END DO
-
- PRINT *,' VELOCITY (cm/s ) '
- DO jk=1,nk
- PRINT 9000, jk, (zu(ji,jk)*100,ji=1,npts)
- END DO
-
- PRINT *,' GDEPU (m) '
- DO jk=1,nk
- PRINT 9001,jk, (gdepu(ji,jk)*zmask(ji,jk),ji=1,npts)
- END DO
-
- PRINT *, 'E3 (m)'
- DO jk=1,nk
- PRINT 9001,jk, (e3(ji,jk)*zmask(ji,jk),ji=1,npts)
- END DO
- END IF
-
- ! compute depth of isopynals (nbins+1 )
- IF (l_print ) PRINT *,' DEP ISO ( m )'
- DO jiso =1, nbins+1
- sigma=sigma_lev(jiso)
-!!! REM : I and K loop can be inverted if necessary
- DO ji=1,npts
- hiso(ji,jiso) = gdept(npk)
- DO jk=1,nk
- IF ( zsig(ji,jk) < sigma ) THEN
- ELSE
- ! interpolate between jk-1 and jk
- zalfa=(sigma - zsig(ji,jk-1)) / ( zsig(ji,jk) -zsig(ji,jk-1) )
- IF (ABS(zalfa) > 1.1 ) THEN ! case zsig(0) = zsig(1)-1.e-4
- hiso(ji,jiso)= 0.
- ELSE
- hiso(ji,jiso)= gdepu(ji,jk)*zalfa + (1.-zalfa)* gdepu(ji,jk-1)
- ENDIF
- EXIT
- ENDIF
- END DO
- END DO
- IF (l_print) PRINT 9002, sigma,(hiso(ji,jiso),ji=1,npts)
- END DO
-
- ! compute transport between surface and isopycn
- IF (l_print) PRINT *,' TRP SURF --> ISO (SV)'
- DO jiso = 1, nbins + 1
- sigma=sigma_lev(jiso)
- DO ji=1,npts
- zwtrp(ji,jiso) = 0.d0
- DO jk=1, nk-1
- IF ( gdepw(jk+1) < hiso(ji,jiso) ) THEN
- zwtrp(ji,jiso)= zwtrp(ji,jiso) + eu(ji)*e3(ji,jk)*zu(ji,jk)
- ELSE ! last box ( fraction)
- zwtrp(ji,jiso)= zwtrp(ji,jiso) + eu(ji)*(hiso(ji,jiso)-gdepw(jk))*zu(ji,jk)
- EXIT ! jk loop
- ENDIF
- END DO
- END DO
- IF (l_print) PRINT 9003, sigma,(zwtrp(ji,jiso)/1.e6,ji=1,npts)
- END DO
-
- ! binned transport : difference between 2 isopycns
- IF (l_print) PRINT *,' TRP bins (SV)'
- DO jbin=1, nbins
- sigma=sigma_lev(jbin)
- DO ji=1, npts
- zwtrpbin(ji,jbin) = zwtrp(ji,jbin+1) - zwtrp(ji,jbin)
- END DO
- trpbin(jsec,jbin)=SUM(zwtrpbin(:,jbin) )
- IF (l_print) PRINT 9003, sigma,(zwtrpbin(ji,jbin)/1.e6,ji=1,npts), trpbin(jsec,jbin)/1.e6
- END DO
- PRINT *,' Total transport in all bins :',TRIM(csection(jsec)),' ',SUM(trpbin(jsec,:) )/1.e6
-
-
- ! output of the code for 1 section
- IF (l_bimg) THEN
- ! (along section, depth ) 2D variables
- cdum=TRIM(csection(jsec))//'_trpdep.bimg'
- OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED')
- cdum=' 3 dimensions in this isopycnal file '
- WRITE(numbimg) cdum
- cdum=' 1: T ; 2: S ; 3: sigma ; 4: Velocity '
- WRITE(numbimg) cdum
- WRITE(cdum,'(a,4i5.4)') ' from '//TRIM(csection(jsec)), imin,imax,jmin,jmax
- WRITE(numbimg) cdum
- cdum=' file '//TRIM(cfilet)
- WRITE(numbimg) cdum
- WRITE(numbimg) npts,nk,1,1,4,0
- WRITE(numbimg) 1.,-float(nk),1.,1., 0.
- WRITE(numbimg) 0.
- WRITE(numbimg) 0.
- ! temperature
- WRITE(numbimg) (( REAL(zt(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- ! salinity
- WRITE(numbimg) (( REAL(zs(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- ! sigma
- WRITE(numbimg) (( REAL(zsig(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- ! Velocity
- WRITE(numbimg) (( REAL(zu(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- CLOSE(numbimg)
-
- ! (along section, sigma ) 2D variables
- cdum=TRIM(csection(jsec))//'_trpsig.bimg'
- OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED')
- cdum=' 3 dimensions in this isopycnal file '
- WRITE(numbimg) cdum
- cdum=' 1: hiso ; 2: bin trp ; 3: cumulated trp '
- WRITE(numbimg) cdum
- WRITE(cdum,'(a,4i5.4)') ' from '//TRIM(csection(jsec)), imin,imax,jmin,jmax
- WRITE(numbimg) cdum
- cdum=' file '//TRIM(cfilet)
- WRITE(numbimg) cdum
- WRITE(numbimg) npts,nbins,1,1,3,0
- WRITE(numbimg) 1.,-REAL(sigma_lev(nbins)),1.,REAL(dsigma), 0.
- WRITE(numbimg) 0.
- WRITE(numbimg) 0.
- ! hiso
- WRITE(numbimg) (( REAL(hiso(ji,jiso)), ji=1,npts) , jiso=nbins,1,-1)
- ! binned transport
- WRITE(numbimg) (( REAL(zwtrpbin(ji,jiso))/1.e6, ji=1,npts) , jiso=nbins,1,-1)
- ! cumulated transport
- WRITE(numbimg) (( REAL(zwtrp(ji,jiso))/1.e6, ji=1,npts) , jiso=nbins,1,-1)
- CLOSE(numbimg)
- ENDIF
-
- ! free memory for the next section
- DEALLOCATE ( zu,zt, zs ,zsig ,gdepu, hiso, zwtrp, zwtrpbin )
- DEALLOCATE ( eu, e3 ,tmpm, tmpz,zmask )
-
- END DO ! next section
-
- !! Global Output
- OPEN( numout, FILE=cfilout)
- ipos=INDEX(cfilet,'_gridT.nc')
- WRITE(numout,9006) TRIM(cfilet(1:ipos-1))
- WRITE(numout,9005) ' sigma ', (csection(jsec),jsec=1,nsection)
- DO jiso=1,nbins
- WRITE(numout,9004) sigma_lev(jiso), (trpbin(jsec,jiso),jsec=1,nsection)
- ENDDO
- CLOSE(numout)
-
-9000 FORMAT(i7,25f8.3)
-9001 FORMAT(i7,25f8.0)
-9002 FORMAT(f7.3,25f8.0)
-9003 FORMAT(f7.3,25f8.3)
-9004 FORMAT(f9.4, 20e16.7)
-9005 FORMAT('#',a9, 20(2x,a12,2x) )
-9006 FORMAT('# ',a)
-
-CONTAINS
- SUBROUTINE section_init(cdfile,cdsection,kimin,kimax,kjmin,kjmax,knumber)
- IMPLICIT NONE
- ! Arguments
- INTEGER, INTENT(INOUT) :: knumber
- INTEGER, DIMENSION(knumber) :: kimin,kimax, kjmin,kjmax
- CHARACTER(LEN=256), DIMENSION(knumber) :: cdsection
- CHARACTER(LEN=*), INTENT(IN) :: cdfile
-
- ! Local variables
- INTEGER :: ii, numit=10, jsec
- CHARACTER(LEN=256) :: cline
- LOGICAL :: lfirst
-
- lfirst=.false.
- IF ( knumber == 0 ) lfirst=.true.
-
- OPEN(numit, FILE=cdfile)
- ii=0
-
- DO
- READ(numit,'(a)') cline
- IF (INDEX(cline,'EOF') == 0 ) THEN
- READ(numit,*) ! skip one line
- ii = ii + 1
- ELSE
- EXIT
- ENDIF
- END DO
-
- knumber=ii
- IF ( lfirst ) RETURN
- REWIND(numit)
- DO jsec=1,knumber
- READ(numit,'(a)') cdsection(jsec)
- READ(numit,*) kimin(jsec), kimax(jsec), kjmin(jsec), kjmax(jsec)
- END DO
-
- CLOSE(numit)
-
- END SUBROUTINE section_init
-
-
-END PROGRAM cdfsigitrp
diff --git a/cdfsigtrp-full.f90 b/cdfsigtrp-full.f90
deleted file mode 100644
index 18eed65..0000000
--- a/cdfsigtrp-full.f90
+++ /dev/null
@@ -1,449 +0,0 @@
-PROGRAM cdfsigtrp_full
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfsigtrp_full ***
- !!
- !! ** Purpose: Compute density class Mass Transports across a section
- !! FULL STEPS version
- !!
- !! ** Method:
- !! -The begining and end point of the section are given in term of f-points index.
- !! -The program works for zonal or meridional sections.
- !! -The section definitions are given in an ASCII FILE dens_section.dat
- !! foreach sections, 2 lines : (i) : section name (String, no blank)
- !! (ii) : imin imax jmin jmax for the section
- !! -Only vertical slices corrsponding to the sections are read in the files.
- !! read metrics, depth, etc
- !! read normal velocity (either vozocrtx oy vomecrty )
- !! read 2 rows of T and S ( i i+1 or j j+1 )
- !! compute the mean value at velocity point
- !! compute sigma0 (can be easily modified for sigmai )
- !! compute the depths of isopyncal surfaces
- !! compute the transport from surface to the isopycn
- !! compute the transport in each class of density
- !! compute the total transport (for information)
- !!
- !! history :
- !! Original : J.M. Molines March 2006
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nbins !: number of density classes
- INTEGER :: ji, jk, jclass, jsec,jiso , jbin,jarg !: dummy loop index
- INTEGER :: ipos !: working variable
- INTEGER :: narg, iargc, nxtarg !: command line
- INTEGER :: npk, nk !: vertical size, number of wet layers in the section
- INTEGER :: numbimg=10 !: optional bimg logical unit
- INTEGER :: numout=11 !: ascii output
-
- INTEGER :: nsection !: number of sections (overall)
- INTEGER ,DIMENSION(:), ALLOCATABLE :: imina, imaxa, jmina, jmaxa !: sections limits
- INTEGER :: imin, imax, jmin, jmax !: working section limits
- INTEGER :: npts !: working section number of h-points
-
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdept, gdepw !: depth of T and W points
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: e3t !: depth of T and W points
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zs, zt !: salinity and temperature from file
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: tmpm, tmpz !: temporary arrays
-
- ! double precision for cumulative variables and densities
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: eu !: either e1v or e2u
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zu, e3 , zmask !: velocities e3 and umask
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zsig ,gdepu !: density, depth of vel points
- REAL(KIND=8) :: sigma_min, sigma_max,dsigma !: Min and Max for sigma bining
- REAL(KIND=8) :: sigma,zalfa !: current working sigma
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: sigma_lev !: built array with sigma levels
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: hiso !: depth of isopycns
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwtrp, zwtrpbin, trpbin !: transport arrays
-
- CHARACTER(LEN=256), DIMENSION (:), ALLOCATABLE :: csection !: section name
- CHARACTER(LEN=256) :: cfilet, cfileu, cfilev, cfilesec='dens_section.dat' !: files name
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc' !: coordinates files
- CHARACTER(LEN=256) :: cfilout='trpsig.txt' !: output file
- CHARACTER(LEN=256) :: cdum !: dummy string
-
- LOGICAL :: l_merid !: flag is true for meridional working section
- LOGICAL :: l_print=.FALSE. !: flag for printing additional results
- LOGICAL :: l_bimg=.FALSE. !: flag for bimg output
-
- !! * Initialisations
-
- ! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 6 ) THEN
- PRINT '(255a)',' Usage : cdfsigtrp-full gridTfile gridUfile gridVfile sigma_min sigma_max nbins [options]'
- PRINT '(255a)',' sigma_min, sigma_max : limit for density bining '
- PRINT '(255a)',' nbins : number of bins to use '
- PRINT '(255a)',' Possible options :'
- PRINT '(255a)',' -print :additional output is send to std output'
- PRINT '(255a)',' -bimg : 2D (x=lat/lon, y=sigma) output on bimg file for hiso, cumul trp, trp'
- PRINT '(255a)',' Files mesh_hgr.nc, mesh_zgr.nc must be in the current directory'
- PRINT '(255a)',' File dens_section.dat must also be in the current directory '
- PRINT '(255a)',' Output on trpsig.txt'
- STOP
- ENDIF
-
- !! Read arguments
- CALL getarg (1, cfilet)
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
- CALL getarg (4,cdum) ; READ(cdum,*) sigma_min
- CALL getarg (5,cdum) ; READ(cdum,*) sigma_max
- CALL getarg (6,cdum) ; READ(cdum,*) nbins
-
- DO jarg=7, narg
- CALL getarg(jarg,cdum)
- SELECT CASE (cdum)
- CASE ('-print' )
- l_print = .TRUE.
- CASE ('-bimg')
- l_bimg = .TRUE.
- CASE DEFAULT
- PRINT *,' Unknown option ', TRIM(cdum),' ... ignored'
- END SELECT
- END DO
-
- ! Initialise sections from file
- nsection=section_number(cfilesec)
- ALLOCATE ( csection(nsection), imina(nsection), imaxa(nsection), jmina(nsection), jmaxa(nsection) )
- CALL section_init(cfilesec, csection,imina,imaxa,jmina,jmaxa, nsection)
-
- ! Allocate and build sigma levels and section array
- ALLOCATE ( sigma_lev (nbins+1) , trpbin(nsection,nbins) )
-
- sigma_lev(1)=sigma_min
- dsigma=( sigma_max - sigma_min) / nbins
- DO jclass =2, nbins+1
- sigma_lev(jclass)= sigma_lev(1) + (jclass-1) * dsigma
- END DO
-
- ! Look for vertical size of the domain
- npk = getdim (cfilet,'depth')
- ALLOCATE ( gdept(npk), gdepw(npk), e3t(npk) )
-
- ! read gdept, gdepw
- gdept(:) = getvare3(coordzgr, 'gdept',npk)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
- e3t(:) = getvare3(coordzgr, 'e3t',npk)
-
- !! * Main loop on sections
-
- write(*,*) 'nsection',nsection
- DO jsec=1,nsection
- l_merid=.FALSE.
- imin=imina(jsec) ; imax=imaxa(jsec) ; jmin=jmina(jsec) ; jmax=jmaxa(jsec)
- IF (imin == imax ) THEN ! meridional section
- l_merid=.TRUE.
- npts=jmax-jmin
-
- ELSE IF ( jmin == jmax ) THEN ! zonal section
- npts=imax-imin
-
- ELSE
- PRINT *,' Section ',TRIM(csection(jsec)),' is neither zonal nor meridional :('
- PRINT *,' We skip this section .'
- CYCLE
- ENDIF
-
- ALLOCATE ( zu(npts, npk), zt(npts,npk), zs(npts,npk) ,zsig(npts,0:npk) )
- ALLOCATE ( eu(npts), e3(npts,npk), gdepu(npts, npk), zmask(npts,npk) )
- ALLOCATE ( tmpm(1,npts,2), tmpz(npts,1,2) )
- ALLOCATE ( zwtrp(npts, nbins+1) , hiso(npts,nbins+1), zwtrpbin(npts,nbins) )
-
- zt = 0. ; zs = 0. ; zu = 0. ; gdepu= 0. ; zmask = 0. ; zsig=0.d0
-
- IF (l_merid ) THEN ! meridional section at i=imin=imax
- tmpm(:,:,1)=getvar(coordhgr, 'e2u', 1,1,npts, kimin=imin, kjmin=jmin+1)
- eu(:)=tmpm(1,:,1) ! metrics varies only horizontally
- DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (Full step )
- e3(:,jk)=e3t(jk)
-
- ! Normal velocity
- tmpm(:,:,1)=getvar(cfileu,'vozocrtx',jk,1,npts, kimin=imin, kjmin=jmin+1)
- zu(:,jk)=tmpm(1,:,1)
-
- ! salinity and deduce umask for the section
- tmpm(:,:,1)=getvar(cfilet,'vosaline',jk,1,npts, kimin=imin , kjmin=jmin+1)
- tmpm(:,:,2)=getvar(cfilet,'vosaline',jk,1,npts, kimin=imin+1, kjmin=jmin+1)
- zmask(:,jk)=tmpm(1,:,1)*tmpm(1,:,2)
- WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
- ! do not take special care for land value, as the corresponding velocity point is masked
- zs(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) )
-
- ! limitation to 'wet' points
- IF ( SUM(zs(:,jk)) == 0 ) THEN
- nk=jk ! first vertical point of the section full on land
- EXIT ! as soon as all the points are on land
- ENDIF
-
- ! temperature
- tmpm(:,:,1)=getvar(cfilet,'votemper',jk,1,npts, kimin=imin, kjmin=jmin+1)
- tmpm(:,:,2)=getvar(cfilet,'votemper',jk,1,npts, kimin=imin+1, kjmin=jmin+1)
- zt(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) )
-
- END DO
-
- ELSE ! zonal section at j=jmin=jmax
- tmpz(:,:,1)=getvar(coordhgr, 'e1v', 1,npts,1,kimin=imin, kjmin=jmin)
- eu=tmpz(:,1,1)
- DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (Full step case)
- e3(:,jk)=e3t(jk)
-
- ! Normal velocity
- tmpz(:,:,1)=getvar(cfilev,'vomecrty',jk,npts,1, kimin=imin+1, kjmin=jmin)
- zu(:,jk)=tmpz(:,1,1)
-
- ! salinity and mask
- tmpz(:,:,1)=getvar(cfilet,'vosaline',jk, npts, 1, kimin=imin+1, kjmin=jmin)
- tmpz(:,:,2)=getvar(cfilet,'vosaline',jk, npts, 1, kimin=imin+1, kjmin=jmin+1)
- zmask(:,jk)=tmpz(:,1,1)*tmpz(:,1,2)
- WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
- ! do not take special care for land value, as the corresponding velocity point is masked
- zs(:,jk) = 0.5 * ( tmpz(:,1,1) + tmpz(:,1,2) )
-
- ! limitation to 'wet' points
- IF ( SUM(zs(:,jk)) == 0 ) THEN
- nk=jk ! first vertical point of the section full on land
- EXIT ! as soon as all the points are on land
- ENDIF
-
- ! temperature
- tmpz(:,:,1)=getvar(cfilet,'votemper',jk, npts, 1, kimin=imin+1, kjmin=jmin)
- tmpz(:,:,2)=getvar(cfilet,'votemper',jk, npts, 1, kimin=imin+1, kjmin=jmin+1)
- zt(:,jk) = 0.5 * ( tmpz(:,1,1) + tmpz(:,1,2) )
- END DO
-
- ENDIF
-
- ! compute density only for wet points
- zsig(:,1:nk)=sigma0( zt, zs, npts, nk)*zmask(:,:)
- zsig(:,0)=zsig(:,1)-1.e-4 ! dummy layer for easy interpolation
-
- ! Some control print
- IF ( l_print ) THEN
- PRINT *,' T (deg C)'
- DO jk=1,nk
- PRINT 9000, jk, (zt(ji,jk),ji=1,npts)
- END DO
-
- PRINT *,' S (PSU)'
- DO jk=1,nk
- PRINT 9000, jk, (zs(ji,jk),ji=1,npts)
- END DO
-
- PRINT *,' SIG (kg/m3 - 1000 )'
- DO jk=1,nk
- PRINT 9000, jk, (zsig(ji,jk),ji=1,npts)
- END DO
-
- PRINT *,' VELOCITY (cm/s ) '
- DO jk=1,nk
- PRINT 9000, jk, (zu(ji,jk)*100,ji=1,npts)
- END DO
-
- PRINT *,' GDEPU (m) '
- DO jk=1,nk
- PRINT 9001,jk, (gdepu(ji,jk)*zmask(ji,jk),ji=1,npts)
- END DO
-
- PRINT *, 'E3 (m)'
- DO jk=1,nk
- PRINT 9001,jk, (e3(ji,jk)*zmask(ji,jk),ji=1,npts)
- END DO
- END IF
-
- ! compute depth of isopynals (nbins+1 )
- IF (l_print ) PRINT *,' DEP ISO ( m )'
- DO jiso =1, nbins+1
- sigma=sigma_lev(jiso)
-!!! REM : I and K loop can be inverted if necessary
- DO ji=1,npts
- hiso(ji,jiso) = gdept(npk)
- DO jk=1,nk
- IF ( zsig(ji,jk) < sigma ) THEN
- ELSE
- ! interpolate between jk-1 and jk
- zalfa=(sigma - zsig(ji,jk-1)) / ( zsig(ji,jk) -zsig(ji,jk-1) )
- IF (ABS(zalfa) > 1.1 ) THEN ! case zsig(0) = zsig(1)-1.e-4
- hiso(ji,jiso)= 0.
- ELSE
- hiso(ji,jiso)= gdepu(ji,jk)*zalfa + (1.-zalfa)* gdepu(ji,jk-1)
- ENDIF
- EXIT
- ENDIF
- END DO
- END DO
- IF (l_print) PRINT 9002, sigma,(hiso(ji,jiso),ji=1,npts)
- END DO
-
- ! compute transport between surface and isopycn
- IF (l_print) PRINT *,' TRP SURF --> ISO (SV)'
- DO jiso = 1, nbins + 1
- sigma=sigma_lev(jiso)
- DO ji=1,npts
- zwtrp(ji,jiso) = 0.d0
- DO jk=1, nk
- IF ( gdepw(jk+1) < hiso(ji,jiso) ) THEN
- zwtrp(ji,jiso)= zwtrp(ji,jiso) + eu(ji)*e3(ji,jk)*zu(ji,jk)
- ELSE ! last box ( fraction)
- zwtrp(ji,jiso)= zwtrp(ji,jiso) + eu(ji)*(hiso(ji,jiso)-gdepw(jk))*zu(ji,jk)
- EXIT ! jk loop
- ENDIF
- END DO
- END DO
- IF (l_print) PRINT 9003, sigma,(zwtrp(ji,jiso)/1.e6,ji=1,npts)
- END DO
-
- ! binned transport : difference between 2 isopycns
- IF (l_print) PRINT *,' TRP bins (SV)'
- DO jbin=1, nbins
- sigma=sigma_lev(jbin)
- DO ji=1, npts
- zwtrpbin(ji,jbin) = zwtrp(ji,jbin+1) - zwtrp(ji,jbin)
- END DO
- trpbin(jsec,jbin)=SUM(zwtrpbin(:,jbin) )
- IF (l_print) PRINT 9003, sigma,(zwtrpbin(ji,jbin)/1.e6,ji=1,npts), trpbin(jsec,jbin)/1.e6
- END DO
- PRINT *,' Total transport in all bins :',TRIM(csection(jsec)),' ',SUM(trpbin(jsec,:) )/1.e6
-
-
- ! output of the code for 1 section
- IF (l_bimg) THEN
- ! (along section, depth ) 2D variables
- cdum=TRIM(csection(jsec))//'_trpdep.bimg'
- OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED')
- cdum=' 3 dimensions in this isopycnal file '
- WRITE(numbimg) cdum
- cdum=' 1: T ; 2: S ; 3: sigma ; 4: Velocity '
- WRITE(numbimg) cdum
- WRITE(cdum,'(a,4i5.4)') ' from '//TRIM(csection(jsec)), imin,imax,jmin,jmax
- WRITE(numbimg) cdum
- cdum=' file '//TRIM(cfilet)
- WRITE(numbimg) cdum
- WRITE(numbimg) npts,nk,1,1,4,0
- WRITE(numbimg) 1.,-float(nk),1.,1., 0.
- WRITE(numbimg) 0.
- WRITE(numbimg) 0.
- ! temperature
- WRITE(numbimg) (( REAL(zt(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- ! salinity
- WRITE(numbimg) (( REAL(zs(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- ! sigma
- WRITE(numbimg) (( REAL(zsig(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- ! Velocity
- WRITE(numbimg) (( REAL(zu(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- CLOSE(numbimg)
-
- ! (along section, sigma ) 2D variables
- cdum=TRIM(csection(jsec))//'_trpsig.bimg'
- OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED')
- cdum=' 3 dimensions in this isopycnal file '
- WRITE(numbimg) cdum
- cdum=' 1: hiso ; 2: bin trp '
- WRITE(numbimg) cdum
- WRITE(cdum,'(a,4i5.4)') ' from '//TRIM(csection(jsec)), imin,imax,jmin,jmax
- WRITE(numbimg) cdum
- cdum=' file '//TRIM(cfilet)
- WRITE(numbimg) cdum
- WRITE(numbimg) npts,nbins,1,1,2,0
- WRITE(numbimg) 1.,-REAL(sigma_lev(nbins)),1.,REAL(dsigma), 0.
- WRITE(numbimg) 0.
- WRITE(numbimg) 0.
- ! hiso
- WRITE(numbimg) (( REAL(hiso(ji,jiso)), ji=1,npts) , jiso=nbins,1,-1)
- ! binned transport
- WRITE(numbimg) (( REAL(zwtrpbin(ji,jiso))/1.e6, ji=1,npts) , jiso=nbins,1,-1)
- CLOSE(numbimg)
- ENDIF
-
- ! free memory for the next section
- DEALLOCATE ( zu,zt, zs ,zsig ,gdepu, hiso, zwtrp, zwtrpbin )
- DEALLOCATE ( eu, e3 ,tmpm, tmpz,zmask )
-
- END DO ! next section
-
- !! Global Output
- OPEN( numout, FILE=cfilout)
- ipos=INDEX(cfilet,'_gridT.nc')
- WRITE(numout,9006) TRIM(cfilet(1:ipos-1))
- WRITE(numout,9005) ' sigma ', (csection(jsec),jsec=1,nsection)
- DO jiso=1,nbins
- WRITE(numout,9004) sigma_lev(jiso), (trpbin(jsec,jiso),jsec=1,nsection)
- ENDDO
- CLOSE(numout)
-
-9000 FORMAT(i7,40f8.3)
-9001 FORMAT(i7,40f8.0)
-9002 FORMAT(f7.3,40f8.0)
-9003 FORMAT(f7.3,40f8.3)
-9004 FORMAT(f9.4, 40e16.7)
-9005 FORMAT('#',a9, 40(2x,a12,2x) )
-9006 FORMAT('# ',a)
-
-CONTAINS
- FUNCTION section_number ( cdfile)
- ! Arguments
- CHARACTER(LEN=*), INTENT(IN) :: cdfile
- INTEGER :: section_number
-
- ! Local variables
- INTEGER :: ii, numit=10, jsec
- CHARACTER(LEN=256) :: cline
-
- OPEN(numit, FILE=cdfile)
- ii=0
- DO
- READ(numit,'(a)') cline
- IF (INDEX(cline,'EOF') == 0 ) THEN
- READ(numit,*) ! skip one line
- ii = ii + 1
- ELSE
- section_number=ii
- EXIT
- ENDIF
- END DO
-
- END FUNCTION section_number
-
- SUBROUTINE section_init(cdfile,cdsection,kimin,kimax,kjmin,kjmax,knumber)
- IMPLICIT NONE
- ! Arguments
- INTEGER, DIMENSION(:) :: kimin,kimax, kjmin,kjmax
- INTEGER, INTENT(IN) :: knumber
- CHARACTER(LEN=256), DIMENSION(:) :: cdsection
- CHARACTER(LEN=*), INTENT(IN) :: cdfile
-
- ! Local variables
- INTEGER :: ii, numit=10, jsec
- CHARACTER(LEN=256) :: cline
-
- OPEN(numit, FILE=cdfile)
- REWIND(numit)
-
- DO jsec=1,knumber
- READ(numit,'(a)') cdsection(jsec)
- READ(numit,*) kimin(jsec), kimax(jsec), kjmin(jsec), kjmax(jsec)
- END DO
-
- CLOSE(numit)
-
- END SUBROUTINE section_init
-
-
-END PROGRAM cdfsigtrp_full
diff --git a/cdfsigtrp.f90 b/cdfsigtrp.f90
index 36059e2..86710bd 100644
--- a/cdfsigtrp.f90
+++ b/cdfsigtrp.f90
@@ -1,218 +1,335 @@
PROGRAM cdfsigtrp
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfsigtrp ***
+ !!======================================================================
+ !! *** PROGRAM cdfsigtrp ***
+ !!=====================================================================
+ !! ** Purpose : Compute density class Mass transport across a section.
!!
- !! ** Purpose: Compute density class Mass Transports across a section
- !! PARTIAL STEPS version
- !!
- !! ** Method:
- !! -The begining and end point of the section are given in term of f-points index.
- !! -The program works for zonal or meridional sections.
- !! -The section definitions are given in an ASCII FILE dens_section.dat
- !! foreach sections, 2 lines : (i) : section name (String, no blank)
- !! (ii) : imin imax jmin jmax for the section
- !! -Only vertical slices corrsponding to the sections are read in the files.
- !! read metrics, depth, etc
- !! read normal velocity (either vozocrtx oy vomecrty )
- !! read 2 rows of T and S ( i i+1 or j j+1 )
- !! compute the mean value at velocity point
- !! compute sigma0 (can be easily modified for sigmai )
- !! compute the depths of isopyncal surfaces
- !! compute the transport from surface to the isopycn
- !! compute the transport in each class of density
- !! compute the total transport (for information)
+ !! ** Method :- The begining and end point of the section are given in
+ !! term of f-points index.
+ !! - The program works for zonal or meridional sections.
+ !! - The section definitions are given in an ASCII FILE
+ !! dens_section.dat:
+ !! foreach sections, 2 lines :
+ !! (i) : section name (String, no blank)
+ !! (ii) : imin imax jmin jmax for the section
+ !! - Only vertical slices corrsponding to the sections are
+ !! read in the files.
+ !! - read metrics, depth, etc
+ !! - read normal velocity (either vozocrtx oy vomecrty )
+ !! - read 2 rows of T and S ( i i+1 or j j+1 )
+ !! - compute the mean value at velocity point
+ !! - compute sigma0 (can be easily modified for sigmai )
+ !! - compute the depths of isopyncal surfaces
+ !! - compute the transport from surface to the isopycn
+ !! - compute the transport in each class of density
+ !! - compute the total transport (for information)
!!
- !! history :
- !! Original : J.M. Molines March 2006
- !! : R. Dussin (Jul. 2009) add cdf output
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 03/2006 : J.M. Molines : Original code
+ !! : 07/2009 : R. Dussin : add cdf output
+ !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! section_init : initialize section names and positions
+ !! print_out : routine which performs standard output if required
+ !! bimg_writ : routine which performs bimg output if required
+ !!----------------------------------------------------------------------
USE cdfio
- USE eos
-
- !! * Local variables
+ USE eos ! for sigma0, sigmai
+ USE modcdfnames ! for ReadCdfNames
+ USE modutils ! for SetGlobalAtt
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: nbins !: number of density classes
- INTEGER :: ji, jk, jclass, jsec,jiso , jbin,jarg !: dummy loop index
- INTEGER :: ipos !: working variable
- INTEGER :: narg, iargc !: command line
- INTEGER :: npk, nk !: vertical size, number of wet layers in the section
- INTEGER :: numbimg=10 !: optional bimg logical unit
- INTEGER :: numout=11 !: ascii output
-
- INTEGER :: nsection !: number of sections (overall)
- INTEGER ,DIMENSION(:), ALLOCATABLE :: imina, imaxa, jmina, jmaxa !: sections limits
- INTEGER :: imin, imax, jmin, jmax !: working section limits
- INTEGER :: npts !: working section number of h-points
- ! added to write in netcdf
- INTEGER :: kx=1, ky=1 ! dims of netcdf output file
- INTEGER :: nboutput=2 ! number of values to write in cdf output
- INTEGER :: ncout, ierr ! for netcdf output
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
-
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdept, gdepw !: depth of T and W points
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zs, zt !: salinity and temperature from file
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: tmpm, tmpz !: temporary arrays
+
+ INTEGER(KIND=4) :: ji, jk, jclass, jsec ! dummy loop index
+ INTEGER(KIND=4) :: jiso, jbin, jarg ! dummy loop index
+ INTEGER(KIND=4) :: nbins ! number of density classes
+ INTEGER(KIND=4) :: ipos ! working variable
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: npk, nk ! vertical size, number of wet layers
+ INTEGER(KIND=4) :: numbimg=10 ! optional bimg logical unit
+ INTEGER(KIND=4) :: numout=11 ! ascii output
+ INTEGER(KIND=4) :: nsection ! number of sections (overall)
+ INTEGER(KIND=4) :: iimin, iimax ! working section limits
+ INTEGER(KIND=4) :: ijmin, ijmax ! working section limits
+ INTEGER(KIND=4) :: npts ! number of points in section
+ INTEGER(KIND=4) :: ikx=1, iky=1 ! dims of netcdf output file
+ INTEGER(KIND=4) :: nboutput=2 ! number of values to write in cdf output
+ INTEGER(KIND=4) :: ncout, ierr ! for netcdf output
+ INTEGER(KIND=4) :: iweight ! weight of input file for further averaging
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: iimina, iimaxa ! sections limits
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ijmina, ijmaxa ! sections limits
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! variable levels and id
+
+ REAL(KIND=4) :: refdep =0.e0 ! reference depth (m)
+ REAL(KIND=4), DIMENSION(1) :: tim ! time counter
+ REAL(KIND=4), DIMENSION(1) :: rdummy1, rdummy2 ! working variable
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept, gdepw ! depth of T and W points
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: eu ! either e1v or e2u
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e3t1d, e3w1d ! vertical metrics in case of full step
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rlonlat ! longitudes/latitudes if the section
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zs, zt ! salinity and temperature from file
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdumlon, rdumlat ! dummy longitude and latitude for output
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu ! velocity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: tmpm, tmpz ! temporary arrays
! double precision for cumulative variables and densities
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: eu !: either e1v or e2u
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zu, e3 , zmask !: velocities e3 and umask
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zsig ,gdepu !: density, depth of vel points
- REAL(KIND=8) :: sigma_min, sigma_max,dsigma !: Min and Max for sigma bining
- REAL(KIND=8) :: sigma,zalfa !: current working sigma
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: sigma_lev !: built array with sigma levels
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: hiso !: depth of isopycns
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwtrp, zwtrpbin, trpbin !: transport arrays
- ! added to write in netcdf
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dumlon, dumlat
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: pdep
- REAL(KIND=4), DIMENSION (1) :: tim ! time counter
- REAL(KIND=4), DIMENSION (1) :: dummy1, dummy2
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar ! structure of output
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvarin !: structure for recovering input informations such as iwght
- CHARACTER(LEN=256), DIMENSION(:),ALLOCATABLE :: cvarname !: names of input variables
- INTEGER :: nvarin !: number of variables in input file
- INTEGER :: iweight !: weight of input file for further averaging
-
- CHARACTER(LEN=256), DIMENSION (:), ALLOCATABLE :: csection !: section name
- CHARACTER(LEN=256) :: cfilet, cfileu, cfilev, cfilesec='dens_section.dat' !: files name
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc' !: coordinates files
- CHARACTER(LEN=256) :: cfilout='trpsig.txt' !: output file
- CHARACTER(LEN=256) :: cdum !: dummy string
- ! added to write in netcdf
- CHARACTER(LEN=256) :: cfileoutnc
- CHARACTER(LEN=256) :: cdunits, cdlong_name, cdshort_name, cdep
-
- LOGICAL :: l_merid !: flag is true for meridional working section
- LOGICAL :: l_print=.FALSE. !: flag for printing additional results
- LOGICAL :: l_bimg=.FALSE. !: flag for bimg output
- ! added to write in netcdf
- LOGICAL :: lwrtcdf=.TRUE.
- CHARACTER(LEN=80) :: cfor9000, cfor9001, cfor9002, cfor9003
-
-
- !! * Initialisations
-
- ! Read command line and output usage message if not compliant.
+ REAL(KIND=8) :: dsigma_min ! minimum density for bining
+ REAL(KIND=8) :: dsigma_max, dltsig ! maximum density for bining, step
+ REAL(KIND=8) :: dsigma, dalfa ! working sigma, interpolation coeff.
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dsigma_lev ! built array with sigma levels
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: de3 ! vertical metrics
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: ddepu ! depth of vel points
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsig ! density
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dhiso ! depth of isopycns
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwtrp, dwtrpbin ! transport arrays
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtrpbin ! transport arrays
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output
+
+ CHARACTER(LEN=256) :: cf_tfil ! temperature salinity file
+ CHARACTER(LEN=256) :: cf_ufil ! zonal velocity file
+ CHARACTER(LEN=256) :: cf_vfil ! meridional velocity file
+ CHARACTER(LEN=256) :: cf_section='dens_section.dat' ! input section file
+ CHARACTER(LEN=256) :: cf_out='trpsig.txt' ! output ascii file
+ CHARACTER(LEN=256) :: cf_bimg ! output bimg file (2d)
+ CHARACTER(LEN=256) :: cf_nc ! output netcdf file (2d)
+ CHARACTER(LEN=256) :: cf_outnc ! output netcdf file (1d, 0d))
+ CHARACTER(LEN=256) :: cv_dep ! depth variable
+ CHARACTER(LEN=256) :: cldum ! dummy string
+ CHARACTER(LEN=256) :: cglobal ! global attribute
+ CHARACTER(LEN=80 ) :: cfmt_9000 ! format string
+ CHARACTER(LEN=80 ) :: cfmt_9001 ! format string
+ CHARACTER(LEN=80 ) :: cfmt_9002 ! format string
+ CHARACTER(LEN=80 ) :: cfmt_9003 ! format string
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! names of input variables
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: csection ! section name
+
+ LOGICAL :: l_merid ! flag for meridional section
+ LOGICAL :: ltemp =.FALSE. ! flag for extra print
+ LOGICAL :: lprint =.FALSE. ! flag for extra print
+ LOGICAL :: lbimg =.FALSE. ! flag for bimg output
+ LOGICAL :: lncdf =.FALSE. ! flag for bimg output
+ LOGICAL :: lfull =.FALSE. ! flag for bimg output
+ LOGICAL :: lchk =.FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
- IF ( narg < 6 ) THEN
- PRINT *,' Usage : cdfsigtrp gridTfile gridUfile gridVfile sigma_min sigma_max nbins [options]'
- PRINT *,' sigma_min, sigma_max : limit for density bining '
- PRINT *,' nbins : number of bins to use '
- PRINT *,' Possible options :'
- PRINT *,' -print :additional output is send to std output'
- PRINT *,' -bimg : 2D (x=lat/lon, y=sigma) output on bimg file for hiso, cumul trp, trp'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in the current directory'
- PRINT *,' File section.dat must also be in the current directory '
- PRINT *,' Output on trpsig.txt and on standard output '
+ IF ( narg < 6 ) THEN
+ PRINT *,' usage : cdfsigtrp T-file U-file V-file sigma_min sigma_max nbins ...'
+ PRINT *,' ... [-print ] [-bimg ] [-full ] [ -refdep ref_depth] ...'
+ PRINT *,' ... [-section file ] [-temp ]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute density class transports, according to the density class'
+ PRINT *,' definition ( minimum, maximum and number of bins) given in arguments.'
+ PRINT *,' Section position are given in ',TRIM(cf_section),', an ASCII file '
+ PRINT *,' with pairs of lines giving section name and section location as'
+ PRINT *,' imin imax jmin jmax. Only zonal or meridional section are allowed.'
+ PRINT *,' The name of this file can be specified with the -section option, if'
+ PRINT *,' it differs from the standard name.'
+ PRINT *,' '
+ PRINT *,' This program can also be used to compute transport by class of '
+ PRINT *,' temperatures, provided the temperatures decreases monotonically '
+ PRINT *,' downward. In this case, use -temp option and of course specify'
+ PRINT *,' sigma_min, sigma_max as temperatures.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with temperature and salinity'
+ PRINT *,' U-file : netcdf file with zonal velocity component'
+ PRINT *,' V-file : netcdf file with meridional velocity component'
+ PRINT *,' sigma_min : minimum density for binning'
+ PRINT *,' sigma_max : maximum density for binning'
+ PRINT *,' nbins : number of bins. This will fix the bin ''width'' '
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ -full ] : for full step configuration'
+ PRINT *,' [ -bimg ] : produce extra bimg output file which shows the details'
+ PRINT *,' of the sections (normal velocity, density, temperature, '
+ PRINT *,' salinity, transports, isopycnal depths. (to be change to '
+ PRINT *,' netcdf files for more common use.'
+ PRINT *,' [ -ncdf ] : produce extra netcdf output file which shows the details'
+ PRINT *,' of the sections (normal velocity, density, temperature, '
+ PRINT *,' salinity, transports, isopycnal depths. '
+ PRINT *,' [ -print ]: write the binned transports on standard output, for each'
+ PRINT *,' sections.'
+ PRINT *,' [ -refdep ref_depth ]: give a reference depths for the computation of'
+ PRINT *,' potential density. Sigma_min, sigma_max must be adapted '
+ PRINT *,' accordingly.'
+ PRINT *,' [ -section file] : give the name of section file.'
+ PRINT *,' Default is ', TRIM(cf_section)
+ PRINT *,' [ -temp ] : use temperature instead of density for binning'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fhgr),', ', TRIM(cn_fzgr),' and ', TRIM(cf_section)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' Netcdf file : There is 1 netcdf file per section. File name is build'
+ PRINT *,' from section name : Section_name_trpsig.nc'
+ PRINT *,' variables : sigma_class (upper limit of the bin)'
+ PRINT *,' sigtrp : transport (Sv per bin)'
+ PRINT *,' '
+ PRINT *,' ascii file : ', TRIM(cf_out)
+ PRINT *,' '
+ PRINT *,' bimg file : There are 2 bimg files whose name is build from section'
+ PRINT *,' name : section_name_trpdep.bimg and section_name_trpsig.bimg.'
+ PRINT *,' This file is written only if -bimg option is used.'
+ PRINT *,' '
+ PRINT *,' Standard output : the results are written on standard output only if '
+ PRINT *,' the -print option is used.'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfrhoproj, cdftransport, cdfsigintegr '
+ PRINT *,' '
STOP
ENDIF
- !! Read arguments
- CALL getarg (1, cfilet)
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
- CALL getarg (4,cdum) ; READ(cdum,*) sigma_min
- CALL getarg (5,cdum) ; READ(cdum,*) sigma_max
- CALL getarg (6,cdum) ; READ(cdum,*) nbins
-
- DO jarg=7, narg
- CALL getarg(jarg,cdum)
- SELECT CASE (cdum)
- CASE ('-print' )
- l_print = .TRUE.
- CASE ('-bimg')
- l_bimg = .TRUE.
+ ! browse command line
+ ijarg = 1 ; ireq = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
+ CASE ( '-full' ) ; lfull = .TRUE.
+ CASE ( '-bimg' ) ; lbimg = .TRUE.
+ CASE ( '-ncdf' ) ; lncdf = .TRUE.
+ CASE ( '-print') ; lprint = .TRUE.
+ CASE ( '-temp') ; ltemp = .TRUE.
+ CASE ( '-refdep' ) ; CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) refdep
+ CASE ( '-section') ; CALL getarg(ijarg, cf_section ) ; ijarg=ijarg+1
CASE DEFAULT
- PRINT *,' Unknown option ', TRIM(cdum),' ... ignored'
+ ireq=ireq+1
+ SELECT CASE ( ireq)
+ CASE ( 1 ) ; cf_tfil = cldum
+ CASE ( 2 ) ; cf_ufil = cldum
+ CASE ( 3 ) ; cf_vfil = cldum
+ CASE ( 4 ) ; READ(cldum,*) dsigma_min
+ CASE ( 5 ) ; READ(cldum,*) dsigma_max
+ CASE ( 6 ) ; READ(cldum,*) nbins
+ CASE DEFAULT
+ PRINT *,' Too many arguments ' ; STOP
+ END SELECT
END SELECT
END DO
- IF(lwrtcdf) THEN
- nvarin=getnvar(cfileu) ! smaller than cfilet
- ALLOCATE(typvarin(nvarin), cvarname(nvarin) )
- cvarname(:)=getvarname(cfileu,nvarin,typvarin)
-
- DO jarg=1,nvarin
- IF ( TRIM(cvarname(jarg)) == 'vozocrtx' ) THEN
- iweight=typvarin(jarg)%iwght
- EXIT ! loop
- ENDIF
- END DO
-
-
- ALLOCATE ( typvar(nboutput), ipk(nboutput), id_varout(nboutput) )
- ALLOCATE (dumlon(kx,ky) , dumlat(kx,ky) )
-
- dumlon(:,:)=0.
- dumlat(:,:)=0.
-
- ipk(1)=nbins ! sigma for each level
- ipk(2)=nbins ! transport for each level
-
- ! define new variables for output
- typvar(1)%name='sigma_class'
- typvar%units='[]'
- typvar%missing_value=99999.
- typvar%valid_min= 0.
- typvar%valid_max= 100.
- typvar%scale_factor= 1.
- typvar%add_offset= 0.
- typvar%savelog10= 0.
- typvar%iwght=iweight
- typvar(1)%long_name='class of potential density'
- typvar(1)%short_name='sigma_class'
- typvar%online_operation='N/A'
- typvar%axis='ZT'
-
- typvar(2)%name='sigtrp'
- typvar(2)%units='Sv'
- typvar(2)%valid_min= -1000.
- typvar(2)%valid_max= 1000.
- typvar(2)%long_name='transport in sigma class'
- typvar(2)%short_name='sigtrp'
+ ! check for file existence
+ lchk = lchk .OR. chkfile( cn_fzgr )
+ lchk = lchk .OR. chkfile( cn_fhgr )
+ lchk = lchk .OR. chkfile( cf_section )
+ lchk = lchk .OR. chkfile( cf_tfil )
+ lchk = lchk .OR. chkfile( cf_ufil )
+ lchk = lchk .OR. chkfile( cf_vfil )
+ IF ( lchk ) STOP ! missing file
+ IF ( ltemp) THEN ! temperature decrease downward. Change sign and swap min/max
+ refdep = -10. ! flag value
+ dltsig = dsigma_max ! use dltsig as dummy variable for swapping
+ dsigma_max = -dsigma_min
+ dsigma_min = -dltsig
+ ENDIF
+ ! define global attribute with command line
+ CALL SetGlobalAtt( cglobal)
+
+ ! get the attribute iweight from vozocrtx
+ iweight = getatt(cf_ufil, cn_vozocrtx, 'iweight')
+ IF ( iweight == 0 ) iweight = 1 ! if 0 means that it is not defined.
+
+ ALLOCATE ( stypvar(nboutput), ipk(nboutput), id_varout(nboutput) )
+ ALLOCATE ( rdumlon(ikx,iky), rdumlat(ikx,iky) )
+
+ rdumlon(:,:)=0.
+ rdumlat(:,:)=0.
+
+ ipk(1)=nbins ! sigma for each level
+ ipk(2)=nbins ! transport for each level
+
+ ! define new variables for output
+ stypvar%rmissing_value = 99999.
+ stypvar%scale_factor = 1.
+ stypvar%add_offset = 0.
+ stypvar%savelog10 = 0.
+ stypvar%iwght = iweight
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'ZT'
+
+ IF ( ltemp ) THEN
+ stypvar(1)%cname = 'temp_class'
+ stypvar(1)%cunits = '[]'
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 100.
+ stypvar(1)%clong_name = 'class of potential temperature'
+ stypvar(1)%cshort_name = 'temp_class'
+
+ stypvar(2)%cname = 'temptrp'
+ stypvar(2)%cunits = 'Sv'
+ stypvar(2)%valid_min = -1000.
+ stypvar(2)%valid_max = 1000.
+ stypvar(2)%clong_name = 'transport in temperature class'
+ stypvar(2)%cshort_name = 'temptrp'
+ ELSE
+ stypvar(1)%cname = 'sigma_class'
+ stypvar(1)%cunits = '[]'
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 100.
+ stypvar(1)%clong_name = 'class of potential density'
+ stypvar(1)%cshort_name = 'sigma_class'
+
+ stypvar(2)%cname = 'sigtrp'
+ stypvar(2)%cunits = 'Sv'
+ stypvar(2)%valid_min = -1000.
+ stypvar(2)%valid_max = 1000.
+ stypvar(2)%clong_name = 'transport in sigma class'
+ stypvar(2)%cshort_name = 'sigtrp'
ENDIF
! Initialise sections from file
! first call to get nsection and allocate arrays
- nsection = 0 ; CALL section_init(cfilesec, csection,imina,imaxa,jmina,jmaxa, nsection)
- ALLOCATE ( csection(nsection), imina(nsection), imaxa(nsection), jmina(nsection),jmaxa(nsection) )
- CALL section_init(cfilesec, csection,imina,imaxa,jmina,jmaxa, nsection)
+ nsection = 0 ; CALL section_init(cf_section, csection, iimina, iimaxa, ijmina, ijmaxa, nsection)
+ ALLOCATE ( csection(nsection), iimina(nsection), iimaxa(nsection), ijmina(nsection),ijmaxa(nsection) )
+ CALL section_init(cf_section, csection,iimina,iimaxa,ijmina,ijmaxa, nsection)
! Allocate and build sigma levels and section array
- ALLOCATE ( sigma_lev (nbins+1) , trpbin(nsection,nbins) )
+ ALLOCATE ( dsigma_lev (nbins+1) , dtrpbin(nsection,nbins) )
- sigma_lev(1)=sigma_min
- dsigma=( sigma_max - sigma_min) / nbins
+ dsigma_lev(1)=dsigma_min
+ dltsig=( dsigma_max - dsigma_min) / nbins
DO jclass =2, nbins+1
- sigma_lev(jclass)= sigma_lev(1) + (jclass-1) * dsigma
+ dsigma_lev(jclass)= dsigma_lev(1) + (jclass-1) * dltsig
END DO
! Look for vertical size of the domain
- npk = getdim (cfilet,'depth')
+ npk = getdim (cf_tfil,cn_z)
ALLOCATE ( gdept(npk), gdepw(npk) )
+ IF ( lfull ) ALLOCATE ( e3t1d(npk), e3w1d(npk))
! read gdept, gdepw : it is OK even in partial cells, as we never use the bottom gdep
- gdept(:) = getvare3(coordzgr,'gdept', npk)
- gdepw(:) = getvare3(coordzgr,'gdepw', npk)
+ gdept(:) = getvare3(cn_fzgr, cn_gdept, npk)
+ gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk)
- !! * Main loop on sections
+ IF ( lfull ) THEN
+ e3t1d(:) = getvare3(cn_fzgr, cn_ve3t, npk)
+ e3w1d(:) = getvare3(cn_fzgr, cn_ve3w, npk)
+ ENDIF
+ !! * Main loop on sections
DO jsec=1,nsection
- l_merid=.FALSE.
- imin=imina(jsec) ; imax=imaxa(jsec) ; jmin=jmina(jsec) ; jmax=jmaxa(jsec)
- IF (imin == imax ) THEN ! meridional section
- l_merid=.TRUE.
- npts=jmax-jmin
+ iimin=iimina(jsec) ; iimax=iimaxa(jsec)
+ ijmin=ijmina(jsec) ; ijmax=ijmaxa(jsec)
- ELSE IF ( jmin == jmax ) THEN ! zonal section
- npts=imax-imin
+ IF (iimin == iimax ) THEN ! meridional section
+ npts = ijmax - ijmin ! number of segments
+ l_merid = .TRUE.
+
+ ELSE IF ( ijmin == ijmax ) THEN ! zonal section
+ npts = iimax - iimin ! number of segments
+ l_merid = .FALSE.
ELSE
PRINT *,' Section ',TRIM(csection(jsec)),' is neither zonal nor meridional :('
@@ -220,39 +337,49 @@ PROGRAM cdfsigtrp
CYCLE
ENDIF
- ALLOCATE ( zu(npts, npk), zt(npts,npk), zs(npts,npk) ,zsig(npts,0:npk) )
- ALLOCATE ( eu(npts), e3(npts,npk), gdepu(npts, 0:npk), zmask(npts,npk) )
- ALLOCATE ( tmpm(1,npts,2), tmpz(npts,1,2) )
- ALLOCATE ( zwtrp(npts, nbins+1) , hiso(npts,nbins+1), zwtrpbin(npts,nbins) )
-
- zt = 0. ; zs = 0. ; zu = 0. ; gdepu= 0. ; zmask = 0. ; zsig=0.d0
+ ALLOCATE ( zu(npts,npk), zt(npts,npk), zs(npts,npk), dsig(npts,0:npk) )
+ ALLOCATE ( eu(npts), de3(npts,npk), ddepu(npts, 0:npk), zmask(npts,npk) )
+ ALLOCATE ( tmpm(1,npts,2), tmpz(npts,1,2) )
+ ALLOCATE ( dwtrp(npts, nbins+1), dhiso(npts,nbins+1), dwtrpbin(npts,nbins) )
+ ALLOCATE ( rlonlat(npts,1) )
+
+ zt = 0. ; zs = 0. ; zu = 0. ; ddepu= 0. ; zmask = 0. ; dsig=0.d0
+
+ IF (l_merid ) THEN ! meridional section at i=iimin=iimax
+ tmpm(:,:,1) = getvar(cn_fhgr, cn_ve2u, 1, 1, npts, kimin=iimin, kjmin=ijmin+1)
+ eu(:) = tmpm(1,:,1) ! metrics varies only horizontally
+ tmpm(:,:,1) = getvar(cn_fhgr, cn_vlat2d, 1, 1, npts, kimin=iimin, kjmin=ijmin+1)
+ rlonlat(:,1) = tmpm(1,:,1) ! latitude in this case
+ DO jk = 1,npk
+ ! initiliaze ddepu to gdept()
+ ddepu(:,jk) = gdept(jk)
+
+ IF ( lfull ) THEN
+ de3(:,jk) = e3t1d(jk)
+ tmpm(1,:,1) = e3w1d(jk)
+ tmpm(1,:,2) = e3w1d(jk)
+ ELSE
+ ! vertical metrics (PS case)
+ tmpm(:,:,1) = getvar(cn_fzgr, 'e3u_ps', jk, 1, npts, kimin=iimin, kjmin=ijmin+1, ldiom=.TRUE.)
+ de3(:,jk) = tmpm(1,:,1)
+ tmpm(:,:,1) = getvar(cn_fzgr, 'e3w_ps', jk, 1, npts, kimin=iimin, kjmin=ijmin+1, ldiom=.TRUE.)
+ tmpm(:,:,2) = getvar(cn_fzgr, 'e3w_ps', jk, 1, npts, kimin=iimin+1, kjmin=ijmin+1, ldiom=.TRUE.)
+ ENDIF
- IF (l_merid ) THEN ! meridional section at i=imin=imax
- tmpm(:,:,1)=getvar(coordhgr, 'e2u', 1,1,npts, kimin=imin, kjmin=jmin+1)
- eu(:)=tmpm(1,:,1) ! metrics varies only horizontally
- DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (PS case)
- tmpm(:,:,1)=getvar(coordzgr,'e3u_ps',jk,1,npts, kimin=imin, kjmin=jmin+1, ldiom=.TRUE.)
- e3(:,jk)=tmpm(1,:,1)
- tmpm(:,:,1)=getvar(coordzgr,'e3w_ps',jk,1,npts, kimin=imin, kjmin=jmin+1, ldiom=.TRUE.)
- tmpm(:,:,2)=getvar(coordzgr,'e3w_ps',jk,1,npts, kimin=imin+1, kjmin=jmin+1, ldiom=.TRUE.)
IF (jk >= 2 ) THEN
DO ji=1,npts
- gdepu(ji,jk)= gdepu(ji,jk-1) + MIN(tmpm(1,ji,1), tmpm(1,ji,2))
+ ddepu(ji,jk)= ddepu(ji,jk-1) + MIN(tmpm(1,ji,1), tmpm(1,ji,2))
END DO
ENDIF
! Normal velocity
- tmpm(:,:,1)=getvar(cfileu,'vozocrtx',jk,1,npts, kimin=imin, kjmin=jmin+1)
- zu(:,jk)=tmpm(1,:,1)
+ tmpm(:,:,1) = getvar(cf_ufil,cn_vozocrtx,jk,1,npts, kimin=iimin, kjmin=ijmin+1)
+ zu(:,jk) = tmpm(1,:,1)
! salinity and deduce umask for the section
- tmpm(:,:,1)=getvar(cfilet,'vosaline',jk,1,npts, kimin=imin , kjmin=jmin+1)
- tmpm(:,:,2)=getvar(cfilet,'vosaline',jk,1,npts, kimin=imin+1, kjmin=jmin+1)
- zmask(:,jk)=tmpm(1,:,1)*tmpm(1,:,2)
+ tmpm(:,:,1) = getvar(cf_tfil,cn_vosaline,jk,1,npts, kimin=iimin , kjmin=ijmin+1)
+ tmpm(:,:,2) = getvar(cf_tfil,cn_vosaline,jk,1,npts, kimin=iimin+1, kjmin=ijmin+1)
+ zmask(:,jk) = tmpm(1,:,1)*tmpm(1,:,2)
WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
! do not take special care for land value, as the corresponding velocity point is masked
zs(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) )
@@ -264,37 +391,45 @@ PROGRAM cdfsigtrp
ENDIF
! temperature
- tmpm(:,:,1)=getvar(cfilet,'votemper',jk,1,npts, kimin=imin, kjmin=jmin+1)
- tmpm(:,:,2)=getvar(cfilet,'votemper',jk,1,npts, kimin=imin+1, kjmin=jmin+1)
+ tmpm(:,:,1) = getvar(cf_tfil, cn_votemper, jk, 1, npts, kimin=iimin, kjmin=ijmin+1)
+ tmpm(:,:,2) = getvar(cf_tfil, cn_votemper, jk, 1, npts, kimin=iimin+1, kjmin=ijmin+1)
zt(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) )
-
END DO
- ELSE ! zonal section at j=jmin=jmax
- tmpz(:,:,1)=getvar(coordhgr, 'e1v', 1,npts,1,kimin=imin, kjmin=jmin)
- eu=tmpz(:,1,1)
+ ELSE ! zonal section at j=ijmin=ijmax
+ tmpz(:,:,1) = getvar(cn_fhgr, cn_ve1v, 1, npts, 1, kimin=iimin, kjmin=ijmin)
+ eu(:) = tmpz(:,1,1)
+ tmpz(:,:,1) = getvar(cn_fhgr, cn_vlon2d, 1, npts, 1, kimin=iimin, kjmin=ijmin)
+ rlonlat(:,1) = tmpz(:,1,1) ! longitude in this case
DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (PS case)
- tmpz(:,:,1)=getvar(coordzgr,'e3v_ps',jk, npts, 1, kimin=imin+1, kjmin=jmin, ldiom=.TRUE.)
- e3(:,jk)=tmpz(:,1,1)
- tmpz(:,:,1)=getvar(coordzgr,'e3w_ps',jk,npts,1, kimin=imin+1, kjmin=jmin, ldiom=.TRUE.)
- tmpz(:,:,2)=getvar(coordzgr,'e3w_ps',jk,npts,1, kimin=imin+1, kjmin=jmin+1, ldiom=.TRUE.)
+ ! initiliaze ddepu to gdept()
+ ddepu(:,jk) = gdept(jk)
+
+ IF ( lfull ) THEN
+ de3(:,jk) = e3t1d(jk)
+ tmpm(:,1,1) = e3w1d(jk)
+ tmpm(:,1,2) = e3w1d(jk)
+ ELSE
+ ! vertical metrics (PS case)
+ tmpz(:,:,1)=getvar(cn_fzgr,'e3v_ps',jk, npts, 1, kimin=iimin+1, kjmin=ijmin, ldiom=.TRUE.)
+ de3(:,jk) = tmpz(:,1,1)
+ tmpz(:,:,1)=getvar(cn_fzgr,'e3w_ps',jk,npts,1, kimin=iimin+1, kjmin=ijmin, ldiom=.TRUE.)
+ tmpz(:,:,2)=getvar(cn_fzgr,'e3w_ps',jk,npts,1, kimin=iimin+1, kjmin=ijmin+1, ldiom=.TRUE.)
+ ENDIF
+
IF (jk >= 2 ) THEN
DO ji=1,npts
- gdepu(ji,jk)= gdepu(ji,jk-1) + MIN(tmpz(ji,1,1), tmpz(ji,1,2))
+ ddepu(ji,jk)= ddepu(ji,jk-1) + MIN(tmpz(ji,1,1), tmpz(ji,1,2))
END DO
ENDIF
! Normal velocity
- tmpz(:,:,1)=getvar(cfilev,'vomecrty',jk,npts,1, kimin=imin+1, kjmin=jmin)
+ tmpz(:,:,1)=getvar(cf_vfil,cn_vomecrty,jk,npts,1, kimin=iimin+1, kjmin=ijmin)
zu(:,jk)=tmpz(:,1,1)
! salinity and mask
- tmpz(:,:,1)=getvar(cfilet,'vosaline',jk, npts, 1, kimin=imin+1, kjmin=jmin)
- tmpz(:,:,2)=getvar(cfilet,'vosaline',jk, npts, 1, kimin=imin+1, kjmin=jmin+1)
+ tmpz(:,:,1)=getvar(cf_tfil,cn_vosaline,jk, npts, 1, kimin=iimin+1, kjmin=ijmin)
+ tmpz(:,:,2)=getvar(cf_tfil,cn_vosaline,jk, npts, 1, kimin=iimin+1, kjmin=ijmin+1)
zmask(:,jk)=tmpz(:,1,1)*tmpz(:,1,2)
WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
! do not take special care for land value, as the corresponding velocity point is masked
@@ -307,261 +442,444 @@ PROGRAM cdfsigtrp
ENDIF
! temperature
- tmpz(:,:,1)=getvar(cfilet,'votemper',jk, npts, 1, kimin=imin+1, kjmin=jmin)
- tmpz(:,:,2)=getvar(cfilet,'votemper',jk, npts, 1, kimin=imin+1, kjmin=jmin+1)
+ tmpz(:,:,1)=getvar(cf_tfil,cn_votemper,jk, npts, 1, kimin=iimin+1, kjmin=ijmin)
+ tmpz(:,:,2)=getvar(cf_tfil,cn_votemper,jk, npts, 1, kimin=iimin+1, kjmin=ijmin+1)
zt(:,jk) = 0.5 * ( tmpz(:,1,1) + tmpz(:,1,2) )
END DO
ENDIF
! compute density only for wet points
- zsig(:,1:nk)=sigma0( zt, zs, npts, nk)*zmask(:,:)
- zsig(:,0)=zsig(:,1)-1.e-4 ! dummy layer for easy interpolation
-
- ! Some control print
- IF ( l_print ) THEN
- WRITE(cfor9000,'(a,i4,a)') '(i7,',npts,'f8.3)'
- WRITE(cfor9001,'(a,i4,a)') '(i7,',npts,'f8.0)'
- WRITE(cfor9002,'(a,i4,a)') '(f7.3,',npts,'f8.0)'
- WRITE(cfor9003,'(a,i4,a)') '(f7.3,',npts,'f8.3)'
- PRINT *,' T (deg C)'
- DO jk=1,nk
- PRINT cfor9000, jk, (zt(ji,jk),ji=1,npts)
- END DO
-
- PRINT *,' S (PSU)'
- DO jk=1,nk
- PRINT cfor9000, jk, (zs(ji,jk),ji=1,npts)
- END DO
-
- PRINT *,' SIG (kg/m3 - 1000 )'
- DO jk=1,nk
- PRINT cfor9000, jk, (zsig(ji,jk),ji=1,npts)
- END DO
-
- PRINT *,' VELOCITY (cm/s ) '
- DO jk=1,nk
- PRINT cfor9000, jk, (zu(ji,jk)*100,ji=1,npts)
- END DO
-
- PRINT *,' GDEPU (m) '
- DO jk=1,nk
- PRINT cfor9001,jk, (gdepu(ji,jk)*zmask(ji,jk),ji=1,npts)
- END DO
+ IF ( refdep == -10. ) THEN
+ dsig(:,1:nk)= -zt(:,:) ! change sign
+ ELSEIF ( refdep == 0. ) THEN
+ dsig(:,1:nk)=sigma0( zt, zs, npts, nk)*zmask(:,:)
+ ELSE
+ dsig(:,1:nk)=sigmai( zt, zs, refdep, npts, nk)*zmask(:,:)
+ ENDIF
- PRINT *, 'E3 (m)'
- DO jk=1,nk
- PRINT cfor9001,jk, (e3(ji,jk)*zmask(ji,jk),ji=1,npts)
- END DO
- END IF
+ dsig(:,0)=dsig(:,1)-1.e-4 ! dummy layer for easy interpolation
! compute depth of isopynals (nbins+1 )
- IF (l_print ) PRINT *,' DEP ISO ( m )'
DO jiso =1, nbins+1
- sigma=sigma_lev(jiso)
+ dsigma=dsigma_lev(jiso)
!!! REM : I and K loop can be inverted if necessary
DO ji=1,npts
- hiso(ji,jiso) = gdept(npk)
+ dhiso(ji,jiso) = gdept(npk)
DO jk=1,nk
- IF ( zsig(ji,jk) < sigma ) THEN
+ IF ( dsig(ji,jk) < dsigma ) THEN
ELSE
! interpolate between jk-1 and jk
- zalfa=(sigma - zsig(ji,jk-1)) / ( zsig(ji,jk) -zsig(ji,jk-1) )
- IF (ABS(zalfa) > 1.1 .OR. zalfa < 0 ) THEN ! case zsig(0) = zsig(1)-1.e-4
- hiso(ji,jiso)= 0.
+ dalfa=(dsigma - dsig(ji,jk-1)) / ( dsig(ji,jk) -dsig(ji,jk-1) )
+ IF (ABS(dalfa) > 1.1 .OR. dalfa < 0 ) THEN ! case dsig(0) = dsig(1)-1.e-4
+ dhiso(ji,jiso)= 0.d0
ELSE
- hiso(ji,jiso)= gdepu(ji,jk)*zalfa + (1.-zalfa)* gdepu(ji,jk-1)
+ dhiso(ji,jiso)= ddepu(ji,jk)*dalfa + (1.d0-dalfa)* ddepu(ji,jk-1)
ENDIF
EXIT
ENDIF
END DO
END DO
- IF (l_print) PRINT cfor9002, sigma,(hiso(ji,jiso),ji=1,npts)
END DO
! compute transport between surface and isopycn
- IF (l_print) PRINT *,' TRP SURF --> ISO (SV)'
DO jiso = 1, nbins + 1
- sigma=sigma_lev(jiso)
+ dsigma=dsigma_lev(jiso)
DO ji=1,npts
- zwtrp(ji,jiso) = 0.d0
+ dwtrp(ji,jiso) = 0.d0
DO jk=1, nk-1
- IF ( gdepw(jk+1) < hiso(ji,jiso) ) THEN
- zwtrp(ji,jiso)= zwtrp(ji,jiso) + eu(ji)*e3(ji,jk)*zu(ji,jk)
+ IF ( gdepw(jk+1) < dhiso(ji,jiso) ) THEN
+ dwtrp(ji,jiso)= dwtrp(ji,jiso) + eu(ji)*de3(ji,jk)*zu(ji,jk)*1.d0
ELSE ! last box ( fraction)
- zwtrp(ji,jiso)= zwtrp(ji,jiso) + eu(ji)*(hiso(ji,jiso)-gdepw(jk))*zu(ji,jk)
+ dwtrp(ji,jiso)= dwtrp(ji,jiso) + eu(ji)*(dhiso(ji,jiso)-gdepw(jk))*zu(ji,jk)*1.d0
EXIT ! jk loop
ENDIF
END DO
END DO
- IF (l_print) PRINT cfor9003, sigma,(zwtrp(ji,jiso)/1.e6,ji=1,npts)
END DO
! binned transport : difference between 2 isopycns
- IF (l_print) PRINT *,' TRP bins (SV)'
DO jbin=1, nbins
- sigma=sigma_lev(jbin)
+ dsigma=dsigma_lev(jbin)
DO ji=1, npts
- zwtrpbin(ji,jbin) = zwtrp(ji,jbin+1) - zwtrp(ji,jbin)
+ dwtrpbin(ji,jbin) = dwtrp(ji,jbin+1) - dwtrp(ji,jbin)
END DO
- trpbin(jsec,jbin)=SUM(zwtrpbin(:,jbin) )
- IF (l_print) PRINT cfor9003, sigma,(zwtrpbin(ji,jbin)/1.e6,ji=1,npts), trpbin(jsec,jbin)/1.e6
+ dtrpbin(jsec,jbin)=SUM(dwtrpbin(:,jbin) )
END DO
- PRINT *,' Total transport in all bins :',TRIM(csection(jsec)),' ',SUM(trpbin(jsec,:) )/1.e6
-
! output of the code for 1 section
- IF (l_bimg) THEN
- ! (along section, depth ) 2D variables
- cdum=TRIM(csection(jsec))//'_trpdep.bimg'
- OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED')
- cdum=' 4 dimensions in this isopycnal file '
- WRITE(numbimg) cdum
- cdum=' 1: T ; 2: S ; 3: sigma ; 4: Velocity '
- WRITE(numbimg) cdum
- WRITE(cdum,'(a,4i5.4)') ' from '//TRIM(csection(jsec)), imin,imax,jmin,jmax
- WRITE(numbimg) cdum
- cdum=' file '//TRIM(cfilet)
- WRITE(numbimg) cdum
- WRITE(numbimg) npts,nk,1,1,4,0
- WRITE(numbimg) 1.,-float(nk),1.,1., 0.
- WRITE(numbimg) 0.
- WRITE(numbimg) 0.
- ! temperature
- WRITE(numbimg) (( REAL(zt(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- ! salinity
- WRITE(numbimg) (( REAL(zs(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- ! sigma
- WRITE(numbimg) (( REAL(zsig(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- ! Velocity
- WRITE(numbimg) (( REAL(zu(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- CLOSE(numbimg)
-
- ! (along section, sigma ) 2D variables
- cdum=TRIM(csection(jsec))//'_trpsig.bimg'
- OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED')
- cdum=' 3 dimensions in this isopycnal file '
- WRITE(numbimg) cdum
- cdum=' 1: hiso ; 2: bin trp ; 3: cumulated trp '
- WRITE(numbimg) cdum
- WRITE(cdum,'(a,4i5.4)') ' from '//TRIM(csection(jsec)), imin,imax,jmin,jmax
- WRITE(numbimg) cdum
- cdum=' file '//TRIM(cfilet)
- WRITE(numbimg) cdum
- WRITE(numbimg) npts,nbins,1,1,3,0
- WRITE(numbimg) 1.,-REAL(sigma_lev(nbins)),1.,REAL(dsigma), 0.
- WRITE(numbimg) 0.
- WRITE(numbimg) 0.
- ! hiso
- WRITE(numbimg) (( REAL(hiso(ji,jiso)), ji=1,npts) , jiso=nbins,1,-1)
- ! binned transport
- WRITE(numbimg) (( REAL(zwtrpbin(ji,jiso))/1.e6, ji=1,npts) , jiso=nbins,1,-1)
- ! cumulated transport
- WRITE(numbimg) (( REAL(zwtrp(ji,jiso))/1.e6, ji=1,npts) , jiso=nbins,1,-1)
- CLOSE(numbimg)
- ENDIF
+ IF (lprint) CALL print_out(jsec)
+ IF (lbimg ) CALL bimg_writ(jsec)
+ IF (lncdf ) CALL cdf_writ(jsec)
+ PRINT *,' Total transport in all bins :',TRIM(csection(jsec)),' ',SUM(dtrpbin(jsec,:) )/1.d6
! free memory for the next section
- DEALLOCATE ( zu,zt, zs ,zsig ,gdepu, hiso, zwtrp, zwtrpbin )
- DEALLOCATE ( eu, e3 ,tmpm, tmpz,zmask )
+ DEALLOCATE ( zu, zt, zs, dsig, ddepu, dhiso, dwtrp, dwtrpbin )
+ DEALLOCATE ( eu, de3, tmpm, tmpz, zmask, rlonlat )
END DO ! next section
!! Global Output
- OPEN( numout, FILE=cfilout)
- ipos=INDEX(cfilet,'_gridT.nc')
- WRITE(numout,9006) TRIM(cfilet(1:ipos-1))
+ OPEN( numout, FILE=cf_out)
+ ipos=INDEX(cf_tfil,'_gridT.nc')
+ WRITE(numout,9006) TRIM(cf_tfil(1:ipos-1))
WRITE(numout,9005) ' sigma ', (csection(jsec),jsec=1,nsection)
DO jiso=1,nbins
- WRITE(numout,9004) sigma_lev(jiso), (trpbin(jsec,jiso),jsec=1,nsection)
+ WRITE(numout,9004) dsigma_lev(jiso), (dtrpbin(jsec,jiso),jsec=1,nsection)
ENDDO
CLOSE(numout)
+ cv_dep='levels'
- IF(lwrtcdf) THEN
-
- cdep='levels'
-
- DO jsec=1,nsection
-
- ! create output fileset
- cfileoutnc=TRIM(csection(jsec))//'_trpsig.nc'
- ncout =create(cfileoutnc,'none',kx,ky,nbins, cdep=cdep)
- ierr= createvar(ncout,typvar,nboutput,ipk,id_varout)
- ierr= putheadervar(ncout, cfilet,kx, &
- ky,nbins,pnavlon=dumlon,pnavlat=dumlat, pdep=REAL(sigma_lev), cdep='levels')
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
+ DO jsec=1,nsection
+ ! create output fileset
+ IF (ltemp) THEN
+ cf_outnc = TRIM(csection(jsec))//'_trptemp.nc'
+ ELSE
+ cf_outnc = TRIM(csection(jsec))//'_trpsig.nc'
+ ENDIF
- ! netcdf output
- DO jiso=1,nbins
- dummy1=sigma_lev(jiso)
- dummy2=trpbin(jsec,jiso)/1.e6
- ierr = putvar(ncout,id_varout(1), dummy1, jiso, kx, ky )
- ierr = putvar(ncout,id_varout(2), dummy2, jiso, kx, ky )
- END DO
+ ncout = create (cf_outnc, 'none', ikx, iky, nbins, cdep=cv_dep )
+ ierr = createvar (ncout, stypvar, nboutput, ipk, id_varout, cdglobal=TRIM(cglobal))
+ ierr = putheadervar(ncout, cf_tfil, ikx, iky, nbins, &
+ & pnavlon=rdumlon, pnavlat=rdumlat, pdep=REAL(dsigma_lev), cdep=cv_dep )
- ierr = closeout(ncout)
+ tim = getvar1d(cf_tfil, cn_vtimec, 1 )
+ ierr = putvar1d(ncout, tim, 1, 'T')
+ DO jiso=1,nbins
+ rdummy1 = dsigma_lev(jiso)
+ rdummy2 = dtrpbin(jsec,jiso)/1.d6 ! Sv
+ ierr = putvar(ncout, id_varout(1), rdummy1, jiso, ikx, iky )
+ ierr = putvar(ncout, id_varout(2), rdummy2, jiso, ikx, iky )
END DO
- ENDIF
+ ierr = closeout(ncout)
+
+ END DO
-9000 FORMAT(i7,25f8.3)
-9001 FORMAT(i7,25f8.0)
-9002 FORMAT(f7.3,25f8.0)
-9003 FORMAT(f7.3,25f8.3)
9004 FORMAT(f9.4, 20e16.7)
9005 FORMAT('#',a9, 20(2x,a12,2x) )
9006 FORMAT('# ',a)
CONTAINS
- SUBROUTINE section_init(cdfile,cdsection,kimin,kimax,kjmin,kjmax,knumber)
- IMPLICIT NONE
- ! Arguments
- ! INTEGER, DIMENSION(:),ALLOCATABLE :: kimin,kimax, kjmin,kjmax
- INTEGER, INTENT(INOUT) :: knumber
- INTEGER, DIMENSION(knumber) :: kimin,kimax, kjmin,kjmax
- ! CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cdsection
- CHARACTER(LEN=256), DIMENSION(knumber) :: cdsection
- CHARACTER(LEN=*), INTENT(IN) :: cdfile
+ SUBROUTINE section_init(cdfile, cdsection, kimin, kimax, kjmin, kjmax, knumber)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE section_init ***
+ !!
+ !! ** Purpose : Read input ASCII file that defines section names and limit of
+ !! sections.
+ !!
+ !! ** Method : At fisrt call only return the number of sections for further
+ !! allocation.
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in ) :: cdfile
+ CHARACTER(LEN=256), DIMENSION(knumber), INTENT(out ) :: cdsection
+ INTEGER(KIND=4), INTENT(inout) :: knumber
+ INTEGER(KIND=4), DIMENSION(knumber), INTENT(out ) :: kimin, kimax, kjmin, kjmax
! Local variables
- INTEGER :: ii, numit=10, jsec
- CHARACTER(LEN=256) :: cline
- LOGICAL :: lfirst
-
- lfirst=.FALSE.
- IF ( knumber == 0 ) lfirst=.TRUE.
-
- OPEN(numit, FILE=cdfile)
- REWIND(numit)
- ii=0
-
+ INTEGER(KIND=4) :: jsec
+ INTEGER(KIND=4) :: ii, inum=10
+ CHARACTER(LEN=256) :: cline
+ LOGICAL :: llfirst
+ !!----------------------------------------------------------------------
+ llfirst=.FALSE.
+ IF ( knumber == 0 ) llfirst=.TRUE.
+
+ OPEN(inum, FILE=cdfile)
+ REWIND(inum)
+ ii = 0
+
+ ! read the file just to count the number of sections
DO
- READ(numit,'(a)') cline
+ READ(inum,'(a)') cline
IF (INDEX(cline,'EOF') == 0 ) THEN
- READ(numit,*) ! skip one line
+ READ(inum,*) ! skip one line
ii = ii + 1
ELSE
EXIT
ENDIF
END DO
-
knumber=ii
- IF ( lfirst ) RETURN
- ! ALLOCATE( cdsection(knumber) )
- ! ALLOCATE( kimin(knumber), kimax(knumber), kjmin(knumber), kjmax(knumber) )
- REWIND(numit)
+ IF ( llfirst ) RETURN
+
+ REWIND(inum)
DO jsec=1,knumber
- READ(numit,'(a)') cdsection(jsec)
- READ(numit,*) kimin(jsec), kimax(jsec), kjmin(jsec), kjmax(jsec)
+ READ(inum,'(a)') cdsection(jsec)
+ READ(inum,* ) kimin(jsec), kimax(jsec), kjmin(jsec), kjmax(jsec)
END DO
- CLOSE(numit)
+ CLOSE(inum)
END SUBROUTINE section_init
+ SUBROUTINE bimg_writ( ksec)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE bimg_writ ***
+ !!
+ !! ** Purpose : Write output bimg files if required
+ !!
+ !! ** Method : Most of the variables are global
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: ksec ! number of the section
+
+ INTEGER(KIND=4) :: ji, jk
+ !!----------------------------------------------------------------------
+ ! (along section, depth ) 2D variables
+ cf_bimg=TRIM(csection(ksec))//'_trpdep.bimg'
+ OPEN(numbimg,FILE=cf_bimg,FORM='UNFORMATTED')
+ cldum=' 4 dimensions in this isopycnal file '
+ WRITE(numbimg) cldum
+
+ cldum=' 1: T ; 2: S ; 3: sigma ; 4: Velocity '
+ WRITE(numbimg) cldum
+
+ WRITE(cldum,'(a,4i5.4)') ' from '//TRIM(csection(ksec)), iimin,iimax,ijmin,ijmax
+ WRITE(numbimg) cldum
+
+ cldum=' file '//TRIM(cf_tfil)
+ WRITE(numbimg) cldum
+
+ WRITE(numbimg) npts,nk,1,1,4,0
+ WRITE(numbimg) 1.,-float(nk),1.,1., 0.
+ WRITE(numbimg) 0.
+ WRITE(numbimg) 0.
+
+ WRITE(numbimg) (( REAL(zt(ji,jk) ), ji=1,npts), jk=nk,1,-1 ) ! temperature
+ WRITE(numbimg) (( REAL(zs(ji,jk) ), ji=1,npts), jk=nk,1,-1 ) ! salinity
+ WRITE(numbimg) (( REAL(dsig(ji,jk)), ji=1,npts), jk=nk,1,-1 ) ! density
+ WRITE(numbimg) (( REAL(zu(ji,jk) ), ji=1,npts), jk=nk,1,-1 ) ! normal velocity
+ CLOSE(numbimg)
+
+ ! (along section, sigma ) 2D variables
+ cf_bimg=TRIM(csection(ksec))//'_trpsig.bimg'
+ OPEN(numbimg,FILE=cf_bimg,FORM='UNFORMATTED')
+ cldum=' 3 dimensions in this isopycnal file '
+ WRITE(numbimg) cldum
+ cldum=' 1: hiso ; 2: bin trp ; 3: cumulated trp '
+ WRITE(numbimg) cldum
+ WRITE(cldum,'(a,4i5.4)') ' from '//TRIM(csection(ksec)), iimin,iimax,ijmin,ijmax
+ WRITE(numbimg) cldum
+ cldum=' file '//TRIM(cf_tfil)
+ WRITE(numbimg) cldum
+ WRITE(numbimg) npts,nbins,1,1,3,0
+ WRITE(numbimg) 1.,-REAL(dsigma_lev(nbins)),1.,REAL(dltsig), 0.
+ WRITE(numbimg) 0.
+ WRITE(numbimg) 0.
+ WRITE(numbimg) (( REAL(dhiso(ji,jiso) ), ji=1,npts), jiso=nbins,1,-1) ! isopyc depth
+ WRITE(numbimg) (( REAL(dwtrpbin(ji,jiso))/1.e6, ji=1,npts), jiso=nbins,1,-1) ! binned transport
+ WRITE(numbimg) (( REAL(dwtrp(ji,jiso) )/1.e6, ji=1,npts), jiso=nbins,1,-1) ! cumulated transport
+ CLOSE(numbimg)
+
+ END SUBROUTINE bimg_writ
+
+ SUBROUTINE cdf_writ( ksec)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE cdf_writ ***
+ !!
+ !! ** Purpose : Write output cdf files if required
+ !!
+ !! ** Method : Most of the variables are global
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: ksec ! number of the section
+
+ INTEGER(KIND=4) :: ji, jk
+ INTEGER(KIND=4) :: ivar
+ INTEGER(KIND=4) :: icout
+ INTEGER(KIND=4), DIMENSION(4) :: ipk, id_varout
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zdum
+ TYPE(variable), DIMENSION(4) :: sl_typvar
+ !!----------------------------------------------------------------------
+ ALLOCATE ( zdum(npts,1))
+ ! (along section, depth ) 2D variables
+ cf_nc=TRIM(csection(ksec))//'_secdep.nc'
+ ! define variables
+ ipk(:)=nk
+ sl_typvar%rmissing_value = 0.
+ sl_typvar%rmissing_value = 0.
+ sl_typvar%scale_factor = 1.
+ sl_typvar%add_offset = 0.
+ sl_typvar%savelog10 = 0.
+ sl_typvar%iwght = iweight
+ sl_typvar%conline_operation = 'N/A'
+ sl_typvar%caxis = 'XZT'
+
+ ivar=1
+ sl_typvar(ivar)%cname = 'temperature'
+ sl_typvar(ivar)%cunits = 'Celsius'
+ sl_typvar(ivar)%valid_min = -2.
+ sl_typvar(ivar)%valid_max = 45.
+ sl_typvar(ivar)%clong_name = 'Potential_temperature'
+ sl_typvar(ivar)%cshort_name = 'temperature'
+
+ ivar=ivar+1
+ sl_typvar(ivar)%cname = 'salinity'
+ sl_typvar(ivar)%cunits = 'PSU'
+ sl_typvar(ivar)%valid_min = 0.
+ sl_typvar(ivar)%valid_max = 45.
+ sl_typvar(ivar)%clong_name = 'Salinity'
+ sl_typvar(ivar)%cshort_name = 'salinity'
+
+ ivar=ivar+1
+ sl_typvar(ivar)%cname = 'density'
+ sl_typvar(ivar)%cunits = 'kg/m3 -1000'
+ sl_typvar(ivar)%valid_min = 0.
+ sl_typvar(ivar)%valid_max = 45.
+ sl_typvar(ivar)%clong_name = 'potential_density'
+ sl_typvar(ivar)%cshort_name = 'density'
+
+ ivar=ivar+1
+ sl_typvar(ivar)%cname = 'velocity'
+ sl_typvar(ivar)%cunits = 'm/s'
+ sl_typvar(ivar)%valid_min = -3.
+ sl_typvar(ivar)%valid_max = 3.
+ sl_typvar(ivar)%clong_name = 'Normal_velocity'
+ sl_typvar(ivar)%cshort_name = 'velocity'
+
+ icout = create (cf_nc, 'none', npts, 1, nk, cdep=cn_vdeptht )
+ ierr = createvar (icout, sl_typvar, ivar, ipk, id_varout, cdglobal=TRIM(cglobal) )
+ ierr = putheadervar(icout, cf_tfil, npts, 1, nk, &
+ & pnavlon=rlonlat, pnavlat=rlonlat, cdep=cn_vdeptht )
+
+! tim = getvar1d(cf_tfil, cn_vtimec, 1 )
+! ierr = putvar1d(icout, tim, 1, 'T')
+
+ DO jk = 1, nk
+ zdum(:,1)=zt(:,jk) ; ierr = putvar ( icout, id_varout(1), zdum, jk, npts, 1 )
+ zdum(:,1)=zs(:,jk) ; ierr = putvar ( icout, id_varout(2), zdum, jk, npts, 1 )
+ zdum(:,1)=dsig(:,jk) ; ierr = putvar ( icout, id_varout(3), zdum, jk, npts, 1 )
+ zdum(:,1)=zu(:,jk) ; ierr = putvar ( icout, id_varout(4), zdum, jk, npts, 1 )
+ END DO
+
+ ierr = closeout(icout)
+
+ ! (along section, sigma ) 2D variables
+ cf_nc=TRIM(csection(ksec))//'_secsig.nc'
+ ! define variables
+ ipk(:)=nbins
+ sl_typvar%rmissing_value = 99999.
+ sl_typvar%rmissing_value = 99999.
+ sl_typvar%scale_factor = 1.
+ sl_typvar%add_offset = 0.
+ sl_typvar%savelog10 = 0.
+ sl_typvar%iwght = iweight
+ sl_typvar%conline_operation = 'N/A'
+ sl_typvar%caxis = 'XST'
+
+ ivar=1
+ ipk(ivar)=nbins-1
+ sl_typvar(ivar)%cname = 'isodep'
+ sl_typvar(ivar)%cunits = 'm'
+ sl_typvar(ivar)%valid_min = 0.
+ sl_typvar(ivar)%valid_max = 6000.
+ sl_typvar(ivar)%clong_name = 'isopycnal_depth'
+ sl_typvar(ivar)%cshort_name = 'isodep'
+
+ ivar=ivar+1
+ sl_typvar(ivar)%cname = 'bintrp'
+ sl_typvar(ivar)%cunits = 'SV'
+ sl_typvar(ivar)%valid_min = -5.
+ sl_typvar(ivar)%valid_max = 5.
+ sl_typvar(ivar)%clong_name = 'Binned_transport'
+ sl_typvar(ivar)%cshort_name = 'bintrp'
+
+ ivar=ivar+1
+ sl_typvar(ivar)%cname = 'sumtrp'
+ sl_typvar(ivar)%cunits = 'SV'
+ sl_typvar(ivar)%valid_min = -20.
+ sl_typvar(ivar)%valid_max = 20.
+ sl_typvar(ivar)%clong_name = 'cumulated_transport'
+ sl_typvar(ivar)%cshort_name = 'sumtrp'
+
+ icout = create (cf_nc, 'none', npts, 1, nbins, cdep='levels' )
+ ierr = createvar (icout, sl_typvar, ivar, ipk, id_varout, cdglobal=TRIM(cglobal) )
+ ierr = putheadervar(icout, cf_tfil, npts, 1, nbins, &
+ & pnavlon=rlonlat, pnavlat=rlonlat, pdep=REAL(dsigma_lev), cdep='levels' )
+
+ PRINT *, 'NBINS', nbins, npts
+ DO jk = 1, nbins-1
+ zdum(:,1)=dhiso (:,jk) ; ierr = putvar ( icout, id_varout(1), zdum, jk, npts, 1 )
+ END DO
+ DO jk = 1, nbins
+ zdum(:,1)=dwtrpbin(:,jk)/1.e6 ; ierr = putvar ( icout, id_varout(2), zdum, jk, npts, 1 )
+ zdum(:,1)=dwtrp (:,jk)/1.e6 ; ierr = putvar ( icout, id_varout(3), zdum, jk, npts, 1 )
+ END DO
+ ierr = closeout(icout)
+
+ DEALLOCATE ( zdum )
+
+ END SUBROUTINE cdf_writ
+
+ SUBROUTINE print_out(ksec)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE print_out ***
+ !!
+ !! ** Purpose : Print results on standard output
+ !!
+ !! ** Method : Most of the variables are global and already known
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: ksec ! number of the section
+
+ INTEGER(KIND=4) :: ji, jk, jiso, jbin
+ !!----------------------------------------------------------------------
+ WRITE(cfmt_9000,'(a,i3,a)') '(i7, ',npts,'f8.3)'
+ WRITE(cfmt_9001,'(a,i3,a)') '(i7, ',npts,'f8.0)'
+ WRITE(cfmt_9002,'(a,i3,a)') '(f7.3,',npts,'f8.0)'
+ WRITE(cfmt_9003,'(a,i3,a)') '(f7.3,',npts,'f8.3)'
+ PRINT *,' T (deg C)'
+ DO jk=1,nk
+ PRINT cfmt_9000, jk, (zt(ji,jk),ji=1,npts)
+ END DO
+
+ PRINT *,' S (PSU)'
+ DO jk=1,nk
+ PRINT cfmt_9000, jk, (zs(ji,jk),ji=1,npts)
+ END DO
+
+ PRINT *,' SIG (kg/m3 - 1000 )'
+ DO jk=1,nk
+ PRINT cfmt_9000, jk, (dsig(ji,jk),ji=1,npts)
+ END DO
+
+ PRINT *,' VELOCITY (cm/s ) '
+ DO jk=1,nk
+ PRINT cfmt_9000, jk, (zu(ji,jk)*100,ji=1,npts)
+ END DO
+
+ PRINT *,' GDEPU (m) '
+ DO jk=1,nk
+ PRINT cfmt_9001,jk, (ddepu(ji,jk)*zmask(ji,jk),ji=1,npts)
+ END DO
+
+ PRINT *, 'E3 (m)'
+ DO jk=1,nk
+ PRINT cfmt_9001,jk, (de3(ji,jk)*zmask(ji,jk),ji=1,npts)
+ END DO
+
+ PRINT *,' DEP ISO ( m )'
+ DO jiso =1, nbins+1
+ PRINT cfmt_9002, dsigma_lev(jiso),(dhiso(ji,jiso),ji=1,npts)
+ END DO
+
+ PRINT *,' TRP SURF --> ISO (SV)'
+ DO jiso =1, nbins+1
+ PRINT cfmt_9003, dsigma_lev(jiso),(dwtrp(ji,jiso)/1.d6,ji=1,npts)
+ END DO
+
+ PRINT *,' TRP bins (SV)'
+ DO jbin =1, nbins
+ PRINT cfmt_9003, dsigma_lev(jbin),(dwtrpbin(ji,jbin)/1.d6,ji=1,npts), dtrpbin(ksec,jbin)/1.d6
+ END DO
+
+
+
+ END SUBROUTINE print_out
END PROGRAM cdfsigtrp
diff --git a/cdfsigtrp2.f90 b/cdfsigtrp2.f90
deleted file mode 100644
index 286132d..0000000
--- a/cdfsigtrp2.f90
+++ /dev/null
@@ -1,394 +0,0 @@
-PROGRAM cdfsigtrp
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfsigtrp ***
- !!
- !! ** Purpose: Compute density class Mass Transports across a section
- !! PARTIAL STEPS version
- !!
- !! ** Method:
- !! -The begining and end point of the section are given in term of f-points index.
- !! -The program works for zonal or meridional sections.
- !! -The section definitions are given in an ASCII FILE dens_section.dat
- !! foreach sections, 2 lines : (i) : section name (String, no blank)
- !! (ii) : imin imax jmin jmax for the section
- !! -Only vertical slices corrsponding to the sections are read in the files.
- !! read metrics, depth, etc
- !! read normal velocity (either vozocrtx oy vomecrty )
- !! read 2 rows of T and S ( i i+1 or j j+1 )
- !! compute the mean value at velocity point
- !! compute sigma0 (can be easily modified for sigmai )
- !! compute the depths of isopyncal surfaces
- !! compute the transport from surface to the isopycn
- !! compute the transport in each class of density
- !! compute the total transport (for information)
- !!
- !! history :
- !! Original : J.M. Molines March 2006
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nbins !: number of density classes
- INTEGER :: ji, jk, jclass, jsec,jiso , jbin,jarg !: dummy loop index
- INTEGER :: narg, iargc, nxtarg !: command line
- INTEGER :: npk, nk !: vertical size, number of wet layers in the section
- INTEGER :: numbimg=10 !: optional bimg logical unit
-
- INTEGER :: nsection !: number of sections (overall)
- INTEGER ,DIMENSION(:), ALLOCATABLE :: imina, imaxa, jmina, jmaxa !: sections limits
- INTEGER :: imin, imax, jmin, jmax !: working section limits
- INTEGER :: npts !: working section number of h-points
-
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdept, gdepw !: depth of T and W points
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zs, zt !: salinity and temperature from file
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: tmpm, tmpz !: temporary arrays
-
- ! double precision for cumulative variables and densities
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: eu !: either e1v or e2u
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zu, e3 , zmask !: velocities e3 and umask
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zsig ,gdepu !: density, depth of vel points
- REAL(KIND=8) :: sigma_min, sigma_max,dsigma !: Min and Max for sigma bining
- REAL(KIND=8) :: sigma,zalfa !: current working sigma
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: sigma_lev !: built array with sigma levels
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: hiso !: depth of isopycns
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwtrp, zwtrpbin, trpbin !: transport arrays
-
- CHARACTER(LEN=256), DIMENSION (:), ALLOCATABLE :: csection !: section name
- CHARACTER(LEN=256) :: cfilet, cfileu, cfilev, cfilesec='dens_section.dat' !: files name
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc' !: coordinates files
- CHARACTER(LEN=256) :: cdum !: dummy string
-
- LOGICAL :: l_merid !: flag is true for meridional working section
- LOGICAL :: l_print=.FALSE. !: flag for printing additional results
- LOGICAL :: l_bimg=.FALSE. !: flag for bimg output
-
- !! * Initialisations
-
- ! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 6 ) THEN
- PRINT *,' Usage : cdfsigtrp gridTfile gridUfile gridVfile sigma_min sigma_max nbins [options]'
- PRINT *,' sigma_min, sigma_max : limit for density bining '
- PRINT *,' nbins : number of bins to use '
- PRINT *,' Possible options :'
- PRINT *,' -print :additional output is send to std output'
- PRINT *,' -bimg : 2D (x=lat/lon, y=sigma) output on bimg file for hiso, cumul trp, trp'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in the current directory'
- PRINT *,' File section.dat must also be in the current directory '
- PRINT *,' Output on standard output '
- STOP
- ENDIF
-
- !! Read arguments
- CALL getarg (1, cfilet)
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
- CALL getarg (4,cdum) ; READ(cdum,*) sigma_min
- CALL getarg (5,cdum) ; READ(cdum,*) sigma_max
- CALL getarg (6,cdum) ; READ(cdum,*) nbins
-
- DO jarg=7, narg
- CALL getarg(jarg,cdum)
- SELECT CASE (cdum)
- CASE ('-print' )
- l_print = .TRUE.
- CASE ('-bimg')
- l_bimg = .TRUE.
- CASE DEFAULT
- PRINT *,' Unknown option ', TRIM(cdum),' ... ignored'
- END SELECT
- END DO
-
- ! Initialise sections from file
- CALL section_init(cfilesec, csection,imina,imaxa,jmina,jmaxa, nsection)
- IF (l_print) PRINT *,nsection, ' found : ', csection
-
- ! Allocate and build sigma levels and section array
- ALLOCATE ( sigma_lev (nbins+1) , trpbin(nsection,nbins) )
-
- sigma_lev(1)=sigma_min
- dsigma=( sigma_max - sigma_min) / nbins
- DO jclass =2, nbins+1
- sigma_lev(jclass)= sigma_lev(1) + (jclass-1) * dsigma
- END DO
-
- ! Look for vertical size of the domain
- npk = getdim (cfilet,'depth')
- ALLOCATE ( gdept(npk), gdepw(npk) )
-
- ! read gdept, gdepw : it is OK even in partial cells, as we never use the bottom gdep
- gdept(:) = getvare3(coordzgr,'gdept', npk)
- gdepw(:) = getvare3(coordzgr,'gdepw', npk)
-
- !! * Main loop on sections
-
- DO jsec=1,nsection
- l_merid=.FALSE.
- imin=imina(jsec) ; imax=imaxa(jsec) ; jmin=jmina(jsec) ; jmax=jmaxa(jsec)
- IF (imin == imax ) THEN ! meridional section
- l_merid=.TRUE.
- npts=jmax-jmin
-
- ELSE IF ( jmin == jmax ) THEN ! zonal section
- npts=imax-imin
-
- ELSE
- PRINT *,' Section ',TRIM(csection(jsec)),' is neither zonal nor meridional :('
- PRINT *,' We skip this section .'
- CYCLE
- ENDIF
-
- ALLOCATE ( zu(npts, npk), zt(npts,npk), zs(npts,npk) ,zsig(npts,0:npk) )
- ALLOCATE ( eu(npts), e3(npts,npk), gdepu(npts, npk), zmask(npts,npk) )
- ALLOCATE ( tmpm(1,npts,2), tmpz(npts,1,2) )
- ALLOCATE ( zwtrp(npts, nbins+1) , hiso(npts,nbins+1), zwtrpbin(npts,nbins) )
-
- zt = 0. ; zs = 0. ; zu = 0. ; gdepu= 0. ; zmask = 0. ; zsig=0.d0
-
- IF (l_merid ) THEN ! meridional section at i=imin=imax
- tmpm(:,:,1)=getvar(coordhgr, 'e2u', 1,1,npts, kimin=imin, kjmin=jmin+1)
- eu(:)=tmpm(1,:,1) ! metrics varies only horizontally
- DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (PS case)
- tmpm(:,:,1)=getvar(coordzgr,'e3u_ps',jk,1,npts, kimin=imin, kjmin=jmin+1, ldiom=.true.)
- e3(:,jk)=tmpm(1,:,1)
- tmpm(:,:,1)=getvar(coordzgr,'e3w_ps',jk,1,npts, kimin=imin, kjmin=jmin+1, ldiom=.true.)
- tmpm(:,:,2)=getvar(coordzgr,'e3w_ps',jk,1,npts, kimin=imin+1, kjmin=jmin+1, ldiom=.true.)
- IF (jk >= 2 ) THEN
- DO ji=1,npts
- gdepu(ji,jk)= gdepu(ji,jk-1) + MIN(tmpm(1,ji,1), tmpm(1,ji,2))
- END DO
- ENDIF
-
- ! Normal velocity
- tmpm(:,:,1)=getvar(cfileu,'vozocrtx',jk,1,npts, kimin=imin, kjmin=jmin+1)
- zu(:,jk)=tmpm(1,:,1)
-
- ! salinity and deduce umask for the section
- tmpm(:,:,1)=getvar(cfilet,'vosaline',jk,1,npts, kimin=imin , kjmin=jmin+1)
- tmpm(:,:,2)=getvar(cfilet,'vosaline',jk,1,npts, kimin=imin+1, kjmin=jmin+1)
- zmask(:,jk)=tmpm(1,:,1)*tmpm(1,:,2)
- WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
- ! do not take special care for land value, as the corresponding velocity point is masked
- zs(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) )
-
- ! limitation to 'wet' points
- IF ( SUM(zs(:,jk)) == 0 ) THEN
- nk=jk ! first vertical point of the section full on land
- EXIT ! as soon as all the points are on land
- ENDIF
-
- ! temperature
- tmpm(:,:,1)=getvar(cfilet,'votemper',jk,1,npts, kimin=imin, kjmin=jmin+1)
- tmpm(:,:,2)=getvar(cfilet,'votemper',jk,1,npts, kimin=imin+1, kjmin=jmin+1)
- zt(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) )
-
- END DO
-
- ELSE ! zonal section at j=jmin=jmax
- tmpz(:,:,1)=getvar(coordhgr, 'e1v', 1,npts,1,kimin=imin, kjmin=jmin)
- eu=tmpz(:,1,1)
- DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (PS case)
- tmpz(:,:,1)=getvar(coordzgr,'e3v_ps',jk, npts, 1, kimin=imin+1, kjmin=jmin, ldiom=.true.)
- e3(:,jk)=tmpz(:,1,1)
- tmpz(:,:,1)=getvar(coordzgr,'e3w_ps',jk,npts,1, kimin=imin+1, kjmin=jmin, ldiom=.true.)
- tmpz(:,:,2)=getvar(coordzgr,'e3w_ps',jk,npts,1, kimin=imin+1, kjmin=jmin+1, ldiom=.true.)
- IF (jk >= 2 ) THEN
- DO ji=1,npts
- gdepu(ji,jk)= gdepu(ji,jk-1) + MIN(tmpz(ji,1,1), tmpz(ji,1,2))
- END DO
- ENDIF
-
- ! Normal velocity
- tmpz(:,:,1)=getvar(cfilev,'vomecrty',jk,npts,1, kimin=imin+1, kjmin=jmin)
- zu(:,jk)=tmpz(:,1,1)
-
- ! salinity and mask
- tmpz(:,:,1)=getvar(cfilet,'vosaline',jk, npts, 1, kimin=imin+1, kjmin=jmin)
- tmpz(:,:,2)=getvar(cfilet,'vosaline',jk, npts, 1, kimin=imin+1, kjmin=jmin+1)
- zmask(:,jk)=tmpz(:,1,1)*tmpz(:,1,2)
- WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
- ! do not take special care for land value, as the corresponding velocity point is masked
- zs(:,jk) = 0.5 * ( tmpz(:,1,1) + tmpz(:,1,2) )
-
- ! limitation to 'wet' points
- IF ( SUM(zs(:,jk)) == 0 ) THEN
- nk=jk ! first vertical point of the section full on land
- EXIT ! as soon as all the points are on land
- ENDIF
-
- ! temperature
- tmpz(:,:,1)=getvar(cfilet,'votemper',jk, npts, 1, kimin=imin+1, kjmin=jmin)
- tmpz(:,:,2)=getvar(cfilet,'votemper',jk, npts, 1, kimin=imin+1, kjmin=jmin+1)
- zt(:,jk) = 0.5 * ( tmpz(:,1,1) + tmpz(:,1,2) )
- END DO
-
- ENDIF
-
- ! compute density only for wet points
- zsig(:,1:nk)=sigma0( zt, zs, npts, nk)*zmask(:,:)
- zsig(:,0)=zsig(:,1)-1.e-4 ! dummy layer for easy interpolation
-
- ! Some control print
- IF ( l_print ) THEN
- PRINT *,' SIG (kg/m3 - 1000 )'
- DO jk=1,nk
- PRINT 9000, jk, (zsig(ji,jk),ji=1,npts)
- END DO
-
- PRINT *,' GDEPU (m) '
- DO jk=1,nk
- PRINT 9001,jk, (gdepu(ji,jk)*zmask(ji,jk),ji=1,npts)
- END DO
-
- PRINT *, 'E3 (m)'
- DO jk=1,nk
- PRINT 9001,jk, (e3(ji,jk)*zmask(ji,jk),ji=1,npts)
- END DO
- END IF
-
- ! compute depth of isopynals (nbins+1 )
- IF (l_print ) PRINT *,' DEP ISO '
- DO jiso =1, nbins+1
- sigma=sigma_lev(jiso)
-!!! REM : I and K loop can be inverted if necessary
- DO ji=1,npts
- hiso(ji,jiso) = gdept(npk)
- DO jk=1,nk
- IF ( zsig(ji,jk) < sigma ) THEN
- ELSE
- ! interpolate between jk-1 and jk
- zalfa=(sigma - zsig(ji,jk-1)) / ( zsig(ji,jk) -zsig(ji,jk-1) )
- IF (ABS(zalfa) > 1.1 ) THEN ! case zsig(0) = zsig(1)-1.e-4
- hiso(ji,jiso)= 0.
- ELSE
- hiso(ji,jiso)= gdepu(ji,jk)*zalfa + (1.-zalfa)* gdepu(ji,jk-1)
- ENDIF
- EXIT
- ENDIF
- END DO
- END DO
- IF (l_print) PRINT 9002, sigma,(hiso(ji,jiso),ji=1,npts)
- END DO
-
- ! compute transport between surface and isopycn
- IF (l_print) PRINT *,' TRP SURF --> ISO (SV)'
- DO jiso = 1, nbins + 1
- sigma=sigma_lev(jiso)
- DO ji=1,npts
- zwtrp(ji,jiso) = 0
- DO jk=1, nk
- IF ( gdepw(jk) < hiso(ji,jiso) ) THEN
- zwtrp(ji,jiso)= zwtrp(ji,jiso) + eu(ji)*e3(ji,jk)*zu(ji,jk)
- ELSE ! last box ( fraction)
- zwtrp(ji,jiso)= zwtrp(ji,jiso) + eu(ji)*(hiso(ji,jiso)-gdepw(jk))*zu(ji,jk)
- EXIT ! jk loop
- ENDIF
- END DO
- END DO
- IF (l_print) PRINT 9003, sigma,(zwtrp(ji,jiso)/1.e6,ji=1,npts)
- END DO
-
- ! binned transport : difference between 2 isopycns
- IF (l_print) PRINT *,' TRP bins (SV)'
- DO jbin=1, nbins
- DO ji=1, npts
- zwtrpbin(ji,jbin) = zwtrp(ji,jbin+1) - zwtrp(ji,jbin)
- END DO
- trpbin(jsec,jbin)=SUM(zwtrpbin(:,jbin) )
- IF (l_print) PRINT 9000, jbin,(zwtrpbin(ji,jbin)/1.e6,ji=1,npts), trpbin(jsec,jbin)/1.e6
- END DO
- PRINT *,' Total transport in all bins :',TRIM(csection(jsec)),' ',SUM(trpbin(jsec,:) )/1.e6
-
- ! output of the code for 1 section
- IF (l_bimg) THEN
- cdum=TRIM(csection(jsec))//'.bimg'
- OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED')
- cdum=' 3 dimensions in this isopycnal file '
- WRITE(numbimg) cdum
- cdum=' 1: hiso ; 2: cumulated trp ; 3: bin trp '
- WRITE(numbimg) cdum
- WRITE(cdum,'(a,4i5.4)') ' from '//TRIM(csection(jsec)), imin,imax,jmin,jmax
- WRITE(numbimg) cdum
- cdum=' file '//TRIM(cfilet)
- WRITE(numbimg) cdum
- WRITE(numbimg) npts,nbins,1,1,3,0
- WRITE(numbimg) 1.,-REAL(sigma_lev(nbins)),1.,REAL(dsigma), 0.
- WRITE(numbimg) 0.
- WRITE(numbimg) 0.
- ! hiso
- WRITE(numbimg) (( REAL(hiso(ji,jiso)), ji=1,npts) , jiso=nbins,1,-1)
- ! cumulated transport
- WRITE(numbimg) (( REAL(zwtrp(ji,jiso))/1.e6, ji=1,npts) , jiso=nbins,1,-1)
- ! binned transport
- WRITE(numbimg) (( REAL(zwtrpbin(ji,jiso))/1.e6, ji=1,npts) , jiso=nbins,1,-1)
- CLOSE(numbimg)
- ENDIF
-
- ! free memory for the next section
- DEALLOCATE ( zu,zt, zs ,zsig ,gdepu, hiso, zwtrp, zwtrpbin )
- DEALLOCATE ( eu, e3 ,tmpm, tmpz,zmask )
-
- END DO ! next section
-
-9000 FORMAT(i7,25f8.3)
-9001 FORMAT(i7,25f8.0)
-9002 FORMAT(f7.3,25f8.0)
-9003 FORMAT(f7.3,25f8.3)
-
-CONTAINS
- SUBROUTINE section_init(cdfile,cdsection,kimin,kimax,kjmin,kjmax,knumber)
- IMPLICIT NONE
- ! Arguments
- INTEGER, DIMENSION(:), ALLOCATABLE :: kimin,kimax, kjmin,kjmax
- INTEGER, INTENT(OUT) :: knumber
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cdsection
- CHARACTER(LEN=*), INTENT(IN) :: cdfile
-
- ! Local variables
- INTEGER :: ii, numit=10, jsec
- CHARACTER(LEN=256) :: cline
-
- OPEN(numit, FILE=cdfile)
- ii=0
-
- DO
- READ(numit,'(a)') cline
- IF (INDEX(cline,'EOF') == 0 ) THEN
- READ(numit,*) ! skip one line
- ii = ii + 1
- ELSE
- EXIT
- ENDIF
- END DO
-
- knumber=ii
- ALLOCATE( cdsection(knumber) )
- ALLOCATE( kimin(knumber), kimax(knumber), kjmin(knumber), kjmax(knumber) )
- REWIND(numit)
- DO jsec=1,knumber
- READ(numit,'(a)') cdsection(jsec)
- READ(numit,*) kimin(jsec), kimax(jsec), kjmin(jsec), kjmax(jsec)
- END DO
-
- CLOSE(numit)
-
- END SUBROUTINE section_init
-
-
-END PROGRAM cdfsigtrp
diff --git a/cdfsmooth.f90 b/cdfsmooth.f90
index c37ca96..d40b081 100644
--- a/cdfsmooth.f90
+++ b/cdfsmooth.f90
@@ -1,448 +1,517 @@
PROGRAM cdfsmooth
- !!----------------------------------------------------------------------------
- !! *** PROGRAM cdfsmooth ***
- !!
- !! ** Purpose : perform a spatial filtering on input file.
- !! - various filters are available :
+ !!======================================================================
+ !! *** PROGRAM cdfsmooth ***
+ !!=====================================================================
+ !! ** Purpose : perform a spatial filtering on input file.
+ !! - various filters are available :
!! 1: Lanczos (default)
!! 2: hanning
!! 3: shapiro
- !! ... : to be completed
!!
- !! ** Method : read file level by level and perform a x direction filter, then y direction filter
+ !! ** Method : read file level by level and perform a x direction
+ !! filter, then y direction filter
!!
- !! * history:
- !! Original : J.M. Molines 1995 for SPEM
- !! In Dr. Form October 2002
- !! in cdftools J.M. Molines (July 2007)
- !!----------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Used moules
+ !! History : -- : 1995 : J.M. Molines : Original code for spem
+ !! : 2.1 : 07/2007 : J.M. Molines : port in cdftools
+ !! : 2.1 : 05/2010 : R. Dussin : Add shapiro filter
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! filterinit : initialise weight
+ !! filter : main routine for filter computation
+ !! initlanc : initialise lanczos weights
+ !! inithann : initialise hanning weights
+ !! initshap : initialise shapiro routine
+ !! initbox : initialize weight for box car average
+ !! lislanczos2d : Lanczos filter
+ !! lishan2d : hanning 2d filter
+ !! lisshapiro1d : shapiro filter
+ !! lisbox : box car filter
+ !!----------------------------------------------------------------------
USE cdfio
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
!
- INTEGER :: npiglo, npjglo, npk, nt
- !
- INTEGER :: ji,jj, jk, jt, jvar
- INTEGER :: narg, iargc
- INTEGER :: ncoup, nband
- INTEGER :: nfilter=1
- INTEGER, DIMENSION(:,:), ALLOCATABLE :: iw !: flag for bad values (or land masked )
- !
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d,w2d !: raw data, filtered result
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: h !: depth
- REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: ec,e !: weigh in r8, starting index 0 :nband
- REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: ec2d
- REAL(KIND=4) :: fn, spval
- !
- CHARACTER(LEN=256) :: cfile,cnom, cfilout, cdep, ctim
- ! cdf stuff
- INTEGER :: nvars, ierr
- INTEGER :: ncout
- INTEGER , DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim
- CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
-
- TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar
- ! ---
-
+ INTEGER(KIND=4), PARAMETER :: jp_lanc=1 ! lancszos id
+ INTEGER(KIND=4), PARAMETER :: jp_hann=2 ! hanning id
+ INTEGER(KIND=4), PARAMETER :: jp_shap=3 ! shapiro id
+ INTEGER(KIND=4), PARAMETER :: jp_boxc=4 ! box car id
+ INTEGER(KIND=4) :: jk, jt, jvar ! dummy loop index
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: narg, iargc ! browse arguments
+ INTEGER(KIND=4) :: ncut, nband ! cut period/ length, bandwidth
+ INTEGER(KIND=4) :: nfilter = jp_lanc ! default value
+ INTEGER(KIND=4) :: nvars, ierr ! number of vars
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: iw ! flag for bad values (or land masked )
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! arrays of var id's
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk ! arrays of vertical level for each var
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varout ! id of output variables
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d, w2d ! raw data, filtered result
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time array
+ REAL(KIND=4) :: fn, rspval ! cutoff freq/wavelength, spval
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dec2d ! working array
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dec, de ! weight in r8, starting index 0:nband
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! struture for attribute
+
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! array of var name
+ CHARACTER(LEN=256) :: cf_in, cf_out ! file names
+ CHARACTER(LEN=256) :: cv_dep, cv_tim ! variable name for depth and time
+ CHARACTER(LEN=256) :: ctyp ! filter type
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- ! * Initializations
- !
narg=iargc()
- IF (narg == 0) THEN
- PRINT *,' >>>> cdfsmooth usage : cdfsmooth <filename> n(dx) [ filtertype] '
- PRINT *,' filename = ncdf file with input data'
- PRINT *,' n = number of grid step to filter '
- PRINT *,' Filtertype = optional argument either '
- PRINT *,' for Lanczos : Lanczos, l , L '
- PRINT *,' for Hanning : Hanning, H, h '
- PRINT *,' for Shapiro : Shapiro, S, s '
- PRINT *,' for Box : Box, B, b '
- PRINT *,' output is done on ''filename''.smooth'
- PRINT *,' where smooth is either L H or S.'
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfsmooth IN-file ncut [filter_type]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Perform a spatial smoothing on the file using a particular'
+ PRINT *,' filter as specified in the option. Available filters'
+ PRINT *,' are : Lanczos, Hanning, Shapiro, Box car average. Default'
+ PRINT *,' is Lanczos filter.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : input data file. All variables will be filtered'
+ PRINT *,' ncut : number of grid step to be filtered'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [filter_type] : Lanczos, L, l (default)'
+ PRINT *,' Hanning, H, h'
+ PRINT *,' Shapiro, S, s'
+ PRINT *,' Box , B, b'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' Output file name is build from input file name with indication'
+ PRINT *,' of the filter type (1 letter) and of ncut.'
+ PRINT *,' netcdf file : IN-file[LHSB]ncut'
+ PRINT *,' variables : same as input variables.'
STOP
- END IF
+ ENDIF
!
- CALL getarg(1,cfile)
- CALL getarg(2,cnom)
- READ(cnom,*) ncoup ! remark: for a spatial filter, fn=dx/lambda where dx is spatial step, lamda is cutting wavelength
- fn=1./ncoup
- nband=NINT(2./fn) ! Bandwidth of filter is twice the filter span
- ALLOCATE ( ec(0:nband) , e(0:nband) )
- WRITE(cfilout,'(a,a,i3.3)') TRIM(cfile),'L',ncoup ! default name
+ CALL getarg(1,cf_in)
+ CALL getarg(2,cldum) ; READ(cldum,*) ncut
+ IF ( chkfile(cf_in) ) STOP ! missing file
+
+ ! remark: for a spatial filter, fn=dx/lambda where dx is spatial step, lamda is cutting wavelength
+ fn = 1./ncut
+ nband = 2*ncut ! Bandwidth of filter is twice the filter span
+
+ ALLOCATE ( dec(0:nband) , de(0:nband) )
+
+ WRITE(cf_out,'(a,a,i3.3)') TRIM(cf_in),'L',ncut ! default name
IF ( narg == 3 ) THEN
- CALL getarg(3, cnom)
- SELECT CASE ( cnom)
+ CALL getarg(3, ctyp)
+ SELECT CASE ( ctyp)
CASE ( 'Lanczos','L','l')
- nfilter=1
- WRITE(cfilout,'(a,a,i3.3)') TRIM(cfile),'L',ncoup
+ nfilter=jp_lanc
+ WRITE(cf_out,'(a,a,i3.3)') TRIM(cf_in),'L',ncut
PRINT *,' Working with Lanczos filter'
CASE ( 'Hanning','H','h')
- nfilter=2
- ALLOCATE ( ec2d(0:2,0:2) )
- WRITE(cfilout,'(a,a,i3.3)') TRIM(cfile),'H',ncoup
+ nfilter=jp_hann
+ ALLOCATE ( dec2d(0:2,0:2) )
+ WRITE(cf_out,'(a,a,i3.3)') TRIM(cf_in),'H',ncut
PRINT *,' Working with Hanning filter'
CASE ( 'Shapiro','S','s')
- nfilter=3
- WRITE(cfilout,'(a,a,i3.3)') TRIM(cfile),'S',ncoup
+ nfilter=jp_shap
+ WRITE(cf_out,'(a,a,i3.3)') TRIM(cf_in),'S',ncut
PRINT *,' Working with Shapiro filter'
CASE ( 'Box','B','b')
- nfilter=4
- WRITE(cfilout,'(a,a,i3.3)') TRIM(cfile),'B',ncoup
+ nfilter=jp_boxc
+ WRITE(cf_out,'(a,a,i3.3)') TRIM(cf_in),'B',ncut
PRINT *,' Working with Box filter'
CASE DEFAULT
- PRINT *, TRIM(cnom),' : undefined filter ' ; STOP
+ PRINT *, TRIM(ctyp),' : undefined filter ' ; STOP
END SELECT
ENDIF
- CALL filterinit (nfilter, fn,nband)
+ CALL filterinit (nfilter, fn, nband)
! Look for input file and create outputfile
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=ierr)
+ npiglo = getdim (cf_in,cn_x)
+ npjglo = getdim (cf_in,cn_y)
+ npk = getdim (cf_in,cn_z, cdtrue=cv_dep, kstatus=ierr)
IF ( ierr /= 0 ) THEN
- npk = getdim (cfile,'z',cdtrue=cdep,kstatus=ierr)
+ npk = getdim (cf_in,'z', cdtrue=cv_dep, kstatus=ierr)
IF ( ierr /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=ierr)
+ npk = getdim (cf_in, 'sigma', cdtrue=cv_dep, kstatus=ierr)
IF ( ierr /= 0 ) THEN
- PRINT *,' assume file with no depth'
- npk=0
+ PRINT *,' assume file with no depth'
+ npk=0
ENDIF
ENDIF
ENDIF
- nt = getdim (cfile,'time',cdtrue=ctim)
-
+ npt = getdim (cf_in,cn_t, cdtrue=cv_tim)
+
PRINT *, 'npiglo = ',npiglo
PRINT *, 'npjglo = ',npjglo
PRINT *, 'npk = ',npk
- PRINT *, 'nt = ',nt
+ PRINT *, 'npt = ',npt
- ALLOCATE ( h(npk), v2d(npiglo,npjglo),iw(npiglo,npjglo), w2d(npiglo,npjglo), tim(nt) )
- nvars = getnvar(cfile)
- PRINT *,' nvars =', nvars
- ALLOCATE (cvarname(nvars) )
- ALLOCATE (typvar(nvars) )
+ ALLOCATE ( v2d(npiglo,npjglo),iw(npiglo,npjglo), w2d(npiglo,npjglo), tim(npt) )
+ nvars = getnvar(cf_in)
+ PRINT *, 'nvars = ', nvars
+ ALLOCATE (cv_names(nvars) )
+ ALLOCATE (stypvar(nvars) )
ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars) )
- ! get list of variable names and collect attributes in typvar (optional)
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ ! get list of variable names and collect attributes in stypvar (optional)
+ cv_names(:) = getvarname(cf_in, nvars, stypvar)
! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
- WHERE( ipk == 0 ) cvarname='none'
- typvar(:)%name=cvarname
-
- ! create output file taking the sizes in cfile
- ncout =create(cfilout, cfile,npiglo,npjglo,npk,cdep=cdep)
- print *,ncout, trim(cfilout)
- ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
- ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk,cdep=cdep)
- tim=getvar1d(cfile,ctim,nt)
+ ipk(:) = getipk (cf_in, nvars, cdep=cv_dep)
+ WHERE( ipk == 0 ) cv_names='none'
+ stypvar(:)%cname=cv_names
+
+ ! create output file taking the sizes in cf_in
+ PRINT *, 'Output file name : ', TRIM(cf_out)
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep)
+ ierr = createvar (ncout , stypvar, nvars, ipk, id_varout )
+ ierr = putheadervar(ncout , cf_in, npiglo, npjglo, npk, cdep=cv_dep)
+ tim = getvar1d(cf_in, cv_tim, npt)
!
- DO jvar =1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' .OR. cvarname(jvar) == 'none' ) THEN
+ DO jvar = 1,nvars
+ IF ( cv_names(jvar) == cn_vlon2d .OR. &
+ cv_names(jvar) == cn_vlat2d .OR. cv_names(jvar) == 'none' ) THEN
! skip these variables
ELSE
- spval=typvar(jvar)%missing_value
- print *,'VAR ',TRIM(cvarname(jvar)),' SVPAL=',spval
- !STOP
- DO jt=1,nt
+ rspval=stypvar(jvar)%rmissing_value
+ DO jt=1,npt
DO jk=1,ipk(jvar)
- PRINT *, jt,'/',nt,' and ',jk,'/',ipk(jvar)
- v2d(:,:) = getvar(cfile,cvarname(jvar),jk,npiglo,npjglo,ktime=jt)
+ PRINT *, jt,'/',npt,' and ',jk,'/',ipk(jvar)
+ v2d(:,:) = getvar(cf_in,cv_names(jvar),jk,npiglo,npjglo,ktime=jt)
iw(:,:) = 1
- WHERE ( v2d == spval ) iw =0
- IF ( ncoup .NE. 0 ) CALL filter(nfilter,v2d,iw,w2d)
- IF ( ncoup .EQ. 0 ) w2d=v2d
- w2d=w2d *iw ! mask filtered data
- ierr = putvar(ncout, id_varout(jvar) ,w2d, jk, npiglo, npjglo, jt)
+ WHERE ( v2d == rspval ) iw =0
+ IF ( ncut /= 0 ) CALL filter( nfilter, v2d, iw, w2d)
+ IF ( ncut == 0 ) w2d = v2d
+ w2d = w2d *iw ! mask filtered data
+ ierr = putvar(ncout, id_varout(jvar), w2d, jk, npiglo, npjglo, ktime=jt)
!
END DO
END DO
ENDIF
END DO
- ierr=putvar1d(ncout, tim,nt,'T')
- ierr=closeout(ncout)
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = closeout(ncout )
CONTAINS
SUBROUTINE filterinit(kfilter, pfn, kband)
- INTEGER, INTENT(in) :: kfilter, kband
- REAL(KIND=4),INTENT(in) :: pfn
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE filterinit ***
+ !!
+ !! ** Purpose : initialise weight according to filter type
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kfilter ! filter number
+ REAL(KIND=4), INTENT(in) :: pfn ! filter cutoff frequency/wavelength
+ INTEGER(KIND=4), INTENT(in) :: kband ! filter bandwidth
+ !!----------------------------------------------------------------------
SELECT CASE ( kfilter)
- CASE ( 1 )
- CALL initlanc(pfn,kband)
- CASE ( 2 )
- CALL inithann(pfn,kband)
- CASE ( 3 )
- CALL initshap(pfn, kband)
- CASE ( 4 )
- CALL initbox(pfn, kband)
+ CASE ( jp_lanc )
+ CALL initlanc (pfn, kband)
+ CASE ( jp_hann )
+ CALL inithann (pfn, kband)
+ CASE ( jp_shap )
+ CALL initshap (pfn, kband)
+ CASE ( jp_boxc )
+ CALL initbox (pfn, kband)
END SELECT
+
END SUBROUTINE filterinit
- SUBROUTINE filter (kfilter,px,kpx,py)
- INTEGER, INTENT(in) :: kfilter
- INTEGER , DIMENSION(:,:), INTENT(in) :: kpx
- REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: px
- REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py
+ SUBROUTINE filter (kfilter, px, kpx, py)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE filter ***
+ !!
+ !! ** Purpose : Call the proper filter routine according to filter type
+ !!
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kfilter ! filter number
+ REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: px ! input data
+ INTEGER(KIND=4), DIMENSION(:,:), INTENT(in) :: kpx ! validity flag
+ REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py ! output data
+ !!----------------------------------------------------------------------
SELECT CASE ( kfilter)
- CASE ( 1 )
- CALL lislanczos2d(px,kpx,py,npiglo,npjglo,fn,nband,npiglo,npjglo)
- CASE ( 2 )
- CALL lishan2d(px,iw,py,ncoup,npiglo,npjglo)
- CASE ( 3 )
- CALL lisshapiro1d(px,iw,py,ncoup,npiglo,npjglo)
- CASE ( 4 )
- CALL lisbox(px,kpx,py,npiglo,npjglo,fn,nband,npiglo,npjglo)
+ CASE ( jp_lanc )
+ CALL lislanczos2d (px, kpx, py, npiglo, npjglo, fn, nband)
+ CASE ( jp_hann )
+ CALL lishan2d (px, kpx, py, ncut, npiglo, npjglo)
+ CASE ( jp_shap )
+ CALL lisshapiro1d (px, kpx, py, ncut, npiglo, npjglo)
+ CASE ( jp_boxc )
+ CALL lisbox (px, kpx, py, npiglo, npjglo, fn, nband)
END SELECT
+
END SUBROUTINE filter
- !!
- SUBROUTINE initlanc(pfn,knj)
- INTEGER, INTENT(in) :: knj !: bandwidth
- REAL(KIND=4),INTENT(in) :: pfn
- ! Local variable
- INTEGER :: ji
- REAL(KIND=8) :: zpi,zey, zcoef
- !
- !
- zpi=ACOS(-1.)
- zcoef=2*zpi*pfn
+ SUBROUTINE initlanc(pfn, knj)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE initlanc ***
+ !!
+ !! ** Purpose : initialize lanczos weights
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), INTENT(in) :: pfn ! cutoff freq/wavelength
+ INTEGER(KIND=4), INTENT(in) :: knj ! bandwidth
+
+ INTEGER(KIND=4) :: ji ! dummy loop index
+ REAL(KIND=8) :: dl_pi, dl_ey, dl_coef
+ !!----------------------------------------------------------------------
+ dl_pi = ACOS(-1.d0)
+ dl_coef = 2*dl_pi*pfn
- e(0)= 2.*pfn
+ de(0) = 2.d0*pfn
DO ji=1,knj
- e(ji)=SIN(zcoef*ji)/(zpi*ji)
+ de(ji) = SIN(dl_coef*ji)/(dl_pi*ji)
END DO
!
- ec(0) = 2*pfn
+ dec(0) = 2.d0*pfn
DO ji=1,knj
- zey=zpi*ji/knj
- ec(ji)=e(ji)*SIN(zey)/zey
+ dl_ey = dl_pi*ji/knj
+ dec(ji) = de(ji)*SIN(dl_ey)/dl_ey
END DO
- !
+
END SUBROUTINE initlanc
- SUBROUTINE inithann(pfn,knj)
- INTEGER, INTENT(in) :: knj !: bandwidth
- REAL(KIND=4),INTENT(in) :: pfn
- REAL(KIND=4) :: zsum
- ec2d(:,:) = 0.
+ SUBROUTINE inithann(pfn, knj)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE inithann ***
+ !!
+ !! ** Purpose : Initialize hanning weight
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), INTENT(in) :: pfn ! cutoff freq/wavelength
+ INTEGER(KIND=4), INTENT(in) :: knj ! bandwidth
+
+ REAL(KIND=8) :: dl_sum
+ !!----------------------------------------------------------------------
+ dec2d(:,:) = 0.d0
! central point
- ec2d(1,1) = 4.
+ dec2d(1,1) = 4.d0
! along one direction
- ec2d(1,0) = 1. ; ec2d(1,2) = 1.
+ dec2d(1,0) = 1.d0 ; dec2d(1,2) = 1.d0
! and the other
- ec2d(0,1) = 1. ; ec2d(2,1) = 1.
+ dec2d(0,1) = 1.d0 ; dec2d(2,1) = 1.d0
! normalize
- zsum = SUM(ec2d)
- ec2d(:,:) = ec2d(:,:) / zsum
+ dl_sum = SUM(dec2d)
+ dec2d(:,:) = dec2d(:,:) / dl_sum
END SUBROUTINE inithann
- SUBROUTINE initshap(pfn,knj)
- INTEGER, INTENT(in) :: knj !: bandwidth
- REAL(KIND=4),INTENT(in) :: pfn
-! nothing to do
+ SUBROUTINE initshap(pfn, knj)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE initshap ***
+ !!
+ !! ** Purpose : Dummy routine to respect program structure
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), INTENT(in) :: pfn ! cutoff freq/wavelength
+ INTEGER(KIND=4), INTENT(in) :: knj ! bandwidth
+ !!----------------------------------------------------------------------
+ ! nothing to do
END SUBROUTINE initshap
- SUBROUTINE initbox(pfn,knj)
- INTEGER, INTENT(in) :: knj !: bandwidth
- REAL(KIND=4),INTENT(in) :: pfn
- ! dummy init
- ec(:) = 1.
+
+ SUBROUTINE initbox(pfn, knj)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE initbox ***
+ !!
+ !! ** Purpose : Init weights for box car
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), INTENT(in) :: pfn ! cutoff freq/wavelength
+ INTEGER(KIND=4), INTENT(in) :: knj ! bandwidth
+ !!----------------------------------------------------------------------
+ dec(:) = 1.d0
+
END SUBROUTINE initbox
- SUBROUTINE lislanczos2d(px,kiw,py,knx,kny,pfn,knj,kpi,kpj)
- !----------------------------------------------
- ! px=input data
- ! kiw = validity of input data
- ! py=output filter
- ! n=number of input/output data
- ! knj= bandwith of the filter
- ! pfn= cutoff frequency
- ! Eric Blayo d'apres une source CLS fournie par F. BLANC. et grosse
- ! optimization.
- !--------------------------------------------
- ! * Arguments
- INTEGER, INTENT(in) :: knx, kny, knj, kpi, kpj
- INTEGER,DIMENSION(:,:),INTENT(in) :: kiw
- REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: px
- REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py
- REAL(KIND=4), INTENT(in) :: pfn
-
- ! * local variables
- !
- REAL(KIND=8), DIMENSION(kpi,kpj) :: ztmpx, ztmpy
- REAL(KIND=8) :: zyy, zden
- INTEGER :: ji,jj,jmx,jkx
- INTEGER :: ik1x, ik2x,ikkx
- INTEGER :: ifrst=0
- INTEGER :: inxmin,inxmaxi,inymin,inymaxi
+ SUBROUTINE lislanczos2d(px, kiw, py, kpi, kpj, pfn, knj)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE lislanczos2d ***
+ !!
+ !! ** Purpose : Perform lanczos filter
!!
- ! filtering
+ !! ** Method : px = input data
+ !! kiw = validity of input data
+ !! py = output filter
+ !! kpi,kpj = number of input/output data
+ !! pfn = cutoff frequency
+ !! knj = bandwith of the filter
+ !!
+ !! References : E. Blayo (1992) from CLS source and huge optimization
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), DIMENSION(:,:), INTENT(in ) :: px ! input array
+ INTEGER(KIND=4), DIMENSION(:,:), INTENT(in ) :: kiw ! flag input array
+ REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py ! output array
+ INTEGER(KIND=4), INTENT(in ) :: kpi, kpj ! size of input/output
+ REAL(KIND=4), INTENT(in ) :: pfn ! cutoff frequency/wavelength
+ INTEGER(KIND=4), INTENT(in ) :: knj ! filter bandwidth
+
+ INTEGER(KIND=4) :: ji, jj, jmx, jkx ! dummy loop index
+ INTEGER(KIND=4) :: ik1x, ik2x, ikkx
+ INTEGER(KIND=4) :: ifrst=0
+ INTEGER(KIND=4) :: inxmin, inxmaxi
+ INTEGER(KIND=4) :: inymin, inymaxi
+ REAL(KIND=8), DIMENSION(kpi,kpj) :: dl_tmpx, dl_tmpy
+ REAL(KIND=8) :: dl_yy, dl_den
+ !!----------------------------------------------------------------------
inxmin = knj
- inxmaxi = knx-knj+1
+ inxmaxi = kpi-knj+1
inymin = knj
- inymaxi = kny-knj+1
+ inymaxi = kpj-knj+1
+
PRINT *,' filtering parameters'
- PRINT *,' nx=',knx
- PRINT *,' nband=',knj
- PRINT *,' fn=',pfn
- DO jj=1,kny
- DO jmx=1,knx
+ PRINT *,' nx = ', kpi
+ PRINT *,' nband = ', knj
+ PRINT *,' fn = ', pfn
+
+ DO jj=1,kpj
+ DO jmx=1,kpi
ik1x = -knj
ik2x = knj
!
- IF (jmx <= inxmin) ik1x = 1-jmx
- IF (jmx >= inxmaxi) ik2x = knx-jmx
+ IF (jmx <= inxmin ) ik1x = 1-jmx
+ IF (jmx >= inxmaxi) ik2x = kpi-jmx
!
- zyy = 0.d0
- zden = 0.d0
+ dl_yy = 0.d0
+ dl_den = 0.d0
!
DO jkx=ik1x,ik2x
ikkx=ABS(jkx)
IF (kiw(jkx+jmx,jj) == 1) THEN
- zden=zden+ec(ikkx)
- zyy=zyy+ec(ikkx)*px(jkx+jmx,jj)
+ dl_den = dl_den + dec(ikkx)
+ dl_yy = dl_yy + dec(ikkx)*px(jkx+jmx,jj)
END IF
END DO
!
- ztmpx(jmx,jj)=zyy/zden
+ dl_tmpx(jmx,jj)=dl_yy/dl_den
END DO
END DO
- DO ji=1,knx
- DO jmx=1,kny
+ DO ji=1,kpi
+ DO jmx=1,kpj
ik1x = -knj
ik2x = knj
!
- IF (jmx <= inymin) ik1x=1-jmx
- IF (jmx >= inymaxi) ik2x=kny-jmx
+ IF (jmx <= inymin ) ik1x = 1-jmx
+ IF (jmx >= inymaxi) ik2x = kpj-jmx
!
- zyy=0.d0
- zden=0.d0
+ dl_yy = 0.d0
+ dl_den = 0.d0
!
DO jkx=ik1x,ik2x
ikkx=ABS(jkx)
IF (kiw(ji,jkx+jmx) == 1) THEN
- zden=zden+ec(ikkx)
- zyy=zyy+ec(ikkx)*ztmpx(ji,jkx+jmx)
-! zyy=zyy+ec(ikkx)*px(ji,jkx+jmx)
+ dl_den = dl_den + dec(ikkx)
+ dl_yy = dl_yy + dec(ikkx)*dl_tmpx(ji,jkx+jmx)
END IF
END DO
-! ztmpy(ji,jmx)=zyy/zden
py(ji,jmx)=0.
- IF (zden .NE. 0.) py(ji,jmx)=zyy/zden
+ IF (dl_den /= 0.) py(ji,jmx) = dl_yy/dl_den
END DO
END DO
-! py=0.5*(ztmpx + ztmpy )
!
END SUBROUTINE lislanczos2d
- SUBROUTINE lishan2d(px,kiw,py,order,kpi,kpj)
- !----------------------------------------------
- ! px = input data
- ! kiw = validity of input data
- ! py = output filter
- ! n=number of input/output data
- !--------------------------------------------
- ! * Arguments
- INTEGER, INTENT(in) :: kpi, kpj, order
- INTEGER,DIMENSION(:,:),INTENT(in) :: kiw
- REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: px
- REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py
-
- ! local
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: tmp
- INTEGER :: jiplus1, jiminus1, jjplus1, jjminus1
- INTEGER :: jj, ji, iorder !: loop indexes
-
- ! init the arrays
- ALLOCATE( tmp(kpi,kpj) )
- py(:,:) = 0.
- tmp(:,:) = px(:,:)
-
- DO iorder=1,order
-
- DO jj=2,kpj-1
- DO ji=2,kpi-1
-
- !treatment of the domain frontiers
- jiplus1 = MIN(ji+1,kpi) ; jiminus1 = MAX(ji-1,1)
- jjplus1 = MIN(jj+1,kpj) ; jjminus1 = MAX(jj-1,1)
-
- ! we don't compute in land
- IF ( kiw(ji,jj) == 1 ) THEN
-
- py(ji,jj) = SUM( ec2d(:,:) * tmp(jiminus1:jiplus1,jjminus1:jjplus1) )
-
- ENDIF
-
- ENDDO
- ENDDO
-
- ! update the tmp array
- tmp(:,:) = py(:,:)
-
+ SUBROUTINE lishan2d(px, kiw, py, korder, kpi, kpj)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE lishan2d ***
+ !!
+ !! ** Purpose : compute hanning filter at order korder
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), DIMENSION(:,:), INTENT(in ) :: px ! input data
+ INTEGER(KIND=4), DIMENSION(:,:), INTENT(in ) :: kiw ! validity flags
+ REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py ! output data
+ INTEGER(KIND=4), INTENT(in ) :: korder ! order of the filter
+ INTEGER(KIND=4), INTENT(in ) :: kpi, kpj ! size of the data
+
+ INTEGER(KIND=4) :: jj, ji, jorder ! loop indexes
+ INTEGER(KIND=4) :: iiplus1, iiminus1
+ INTEGER(KIND=4) :: ijplus1, ijminus1
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztmp
+ !!----------------------------------------------------------------------
+ ALLOCATE( ztmp(kpi,kpj) )
+
+ py(:,:) = 0.
+ ztmp(:,:) = px(:,:)
+
+ DO jorder = 1, korder
+ DO jj = 2, kpj-1
+ DO ji = 2, kpi-1
+ !treatment of the domain frontiers
+ iiplus1 = MIN(ji+1,kpi) ; iiminus1 = MAX(ji-1,1)
+ ijplus1 = MIN(jj+1,kpj) ; ijminus1 = MAX(jj-1,1)
+
+ ! we don't compute in land
+ IF ( kiw(ji,jj) == 1 ) THEN
+ py(ji,jj) = SUM( dec2d(:,:) * ztmp(iiminus1:iiplus1,ijminus1:ijplus1) )
+ ENDIF
+ ENDDO
+ ENDDO
+ ! update the ztmp array
+ ztmp(:,:) = py(:,:)
ENDDO
END SUBROUTINE lishan2d
- SUBROUTINE lisshapiro1d(px,kiw,py,order,kpi,kpj)
- !----------------------------------------------
- ! px = input data
- ! kiw = validity of input data
- ! py = output filter
- ! n=number of input/output data
- !
- ! adapted from Mercator code...
- !--------------------------------------------
- ! * Arguments
- INTEGER, INTENT(in) :: kpi, kpj, order
- INTEGER,DIMENSION(:,:),INTENT(in) :: kiw
- REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: px
- REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py
- REAL(KIND=4), PARAMETER :: rp_aniso_diff_XY=2.25 ! anisotrope case
- REAL(KIND=4) :: zalphax, zalphay, znum
-
- ! local
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztmp , zpx , zpy, zkiw
- INTEGER :: imin, imax, halo=0
- INTEGER :: jj, ji, iorder !: loop indexes
-
- LOGICAL :: cycl = .true.
-
- !PRINT *, 'east-west periodicity is assumed ' , cycl
-
- IF(cycl) halo=1
- ! we allocate with an halo
- ALLOCATE( ztmp(0:kpi+halo,kpj) , zpx(0:kpi+halo,kpj) , zpy(0:kpi+halo,kpj) , zkiw(0:kpi+halo,kpj) )
-
- IF(cycl) THEN
- zpx(1:kpi,:) = px(:,:) ; zkiw(1:kpi,:) = kiw(:,:)
- zpx(0,:) = px(kpi,:) ; zkiw(0,:) = kiw(kpi,:)
- zpx(kpi+1,:) = px(1,:) ; zkiw(kpi+1,:) = kiw(1,:)
+ SUBROUTINE lisshapiro1d(px, kiw, py, korder, kpi, kpj)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE lisshapiro1d ***
+ !!
+ !! ** Purpose : compute shapiro filter
+ !!
+ !! References : adapted from Mercator code
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), DIMENSION(:,:), INTENT(in ) :: px ! input data
+ INTEGER(KIND=4), DIMENSION(:,:), INTENT(in ) :: kiw ! validity flags
+ REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py ! output data
+ INTEGER(KIND=4), INTENT(in ) :: korder ! order of the filter
+ INTEGER(KIND=4), INTENT(in ) :: kpi, kpj ! size of the data
+
+ INTEGER(KIND=4) :: jj, ji, jorder ! loop indexes
+ INTEGER(KIND=4) :: imin, imax, ihalo=0
+ REAL(KIND=4), PARAMETER :: rp_aniso_diff_XY = 2.25 ! anisotrope case
+ REAL(KIND=4) :: zalphax, zalphay, znum
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztmp , zpx , zpy, zkiw
+ LOGICAL :: ll_cycl = .TRUE.
+ !!----------------------------------------------------------------------
+
+ IF(ll_cycl) ihalo=1
+ ! we allocate with an ihalo
+ ALLOCATE( ztmp(0:kpi+ihalo,kpj) , zkiw(0:kpi+ihalo,kpj) )
+ ALLOCATE( zpx (0:kpi+ihalo,kpj) , zpy (0:kpi+ihalo,kpj) )
+
+ IF(ll_cycl) THEN
+ zpx(1:kpi,:) = px(: ,:) ; zkiw(1:kpi,:) = kiw(: ,:)
+ zpx(0 ,:) = px(kpi,:) ; zkiw(0 ,:) = kiw(kpi,:)
+ zpx(kpi+1,:) = px(1 ,:) ; zkiw(kpi+1,:) = kiw(1 ,:)
ELSE
- zpx(:,:) = px(:,:)
+ zpx(: ,:) = px(: ,:)
ENDIF
- zpy(:,:) = zpx(:,:) ! init?
+ zpy (:,:) = zpx(:,:) ! init?
ztmp(:,:) = zpx(:,:) ! init
zalphax=1./2.
@@ -454,75 +523,77 @@ CONTAINS
IF ( rp_aniso_diff_XY >= 1. ) zalphay=zalphay/rp_aniso_diff_XY
IF ( rp_aniso_diff_XY < 1. ) zalphax=zalphax*rp_aniso_diff_XY
- DO iorder=1,order
-
- imin=2-halo
- imax=kpi-1+halo
-
- DO ji = imin,imax
- DO jj = 2,kpj-1
- ! We crop on the coast
- znum = ztmp(ji,jj) &
- + 0.25*zalphax*(ztmp(ji-1,jj )-ztmp(ji,jj))*zkiw(ji-1,jj) &
- + 0.25*zalphax*(ztmp(ji+1,jj )-ztmp(ji,jj))*zkiw(ji+1,jj) &
- + 0.25*zalphay*(ztmp(ji ,jj-1)-ztmp(ji,jj))*zkiw(ji ,jj-1) &
- + 0.25*zalphay*(ztmp(ji ,jj+1)-ztmp(ji,jj))*zkiw(ji ,jj+1)
- zpy(ji,jj)=znum*zkiw(ji,jj)+zpx(ji,jj)*(1.-zkiw(ji,jj))
- ENDDO ! end loop ji
- ENDDO ! end loop jj
-
- IF(cycl) THEN
- zpy(0,:) = zpy(kpi,:)
- zpy(kpi+1,:) = zpy(1,:)
- ENDIF
-
- ! update the tmp array
- ztmp(:,:) = zpy(:,:)
+ DO jorder=1,korder
+ imin = 2 - ihalo
+ imax = kpi-1 + ihalo
+ DO ji = imin,imax
+ DO jj = 2,kpj-1
+ ! We crop on the coast
+ znum = ztmp(ji,jj) &
+ & + 0.25*zalphax*(ztmp(ji-1,jj )-ztmp(ji,jj))*zkiw(ji-1,jj ) &
+ & + 0.25*zalphax*(ztmp(ji+1,jj )-ztmp(ji,jj))*zkiw(ji+1,jj ) &
+ & + 0.25*zalphay*(ztmp(ji ,jj-1)-ztmp(ji,jj))*zkiw(ji ,jj-1) &
+ & + 0.25*zalphay*(ztmp(ji ,jj+1)-ztmp(ji,jj))*zkiw(ji ,jj+1)
+ zpy(ji,jj) = znum*zkiw(ji,jj)+zpx(ji,jj)*(1.-zkiw(ji,jj))
+ ENDDO ! end loop ji
+ ENDDO ! end loop jj
+
+ IF ( ll_cycl ) THEN
+ zpy(0 ,:) = zpy(kpi,:)
+ zpy(kpi+1,:) = zpy(1 ,:)
+ ENDIF
+
+ ! update the tmp array
+ ztmp(:,:) = zpy(:,:)
ENDDO
- ! return this array
- IF(cycl) THEN
- py(:,:) = zpy(1:kpi,:)
- ELSE
- py(:,:) = zpy(:,:)
- ENDIF
+ ! return this array
+ IF( ll_cycl ) THEN
+ py(:,:) = zpy(1:kpi,:)
+ ELSE
+ py(:,:) = zpy(: ,:)
+ ENDIF
END SUBROUTINE lisshapiro1d
- SUBROUTINE lisbox(px,kiw,py,knx,kny,pfn,knj,kpi,kpj)
- !----------------------------------------------
- ! perform a box car 2d filtering, of span knj
- !----------------------------------------------
- ! * Arguments
- INTEGER, INTENT(in) :: knx, kny, knj, kpi, kpj
- INTEGER,DIMENSION(:,:),INTENT(in) :: kiw
- REAL(KIND=4), DIMENSION(:,:), INTENT(in) :: px
- REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py
- REAL(KIND=4), INTENT(in) :: pfn
-
- ! Local vaariables
- INTEGER :: ji,jj, ik1x, ik2x, ik1y, ik2y
- REAL(KIND=8) :: den
- LOGICAL, DIMENSION(kpi,kpj) :: lmask
-
- lmask=.true.
- WHERE (kiw == 0 ) lmask=.false.
- DO ji=1,knx
- ik1x=ji-knj ; ik2x=ji+knj
- ik1x=MAX(1,ik1x) ; ik2x=MIN(knx,ik2x)
- DO jj=1,kny
- ik1y=jj-knj ; ik2y=jj+knj
- ik1y=MAX(1,ik1y) ; ik2y=MIN(kny,ik2y)
- den=SUM(kiw(ik1x:ik2x,ik1y:ik2y) )
- IF ( den /= 0 ) THEN
- py(ji,jj)= SUM(px(ik1x:ik2x,ik1y:ik2y), mask=lmask(ik1x:ik2x,ik1y:ik2y) )/den
- ELSE
- py(ji,jj) = spval
- ENDIF
- END DO
+
+ SUBROUTINE lisbox(px, kiw, py, kpi, kpj, pfn, knj)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE lisbox ***
+ !!
+ !! ** Purpose : Perform box car filtering
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), DIMENSION(:,:), INTENT(in ) :: px ! input array
+ INTEGER(KIND=4), DIMENSION(:,:), INTENT(in ) :: kiw ! flag input array
+ REAL(KIND=4), DIMENSION(:,:), INTENT(out) :: py ! output array
+ INTEGER(KIND=4), INTENT(in ) :: kpi, kpj ! size of input/output
+ REAL(KIND=4), INTENT(in ) :: pfn ! cutoff frequency/wavelength
+ INTEGER(KIND=4), INTENT(in ) :: knj ! filter bandwidth
+
+ INTEGER(KIND=4) :: ji, jj
+ INTEGER(KIND=4) :: ik1x, ik2x, ik1y, ik2y
+ REAL(KIND=8) :: dl_den
+ LOGICAL, DIMENSION(kpi,kpj) :: ll_mask
+ !!----------------------------------------------------------------------
+ ll_mask=.TRUE.
+ WHERE (kiw == 0 ) ll_mask=.FALSE.
+ DO ji=1,kpi
+ ik1x = ji-knj ; ik2x = ji+knj
+ ik1x = MAX(1,ik1x) ; ik2x = MIN(kpi,ik2x)
+ DO jj=1,kpj
+ ik1y = jj-knj ; ik2y = jj+knj
+ ik1y = MAX(1,ik1y) ; ik2y = MIN(kpj,ik2y)
+ dl_den = SUM(kiw(ik1x:ik2x,ik1y:ik2y) )
+ IF ( dl_den /= 0 ) THEN
+ py(ji,jj) = SUM(px(ik1x:ik2x,ik1y:ik2y), mask=ll_mask(ik1x:ik2x,ik1y:ik2y) )/dl_den
+ ELSE
+ py(ji,jj) = rspval
+ ENDIF
+ END DO
END DO
- END SUBROUTINE lisbox
+ END SUBROUTINE lisbox
END PROGRAM cdfsmooth
diff --git a/cdfspeed.f90 b/cdfspeed.f90
index 8a51608..108ca23 100644
--- a/cdfspeed.f90
+++ b/cdfspeed.f90
@@ -1,144 +1,205 @@
PROGRAM cdfspeed
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfspeed ***
+ !!======================================================================
+ !! *** PROGRAM cdfspeed ***
+ !!=====================================================================
+ !! ** Purpose : combine u and v to obtains the wind speed
!!
- !! ** Purpose : combine u and v to obtains the wind speed
- !!
- !! ** Method : sqrt(u**2 + v**2)
+ !! ** Method : speed=sqrt(u**2 + v**2)
!!
- !!
- !! history ;
- !! Original : P. Mathiot (Nov. 2007) from cdfmeanvar
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2007 : P. Mathiot : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, ik, jt, ji, jj
- INTEGER :: narg, iargc, ncout, ierr !: command line
- INTEGER :: npiglo,npjglo,npk,nt !: size of the domain
- INTEGER :: nvpk !: vertical levels in working variable
- INTEGER, DIMENSION(1) :: ipk, id_varout !
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: zu, zv, U
+ INTEGER(KIND=4) :: ji, jj, jk, jt, jlev ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! command line
+ INTEGER(KIND=4) :: ncout, ierr ! output file stuff
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt, nlev ! size of the domain
+ INTEGER(KIND=4) :: nvpk ! vertical levels in working variable
+ INTEGER(KIND=4) :: ik ! level counter
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: nklevel ! requested levels
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! output variable vertical level, varid
- REAL(kind=4), DIMENSION(:), ALLOCATABLE :: tim
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter array
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept, gdeptall ! deptht values for requested/all levels
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, zv, zspeed ! working arrays, speed
- CHARACTER(LEN=256) :: cfilev, cfileu
- CHARACTER(LEN=256) :: cfileout='speed.nc'
- CHARACTER(LEN=256) :: cvaru, cvarv, cvartype
- CHARACTER(LEN=20) :: ce1, ce2, ce3, cvmask, cvtype, cdep
+ CHARACTER(LEN=256) :: cf_vfil, cf_ufil ! file for u and v components
+ CHARACTER(LEN=256) :: cf_tfil ! file for T point position
+ CHARACTER(LEN=256) :: cv_u, cv_v ! name of u and v variable
+ CHARACTER(LEN=256) :: cf_out='speed.nc' ! output file name
+ CHARACTER(LEN=256) :: cldum ! dummy char variable
- LOGICAL :: lforcing
- INTEGER :: istatus
+ TYPE (variable), DIMENSION(1) :: stypvar ! structure for attibutes
- TYPE (variable), DIMENSION(1) :: typvar !: structure for attibutes
- ! constants
+ LOGICAL :: lforcing ! forcing flag
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line and output usage message if not compliant.
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfspeed ncfileU ncfileV cdfvarU cdfvarV'
- PRINT *,' Computes the speed current or wind'
- PRINT *,' If the input files are 3D, the input is assumed to be '
- PRINT *,' a model output on native C-grid. Speed is computed on the A-grid.'
- PRINT *,' If the input file is 2D and have many time steps, then '
- PRINT *,' we assume that this is a forcing file already on the A-grid.'
- PRINT *,' Output on speed.nc, variable U'
+ PRINT *,' usage : cdfspeed U-file V-file U-var V-var [-t T-file] ...'
+ PRINT *,' ... [-lev level_list]'
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes the speed of ocean currents or wind speed'
+ PRINT *,' '
+ PRINT *,' If the input files are 3D, the input is assumed to be '
+ PRINT *,' a model output on native C-grid. Speed is computed on the A-grid.'
+ PRINT *,' '
+ PRINT *,' If the input file is 2D and then we assume that this is '
+ PRINT *,' a forcing file already on the A-grid.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' U-file : netcdf file for U component'
+ PRINT *,' V-file : netcdf file for V component'
+ PRINT *,' U-var : netcdf variable name for U component'
+ PRINT *,' V-var : netcdf variable name for V component'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-t T-file ] : indicate any file on gridT for correct header'
+ PRINT *,' of the output file (usefull for 3D files)'
+ PRINT *,' [-lev level_list ] : indicate a list of levels to be processed'
+ PRINT *,' If not used, all levels are processed.'
+ PRINT *,' This option should be the last on the command line'
+ PRINT *,' '
+ PRINT *,' OUTPUT :'
+ PRINT *,' Output on ',TRIM(cf_out),' variable U '
STOP
ENDIF
- CALL getarg (1, cfileu)
- CALL getarg (2, cfilev)
- CALL getarg (3, cvaru)
- CALL getarg (4, cvarv)
-
- IF (narg > 4 ) THEN
- PRINT *, ' ERROR : You must give just fileU and fileV and cvaru and cvarv'
+ nlev =0
+ ijarg=1
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum ) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-lev' )
+ nlev = narg -ijarg + 1
+ ALLOCATE ( nklevel(nlev) )
+ DO jlev = 1, nlev
+ CALL getarg(ijarg, cldum ) ; ijarg = ijarg + 1 ; READ( cldum,*) nklevel(jlev)
+ END DO
+ CASE ( '-t' )
+ CALL getarg(ijarg, cf_tfil ) ; ijarg = ijarg + 1
+ IF ( chkfile (cf_tfil) ) STOP ! missing file
+ CASE DEFAULT
+ cf_ufil = cldum
+ CALL getarg(ijarg, cf_vfil ) ; ijarg = ijarg + 1
+ IF ( chkfile(cf_ufil) .OR. chkfile(cf_vfil) ) STOP ! missing file
+ CALL getarg(ijarg, cv_u ) ; ijarg = ijarg + 1
+ CALL getarg(ijarg, cv_v ) ; ijarg = ijarg + 1
+ END SELECT
+ ENDDO
+
+ npiglo = getdim (cf_vfil,cn_x)
+ npjglo = getdim (cf_vfil,cn_y)
+ npk = getdim (cf_vfil,cn_z)
+ nvpk = getvdim(cf_vfil,cv_v)
+ npt = getdim (cf_vfil,cn_t)
+
+ IF ( (npk == 0) ) THEN
+ lforcing=.TRUE.
+ npk=1
+ PRINT *, 'W A R N I N G : you used a forcing field'
+ ELSE
+ lforcing=.FALSE.
+ IF ( TRIM(cf_tfil) == 'none' ) THEN
+ PRINT *,' ERROR: you must specify a griT file as fifth argument '
+ PRINT *,' This is for the proper header of output file '
STOP
- ENDIF
+ ENDIF
+ END IF
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
- nvpk = getvdim(cfilev,cvarv)
- nt = getdim (cfilev,'time_counter')
+ IF ( nlev == 0 ) THEN
+ nlev = npk
+ ALLOCATE ( nklevel(nlev) )
+ DO jlev =1, nlev
+ nklevel(jlev) = jlev
+ ENDDO
+ ENDIF
IF (nvpk == 2 ) nvpk = 1
- IF (nvpk == 3 ) nvpk = npk
+ IF (nvpk == 3 ) nvpk = nlev
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'nvpk =', nvpk
- PRINT *, 'nt =', nt
-
- lforcing=.FALSE.
- IF ((npk .EQ. 0) .AND. (nt .GT. 1)) THEN
- lforcing=.TRUE.
- npk=1
- PRINT *, 'W A R N I N G : you used a forcing field'
- END IF
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npk =', npk
+ PRINT *, 'nvpk =', nvpk
+ PRINT *, 'nlev =', nlev
+ PRINT *, 'npt =', npt
! define new variables for output
- typvar(1)%name='U'
- typvar(1)%units='m.s-1'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar(1)%long_name='Current or wind speed'
- typvar(1)%short_name='U'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
+ stypvar(1)%cname = 'U'
+ stypvar(1)%cunits = 'm.s-1'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = -1000.
+ stypvar(1)%valid_max = 1000.
+ stypvar(1)%clong_name = 'Current or wind speed'
+ stypvar(1)%cshort_name = 'U'
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
! create output fileset
IF (lforcing ) THEN
- ipk(1) = 1 ! 2D
- ncout =create(cfileout, cfilev, npiglo,npjglo,0)
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilev, npiglo, npjglo,0)
+ ipk(1) = 1 ! 2D no dep variable
+ ncout = create (cf_out, cf_vfil, npiglo, npjglo, 0 )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_vfil, npiglo, npjglo, 0 )
+ nlev=1 ; nklevel(nlev) = 1
ELSE
- ipk(1)=npk
- ncout =create(cfileout, cfilev, npiglo,npjglo,npk)
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilev, npiglo, npjglo,npk)
+ ALLOCATE ( gdept(nlev), gdeptall(npk) )
+ gdeptall = getvar1d ( cf_tfil, cn_vdeptht, npk )
+ DO jlev = 1, nlev
+ gdept(jlev) = gdeptall( nklevel(jlev) )
+ END DO
+ ipk(1) = nlev
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, nlev )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, nlev, pdep=gdept )
END IF
+
! Allocate arrays
- ALLOCATE ( zv(npiglo,npjglo), zu(npiglo,npjglo), U(npiglo,npjglo), tim(nt))
+ ALLOCATE ( zv(npiglo,npjglo), zu(npiglo,npjglo), zspeed(npiglo,npjglo), tim(npt))
- DO jt=1,nt
+ DO jt=1,npt
tim(jt)=jt
END DO
- ierr=putvar1d(ncout,tim,nt,'T')
- DO jt = 1,nt
- DO jk = 1,nvpk
- ! Get velocities v at ik
- zv(:,:)= getvar(cfilev, cvarv,jk,npiglo,npjglo,ktime=jt)
- zu(:,:)= getvar(cfileu, cvaru,jk,npiglo,npjglo,ktime=jt)
+ ierr=putvar1d(ncout, tim, npt, 'T')
+
+ DO jt = 1,npt
+ DO jlev = 1, nlev
+ ik = nklevel(jlev)
+ ! Get velocities v at jk
+ zu(:,:) = getvar(cf_ufil, cv_u, ik, npiglo, npjglo, ktime=jt)
+ zv(:,:) = getvar(cf_vfil, cv_v, ik, npiglo, npjglo, ktime=jt)
IF ( lforcing ) THEN
- ! u and v are already on the T grid points
+ ! u and v are already on the T grid points
ELSE
- ! in this case we are on the C-grid and the speed mus be computed on the A-grid
- DO ji=1,npiglo -1
+ ! in this case we are on the C-grid and the speed must be computed
+ ! on the A-grid. We use reverse loop in order to use only one array
+ DO ji=npiglo,2,-1
DO jj=1,npjglo
- zu(ji,jj)=0.5*(zu(ji,jj)+zu(ji+1,jj))
+ zu(ji,jj) = 0.5*(zu(ji-1,jj)+zu(ji,jj))
ENDDO
ENDDO
+
DO ji=1,npiglo
- DO jj=1,npjglo-1
- zv(ji,jj)=0.5*(zv(ji,jj)+zv(ji,jj+1))
+ DO jj=npjglo,2 -1
+ zv(ji,jj) = 0.5*(zv(ji,jj-1)+zv(ji,jj))
ENDDO
ENDDO
END IF
-
- U=SQRT(zv*zv+zu*zu)
- ierr = putvar(ncout, id_varout(1) ,U, jk ,npiglo, npjglo, ktime=jt)
+ zspeed = SQRT(zv*zv+zu*zu)
+ ierr = putvar(ncout, id_varout(1), zspeed, jlev ,npiglo, npjglo, ktime=jt)
END DO
END DO
ierr = closeout(ncout)
diff --git a/cdfspice.f90 b/cdfspice.f90
index 313d39d..92387e2 100644
--- a/cdfspice.f90
+++ b/cdfspice.f90
@@ -1,134 +1,176 @@
PROGRAM cdfspice
- !!---------------------------------------------------------------------------------
- !! *** PROGRAM cdfspice ***
- !!
- !! ** Purpose: Compute spiciness 3D field from gridT file
+ !!======================================================================
+ !! *** PROGRAM cdfspice ***
+ !!=====================================================================
+ !! ** Purpose : Compute spiciness 3D field from gridT file
!! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: Try to avoid 3 d arrays
- !! Following Flament (2002) "A state variable for characterizing water
- !! masses and their diffusive stability: spiciness."
- !! Progress in Oceanography Volume 54, 2002, Pages 493-501.
!!
- !! ** Definition: spiciness = sum(i=0,5)[sum(j=0,4)[b(i,j)*theta^i*(s-35)^j]]
+ !! ** Method : spiciness = sum(i=0,5)[sum(j=0,4)[b(i,j)*theta^i*(s-35)^j]]
!! with: b -> coefficients
!! theta -> potential temperature
- !! s -> salinity
+ !! s -> salinity
!!
- !! ** Example:
+ !! ** Example:
!! spice(15,33)= 0.5445863 0.544586321373410 calcul en double
!! spice(15,33)= 0.5445864 (calcul en simple precision)
!!
- !! history:
- !! Original : C.O. Dufour (Mar 2010)
- !!----------------------------------------------------------------------------------
- !!----------------------------------------------------------------------------------
- !! * Modules used
+ !! ** References : Flament (2002) "A state variable for characterizing
+ !! water masses and their diffusive stability: spiciness."
+ !! Progress in Oceanography Volume 54, 2002, Pages 493-501.
+ !!
+ !! History : 2.1 : 03/2010 : C.O. Dufour : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, jt, ji, jj !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk, npt !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, & !: outptut variables : number of levels,
- & id_varout !: ncdf varid's
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal ,& !: Array to read a layer of data
- & ztempt, zsalt, zsalref ,& !: temporary arrays
- & zspi , & !: potential density (sig-0)
- & zmask !: 2D mask at current level
-
- REAL(KIND=8) , DIMENSION (6,5) :: beta !: coefficients of spiciness formula
- REAL(KIND=4),DIMENSION(:),ALLOCATABLE :: tim
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='spice.nc' !:
-
- TYPE(variable) , DIMENSION(1) :: typvar !: structure for attributes
- INTEGER :: ncout
- INTEGER :: istatus
-
- !! Read command line
- narg= iargc()
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4) :: narg, iargc ! browse command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! level and varid's
+
+ REAL(KIND=4) :: zspval ! missing value
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtemp ! temperature
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtempt ! temperature
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsal ! salinity
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsalt ! salinity
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsalref ! reference salinity
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dspi ! spiceness
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dmask ! 2D mask at current level
+ REAL(KIND=8), DIMENSION(6,5) :: dbet ! coefficients of spiciness formula
+
+ CHARACTER(LEN=256) :: cf_tfil ! input filename
+ CHARACTER(LEN=256) :: cf_out='spice.nc' ! output file name
+
+ TYPE (variable), DIMENSION(1) :: stypvar ! structure for attributes
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfspice gridT '
- PRINT *,' Output on spice.nc, variable vospice'
+ PRINT *,' usage : cdfspice T-file '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the spiceness corresponding to temperatures and salinities'
+ PRINT *,' given in the input file.'
+ PRINT *,' '
+ PRINT *,' spiciness = sum(i=0,5)[sum(j=0,4)[b(i,j)*theta^i*(s-35)^j]]'
+ PRINT *,' with: b -> coefficients'
+ PRINT *,' theta -> potential temperature'
+ PRINT *,' s -> salinity'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with temperature and salinity (gridT)'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : vospice'
+ PRINT *,' '
+ PRINT *,' REFERENCE :'
+ PRINT *,' Flament (2002) "A state variable for characterizing '
+ PRINT *,' water masses and their diffusive stability: spiciness."'
+ PRINT *,' Progress in Oceanography Volume 54, 2002, Pages 493-501.'
+ STOP
+ ENDIF
+ IF ( narg == 0 ) THEN
+ PRINT *,'usage : cdfspice gridT '
+ PRINT *,' Output on spice.nc, variable vospice'
STOP
ENDIF
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
- npt = getdim (cfilet,'time')
-
- ipk(:)= npk ! all variables (input and output are 3D)
- typvar(1)%name= 'vospice'
- typvar(1)%units='kg/m3'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -300.
- typvar(1)%valid_max= 300.
- typvar(1)%long_name='spiciness'
- typvar(1)%short_name='vospice'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'npt =', npt
-
- ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zspi(npiglo,npjglo) ,zmask(npiglo,npjglo))
- ALLOCATE (ztempt(npiglo,npjglo), zsalt(npiglo,npjglo), zsalref(npiglo,npjglo))
+ CALL getarg (1, cf_tfil)
+
+ IF ( chkfile(cf_tfil) ) STOP ! missing files
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+ npt = getdim (cf_tfil,cn_t)
+
+ ipk(:) = npk
+ stypvar(1)%cname = 'vospice'
+ stypvar(1)%cunits = 'kg/m3'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = -300.
+ stypvar(1)%valid_max = 300.
+ stypvar(1)%clong_name = 'spiciness'
+ stypvar(1)%cshort_name = 'vospice'
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE (dtemp(npiglo,npjglo), dsal (npiglo,npjglo) )
+ ALLOCATE (dspi( npiglo,npjglo), dmask(npiglo,npjglo) )
+ ALLOCATE (dtempt(npiglo,npjglo), dsalt(npiglo,npjglo))
+ ALLOCATE (dsalref(npiglo,npjglo))
ALLOCATE (tim(npt))
! create output fileset
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,npk)
- tim=getvar1d(cfilet,'time_counter',npt)
- ierr=putvar1d(ncout,tim,npt,'T')
+ zspval = getatt(cf_tfil, cn_vosaline, 'missing_value')
- ! Define coefficients to compute spiciness
- beta(1,1) = 0 ; beta(1,2) = 7.7442e-01 ; beta(1,3) = -5.85e-03 ; beta(1,4) = -9.84e-04 ; beta(1,5) = -2.06e-04
- beta(2,1) = 5.1655e-02 ; beta(2,2) = 2.034e-03 ; beta(2,3) = -2.742e-04 ; beta(2,4) = -8.5e-06 ; beta(2,5) = 1.36e-05
- beta(3,1) = 6.64783e-03 ; beta(3,2) = -2.4681e-04 ; beta(3,3) = -1.428e-05 ; beta(3,4) = 3.337e-05 ; beta(3,5) = 7.894e-06
- beta(4,1) = -5.4023e-05 ; beta(4,2) = 7.326e-06 ; beta(4,3) = 7.0036e-06 ; beta(4,4) = -3.0412e-06 ; beta(4,5) = -1.0853e-06
- beta(5,1) = 3.949e-07 ; beta(5,2) = -3.029e-08 ; beta(5,3) = -3.8209e-07 ; beta(5,4) = 1.0012e-07 ; beta(5,5) = 4.7133e-08
- beta(6,1) = -6.36e-10 ; beta(6,2) = -1.309e-09 ; beta(6,3) = 6.048e-09 ; beta(6,4) = -1.1409e-09 ; beta(6,5) = -6.676e-10
+ ! Define coefficients to compute spiciness (R*8)
+ dbet(1,1) = 0 ; dbet(1,2) = 7.7442d-01 ; dbet(1,3) = -5.85d-03 ; dbet(1,4) = -9.84d-04 ; dbet(1,5) = -2.06d-04
+ dbet(2,1) = 5.1655d-02 ; dbet(2,2) = 2.034d-03 ; dbet(2,3) = -2.742d-04 ; dbet(2,4) = -8.5d-06 ; dbet(2,5) = 1.36d-05
+ dbet(3,1) = 6.64783d-03 ; dbet(3,2) = -2.4681d-04 ; dbet(3,3) = -1.428d-05 ; dbet(3,4) = 3.337d-05 ; dbet(3,5) = 7.894d-06
+ dbet(4,1) = -5.4023d-05 ; dbet(4,2) = 7.326d-06 ; dbet(4,3) = 7.0036d-06 ; dbet(4,4) = -3.0412d-06 ; dbet(4,5) = -1.0853d-06
+ dbet(5,1) = 3.949d-07 ; dbet(5,2) = -3.029d-08 ; dbet(5,3) = -3.8209d-07 ; dbet(5,4) = 1.0012d-07 ; dbet(5,5) = 4.7133d-08
+ dbet(6,1) = -6.36d-10 ; dbet(6,2) = -1.309d-09 ; dbet(6,3) = 6.048d-09 ; dbet(6,4) = -1.1409d-09 ; dbet(6,5) = -6.676d-10
! Compute spiciness
DO jt=1,npt
PRINT *,' TIME = ', jt, tim(jt)/86400.,' days'
DO jk = 1, npk
- zmask(:,:)=1.
+ dmask(:,:) = 1.
- ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo,ktime=jt)
- zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo,ktime=jt)
+ dtemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt)
+ dsal( :,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt)
- WHERE(zsal == 0 ) zmask = 0
+ WHERE(dsal == zspval ) dmask = 0
! spiciness at time jt, at level jk
- zspi(:,:) = 0
- zsalref(:,:) = zsal(:,:) - 35.
- ztempt(:,:) = 1.
+ dspi(:,:) = 0.d0
+ dsalref(:,:) = dsal(:,:) - 35.d0
+ dtempt(:,:) = 1.d0
DO ji=1,6
- zsalt(:,:) = 1.
+ dsalt(:,:) = 1.d0
DO jj=1,5
- zspi(:,:) = zspi(:,:) + beta(ji,jj)*ztempt(:,:)*zsalt(:,:)
- zsalt(:,:) = zsalt(:,:)*zsalref(:,:)
+ dspi( :,:) = dspi (:,:) + dbet (ji,jj) * dtempt(:,:) * dsalt(:,:)
+ dsalt(:,:) = dsalt(:,:) * dsalref( :,: )
END DO
- ztempt(:,:) = ztempt(:,:)*ztemp(:,:)
+ dtempt(:,:) = dtempt(:,:) * dtemp(:,:)
END DO
- ierr = putvar(ncout, id_varout(1) ,REAL(zspi)*zmask, jk,npiglo, npjglo,ktime=jt)
+ ierr = putvar(ncout, id_varout(1), REAL(dspi*dmask), jk, npiglo, npjglo, ktime=jt)
END DO ! loop to next level
END DO ! next time frame
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
+
END PROGRAM cdfspice
diff --git a/cdfsstconv.f90 b/cdfsstconv.f90
index 54f2fd3..204c903 100644
--- a/cdfsstconv.f90
+++ b/cdfsstconv.f90
@@ -140,37 +140,37 @@ PROGRAM cdfflxconv
ALLOCATE ( typvarqsr(nvar), ipkqsr(nvar), id_varoutqsr(nvar) )
jvar=1
ipkemp(jvar) = 1
- typvaremp(jvar)%name='sowaflup' ! E - P = dim 3 - dim 4 dimgfile
- typvaremp(jvar)%units='kg/m2/s'
- typvaremp(jvar)%missing_value=0.
+ typvaremp(jvar)%cname='sowaflup' ! E - P = dim 3 - dim 4 dimgfile
+ typvaremp(jvar)%cunits='kg/m2/s'
+ typvaremp(jvar)%rmissing_value=0.
typvaremp(jvar)%valid_min= -0.002
typvaremp(jvar)%valid_max= 0.002
- typvaremp(jvar)%long_name='E-P Upward water flux'
- typvaremp(jvar)%short_name='sowaflup'
- typvaremp(jvar)%online_operation='N/A'
- typvaremp(jvar)%axis='TYX'
+ typvaremp(jvar)%clong_name='E-P Upward water flux'
+ typvaremp(jvar)%cshort_name='sowaflup'
+ typvaremp(jvar)%conline_operation='N/A'
+ typvaremp(jvar)%caxis='TYX'
ipkqnet(jvar) = 1
- typvarqnet(jvar)%name='sohefldo' ! QNET = dim 1 dimgfile
- typvarqnet(jvar)%units='W/m2'
- typvarqnet(jvar)%missing_value=0.
+ typvarqnet(jvar)%cname='sohefldo' ! QNET = dim 1 dimgfile
+ typvarqnet(jvar)%cunits='W/m2'
+ typvarqnet(jvar)%rmissing_value=0.
typvarqnet(jvar)%valid_min= -1000.
typvarqnet(jvar)%valid_max= 1000.
- typvarqnet(jvar)%long_name='Net_Downward_Heat_Flux'
- typvarqnet(jvar)%short_name='sohefldo'
- typvarqnet(jvar)%online_operation='N/A'
- typvarqnet(jvar)%axis='TYX'
+ typvarqnet(jvar)%clong_name='Net_Downward_Heat_Flux'
+ typvarqnet(jvar)%cshort_name='sohefldo'
+ typvarqnet(jvar)%conline_operation='N/A'
+ typvarqnet(jvar)%caxis='TYX'
ipkqsr(jvar) = 1
- typvarqsr(jvar)%name='soshfldo' ! QSR = dim 2 dimgfile
- typvarqsr(jvar)%units='W/m2'
- typvarqsr(jvar)%missing_value=0.
+ typvarqsr(jvar)%cname='soshfldo' ! QSR = dim 2 dimgfile
+ typvarqsr(jvar)%cunits='W/m2'
+ typvarqsr(jvar)%rmissing_value=0.
typvarqsr(jvar)%valid_min= -1000.
typvarqsr(jvar)%valid_max= 1000.
- typvarqsr(jvar)%long_name='Short_Wave_Radiation'
- typvarqsr(jvar)%short_name='soshfldo'
- typvarqsr(jvar)%online_operation='N/A'
- typvarqsr(jvar)%axis='TYX'
+ typvarqsr(jvar)%clong_name='Short_Wave_Radiation'
+ typvarqsr(jvar)%cshort_name='soshfldo'
+ typvarqsr(jvar)%conline_operation='N/A'
+ typvarqsr(jvar)%caxis='TYX'
ncoutemp =create(cemp, 'none',npiglo,npjglo,npk,cdep='deptht' )
istatus= createvar(ncoutemp ,typvaremp,nvar, ipkemp,id_varoutemp )
@@ -267,26 +267,26 @@ PROGRAM cdfflxconv
ALLOCATE ( typvartauy(nvar), ipktauy(nvar), id_varouttauy(nvar) )
jvar=1
ipktaux(jvar) = 1
- typvartaux(jvar)%name='sozotaux' ! taux dim 1 of dimgfile
- typvartaux(jvar)%units='N/m2'
- typvartaux(jvar)%missing_value=0.
+ typvartaux(jvar)%cname='sozotaux' ! taux dim 1 of dimgfile
+ typvartaux(jvar)%cunits='N/m2'
+ typvartaux(jvar)%rmissing_value=0.
typvartaux(jvar)%valid_min= -0.1
typvartaux(jvar)%valid_max= 0.1
- typvartaux(jvar)%long_name='Zonal Wind Stress'
- typvartaux(jvar)%short_name='sozotaux'
- typvartaux(jvar)%online_operation='N/A'
- typvartaux(jvar)%axis='TYX'
+ typvartaux(jvar)%clong_name='Zonal Wind Stress'
+ typvartaux(jvar)%cshort_name='sozotaux'
+ typvartaux(jvar)%conline_operation='N/A'
+ typvartaux(jvar)%caxis='TYX'
ipktauy(jvar) = 1
- typvartauy(jvar)%name='sometauy' ! tauy dim 2 of dimgfile
- typvartauy(jvar)%units='N/m2'
- typvartauy(jvar)%missing_value=0.
+ typvartauy(jvar)%cname='sometauy' ! tauy dim 2 of dimgfile
+ typvartauy(jvar)%cunits='N/m2'
+ typvartauy(jvar)%rmissing_value=0.
typvartauy(jvar)%valid_min= -0.1
typvartauy(jvar)%valid_max= 0.1
- typvartauy(jvar)%long_name='Meridional Wind Stress'
- typvartauy(jvar)%short_name='sometauy'
- typvartauy(jvar)%online_operation='N/A'
- typvartauy(jvar)%axis='TYX'
+ typvartauy(jvar)%clong_name='Meridional Wind Stress'
+ typvartauy(jvar)%cshort_name='sometauy'
+ typvartauy(jvar)%conline_operation='N/A'
+ typvartauy(jvar)%caxis='TYX'
ncouttaux =create(ctaux, 'none',npiglo,npjglo,npk,cdep='deptht' )
istatus= createvar(ncouttaux ,typvartaux,nvar, ipktaux,id_varouttaux )
@@ -359,15 +359,15 @@ PROGRAM cdfflxconv
ALLOCATE ( typvarsst(nvar), ipksst(nvar), id_varoutsst(nvar) )
jvar=1
ipksst(jvar) = 1
- typvarsst(jvar)%name='sst' ! sst dim 1 of dimgfile
- typvarsst(jvar)%units='C'
- typvarsst(jvar)%missing_value=0.
+ typvarsst(jvar)%cname='sst' ! sst dim 1 of dimgfile
+ typvarsst(jvar)%cunits='C'
+ typvarsst(jvar)%rmissing_value=0.
typvarsst(jvar)%valid_min= -10.
typvarsst(jvar)%valid_max= 50.
- typvarsst(jvar)%long_name='Reynolds SST'
- typvarsst(jvar)%short_name='SST'
- typvarsst(jvar)%online_operation='N/A'
- typvarsst(jvar)%axis='TYX'
+ typvarsst(jvar)%clong_name='Reynolds SST'
+ typvarsst(jvar)%cshort_name='SST'
+ typvarsst(jvar)%conline_operation='N/A'
+ typvarsst(jvar)%caxis='TYX'
ncoutsst =create(csst, 'none',npiglo,npjglo,npk,cdep='deptht' )
istatus= createvar(ncoutsst ,typvarsst,nvar, ipksst,id_varoutsst )
diff --git a/cdfstatcoord.f90 b/cdfstatcoord.f90
index 0c72be1..fb8a800 100644
--- a/cdfstatcoord.f90
+++ b/cdfstatcoord.f90
@@ -1,79 +1,104 @@
PROGRAM cdfstatcoord
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfstatcoord ***
+ !!======================================================================
+ !! *** PROGRAM cdfstatcoord ***
+ !!=====================================================================
+ !! ** Purpose : Compute statistics about the grid metric versus latitude
!!
- !! ** Purpose: Compute statistics about the grid metric versus latitude
- !!
- !! ** Method: bins e1 and e2 by latitudes and takes the mean value of each bin
+ !! ** Method : bins e1 and e2 by latitudes and takes the mean value
+ !! of each bin
!!
- !! history:
- !! Original : J.M. Molines 07/07 for T. Penduff
- !!--------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- !! * Modules used
+ !! History : 2.1 : 07/2007 : J.M. Molines : Original code (T. Penduff idea)
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk ,npt !: size of the domain
- INTEGER :: ngood
- REAL(kind=4) , DIMENSION(:,:), ALLOCATABLE :: e1, e2, gphi, tmask
- LOGICAL, DIMENSION(:,:), ALLOCATABLE :: lgood
- REAL(KIND=4) :: binsize=2., rlatmin=-80., rlatmax=90. , rlat, rlat1, rlat2
- REAL(KIND=8) :: e1mean, e2mean
- CHARACTER(LEN=256) :: coord ='mesh_hgr.nc' , cmask='mask.nc', cvmask='tmask' !:
- TYPE(variable), DIMENSION(3) :: typvar !: structure for attribute
-
- !! Read command line
- narg= iargc()
+ INTEGER(KIND=4) :: narg, iargc ! browse lines
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: ngood ! point counter
+
+ REAL(KIND=4), PARAMETER :: pp_binsize=2. ! bin size
+ REAL(KIND=4), PARAMETER :: pp_latmin=-80. ! minimum latitude
+ REAL(KIND=4), PARAMETER :: pp_latmax=90. ! maximum latitude
+ REAL(KIND=4) :: rlat, rlat1, rlat2 ! working variables
+ REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: e1, e2, gphi, zmask ! metrics and mask
+
+ REAL(KIND=8) :: de1mean, de2mean ! mean value of horiz metrics
+
+ CHARACTER(LEN=256) :: cf_coo, cf_msk ! file names
+ CHARACTER(LEN=256) :: cv_msk='tmask' ! mask variable name
+
+ LOGICAL, DIMENSION(:,:), ALLOCATABLE :: lgood ! flag for point selection
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg < 2 ) THEN
- PRINT *,' Usage : cdfstatcoord coordinate-file mask [mask variable name]'
- PRINT *,' coordinate file is the file where e1t e2t anf gphit can be found'
- PRINT *,' if mask variable is not tmask, give it as optional argument'
- PRINT *,' results is given on standard output '
+ PRINT *,' usage : cdfstatcoord COOR-file MSK-file [ MSK-var ]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes and displays statistics about grid metrics vs latitude.'
+ PRINT *,' Bins e1 and e2 by latitude bins, and compute the mean of each bin.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' COOR-file : coordinates file with e1 e2 metrics'
+ PRINT *,' MSK-file : mask file '
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [MSK-var] : mask variable name. Default is ', TRIM(cv_msk)
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none apart those requested on command line.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' Standard output'
STOP
ENDIF
- CALL getarg (1, coord)
- CALL getarg (2, cmask)
- IF ( narg == 3 ) CALL getarg(3,cvmask)
+ CALL getarg (1, cf_coo)
+ CALL getarg (2, cf_msk)
+ IF ( narg == 3 ) CALL getarg(3, cv_msk)
+
+ IF ( chkfile(cf_coo) .OR. chkfile(cf_msk) ) STOP ! missing files
- npiglo= getdim (coord,'x')
- npjglo= getdim (coord,'y')
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
+ npiglo= getdim (cf_coo, cn_x)
+ npjglo= getdim (cf_coo, cn_y)
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
ALLOCATE ( e1(npiglo,npjglo) , e2(npiglo,npjglo) )
- ALLOCATE ( gphi(npiglo,npjglo), tmask(npiglo,npjglo), lgood(npiglo,npjglo) )
+ ALLOCATE ( gphi(npiglo,npjglo), zmask(npiglo,npjglo), lgood(npiglo,npjglo) )
! read grid metrics and latitude
- e1= getvar(coord, 'e1t', 1,npiglo,npjglo)
- e2= getvar(coord, 'e2t', 1,npiglo,npjglo)
- gphi= getvar(coord, 'gphit', 1,npiglo,npjglo)
- ! read tmask (1)
- tmask= getvar(cmask, cvmask, 1,npiglo,npjglo)
+ e1 = getvar(cf_coo, cn_ve1t, 1, npiglo, npjglo)
+ e2 = getvar(cf_coo, cn_ve2t, 1, npiglo, npjglo)
+ gphi = getvar(cf_coo, cn_gphit, 1, npiglo, npjglo)
+ ! read zmask (1)
+ zmask = getvar(cf_msk, cv_msk, 1, npiglo, npjglo)
- rlat=rlatmin+binsize/2.
- DO WHILE ( rlat <= rlatmax )
- rlat1= rlat -binsize/2. ; rlat2 = rlat+binsize/2.
- lgood=.false.
- WHERE ( rlat1 <= gphi .AND. gphi < rlat2 .AND. tmask /= 0 ) lgood=.true.
- ngood=count(lgood)
- IF ( ngood /= 0 ) THEN
- e1mean=SUM( e1, mask=lgood)/ngood
- e2mean=SUM( e2, mask=lgood)/ngood
- ELSE
- e1mean=-999.
- e2mean=-999.
- ENDIF
- PRINT '(f8.3, 3f15.3,i8)', rlat, e1mean, e2mean ,e1mean/e2mean, ngood
- rlat=rlat+binsize
+ rlat = pp_latmin + pp_binsize/2.
+ DO WHILE ( rlat <= pp_latmax )
+ rlat1 = rlat - pp_binsize/2. ; rlat2 = rlat + pp_binsize/2.
+ lgood = .FALSE.
+ WHERE ( rlat1 <= gphi .AND. gphi < rlat2 .AND. zmask /= 0 ) lgood=.TRUE.
+ ngood = COUNT(lgood)
+ IF ( ngood /= 0 ) THEN
+ de1mean = SUM( e1, mask=lgood) / ngood
+ de2mean = SUM( e2, mask=lgood) / ngood
+ ELSE
+ de1mean = -999.
+ de2mean = -999.
+ ENDIF
+ PRINT '(f8.3, 3f15.3,i8)', rlat, de1mean, de2mean ,de1mean/de2mean, ngood
+ rlat = rlat + pp_binsize
ENDDO
+
END PROGRAM cdfstatcoord
diff --git a/cdfstd.f90 b/cdfstd.f90
index 48abad4..c0f723d 100644
--- a/cdfstd.f90
+++ b/cdfstd.f90
@@ -1,160 +1,229 @@
PROGRAM cdfstd
- !!-----------------------------------------------------------------------
- !! *** PROGRAM cdfrms ***
+ !!======================================================================
+ !! *** PROGRAM cdfstd ***
+ !!=====================================================================
+ !! ** Purpose : Compute Standard deviation values for all the
+ !! variables in a bunch of cdf files given as argument
+ !! Store the results on a 'similar' cdf file.
!!
- !! ** Purpose: Compute Standard deviation values for all the variables in a bunch
- !! of cdf files given as argument
- !! Store the results on a 'similar' cdf file.
- !!
- !! ** Method: Try to avoid 3 d arrays
- !!
- !! history :
- !! Original code : F. Castruccio (2.0, from cdfmoy) 04/2007
- !! J.M. Molines for 2.1 (04/07)
- !!-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
+ !! ** Method : Compute mean, mean squared, then the variance and
+ !! the standard deviation
!!
+ !! History : 2.1 : 04/2006 : F. Castruccio : Original code (from cdfmoy)
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk,jt,jtt,jvar, jv !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk,nt !: size of the domain
- INTEGER :: nvars !: Number of variables in a file
- INTEGER :: ntframe !: Cumul of time frame
- INTEGER, DIMENSION(:), ALLOCATABLE :: id_var , & !: arrays of var id's
- & ipk , & !: arrays of vertical level for each var
- & id_varout
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: tab, tab2 !: Arrays for cumulated values
- REAL(KIND=8) :: total_time
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: v2d ,& !: Array to read a layer of data
- & rmean, rmean2, std
- REAL(KIND=4), DIMENSION(1) :: timean
- REAL(KIND=4), DIMENSION(2000) :: tim
-
- CHARACTER(LEN=256) :: cfile ,cfileout !: file name
- CHARACTER(LEN=256) :: cdep
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE:: cvarnameo !: array of var name for output
-
- TYPE ( variable ), DIMENSION(:), ALLOCATABLE :: typvar, typvaro
-
- INTEGER :: ncout
- INTEGER :: istatus
- LOGICAL :: lcaltmean
- !!
+ INTEGER(KIND=4) :: jk, jfil, jt ! dummy loop index
+ INTEGER(KIND=4) :: jvar, jv ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvars ! number of variables in a file
+ INTEGER(KIND=4) :: ntframe ! cumul of time frame
+ INTEGER(KIND=4) :: ncout ! ncid of stdev file output
+ INTEGER(KIND=4) :: ncou2 ! ncid of mean file output (optional)
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_var ! varid's of input variables
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! levels and varid's of output vars
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varoutm ! varid's of mean var output (optional)
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! 2d data array
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! tim counter
+ REAL(KIND=4), DIMENSION(1) :: timean ! mean time
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dtab, dtab2 ! cumulated values and squared values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dstd ! standard deviation
+ REAL(KIND=8) :: dtotal_time ! cumulated time
+
+ CHARACTER(LEN=256) :: cf_in ! input file
+ CHARACTER(LEN=256) :: cf_out='cdfstd.nc' ! std dev output file
+ CHARACTER(LEN=256) :: cf_moy='cdfmoy.nc' ! mean output file (optional)
+ CHARACTER(LEN=256) :: cv_dep ! depth variable name
+ CHARACTER(LEN=256) :: cldum ! dummy string
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_namesi ! array of var name
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nameso ! array of var name for output
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvari ! attributes of input variables
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvaro ! attributes of output variables
+
+ LOGICAL :: lcaltmean ! time mean computation flag
+ LOGICAL :: lsave=.false. ! mean value save flag
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfstd ''list_of_ioipsl_model_output_files'' '
+ PRINT *,' usage : cdfstd list_of files [-save]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the standard deviation of the variables belonging to a set of'
+ PRINT *,' files given as arguments. This computation is direct and does not '
+ PRINT *,' required a pre-processing with any of the cdfmoy tools.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' List on netcdf files of the same type, forming a time-series'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ -save ] : Save the mean value of the field, in addition to the '
+ PRINT *,' std deviation'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' - netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : IN-var_std, same units than input variables.'
+ PRINT *,' - netcdf file : ', TRIM(cf_moy),' in case of -save option.'
+ PRINT *,' variables : IN-var, same units than input variables.'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfmoy, cdfrmsssh, cdfstdevw'
STOP
ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth',cdtrue=cdep, kstatus=istatus)
-
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'z',kstatus=istatus)
- IF (istatus /= 0 ) THEN
- npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=istatus)
- IF (istatus /= 0 ) THEN
+
+ ! look for -save option and one of the file name
+ ijarg = 1
+ DO WHILE ( ijarg <= narg )
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-save' )
+ lsave = .true.
+ CASE DEFAULT
+ CALL getarg (ijarg, cf_in) ; ijarg = ijarg + 1
+ EXIT ! got the first file
+ END SELECT
+ END DO
+
+ IF ( chkfile(cf_in) ) STOP ! missing file
+
+ npiglo = getdim (cf_in, cn_x)
+ npjglo = getdim (cf_in, cn_y)
+ npk = getdim (cf_in, cn_z, cdtrue=cv_dep, kstatus=ierr)
+
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'z',kstatus=ierr)
+ IF (ierr /= 0 ) THEN
+ npk = getdim (cf_in,'sigma',cdtrue=cv_dep,kstatus=ierr)
+ IF (ierr /= 0 ) THEN
PRINT *,' assume file with no depth'
npk=0
ENDIF
ENDIF
ENDIF
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
- ALLOCATE( tab(npiglo,npjglo), tab2(npiglo,npjglo), v2d(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo), rmean2(npiglo,npjglo), std(npiglo,npjglo) )
+ ALLOCATE( dtab(npiglo,npjglo), dtab2(npiglo,npjglo), v2d(npiglo,npjglo) )
+ ALLOCATE( dstd(npiglo,npjglo) )
- nvars = getnvar(cfile)
+ nvars = getnvar(cf_in)
PRINT *,' nvars =', nvars
- ALLOCATE (cvarname(nvars), cvarnameo(nvars) )
- ALLOCATE (typvar(nvars), typvaro(nvars) )
- ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars) )
+ ALLOCATE (cv_namesi(nvars), cv_nameso(nvars) )
+ ALLOCATE (stypvari(nvars), stypvaro(nvars) )
+ ALLOCATE (id_var(nvars), ipk(nvars), id_varout(nvars) )
+ IF ( lsave ) ALLOCATE (id_varoutm(nvars) )
- cvarname(:)=getvarname(cfile,nvars,typvar)
+ cv_namesi(:) = getvarname(cf_in, nvars, stypvari)
id_var(:) = (/(jv, jv=1,nvars)/)
- ! ipk gives the number of level or 0 if not a T[Z]YX variable
- ipk(:) = getipk (cfile,nvars,cdep=cdep)
+ ipk(:) = getipk(cf_in, nvars, cdep=cv_dep)
DO jvar = 1, nvars
- cvarnameo(jvar)=TRIM(cvarname(jvar))//'_std'
+ cv_nameso(jvar) = TRIM(cv_namesi(jvar))//'_std'
ENDDO
- WHERE( ipk == 0 ) cvarnameo='none'
+ WHERE( ipk == 0 ) cv_nameso='none'
DO jvar = 1, nvars
- typvaro(jvar)=typvar(jvar)
- typvaro(jvar)%name=cvarnameo(jvar)
- typvaro(jvar)%long_name='Std Deviation of '//TRIM(cvarname(jvar))
- typvaro(jvar)%short_name=cvarnameo(jvar)
+ stypvaro(jvar) = stypvari(jvar)
+ stypvaro(jvar)%cname = cv_nameso(jvar)
+ stypvaro(jvar)%clong_name = 'Std Deviation of '//TRIM(cv_namesi(jvar))
+ stypvaro(jvar)%cshort_name = cv_nameso(jvar)
END DO
! create output fileset
- cfileout='cdfstd.nc'
- ! create output file taking the sizes in cfile
-
- ncout =create(cfileout, cfile, npiglo, npjglo, npk,cdep=cdep )
- ierr= createvar(ncout, typvaro, nvars, ipk, id_varout )
- ierr= putheadervar(ncout, cfile, npiglo, npjglo, npk,cdep=cdep )
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npk, cdep=cv_dep )
+ ierr = createvar (ncout, stypvaro, nvars, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk, cdep=cv_dep )
+
+ IF ( lsave ) THEN
+ ! create output fileset for mean values
+ ncou2 = create (cf_moy, cf_in, npiglo, npjglo, npk, cdep=cv_dep )
+ ierr = createvar (ncou2, stypvari, nvars, ipk, id_varoutm )
+ ierr = putheadervar(ncou2, cf_in, npiglo, npjglo, npk, cdep=cv_dep )
+ ENDIF
lcaltmean=.TRUE.
DO jvar = 1,nvars
- IF (cvarname(jvar) == 'nav_lon' .OR. &
- cvarname(jvar) == 'nav_lat' .OR. &
- cvarnameo(jvar) == 'none' ) THEN
+ IF ( cv_namesi(jvar) == cn_vlon2d .OR. &
+ cv_namesi(jvar) == cn_vlat2d .OR. &
+ cv_nameso(jvar) == 'none' ) THEN
! skip these variable
ELSE
- PRINT *,' Working with ', TRIM(cvarname(jvar)), ipk(jvar)
+ PRINT *,' Working with ', TRIM(cv_namesi(jvar)), ipk(jvar)
+
DO jk = 1, ipk(jvar)
PRINT *,'level ',jk
- tab(:,:) = 0.d0 ; tab2(:,:) = 0.d0 ; total_time = 0.; ntframe=0
- DO jt = 1, narg
- CALL getarg (jt, cfile)
- nt = getdim (cfile,'time_counter')
+
+ dtab(:,:) = 0.d0; dtab2(:,:) = 0.d0; dtotal_time = 0.d0
+ ntframe = 0
+ DO jfil = 1, narg
+ CALL getarg (jfil, cf_in)
+ IF ( chkfile(cf_in) ) STOP ! missing file
+
IF ( lcaltmean ) THEN
- tim(1:nt)=getvar1d(cfile,'time_counter',nt)
- total_time = total_time + SUM(tim(1:nt) )
+ npt = getdim (cf_in, cn_t)
+ ALLOCATE (tim(npt) )
+ tim(:) = getvar1d(cf_in, cn_vtimec, npt)
+ dtotal_time = dtotal_time + SUM(DBLE(tim))
+ DEALLOCATE ( tim )
END IF
- DO jtt=1,nt
- ntframe=ntframe+1
- v2d(:,:)= getvar(cfile, cvarname(jvar), jk ,npiglo, npjglo ,ktime=jtt)
- tab(:,:) = tab(:,:) + v2d(:,:)
- tab2(:,:) = tab2(:,:) + v2d(:,:)*v2d(:,:)
+
+ DO jt=1,npt
+ ntframe = ntframe + 1
+ v2d( :,:) = getvar(cf_in, cv_namesi(jvar), jk, npiglo, npjglo, ktime=jt)
+ dtab( :,:) = dtab( :,:) + v2d(:,:)*1.d0
+ dtab2(:,:) = dtab2(:,:) + v2d(:,:)*v2d(:,:)*1.d0
END DO
END DO
+
! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = tab(:,:)/ntframe
- rmean2(:,:) = tab2(:,:)/ntframe
- std(:,:) = SQRT(rmean2(:,:) - (rmean(:,:)*rmean(:,:)))
- ! store variable on outputfile
- ierr = putvar(ncout, id_varout(jvar) ,std, jk, npiglo, npjglo)
- IF (lcaltmean ) THEN
- timean(1)= total_time/ntframe
- ierr=putvar1d(ncout,timean,1,'T')
+ dtab( :,:) = dtab( :,:) / ntframe
+ dtab2(:,:) = dtab2(:,:) / ntframe
+
+ WHERE ( dtab2 - dtab*dtab >= 0 )
+ dstd = SQRT(dtab2 - dtab*dtab)
+ ELSE WHERE
+ dstd = 0.d0
+ END WHERE
+
+ ! store variable on output file
+ ierr = putvar(ncout, id_varout(jvar), REAL(dstd), jk, npiglo, npjglo, kwght=ntframe)
+ IF ( lsave ) ierr = putvar(ncou2, id_varoutm(jvar), REAL(dtab), jk, npiglo, npjglo, kwght=ntframe)
+
+ IF ( lcaltmean ) THEN
+ timean(1) = dtotal_time / ntframe
+ ierr = putvar1d(ncout, timean, 1, 'T')
+ IF ( lsave ) ierr = putvar1d(ncou2, timean, 1, 'T')
+ lcaltmean = .FALSE. ! tmean already computed
END IF
- lcaltmean=.FALSE. ! tmean already computed
END DO ! loop to next level
END IF
END DO ! loop to next var in file
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
+ ierr = closeout(ncou2)
END PROGRAM cdfstd
diff --git a/cdfstdevts.f90 b/cdfstdevts.f90
index afb3eee..5d8377f 100644
--- a/cdfstdevts.f90
+++ b/cdfstdevts.f90
@@ -1,110 +1,156 @@
PROGRAM cdfstdevts
- !!--------------------------------------------------------------------
- !! *** PROGRAM cdfstdevts ***
+ !!======================================================================
+ !! *** PROGRAM cdfstdevts ***
+ !!=====================================================================
+ !! ** Purpose : Compute the RMS of T and S, from the mean squared value.
!!
- !! ** Purpose : Compute standard deviation of TS fields
- !!
- !! ** Method : Start from T2 files computed with cdfmoy_sal2_temp2
+ !! ** Method : Read gridT and gridT2 and compute rms
!!
- !! history :
- !! Original : J.M. Molines (nov 2004) for ORCA025
- !! J.M. Molines (Apr 2005) : use of modules
- !!--------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2004 : J.M. Molines : Original code
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, jvar
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(2) :: ipk, id_varout
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: u, u2, stdev
- REAL(KIND=4) ,DIMENSION(1) :: timean
- CHARACTER(LEN=256) :: cfile ,cfile2 ,cfileout='stdevts.nc' !: file name
- CHARACTER(LEN=256), DIMENSION(2) :: cvar, cvar2
+ INTEGER(KIND=4) :: jk, jt, jvar ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output variable
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4), DIMENSION(2) :: ipko, id_varout ! output variable
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvbar, zvba2 ! mean and mean2 variable
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsdev ! standard deviation
+
+ CHARACTER(LEN=256) :: cf_in ! input mean file name
+ CHARACTER(LEN=256) :: cf_in2 ! input mean2 file name
+ CHARACTER(LEN=256) :: cf_out = 'stdevts.nc'! output file name
+ CHARACTER(LEN=256) :: cv_in, cv_in2 ! input variable names
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+ CHARACTER(LEN=256), DIMENSION(2) :: cv_namesi ! input variable names
+
+ TYPE(variable), DIMENSION(2) :: stypvaro ! output data structure
- TYPE(variable), DIMENSION(2) :: typvar !: structure for attributes
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- INTEGER :: ncout
- INTEGER :: istatus, ierr
+ cv_namesi(1) = cn_votemper
+ cv_namesi(2) = cn_vosaline
- !! Read command line
narg= iargc()
IF ( narg /= 2 ) THEN
- PRINT *,' Usage : cdfstdevts ''gridX gridX2'' '
- PRINT *,' Output on stdevts.nc variable votemper_stdev vosaline_stdev'
+ PRINT *,' usage : cdfstdevts T-file T2-file '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the standard deviation of the temperature'
+ PRINT *,' and salinity from their mean and mean square values. '
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : netcdf file with mean values for T, S'
+ PRINT *,' T2-file : netcdf file with mean squared values for T,S'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cn_votemper)//'_stdev, same unit than the input.'
+ PRINT *,' ', TRIM(cn_vosaline)//'_stdev, same unit than the input.'
+ PRINT *,' '
+ PRINT *,' SEA ALSO :'
+ PRINT *,' cdfstd, cdfrmsssh, cdfstdevw.'
STOP
ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
- CALL getarg (2, cfile2)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth')
-
- cvar(1)='votemper' ; cvar2(1)='votemper_sqd'
- cvar(2)='vosaline' ; cvar2(2)='vosaline_sqd'
-
- ipk(1) = npk
- typvar(1)%name= 'votemper_stdev'
- typvar(1)%units='DegC'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 20.
- typvar(1)%long_name='stdev_temperature'
- typvar(1)%short_name='votemper_stdev'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
- ipk(2) = npk
- typvar(2)%name= 'vosaline_stdev'
- typvar(2)%units='PSU'
- typvar(2)%missing_value=0.
- typvar(2)%valid_min= 0.
- typvar(2)%valid_max= 10.
- typvar(2)%long_name='STDEV_salinity'
- typvar(2)%short_name='vosaline_stdev'
- typvar(2)%online_operation='N/A'
- typvar(2)%axis='TZYX'
-
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( u(npiglo,npjglo), u2(npiglo,npjglo) )
- ALLOCATE( stdev(npiglo,npjglo) )
-
- ncout =create(cfileout, cfile,npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,2, ipk,id_varout )
- ierr= putheadervar(ncout, cfile, npiglo, npjglo, npk)
-
- DO jvar=1,2
- DO jk = 1, ipk(jvar)
- u(:,:) = getvar(cfile,cvar(jvar),jk, npiglo, npjglo)
- u2(:,:) = getvar(cfile2,cvar2(jvar),jk, npiglo, npjglo)
-
- stdev(:,:) = 0.
- DO ji=2, npiglo
- DO jj=2,npjglo
- stdev(ji,jj) = ((u2(ji,jj)-u(ji,jj)*u(ji,jj)))
- END DO
+
+ ijarg = 1 ; ireq = 0
+ DO WHILE ( ijarg <= narg)
+ CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
+ CASE DEFAULT
+ ireq = ireq + 1
+ SELECT CASE ( ireq )
+ CASE ( 1 ) ; cf_in = cldum
+ CASE ( 2 ) ; cf_in2 = cldum
+ CASE DEFAULT
+ PRINT *, ' Too many variables ' ; STOP
+ END SELECT
+ END SELECT
+ ENDDO
+
+ ! check existence of files
+ lchk = lchk .OR. chkfile(cf_in )
+ lchk = lchk .OR. chkfile(cf_in2)
+ IF (lchk ) STOP ! missing file
+
+ npiglo = getdim (cf_in, cn_x)
+ npjglo = getdim (cf_in, cn_y)
+ npk = getdim (cf_in, cn_z)
+ npt = getdim (cf_in, cn_t)
+
+ ipko(1) = npk
+ stypvaro(1)%cname = TRIM(cn_votemper)//'_stdev'
+ stypvaro(1)%cunits = 'DegC'
+ stypvaro(1)%rmissing_value = 0.
+ stypvaro(1)%valid_min = 0.
+ stypvaro(1)%valid_max = 20
+ stypvaro(1)%clong_name = 'STDEV_Temperature'
+ stypvaro(1)%cshort_name = TRIM(cn_votemper)//'_stdev'
+ stypvaro(1)%conline_operation = 'N/A'
+ stypvaro(1)%caxis = 'TZYX'
+
+ ipko(2) = npk
+ stypvaro(2)%cname = TRIM(cn_vosaline)//'_stdev'
+ stypvaro(2)%cunits = 'PSU'
+ stypvaro(2)%rmissing_value = 0.
+ stypvaro(2)%valid_min = 0.
+ stypvaro(2)%valid_max = 10
+ stypvaro(2)%clong_name = 'STDEV_Salinity'
+ stypvaro(2)%cshort_name = TRIM(cn_vosaline)//'_stdev'
+ stypvaro(2)%conline_operation = 'N/A'
+ stypvaro(2)%caxis = 'TZYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE( zvbar(npiglo,npjglo), zvba2(npiglo,npjglo) )
+ ALLOCATE( dsdev(npiglo,npjglo), tim(npt) )
+
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvaro, 2, ipko, id_varout )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk )
+
+ DO jvar = 1, 2
+ cv_in = cv_namesi(jvar)
+ cv_in2 = TRIM(cv_in)//'_sqd'
+ DO jt = 1, npt
+ DO jk = 1, npk
+ zvbar(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt)
+ zvba2(:,:) = getvar(cf_in2, cv_in2, jk, npiglo, npjglo, ktime=jt)
+
+ dsdev(:,:) = SQRT ( DBLE(zvba2(:,:) - zvbar(:,:)*zvbar(:,:)) )
+
+ ierr = putvar(ncout, id_varout(jvar), REAL(dsdev), jk, npiglo, npjglo, ktime=jt)
END DO
- ierr=putvar(ncout,id_varout(jvar), sqrt(real(stdev)), jk, npiglo, npjglo)
END DO
- timean=getvar1d(cfile,'time_counter',1)
END DO
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
+
+ tim = getvar1d(cf_in, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ ierr = closeout(ncout)
END PROGRAM cdfstdevts
diff --git a/cdfstdevw.f90 b/cdfstdevw.f90
index b9b834c..1deebdf 100644
--- a/cdfstdevw.f90
+++ b/cdfstdevw.f90
@@ -1,92 +1,143 @@
PROGRAM cdfstdevw
- !!--------------------------------------------------------------------
- !! *** PROGRAM cdfstdevw ***
+ !!======================================================================
+ !! *** PROGRAM cdfstdevw ***
+ !!=====================================================================
+ !! ** Purpose : Compute the RMS of W, from the mean squared value.
!!
- !! ** Purpose : Compute standard deviation of W fields
- !!
- !! ** Method : Try to avoid 3 d arrays
+ !! ** Method : Read gridW and gridW2 and compute rms
!!
- !! history :
- !! Original : J.M. Molines (nov 2004) for ORCA025
- !! J.M. Molines (Apr 2005) : use of modules
- !!--------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2004 : J.M. Molines : Original code
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(1) :: ipk, id_varout
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: u, u2, rms
- REAL(KIND=4) ,DIMENSION(1) :: timean
- CHARACTER(LEN=256) :: cfile ,cfile2 ,cfileout='rmsw.nc' !: file name
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output variable
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4), DIMENSION(1) :: ipko, id_varout ! output variable
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zvbar, zvba2 ! mean and mean2 variable
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsdev ! standard deviation
+
+ CHARACTER(LEN=256) :: cf_in ! input mean file name
+ CHARACTER(LEN=256) :: cf_in2 ! input mean2 file name
+ CHARACTER(LEN=256) :: cf_out = 'rmsw.nc'! output file name
+ CHARACTER(LEN=256) :: cv_in, cv_in2 ! input variable names
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+
+ TYPE(variable), DIMENSION(1) :: stypvaro ! output data structure
- TYPE(variable), DIMENSION(1) :: typvar !: structure for attributes
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- INTEGER :: ncout
- INTEGER :: istatus, ierr
+ cv_in = cn_vovecrtz
- !! Read command line
narg= iargc()
IF ( narg /= 2 ) THEN
- PRINT *,' Usage : cdfstdevw ''gridX gridX2'' '
- PRINT *,' Output on rmsw.nc variable vovecrtz_rms'
+ PRINT *,' usage : cdfstdevw W-file W2-file '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the standard deviation of the vertical velocity'
+ PRINT *,' from its mean value and its mean square value. '
+ PRINT *,' '
+ PRINT *,' Note that what is computed in this program is stictly the'
+ PRINT *,' standard deviation. It is very often called RMS, which is'
+ PRINT *,' an abuse. It is the same only in the case of zero mean value.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' W-file : netcdf file with mean values for w'
+ PRINT *,' W2-file : netcdf file with mean squared values for w'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_in)//'_rms, same unit than the input.'
+ PRINT *,' '
+ PRINT *,' SEA ALSO :'
+ PRINT *,' cdfstd, cdfrmsssh, cdfstdevts.'
STOP
ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
- CALL getarg (2, cfile2)
-
- npiglo= getdim (cfile,'x')
- npjglo= getdim (cfile,'y')
- npk = getdim (cfile,'depth')
-
- ipk(1) = npk
- typvar(1)%name= 'vovecrtz_rms'
- typvar(1)%units='m/s'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 1.
- typvar(1)%long_name='RMS_Vertical_Velocity'
- typvar(1)%short_name='vovecrtz_rms'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( u(npiglo,npjglo), u2(npiglo,npjglo) )
- ALLOCATE( rms(npiglo,npjglo) )
-
- ncout =create(cfileout, cfile,npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfile, npiglo, npjglo, npk)
-
- DO jk = 1, ipk(1)
- u(:,:) = getvar(cfile,'vovecrtz',jk, npiglo, npjglo)
- u2(:,:) = getvar(cfile2,'vovecrtz_sqd',jk, npiglo, npjglo)
-
- rms(:,:) = 0.
- DO ji=2, npiglo
- DO jj=2,npjglo
- rms(ji,jj) = SQRT((u2(ji,jj)-u(ji,jj)*u(ji,jj)))
- END DO
+
+ ijarg = 1 ; ireq = 0
+ DO WHILE ( ijarg <= narg)
+ CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
+ CASE DEFAULT
+ ireq = ireq + 1
+ SELECT CASE ( ireq )
+ CASE ( 1 ) ; cf_in = cldum
+ CASE ( 2 ) ; cf_in2 = cldum
+ CASE DEFAULT
+ PRINT *, ' Too many variables ' ; STOP
+ END SELECT
+ END SELECT
+ ENDDO
+
+ ! check existence of files
+ lchk = lchk .OR. chkfile(cf_in )
+ lchk = lchk .OR. chkfile(cf_in2)
+ IF (lchk ) STOP ! missing file
+
+ npiglo = getdim (cf_in, cn_x)
+ npjglo = getdim (cf_in, cn_y)
+ npk = getdim (cf_in, cn_z)
+ npt = getdim (cf_in, cn_t)
+
+ ipko(1) = npk
+ stypvaro(1)%cname = TRIM(cv_in)//'_rms'
+ stypvaro(1)%cunits = 'm/s'
+ stypvaro(1)%rmissing_value = 0.
+ stypvaro(1)%valid_min = 0.
+ stypvaro(1)%valid_max = 0.01
+ stypvaro(1)%clong_name = 'RMS_Vertical_Velocity'
+ stypvaro(1)%cshort_name = TRIM(cv_in)//'_rms'
+ stypvaro(1)%conline_operation = 'N/A'
+ stypvaro(1)%caxis = 'TZYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ALLOCATE( zvbar(npiglo,npjglo), zvba2(npiglo,npjglo) )
+ ALLOCATE( dsdev(npiglo,npjglo), tim(npt) )
+
+ ncout = create (cf_out, cf_in, npiglo, npjglo, npk )
+ ierr = createvar (ncout, stypvaro, 1, ipko, id_varout )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, npk )
+
+ cv_in2 = TRIM(cv_in)//'_sqd'
+ DO jt = 1, npt
+ DO jk = 1, npk
+ zvbar(:,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt)
+ zvba2(:,:) = getvar(cf_in2, cv_in2, jk, npiglo, npjglo, ktime=jt)
+
+ dsdev(:,:) = SQRT ( DBLE(zvba2(:,:) - zvbar(:,:)*zvbar(:,:)) )
+
+ ierr = putvar(ncout, id_varout(1), REAL(dsdev), jk, npiglo, npjglo, ktime=jt)
END DO
- ierr=putvar(ncout,id_varout(1), rms, jk, npiglo, npjglo)
END DO
- timean=getvar1d(cfile,'time_counter',1)
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
+
+ tim = getvar1d(cf_in, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ ierr = closeout(ncout)
END PROGRAM cdfstdevw
diff --git a/cdfstrconv.f90 b/cdfstrconv.f90
index 9cb268f..0d20b8c 100644
--- a/cdfstrconv.f90
+++ b/cdfstrconv.f90
@@ -139,26 +139,26 @@ PROGRAM cdfstrconv
ALLOCATE ( typvartauy(nvar), ipktauy(nvar), id_varouttauy(nvar) )
jvar=1
ipktaux(jvar) = 1
- typvartaux(jvar)%name='sozotaux' ! taux dim 1 of dimgfile
- typvartaux(jvar)%units='N/m2'
- typvartaux(jvar)%missing_value=0.
+ typvartaux(jvar)%cname='sozotaux' ! taux dim 1 of dimgfile
+ typvartaux(jvar)%cunits='N/m2'
+ typvartaux(jvar)%rmissing_value=0.
typvartaux(jvar)%valid_min= -0.1
typvartaux(jvar)%valid_max= 0.1
- typvartaux(jvar)%long_name='Zonal Wind Stress'
- typvartaux(jvar)%short_name='sozotaux'
- typvartaux(jvar)%online_operation='N/A'
- typvartaux(jvar)%axis='TYX'
+ typvartaux(jvar)%clong_name='Zonal Wind Stress'
+ typvartaux(jvar)%cshort_name='sozotaux'
+ typvartaux(jvar)%conline_operation='N/A'
+ typvartaux(jvar)%caxis='TYX'
ipktauy(jvar) = 1
- typvartauy(jvar)%name='sometauy' ! tauy dim 2 of dimgfile
- typvartauy(jvar)%units='N/m2'
- typvartauy(jvar)%missing_value=0.
+ typvartauy(jvar)%cname='sometauy' ! tauy dim 2 of dimgfile
+ typvartauy(jvar)%cunits='N/m2'
+ typvartauy(jvar)%rmissing_value=0.
typvartauy(jvar)%valid_min= -0.1
typvartauy(jvar)%valid_max= 0.1
- typvartauy(jvar)%long_name='Meridional Wind Stress'
- typvartauy(jvar)%short_name='sometauy'
- typvartauy(jvar)%online_operation='N/A'
- typvartauy(jvar)%axis='TYX'
+ typvartauy(jvar)%clong_name='Meridional Wind Stress'
+ typvartauy(jvar)%cshort_name='sometauy'
+ typvartauy(jvar)%conline_operation='N/A'
+ typvartauy(jvar)%caxis='TYX'
ncouttaux =create(ctaux, 'none',npiglo,npjglo,npk,cdep='deptht' )
istatus= createvar(ncouttaux ,typvartaux,nvar, ipktaux,id_varouttaux )
diff --git a/cdfsum.f90 b/cdfsum.f90
index 35f5da5..cce03a3 100644
--- a/cdfsum.f90
+++ b/cdfsum.f90
@@ -1,191 +1,226 @@
PROGRAM cdfsum
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfsum ***
+ !!======================================================================
+ !! *** PROGRAM cdfsum ***
+ !!=====================================================================
+ !! ** Purpose : Compute the sum of a variable over the ocean, or
+ !! part of the ocean
!!
- !! ** Purpose : Compute the SUM over the ocean
- !! PARTIAL STEPS
- !!
- !! ** Method : compute the sum ( V * e1 *e2 * e3 *mask )
+ !! ** Method : this code is for partial steps configuration
+ !! sum = sum ( V * e1 *e2 * e3 *mask )
+ !! CAUTION : this version is still tricky, as it does not
+ !! compute the same thing in case of forcing field or
+ !! model field. Need clarification ( JMM)
!!
- !!
- !! history ;
- !! Original : J.M. Molines (Oct. 2005)
- !! : P. Mathiot ( 2008) : adaptation from cdfmean
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2008 : P. Mathiot : Original code (from cdfmean)
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, ik, jt
- INTEGER :: imin=0, imax=0, jmin=0, jmax=0 !: domain limitation for computation
- INTEGER :: kmin=0, kmax=0 !: domain limitation for computation
- INTEGER :: ierr, err, istatus !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk, nt !: size of the domain
- INTEGER :: nvpk !: vertical levels in working variable
- INTEGER :: numout=10 !: logical unit
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, e3, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: npiglo x npjglo
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep !: depth
-
- REAL(KIND=8) :: zvol, zsum, zvol2d, zsum2d, zsurf
- CHARACTER(LEN=256) :: cfilev , cdum
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmask='mask.nc'
- CHARACTER(LEN=256) :: cvar, cvartype
- CHARACTER(LEN=20) :: ce1, ce2, ce3, cvmask, cvtype, cdep
-
- LOGICAL :: lforcing
- ! constants
-
- !! Read command line and output usage message if not compliant.
+
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ik ! dummy loop index
+ INTEGER(KIND=4) :: iimin=0, iimax=0 ! domain limitation for computation
+ INTEGER(KIND=4) :: ijmin=0, ijmax=0 ! domain limitation for computation
+ INTEGER(KIND=4) :: ikmin=0, ikmax=0 ! domain limitation for computation
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvpk ! vertical levels in working variable
+ INTEGER(KIND=4) :: numout=10 ! logical unit
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1, e2, e3, zv ! metrics, velocity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! npiglo x npjglo
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdep ! depth
+
+ REAL(KIND=8) :: dvol, dvol2d ! volume of the ocean/ layer
+ REAL(KIND=8) :: dsurf ! surface of the ocean
+ REAL(KIND=8) :: dsum, dsum2d ! global sum /layer sum
+
+ CHARACTER(LEN=256) :: cldum ! dummy string
+ CHARACTER(LEN=256) :: cf_in ! file name
+ CHARACTER(LEN=256) :: cv_dep ! depth name
+ CHARACTER(LEN=256) :: cv_in ! variable name
+ CHARACTER(LEN=20) :: cv_e1, cv_e2, cv_e3 ! name of the horiz/vert metrics
+ CHARACTER(LEN=20) :: cv_msk ! name of mask variable
+ CHARACTER(LEN=20) :: cvartype ! variable type
+
+ LOGICAL :: lforcing ! forcing flag
+ LOGICAL :: lchk ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfsum ncfile cdfvar T| U | V | F | W [imin imax jmin jmax kmin kmax] '
- PRINT *,' Computes the sum value of the field (3D, weighted) '
- PRINT *,' imin imax jmin jmax kmin kmax can be given in option '
- PRINT *,' if imin = 0 then ALL i are taken'
- PRINT *,' if jmin = 0 then ALL j are taken'
- PRINT *,' if kmin = 0 then ALL k are taken'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on standard output'
+ PRINT *,' usage : cdfsum IN-file IN-var T| U | V | F | W ... '
+ PRINT *,' ... [imin imax jmin jmax kmin kmax] [-full ] '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes the sum value of the field (3D, weighted)'
+ PRINT *,' This sum can be optionally limited to a sub-area.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : netcdf input file.'
+ PRINT *,' IN-var : netcdf variable to work with.'
+ PRINT *,' T| U | V | F | W : C-grid point where IN-var is located.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [imin imax jmin jmax kmin kmax] : limit of the sub area to work with.'
+ PRINT *,' if imin=0 all i are taken'
+ PRINT *,' if jmin=0 all j are taken'
+ PRINT *,' if kmin=0 all k are taken'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fhgr),', ',TRIM(cn_fzgr),' and ',TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' Standard output.'
STOP
ENDIF
- CALL getarg (1, cfilev)
- CALL getarg (2, cvar)
+ CALL getarg (1, cf_in)
+ CALL getarg (2, cv_in)
CALL getarg (3, cvartype)
+ lchk = chkfile(cn_fhgr)
+ lchk = chkfile(cn_fzgr) .OR. lchk
+ lchk = chkfile(cn_fmsk) .OR. lchk
+ lchk = chkfile(cf_in ) .OR. lchk
+ IF ( lchk ) STOP ! missing file
+
IF (narg > 3 ) THEN
- IF ( narg /= 9 ) THEN
- PRINT *, ' ERROR : You must give 6 optional values (imin imax jmin jmax kmin kmax)'
- STOP
- ELSE
- ! input optional imin imax jmin jmax
- CALL getarg ( 4,cdum) ; READ(cdum,*) imin
- CALL getarg ( 5,cdum) ; READ(cdum,*) imax
- CALL getarg ( 6,cdum) ; READ(cdum,*) jmin
- CALL getarg ( 7,cdum) ; READ(cdum,*) jmax
- CALL getarg ( 8,cdum) ; READ(cdum,*) kmin
- CALL getarg ( 9,cdum) ; READ(cdum,*) kmax
- ENDIF
+ IF ( narg /= 9 ) THEN
+ PRINT *, ' ERROR : You must give 6 optional values (imin imax jmin jmax kmin kmax)'
+ STOP
+ ELSE
+ ! input optional iimin iimax ijmin ijmax
+ CALL getarg ( 4,cldum) ; READ(cldum,*) iimin
+ CALL getarg ( 5,cldum) ; READ(cldum,*) iimax
+ CALL getarg ( 6,cldum) ; READ(cldum,*) ijmin
+ CALL getarg ( 7,cldum) ; READ(cldum,*) ijmax
+ CALL getarg ( 8,cldum) ; READ(cldum,*) ikmin
+ CALL getarg ( 9,cldum) ; READ(cldum,*) ikmax
+ ENDIF
ENDIF
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
- nvpk = getvdim(cfilev,cvar)
- nt = getdim (cfilev,'time_counter')
+ npiglo = getdim (cf_in,cn_x)
+ npjglo = getdim (cf_in,cn_y)
+ npk = getdim (cf_in,cn_z)
+ nvpk = getvdim(cf_in,cv_in)
+ npt = getdim (cf_in,cn_t)
- IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF
- IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF
- IF (kmin /= 0 ) THEN ; npk =kmax -kmin + 1; ELSE ; kmin=1 ; ENDIF
+ IF (iimin /= 0 ) THEN ; npiglo = iimax - iimin + 1; ELSE ; iimin = 1 ; ENDIF
+ IF (ijmin /= 0 ) THEN ; npjglo = ijmax - ijmin + 1; ELSE ; ijmin = 1 ; ENDIF
+ IF (ikmin /= 0 ) THEN ; npk = ikmax - ikmin + 1; ELSE ; ikmin = 1 ; ENDIF
IF (nvpk == 2 ) nvpk = 1
IF (nvpk == 3 ) nvpk = npk
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'nvpk =', nvpk
- PRINT *, 'nt =',nt
+ PRINT *, 'Size of the extracted area :'
+ PRINT *, ' npiglo = ', npiglo
+ PRINT *, ' npjglo = ', npjglo
+ PRINT *, ' npk = ', npk
+ PRINT *, ' nvpk = ', nvpk
+ PRINT *, ' npt = ', npt
lforcing=.FALSE.
-! IF ((npk .EQ. 0) .AND. (nt .GT. 1)) THEN
- IF ((npk .EQ. 0) ) THEN
- lforcing=.TRUE.
- npk=1
+ IF ( (npk == 0) ) THEN
+ lforcing = .TRUE.
+ npk = 1
PRINT *, 'W A R N I N G : you used a forcing field'
END IF
- IF (lforcing) OPEN(unit=numout, file='out.txt' , form='formatted', status='new', iostat=err)
+
+ IF (lforcing) OPEN(unit=numout, file='cdfsum.txt' , form='formatted', status='new', iostat=ierr)
! Allocate arrays
ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo), e3(npiglo,npjglo) )
+ ALLOCATE ( zv (npiglo,npjglo) )
+ ALLOCATE ( e1 (npiglo,npjglo), e2(npiglo,npjglo), e3(npiglo,npjglo) )
ALLOCATE ( gdep (npk) )
+
SELECT CASE (TRIM(cvartype))
CASE ( 'T' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3t_ps'
- cvmask='tmask'
- cdep='gdept'
+ cv_e1 = cn_ve1t
+ cv_e2 = cn_ve2t
+ cv_e3 = 'e3t_ps'
+ cv_msk = 'tmask'
+ cv_dep = cn_gdept
CASE ( 'U' )
- ce1='e1u'
- ce2='e2u'
- ce3='e3t_ps'
- cvmask='umask'
- cdep='gdept'
+ cv_e1 = cn_ve1u
+ cv_e2 = cn_ve2u
+ cv_e3 = 'e3t_ps'
+ cv_msk = 'umask'
+ cv_dep = cn_gdept
CASE ( 'V' )
- ce1='e1v'
- ce2='e2v'
- ce3='e3t_ps'
- cvmask='vmask'
- cdep='gdept'
+ cv_e1 = cn_ve1v
+ cv_e2 = cn_ve2v
+ cv_e3 = 'e3t_ps'
+ cv_msk = 'vmask'
+ cv_dep = cn_gdept
CASE ( 'F' )
- ce1='e1f'
- ce2='e2f'
- ce3='e3t_ps'
- cvmask='fmask'
- cdep='gdept'
+ cv_e1 = cn_ve1f
+ cv_e2 = cn_ve2f
+ cv_e3 = 'e3t_ps'
+ cv_msk = 'fmask'
+ cv_dep = cn_gdept
CASE ( 'W' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3w_ps'
- cvmask='tmask'
- cdep='gdepw'
+ cv_e1 = cn_ve1t
+ cv_e2 = cn_ve2t
+ cv_e3 = 'e3w_ps'
+ cv_msk = 'tmask'
+ cv_dep = cn_gdepw
CASE DEFAULT
- PRINT *, 'this type of variable is not known :', trim(cvartype)
- STOP
+ PRINT *, 'this type of variable is not known :', TRIM(cvartype)
+ STOP
END SELECT
- e1(:,:) = getvar(coordhgr, ce1, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- e2(:,:) = getvar(coordhgr, ce2, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- gdep(:) = getvare3(coordzgr,cdep,npk)
+ e1(:,:) = getvar (cn_fhgr, cv_e1, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin)
+ e2(:,:) = getvar (cn_fhgr, cv_e2, 1, npiglo, npjglo, kimin=iimin, kjmin=ijmin)
+ gdep(:) = getvare3(cn_fzgr, cv_dep, npk )
- zvol=0.d0
- zsum=0.d0
- DO jt = 1,nt
- zsum=0.d0
- zv=0.
+ DO jt = 1,npt
+ dvol = 0.d0
+ dsum = 0.d0
+ zv = 0.
DO jk = 1,nvpk
- ik = jk+kmin-1
+ ik = jk + ikmin -1
! Get velocities v at ik
- zv(:,:)= getvar(cfilev, cvar, ik ,npiglo,npjglo,ktime=jt,kimin=imin,kjmin=jmin)
- zmask(:,:)=getvar(cmask,cvmask,ik,npiglo,npjglo,kimin=imin,kjmin=jmin)
+ zv (:,:) = getvar(cf_in, cv_in, ik, npiglo, npjglo, ktime=jt, kimin=iimin, kjmin=ijmin)
+ zmask(:,:) = getvar(cn_fmsk, cv_msk, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin)
! zmask(:,npjglo)=0.
-
+
! get e3 at level ik ( ps...)
- e3(:,:) = getvar(coordzgr, ce3, ik,npiglo,npjglo,kimin=imin,kjmin=jmin, ldiom=.true.)
+ e3(:,:) = getvar(cn_fzgr, cv_e3, ik, npiglo, npjglo, kimin=iimin, kjmin=ijmin, ldiom=.TRUE.)
!
IF (.NOT. lforcing) THEN
- zsurf=sum(e1 * e2 * zmask)
- zvol2d=sum(e1 * e2 * e3 * zmask)
- zvol=zvol+zvol2d
- zsum2d=sum(zv)
- zsum=zsum+zsum2d
- IF (zvol2d /= 0 )THEN
- PRINT *, ' Sum value at level ',ik,'(',gdep(ik),' m) ',zsum2d
+ dsurf = SUM(DBLE(e1 * e2 * zmask))
+ dvol2d = SUM(DBLE(e1 * e2 * e3 * zmask))
+ dvol = dvol + dvol2d
+ dsum2d = SUM(DBLE(zv))
+ dsum = dsum + dsum2d
+ IF (dvol2d /= 0 )THEN
+ PRINT *, ' Sum value at level ', ik, '(',gdep(ik),' m) ', dsum2d
ELSE
- PRINT *, ' No points in the water at level ',ik,'(',gdep(ik),' m) '
+ PRINT *, ' No points in the water at level ', ik, '(',gdep(ik),' m) '
ENDIF
ELSE
- zsurf=sum(e1 * e2 * zmask)
- zsum2d=sum(zv*e1*e2*zmask)
- zsum=zsum+zsum2d
- PRINT *, ' Sum value at time ',jt,' = ',zsum2d
- WRITE (numout,'(i4," ",1e12.6)') jt, zsum2d
+ dsurf = SUM(DBLE( e1 * e2 * zmask))
+ dsum2d = SUM(DBLE(zv * e1 * e2 * zmask))
+ dsum = dsum + dsum2d
+ PRINT *, ' Sum value at time ',jt,' = ', dsum2d
+ WRITE (numout,'(i4," ",1e12.6)') jt, dsum2d
END IF
END DO
- IF (.NOT. lforcing) PRINT * ,' Sum value over the ocean: ', zsum
- END DO
- CLOSE(1)
- END PROGRAM cdfsum
+ IF (.NOT. lforcing) PRINT * ,' Sum value over the ocean: ', dsum
+ END DO ! time loop
+
+ CLOSE(numout)
+
+END PROGRAM cdfsum
diff --git a/cdftemptrp-full.f90 b/cdftemptrp-full.f90
deleted file mode 100644
index 7a3c0d4..0000000
--- a/cdftemptrp-full.f90
+++ /dev/null
@@ -1,425 +0,0 @@
-PROGRAM cdftemptrp_full
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdftemptrp_full ***
- !!
- !! ** Purpose: Compute temperature class Mass Transports across a section
- !! FULL STEPS version
- !!
- !! ** Method:
- !! -The begining and end point of the section are given in term of f-points index.
- !! -The program works for zonal or meridional sections.
- !! -The section definitions are given in an ASCII FILE dens_section.dat
- !! foreach sections, 2 lines : (i) : section name (String, no blank)
- !! (ii) : imin imax jmin jmax for the section
- !! -Only vertical slices corrsponding to the sections are read in the files.
- !! read metrics, depth, etc
- !! read normal velocity (either vozocrtx oy vomecrty )
- !! read 2 rows of T ( i i+1 or j j+1 )
- !! compute the mean value at velocity point
- !! compute the depths of isothermal surfaces
- !! compute the transport from surface to the isotherm
- !! compute the transport in each class of temperature
- !! compute the total transport (for information)
- !!
- !! history :
- !! Original : F. Castruccio ( Fall 2006)
- !!
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nbins !: number of density classes
- INTEGER :: ji, jk, jclass, jsec, jiso, jbin, jarg !: dummy loop index
- INTEGER :: ipos !: working variable
- INTEGER :: narg, iargc, nxtarg !: command line
- INTEGER :: npk, nk !: vertical size, number of wet layers in the section
- INTEGER :: numbimg=10 !: optional bimg logical unit
- INTEGER :: numout=11 !: ascii output
-
- INTEGER :: nsection !: number of sections (overall)
- INTEGER ,DIMENSION(:), ALLOCATABLE :: imina, imaxa, jmina, jmaxa !: sections limits
- INTEGER :: imin, imax, jmin, jmax !: working section limits
- INTEGER :: npts !: working section number of h-points
-
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdept, gdepw !: depth of T and W points
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: e3t !: depth of T and W points
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zt !: temperature from file
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: tmpm, tmpz !: temporary arrays
-
- ! double precision for cumulative variables
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: eu !: either e1v or e2u
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zu, e3 , zmask !: velocities e3 and umask
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztemp, gdepu !: temp., depth of vel points
- REAL(KIND=8) :: temp_min, temp_max,dtemp !: Min and Max for temp. bining
- REAL(KIND=8) :: temp,zalfa !: current working temp.
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: temp_lev !: built array with temp. levels
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: hiso !: depth of isotherms
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwtrp, zwtrpbin, trpbin !: transport arrays
-
- CHARACTER(LEN=256), DIMENSION (:), ALLOCATABLE :: csection !: section name
- CHARACTER(LEN=256) :: cfilet, cfileu, cfilev, cfilesec='temp_section.dat' !: files name
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc' !: coordinates files
- CHARACTER(LEN=256) :: cfilout='trptemp.txt' !: output file
- CHARACTER(LEN=256) :: cdum !: dummy string
-
- LOGICAL :: l_merid !: flag is true for meridional working section
- LOGICAL :: l_print=.FALSE. !: flag for printing additional results
- LOGICAL :: l_bimg=.FALSE. !: flag for bimg output
-
- !! * Initialisations
-
- ! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 6 ) THEN
- PRINT '(255a)',' Usage : cdftemptrp-full gridTfile gridUfile gridVfile temp_max temp_min nbins [options]'
- PRINT '(255a)',' temp_max, temp_min : limit for temperature bining '
- PRINT '(255a)',' nbins : number of bins to use '
- PRINT '(255a)',' Possible options :'
- PRINT '(255a)',' -print :additional output is send to std output'
- PRINT '(255a)',' -bimg : 2D (x=lat/lon, y=temp) output on bimg file for hiso, cumul trp, trp'
- PRINT '(255a)',' Files mesh_hgr.nc, mesh_zgr.nc must be in the current directory'
- PRINT '(255a)',' File temp_section.dat must also be in the current directory '
- PRINT '(255a)',' Output on trptemp.txt'
- STOP
- ENDIF
-
- !! Read arguments
- CALL getarg (1, cfilet)
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
- CALL getarg (4,cdum) ; READ(cdum,*) temp_max
- CALL getarg (5,cdum) ; READ(cdum,*) temp_min
- CALL getarg (6,cdum) ; READ(cdum,*) nbins
-
- DO jarg=7, narg
- CALL getarg(jarg,cdum)
- SELECT CASE (cdum)
- CASE ('-print' )
- l_print = .TRUE.
- CASE ('-bimg')
- l_bimg = .TRUE.
- CASE DEFAULT
- PRINT *,' Unknown option ', TRIM(cdum),' ... ignored'
- END SELECT
- END DO
-
- ! Initialise sections from file
- nsection=section_number(cfilesec)
- ALLOCATE ( csection(nsection), imina(nsection), imaxa(nsection), jmina(nsection), jmaxa(nsection) )
- CALL section_init(cfilesec, csection,imina,imaxa,jmina,jmaxa, nsection)
-
- ! Allocate and build temp. levels and section array
- ALLOCATE ( temp_lev (nbins+1) , trpbin(nsection,nbins) )
-
- temp_lev(1)=temp_max
- dtemp=( temp_max - temp_min) / nbins
- DO jclass =2, nbins+1
- temp_lev(jclass)= temp_lev(1) - (jclass-1) * dtemp
- END DO
-
- ! Look for vertical size of the domain
- npk = getdim (cfilet,'depth')
- ALLOCATE ( gdept(npk), gdepw(npk), e3t(npk) )
-
- ! read gdept, gdepw
- gdept(:) = getvare3(coordzgr, 'gdept',npk)
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
- e3t(:) = getvare3(coordzgr, 'e3t',npk)
-
- !! * Main loop on sections
-
- write(*,*) 'nsection',nsection
- DO jsec=1,nsection
- l_merid=.FALSE.
- imin=imina(jsec) ; imax=imaxa(jsec) ; jmin=jmina(jsec) ; jmax=jmaxa(jsec)
- IF (imin == imax ) THEN ! meridional section
- l_merid=.TRUE.
- npts=jmax-jmin
-
- ELSE IF ( jmin == jmax ) THEN ! zonal section
- npts=imax-imin
-
- ELSE
- PRINT *,' Section ',TRIM(csection(jsec)),' is neither zonal nor meridional :('
- PRINT *,' We skip this section .'
- CYCLE
- ENDIF
-
- ALLOCATE ( zu(npts, npk), zt(npts,npk), ztemp(npts,0:npk))
- ALLOCATE ( eu(npts), e3(npts,npk), gdepu(npts, npk), zmask(npts,npk) )
- ALLOCATE ( tmpm(1,npts,2), tmpz(npts,1,2) )
- ALLOCATE ( zwtrp(npts, nbins+1) , hiso(npts,nbins+1), zwtrpbin(npts,nbins) )
-
- zt = 0. ; zu = 0. ; gdepu= 0. ; zmask = 0. ; ztemp=0.d0
-
- IF (l_merid ) THEN ! meridional section at i=imin=imax
- tmpm(:,:,1)=getvar(coordhgr, 'e2u', 1,1,npts, kimin=imin, kjmin=jmin+1)
- eu(:)=tmpm(1,:,1) ! metrics varies only horizontally
- DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (Full step )
- e3(:,jk)=e3t(jk)
-
- ! Normal velocity
- tmpm(:,:,1)=getvar(cfileu,'vozocrtx',jk,1,npts, kimin=imin, kjmin=jmin+1)
- zu(:,jk)=tmpm(1,:,1)
-
- ! temperature
- tmpm(:,:,1)=getvar(cfilet,'votemper',jk,1,npts, kimin=imin, kjmin=jmin+1)
- tmpm(:,:,2)=getvar(cfilet,'votemper',jk,1,npts, kimin=imin+1, kjmin=jmin+1)
- zmask(:,jk)=tmpm(1,:,1)*tmpm(1,:,2)
- WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
- ! do not take special care for land value, as the corresponding velocity point is masked
- zt(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) )
-
- ! limitation to 'wet' points
- IF ( SUM(zt(:,jk)) == 0 ) THEN
- nk=jk ! first vertical point of the section full on land
- EXIT ! as soon as all the points are on land
- ENDIF
-
-
- END DO
-
- ELSE ! zonal section at j=jmin=jmax
- tmpz(:,:,1)=getvar(coordhgr, 'e1v', 1,npts,1,kimin=imin, kjmin=jmin)
- eu=tmpz(:,1,1)
- DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (Full step case)
- e3(:,jk)=e3t(jk)
-
- ! Normal velocity
- tmpz(:,:,1)=getvar(cfilev,'vomecrty',jk,npts,1, kimin=imin+1, kjmin=jmin)
- zu(:,jk)=tmpz(:,1,1)
-
- ! temperature
- tmpz(:,:,1)=getvar(cfilet,'votemper',jk, npts, 1, kimin=imin+1, kjmin=jmin)
- tmpz(:,:,2)=getvar(cfilet,'votemper',jk, npts, 1, kimin=imin+1, kjmin=jmin+1)
- zmask(:,jk)=tmpz(:,1,1)*tmpz(:,1,2)
- WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
- ! do not take special care for land value, as the corresponding velocity point is masked
- zt(:,jk) = 0.5 * ( tmpz(:,1,1) + tmpz(:,1,2) )
-
- ! limitation to 'wet' points
- IF ( SUM(zt(:,jk)) == 0 ) THEN
- nk=jk ! first vertical point of the section full on land
- EXIT ! as soon as all the points are on land
- ENDIF
-
- END DO
-
- ENDIF
-
- ! temp. only for wet points
- ztemp(:,1:nk)=zt(:,:)
- ztemp(:,0)=ztemp(:,1)-1.e-4 ! dummy layer for easy interpolation
-
- ! Some control print
- IF ( l_print ) THEN
- PRINT *,' T (deg C)'
- DO jk=1,nk
- PRINT 9000, jk, (ztemp(ji,jk),ji=1,npts)
- END DO
-
- PRINT *,' VELOCITY (cm/s ) '
- DO jk=1,nk
- PRINT 9000, jk, (zu(ji,jk)*100,ji=1,npts)
- END DO
-
- PRINT *,' GDEPU (m) '
- DO jk=1,nk
- PRINT 9001,jk, (gdepu(ji,jk)*zmask(ji,jk),ji=1,npts)
- END DO
-
- PRINT *, 'E3 (m)'
- DO jk=1,nk
- PRINT 9001,jk, (e3(ji,jk)*zmask(ji,jk),ji=1,npts)
- END DO
- END IF
-
- ! compute depth of isotherms (nbins+1 )
- IF (l_print ) PRINT *,' DEP ISO ( m )'
- DO jiso =1, nbins+1
- temp=temp_lev(jiso)
-!!! REM : I and K loop can be inverted if necessary
- DO ji=1,npts
- hiso(ji,jiso) = gdept(npk)
- DO jk=1,nk
- IF ( ztemp(ji,jk) > temp ) THEN
- ELSE
- ! interpolate between jk-1 and jk
- zalfa=(temp - ztemp(ji,jk-1)) / ( ztemp(ji,jk) -ztemp(ji,jk-1) )
- IF (ABS(zalfa) > 1.1 ) THEN ! case ztemp(0) = ztemp(1)-1.e-4
- hiso(ji,jiso)= 0.
- ELSE
- hiso(ji,jiso)= gdepu(ji,jk)*zalfa + (1.-zalfa)* gdepu(ji,jk-1)
- ENDIF
- EXIT
- ENDIF
- END DO
- END DO
- IF (l_print) PRINT 9002, temp,(hiso(ji,jiso),ji=1,npts)
- END DO
-
- ! compute transport between surface and isotherm
- IF (l_print) PRINT *,' TRP SURF --> ISO (SV)'
- DO jiso = 1, nbins + 1
- temp=temp_lev(jiso)
- DO ji=1,npts
- zwtrp(ji,jiso) = 0.d0
- DO jk=1, nk
- IF ( gdepw(jk+1) < hiso(ji,jiso) ) THEN
- zwtrp(ji,jiso)= zwtrp(ji,jiso) + eu(ji)*e3(ji,jk)*zu(ji,jk)
- ELSE ! last box ( fraction)
- zwtrp(ji,jiso)= zwtrp(ji,jiso) + eu(ji)*(hiso(ji,jiso)-gdepw(jk))*zu(ji,jk)
- EXIT ! jk loop
- ENDIF
- END DO
- END DO
- IF (l_print) PRINT 9003, temp,(zwtrp(ji,jiso)/1.e6,ji=1,npts)
- END DO
-
- ! binned transport : difference between 2 isotherms
- IF (l_print) PRINT *,' TRP bins (SV)'
- DO jbin=1, nbins
- temp=temp_lev(jbin)
- DO ji=1, npts
- zwtrpbin(ji,jbin) = zwtrp(ji,jbin+1) - zwtrp(ji,jbin)
- END DO
- trpbin(jsec,jbin)=SUM(zwtrpbin(:,jbin) )
- IF (l_print) PRINT 9003, temp,(zwtrpbin(ji,jbin)/1.e6,ji=1,npts), trpbin(jsec,jbin)/1.e6
- END DO
- PRINT *,' Total transport in all bins :',TRIM(csection(jsec)),' ',SUM(trpbin(jsec,:) )/1.e6
-
-
- ! output of the code for 1 section
- IF (l_bimg) THEN
- ! (along section, depth ) 2D variables
- cdum=TRIM(csection(jsec))//'_trpdep.bimg'
- OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED')
- cdum=' 3 dimensions in this file '
- WRITE(numbimg) cdum
- cdum=' 1: T ; 2: Velocity '
- WRITE(numbimg) cdum
- WRITE(cdum,'(a,4i5.4)') ' from '//TRIM(csection(jsec)), imin,imax,jmin,jmax
- WRITE(numbimg) cdum
- cdum=' file '//TRIM(cfilet)
- WRITE(numbimg) cdum
- WRITE(numbimg) npts,nk,1,1,2,0
- WRITE(numbimg) 1.,-float(nk),1.,1., 0.
- WRITE(numbimg) 0.
- WRITE(numbimg) 0.
- ! temperature
- WRITE(numbimg) (( REAL(ztemp(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- ! Velocity
- WRITE(numbimg) (( REAL(zu(ji,jk)), ji=1,npts) , jk=nk,1,-1 )
- CLOSE(numbimg)
-
- ! (along section, temp ) 2D variables
- cdum=TRIM(csection(jsec))//'_trptemp.bimg'
- OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED')
- cdum=' 3 dimensions in this file '
- WRITE(numbimg) cdum
- cdum=' 1: hiso ; 2: bin trp '
- WRITE(numbimg) cdum
- WRITE(cdum,'(a,4i5.4)') ' from '//TRIM(csection(jsec)), imin,imax,jmin,jmax
- WRITE(numbimg) cdum
- cdum=' file '//TRIM(cfilet)
- WRITE(numbimg) cdum
- WRITE(numbimg) npts,nbins,1,1,2,0
- WRITE(numbimg) 1.,-REAL(temp_lev(nbins)),1.,REAL(dtemp), 0.
- WRITE(numbimg) 0.
- WRITE(numbimg) 0.
- ! hiso
- WRITE(numbimg) (( REAL(hiso(ji,jiso)), ji=1,npts) , jiso=nbins,1,-1)
- ! binned transport
- WRITE(numbimg) (( REAL(zwtrpbin(ji,jiso))/1.e6, ji=1,npts) , jiso=nbins,1,-1)
- CLOSE(numbimg)
- ENDIF
-
- ! free memory for the next section
- DEALLOCATE ( zu, zt, ztemp, gdepu, hiso, zwtrp, zwtrpbin )
- DEALLOCATE ( eu, e3 ,tmpm, tmpz, zmask )
-
- END DO ! next section
-
- !! Global Output
- OPEN( numout, FILE=cfilout)
- ipos=INDEX(cfilet,'_gridT.nc')
- WRITE(numout,9006) TRIM(cfilet(1:ipos-1))
- WRITE(numout,9005) ' temp. ', (csection(jsec),jsec=1,nsection)
- DO jiso=1,nbins
- WRITE(numout,9004) temp_lev(jiso), (trpbin(jsec,jiso),jsec=1,nsection)
- ENDDO
- CLOSE(numout)
-
-9000 FORMAT(i7,40f8.3)
-9001 FORMAT(i7,40f8.0)
-9002 FORMAT(f7.3,40f8.0)
-9003 FORMAT(f7.3,40f8.3)
-9004 FORMAT(f9.4, 40e16.7)
-9005 FORMAT('#',a9, 40(2x,a12,2x) )
-9006 FORMAT('# ',a)
-
-CONTAINS
- FUNCTION section_number ( cdfile)
- ! Arguments
- CHARACTER(LEN=*), INTENT(IN) :: cdfile
- INTEGER :: section_number
-
- ! Local variables
- INTEGER :: ii, numit=10, jsec
- CHARACTER(LEN=256) :: cline
-
- OPEN(numit, FILE=cdfile)
- ii=0
- DO
- READ(numit,'(a)') cline
- IF (INDEX(cline,'EOF') == 0 ) THEN
- READ(numit,*) ! skip one line
- ii = ii + 1
- ELSE
- section_number=ii
- EXIT
- ENDIF
- END DO
-
- END FUNCTION section_number
-
- SUBROUTINE section_init(cdfile,cdsection,kimin,kimax,kjmin,kjmax,knumber)
- IMPLICIT NONE
- ! Arguments
- INTEGER, DIMENSION(:) :: kimin,kimax, kjmin,kjmax
- INTEGER, INTENT(IN) :: knumber
- CHARACTER(LEN=256), DIMENSION(:) :: cdsection
- CHARACTER(LEN=*), INTENT(IN) :: cdfile
-
- ! Local variables
- INTEGER :: ii, numit=10, jsec
- CHARACTER(LEN=256) :: cline
-
- OPEN(numit, FILE=cdfile)
- REWIND(numit)
-
- DO jsec=1,knumber
- READ(numit,'(a)') cdsection(jsec)
- READ(numit,*) kimin(jsec), kimax(jsec), kjmin(jsec), kjmax(jsec)
- END DO
-
- CLOSE(numit)
-
- END SUBROUTINE section_init
-
-END PROGRAM cdftemptrp_full
diff --git a/cdftools.f90 b/cdftools.f90
index 1813106..63f5d6a 100644
--- a/cdftools.f90
+++ b/cdftools.f90
@@ -1,324 +1,370 @@
MODULE cdftools
- !!---------------------------------------------------------------------------
- !! *** MODULE cdftools ***
- !!
- !! Purpose : this module holds subroutine that corresponds to cdftools.
- !! for example cdf_findij is the subroutine equivalent to cdffindij
- !!
- !! Method : when necessery or usefull, an existing cdftools is transformed in
- !! a callable routine. We decided to call the routine cdf_xxxx, in
- !! order to make the difference with the corresponding program
- !!
- !! history: Original: J.M. Molines, A. Melet-Dieudonne (May 2010)
- !!---------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
+ !!======================================================================
+ !! *** MODULE cdftools ***
+ !! This module holds subroutine that corresponds to cdftools.
+ !! For example cdf_findij is the subroutine equivalent to cdffindij
+ !!=====================================================================
+ !! History : 2.1 ! 05/2010 : J.M. Molines, A. Melet : Original
+ !! 3.0 ! 12/2010 : J.M. Molines : Doctor + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! cdf_findij : the routine version of cdffindij
+ !! NearestPoint : determine the nearest point from a lon lat location
+ !! dist : compute the distance along othodromic route
+ !!----------------------------------------------------------------------
USE cdfio
+ USE modcdfnames
+
IMPLICIT NONE
PRIVATE
! list of public subroutines that can be called
- PUBLIC :: cdf_findij
-
- CONTAINS
-
- SUBROUTINE cdf_findij ( pxmin, pxmax, pymin, pymax, &
- & kimin, kimax, kjmin, kjmax, &
- & cd_coord, cd_point )
- !!--------------------------------------------------------------------------
- !! *** SUBROUTINE CDF_FINDIJ ***
- !!
- !! Purpose : the routine equivalent of cdffindij
- !!--------------------------------------------------------------------------
- !! Arguments
- REAL(KIND=4), INTENT(in) :: pxmin, pxmax, pymin, pymax !: geographical window in lon-lat
- INTEGER, INTENT(out) :: kimin, kimax, kjmin, kjmax !: equivalent in model coordinates
- CHARACTER(*), OPTIONAL, INTENT(in) :: cd_coord !: coordinate file name (default coordinates.nc)
- CHARACTER(*), OPTIONAL, INTENT(in) :: cd_point !: point type (default F )
-
- !! * Local variables
- INTEGER :: niter
- INTEGER :: imin, imax, jmin, jmax
- INTEGER, SAVE :: iloc, jloc
- INTEGER :: npiglo, npjglo
- INTEGER, PARAMETER :: jpitermax=15
-
- REAL(KIND=8) :: xmin, xmax, ymin, ymax, rdis
- REAL(KIND=4) :: glamfound, glamin, glamax
- REAL(KIND=8) :: glam0, emax
- REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: glam, gphi, e1, e2
-
- CHARACTER(LEN=256) :: cdum, coord='coordinates.nc', ctype='F'
-
- LOGICAL :: lagain, lbord
-
- xmin = pxmin
- xmax = pxmax
- ymin = pymin
- ymax = pymax
-
- IF ( PRESENT( cd_coord) ) coord=cd_coord
- IF ( PRESENT( cd_point) ) ctype=cd_point
-
- npiglo= getdim (coord,'x')
- npjglo= getdim (coord,'y')
-
- ALLOCATE (glam(npiglo,npjglo), gphi(npiglo,npjglo) )
- ALLOCATE (e1(npiglo,npjglo), e2(npiglo,npjglo) )
-
- SELECT CASE ( ctype )
- CASE ('T' , 't' )
- glam(:,:) = getvar(coord, 'glamt',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphit',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1t' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2t' ,1,npiglo,npjglo)
- CASE ('U','u' )
- glam(:,:) = getvar(coord, 'glamu',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphiu',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1u' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2u' ,1,npiglo,npjglo)
- CASE ('V','v' )
- glam(:,:) = getvar(coord, 'glamv',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphiv',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1v' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2v' ,1,npiglo,npjglo)
- CASE ('F','f' )
- glam(:,:) = getvar(coord, 'glamf',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphif',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1f' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2f' ,1,npiglo,npjglo)
- CASE DEFAULT
- PRINT *,' ERROR : type of point not known: ', TRIM(ctype)
- END SELECT
- ! work with longitude between 0 and 360 to avoid the date line.
- WHERE( glam < 0 ) glam=glam+360.
- ! For Orca grid, the longitude of ji=1 is about 70 E
- glam0=glam(1, npjglo/2)
- WHERE( glam < glam0 ) glam=glam+360.
-
- IF (xmin < 0.) xmin = xmin +360.
- IF (xmax < 0.) xmax = xmax +360.
-
- IF (xmin < glam0) xmin = xmin +360.
- IF (xmax < glam0) xmax = xmax +360.
-
-
- lagain = .TRUE.
- niter = 1
- DO WHILE (lagain)
- CALL Nearestpoint(xmin,ymin,npiglo,npjglo,glam,gphi,iloc,jloc,lbord)
- ! distance between the target point and the nearest point
- rdis=dist(xmin,glam(iloc,jloc),ymin,gphi(iloc,jloc) ) ! in km
- ! typical grid size (diagonal) in the vicinity of nearest point
- emax= MAX(e1(iloc,jloc),e2(iloc,jloc))/1000.*SQRT(2.) ! in km
-
-! rdis = (xmin - glam(iloc,jloc))**2 + (ymin - gphi(iloc,jloc))**2
-! rdis = SQRT(rdis)
- IF (rdis > emax ) THEN
- glamfound=glam(iloc,jloc) ; IF (glamfound > 180.) glamfound=glamfound -360.
- PRINT 9000, 'Long= ',glamfound,' Lat = ',gphi(iloc,jloc)&
- & , iloc, jloc
- PRINT *,' Algorithme ne converge pas ', rdis
- IF ( niter >= jpitermax ) STOP ' pas de convergence apres iteration'
- lagain = .TRUE.
- niter = niter +1
- ! change location of first guess point for next interation
- jloc = (niter -1)* npjglo/niter
- iloc = (niter -1)* npiglo/jpitermax
- ELSE
- PRINT '("# rdis= ",f8.3," km")', rdis
- lagain = .FALSE.
- END IF
- END DO
- IF (lbord) THEN
- WRITE (*,*)'Point Out of domain or on boundary'
- ELSE
- imin=iloc
- jmin=jloc
- ! PRINT 9000, 'Long= ',glam(iloc,jloc),' lat = ',gphi(iloc,jloc), iloc, jloc
- ENDIF
- !
- lagain = .TRUE.
- niter = 1
- iloc=npiglo/2 ; jloc=npjglo/2
- DO WHILE (lagain)
- CALL Nearestpoint(xmax,ymax,npiglo,npjglo,glam,gphi,iloc,jloc,lbord)
- ! distance between the target point and the nearest point
- rdis=dist(xmax,glam(iloc,jloc),ymax,gphi(iloc,jloc) ) ! in km
- ! typical grid size (diagonal) in the vicinity of nearest point
- emax= MAX(e1(iloc,jloc),e2(iloc,jloc))/1000.*SQRT(2.) ! in km
-! rdis = (xmax - glam(iloc,jloc))**2 + (ymax - gphi(iloc,jloc))**2
-! rdis = SQRT(rdis)
- IF (rdis > emax ) THEN
- glamfound=glam(iloc,jloc) ; IF (glamfound > 180.) glamfound=glamfound -360.
- PRINT 9000, 'Long= ',glamfound,' Lat = ',gphi(iloc,jloc) &
- & , iloc, jloc
- PRINT *,' Algorithme ne converge pas ', rdis
- IF ( niter >= jpitermax ) STOP ' pas de convergence apres iteration'
- lagain = .TRUE.
- niter = niter +1
- jloc = (niter -1)* npjglo/niter
- iloc = (niter -1)* npiglo/jpitermax
- ELSE
- PRINT '("# rdis= ",f8.3," km")', rdis
- lagain = .FALSE.
- END IF
- END DO
- IF (lbord) THEN
- WRITE (*,*) 'Point Out of domain or on boundary'
- ELSE
- imax=iloc
- jmax=jloc
- ! PRINT 9000, 'Long= ',glam(iloc,jloc),' lat = ',gphi(iloc,jloc), iloc, jloc
- ENDIF
+ PUBLIC :: cdf_findij
+ PRIVATE :: NearestPoint
+ PRIVATE :: dist
+
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
+
+CONTAINS
+
+ SUBROUTINE cdf_findij ( pxmin, pxmax, pymin, pymax, &
+ & kimin, kimax, kjmin, kjmax, cd_coord, cd_point )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE cdf_findij ***
+ !!
+ !! ** Purpose : the routine equivalent of cdffindij
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), INTENT(in) :: pxmin, pxmax, pymin, pymax !: geographical window in lon-lat
+ INTEGER(KIND=4), INTENT(out) :: kimin, kimax, kjmin, kjmax !: equivalent in model coordinates
+ CHARACTER(*), OPTIONAL, INTENT(in) :: cd_coord !: coordinate file name (D: cn_fcoo)
+ CHARACTER(*), OPTIONAL, INTENT(in) :: cd_point !: point type (D: F )
+
+ INTEGER(KIND=4) :: initer
+ INTEGER(KIND=4) :: imin, imax, jmin, jmax
+ INTEGER(KIND=4), SAVE :: iloc, jloc
+ INTEGER(KIND=4) :: ipiglo, ipjglo
+ INTEGER(KIND=4), PARAMETER :: jp_itermax=15
- PRINT 9001, imin,imax, jmin, jmax
- kimin=imin ; kimax=imax; kjmin=jmin ; kjmax=jmax
- glamin=glam(imin,jmin) ;glamax=glam(imax,jmax)
- IF ( glamin > 180 ) glamin=glamin-360.
- IF ( glamax > 180 ) glamax=glamax-360.
- PRINT 9002, glamin, glamax, gphi(imin,jmin),gphi(imax,jmax)
+ REAL(KIND=8) :: dl_xmin, dl_xmax, dl_ymin, dl_ymax
+ REAL(KIND=8) :: dl_dis
+ REAL(KIND=8) :: dl_glam0, dl_emax
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_glam, dl_gphi, dl_e1, dl_e2
+
+ REAL(KIND=4) :: zglamfound, zglamin, zglamax
+
+ CHARACTER(LEN=256) :: cl_type='F'
+
+ LOGICAL :: ll_again, ll_bnd
+ !!--------------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ dl_xmin = pxmin
+ dl_xmax = pxmax
+ dl_ymin = pymin
+ dl_ymax = pymax
+
+ IF ( PRESENT( cd_coord) ) cn_fcoo=cd_coord
+ IF ( PRESENT( cd_point) ) cl_type=cd_point
+
+ IF (chkfile (cn_fcoo) ) STOP ! missing file
+
+ ipiglo= getdim (cn_fcoo,cn_x)
+ ipjglo= getdim (cn_fcoo,cn_y)
+
+ ALLOCATE (dl_glam(ipiglo,ipjglo), dl_gphi(ipiglo,ipjglo) )
+ ALLOCATE (dl_e1 (ipiglo,ipjglo), dl_e2 (ipiglo,ipjglo) )
+
+ SELECT CASE ( cl_type )
+ CASE ('T' , 't' )
+ dl_glam(:,:) = getvar(cn_fcoo, cn_glamt, 1, ipiglo, ipjglo)
+ dl_gphi(:,:) = getvar(cn_fcoo, cn_gphit, 1, ipiglo, ipjglo)
+ dl_e1 (:,:) = getvar(cn_fcoo, cn_ve1t, 1, ipiglo, ipjglo)
+ dl_e2 (:,:) = getvar(cn_fcoo, cn_ve2t, 1, ipiglo, ipjglo)
+ CASE ('U','u' )
+ dl_glam(:,:) = getvar(cn_fcoo, cn_glamu, 1, ipiglo, ipjglo)
+ dl_gphi(:,:) = getvar(cn_fcoo, cn_gphiu, 1, ipiglo, ipjglo)
+ dl_e1 (:,:) = getvar(cn_fcoo, cn_ve1u, 1, ipiglo, ipjglo)
+ dl_e2 (:,:) = getvar(cn_fcoo, cn_ve2u, 1, ipiglo, ipjglo)
+ CASE ('V','v' )
+ dl_glam(:,:) = getvar(cn_fcoo, cn_glamv, 1, ipiglo, ipjglo)
+ dl_gphi(:,:) = getvar(cn_fcoo, cn_gphiv, 1, ipiglo, ipjglo)
+ dl_e1 (:,:) = getvar(cn_fcoo, cn_ve1v, 1, ipiglo, ipjglo)
+ dl_e2 (:,:) = getvar(cn_fcoo, cn_ve2v, 1, ipiglo, ipjglo)
+ CASE ('F','f' )
+ dl_glam(:,:) = getvar(cn_fcoo, cn_glamf, 1, ipiglo, ipjglo)
+ dl_gphi(:,:) = getvar(cn_fcoo, cn_gphif, 1, ipiglo, ipjglo)
+ dl_e1 (:,:) = getvar(cn_fcoo, cn_ve1f, 1, ipiglo, ipjglo)
+ dl_e2 (:,:) = getvar(cn_fcoo, cn_ve2f, 1, ipiglo, ipjglo)
+ CASE DEFAULT
+ PRINT *,' ERROR : type of point not known: ', TRIM(cl_type)
+ END SELECT
+
+ ! work with longitude between 0 and 360 to avoid the date line.
+ WHERE( dl_glam < 0 ) dl_glam = dl_glam + 360.d0
+
+ ! For Orca grid, the longitude of ji=1 is about 70 E
+ dl_glam0 = dl_glam(1, ipjglo/2)
+ WHERE( dl_glam < dl_glam0 ) dl_glam =dl_glam + 360.d0
+
+ IF (dl_xmin < 0.) dl_xmin = dl_xmin + 360.d0
+ IF (dl_xmax < 0.) dl_xmax = dl_xmax + 360.d0
+
+ IF (dl_xmin < dl_glam0) dl_xmin = dl_xmin + 360.d0
+ IF (dl_xmax < dl_glam0) dl_xmax = dl_xmax + 360.d0
+
+
+ ! deal with xmin, ymin
+ ll_again = .TRUE.
+ initer = 1
+
+ DO WHILE (ll_again)
+ CALL NearestPoint(dl_xmin, dl_ymin, ipiglo, ipjglo, dl_glam, dl_gphi, iloc, jloc, ll_bnd)
+
+ ! distance between the target point and the nearest point
+ dl_dis = dist(dl_xmin, dl_glam(iloc,jloc), dl_ymin, dl_gphi(iloc,jloc) ) ! in km
+
+ ! typical grid size (diagonal) in the vicinity of nearest point
+ dl_emax= MAX(dl_e1(iloc,jloc), dl_e2(iloc,jloc))/1000.*SQRT(2.) ! in km
+
+ IF (dl_dis > dl_emax ) THEN
+ zglamfound = dl_glam(iloc,jloc) ; IF (zglamfound > 180.) zglamfound=zglamfound - 360.
+
+ PRINT 9000, 'Long= ',zglamfound,' Lat = ',dl_gphi(iloc,jloc) , iloc, jloc
+ PRINT *,' Algorithm does''nt converge ', dl_dis
+
+ IF ( initer >= jp_itermax ) THEN
+ PRINT *, ' no convergence after ', jp_itermax,' iterations'
+ iloc = -1000
+ jloc = -1000
+ ll_again = .FALSE.
+ ELSE
+ ll_again = .TRUE.
+ initer = initer +1
+ jloc = (initer -1)* ipjglo/initer
+ iloc = (initer -1)* ipiglo/jp_itermax
+ ENDIF
+ ELSE
+ PRINT '("# dl_dis= ",f8.3," km")', dl_dis
+ ll_again = .FALSE.
+ END IF
+ END DO
+
+ IF (ll_bnd) THEN
+ WRITE (*,*)'Point Out of domain or on boundary'
+ ELSE
+ imin=iloc
+ jmin=jloc
+ ENDIF
+
+ ! deal with xmax, ymax
+ IF ( pxmin == pxmax .AND. pymin == pymax ) THEN
+ ! job already done with first point
+ imax=imin
+ jmax=jmin
+ ELSE
+ ll_again = .TRUE.
+ initer = 1
+ iloc=ipiglo/2 ; jloc=ipjglo/2
+
+ DO WHILE (ll_again)
+ CALL NearestPoint(dl_xmax, dl_ymax, ipiglo, ipjglo, dl_glam, dl_gphi, iloc, jloc, ll_bnd)
+
+ ! distance between the target point and the nearest point
+ dl_dis = dist(dl_xmax, dl_glam(iloc,jloc), dl_ymax, dl_gphi(iloc,jloc) ) ! in km
+
+ ! typical grid size (diagonal) in the vicinity of nearest point
+ dl_emax = MAX(dl_e1(iloc,jloc),dl_e2(iloc,jloc))/1000.*SQRT(2.) ! in km
+
+ IF (dl_dis > dl_emax ) THEN
+ zglamfound=dl_glam(iloc,jloc) ; IF (zglamfound > 180.) zglamfound=zglamfound -360.
+
+ PRINT 9000, 'Long= ',zglamfound,' Lat = ',dl_gphi(iloc,jloc), iloc, jloc
+ PRINT *,' Algorithm does''nt converge ', dl_dis
+
+ IF ( initer >= jp_itermax ) THEN
+ PRINT *, ' no convergence after ', jp_itermax,' iterations'
+ iloc = -1000
+ jloc = -1000
+ ll_again = .FALSE.
+ ELSE
+ ll_again = .TRUE.
+ initer = initer +1
+ jloc = (initer -1)* ipjglo/initer
+ iloc = (initer -1)* ipiglo/jp_itermax
+ ENDIF
+ ELSE
+ PRINT '("# dl_dis= ",f8.3," km")', dl_dis
+ ll_again = .FALSE.
+ END IF
+ END DO
+ IF (ll_bnd) THEN
+ WRITE (*,*) 'Point Out of domain or on boundary'
+ ELSE
+ imax=iloc
+ jmax=jloc
+ ENDIF
+ ENDIF
+
+ PRINT 9001, imin, imax, jmin, jmax
+
+ kimin = imin ; kimax = imax ; kjmin = jmin ; kjmax = jmax
+ zglamin = dl_glam(imin,jmin) ; zglamax = dl_glam(imax,jmax)
+
+ IF ( zglamin > 180 ) zglamin=zglamin-360.
+ IF ( zglamax > 180 ) zglamax=zglamax-360.
+
+ PRINT 9002, zglamin, zglamax, dl_gphi(imin,jmin),dl_gphi(imax,jmax)
+
9000 FORMAT(a,f8.2,a,f8.2,2i5)
9001 FORMAT(4i10)
9002 FORMAT(4f10.4)
- END SUBROUTINE cdf_findij
- SUBROUTINE Nearestpoint(pplon,pplat,kpi,kpj,plam,pphi,kpiloc,kpjloc,ldbord)
- !!----------------------------------------------------------------------------
- !! *** SUBROUTINE NEARESTPOINT ***
- !!
- !! ** Purpose: Computes the positions of the nearest i,j in the grid
- !! from the given longitudes and latitudes
+ END SUBROUTINE cdf_findij
+
+
+ SUBROUTINE NearestPoint(ddlon, ddlat, kpi, kpj, ddlam, ddphi, kpiloc, kpjloc, ld_bnd)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE NearestPoint ***
!!
- !! ** Method : Starts on the middle of the grid, search in a 20x20 box, and move
- !! the box in the direction where the distance between the box and the
- !! point is minimum
- !! Iterates ...
- !! Stops when the point is outside the grid.
- !! This algorithm does not work on the Mediteranean grid !
+ !! ** Purpose : Computes the positions of the nearest i,j in the grid
+ !! from the given longitudes and latitudes
!!
- !! * history:
- !! Anne de Miranda et Pierre-Antoine Darbon Jul. 2000 (CLIPPER)
- !! Jean-Marc Molines : In NEMO form
- !!----------------------------------------------------------------------------
- IMPLICIT NONE
- !* arguments
- REAL(KIND=8),INTENT(in) :: pplon,pplat !: lon and lat of target point
- INTEGER,INTENT (in) :: kpi,kpj !: grid size
- INTEGER,INTENT (inout) :: kpiloc,kpjloc !: nearest point location
- REAL(KIND=8),DIMENSION(kpi,kpj),INTENT(in) :: pphi,plam !: model grid layout
- LOGICAL :: ldbord !: reach boundary flag
-
- ! * local variables
- INTEGER :: ji,jj,i0,j0,i1,j1
- INTEGER :: itbl
- REAL(KIND=4) :: zdist,zdistmin,zdistmin0
- LOGICAL, SAVE :: lbordcell, lfirst=.TRUE.
+ !! ** Method : Starts on the middle of the grid, search in a 20x20 box,
+ !! and move the box in the direction where the distance
+ !! between the box and the point is minimum.
+ !! Iterates ...
+ !! Stops when the point is outside the grid.
!!
- ! Initial values
- IF ( lfirst ) THEN
- kpiloc = kpi/2 ; kpjloc = kpj/2 ! seek from the middle of domain
- lfirst=.FALSE.
+ !! References : P.A. Darbon and A. de Miranda acknowledged for this
+ !! clever algorithm developped in CLIPPER.
+ !!----------------------------------------------------------------------
+ REAL(KIND=8), INTENT(in) :: ddlon, ddlat !: lon and lat of target point
+ INTEGER(KIND=4), INTENT (in) :: kpi, kpj !: grid size
+ REAL(KIND=8), DIMENSION(kpi,kpj), INTENT(in) :: ddlam, ddphi !: model grid layout
+ INTEGER(KIND=4), INTENT (inout) :: kpiloc, kpjloc !: nearest point location
+ LOGICAL :: ld_bnd !: reach boundary flag
+
+ INTEGER(KIND=4) :: ji, jj
+ INTEGER(KIND=4), PARAMETER :: jp_blk=10
+ INTEGER(KIND=4) :: ii0, ij0
+ INTEGER(KIND=4) :: ii1, ij1
+ REAL(KIND=4) :: zdist
+ REAL(KIND=4) :: zdistmin, zdistmin0
+ LOGICAL, SAVE :: ll_bndcell, ll_first=.TRUE.
+ !!----------------------------------------------------------------------
+ IF ( ll_first ) THEN
+ kpiloc = kpi/2 ; kpjloc = kpj/2 ! seek from the middle of domain
+ ll_first=.FALSE.
ENDIF
- itbl = 10 ! block size for search
+
zdistmin=1000000. ; zdistmin0=1000000.
- i0=kpiloc ; j0=kpjloc
- lbordcell=.TRUE.; ldbord=.FALSE.
+ ii0 = kpiloc ; ij0 = kpjloc
+ ll_bndcell=.TRUE. ; ld_bnd=.FALSE.
! loop until found or boundary reach
- DO WHILE ( lbordcell .AND. .NOT. ldbord)
- i0=kpiloc-itbl ; i1=kpiloc+itbl
- j0=kpjloc-itbl ; j1=kpjloc+itbl
+ DO WHILE ( ll_bndcell .AND. .NOT. ld_bnd )
+ ii0 = kpiloc - jp_blk ; ii1 = kpiloc + jp_blk
+ ij0 = kpjloc - jp_blk ; ij1 = kpjloc + jp_blk
! search only the inner domain
- IF (i0 <= 0) i0=2
- IF (i1 > kpi) i1=kpi-1
- IF (j0 <= 0) j0=2
- IF( j1 > kpj) j1=kpj-1
-
- ! within a block itbl+1 x itbl+1:
- DO jj=j0,j1
- DO ji=i0,i1
+ IF (ii0 <= 0 ) ii0 = 2
+ IF (ii1 > kpi) ii1 = kpi - 1
+ IF (ij0 <= 0 ) ij0 = 2
+ IF( ij1 > kpj) ij1 = kpj - 1
+
+ ! within a block jp_blk+1 x jp_blk+1:
+ DO jj=ij0,ij1
+ DO ji=ii0,ii1
! compute true distance (orthodromy) between target point and grid point
- zdist=dist(pplon,plam(ji,jj),pplat,pphi(ji,jj) )
- zdistmin=MIN(zdistmin,zdist)
+ zdist = dist(ddlon, ddlam(ji,jj), ddlat, ddphi(ji,jj) )
+ zdistmin = MIN(zdistmin, zdist)
! update kpiloc, kpjloc if distance decreases
- IF (zdistmin .NE. zdistmin0 ) THEN
+ IF (zdistmin /= zdistmin0 ) THEN
kpiloc=ji
kpjloc=jj
ENDIF
zdistmin0=zdistmin
END DO
END DO
- lbordcell=.FALSE.
+
+ ll_bndcell=.FALSE.
! if kpiloc, kpjloc belong to block boundary proceed to next block, centered on kpiloc, kpjloc
- IF (kpiloc == i0 .OR. kpiloc == i1) lbordcell=.TRUE.
- IF (kpjloc == j0 .OR. kpjloc == j1) lbordcell=.TRUE.
+ IF (kpiloc == ii0 .OR. kpiloc == ii1) ll_bndcell=.TRUE.
+ IF (kpjloc == ij0 .OR. kpjloc == ij1) ll_bndcell=.TRUE.
+
! boundary reach ---> not found
- IF (kpiloc == 2 .OR. kpiloc ==kpi-1) ldbord=.TRUE.
- IF (kpjloc == 2 .OR. kpjloc ==kpj-1) ldbord=.TRUE.
+ IF (kpiloc == 2 .OR. kpiloc ==kpi-1) ld_bnd=.TRUE.
+ IF (kpjloc == 2 .OR. kpjloc ==kpj-1) ld_bnd=.TRUE.
END DO
+
END SUBROUTINE NEARESTPOINT
- FUNCTION dist(plona,plonb,plata,platb)
- !!----------------------------------------------------------
- !! *** FUNCTION DIST ***
+
+
+ REAL(KIND=8) FUNCTION dist(ddlona, ddlonb, ddlata, ddlatb)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION dist ***
!!
- !! ** Purpose : Compute the distance (km) between
- !! point A (lona, lata) and B(lonb,latb)
+ !! ** Purpose : Compute the distance (km) between
+ !! point A (lona, lata) and B (lonb, latb)
!!
- !! ** Method : Compute the distance along the orthodromy
+ !! ** Method : Use of double precision is important. Compute the
+ !! distance along the orthodromy
!!
- !! * history : J.M. Molines in CHART, f90, may 2007
- !!----------------------------------------------------------
- IMPLICIT NONE
- ! Argument
- REAL(KIND=8), INTENT(in) :: plata, plona, platb, plonb
- REAL(KIND=8) :: dist
- ! Local variables
- REAL(KIND=8),SAVE :: zlatar, zlatbr, zlonar, zlonbr
- REAL(KIND=8) :: zpds
- REAL(KIND=8),SAVE :: zux, zuy, zuz
- REAL(KIND=8) :: zvx, zvy, zvz
-
- REAL(KIND=8), SAVE :: prevlat=-1000., prevlon=-1000, zr, zpi, zconv
- LOGICAL :: lfirst=.TRUE.
+ !!----------------------------------------------------------------------
+ REAL(KIND=8), INTENT(in) :: ddlata, ddlona, ddlatb, ddlonb
+
+ REAL(KIND=8), SAVE :: dl_latar, dl_latbr, dl_lonar, dl_lonbr
+ REAL(KIND=8) :: dl_pds
+ REAL(KIND=8), SAVE :: dl_ux, dl_uy, dl_uz
+ REAL(KIND=8) :: dl_vx, dl_vy, dl_vz
+ REAL(KIND=8), SAVE :: dl_prevlat=-1000.d0
+ REAL(KIND=8), SAVE :: dl_prevlon=-1000.d0
+ REAL(KIND=8), SAVE :: dl_r, dl_pi, dl_conv
+ LOGICAL :: ll_first=.TRUE.
+ !!----------------------------------------------------------------------
! initialise some values at first call
- IF ( lfirst ) THEN
- lfirst=.FALSE.
+ IF ( ll_first ) THEN
+ ll_first = .FALSE.
! constants
- zpi=ACOS(-1.)
- zconv=zpi/180. ! for degree to radian conversion
+ dl_pi = ACOS(-1.d0)
+ dl_conv = dl_pi/180.d0 ! for degree to radian conversion
! Earth radius
- zr=(6378.137+6356.7523)/2.0 ! km
+ dl_r = (6378.137d0+6356.7523d0)/2.0d0 ! km
ENDIF
! compute these term only if they differ from previous call
- IF ( plata /= prevlat .OR. plona /= prevlon) THEN
- zlatar=plata*zconv
- zlonar=plona*zconv
- zux=COS(zlonar)*COS(zlatar)
- zuy=SIN(zlonar)*COS(zlatar)
- zuz=SIN(zlatar)
- prevlat=plata
- prevlon=plona
+ IF ( ddlata /= dl_prevlat .OR. ddlona /= dl_prevlon) THEN
+ dl_latar = ddlata*dl_conv
+ dl_lonar = ddlona*dl_conv
+ dl_ux = COS(dl_lonar)*COS(dl_latar)
+ dl_uy = SIN(dl_lonar)*COS(dl_latar)
+ dl_uz = SIN(dl_latar)
+ dl_prevlat = ddlata
+ dl_prevlon = ddlona
ENDIF
- zlatbr=platb*zconv
- zlonbr=plonb*zconv
- zvx=COS(zlonbr)*COS(zlatbr)
- zvy=SIN(zlonbr)*COS(zlatbr)
- zvz=SIN(zlatbr)
+ dl_latbr = ddlatb*dl_conv
+ dl_lonbr = ddlonb*dl_conv
+ dl_vx = COS(dl_lonbr)*COS(dl_latbr)
+ dl_vy = SIN(dl_lonbr)*COS(dl_latbr)
+ dl_vz = SIN(dl_latbr)
- zpds=zux*zvx+zuy*zvy+zuz*zvz
+ dl_pds = dl_ux*dl_vx + dl_uy*dl_vy + dl_uz*dl_vz
- IF (zpds >= 1.) THEN
- dist=0.
+ IF (dl_pds >= 1.) THEN
+ dist = 0.
ELSE
- dist=zr*ACOS(zpds)
+ dist = dl_r*ACOS(dl_pds)
ENDIF
+
END FUNCTION dist
END MODULE cdftools
diff --git a/cdftransig_xy3d.f90 b/cdftransig_xy3d.f90
index cee0770..23e3e0a 100644
--- a/cdftransig_xy3d.f90
+++ b/cdftransig_xy3d.f90
@@ -1,289 +1,410 @@
PROGRAM cdftransig_xy3d
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdftransig_xy3d ***
+ !!======================================================================
+ !! *** PROGRAM cdftransig_xy3d ***
+ !!=====================================================================
+ !! ** Purpose : Calculates u and v transports at each grid cell
+ !! in rho coordinates. produces a 3D field.
!!
- !! ** Purpose : calculates u and v transports
- !! in rho coordinates. produces a 3D field.
- !! allow two 3D arrays for more efficient reading
+ !! ** Method : allow two 3D arrays for more efficient reading
!!
- !! history ;
- !! Original : A.M. Treguier (feb 2006)
- !! Allow increased resolution in density in deeper layers (feb 2011)
- !!-------------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 02/2006 : A.M. Treguier : Original code
+ !! 2.1 : 02/2011 : A.M. Treguier : Allow increased resolution in density
+ !! in deeper layers
+ !! 3.0 : 06/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ USE modutils ! for SetFileName, SetGlobalAtt
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
-! FOR sigma 0 as the density coordinate
-! REAL(KIND=4), PARAMETER :: pref = 0 !: reference for density
-! INTEGER, PARAMETER :: jpbin = 101 !: density bins
-! REAL(KIND=4), PARAMETER :: s1min = 23.,s1scal=0.05 !: reference for density
-! CHARACTER (LEN=7) :: clsigma = 'sigma_0'
-! FOR sigma 1 as the density coordinate
- REAL(KIND=4), PARAMETER :: pref = 1000 !: reference for density
- INTEGER, PARAMETER :: jpbin = 93 !: density bins
- REAL(KIND=4), PARAMETER :: s1min = 24.2,s1scal=0.1 !: min sigma and delta_sigma
- REAL(KIND=4), PARAMETER :: s1zoom = 32.3,s1scalmin=0.05 !: min sigma for increased resolution
- CHARACTER (LEN=7) :: clsigma = 'sigma_1'
-! FOR sigma 1 as the density coordinate for ACC region
-! REAL(KIND=4), PARAMETER :: pref = 1000 !: reference for density
-! INTEGER, PARAMETER :: jpbin = 88 !: density bins
-! REAL(KIND=4), PARAMETER :: s1min = 24.5,s1scal=0.1 !: reference for density
-! CHARACTER (LEN=7) :: clsigma = 'sigma_1'
-! FOR sigma 2 as the density coordinate
-! REAL(KIND=4), PARAMETER :: pref = 2000 !: reference for density
-! INTEGER, PARAMETER :: jpbin = 174 !: density bins
-! REAL(KIND=4), PARAMETER :: s1min = 29,s1scal=0.05 !: reference for density
-! CHARACTER (LEN=7) :: clsigma = 'sigma_2'
-
- INTEGER :: jj, jk ,ji, jt , jib !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout, ntags
- INTEGER, DIMENSION(2) :: id_varout , ipk !
- INTEGER, DIMENSION (:) , ALLOCATABLE :: itab !: look up table for density intervals
- INTEGER :: jpsigmax , jitrans !: dimension for itab, intermediate index
- REAL(KIND=4), DIMENSION (:,:) , ALLOCATABLE :: e1v, gphiv !: 2D x,y metrics, velocity
- REAL(KIND=4), DIMENSION (:,:) , ALLOCATABLE :: e2u !: metrics, velocity
-!!!
- REAL(KIND=4), DIMENSION (:,:) , ALLOCATABLE :: zt,zs, zv, e3v !: x,1,z arrays metrics, velocity
- REAL(KIND=4), DIMENSION (:,:) , ALLOCATABLE :: zu, e3u !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:) , ALLOCATABLE :: zmasku,zmaskv !: masks x,1,jpbin
- INTEGER, DIMENSION (:,:) , ALLOCATABLE :: ibinu, ibinv !: integer value corresponding to density for binning
- REAL(KIND=4), DIMENSION (:) , ALLOCATABLE :: gdept !: array for depth of T points
- REAL(KIND=4), DIMENSION (jpbin) :: sigma !: density coordinate, center of bins
- REAL(KIND=4), DIMENSION (jpbin+1) :: sig_edge !: density coordinate, edge of bins.
- REAL(KIND=4),DIMENSION(1) :: timean, tim
- REAL(KIND=4) ,DIMENSION(:,:) , ALLOCATABLE :: zdensu, zdensv !: density on u and v points
-!!! 3D arrays below are x,y,z
- REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: dusigsig,dvsigsig !: cumulated transports,
- REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: dens2d
- REAL(KIND=8) :: total_time
- REAL(KIND=4) :: sigtest
-!!! below 2D arrays npiglo,1
- CHARACTER(LEN=80) :: cfilev , cfilet, cfileu, config , ctag
- CHARACTER(LEN=80) :: cfileout='uvxysig.nc'
- CHARACTER(LEN=80) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc'
- CHARACTER(LEN=1) :: clanswer
- TYPE (variable), DIMENSION(2) :: typvar !: structure for attributes
-
- INTEGER :: istatus
- LOGICAL :: lprint = .false.
-
- ! constants
-! lprint = .true.
- !! Read command line and output usage message if not compliant.
+
+ INTEGER(KIND=4) :: ji, jj, jk ! dummy loop index
+ INTEGER(KIND=4) :: jt, jtag ! dummy loop index
+ INTEGER(KIND=4) :: ijb
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq, istag
+ INTEGER(KIND=4) :: iset
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nbins ! density bins
+ INTEGER(KIND=4) :: ncout
+ INTEGER(KIND=4) :: ntags, nframes
+ INTEGER(KIND=4) :: nsigmax , ijtrans ! dimension for itab, intermediate index
+ INTEGER(KIND=4), DIMENSION(2) :: id_varout , ipk !
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: itab ! look up table for density intervals
+ INTEGER(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ibinu, ibinv ! integer value corresponding to density for binning
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmasku,zmaskv ! masks x,1,nbins
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, gphiv ! 2D x,y metrics, velocity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e2u ! metrics, velocity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zt, zs, zv, e3v ! x,1,z arrays metrics, velocity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, e3u ! metrics, velocity
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zdensu, zdensv ! density on u and v points
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept ! array for depth of T points
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metric in case of full step
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim
+ REAL(KIND=4), DIMENSION(1) :: timean
+ REAL(KIND=4) :: pref ! reference for density
+
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dusigsig,dvsigsig ! cumulated transports,
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dens2d
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dsigma ! density coordinate, center of bins
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dsig_edge ! density coordinate, edge of bins.
+ REAL(KIND=8) :: dsigtest
+ REAL(KIND=8) :: ds1min, ds1scal ! min sigma and delta_sigma
+ REAL(KIND=8) :: ds1zoom = 999., ds1scalmin ! min sigma for increased resolution
+ REAL(KIND=8) :: dtotal_time
+
+ CHARACTER(LEN=80 ) :: cf_out='uvxysig.nc'
+ CHARACTER(LEN=80 ) :: cf_tfil
+ CHARACTER(LEN=80 ) :: cf_ufil
+ CHARACTER(LEN=80 ) :: cf_vfil
+ CHARACTER(LEN=80 ) :: cv_outu='vouxysig'
+ CHARACTER(LEN=80 ) :: cv_outv='vovxysig'
+ CHARACTER(LEN=80 ) :: config
+ CHARACTER(LEN=80 ) :: ctag
+ CHARACTER(LEN=80 ) :: cldum
+ CHARACTER(LEN=80 ) :: cldepcode='1000'
+ CHARACTER(LEN=256) :: cglobal
+ CHARACTER(LEN=7 ) :: clsigma
+
+ TYPE (variable), DIMENSION(2) :: stypvar ! structure for attributes
+
+ LOGICAL :: lprint = .FALSE.
+ LOGICAL :: lfull = .FALSE.
+ LOGICAL :: lnotset = .FALSE.
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ LOGICAL :: lperio = .FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
narg= iargc()
- ntags = narg-1
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdftransig_xyz CONFIG ''list_of_tags'' '
- PRINT *,' Computes the density transport in density space '
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc, U, V, and T '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on uvsigsig'
- PRINT *,' variables vouxysig, vovxysig '
+ PRINT *,' usage : cdftransig_xyz CONFCASE ''list_of_tags'' [-depref depcode ] ...'
+ PRINT *,' ... [-depref depref ] [ -nbins nbins ] ... '
+ PRINT *,' ... [-sigmin smin s-scal] [-sigzoom sminr s-scalr ] ...'
+ PRINT *,' ... [-full ] [-v ]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes the volume transport at each grid cell in density space '
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' CONFCASE : a DRAKKAR CONFIG-CASE name '
+ PRINT *,' list_of_tags : a list of time tags to be processed'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-depcode depcode ] : depcode corresponds to pre-defined parameter '
+ PRINT *,' setting, in term of reference depths, density limits for '
+ PRINT *,' binning, number of bins, deeper layer refinement.'
+ PRINT *,' AVAILABLE depcode are :'
+ PRINT *,' _______________________________________________________________'
+ PRINT *,' depcode | depth_ref nbins smin s-scal szoommin szoom-scal '
+ PRINT *,' ---------------------------------------------------------------'
+ PRINT *,' 0 | 0 101 23.0 0.05 '
+ PRINT *,' 1000 | 1000 93 24.2 0.10 32.3 0.05 '
+ PRINT *,' 1000-acc | 1000 88 24.5 0.10 '
+ PRINT *,' 2000 | 2000 174 29.0 0.05 '
+ PRINT *,' none | parameters must be set individually '
+ PRINT *,' ---------------------------------------------------------------'
+ PRINT *,' DEFAULT depcode is : ',TRIM(cldepcode)
+ PRINT *,' For other setting use the options to specify the settings'
+ PRINT *,' individually.'
+ PRINT *,' [-depref depref ] : give the depth reference for potential density'
+ PRINT *,' [-nbins nbins ] : give the number of density bins.'
+ PRINT *,' [-sigmin smin s-scal ] : give the minimum of density for binning and'
+ PRINT *,' the bin width. ( take care of the reference depth).'
+ PRINT *,' [-sigzoom sminr s-scalr ] : allow density refinement from sminr, with'
+ PRINT *,' s-scalr bin width.'
+ PRINT *,' [-full ] : indicate a full step configuration.'
+ PRINT *,' [-v ] : verbose mode : extra print are performed during execution.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ',TRIM(cv_outu),' and ', TRIM(cv_outv),' in m3/s.'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfrhoproj, cdfsigtrp'
+ PRINT *,' '
STOP
ENDIF
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, config)
- CALL getarg (2, ctag)
- WRITE(cfilev,'(a,"_",a,"_gridV.nc")') TRIM(config),TRIM(ctag)
-
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
-
-! define densities at middle of bins and edge
- jitrans = 0
- DO ji=1,jpbin
- sigtest = s1min +(ji-0.5)*s1scal
- if ( sigtest > s1zoom ) THEN
- if ( jitrans == 0 ) jitrans = ji
- sigma(ji) = s1zoom + (ji-jitrans+0.5)*s1scalmin
- else
- sigma(ji) = sigtest
- endif
+
+ ! browse command line according to options
+ ijarg = 1 ; ireq = 0 ; ntags = 0 ; iset = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
+ CASE ( '-depcode' ) ; CALL getarg(ijarg, cldepcode ) ; ijarg=ijarg+1
+ CASE ( '-depref' ) ; CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) pref ; iset = iset+1
+ WRITE(clsigma,'("sigma_",I1)'), NINT(pref/1000.)
+ CASE ( '-nbins' ) ; CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) nbins ; iset = iset+1
+ CASE ( '-sigmin' ) ; CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) ds1min
+ CASE ( '-sigzoom' ) ; CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) ds1zoom ; iset = iset+1
+ CALL getarg(ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,*) ds1scalmin
+ CASE ( '-full' ) ; lfull = .TRUE.
+ CASE ( '-v' ) ; lprint = .TRUE.
+ CASE DEFAULT ! mandatory arguments
+ ireq=ireq+1
+ SELECT CASE (ireq)
+ CASE ( 1 ) ; config=cldum
+ CASE DEFAULT
+ IF ( ntags == 0 ) istag = ijarg - 1 ! remember the argument number corresponding to 1rst tag
+ ntags=ntags + 1
+ END SELECT
+ END SELECT
ENDDO
- IF (lprint) print *, ' min density:',sigma(1), ' max density:', sigma(jpbin)
- IF (lprint) print *, ' verify sigma:', sigma
- sig_edge(1) = s1min
- DO ji=2,jpbin
- sig_edge(ji) = 0.5* (sigma(ji)+sigma(ji-1))
- end do
- sig_edge(jpbin+1) = sig_edge(jpbin)+s1scalmin
- IF (lprint) print *, ' sig_edge : ', sig_edge
- !
- ! define a lookup table array so that the density can be binned according to
- ! the smallest interval s1scalmin
- jpsigmax = (sig_edge(jpbin+1)-sig_edge(1))/s1scalmin +1
- allocate ( itab(jpsigmax))
- itab(:) = 0
- DO ji=1,jpsigmax
- sigtest = s1min+ (ji-0.5)*s1scalmin
- DO jj=1,jpbin
- if ( sigtest > sig_edge(jj) .AND. sigtest <= sig_edge(jj+1) ) THEN
- itab(ji) = jj
- endif
- end do
- enddo
- IF (lprint) print *, ' jpsigmax=' , jpsigmax
- IF (lprint) print *, ' verify itab:', itab
-
-
- ! define new variables for output ( must update att.txt)
- ! define output variables
- typvar(1)%name= 'vouxysig'
- typvar(2)%name= 'vovxysig'
- typvar(1)%units='m/s'
- typvar(2)%units='m/s'
- typvar%missing_value=0.
- typvar%valid_min= -10.
- typvar%valid_max= 10.
+ ! set parameters for pre-defined depcode
+ SELECT CASE ( cldepcode )
+ CASE ( '0' )
+ pref = 0. ; nbins = 101 ; ds1min = 23.0 ; ds1scal = 0.03 ; ds1zoom = 999. ; ds1scalmin = 999. ; clsigma='sigma_0'
+ CASE ( '1000' )
+ pref = 1000. ; nbins = 93 ; ds1min = 24.2d0 ; ds1scal = 0.10d0 ; ds1zoom = 32.3d0 ; ds1scalmin = 0.05d0 ; clsigma='sigma_1'
+ CASE ( '1000-acc', '1000-ACC' )
+ pref = 1000. ; nbins = 88 ; ds1min = 24.5 ; ds1scal = 0.10 ; ds1zoom = 999. ; ds1scalmin = 999. ; clsigma='sigma_1'
+ CASE ( '2000' )
+ pref = 2000. ; nbins = 174 ; ds1min = 29.0 ; ds1scal = 0.05 ; ds1zoom = 999. ; ds1scalmin = 999. ; clsigma='sigma_2'
+ CASE ( 'none' )
+ ! in this case check that all parameters are set individually
+ IF ( iset /= 3 ) THEN
+ PRINT *, ' You must set depref, nbins, sigmin individually' ; STOP
+ ENDIF
+ CASE DEFAULT
+ PRINT *, ' this depcode :',TRIM(cldepcode),' is not available.' ; STOP
+ END SELECT
+
+ ds1scalmin = MIN ( ds1scalmin, ds1scal )
+ IF ( lprint ) THEN
+ PRINT *,' DEP REF : ', pref, ' m'
+ PRINT *,' NBINS : ', nbins
+ PRINT *,' SIGMIN : ', ds1min
+ PRINT *,' SIGSTP : ', ds1scal
+ PRINT *,' SIGIN R : ', ds1zoom
+ PRINT *,' SIGSTP R : ', ds1scalmin
+ ENDIF
+ ! use first tag to look for file dimension
+ CALL getarg (istag, ctag)
+ cf_vfil = SetFileName (config, ctag, 'V' )
+ IF ( chkfile(cf_vfil) ) STOP ! missing file
- typvar(1)%long_name='Zonal_Velocity_sig_coord'
- typvar(2)%long_name='Meridional_Velocity_sig_coord'
+ npiglo = getdim (cf_vfil, cn_x)
+ npjglo = getdim (cf_vfil, cn_y)
+ npk = getdim (cf_vfil, cn_z)
- typvar(1)%short_name='vouxysig'
- typvar(2)%short_name='vovxysig'
+ ALLOCATE ( dsigma(nbins), dsig_edge(nbins+1) )
+ ! define densities at middle of bins and edges of bins
+ ijtrans = 0
+ DO ji=1,nbins
+ dsigtest = ds1min +(ji-0.5)*ds1scal
+ IF ( dsigtest > ds1zoom ) THEN
+ IF ( ijtrans == 0 ) ijtrans = ji
+ dsigma(ji) = ds1zoom + (ji-ijtrans+0.5)*ds1scalmin
+ ELSE
+ dsigma(ji) = dsigtest
+ ENDIF
+ ENDDO
- typvar%online_operation='N/A'
- typvar%axis='TZYX'
+ IF (lprint) PRINT *, ' min density:',dsigma(1), ' max density:', dsigma(nbins)
+ IF (lprint) PRINT *, ' verify sigma:', dsigma
-! output file has jpbin sigma values
- ipk(:) = jpbin
+ dsig_edge(1) = ds1min
+ DO ji=2,nbins
+ dsig_edge(ji) = 0.5* (dsigma(ji)+dsigma(ji-1))
+ END DO
+ dsig_edge(nbins+1) = dsig_edge(nbins) + ds1scalmin
+ IF (lprint) PRINT *, ' sig_edge : ', dsig_edge
+ !
+ ! define a lookup table array so that the density can be binned according to
+ ! the smallest interval ds1scalmin
+ nsigmax = NINT( (dsig_edge(nbins+1)-dsig_edge(1))/ds1scalmin ) !+1
+ ALLOCATE ( itab(nsigmax))
+ itab(:) = 0
+ DO ji=1,nsigmax
+ dsigtest = ds1min+ (ji-0.5) * ds1scalmin
+ DO jj=1,nbins
+ IF ( dsigtest > dsig_edge(jj) .AND. dsigtest <= dsig_edge(jj+1) ) THEN
+ itab(ji) = jj
+ ENDIF
+ END DO
+ ENDDO
+ IF (lprint) PRINT *, ' nsigmax=' , nsigmax
+ IF (lprint) PRINT *, ' verify itab:', itab
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk, ' jpbin:', jpbin
+ ! define new variables for output ( must update att.txt)
+ ! define output variables
+ CALL SetGlobalAtt(cglobal)
+
+ ipk(:) = nbins ! output file has nbins sigma values
+ stypvar%cunits = 'm3/s' ! transports
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = -10. ! seem to be small
+ stypvar%valid_max = 10.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TSYX'
+
+ stypvar(1)%cname = cv_outu ; stypvar(2)%cname = cv_outv
+ stypvar(1)%clong_name = 'Zonal_trsp_sig_coord' ; stypvar(2)%clong_name = 'Meridional_trsp_sig_coord'
+ stypvar(1)%cshort_name = cv_outu ; stypvar(2)%cshort_name = cv_outv
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'nbins = ', nbins
! Allocate arrays
- ALLOCATE ( zv (npiglo,npjglo), zu (npiglo,npjglo) )
- ALLOCATE ( zt (npiglo,npjglo), zs (npiglo,npjglo) )
- ALLOCATE ( e3v(npiglo,npjglo), e3u(npiglo,npjglo) )
+ ALLOCATE ( zv (npiglo,npjglo), zu (npiglo,npjglo) )
+ ALLOCATE ( zt (npiglo,npjglo), zs (npiglo,npjglo) )
+ ALLOCATE ( e3v(npiglo,npjglo), e3u(npiglo,npjglo) )
ALLOCATE ( ibinu(npiglo, npjglo), ibinv(npiglo, npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo), gphiv(npiglo,npjglo) ,gdept(npk) )
+ ALLOCATE ( e1v(npiglo,npjglo), gphiv(npiglo,npjglo), gdept(npk) )
ALLOCATE ( e2u(npiglo,npjglo) )
- ALLOCATE ( dusigsig(npiglo,npjglo,jpbin), dvsigsig(npiglo,npjglo,jpbin))
- ALLOCATE ( dens2d(npiglo,npjglo) )
- ALLOCATE ( zdensu(npiglo,npjglo) ,zdensv(npiglo,npjglo) )
+ ALLOCATE ( zdensu(npiglo,npjglo), zdensv(npiglo,npjglo) )
ALLOCATE ( zmasku(npiglo,npjglo), zmaskv(npiglo,npjglo))
+ ALLOCATE ( dusigsig(npiglo,npjglo,nbins), dvsigsig(npiglo,npjglo,nbins)) ! huge as nbins can be > 100
+ ALLOCATE ( dens2d(npiglo,npjglo) )
+
+ e1v(:,:) = getvar (cn_fhgr, cn_ve1v, 1, npiglo, npjglo)
+ e2u(:,:) = getvar (cn_fhgr, cn_ve2u, 1, npiglo, npjglo)
+ gphiv(:,:) = getvar (cn_fhgr, cn_gphiv, 1, npiglo, npjglo)
+ gdept(:) = getvare3(cn_fzgr, cn_gdept, npk )
+ ! look for E-W periodicity (using zu for temporary array
+ zu(:,:) = getvar (cn_fhgr, cn_glamv, 1, npiglo, npjglo)
+ IF ( zu(1,1) == zu(npiglo-1,1) ) lperio = .TRUE.
- e1v(:,:) = getvar (coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar (coordhgr, 'e2u', 1,npiglo,npjglo)
- gphiv(:,:) = getvar (coordhgr, 'gphiv', 1,npiglo,npjglo)
- IF (lprint) PRINT *, ' read in hgr file OK'
- gdept(:) = getvare3(coordzgr, 'gdept_0',npk)
-
+ IF ( lfull ) THEN
+ ALLOCATE ( e31d(npk) )
+ e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk )
+ ENDIF
! create output fileset
- IF (lprint) PRINT *, ' ready to create file:',trim( cfileout), ' from reference:',trim(cfilev )
- ncout =create(cfileout, cfilev, npiglo,npjglo,jpbin,cdep=clsigma)
- IF (lprint) print *, ' ncout=',ncout, ' ready to create variables:'
- ierr= createvar(ncout ,typvar,2, ipk ,id_varout )
- IF (lprint) print *, ' ierr=',ierr, ' writing variables headers:'
- ierr= putheadervar(ncout, cfilev, npiglo, npjglo,jpbin,pdep=sigma)
-
- total_time=0
-
-! initialize transport to 0
- dusigsig (:,:,:) = 0.; dvsigsig (:,:,:) =0;
-! loop on time and depth ---------------------------------------------------
-!
-
-DO jk= 1, npk-1
- PRINT *, ' working on depth jk=',jk
- e3v(:,:) = getvar(coordzgr, 'e3v', jk, npiglo,npjglo )
- e3u(:,:) = getvar(coordzgr, 'e3u', jk, npiglo,npjglo )
-
-
- DO jt = 2, narg
-
- CALL getarg (jt, ctag)
- IF (lprint ) PRINT *, ' working on ctag=',trim(ctag)
-
- WRITE(cfilet,'(a,"_",a,"_gridT.nc")') TRIM(config),TRIM(ctag)
- WRITE(cfileu,'(a,"_",a,"_gridU.nc")') TRIM(config),TRIM(ctag)
- WRITE(cfilev,'(a,"_",a,"_gridV.nc")') TRIM(config),TRIM(ctag)
-
- IF (jk== 1 ) THEN
- tim=getvar1d(cfilet,'time_counter',1)
- total_time = total_time + tim(1)
- ENDIF
+ IF (lprint) PRINT *, ' ready to create file:',TRIM( cf_out), ' from reference:',TRIM(cf_vfil )
+ ncout = create (cf_out, cf_vfil, npiglo, npjglo, nbins, cdep=clsigma )
+ ierr = createvar (ncout, stypvar, 2, ipk, id_varout, cdglobal=TRIM(cglobal) )
+ ierr = putheadervar(ncout, cf_vfil, npiglo, npjglo, nbins, pdep=REAL(dsigma) )
- ! Get velocities u, v and mask if first time slot only
- zv(:,:)= getvar ( cfilev, 'vomecrty', jk ,npiglo,npjglo )
- zu(:,:)= getvar ( cfileu, 'vozocrtx', jk ,npiglo,npjglo )
- IF (jt == 2) THEN
- zmasku(:,:)= 1; zmaskv(:,:)= 1;
- WHERE( zu == 0) zmasku(:,:)= 0.0;
- WHERE( zv == 0) zmaskv(:,:)= 0.0;
- IF (lprint ) PRINT *, ' min,max u:',minval(zu),maxval(zu)
- ENDIF
-! density
- zt(:,:)= getvar ( cfilet, 'votemper', jk ,npiglo,npjglo )
- zs(:,:)= getvar ( cfilet, 'vosaline', jk ,npiglo,npjglo )
-
- IF ( pref == 0. ) THEN
- dens2d = sigma0(zt,zs,npiglo,npjglo)
+ dtotal_time = 0.d0
+
+ ! initialize transport to 0
+ dusigsig (:,:,:) = 0.d0 ; dvsigsig (:,:,:) = 0.d0;
+ ! loop on time and depth ---------------------------------------------------
+ !
+ DO jk= 1, npk-1
+ IF ( lprint ) PRINT *, ' working on depth jk=',jk
+ IF ( lfull ) THEN
+ e3v(:,:) = e31d(jk)
+ e3u(:,:) = e31d(jk)
ELSE
- dens2d = sigmai(zt,zs,pref,npiglo,npjglo)
+ e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo,npjglo )
+ e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo,npjglo )
ENDIF
-! density on u points masked by u , single precision
- zdensu(1:npiglo-1,:) = 0.5*( dens2d(1:npiglo-1,:) + dens2d(2:npiglo,:))
- zdensu(npiglo,:) = zdensu(2,:)
- zdensu(:,:) = zdensu(:,:) * zmasku(:,:)
-! density on v points masked by v , single precision
- zdensv(:,1:npjglo-1) = 0.5*( dens2d(:,1:npjglo-1) + dens2d(:,2:npjglo) )
- zdensv(:,:) = zdensv(:,:) * zmaskv(:,:)
-
-! bins density - bins based on dens2d
- DO jj=1,npjglo
- DO ji=1,npiglo
- jib = ifix( (zdensu(ji,jj) - s1min)/s1scalmin )+1
- jib = max( jib ,1 )
- jib = min( jib,jpsigmax)
- ibinu(ji,jj) = itab (jib)
- jib = ifix( (zdensv(ji,jj) - s1min)/s1scalmin )+1
- jib = max( jib ,1 )
- jib = min( jib,jpsigmax)
- ibinv(ji,jj) = itab(jib)
- enddo
- enddo
- zu(:,:) = zu(:,:)*e3u(:,:)
- zv(:,:) = zv(:,:)*e3v(:,:)
- DO jj=1,npjglo
- DO ji=1,npiglo
- dusigsig(ji,jj,ibinu(ji,jj)) = dusigsig(ji,jj,ibinu(ji,jj))+ e2u(ji,jj)*zu(ji,jj)
- dvsigsig(ji,jj,ibinv(ji,jj)) = dvsigsig(ji,jj,ibinv(ji,jj))+ e1v(ji,jj)*zv(ji,jj)
- END DO
- END DO
-
-! -----------------------------------------end of loop on ctags
- END DO
-!
-! ----------------- end of loop on jk
+
+ ijarg = istag ; nframes = 0
+ DO jtag = 1, ntags
+
+ CALL getarg (ijarg, ctag) ; ijarg = ijarg + 1
+ IF (lprint ) PRINT *, ' working on ctag=',TRIM(ctag)
+ cf_tfil = SetFileName(config, ctag, 'T')
+ cf_ufil = SetFileName(config, ctag, 'U')
+ cf_vfil = SetFileName(config, ctag, 'V')
+
+ ! check existence of files
+ lchk = chkfile ( cf_tfil)
+ lchk = lchk .OR. chkfile ( cf_ufil)
+ lchk = lchk .OR. chkfile ( cf_vfil)
+ IF ( lchk ) STOP ! missing file
+
+ IF (jk== 1 ) THEN
+ npt = getdim (cf_tfil, cn_t) ! assuming all files (U V ) contains same number of time frame
+ ALLOCATE ( tim(npt) )
+ tim = getvar1d(cf_tfil, cn_vtimec, npt )
+ dtotal_time = dtotal_time + SUM( DBLE(tim) )
+ DEALLOCATE ( tim )
+ ENDIF
+
+ DO jt = 1, npt
+ nframes = nframes + 1
+ ! Get velocities u, v and mask if first time slot only
+ zv(:,:)= getvar ( cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt )
+ zu(:,:)= getvar ( cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jt)
+ IF (jtag == 1) THEN
+ zmasku(:,:)= 1; zmaskv(:,:)= 1.0 ;
+ WHERE( zu == 0) zmasku(:,:)= 0.0 ;
+ WHERE( zv == 0) zmaskv(:,:)= 0.0;
+ IF (lprint ) PRINT *, ' min,max u:',MINVAL(zu),MAXVAL(zu)
+ ENDIF
+ ! density
+ zt(:,:)= getvar ( cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jt )
+ zs(:,:)= getvar ( cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jt )
+
+ IF ( pref == 0. ) THEN
+ dens2d = sigma0(zt, zs, npiglo, npjglo)
+ ELSE
+ dens2d = sigmai(zt, zs, pref, npiglo, npjglo)
+ ENDIF
+
+ ! density on u points masked by u , single precision
+ zdensu(1:npiglo-1,:) = 0.5*( dens2d(1:npiglo-1,:) + dens2d(2:npiglo,:))
+
+ ! check for periodic EW condition
+ IF ( lperio ) THEN ; zdensu(npiglo,:) = zdensu(2,:)
+ ELSE ; zdensu(npiglo,:) = 0.
+ ENDIF
+
+ zdensu(:,:) = zdensu(:,:) * zmasku(:,:)
+
+ ! density on v points masked by v , single precision
+ zdensv(:,1:npjglo-1) = 0.5*( dens2d(:,1:npjglo-1) + dens2d(:,2:npjglo) )
+ zdensv(:,:) = zdensv(:,:) * zmaskv(:,:)
+
+ ! bins density - bins based on dens2d
+ DO jj=1,npjglo
+ DO ji=1,npiglo
+ ijb = INT( (zdensu(ji,jj) - ds1min)/ds1scalmin )+1
+ ijb = MAX( ijb ,1 )
+ ijb = MIN( ijb,nsigmax)
+ ibinu(ji,jj) = itab (ijb)
+ ijb = INT( (zdensv(ji,jj) - ds1min)/ds1scalmin )+1
+ ijb = MAX( ijb ,1 )
+ ijb = MIN( ijb,nsigmax)
+ ibinv(ji,jj) = itab(ijb)
+ ENDDO
+ ENDDO
+ zu(:,:) = zu(:,:)*e3u(:,:)
+ zv(:,:) = zv(:,:)*e3v(:,:)
+ DO jj=1,npjglo
+ DO ji=1,npiglo
+ dusigsig(ji,jj,ibinu(ji,jj)) = dusigsig(ji,jj,ibinu(ji,jj))+ e2u(ji,jj)*zu(ji,jj)*1.d0
+ dvsigsig(ji,jj,ibinv(ji,jj)) = dvsigsig(ji,jj,ibinv(ji,jj))+ e1v(ji,jj)*zv(ji,jj)*1.d0
+ END DO
+ END DO
+ END DO ! end of loop on file time frame
+ ! -----------------------------------------end of loop on ctags
+ END DO
+ !
+ ! ----------------- end of loop on jk
END DO
-
- timean(1)= total_time/ntags
- ierr=putvar1d(ncout,timean,1,'T')
- DO jk=1, jpbin
- zt = dusigsig(:,:,jk) / ntags
- ierr = putvar (ncout, id_varout(1), zt, jk, npiglo, npjglo)
- ENDDO
- DO jk=1, jpbin
- zt = dvsigsig(:,:,jk) / ntags
- ierr = putvar (ncout, id_varout(2), zt, jk, npiglo, npjglo)
- ENDDO
-
+ timean(1) = dtotal_time/nframes
+ ierr = putvar1d(ncout, timean, 1, 'T')
+ DO jk=1, nbins
+ zt = dusigsig(:,:,jk) / nframes
+ ierr = putvar (ncout, id_varout(1), zt, jk, npiglo, npjglo, kwght=nframes)
+ ENDDO
+ DO jk=1, nbins
+ zt = dvsigsig(:,:,jk) / nframes
+ ierr = putvar (ncout, id_varout(2), zt, jk, npiglo, npjglo, kwght=nframes)
+ ENDDO
ierr = closeout(ncout)
-
+
END PROGRAM cdftransig_xy3d
diff --git a/cdftransport.f90 b/cdftransport.f90
new file mode 100644
index 0000000..8a129f0
--- /dev/null
+++ b/cdftransport.f90
@@ -0,0 +1,1120 @@
+PROGRAM cdftransport
+ !!======================================================================
+ !! *** PROGRAM cdftransport ***
+ !!=====================================================================
+ !! ** Purpose : Compute Transports across a section.
+ !! By default, mass (Sv) and heat(PW)/salt(kT/s) transports
+ !! are computed unless -noheat option is used (mass
+ !! transport only).
+ !!
+ !! ** Method : The begining and end point of the section are given in
+ !! term of F-points index. A broken line joining successive
+ !! F-points is defined between the begining and end point
+ !! of the section. Therefore each segment between F-points
+ !! is either a zonal or meridional segment corresponding to
+ !! V or U velocity component. Doing so, the volume conservation
+ !! is ensured as velocities are not interpolated, and stay
+ !! on the native model grid.
+ !! The section name and the begin/end point of a section are
+ !! read from standard input, till 'EOF' is given as section
+ !! name. This make possible to give a bunch of sections in
+ !! an ASCII files and use the < redirection.
+ !! SIGN CONVENTION : The transport is positive when the flow cross
+ !! the section to the right, negative otherwise. This depends
+ !! on the sense the section is described. With this convention
+ !! The algebric sum of transports accross sections forming a
+ !! closed area is 0.
+ !! OPTIONS :
+ !! -full : full step case
+ !! -noheat : only mass transport is computed.
+ !! -time : specify the time frame to be used
+ !! -zlimit : transports can be computed in different depth layers
+ !! defined by their depth limit
+ !! REQUIREMENT :
+ !! mesh-mask file are required in the current directory.
+ !!
+ !!
+ !! History : 2.1 : 01/2005 : J.M. Molines : Original code
+ !! 2.1 : 07/2009 : R. Dussin : add cdf output
+ !! 2.1 : 01/2010 : M.A. Balmaseda : Change integration signs
+ !! so that the transport across a segment is
+ !! independent of the chosen trajectory.
+ !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! interm_pt : choose intermediate points on a broken line.
+ !!----------------------------------------------------------------------
+ USE cdfio
+ USE modcdfnames
+ USE modutils ! for global attribute
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
+ IMPLICIT NONE
+
+ INTEGER(KIND=4) :: jclass, jseg ! dummy loop index
+ INTEGER(KIND=4) :: ji, jj, jk ! dummy loop index
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: imeter ! limit beetween depth level, in m (nclass -1)
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ilev0, ilev1 ! limit in levels (nclass)
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! Netcdf output
+ INTEGER(KIND=4) :: ncout, ierr ! for netcdf output
+ INTEGER(KIND=4) :: nvarout=12 ! number of values to write in cdf output
+ INTEGER(KIND=4) :: ivtrp ! var index of volume transport (barotrope)
+ INTEGER(KIND=4) :: iptrp ! var index of volume transport (barotrope)
+ INTEGER(KIND=4) :: imtrp ! var index of volume transport (barotrope)
+ INTEGER(KIND=4) :: ihtrp ! var index of heat transport (barotrope)
+ INTEGER(KIND=4) :: istrp ! var index of sal transport (barotrope)
+ INTEGER(KIND=4) :: ivtrpcl ! var index of volume transport (p. class)
+ INTEGER(KIND=4) :: iptrpcl ! var index of volume transport (p. class)
+ INTEGER(KIND=4) :: imtrpcl ! var index of volume transport (p. class)
+ INTEGER(KIND=4) :: ihtrpcl ! var index of heat transport (p. class)
+ INTEGER(KIND=4) :: istrpcl ! var index of sal transport (p. class)
+ INTEGER(KIND=4) :: ilonmin ! var index of starting section longitude
+ INTEGER(KIND=4) :: ilonmax ! var index of ending section longitude
+ INTEGER(KIND=4) :: ilatmin ! var index of starting section latitude
+ INTEGER(KIND=4) :: ilatmax ! var index of ending section latitude
+ INTEGER(KIND=4) :: itop ! var index of top depth class
+ INTEGER(KIND=4) :: ibot ! var index of bottom depth class
+ INTEGER(KIND=4) :: ikx=1, iky=1 ! dims of netcdf output file
+ INTEGER(KIND=4) :: numout = 10 ! logical unit for output file (overall)
+ INTEGER(KIND=4) :: numvtrp = 11 ! logical unit for volume transport file
+ INTEGER(KIND=4) :: numhtrp = 12 ! logical unit for heat transport file
+ INTEGER(KIND=4) :: numstrp = 14 ! logical unit for salt trp file
+ INTEGER(KIND=4) :: nclass ! number of depth class
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, nxtarg ! " "
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: iimin, iimax ! i-limit of the section
+ INTEGER(KIND=4) :: ijmin, ijmax ! j-limit of the section
+ INTEGER(KIND=4) :: ivar, itime ! working integer
+ INTEGER(KIND=4) :: ii, ij, ik ! working integer
+ INTEGER(KIND=4), PARAMETER :: jpseg=10000 ! used for broken line algorithm
+ INTEGER(KIND=4) :: ii0, ij0 ! " " "
+ INTEGER(KIND=4) :: ii1, ij1 ! " " "
+ INTEGER(KIND=4) :: iitmp, ijtmp ! " " "
+ INTEGER(KIND=4) :: np, nn ! segment counters,
+ INTEGER(KIND=4) :: iist, ijst ! local point offset for velocity
+ INTEGER(KIND=4) :: norm_u, norm_v ! normalization factor (sign of normal transport)
+ INTEGER(KIND=4) :: idirx, idiry ! sense of description of the section
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e2u ! horizontal metric
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3u, e3v ! vertical metric
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamf ! longitudes of F points
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: gphif ! latitudes of F points
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, zut, zus ! Zonal velocities and uT uS
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zv, zvt, zvs ! Meridional velocities and uT uS
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: rdum ! dummy (1x1) array for ncdf output
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zuobc, zvobc ! arrays for OBC files (vertical slice)
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth at layer interface
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metric in case of full step
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: rclass ! vertical metric in case of full step
+ REAL(KIND=4), DIMENSION(2) :: gla, gphi ! lon/lat of the begining/end of section (f point)
+ REAL(KIND=4), DIMENSION(jpseg) :: rxx, ryy ! working variables
+ REAL(KIND=4) :: rxi0, ryj0 ! working variables
+ REAL(KIND=4) :: rxi1, ryj1 ! working variables
+ REAL(KIND=4) :: ai, bi ! equation of line (y=ai.x +bi)
+ REAL(KIND=4) :: aj, bj ! equation of line (x=aj.y +bj
+ REAL(KIND=4) :: rd, rd1, rd2 ! distance between point, between vertical layers
+ REAL(KIND=4) :: udum, vdum ! dummy velocity components for tests
+ REAL(KIND=4) :: rau0=1000 ! density of pure water (kg/m3)
+ REAL(KIND=4) :: rcp=4000. ! heat capacity (J/kg/K)
+
+ ! at every model point
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwku, dwkv ! volume transport at each cell boundary
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwkut, dwkvt ! heat transport at each cell boundary
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwkus, dwkvs ! salt transport at each cell boundary
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwkup, dwkvp ! volume transport in the positive direction
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dwkum, dwkvm ! volume transport in the negatibe direction
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dtrpu, dtrpv ! volume transport integrated in depth class
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dtrput, dtrpvt ! heat transport integrated in depth class
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dtrpus, dtrpvs ! salt transport integrated in depth class
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dtrpup, dtrpvp ! volume transport integrated in depth class (positive)
+ REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: dtrpum, dtrpvm ! volume transport integrated in depth class (negative)
+ ! for a given section
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvoltrpsum ! volume transport by depth class across section
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvoltrpsump ! volume transport by depth class across section
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvoltrpsumm ! volume transport by depth class across section
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dheatrpsum ! heat transport by depth class across section
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dsaltrpsum ! salt transport by depth class across section
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvolallegcl ! over all leg volume transport by depth class
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvolallegclp ! over all leg volume transport by depth class +
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dvolallegclm ! over all leg volume transport by depth class -
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dheatallegcl ! over all leg heat transport by depth class
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dsaltallegcl ! over all leg salt transport by depth class
+ REAL(KIND=8), DIMENSION(jpseg) :: dvoltrp ! volume transport across each segment of a section
+ REAL(KIND=8), DIMENSION(jpseg) :: dvoltrpp ! volume transport across each segment of a section
+ REAL(KIND=8), DIMENSION(jpseg) :: dvoltrpm ! volume transport across each segment of a section
+ REAL(KIND=8), DIMENSION(jpseg) :: dheatrp ! heat transport across each segment of a section
+ REAL(KIND=8), DIMENSION(jpseg) :: dsaltrp ! salt transport across each segment of a section
+ REAL(KIND=8) :: dvoltrpbrtp ! volume transport integrated over the whole depth
+ REAL(KIND=8) :: dvoltrpbrtpp ! volume transport integrated over the whole depth
+ REAL(KIND=8) :: dvoltrpbrtpm ! volume transport integrated over the whole depth
+ REAL(KIND=8) :: dheatrpbrtp ! heat transport integrated over the whole depth
+ REAL(KIND=8) :: dsaltrpbrtp ! salt transport integrated over the whole depth
+ REAL(KIND=8) :: dvolalleg ! over all leg sum of volume transport
+ REAL(KIND=8) :: dvolallegp ! over all leg sum of volume transport +
+ REAL(KIND=8) :: dvolallegm ! over all leg sum of volume transport -
+ REAL(KIND=8) :: dheatalleg ! over all leg sum of heat transport
+ REAL(KIND=8) :: dsaltalleg ! over all leg sum of salt transport
+
+ COMPLEX, DIMENSION(jpseg) :: yypt ! array of points coordinates in a section
+ COMPLEX :: yypti ! working point
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure of output
+
+ CHARACTER(LEN=256) :: cf_tfil ! VT file (in)
+ CHARACTER(LEN=256) :: cf_ufil ! U file (in)
+ CHARACTER(LEN=256) :: cf_vfil ! V file (in)
+ CHARACTER(LEN=256) :: cf_out='section_trp.dat' ! output file name (ASCII)
+ CHARACTER(LEN=256) :: cf_outnc ! output netcdf file
+ CHARACTER(LEN=256) :: cf_vtrp='vtrp.txt' ! output volume transport file
+ CHARACTER(LEN=256) :: cf_htrp='htrp.txt' ! output heat transport file
+ CHARACTER(LEN=256) :: cf_strp='strp.txt' ! output salt transport file
+ CHARACTER(LEN=256) :: csection ! section names
+ CHARACTER(LEN=512) :: cglobal ! global attribute
+ CHARACTER(LEN=256) :: cldum ! dummy char variable
+
+ LOGICAL :: ltest = .FALSE. ! flag for test case
+ LOGICAL :: lfull = .FALSE. ! flag for full step case
+ LOGICAL :: lheat = .TRUE. ! flag for skipping heat/salt transport computation
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ LOGICAL :: lpm = .FALSE. ! flag for plus/minus transport
+ LOGICAL :: lobc = .FALSE. ! flag for obc input files
+ LOGICAL :: l_merid = .FALSE. ! flag for meridional obc
+ LOGICAL :: l_zonal = .FALSE. ! flag for zonal obc
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg= iargc()
+ ! Print usage if no argument
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdftransport [-test u v ] [-noheat ] [-plus_minus ] [-obc]...'
+ PRINT *,' ... [VT-file] U-file V-file [-full] |-time jt] ...'
+ PRINT *,' ... [-time jt ] [-zlimit limits of level]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the transports accross a section.'
+ PRINT *,' The name of the section and the imin, imax, jmin, jmax for the section '
+ PRINT *,' is read from the standard input. To finish the program use the key name'
+ PRINT *,' ''EOF'' for the section name.'
+ PRINT *,' OBC U,V files can be used if -obc option is specified.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' [VT-file ] : netcdf file with mean values of vt, vs, ut, us for heat and'
+ PRINT *,' salt transport. If options -noheat or -plus_minus are used'
+ PRINT *,' this file name must be omitted.'
+ PRINT *,' [U-file ] : netcdf file with the zonal velocity component.'
+ PRINT *,' [V-file ] : netcdf file with the meridional velocity component.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-test u v ]: use constant the u and v velocity components for sign '
+ PRINT *,' test purpose.'
+ PRINT *,' [-noheat ] : use when heat and salt transport are not requested.'
+ PRINT *,' This option must come before the file names, and if used'
+ PRINT *,' VT file must not be given.'
+ PRINT *,' [ -plus_minus or -pm ] : separate positive and negative contribution to'
+ PRINT *,' the volume transport. This option implicitly set -noheat,'
+ PRINT *,' and must be used before the file names.'
+ PRINT *,' [-obc ] : indicates that input files are obc files (vertical slices)'
+ PRINT *,' Take care that for this case, mesh files must be adapted.'
+ PRINT *,' This option implicitly set -noheat, and must be used before'
+ PRINT *,' the file names.'
+ PRINT *,' [-full ] : use for full step configurations.'
+ PRINT *,' [-time jt ]: compute transports for time index jt. Default is 1.'
+ PRINT *,' [-zlimit list of depth] : Specify depths limits defining layers where the'
+ PRINT *,' transports will be computed. If not used, the transports '
+ PRINT *,' are computed for the whole water column. If used, this '
+ PRINT *,' option must be the last on the command line.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' Files ',TRIM(cn_fhgr),', ',TRIM(cn_fzgr),' must be in the current directory.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' - Standard output '
+ PRINT *,' - ASCII file reflecting the standard output: section_trp.dat'
+ PRINT *,' - ASCII files for volume, heat and salt transport: vtrp.txt, htrp.txt '
+ PRINT *,' and strp.txt.'
+ PRINT *,' - Netcdf files for each section. name of the file is buildt'
+ PRINT *,' from section name.'
+ PRINT *,' '
+ PRINT *,' SEE ALSO :'
+ PRINT *,' cdfsigtrp'
+ PRINT *,' '
+ STOP
+ ENDIF
+
+ itime = 1
+ nclass = 1
+ ijarg = 1
+ CALL SetGlobalAtt(cglobal)
+
+ ! Browse command line for arguments and/or options
+ DO WHILE (ijarg <= narg )
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ('-test ')
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) udum
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) vdum
+ ltest = .TRUE.
+
+ CASE ('-full' )
+ lfull = .TRUE.
+
+ CASE ('-noheat' ) ! it must be called before the list of files
+ lheat = .FALSE.
+
+ CASE ('-time' )
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itime
+
+ CASE ('-plus_minus', '-pm' )
+ lpm = .TRUE.
+ lheat = .FALSE.
+
+ CASE ('-obc' )
+ lobc = .TRUE.
+ lheat = .FALSE.
+
+ CASE ('-zlimit' ) ! this should be the last option on the line
+ nxtarg = ijarg - 1
+ nclass = narg - nxtarg + 1
+ ALLOCATE ( imeter(nclass -1) ) ! if no zlimit option, this array is never used
+ DO jclass =1, nclass -1
+ CALL getarg (ijarg, cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) imeter(jclass)
+ END DO
+
+ CASE DEFAULT
+ ijarg = ijarg -1 ! re-read argument in this case
+ IF ( lheat) THEN
+ CALL getarg (ijarg, cf_tfil) ; ijarg = ijarg + 1
+ ENDIF
+ CALL getarg (ijarg, cf_ufil) ; ijarg = ijarg + 1
+ CALL getarg (ijarg, cf_vfil) ; ijarg = ijarg + 1
+ END SELECT
+ END DO
+
+ ! checking if all required files are available
+ lchk = lchk .OR. chkfile(cn_fzgr)
+ lchk = lchk .OR. chkfile(cn_fhgr)
+ IF ( ltest ) THEN
+ ! OK
+ ELSE
+ lchk = lchk .OR. chkfile(cf_ufil)
+ lchk = lchk .OR. chkfile(cf_vfil)
+ IF (lheat) THEN
+ lchk = lchk .OR. chkfile(cf_tfil)
+ ENDIF
+ ENDIF
+ IF ( lchk ) STOP ! missing files
+
+ ! adjust the number of output variables according to options
+ IF ( nclass > 1 ) THEN
+ IF ( lheat ) THEN
+ nvarout = 12
+ ELSE
+ nvarout = 8
+ ENDIF
+ IF ( lpm ) nvarout=nvarout+4
+ ELSE
+ IF ( lheat ) THEN
+ nvarout = 9
+ ELSE
+ nvarout = 7
+ ENDIF
+ IF ( lpm ) nvarout=nvarout+2
+ ENDIF
+
+ ALLOCATE ( ilev0(nclass), ilev1(nclass), rclass(nclass) )
+ rclass=(/(jclass, jclass=1,nclass)/)
+
+ npiglo = getdim (cf_ufil,cn_x)
+ npjglo = getdim (cf_ufil,cn_y)
+ npk = getdim (cf_ufil,cn_z)
+ npt = getdim (cf_ufil,cn_t)
+
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npk =', npk
+ PRINT *, 'npt =', npt
+
+ IF ( lobc ) THEN ! if lobc false, l_merid and l_zonal are false (default)
+ IF ( npiglo == 1 ) THEN
+ l_merid=.TRUE.
+ ALLOCATE (zuobc(npjglo,npk), zvobc(npjglo,npk) )
+ PRINT *,' Meridional OBC'
+ ENDIF
+
+ IF ( npjglo == 1 ) THEN
+ l_zonal=.TRUE.
+ ALLOCATE (zuobc(npiglo,npk), zvobc(npiglo,npk) )
+ PRINT *,' Zonal OBC'
+ ENDIF
+ ENDIF
+
+ ALLOCATE ( e31d(npk) )
+
+ ! define new variables for output
+ ALLOCATE ( stypvar(nvarout), ipk(nvarout), id_varout(nvarout) )
+ ALLOCATE ( rdum(1,1) )
+
+ rdum(:,:)=0.e0
+
+ stypvar%rmissing_value=99999.
+ stypvar%scale_factor= 1.
+ stypvar%add_offset= 0.
+ stypvar%savelog10= 0.
+ stypvar%conline_operation='N/A'
+ stypvar%caxis='T'
+
+ ivar = 1 ; ivtrp = ivar
+ ipk(ivar) = 1
+ stypvar(ivar)%cname = 'vtrp'
+ stypvar(ivar)%cunits = 'Sverdrup'
+ stypvar(ivar)%valid_min = -500.
+ stypvar(ivar)%valid_max = 500.
+ stypvar(ivar)%clong_name = 'Volume_Transport'
+ stypvar(ivar)%cshort_name = 'vtrp'
+
+ IF ( lpm ) THEN
+ ivar = ivar + 1 ; iptrp = ivar ; imtrp = ivar+1
+ ipk(ivar) = 1 ; ipk(ivar+1) = 1
+ stypvar(ivar)%cname = 'ptrp' ; stypvar(ivar+1)%cname = 'mtrp'
+ stypvar(ivar)%cunits = 'Sverdrup' ; stypvar(ivar+1)%cunits = 'Sverdrup'
+ stypvar(ivar)%valid_min = -500. ; stypvar(ivar+1)%valid_min = -500.
+ stypvar(ivar)%valid_max = 500. ; stypvar(ivar+1)%valid_max = 500.
+ stypvar(ivar)%clong_name = 'Positive_volume_transport' ; stypvar(ivar+1)%clong_name = 'Negative_volume_transport'
+ stypvar(ivar)%cshort_name = 'ptrp' ; stypvar(ivar+1)%cshort_name = 'mtrp'
+ ivar = ivar + 1
+ ENDIF
+
+ IF ( lheat ) THEN
+ ivar = ivar + 1 ; ihtrp = ivar ; istrp = ivar+1
+ ipk(ivar) = 1 ; ipk(ivar+1) = 1
+ stypvar(ivar)%cname = 'htrp' ; stypvar(ivar+1)%cname = 'strp'
+ stypvar(ivar)%cunits = 'PW' ; stypvar(ivar+1)%cunits = 'kt/s'
+ stypvar(ivar)%valid_min = -1000. ; stypvar(ivar+1)%valid_min = -1000.
+ stypvar(ivar)%valid_max = 1000. ; stypvar(ivar+1)%valid_max = 1000.
+ stypvar(ivar)%clong_name = 'Heat_Transport' ; stypvar(ivar+1)%clong_name = 'Salt_Transport'
+ stypvar(ivar)%cshort_name = 'htrp' ; stypvar(ivar+1)%cshort_name = 'strp'
+ ivar = ivar + 1
+ ENDIF
+
+ ivar = ivar + 1 ; ilonmin = ivar ; ilonmax = ivar+1
+ ipk(ivar) = 1 ; ipk(ivar+1) = 1
+ stypvar(ivar)%cname = 'lonmin' ; stypvar(ivar+1)%cname = 'lonmax'
+ stypvar(ivar)%cunits = 'deg' ; stypvar(ivar+1)%cunits = 'deg'
+ stypvar(ivar)%valid_min = -180. ; stypvar(ivar+1)%valid_min = -180.
+ stypvar(ivar)%valid_max = 180. ; stypvar(ivar+1)%valid_max = 180.
+ stypvar(ivar)%clong_name = 'begin_longitude' ; stypvar(ivar+1)%clong_name = 'end_longitude'
+ stypvar(ivar)%cshort_name = 'lonmin' ; stypvar(ivar+1)%cshort_name = 'lonmax'
+ ivar = ivar + 1
+
+ ivar = ivar + 1 ; ilatmin = ivar ; ilatmax = ivar+1
+ ipk(ivar) = 1 ; ipk(ivar+1) = 1
+ stypvar(ivar)%cname = 'latmin' ; stypvar(ivar+1)%cname = 'latmax'
+ stypvar(ivar)%cunits = 'deg' ; stypvar(ivar+1)%cunits = 'deg'
+ stypvar(ivar)%valid_min = -90. ; stypvar(ivar+1)%valid_min = -90.
+ stypvar(ivar)%valid_max = 90. ; stypvar(ivar+1)%valid_max = 90.
+ stypvar(ivar)%clong_name = 'begin_latitude' ; stypvar(ivar+1)%clong_name = 'end_latitude'
+ stypvar(ivar)%cshort_name = 'latmin' ; stypvar(ivar+1)%cshort_name = 'latmax'
+ ivar = ivar + 1
+
+ ivar = ivar + 1 ; itop = ivar ; ibot = ivar+1
+ ipk(ivar) = nclass ; ipk(ivar+1) = nclass
+ stypvar(ivar)%cname = 'top' ; stypvar(ivar+1)%cname = 'bottom'
+ stypvar(ivar)%cunits = 'meters' ; stypvar(ivar+1)%cunits = 'meters'
+ stypvar(ivar)%valid_min = 0. ; stypvar(ivar+1)%valid_min = 0.
+ stypvar(ivar)%valid_max = 10000. ; stypvar(ivar+1)%valid_max = 10000.
+ stypvar(ivar)%clong_name = 'class_min_depth' ; stypvar(ivar+1)%clong_name = 'class_max_depth'
+ stypvar(ivar)%cshort_name = 'top' ; stypvar(ivar+1)%cshort_name = 'bottom'
+ ivar = ivar + 1
+
+ ivtrpcl = -1 ; ihtrpcl = -1 ; istrpcl = -1
+ IF ( nclass > 1 ) THEN ! define additional variable for vertical profile of transport (per class)
+ ivar = ivar + 1 ; ivtrpcl = ivar
+ ipk(ivar) = nclass
+ stypvar(ivar)%cname = 'vtrp_dep'
+ stypvar(ivar)%cunits = 'SV'
+ stypvar(ivar)%valid_min = 0.
+ stypvar(ivar)%valid_max = 10000.
+ stypvar(ivar)%clong_name = 'Volume_Transport_per_class'
+ stypvar(ivar)%cshort_name = 'vtrp_dep'
+
+ IF ( lpm ) THEN
+ ivar = ivar + 1 ; iptrpcl = ivar ; imtrpcl = ivar+1
+ ipk(ivar) = nclass ; ipk(ivar+1) = nclass
+ stypvar(ivar)%cname = 'ptrp_dep' ; stypvar(ivar+1)%cname = 'mtrp_dep'
+ stypvar(ivar)%cunits = 'SV' ; stypvar(ivar+1)%cunits = 'SV'
+ stypvar(ivar)%valid_min = -500. ; stypvar(ivar+1)%valid_min = -500.
+ stypvar(ivar)%valid_max = 500. ; stypvar(ivar+1)%valid_max = 500.
+ stypvar(ivar)%clong_name = 'Positive_trp_per_class' ; stypvar(ivar+1)%clong_name = 'Negative_trp_per_class'
+ stypvar(ivar)%cshort_name = 'ptrp_dep' ; stypvar(ivar+1)%cshort_name = 'mtrp_dep'
+ ivar = ivar + 1
+ ENDIF
+
+ IF ( lheat ) THEN
+ ivar = ivar + 1 ; ihtrpcl = ivar ; istrpcl = ivar+1
+ ipk(ivar) = nclass ; ipk(ivar+1) = nclass
+ stypvar(ivar)%cname = 'htrp_dep' ; stypvar(ivar+1)%cname = 'strp_dep'
+ stypvar(ivar)%cunits = 'PW' ; stypvar(ivar+1)%cunits = 'kt/s'
+ stypvar(ivar)%valid_min = -1000. ; stypvar(ivar+1)%valid_min = -1000.
+ stypvar(ivar)%valid_max = 1000. ; stypvar(ivar+1)%valid_max = 1000.
+ stypvar(ivar)%clong_name = 'Heat_Transport_per_class' ; stypvar(ivar+1)%clong_name = 'Salt_Transport_per_class'
+ stypvar(ivar)%cshort_name = 'htrp_dep' ; stypvar(ivar+1)%cshort_name = 'strp_dep'
+ ivar = ivar + 1
+ ENDIF
+ ENDIF
+
+ ! Allocate arrays
+ ALLOCATE ( zu(npiglo,npjglo), zv(npiglo,npjglo) )
+ ALLOCATE ( dwku(npiglo,npjglo), dwkv(npiglo,npjglo) )
+ ALLOCATE ( dtrpu(npiglo,npjglo,nclass), dtrpv(npiglo,npjglo,nclass))
+ ALLOCATE ( dvoltrpsum(nclass), dvolallegcl(nclass) )
+
+ IF ( lpm ) THEN
+ ALLOCATE ( dwkup(npiglo,npjglo), dwkvp(npiglo,npjglo) )
+ ALLOCATE ( dwkum(npiglo,npjglo), dwkvm(npiglo,npjglo) )
+ ALLOCATE ( dtrpup(npiglo,npjglo,nclass), dtrpvp(npiglo,npjglo,nclass))
+ ALLOCATE ( dtrpum(npiglo,npjglo,nclass), dtrpvm(npiglo,npjglo,nclass))
+ ALLOCATE ( dvoltrpsump(nclass), dvoltrpsumm(nclass) )
+ ALLOCATE ( dvolallegclp(nclass), dvolallegclm(nclass) )
+ ENDIF
+
+ IF ( lheat ) THEN
+ ALLOCATE ( zut(npiglo,npjglo), zus(npiglo,npjglo) )
+ ALLOCATE ( zvt(npiglo,npjglo), zvs(npiglo,npjglo) )
+ ALLOCATE ( dwkut(npiglo,npjglo), dwkus(npiglo,npjglo) )
+ ALLOCATE ( dwkvt(npiglo,npjglo), dwkvs(npiglo,npjglo) )
+ ALLOCATE ( dtrput(npiglo,npjglo,nclass), dtrpvt(npiglo,npjglo,nclass))
+ ALLOCATE ( dtrpus(npiglo,npjglo,nclass), dtrpvs(npiglo,npjglo,nclass))
+ ALLOCATE ( dheatrpsum(nclass), dsaltrpsum(nclass) )
+ ALLOCATE ( dheatallegcl(nclass), dsaltallegcl(nclass) )
+ ENDIF
+ !
+ ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo) )
+ ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo) )
+ !
+ ALLOCATE ( gphif(npiglo,npjglo) )
+ ALLOCATE ( glamf(npiglo,npjglo) )
+ ALLOCATE ( gdepw(npk) , tim(npt) )
+ !
+ ! read metrics and grid position
+ e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo)
+ e2u(:,:) = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo)
+
+ glamf(:,:) = getvar(cn_fhgr, cn_glamf, 1,npiglo, npjglo)
+ gphif(:,:) = getvar(cn_fhgr, cn_gphif, 1,npiglo, npjglo)
+
+ gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk)
+ e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk) ! used only for full step
+
+ ! look for nearest level to imeter and setup ilev0 and ilev1 (t-index of class limit)
+ ik = 1
+ ilev0(1) = 1 ; ilev1(nclass) = npk-1 ! default value if nclass=1
+
+ IF ( lobc ) THEN
+ ! read u, v on OBC
+ IF ( l_zonal ) THEN ! (jpiglo,jpk)
+ zuobc(:,:)= getvarxz(cf_ufil, cn_vozocrtx, 1, npiglo, npk)
+ zvobc(:,:)= getvarxz(cf_vfil, cn_vomecrty, 1, npiglo, npk)
+ ENDIF
+ IF ( l_merid ) THEN ! (jpjglo,jpk)
+ zuobc(:,:)= getvaryz(cf_ufil, cn_vozocrtx, 1, npjglo, npk)
+ zvobc(:,:)= getvaryz(cf_vfil, cn_vomecrty, 1, npjglo, npk)
+ ENDIF
+ ENDIF
+
+ DO jclass = 1, nclass -1
+ DO WHILE ( gdepw(ik) < imeter(jclass) )
+ ik = ik +1
+ END DO
+
+ rd1 = ABS(gdepw(ik-1) - imeter(jclass) )
+ rd2 = ABS(gdepw(ik ) - imeter(jclass) )
+ IF ( rd2 < rd1 ) THEN
+ ilev1(jclass ) = ik - 1 ! t-levels index
+ ilev0(jclass+1) = ik
+ ELSE
+ ilev1(jclass ) = ik - 2 ! t-levels index
+ ilev0(jclass+1) = ik - 1
+ END IF
+ END DO
+
+ PRINT *, 'Limits : '
+ DO jclass = 1, nclass
+ PRINT *, ilev0(jclass),ilev1(jclass), gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1)
+ END DO
+
+ ! compute the transports at each grid cell
+ dtrpu (:,:,:)= 0.d0 ; dtrpv (:,:,:)= 0.d0 ! initialization to 0
+
+ IF ( lpm ) THEN
+ dtrpup(:,:,:)= 0.d0 ; dtrpvp(:,:,:)= 0.d0
+ dtrpum(:,:,:)= 0.d0 ; dtrpvm(:,:,:)= 0.d0
+ ENDIF
+ IF ( lheat ) THEN
+ dtrput(:,:,:)= 0.d0 ; dtrpvt(:,:,:)= 0.d0
+ dtrpus(:,:,:)= 0.d0 ; dtrpvs(:,:,:)= 0.d0
+ ENDIF
+
+ DO jclass = 1, nclass
+ DO jk = ilev0(jclass),ilev1(jclass)
+ PRINT *,'level ',jk
+ ! Get velocities, temperature and salinity fluxes at jk
+ IF ( ltest ) THEN
+ zu (:,:) = udum ; zv (:,:) = vdum
+ IF (lheat) THEN
+ zut(:,:) = udum ; zvt(:,:) = vdum
+ zus(:,:) = udum ; zvs(:,:) = vdum
+ ENDIF
+ ELSEIF ( lobc ) THEN
+ IF ( l_zonal ) THEN ; zu(:,1)=zuobc(:,jk) ; zv(:,1)=zvobc(:,jk)
+ ELSE IF ( l_merid ) THEN ; zu(1,:)=zuobc(:,jk) ; zv(1,:)=zvobc(:,jk) ; ENDIF
+ ELSE
+ zu (:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=itime)
+ zv (:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=itime)
+ IF (lheat) THEN
+ zut(:,:) = getvar(cf_tfil, cn_vozout, jk, npiglo, npjglo, ktime=itime)
+ zvt(:,:) = getvar(cf_tfil, cn_vomevt, jk, npiglo, npjglo, ktime=itime)
+ zus(:,:) = getvar(cf_tfil, cn_vozous, jk, npiglo, npjglo, ktime=itime)
+ zvs(:,:) = getvar(cf_tfil, cn_vomevs, jk, npiglo, npjglo, ktime=itime)
+ ENDIF
+ ENDIF
+
+ ! get e3u, e3v at level jk
+ IF ( lfull ) THEN
+ e3v(:,:) = e31d(jk)
+ e3u(:,:) = e31d(jk)
+ ELSE
+ e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+
+ dwku (:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)*1.d0
+ dwkv (:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)*1.d0
+
+ IF ( lpm ) THEN
+ dwkup = 0.d0 ; dwkum = 0.d0
+ WHERE ( zu >= 0. )
+ dwkup(:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)*1.d0
+ ELSEWHERE
+ dwkum(:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)*1.d0
+ END WHERE
+
+ dwkvp = 0.d0 ; dwkvm = 0.d0
+ WHERE ( zv >= 0. )
+ dwkvp(:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)*1.d0
+ ELSEWHERE
+ dwkvm(:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)*1.d0
+ END WHERE
+ ENDIF
+
+ IF ( lheat ) THEN
+ dwkut(:,:) = zut(:,:)*e2u(:,:)*e3u(:,:)*1.d0
+ dwkvt(:,:) = zvt(:,:)*e1v(:,:)*e3v(:,:)*1.d0
+ dwkus(:,:) = zus(:,:)*e2u(:,:)*e3u(:,:)*1.d0
+ dwkvs(:,:) = zvs(:,:)*e1v(:,:)*e3v(:,:)*1.d0
+ ENDIF
+
+ ! integrates vertically
+ dtrpu (:,:,jclass) = dtrpu (:,:,jclass) + dwku (:,:)
+ dtrpv (:,:,jclass) = dtrpv (:,:,jclass) + dwkv (:,:)
+
+ IF ( lpm ) THEN
+ dtrpup(:,:,jclass) = dtrpup(:,:,jclass) + dwkup(:,:)
+ dtrpvp(:,:,jclass) = dtrpvp(:,:,jclass) + dwkvp(:,:)
+ dtrpum(:,:,jclass) = dtrpum(:,:,jclass) + dwkum(:,:)
+ dtrpvm(:,:,jclass) = dtrpvm(:,:,jclass) + dwkvm(:,:)
+ ENDIF
+
+ IF ( lheat ) THEN
+ dtrput(:,:,jclass) = dtrput(:,:,jclass) + dwkut(:,:) * rau0*rcp
+ dtrpvt(:,:,jclass) = dtrpvt(:,:,jclass) + dwkvt(:,:) * rau0*rcp
+ dtrpus(:,:,jclass) = dtrpus(:,:,jclass) + dwkus(:,:)
+ dtrpvs(:,:,jclass) = dtrpvs(:,:,jclass) + dwkvs(:,:)
+ ENDIF
+
+ END DO ! loop to next level
+ END DO ! next class
+
+ OPEN(numout,FILE=cf_out)
+ ! also dump the results on txt files without any comments, some users like it !
+ OPEN(numvtrp,FILE=cf_vtrp)
+ IF ( lheat ) THEN
+ OPEN(numhtrp,FILE=cf_htrp) ; OPEN(numstrp,FILE=cf_strp)
+ ENDIF
+
+ !################################################################################
+ ! enter interactive part
+ !################################################################################
+ ! initialize all legs arrays and variable to 0
+ dvolalleg = 0.d0 ; dvolallegcl(:) = 0.d0
+ IF ( lpm ) THEN
+ dvolallegp = 0.d0 ; dvolallegclp(:) = 0.d0
+ dvolallegm = 0.d0 ; dvolallegclm(:) = 0.d0
+ ENDIF
+ IF ( lheat ) THEN
+ dheatalleg = 0.d0 ; dheatallegcl(:) = 0.d0
+ dsaltalleg = 0.d0 ; dsaltallegcl(:) = 0.d0
+ ENDIF
+ DO
+ PRINT *, ' Give name of section (EOF to finish)'
+ READ(*,'(a)') csection
+ IF (TRIM(csection) == 'EOF' ) THEN
+ CLOSE(numout) ; CLOSE(numvtrp)
+ IF ( lheat ) THEN
+ CLOSE(numhtrp) ; CLOSE(numstrp)
+ ENDIF
+ EXIT ! infinite DO loop
+ ENDIF
+
+ ! create output fileset
+ cf_outnc = TRIM(csection)//'_transports.nc'
+ ncout = create (cf_outnc, 'none', ikx, iky, nclass, cdep='depth_class')
+ ierr = createvar (ncout, stypvar, nvarout, ipk, id_varout, cdglobal=TRIM(cglobal) )
+ ierr = putheadervar(ncout, cf_ufil, ikx, iky, nclass, pnavlon=rdum, pnavlat=rdum, pdep=rclass )
+ tim = getvar1d (cf_ufil, cn_vtimec, npt )
+ ierr = putvar1d (ncout, tim, npt, 'T')
+
+ PRINT *, ' Give iimin, iimax, ijmin, ijmax '
+ READ(*,*) iimin, iimax, ijmin, ijmax
+ !! Find the broken line between P1 (iimin,ijmin) and P2 (iimax, ijmax)
+ ! ... Initialization
+ ii0 = iimin ; ij0 = ijmin ; ii1 = iimax ; ij1 = ijmax
+ rxi0 = ii0 ; ryj0 = ij0 ; rxi1 = ii1 ; ryj1 = ij1
+
+ ! compute direction of integrations and signs
+ !The transport across the section is the dot product of
+ !integral(line){(Mx,My)*dS}
+ !Mx=integral(u*dz) My=integral(v*dz)) and dS=(dy,-dx)}
+
+ !By defining the direction of the integration as
+ idirx = SIGN(1,ii1-ii0) !positive to the east or if ii1=ii0
+ idiry = SIGN(1,ij1-ij0) !positive to the north or if ij1=ij0
+
+ !Then dS=(e2u*idiry,-e1v*idirx)
+ !This will produce the following sign convention:
+ ! West-to-est line (dx>0, dy=0)=> -My*dx (-ve for a northward flow)
+ ! South-to-north (dy>0, dx=0)=> Mx*dy (+ve for an eastward flow)
+ norm_u = idiry
+ norm_v = -idirx
+
+ ! .. Compute equation: ryj = aj rxi + bj [valid in the (i,j) plane]
+ IF ( (rxi1 -rxi0) /= 0 ) THEN
+ aj = (ryj1 - ryj0 ) / (rxi1 -rxi0)
+ bj = ryj0 - aj * rxi0
+ ELSE
+ aj = 10000. ! flag value
+ bj = 0.
+ END IF
+
+ ! .. Compute equation: rxi = ai ryj + bi [valid in the (i,j) plane]
+ IF ( (ryj1 -ryj0) /= 0 ) THEN
+ ai = (rxi1 - rxi0 ) / ( ryj1 -ryj0 )
+ bi = rxi0 - ai * ryj0
+ ELSE
+ ai = 10000. ! flag value
+ bi = 0.
+ END IF
+
+ ! .. Compute the integer pathway: a succession of F points
+ np=0
+ ! .. Chose the strait line with the smallest slope
+ IF (ABS(aj) <= 1 ) THEN
+ ! ... Here, the best line is y(x)
+ ! ... If ii1 < ii0 swap points [ always describe section from left to right ]
+ IF (ii1 < ii0 ) THEN
+ iitmp = ii0 ; ijtmp = ij0
+ ii0 = ii1 ; ij0 = ij1
+ ii1 = iitmp ; ij1 = ijtmp
+ END IF
+
+ ! iist,ijst is the grid offset to pass from F point to either U/V point
+ IF ( ij1 >= ij0 ) THEN ! line heading NE
+ iist = 1 ; ijst = 1
+ ELSE ! line heading SE
+ iist = 1 ; ijst = 0
+ END IF
+
+ ! ... compute the nearest ji point on the line crossing at ji
+ DO ji=ii0, ii1
+ np=np+1
+ IF (np > jpseg) STOP 'np > jpseg !'
+ ij=NINT(aj*ji + bj )
+ yypt(np) = CMPLX(ji,ij)
+ END DO
+ ELSE
+ ! ... Here, the best line is x(y)
+ ! ... If ij1 < ij0 swap points [ always describe section from bottom to top ]
+ IF (ij1 < ij0 ) THEN
+ iitmp = ii0 ; ijtmp = ij0
+ ii0 = ii1 ; ij0 = ij1
+ ii1 = iitmp ; ij1 = ijtmp
+ END IF
+
+ ! iist,ijst is the grid offset to pass from F point to either U/V point
+ IF ( ii1 >= ii0 ) THEN
+ iist = 1 ; ijst = 1
+ ELSE
+ iist = 0 ; ijst = 1
+ END IF
+
+ ! ... compute the nearest ji point on the line crossing at jj
+ DO jj=ij0,ij1
+ np=np+1
+ IF (np > jpseg) STOP 'np > jpseg !'
+ ii=NINT(ai*jj + bi)
+ yypt(np) = CMPLX(ii,jj)
+ END DO
+ END IF
+
+ !!
+ !! Look for intermediate points to be added.
+ ! .. The final positions are saved in rxx,ryy
+ rxx(1) = REAL(yypt(1))
+ ryy(1) = IMAG(yypt(1))
+ nn = 1
+
+ DO jk=2,np
+ ! .. distance between 2 neighbour points
+ rd=ABS(yypt(jk)-yypt(jk-1))
+ ! .. intermediate points required if rd > 1
+ IF ( rd > 1 ) THEN
+ CALL interm_pt(yypt, jk, ai, bi, aj, bj, yypti)
+ nn=nn+1
+ IF (nn > jpseg) STOP 'nn>jpseg !'
+ rxx(nn) = REAL(yypti)
+ ryy(nn) = IMAG(yypti)
+ END IF
+ nn=nn+1
+ IF (nn > jpseg) STOP 'nn>jpseg !'
+ rxx(nn) = REAL(yypt(jk))
+ ryy(nn) = IMAG(yypt(jk))
+ END DO
+ ! record longitude and latitude of initial en endind point of the section
+ gla (1) = glamf( INT(rxx(1)), INT(ryy(1)) )
+ gphi(1) = gphif( INT(rxx(1)), INT(ryy(1)) )
+ gla (2) = glamf( INT(rxx(nn)), INT(ryy(nn)) )
+ gphi(2) = gphif( INT(rxx(nn)), INT(ryy(nn)) )
+
+ ! Now extract the transport through a section
+ ! ... Check whether we need a u velocity or a v velocity
+ ! Think that the points are f-points and delimit either a U segment
+ ! or a V segment (iist and ijst are set in order to look for the correct
+ ! velocity point on the C-grid
+ PRINT *, TRIM(csection)
+ PRINT *, 'IMIN IMAX JMIN JMAX', iimin, iimax, ijmin, ijmax
+ WRITE(numout,*) '% Transport along a section by levels' ,TRIM(csection)
+ WRITE(numout,*) '% ---- IMIN IMAX JMIN JMAX'
+
+ dvoltrpbrtp = 0.d0
+ dvoltrpbrtpp = 0.d0
+ dvoltrpbrtpm = 0.d0
+ dheatrpbrtp = 0.d0
+ dsaltrpbrtp = 0.d0
+ DO jclass=1,nclass
+ dvoltrpsum(jclass) = 0.d0
+ IF ( lpm ) THEN
+ dvoltrpsump(jclass) = 0.d0
+ dvoltrpsumm(jclass) = 0.d0
+ ENDIF
+ IF ( lheat ) THEN
+ dheatrpsum(jclass) = 0.d0
+ dsaltrpsum(jclass) = 0.d0
+ ENDIF
+
+ ! segment jseg is a line between (rxx(jseg),ryy(jseg)) and (rxx(jseg+1),ryy(jseg+1))
+ DO jseg = 1, nn-1
+ ii0=rxx(jseg)
+ ij0=ryy(jseg)
+ IF ( rxx(jseg) == rxx(jseg+1) ) THEN ! meridional segment, use U velocity
+ dvoltrp(jseg)= dtrpu (ii0,ij0+ijst,jclass)*norm_u
+
+ IF ( lpm ) THEN
+ dvoltrpp(jseg)= dtrpup(ii0,ij0+ijst,jclass)*norm_u
+ dvoltrpm(jseg)= dtrpum(ii0,ij0+ijst,jclass)*norm_u
+ ENDIF
+
+ IF ( lheat ) THEN
+ dheatrp(jseg)= dtrput(ii0,ij0+ijst,jclass)*norm_u
+ dsaltrp(jseg)= dtrpus(ii0,ij0+ijst,jclass)*norm_u
+ ENDIF
+ ELSE IF ( ryy(jseg) == ryy(jseg+1) ) THEN ! zonal segment, use V velocity
+ dvoltrp(jseg)=dtrpv (ii0+iist,ij0,jclass)*norm_v
+
+ IF ( lpm ) THEN
+ dvoltrpp(jseg)=dtrpvp(ii0+iist,ij0,jclass)*norm_v
+ dvoltrpm(jseg)=dtrpvm(ii0+iist,ij0,jclass)*norm_v
+ ENDIF
+
+ IF ( lheat ) THEN
+ dheatrp(jseg)=dtrpvt(ii0+iist,ij0,jclass)*norm_v
+ dsaltrp(jseg)=dtrpvs(ii0+iist,ij0,jclass)*norm_v
+ ENDIF
+ ELSE
+ PRINT *,' ERROR :', rxx(jseg),ryy(jseg),rxx(jseg+1),ryy(jseg+1) ! likely to never happen !
+ END IF
+ dvoltrpsum(jclass) = dvoltrpsum(jclass) + dvoltrp(jseg)
+ IF ( lpm ) THEN
+ dvoltrpsump(jclass) = dvoltrpsump(jclass) + dvoltrpp(jseg)
+ dvoltrpsumm(jclass) = dvoltrpsumm(jclass) + dvoltrpm(jseg)
+ ENDIF
+ IF ( lheat ) THEN
+ dheatrpsum(jclass) = dheatrpsum(jclass) + dheatrp(jseg)
+ dsaltrpsum(jclass) = dsaltrpsum(jclass) + dsaltrp(jseg)
+ ENDIF
+ END DO ! next segment
+
+ ! Ascii outputs :
+ IF (jclass == 1 ) THEN ! print header when it is the first class
+ PRINT '(a,2f8.2,a,2f8.2)', 'FROM (LON LAT): ', gla(1),gphi(1),' TO (LON LAT) ', gla(2), gphi(2)
+ WRITE(numout,*) '% ---- LONmin LATmin LONmax LATmax'
+ WRITE(numout,*) '% Top(m) Bottom(m) MassTrans(Sv) HeatTrans(PW) SaltTrans(kt/s)'
+ WRITE(numout,*) 0 ,iimin, iimax, ijmin, ijmax
+ WRITE(numout,9003) 0. ,gla(1),gphi(1), gla(2), gphi(2)
+ ENDIF
+
+ PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1)
+ PRINT *, ' Mass transport : ', dvoltrpsum(jclass)/1.e6,' SV'
+ WRITE(numvtrp,'(e12.6)') dvoltrpsum(jclass)
+ IF ( lpm ) THEN
+ PRINT *, ' Positive Mass transport : ', dvoltrpsump(jclass)/1.e6,' SV'
+ PRINT *, ' Negative Mass transport : ', dvoltrpsumm(jclass)/1.e6,' SV'
+ WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), &
+ & dvoltrpsum(jclass)/1.e6, dvoltrpsump(jclass)/1.e6, dvoltrpsumm(jclass)/1.e6
+ WRITE(numvtrp,'(e12.6)') dvoltrpsump(jclass)
+ WRITE(numvtrp,'(e12.6)') dvoltrpsumm(jclass)
+ ENDIF
+
+ IF ( lheat ) THEN
+ PRINT *, ' Heat transport : ', dheatrpsum(jclass)/1.e15,' PW'
+ PRINT *, ' Salt transport : ', dsaltrpsum(jclass)/1.e6,' kT/s'
+ WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), &
+ & dvoltrpsum(jclass)/1.e6, dheatrpsum(jclass)/1.e15, dsaltrpsum(jclass)/1.e6
+ WRITE(numhtrp,'(e12.6)') dheatrpsum(jclass)
+ WRITE(numstrp,'(e12.6)') dsaltrpsum(jclass)
+ ELSE
+ IF ( .NOT. lpm ) WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), dvoltrpsum(jclass)/1.e6
+ ENDIF
+
+ ! netcdf output
+ IF ( nclass > 1 ) THEN
+ rdum(1,1) = REAL(dvoltrpsum(jclass)/1.e6)
+ ierr = putvar(ncout,id_varout(ivtrpcl), rdum, jclass, 1, 1, ktime=itime )
+ IF ( lpm ) THEN
+ rdum(1,1) = REAL(dvoltrpsump(jclass)/1.e6)
+ ierr = putvar(ncout,id_varout(iptrpcl), rdum, jclass, 1, 1, ktime=itime )
+ rdum(1,1) = REAL(dvoltrpsumm(jclass)/1.e6)
+ ierr = putvar(ncout,id_varout(imtrpcl), rdum, jclass, 1, 1, ktime=itime )
+ ENDIF
+ IF ( lheat ) THEN
+ rdum(1,1) = REAL(dheatrpsum(jclass)/1.e15)
+ ierr = putvar(ncout,id_varout(ihtrpcl), rdum, jclass, 1, 1, ktime=itime )
+ rdum(1,1) = REAL(dsaltrpsum(jclass)/1.e6)
+ ierr = putvar(ncout,id_varout(istrpcl), rdum, jclass, 1, 1, ktime=itime )
+ ENDIF
+ ENDIF
+ rdum(1,1) = REAL(gdepw(ilev0(jclass)))
+ ierr = putvar(ncout,id_varout(itop), rdum, jclass, 1, 1, ktime=itime )
+ rdum(1,1) = REAL(gdepw(ilev1(jclass)+1))
+ ierr = putvar(ncout,id_varout(ibot), rdum, jclass, 1, 1, ktime=itime )
+
+ dvoltrpbrtp = dvoltrpbrtp + dvoltrpsum(jclass)
+ IF ( lpm ) THEN
+ dvoltrpbrtpp = dvoltrpbrtpp + dvoltrpsump(jclass)
+ dvoltrpbrtpm = dvoltrpbrtpm + dvoltrpsumm(jclass)
+ ENDIF
+ IF ( lheat) THEN
+ dheatrpbrtp = dheatrpbrtp + dheatrpsum(jclass)
+ dsaltrpbrtp = dsaltrpbrtp + dsaltrpsum(jclass)
+ ENDIF
+ ! save sum over legs
+ dvolallegcl(jclass) = dvolallegcl(jclass) + dvoltrpsum(jclass)
+ IF ( lpm ) THEN
+ dvolallegclp(jclass) = dvolallegclp(jclass) + dvoltrpsump(jclass)
+ dvolallegclm(jclass) = dvolallegclm(jclass) + dvoltrpsumm(jclass)
+ ENDIF
+ IF ( lheat ) THEN
+ dheatallegcl(jclass) = dheatallegcl(jclass) + dheatrpsum(jclass)
+ dsaltallegcl(jclass) = dsaltallegcl(jclass) + dsaltrpsum(jclass)
+ ENDIF
+ END DO ! next class
+ ! save sum over legs
+ dvolalleg = dvolalleg + dvoltrpbrtp
+ IF ( lpm ) THEN
+ dvolallegp = dvolallegp + dvoltrpbrtpp
+ dvolallegm = dvolallegm + dvoltrpbrtpm
+ ENDIF
+ IF ( lheat ) THEN
+ dheatalleg = dheatalleg + dheatrpbrtp
+ dsaltalleg = dsaltalleg + dsaltrpbrtp
+ ENDIF
+
+ IF ( nclass > 1 ) THEN
+ PRINT *, ' ====================================================='
+ PRINT *, ' total Mass transport : ', dvoltrpbrtp/1.e6,' SV'
+ IF ( lpm ) THEN
+ PRINT *, ' total positive transport : ', dvoltrpbrtpp/1.e6,' SV'
+ PRINT *, ' total negative transport : ', dvoltrpbrtpm/1.e6,' SV'
+ ENDIF
+ IF ( lheat ) THEN
+ PRINT *, ' total Heat transport : ', dheatrpbrtp/1.e15,' PW'
+ PRINT *, ' total Salt transport : ', dsaltrpbrtp/1.e6,' kT/s'
+ ENDIF
+ ENDIF
+ ierr = putvar0d(ncout,id_varout(ivtrp), REAL(dvoltrpbrtp/1.e6) )
+ IF ( lpm ) THEN
+ ierr = putvar0d(ncout,id_varout(iptrp), REAL(dvoltrpbrtpp/1.e6) )
+ ierr = putvar0d(ncout,id_varout(imtrp), REAL(dvoltrpbrtpm/1.e6) )
+ ENDIF
+ IF ( lheat ) THEN
+ ierr = putvar0d(ncout,id_varout(ihtrp), REAL(dheatrpbrtp/1.e15) )
+ ierr = putvar0d(ncout,id_varout(istrp), REAL(dsaltrpbrtp/1.e6 ) )
+ ENDIF
+ ierr = putvar0d(ncout,id_varout(ilonmin), REAL(gla(1)) )
+ ierr = putvar0d(ncout,id_varout(ilonmax), REAL(gla(2)) )
+ ierr = putvar0d(ncout,id_varout(ilatmin), REAL(gphi(1)) )
+ ierr = putvar0d(ncout,id_varout(ilatmax), REAL(gphi(2)) )
+ ierr = closeout(ncout)
+ END DO ! infinite loop : gets out when input is EOF
+
+
+ PRINT *,' '
+ PRINT *,' Overall transports (sum of all legs done so far)'
+ DO jclass = 1, nclass
+ PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1)
+ PRINT *, ' Mass transport : ', dvolallegcl(jclass)/1.e6,' SV'
+ IF ( lpm ) THEN
+ PRINT *, ' Positive Mass transport : ', dvolallegclp(jclass)/1.e6,' SV'
+ PRINT *, ' Negative Mass transport : ', dvolallegclm(jclass)/1.e6,' SV'
+ ENDIF
+
+ IF ( lheat ) THEN
+ PRINT *, ' Heat transport : ', dheatallegcl(jclass)/1.e15,' PW'
+ PRINT *, ' Salt transport : ', dsaltallegcl(jclass)/1.e6,' kT/s'
+ ENDIF
+ ENDDO
+
+ IF ( nclass > 1 ) THEN
+ PRINT *, ' ====================================================='
+ PRINT *, ' Mass transport : ', dvolalleg/1.e6,' SV'
+ IF ( lpm ) THEN
+ PRINT *, ' positive transport : ', dvolallegp/1.e6,' SV'
+ PRINT *, ' negative transport : ', dvolallegm/1.e6,' SV'
+ ENDIF
+ IF ( lheat ) THEN
+ PRINT *, ' heat transport : ', dheatalleg/1.e15,' PW'
+ PRINT *, ' salt transport : ', dsaltalleg/1.e6,' kT/s'
+ ENDIF
+ ENDIF
+
+
+9000 FORMAT(I4,6(f9.3,f8.4))
+9001 FORMAT(I4,6(f9.2,f9.3))
+9002 FORMAT(f9.0,f9.0,f9.2,f9.2,f9.2)
+9003 FORMAT(f9.2,f9.2,f9.2,f9.2,f9.2)
+
+CONTAINS
+ SUBROUTINE interm_pt (ydpt, kk, pai, pbi, paj, pbj, ydpti)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE nterm_pt ***
+ !!
+ !! ** Purpose : Find the best intermediate points on a pathway.
+ !!
+ !! ** Method : ydpt : complex vector of the positions of the nearest points
+ !! kk : current working index
+ !! pai, pbi : slope and original ordinate of x(y)
+ !! paj, pbj : slope and original ordinate of y(x)
+ !! ydpti : Complex holding the position of intermediate point
+ !!
+ !! ** Reference : 19/07/1999 : J.M. Molines in Clipper
+ !!----------------------------------------------------------------------
+ COMPLEX, DIMENSION(:), INTENT(in ) :: ydpt
+ COMPLEX, INTENT(out) :: ydpti
+ REAL(KIND=4), INTENT(in ) :: pai, pbi, paj, pbj
+ INTEGER(KIND=4), INTENT(in ) :: kk
+ ! ... local
+ COMPLEX :: ylptmp1, ylptmp2
+ REAL(KIND=4) :: za0, zb0
+ REAL(KIND=4) :: za1, zb1
+ REAL(KIND=4) :: zd1, zd2
+ REAL(KIND=4) :: zxm, zym
+ REAL(KIND=4) :: zxp, zyp
+ !!----------------------------------------------------------------------
+ ! ... Determines whether we use y(x) or x(y):
+ IF (ABS(paj) <= 1) THEN
+ ! ..... use y(x)
+ ! ... possible intermediate points:
+ ylptmp1=ydpt(kk-1)+(1.,0.) ! M1
+ ylptmp2=ydpt(kk-1)+CMPLX(0.,SIGN(1.,paj)) ! M2
+ !
+ ! ... M1 is the candidate point:
+ zxm=REAL(ylptmp1)
+ zym=IMAG(ylptmp1)
+ za0=paj
+ zb0=pbj
+ !
+ za1=-1./za0
+ zb1=zym - za1*zxm
+ ! ... P1 is the projection of M1 on the strait line
+ zxp=-(zb1-zb0)/(za1-za0)
+ zyp=za0*zxp + zb0
+ ! ... zd1 is the distance M1P1
+ zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
+ !
+ ! ... M2 is the candidate point:
+ zxm=REAL(ylptmp2)
+ zym=IMAG(ylptmp2)
+ za1=-1./za0
+ zb1=zym - za1*zxm
+ ! ... P2 is the projection of M2 on the strait line
+ zxp=-(zb1-zb0)/(za1-za0)
+ zyp=za0*zxp + zb0
+ ! ... zd2 is the distance M2P2
+ zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
+ ! ... chose the smallest (zd1,zd2)
+ IF (zd2 <= zd1) THEN
+ ydpti=ylptmp2 ! use M2
+ ELSE
+ ydpti=ylptmp1 ! use M1
+ END IF
+ !
+ ELSE
+ ! ... use x(y)
+ ! ... possible intermediate points:
+ ylptmp1=ydpt(kk-1)+CMPLX(SIGN(1.,pai),0.) ! M1
+ ylptmp2=ydpt(kk-1)+(0.,1.) ! M2
+ !
+ ! ... M1 is the candidate point:
+ zxm=REAL(ylptmp1)
+ zym=IMAG(ylptmp1)
+ za0=pai
+ zb0=pbi
+ !
+ za1=-1./za0
+ zb1=zxm - za1*zym
+ zyp=-(zb1-zb0)/(za1-za0)
+ zxp=za0*zyp + zb0
+ zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
+ !
+ zxm=REAL(ylptmp2)
+ zym=IMAG(ylptmp2)
+ za1=-1./za0
+ zb1=zxm - za1*zym
+ zyp=-(zb1-zb0)/(za1-za0)
+ zxp=za0*zyp + zb0
+ zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
+ IF (zd2 <= zd1) THEN
+ ydpti=ylptmp2
+ ELSE
+ ydpti=ylptmp1
+ END IF
+ END IF
+ END SUBROUTINE interm_pt
+
+END PROGRAM cdftransport
diff --git a/cdftransportiz-full.f90 b/cdftransportiz-full.f90
deleted file mode 100644
index 518820c..0000000
--- a/cdftransportiz-full.f90
+++ /dev/null
@@ -1,506 +0,0 @@
-PROGRAM cdftransportiz_full
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdftransportiz-full ***
- !!
- !! ** Purpose: Compute Transports across a section
- !! FULL STEPS version
- !!
- !! ** Method: Try to avoid 3 d arrays.
- !! The begining and end point of the section are given in term of f-points index.
- !! This program computes the transport across this section for
- !! (1) Mass transport ( Sv)
- !! (2) Heat Transport (PW)
- !! (3) Salt Transport (kT/sec)
- !! The transport is > 0 left handside of the line
- !! This program use a zig-zag line going through U and V-points.
- !! It takes as input : VT files, gridU, gridV files.
- !! The mesh_hgr.nc, mesh_hzr.nc are required.
- !! It is conveniebt to use an ASCII file as the standard input to give
- !! the name and the imin imax jmin jmax for eaxh section required
- !! The last name of this ASCII file must be EOF
- !!
- !!
- !! history :
- !! Original : J.M. Molines (jan. 2005)
- !! J.M. Molines Apr 2005 : use modules
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nclass !: number of depth class
- INTEGER ,DIMENSION (:),ALLOCATABLE :: imeter !: limit beetween depth level, in m (nclass -1)
- INTEGER ,DIMENSION (:),ALLOCATABLE :: ilev0,ilev1 !: limit in levels ! nclass
- INTEGER :: jk, jclass !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: imin, imax, jmin, jmax, ik
- INTEGER :: numout=10 !: logical unit for file output
-
- ! broken line stuff
- INTEGER, PARAMETER :: jpseg=10000
- INTEGER :: i0,j0,i1,j1, i, j
- INTEGER :: n,nn,k, jseg
- INTEGER :: norm_u, norm_v, ist, jst
-
- REAL(KIND=4) :: rxi0,ryj0, rxi1, ryj1
- REAL(KIND=4) :: ai,bi, aj,bj,d
- REAL(KIND=4) :: rxx(jpseg),ryy(jpseg)
- REAL(KIND=4), DIMENSION(jpseg) :: gla, gphi
-
- REAL(KIND=8), DIMENSION(jpseg) :: voltrp, heatrp, saltrp
- REAL(KIND=8) :: voltrpsum, heatrpsum, saltrpsum
- COMPLEX yypt(jpseg), yypti
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, gphiv, zv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, gphiu, zu, zut, zus !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamu, glamv
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw , e3t
- REAL(KIND=4) :: rd1, rd2
- REAL(KIND=4) :: udum, vdum
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku,zwkv, zwkut,zwkvt, zwkus,zwkvs
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: ztrpu, ztrpv, ztrput,ztrpvt, ztrpus,ztrpvs
-
- CHARACTER(LEN=256) :: cfilet , cfileu, cfilev, csection
- CHARACTER(LEN=256) :: cfileout='section_trp.dat'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cdum
-
- INTEGER :: nxtarg
- LOGICAL :: ltest=.FALSE.
-
- ! constants
- REAL(KIND=4) :: rau0=1000., rcp=4000.
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 3 ) THEN
- PRINT *,' Usage : cdftransportiz-full [-test u v ] VTfile gridUfile gridVfile ''limit of level'' '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in te current directory'
- PRINT *,' Option -test vt u v is used for testing purposes, with constant flow field'
- PRINT *,' Output on section_trp.dat and standard output'
- STOP
- ENDIF
-
- CALL getarg (1, cfilet)
- IF ( cfilet == '-test') THEN
- ltest = .TRUE.
- CALL getarg (2, cdum)
- READ(cdum,*) udum
- CALL getarg (3, cdum)
- READ(cdum,*) vdum
- CALL getarg (4, cfilet)
- CALL getarg (5, cfileu)
- CALL getarg (6, cfilev)
- nxtarg=6
- ELSE
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
- nxtarg=3
- ENDIF
- nclass = narg -nxtarg + 1
-
- ALLOCATE ( imeter(nclass -1), ilev0(nclass), ilev1(nclass) )
-
- DO jk=1, nclass -1
- CALL getarg(3+jk,cdum)
- READ(cdum,*) imeter(jk)
- END DO
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE( zu (npiglo,npjglo), zut(npiglo,npjglo), zus(npiglo,npjglo) )
- ALLOCATE( zv (npiglo,npjglo), zvt(npiglo,npjglo), zvs(npiglo,npjglo) )
- !
- ALLOCATE ( zwku (npiglo,npjglo), zwkut(npiglo,npjglo), zwkus(npiglo,npjglo) )
- ALLOCATE ( zwkv (npiglo,npjglo), zwkvt(npiglo,npjglo), zwkvs(npiglo,npjglo) )
- !
- ALLOCATE ( ztrpu (npiglo,npjglo,nclass), ztrpv (npiglo,npjglo,nclass))
- ALLOCATE ( ztrput(npiglo,npjglo,nclass), ztrpvt(npiglo,npjglo,nclass))
- ALLOCATE ( ztrpus(npiglo,npjglo,nclass), ztrpvs(npiglo,npjglo,nclass))
- !
- ALLOCATE ( e1v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo))
- !
- ALLOCATE ( gphiu(npiglo,npjglo), gphiv(npiglo,npjglo) )
- ALLOCATE ( glamu(npiglo,npjglo), glamv(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) ,e3t(npk) )
- !
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
-
- glamv(:,:) = getvar(coordhgr, 'glamv', 1,npiglo,npjglo)
- glamu(:,:) = getvar(coordhgr, 'glamu', 1,npiglo,npjglo)
-
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gphiu(:,:) = getvar(coordhgr, 'gphiu', 1,npiglo,npjglo)
-
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
- e3t(:) = getvare3(coordzgr, 'e3t', npk )
-
- ! look for nearest level to imeter
- ik = 1
-
- ilev0(1) = 1
- ilev1(nclass) = npk-1
-
- DO jk = 1, nclass -1
- DO WHILE ( gdepw(ik) < imeter(jk) )
- ik = ik +1
- END DO
-
- rd1= ABS(gdepw(ik-1) - imeter(jk) )
- rd2= ABS(gdepw(ik) - imeter(jk) )
- IF ( rd2 < rd1 ) THEN
- ilev1(jk) = ik -1 ! t-levels
- ilev0(jk+1) = ik
- ELSE
- ilev1(jk) = ik -2 ! t-levels
- ilev0(jk+1) = ik -1
- END IF
- END DO
- PRINT *, 'Limits : '
- DO jk = 1, nclass
- PRINT *, ilev0(jk),ilev1(jk), gdepw(ilev0(jk)), gdepw(ilev1(jk)+1)
- END DO
-
- !! compute the transport
- ztrpu (:,:,:)= 0
- ztrpv (:,:,:)= 0
-
- ztrput(:,:,:)= 0
- ztrpvt(:,:,:)= 0
-
- ztrpus(:,:,:)= 0
- ztrpvs(:,:,:)= 0
- DO jclass = 1, nclass
- DO jk = ilev0(jclass),ilev1(jclass)
- PRINT *,'level ',jk
- ! Get velocities, temperature and salinity fluxes at jk
- IF ( ltest ) THEN
- zu (:,:)= udum
- zv (:,:)= vdum
- zut(:,:)= udum
- zvt(:,:)= vdum
- zus(:,:)= udum
- zvs(:,:)= vdum
- ELSE
- zu (:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv (:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- zut(:,:)= getvar(cfilet, 'vozout', jk ,npiglo,npjglo)
- zvt(:,:)= getvar(cfilet, 'vomevt', jk ,npiglo,npjglo)
- zus(:,:)= getvar(cfilet, 'vozous', jk ,npiglo,npjglo)
- zvs(:,:)= getvar(cfilet, 'vomevs', jk ,npiglo,npjglo)
- ENDIF
-
-
- zwku (:,:) = zu (:,:)*e2u(:,:)*e3t(jk)
- zwkv (:,:) = zv (:,:)*e1v(:,:)*e3t(jk)
- zwkut(:,:) = zut(:,:)*e2u(:,:)*e3t(jk)
- zwkvt(:,:) = zvt(:,:)*e1v(:,:)*e3t(jk)
- zwkus(:,:) = zus(:,:)*e2u(:,:)*e3t(jk)
- zwkvs(:,:) = zvs(:,:)*e1v(:,:)*e3t(jk)
-
- ! integrates vertically
- ztrpu (:,:,jclass) = ztrpu (:,:,jclass) + zwku (:,:)
- ztrpv (:,:,jclass) = ztrpv (:,:,jclass) + zwkv (:,:)
- ztrput(:,:,jclass) = ztrput(:,:,jclass) + zwkut(:,:) * rau0*rcp
- ztrpvt(:,:,jclass) = ztrpvt(:,:,jclass) + zwkvt(:,:) * rau0*rcp
- ztrpus(:,:,jclass) = ztrpus(:,:,jclass) + zwkus(:,:)
- ztrpvs(:,:,jclass) = ztrpvs(:,:,jclass) + zwkvs(:,:)
-
- END DO ! loop to next level
- END DO ! next class
-
- OPEN(numout,FILE=cfileout)
- DO
-
- PRINT *, ' Give name of section '
- READ(*,'(a)') csection
- IF (TRIM(csection) == 'EOF' ) CLOSE(numout)
- IF (TRIM(csection) == 'EOF' ) EXIT
- PRINT *, ' Give imin, imax, jmin, jmax '
- READ(*,*) imin, imax, jmin, jmax
- !! Find the broken line between P1 (imin,jmin) and P2 (imax, jmax)
- !! ---------------------------------------------------------------
- ! ... Initialization
- i0=imin; j0=jmin; i1=imax; j1=jmax
- rxi1=i1; ryj1=j1; rxi0=i0; ryj0=j0
-
- ! .. Compute equation: ryj = aj rxi + bj
- IF ( (rxi1 -rxi0) /= 0 ) THEN
- aj = (ryj1 - ryj0 ) / (rxi1 -rxi0)
- bj = ryj0 - aj * rxi0
- ELSE
- aj=10000.
- bj=0.
- END IF
-
- ! .. Compute equation: rxi = ai ryj + bi
- IF ( (ryj1 -ryj0) /= 0 ) THEN
- ai = (rxi1 - rxi0 ) / ( ryj1 -ryj0 )
- bi = rxi0 - ai * ryj0
- ELSE
- ai=10000.
- bi=0.
- END IF
-
- ! .. Compute the integer pathway:
- n=0
- ! .. Chose the strait line with the smallest slope
- IF (ABS(aj) <= 1 ) THEN
- ! ... Here, the best line is y(x)
- ! ... If i1 < i0 swap points and remember it has been swapped
- IF (i1 < i0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
-
- IF ( j1 >= j0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 1 ; jst = 0
- norm_u = -1 ; norm_v = -1
- END IF
-
- ! ... compute the nearest j point on the line crossing at i
- DO i=i0,i1
- n=n+1
- IF (n > jpseg) STOP 'n > jpseg !'
- j=NINT(aj*i + bj )
- yypt(n) = CMPLX(i,j)
- END DO
- ELSE
- ! ... Here, the best line is x(y)
- ! ... If j1 < j0 swap points and remember it has been swapped
- IF (j1 < j0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
- IF ( i1 >= i0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 0
- jst = 1
- norm_u = 1
- norm_v = 1
- END IF
-
- ! ... compute the nearest i point on the line crossing at j
- DO j=j0,j1
- n=n+1
- IF (n > jpseg) STOP 'n>jpseg !'
- i=NINT(ai*j + bi)
- yypt(n) = CMPLX(i,j)
- END DO
- END IF
-
- !!
- !! Look for intermediate points to be added.
- ! .. The final positions are saved in rxx,ryy
- rxx(1)=REAL(yypt(1))
- ryy(1)=IMAG(yypt(1))
- nn=1
-
- DO k=2,n
- ! .. distance between 2 neighbour points
- d=ABS(yypt(k)-yypt(k-1))
- ! .. intermediate points required if d > 1
- IF ( d > 1 ) THEN
- CALL interm_pt(yypt,k,ai,bi,aj,bj,yypti)
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypti)
- ryy(nn)=IMAG(yypti)
- END IF
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypt(k))
- ryy(nn)=IMAG(yypt(k))
- END DO
-
- ! Now extract the transport through a section
- ! ... Check whether we need a u velocity or a v velocity
- ! Think that the points are f-points and delimit either a U segment
- ! or a V segment (ist and jst are set in order to look for the correct
- ! velocity point on the C-grid
- PRINT *, TRIM(csection)
- PRINT *, 'IMIN IMAX JMIN JMAX', imin, imax, jmin, jmax
- WRITE(numout,*)'% Transport along a section by levels' ,TRIM(csection)
- WRITE(numout,*) '% nada IMIN IMAX JMIN JMAX'
- DO jclass=1,nclass
- voltrpsum = 0.
- heatrpsum = 0.
- saltrpsum = 0.
-
- DO jseg = 1, nn-1
- i0=rxx(jseg)
- j0=ryy(jseg)
- IF ( rxx(jseg) == rxx(jseg+1) ) THEN
- gla(jseg)=glamu(i0,j0+jst) ; gphi(jseg)=gphiu(i0,j0+jst)
- voltrp(jseg)= ztrpu (i0,j0+jst,jclass)*norm_u
- heatrp(jseg)= ztrput(i0,j0+jst,jclass)*norm_u
- saltrp(jseg)= ztrpus(i0,j0+jst,jclass)*norm_u
- ELSE IF ( ryy(jseg) == ryy(jseg+1) ) THEN
- gla(jseg)=glamv(i0+ist,j0) ; gphi(jseg)=gphiv(i0+ist,j0)
- voltrp(jseg)=ztrpv (i0+ist,j0,jclass)*norm_v
- heatrp(jseg)=ztrpvt(i0+ist,j0,jclass)*norm_v
- saltrp(jseg)=ztrpvs(i0+ist,j0,jclass)*norm_v
- ELSE
- PRINT *,' ERROR :', rxx(jseg),ryy(jseg),rxx(jseg+1),ryy(jseg+1)
- END IF
- voltrpsum = voltrpsum+voltrp(jseg)
- heatrpsum = heatrpsum+heatrp(jseg)
- saltrpsum = saltrpsum+saltrp(jseg)
- END DO ! next segment
- IF (jclass == 1 ) PRINT *, 'FROM (LON LAT): ', gla(1),gphi(1),' TO (LON LAT)', gla(nn-1), gphi(nn-1)
- PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1)
- PRINT *, ' Mass transport : ', voltrpsum/1.e6,' SV'
- PRINT *, ' Heat transport : ', heatrpsum/1.e15,' PW'
- PRINT *, ' Salt transport : ', saltrpsum/1.e6,' kT/s'
- IF (jclass == 1 ) THEN
- WRITE(numout,*) '% nada LONmin LATmin LONmax LATmax'
- WRITE(numout,*) '% Top(m) Bottom(m) MassTrans(Sv) HeatTrans(PW) SaltTrans(kt/s)'
- WRITE(numout,*) 0 ,imin, imax, jmin, jmax
- WRITE(numout,9003) 0 ,gla(1),gphi(1), gla(nn-1), gphi(nn-1)
- ENDIF
- WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), voltrpsum/1.e6, heatrpsum/1.e15, saltrpsum/1.e6
-
-
- END DO ! next class
-
- END DO ! infinite loop : gets out when input is EOF
-
-9000 FORMAT(I4,6(f9.3,f8.4))
-9001 FORMAT(I4,6(f9.2,f9.3))
-9002 FORMAT(f9.0,f9.0,f9.2,f9.2,f9.2)
-9003 FORMAT(f9.2,f9.2,f9.2,f9.2,f9.2)
-
-CONTAINS
- SUBROUTINE interm_pt (ydpt,k,pai,pbi,paj,pbj,ydpti)
- !! -----------------------------------------------------
- !! SUBROUTINE INTERM_PT
- !! ********************
- !!
- !! PURPOSE:
- !! --------
- !! Find the best intermediate points on a pathway.
- !!
- !! ARGUMENTS:
- !! ----------
- !! ydpt : complex vector of the positions of the nearest points
- !! k : current working index
- !! pai ,pbi : slope and original ordinate of x(y)
- !! paj ,pbj : slope and original ordinate of y(x)
- !! ydpti : Complex holding the position of intermediate point
- !!
- !! AUTHOR:
- !! -------
- !! 19/07/1999 : Jean-Marc MOLINES
- !! 14/01/2005 : J M M in F90
- !!
- !!--------------------------------------------------------------
- !!
- !! 0. Declarations:
- !! ----------------
- IMPLICIT NONE
- COMPLEX, INTENT(in) :: ydpt(*)
- COMPLEX, INTENT(out) :: ydpti
- REAL(KIND=4), INTENT(IN) :: pai,pbi,paj,pbj
- INTEGER ,INTENT(in) :: k
- ! ... local
- COMPLEX :: ylptmp1, ylptmp2
- REAL(KIND=4) :: za0,zb0,za1,zb1,zd1,zd2
- REAL(KIND=4) :: zxm,zym
- REAL(KIND=4) :: zxp,zyp
- !!
- !! 1. Compute intermediate points
- !! ------------------------------
- !
- ! ... Determines whether we use y(x) or x(y):
- IF (ABS(paj) <= 1) THEN
- ! ..... y(x)
- ! ... possible intermediate points:
- ylptmp1=ydpt(k-1)+(1.,0.)
- ylptmp2=ydpt(k-1)+CMPLX(0.,SIGN(1.,paj))
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=paj
- zb0=pbj
- !
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd1 is the distance MP
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd2 is the distance MP
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- ! ... chose the smallest (zd1,zd2)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- !
- ELSE
- !
- ! ... x(y)
- ylptmp1=ydpt(k-1)+CMPLX(SIGN(1.,pai),0.)
- ylptmp2=ydpt(k-1)+(0.,1.)
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=pai
- zb0=pbi
- !
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- END IF
- END SUBROUTINE interm_pt
-
-END PROGRAM cdftransportiz_full
diff --git a/cdftransportiz.f90 b/cdftransportiz.f90
deleted file mode 100644
index f2bd3a1..0000000
--- a/cdftransportiz.f90
+++ /dev/null
@@ -1,641 +0,0 @@
-PROGRAM cdftransportiz
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdftransportiz ***
- !!
- !! ** Purpose: Compute Transports across a section
- !! PARTIAL STEPS version
- !!
- !! ** Method: Try to avoid 3 d arrays.
- !! The begining and end point of the section are given in term of f-points index.
- !! This program computes the transport across this section for
- !! (1) Mass transport ( Sv)
- !! (2) Heat Transport (PW)
- !! (3) Salt Transport (kT/sec)
- !! The transport is > 0 left handside of the line
- !! This program use a zig-zag line going through U and V-points.
- !! It takes as input : VT files, gridU, gridV files.
- !! The mesh_hgr.nc, mesh_hzr.nc are required.
- !! It is convenient to use an ASCII file as the standard input to give
- !! the name and the imin imax jmin jmax for eaxh section required
- !! The last name of this ASCII file must be EOF
- !!
- !!
- !! history :
- !! Original : J.M. Molines (jan. 2005)
- !! J.M. Molines Apr 2005 : use modules
- !! J.M. Molines Apr 2007 : merge with Julien Jouanno version (std + file output)
- !! R. Dussin (Jul. 2009) : add cdf output
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nclass !: number of depth class
- INTEGER ,DIMENSION (:),ALLOCATABLE :: imeter !: limit beetween depth level, in m (nclass -1)
- INTEGER ,DIMENSION (:),ALLOCATABLE :: ilev0,ilev1 !: limit in levels ! nclass
- INTEGER :: jk, jclass, jj !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: imin, imax, jmin, jmax, ik
- INTEGER :: numout = 10, numvtrp=11, numhtrp=12, numstrp=14
- ! added to write in netcdf
- INTEGER :: kx=1, ky=1, kz=1 ! dims of netcdf output file
- INTEGER :: nboutput=9 ! number of values to write in cdf output
- INTEGER :: ncout, ierr ! for netcdf output
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
- ! broken line stuff
- INTEGER, PARAMETER :: jpseg=10000
- INTEGER :: i0,j0,i1,j1, i, j
- INTEGER :: n,nn,k, jseg
- INTEGER :: norm_u, norm_v, ist, jst
-
- REAL(KIND=4) :: rxi0,ryj0, rxi1, ryj1
- REAL(KIND=4) :: ai,bi, aj,bj,d
- REAL(KIND=4) :: rxx(jpseg),ryy(jpseg)
- REAL(KIND=4), DIMENSION(jpseg) :: gla, gphi
-
- REAL(KIND=8), DIMENSION(jpseg) :: voltrp, heatrp, saltrp
- REAL(KIND=8) :: voltrpsum, heatrpsum, saltrpsum
- COMPLEX yypt(jpseg), yypti
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, e3v ,gphiv, zv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u ,gphiu, zu, zut, zus !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamu, glamv
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw
- REAL(KIND=4) :: rd1, rd2
- REAL(KIND=4) :: udum, vdum
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku,zwkv, zwkut,zwkvt, zwkus,zwkvs
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: ztrpu, ztrpv, ztrput,ztrpvt, ztrpus,ztrpvs
- ! added to write in netcdf
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dumlon, dumlat
- REAL(KIND=4), DIMENSION (1) :: tim ! time counter
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar ! structure of output
- !
- CHARACTER(LEN=256) :: cfilet ,cfileout='section_trp.dat', &
- & cfileu, cfilev, csection , &
- & cfilvtrp='vtrp.txt', cfilhtrp='htrp.txt', cfilstrp='strp.txt'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cdum
- CHARACTER(LEN=256) ,DIMENSION(4) :: cvarname !: array of var name for output
-
- INTEGER :: nxtarg
- LOGICAL :: ltest=.FALSE.
- ! added to write in netcdf
- CHARACTER(LEN=256) :: cfileoutnc
- ! added to write in netcdf
- LOGICAL :: lwrtcdf=.TRUE.
-
- ! constants
- REAL(KIND=4) :: rau0=1000., rcp=4000.
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 3 ) THEN
- PRINT *,' Usage : cdftransportiz [-test u v ] VTfile gridUfile gridVfile ''limit of level'' '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in te current directory'
- PRINT *,' Option -test vt u v is used for testing purposes, with constant flow field'
- PRINT *,' Output on standard output and on an ascii file called section_trp.dat'
- STOP
- ENDIF
-
-
- CALL getarg (1, cfilet)
- IF ( cfilet == '-test') THEN
- ltest = .TRUE.
- CALL getarg (2, cdum)
- READ(cdum,*) udum
- CALL getarg (3, cdum)
- READ(cdum,*) vdum
- CALL getarg (4, cfilet)
- CALL getarg (5, cfileu)
- CALL getarg (6, cfilev)
- nxtarg=6
- ELSE
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
- nxtarg=3
- ENDIF
- nclass = narg -nxtarg + 1
-
- ALLOCATE ( imeter(nclass -1), ilev0(nclass), ilev1(nclass) )
-
- DO jk=1, nclass -1
- CALL getarg(nxtarg+jk,cdum)
- READ(cdum,*) imeter(jk)
- END DO
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- IF(lwrtcdf) THEN
-
- ALLOCATE ( typvar(nboutput), ipk(nboutput), id_varout(nboutput) )
- ALLOCATE (dumlon(1,1) , dumlat(1,1) )
-
- dumlon(:,:)=0.
- dumlat(:,:)=0.
-
- DO jj=1,nboutput
- ipk(jj)=1
- ENDDO
-
- ! define new variables for output
- typvar(1)%name='vtrp'
- typvar(1)%units='Sverdrup'
- typvar%missing_value=99999.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar%scale_factor= 1.
- typvar%add_offset= 0.
- typvar%savelog10= 0.
- typvar(1)%long_name='Mass_Transport'
- typvar(1)%short_name='vtrp'
- typvar%online_operation='N/A'
- typvar%axis='T'
-
- typvar(2)%name='htrp'
- typvar(2)%units='PW'
- typvar(2)%valid_min= -1000.
- typvar(2)%valid_max= 1000.
- typvar(2)%long_name='Heat_Transport'
- typvar(2)%short_name='htrp'
-
- typvar(3)%name='strp'
- typvar(3)%units='kt/s'
- typvar(3)%valid_min= -1000.
- typvar(3)%valid_max= 1000.
- typvar(3)%long_name='Salt_Transport'
- typvar(3)%short_name='strp'
-
- typvar(4)%name='lonmin'
- typvar(4)%units='deg'
- typvar(4)%valid_min= -180.
- typvar(4)%valid_max= 180.
- typvar(4)%long_name='minimum_longitude_of_section'
- typvar(4)%short_name='lonmin'
-
- typvar(5)%name='lonmax'
- typvar(5)%units='deg'
- typvar(5)%valid_min= -180.
- typvar(5)%valid_max= 180.
- typvar(5)%long_name='maximum_longitude_of_section'
- typvar(5)%short_name='lonmax'
-
- typvar(6)%name='latmin'
- typvar(6)%units='deg'
- typvar(6)%valid_min= -90.
- typvar(6)%valid_max= 90.
- typvar(6)%long_name='minimum_latitude_of_section'
- typvar(6)%short_name='latmin'
-
- typvar(7)%name='latmax'
- typvar(7)%units='deg'
- typvar(7)%valid_min= -90.
- typvar(7)%valid_max= 90.
- typvar(7)%long_name='maximum_latitude_of_section'
- typvar(7)%short_name='latmax'
-
- typvar(8)%name='top'
- typvar(8)%units='meters'
- typvar(8)%valid_min= 0.
- typvar(8)%valid_max= 10000.
- typvar(8)%long_name='min_depth_of_the_section'
- typvar(8)%short_name='top'
-
- typvar(9)%name='bottom'
- typvar(9)%units='meters'
- typvar(9)%valid_min= 0.
- typvar(9)%valid_max= 10000.
- typvar(9)%long_name='max_depth_of_the_section'
- typvar(9)%short_name='bottom'
-
- ENDIF
-
- ! Allocate arrays
- ALLOCATE( zu (npiglo,npjglo), zut(npiglo,npjglo), zus(npiglo,npjglo) )
- ALLOCATE( zv (npiglo,npjglo), zvt(npiglo,npjglo), zvs(npiglo,npjglo) )
- !
- ALLOCATE ( zwku (npiglo,npjglo), zwkut(npiglo,npjglo), zwkus(npiglo,npjglo) )
- ALLOCATE ( zwkv (npiglo,npjglo), zwkvt(npiglo,npjglo), zwkvs(npiglo,npjglo) )
- !
- ALLOCATE ( ztrpu (npiglo,npjglo,nclass), ztrpv (npiglo,npjglo,nclass))
- ALLOCATE ( ztrput(npiglo,npjglo,nclass), ztrpvt(npiglo,npjglo,nclass))
- ALLOCATE ( ztrpus(npiglo,npjglo,nclass), ztrpvs(npiglo,npjglo,nclass))
- !
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo))
- !
- ALLOCATE ( gphiu(npiglo,npjglo), gphiv(npiglo,npjglo) )
- ALLOCATE ( glamu(npiglo,npjglo), glamv(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
- !
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
-
- glamv(:,:) = getvar(coordhgr, 'glamv', 1,npiglo,npjglo)
- glamu(:,:) = getvar(coordhgr, 'glamu', 1,npiglo,npjglo)
-
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gphiu(:,:) = getvar(coordhgr, 'gphiu', 1,npiglo,npjglo)
-
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- ! look for nearest level to imeter
- ik = 1
-
- ilev0(1) = 1
- ilev1(nclass) = npk-1
-
- DO jk = 1, nclass -1
- DO WHILE ( gdepw(ik) < imeter(jk) )
- ik = ik +1
- END DO
-
- rd1= ABS(gdepw(ik-1) - imeter(jk) )
- rd2= ABS(gdepw(ik) - imeter(jk) )
- IF ( rd2 < rd1 ) THEN
- ilev1(jk) = ik -1 ! t-levels
- ilev0(jk+1) = ik
- ELSE
- ilev1(jk) = ik -2 ! t-levels
- ilev0(jk+1) = ik -1
- END IF
- END DO
- PRINT *, 'Limits : '
- DO jk = 1, nclass
- PRINT *, ilev0(jk),ilev1(jk), gdepw(ilev0(jk)), gdepw(ilev1(jk)+1)
- END DO
-
- !! compute the transport
- ztrpu (:,:,:)= 0
- ztrpv (:,:,:)= 0
-
- ztrput(:,:,:)= 0
- ztrpvt(:,:,:)= 0
-
- ztrpus(:,:,:)= 0
- ztrpvs(:,:,:)= 0
- DO jclass = 1, nclass
- DO jk = ilev0(jclass),ilev1(jclass)
- PRINT *,'level ',jk
- ! Get velocities, temperature and salinity fluxes at jk
- IF ( ltest ) THEN
- zu (:,:)= udum
- zv (:,:)= vdum
- zut(:,:)= udum
- zvt(:,:)= vdum
- zus(:,:)= udum
- zvs(:,:)= vdum
- ELSE
- zu (:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv (:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- zut(:,:)= getvar(cfilet, 'vozout', jk ,npiglo,npjglo)
- zvt(:,:)= getvar(cfilet, 'vomevt', jk ,npiglo,npjglo)
- zus(:,:)= getvar(cfilet, 'vozous', jk ,npiglo,npjglo)
- zvs(:,:)= getvar(cfilet, 'vomevs', jk ,npiglo,npjglo)
- ENDIF
-
- ! get e3u, e3v at level jk
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.TRUE.)
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.TRUE.)
-
- zwku (:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)
- zwkv (:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)
- zwkut(:,:) = zut(:,:)*e2u(:,:)*e3u(:,:)
- zwkvt(:,:) = zvt(:,:)*e1v(:,:)*e3v(:,:)
- zwkus(:,:) = zus(:,:)*e2u(:,:)*e3u(:,:)
- zwkvs(:,:) = zvs(:,:)*e1v(:,:)*e3v(:,:)
-
- ! integrates vertically
- ztrpu (:,:,jclass) = ztrpu (:,:,jclass) + zwku (:,:)
- ztrpv (:,:,jclass) = ztrpv (:,:,jclass) + zwkv (:,:)
- ztrput(:,:,jclass) = ztrput(:,:,jclass) + zwkut(:,:) * rau0*rcp
- ztrpvt(:,:,jclass) = ztrpvt(:,:,jclass) + zwkvt(:,:) * rau0*rcp
- ztrpus(:,:,jclass) = ztrpus(:,:,jclass) + zwkus(:,:)
- ztrpvs(:,:,jclass) = ztrpvs(:,:,jclass) + zwkvs(:,:)
-
- END DO ! loop to next level
- END DO ! next class
-
- OPEN(numout,FILE=cfileout)
- ! also dump the results on txt files without any comments, some users like it !
- OPEN(numvtrp,FILE=cfilvtrp)
- OPEN(numhtrp,FILE=cfilhtrp)
- OPEN(numstrp,FILE=cfilstrp)
- DO
- PRINT *, ' Give name of section '
- READ(*,'(a)') csection
- IF (TRIM(csection) == 'EOF' ) THEN ; CLOSE(numout) ; CLOSE(numvtrp) ; CLOSE(numhtrp) ; CLOSE(numstrp) ; ENDIF
- IF (TRIM(csection) == 'EOF' ) EXIT
- PRINT *, ' Give imin, imax, jmin, jmax '
- READ(*,*) imin, imax, jmin, jmax
- !! Find the broken line between P1 (imin,jmin) and P2 (imax, jmax)
- !! ---------------------------------------------------------------
- ! ... Initialization
- i0=imin; j0=jmin; i1=imax; j1=jmax
- rxi1=i1; ryj1=j1; rxi0=i0; ryj0=j0
-
- ! .. Compute equation: ryj = aj rxi + bj
- IF ( (rxi1 -rxi0) /= 0 ) THEN
- aj = (ryj1 - ryj0 ) / (rxi1 -rxi0)
- bj = ryj0 - aj * rxi0
- ELSE
- aj=10000.
- bj=0.
- END IF
-
- ! .. Compute equation: rxi = ai ryj + bi
- IF ( (ryj1 -ryj0) /= 0 ) THEN
- ai = (rxi1 - rxi0 ) / ( ryj1 -ryj0 )
- bi = rxi0 - ai * ryj0
- ELSE
- ai=10000.
- bi=0.
- END IF
-
- ! .. Compute the integer pathway:
- n=0
- ! .. Chose the strait line with the smallest slope
- IF (ABS(aj) <= 1 ) THEN
- ! ... Here, the best line is y(x)
- ! ... If i1 < i0 swap points and remember it has been swapped
- IF (i1 < i0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
-
- IF ( j1 >= j0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 1 ; jst = 0
- norm_u = -1 ; norm_v = -1
- END IF
-
- ! ... compute the nearest j point on the line crossing at i
- DO i=i0,i1
- n=n+1
- IF (n > jpseg) STOP 'n > jpseg !'
- j=NINT(aj*i + bj )
- yypt(n) = CMPLX(i,j)
- END DO
- ELSE
- ! ... Here, the best line is x(y)
- ! ... If j1 < j0 swap points and remember it has been swapped
- IF (j1 < j0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
- IF ( i1 >= i0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 0
- jst = 1
- norm_u = 1
- norm_v = 1
- END IF
-
- ! ... compute the nearest i point on the line crossing at j
- DO j=j0,j1
- n=n+1
- IF (n > jpseg) STOP 'n>jpseg !'
- i=NINT(ai*j + bi)
- yypt(n) = CMPLX(i,j)
- END DO
- END IF
-
- !!
- !! Look for intermediate points to be added.
- ! .. The final positions are saved in rxx,ryy
- rxx(1)=REAL(yypt(1))
- ryy(1)=IMAG(yypt(1))
- nn=1
-
- DO k=2,n
- ! .. distance between 2 neighbour points
- d=ABS(yypt(k)-yypt(k-1))
- ! .. intermediate points required if d > 1
- IF ( d > 1 ) THEN
- CALL interm_pt(yypt,k,ai,bi,aj,bj,yypti)
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypti)
- ryy(nn)=IMAG(yypti)
- END IF
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypt(k))
- ryy(nn)=IMAG(yypt(k))
- END DO
-
- ! Now extract the transport through a section
- ! ... Check whether we need a u velocity or a v velocity
- ! Think that the points are f-points and delimit either a U segment
- ! or a V segment (ist and jst are set in order to look for the correct
- ! velocity point on the C-grid
- PRINT *, TRIM(csection)
- PRINT *, 'IMIN IMAX JMIN JMAX', imin, imax, jmin, jmax
- WRITE(numout,*)'% Transport along a section by levels' ,TRIM(csection)
- WRITE(numout,*) '% nada IMIN IMAX JMIN JMAX'
- DO jclass=1,nclass
- voltrpsum = 0.
- heatrpsum = 0.
- saltrpsum = 0.
-
- DO jseg = 1, nn-1
- i0=rxx(jseg)
- j0=ryy(jseg)
- IF ( rxx(jseg) == rxx(jseg+1) ) THEN
- gla(jseg)=glamu(i0,j0+jst) ; gphi(jseg)=gphiu(i0,j0+jst)
- voltrp(jseg)= ztrpu (i0,j0+jst,jclass)*norm_u
- heatrp(jseg)= ztrput(i0,j0+jst,jclass)*norm_u
- saltrp(jseg)= ztrpus(i0,j0+jst,jclass)*norm_u
- ELSE IF ( ryy(jseg) == ryy(jseg+1) ) THEN
- gla(jseg)=glamv(i0+ist,j0) ; gphi(jseg)=gphiv(i0+ist,j0)
- voltrp(jseg)=ztrpv (i0+ist,j0,jclass)*norm_v
- heatrp(jseg)=ztrpvt(i0+ist,j0,jclass)*norm_v
- saltrp(jseg)=ztrpvs(i0+ist,j0,jclass)*norm_v
- ELSE
- PRINT *,' ERROR :', rxx(jseg),ryy(jseg),rxx(jseg+1),ryy(jseg+1)
- END IF
- voltrpsum = voltrpsum+voltrp(jseg)
- heatrpsum = heatrpsum+heatrp(jseg)
- saltrpsum = saltrpsum+saltrp(jseg)
- END DO ! next segment
- IF (jclass == 1 ) PRINT *, 'FROM (LON LAT): ', gla(1),gphi(1),' TO (LON LAT)', gla(nn-1), gphi(nn-1)
- PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1)
- PRINT *, ' Mass transport : ', voltrpsum/1.e6,' SV'
- PRINT *, ' Heat transport : ', heatrpsum/1.e15,' PW'
- PRINT *, ' Salt transport : ', saltrpsum/1.e6,' kT/s'
- IF (jclass == 1 ) THEN
- WRITE(numout,*) '% nada LONmin LATmin LONmax LATmax'
- WRITE(numout,*) '% Top(m) Bottom(m) MassTrans(Sv) HeatTrans(PW) SaltTrans(kt/s)'
- WRITE(numout,*) 0 ,imin, imax, jmin, jmax
- WRITE(numout,9003) 0. ,gla(1),gphi(1), gla(nn-1), gphi(nn-1)
- ENDIF
- WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), voltrpsum/1.e6, heatrpsum/1.e15, saltrpsum/1.e6
- WRITE(numvtrp,'(e12.6)') voltrpsum
- WRITE(numhtrp,'(e12.6)') heatrpsum
- WRITE(numstrp,'(e12.6)') saltrpsum
-
- IF(lwrtcdf) THEN
-
- ! create output fileset
- cfileoutnc=TRIM(csection)//'_transports.nc'
- ncout =create(cfileoutnc,'none',kx,ky,kz,cdep='depthw')
- ierr= createvar(ncout,typvar,nboutput,ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,kx, &
- ky,kz,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ! netcdf output
- ierr = putvar0d(ncout,id_varout(1), REAL(voltrpsum/1.e6) )
- ierr = putvar0d(ncout,id_varout(2), REAL(heatrpsum/1.e15) )
- ierr = putvar0d(ncout,id_varout(3), REAL(saltrpsum/1.e6) )
- ierr = putvar0d(ncout,id_varout(4), REAL(gla(1)) )
- ierr = putvar0d(ncout,id_varout(5), REAL(gla(nn-1)) )
- ierr = putvar0d(ncout,id_varout(6), REAL(gphi(1)) )
- ierr = putvar0d(ncout,id_varout(7), REAL(gphi(nn-1)) )
- ierr = putvar0d(ncout,id_varout(8), REAL(gdepw(ilev0(jclass))) )
- ierr = putvar0d(ncout,id_varout(9), REAL(gdepw(ilev1(jclass)+1)) )
-
- ierr = closeout(ncout)
-
- ENDIF
-
-
- END DO ! next class
-
- END DO ! infinite loop : gets out when input is EOF
-
-9000 FORMAT(I4,6(f9.3,f8.4))
-9001 FORMAT(I4,6(f9.2,f9.3))
-9002 FORMAT(f9.0,f9.0,f9.2,f9.2,f9.2)
-9003 FORMAT(f9.2,f9.2,f9.2,f9.2,f9.2)
-
- CONTAINS
- SUBROUTINE interm_pt (ydpt,k,pai,pbi,paj,pbj,ydpti)
- !! -----------------------------------------------------
- !! SUBROUTINE INTERM_PT
- !! ********************
- !!
- !! PURPOSE:
- !! --------
- !! Find the best intermediate points on a pathway.
- !!
- !! ARGUMENTS:
- !! ----------
- !! ydpt : complex vector of the positions of the nearest points
- !! k : current working index
- !! pai ,pbi : slope and original ordinate of x(y)
- !! paj ,pbj : slope and original ordinate of y(x)
- !! ydpti : Complex holding the position of intermediate point
- !!
- !! AUTHOR:
- !! -------
- !! 19/07/1999 : Jean-Marc MOLINES
- !! 14/01/2005 : J M M in F90
- !!
- !!--------------------------------------------------------------
- !!
- !! 0. Declarations:
- !! ----------------
- IMPLICIT NONE
- COMPLEX, INTENT(in) :: ydpt(*)
- COMPLEX, INTENT(out) :: ydpti
- REAL(KIND=4), INTENT(IN) :: pai,pbi,paj,pbj
- INTEGER ,INTENT(in) :: k
- ! ... local
- COMPLEX :: ylptmp1, ylptmp2
- REAL(KIND=4) :: za0,zb0,za1,zb1,zd1,zd2
- REAL(KIND=4) :: zxm,zym
- REAL(KIND=4) :: zxp,zyp
- !!
- !! 1. Compute intermediate points
- !! ------------------------------
- !
- ! ... Determines whether we use y(x) or x(y):
- IF (ABS(paj) <= 1) THEN
- ! ..... y(x)
- ! ... possible intermediate points:
- ylptmp1=ydpt(k-1)+(1.,0.)
- ylptmp2=ydpt(k-1)+CMPLX(0.,SIGN(1.,paj))
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=paj
- zb0=pbj
- !
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd1 is the distance MP
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd2 is the distance MP
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- ! ... chose the smallest (zd1,zd2)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- !
- ELSE
- !
- ! ... x(y)
- ylptmp1=ydpt(k-1)+CMPLX(SIGN(1.,pai),0.)
- ylptmp2=ydpt(k-1)+(0.,1.)
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=pai
- zb0=pbi
- !
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- END IF
- END SUBROUTINE interm_pt
-
- END PROGRAM cdftransportiz
diff --git a/cdftransportiz_magda.f90 b/cdftransportiz_magda.f90
deleted file mode 100644
index 58a87f5..0000000
--- a/cdftransportiz_magda.f90
+++ /dev/null
@@ -1,661 +0,0 @@
-PROGRAM cdftransportiz
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdftransportiz ***
- !!
- !! ** Purpose: Compute Transports across a section
- !! PARTIAL STEPS version
- !!
- !! ** Method: Try to avoid 3 d arrays.
- !! The begining and end point of the section are given in term of f-points index.
- !! This program computes the transport across this section for
- !! (1) Mass transport ( Sv)
- !! (2) Heat Transport (PW)
- !! (3) Salt Transport (kT/sec)
- !! The transport is > 0 left handside of the line
- !! This program use a zig-zag line going through U and V-points.
- !! It takes as input : VT files, gridU, gridV files.
- !! The mesh_hgr.nc, mesh_hzr.nc are required.
- !! It is conveniebt to use an ASCII file as the standard input to give
- !! the name and the imin imax jmin jmax for eaxh section required
- !! The last name of this ASCII file must be EOF
- !!
- !!
- !! history :
- !! Original : J.M. Molines (jan. 2005)
- !! J.M. Molines Apr 2005 : use modules
- !! J.M. Molines Apr 2007 : merge with Julien Jouanno version (std + file output)
- !! R. Dussin (Jul. 2009) : add cdf output
- !! Mods: M. A. Balmaseda (Jan 2010). Change integration signs so that
- !! the transport across a segment is independent of the chosen
- !! trajectory
- !!---------------------------------------------------------------------
- !! $Rev: 256 $
- !! $Date: 2009-07-27 18:25:04 +0200 (Mon, 27 Jul 2009) $
- !! $Id: cdftransportiz.f90 256 2009-07-27 16:25:04Z forge $
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nclass !: number of depth class
- INTEGER ,DIMENSION (:),ALLOCATABLE :: imeter !: limit beetween depth level, in m (nclass -1)
- INTEGER ,DIMENSION (:),ALLOCATABLE :: ilev0,ilev1 !: limit in levels ! nclass
- INTEGER :: jk, jclass, jj !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: imin, imax, jmin, jmax, ik
- INTEGER :: numout = 10, numvtrp=11, numhtrp=12, numstrp=14
- ! added to write in netcdf
- INTEGER :: kx=1, ky=1, kz=1 ! dims of netcdf output file
- INTEGER :: nboutput=9 ! number of values to write in cdf output
- INTEGER :: ncout, ierr ! for netcdf output
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
- ! broken line stuff
- INTEGER, PARAMETER :: jpseg=10000
- INTEGER :: i0,j0,i1,j1, i, j
- INTEGER :: n,nn,k, jseg
- INTEGER :: norm_u, norm_v, ist, jst, idirx, idiry
-
- REAL(KIND=4) :: rxi0,ryj0, rxi1, ryj1
- REAL(KIND=4) :: ai,bi, aj,bj,d
- REAL(KIND=4) :: rxx(jpseg),ryy(jpseg)
- REAL(KIND=4), DIMENSION(jpseg) :: gla, gphi
-
- REAL(KIND=8), DIMENSION(jpseg) :: voltrp, heatrp, saltrp
- REAL(KIND=8) :: voltrpsum, heatrpsum, saltrpsum
- COMPLEX yypt(jpseg), yypti
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, e3v ,gphiv, zv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u ,gphiu, zu, zut, zus !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamu, glamv
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw
- REAL(KIND=4) :: rd1, rd2
- REAL(KIND=4) :: udum, vdum
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku,zwkv, zwkut,zwkvt, zwkus,zwkvs
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: ztrpu, ztrpv, ztrput,ztrpvt, ztrpus,ztrpvs
- ! added to write in netcdf
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dumlon, dumlat
- REAL(KIND=4), DIMENSION (1) :: tim ! time counter
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar ! structure of output
- !
- CHARACTER(LEN=256) :: cfilet ,cfileout='section_trp.dat', &
- & cfileu, cfilev, csection , &
- & cfilvtrp='vtrp.txt', cfilhtrp='htrp.txt', cfilstrp='strp.txt'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cdum
- CHARACTER(LEN=256) ,DIMENSION(4) :: cvarname !: array of var name for output
-
- INTEGER :: nxtarg
- LOGICAL :: ltest=.FALSE.
- ! added to write in netcdf
- CHARACTER(LEN=256) :: cfileoutnc
- ! added to write in netcdf
- LOGICAL :: lwrtcdf=.TRUE.
-
- ! constants
- REAL(KIND=4) :: rau0=1000., rcp=4000.
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 3 ) THEN
- PRINT *,' Usage : cdftransportiz [-test u v ] VTfile gridUfile gridVfile ''limit of level'' '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in te current directory'
- PRINT *,' Option -test vt u v is used for testing purposes, with constant flow field'
- PRINT *,' Output on standard output and on an ascii file called section_trp.dat'
- STOP
- ENDIF
-
-
- CALL getarg (1, cfilet)
- IF ( cfilet == '-test') THEN
- ltest = .TRUE.
- CALL getarg (2, cdum)
- READ(cdum,*) udum
- CALL getarg (3, cdum)
- READ(cdum,*) vdum
- CALL getarg (4, cfilet)
- CALL getarg (5, cfileu)
- CALL getarg (6, cfilev)
- nxtarg=6
- ELSE
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
- nxtarg=3
- ENDIF
- nclass = narg -nxtarg + 1
-
- ALLOCATE ( imeter(nclass -1), ilev0(nclass), ilev1(nclass) )
-
- DO jk=1, nclass -1
- CALL getarg(nxtarg+jk,cdum)
- READ(cdum,*) imeter(jk)
- END DO
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- IF(lwrtcdf) THEN
-
- ALLOCATE ( typvar(nboutput), ipk(nboutput), id_varout(nboutput) )
- ALLOCATE (dumlon(1,1) , dumlat(1,1) )
-
- dumlon(:,:)=0.
- dumlat(:,:)=0.
-
- DO jj=1,nboutput
- ipk(jj)=1
- ENDDO
-
- ! define new variables for output
- typvar(1)%name='vtrp'
- typvar(1)%units='Sverdrup'
- typvar%missing_value=99999.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar%scale_factor= 1.
- typvar%add_offset= 0.
- typvar%savelog10= 0.
- typvar(1)%long_name='Mass_Transport'
- typvar(1)%short_name='vtrp'
- typvar%online_operation='N/A'
- typvar%axis='T'
-
- typvar(2)%name='htrp'
- typvar(2)%units='PW'
- typvar(2)%valid_min= -1000.
- typvar(2)%valid_max= 1000.
- typvar(2)%long_name='Heat_Transport'
- typvar(2)%short_name='htrp'
-
- typvar(3)%name='strp'
- typvar(3)%units='kt/s'
- typvar(3)%valid_min= -1000.
- typvar(3)%valid_max= 1000.
- typvar(3)%long_name='Salt_Transport'
- typvar(3)%short_name='strp'
-
- typvar(4)%name='lonmin'
- typvar(4)%units='deg'
- typvar(4)%valid_min= -180.
- typvar(4)%valid_max= 180.
- typvar(4)%long_name='minimum_longitude_of_section'
- typvar(4)%short_name='lonmin'
-
- typvar(5)%name='lonmax'
- typvar(5)%units='deg'
- typvar(5)%valid_min= -180.
- typvar(5)%valid_max= 180.
- typvar(5)%long_name='maximum_longitude_of_section'
- typvar(5)%short_name='lonmax'
-
- typvar(6)%name='latmin'
- typvar(6)%units='deg'
- typvar(6)%valid_min= -90.
- typvar(6)%valid_max= 90.
- typvar(6)%long_name='minimum_latitude_of_section'
- typvar(6)%short_name='latmin'
-
- typvar(7)%name='latmax'
- typvar(7)%units='deg'
- typvar(7)%valid_min= -90.
- typvar(7)%valid_max= 90.
- typvar(7)%long_name='maximum_latitude_of_section'
- typvar(7)%short_name='latmax'
-
- typvar(8)%name='top'
- typvar(8)%units='meters'
- typvar(8)%valid_min= 0.
- typvar(8)%valid_max= 10000.
- typvar(8)%long_name='min_depth_of_the_section'
- typvar(8)%short_name='top'
-
- typvar(9)%name='bottom'
- typvar(9)%units='meters'
- typvar(9)%valid_min= 0.
- typvar(9)%valid_max= 10000.
- typvar(9)%long_name='max_depth_of_the_section'
- typvar(9)%short_name='bottom'
-
- ENDIF
-
- ! Allocate arrays
- ALLOCATE( zu (npiglo,npjglo), zut(npiglo,npjglo), zus(npiglo,npjglo) )
- ALLOCATE( zv (npiglo,npjglo), zvt(npiglo,npjglo), zvs(npiglo,npjglo) )
- !
- ALLOCATE ( zwku (npiglo,npjglo), zwkut(npiglo,npjglo), zwkus(npiglo,npjglo) )
- ALLOCATE ( zwkv (npiglo,npjglo), zwkvt(npiglo,npjglo), zwkvs(npiglo,npjglo) )
- !
- ALLOCATE ( ztrpu (npiglo,npjglo,nclass), ztrpv (npiglo,npjglo,nclass))
- ALLOCATE ( ztrput(npiglo,npjglo,nclass), ztrpvt(npiglo,npjglo,nclass))
- ALLOCATE ( ztrpus(npiglo,npjglo,nclass), ztrpvs(npiglo,npjglo,nclass))
- !
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo))
- !
- ALLOCATE ( gphiu(npiglo,npjglo), gphiv(npiglo,npjglo) )
- ALLOCATE ( glamu(npiglo,npjglo), glamv(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
- !
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
-
- glamv(:,:) = getvar(coordhgr, 'glamv', 1,npiglo,npjglo)
- glamu(:,:) = getvar(coordhgr, 'glamu', 1,npiglo,npjglo)
-
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gphiu(:,:) = getvar(coordhgr, 'gphiu', 1,npiglo,npjglo)
-
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- ! look for nearest level to imeter
- ik = 1
-
- ilev0(1) = 1
- ilev1(nclass) = npk-1
-
- DO jk = 1, nclass -1
- DO WHILE ( gdepw(ik) < imeter(jk) )
- ik = ik +1
- END DO
-
- rd1= ABS(gdepw(ik-1) - imeter(jk) )
- rd2= ABS(gdepw(ik) - imeter(jk) )
- IF ( rd2 < rd1 ) THEN
- ilev1(jk) = ik -1 ! t-levels
- ilev0(jk+1) = ik
- ELSE
- ilev1(jk) = ik -2 ! t-levels
- ilev0(jk+1) = ik -1
- END IF
- END DO
- PRINT *, 'Limits : '
- DO jk = 1, nclass
- PRINT *, ilev0(jk),ilev1(jk), gdepw(ilev0(jk)), gdepw(ilev1(jk)+1)
- END DO
-
- !! compute the transport
- ztrpu (:,:,:)= 0
- ztrpv (:,:,:)= 0
-
- ztrput(:,:,:)= 0
- ztrpvt(:,:,:)= 0
-
- ztrpus(:,:,:)= 0
- ztrpvs(:,:,:)= 0
- DO jclass = 1, nclass
- DO jk = ilev0(jclass),ilev1(jclass)
- PRINT *,'level ',jk
- ! Get velocities, temperature and salinity fluxes at jk
- IF ( ltest ) THEN
- zu (:,:)= udum
- zv (:,:)= vdum
- zut(:,:)= udum
- zvt(:,:)= vdum
- zus(:,:)= udum
- zvs(:,:)= vdum
- ELSE
- zu (:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv (:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- zut(:,:)= getvar(cfilet, 'vozout', jk ,npiglo,npjglo)
- zvt(:,:)= getvar(cfilet, 'vomevt', jk ,npiglo,npjglo)
- zus(:,:)= getvar(cfilet, 'vozous', jk ,npiglo,npjglo)
- zvs(:,:)= getvar(cfilet, 'vomevs', jk ,npiglo,npjglo)
- ENDIF
-
- ! get e3u, e3v at level jk
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.TRUE.)
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.TRUE.)
-
- zwku (:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)
- zwkv (:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)
- zwkut(:,:) = zut(:,:)*e2u(:,:)*e3u(:,:)
- zwkvt(:,:) = zvt(:,:)*e1v(:,:)*e3v(:,:)
- zwkus(:,:) = zus(:,:)*e2u(:,:)*e3u(:,:)
- zwkvs(:,:) = zvs(:,:)*e1v(:,:)*e3v(:,:)
-
- ! integrates vertically
- ztrpu (:,:,jclass) = ztrpu (:,:,jclass) + zwku (:,:)
- ztrpv (:,:,jclass) = ztrpv (:,:,jclass) + zwkv (:,:)
- ztrput(:,:,jclass) = ztrput(:,:,jclass) + zwkut(:,:) * rau0*rcp
- ztrpvt(:,:,jclass) = ztrpvt(:,:,jclass) + zwkvt(:,:) * rau0*rcp
- ztrpus(:,:,jclass) = ztrpus(:,:,jclass) + zwkus(:,:)
- ztrpvs(:,:,jclass) = ztrpvs(:,:,jclass) + zwkvs(:,:)
-
- END DO ! loop to next level
- END DO ! next class
-
- OPEN(numout,FILE=cfileout)
- ! also dump the results on txt files without any comments, some users like it !
- OPEN(numvtrp,FILE=cfilvtrp)
- OPEN(numhtrp,FILE=cfilhtrp)
- OPEN(numstrp,FILE=cfilstrp)
- DO
- PRINT *, ' Give name of section '
- READ(*,'(a)') csection
- IF (TRIM(csection) == 'EOF' ) THEN ; CLOSE(numout) ; CLOSE(numvtrp) ; CLOSE(numhtrp) ; CLOSE(numstrp) ; ENDIF
- IF (TRIM(csection) == 'EOF' ) EXIT
- PRINT *, ' Give imin, imax, jmin, jmax '
- READ(*,*) imin, imax, jmin, jmax
- !! Find the broken line between P1 (imin,jmin) and P2 (imax, jmax)
- !! ---------------------------------------------------------------
- ! ... Initialization
- i0=imin; j0=jmin; i1=imax; j1=jmax
- rxi1=i1; ryj1=j1; rxi0=i0; ryj0=j0
- ! compute direction of integrations and signs
-
- !The transport across the section is the dot product of
- !integral(line){(Mx,My)*dS}
- !Mx=integral(u*dz) My=integral(v*dz)) and dS=(dy,-dx)}
-
- !By defining the direction of the integration as
- idirx = isign(1,i1-i0) !positive to the east or if i1=i0
- idiry = isign(1,j1-j0) !positive to the north or if j1=j0
-
- !Then dS=(e2u*idiry,-e1v*idirx)
- !This will produce the following sign convention:
- ! West-to-est line (dx>0, dy=0)=> -My*dx (-ve for a northward flow)
- ! South-to-north (dy>0, dx=0)=> Mx*dy (+ve for an eastward flow)
-
- norm_u = idiry
- norm_v = -idirx
-
- ! .. Compute equation: ryj = aj rxi + bj
- IF ( (rxi1 -rxi0) /= 0 ) THEN
- aj = (ryj1 - ryj0 ) / (rxi1 -rxi0)
- bj = ryj0 - aj * rxi0
- ELSE
- aj=10000.
- bj=0.
- END IF
-
- ! .. Compute equation: rxi = ai ryj + bi
- IF ( (ryj1 -ryj0) /= 0 ) THEN
- ai = (rxi1 - rxi0 ) / ( ryj1 -ryj0 )
- bi = rxi0 - ai * ryj0
- ELSE
- ai=10000.
- bi=0.
- END IF
-
- ! .. Compute the integer pathway:
- n=0
- ! .. Chose the strait line with the smallest slope
- IF (ABS(aj) <= 1 ) THEN
- ! ... Here, the best line is y(x)
- ! ... If i1 < i0 swap points and remember it has been swapped
- IF (i1 < i0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
-
- IF ( j1 >= j0 ) THEN
- ist = 1 ; jst = 1
-! norm_u = 1 ; norm_v = -1
- ELSE
- ist = 1 ; jst = 0
-! norm_u = -1 ; norm_v = -1
- END IF
-
- ! ... compute the nearest j point on the line crossing at i
- DO i=i0,i1
- n=n+1
- IF (n > jpseg) STOP 'n > jpseg !'
- j=NINT(aj*i + bj )
- yypt(n) = CMPLX(i,j)
- END DO
- ELSE
- ! ... Here, the best line is x(y)
- ! ... If j1 < j0 swap points and remember it has been swapped
- IF (j1 < j0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
- IF ( i1 >= i0 ) THEN
- ist = 1 ; jst = 1
-! norm_u = 1 ; norm_v = -1
- ELSE
- ist = 0
- jst = 1
-! norm_u = 1
-! norm_v = 1
- END IF
-
- ! ... compute the nearest i point on the line crossing at j
- DO j=j0,j1
- n=n+1
- IF (n > jpseg) STOP 'n>jpseg !'
- i=NINT(ai*j + bi)
- yypt(n) = CMPLX(i,j)
- END DO
- END IF
-
- !!
- !! Look for intermediate points to be added.
- ! .. The final positions are saved in rxx,ryy
- rxx(1)=REAL(yypt(1))
- ryy(1)=IMAG(yypt(1))
- nn=1
-
- DO k=2,n
- ! .. distance between 2 neighbour points
- d=ABS(yypt(k)-yypt(k-1))
- ! .. intermediate points required if d > 1
- IF ( d > 1 ) THEN
- CALL interm_pt(yypt,k,ai,bi,aj,bj,yypti)
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypti)
- ryy(nn)=IMAG(yypti)
- END IF
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypt(k))
- ryy(nn)=IMAG(yypt(k))
- END DO
-
- ! Now extract the transport through a section
- ! ... Check whether we need a u velocity or a v velocity
- ! Think that the points are f-points and delimit either a U segment
- ! or a V segment (ist and jst are set in order to look for the correct
- ! velocity point on the C-grid
- PRINT *, TRIM(csection)
- PRINT *, 'IMIN IMAX JMIN JMAX', imin, imax, jmin, jmax
- WRITE(numout,*)'% Transport along a section by levels' ,TRIM(csection)
- WRITE(numout,*) '% nada IMIN IMAX JMIN JMAX'
- DO jclass=1,nclass
- voltrpsum = 0.
- heatrpsum = 0.
- saltrpsum = 0.
-
- DO jseg = 1, nn-1
- i0=rxx(jseg)
- j0=ryy(jseg)
- IF ( rxx(jseg) == rxx(jseg+1) ) THEN
- gla(jseg)=glamu(i0,j0+jst) ; gphi(jseg)=gphiu(i0,j0+jst)
- voltrp(jseg)= ztrpu (i0,j0+jst,jclass)*norm_u
- heatrp(jseg)= ztrput(i0,j0+jst,jclass)*norm_u
- saltrp(jseg)= ztrpus(i0,j0+jst,jclass)*norm_u
- ELSE IF ( ryy(jseg) == ryy(jseg+1) ) THEN
- gla(jseg)=glamv(i0+ist,j0) ; gphi(jseg)=gphiv(i0+ist,j0)
- voltrp(jseg)=ztrpv (i0+ist,j0,jclass)*norm_v
- heatrp(jseg)=ztrpvt(i0+ist,j0,jclass)*norm_v
- saltrp(jseg)=ztrpvs(i0+ist,j0,jclass)*norm_v
- ELSE
- PRINT *,' ERROR :', rxx(jseg),ryy(jseg),rxx(jseg+1),ryy(jseg+1)
- END IF
- voltrpsum = voltrpsum+voltrp(jseg)
- heatrpsum = heatrpsum+heatrp(jseg)
- saltrpsum = saltrpsum+saltrp(jseg)
- END DO ! next segment
- IF (jclass == 1 ) PRINT *, 'FROM (LON LAT): ', gla(1),gphi(1),' TO (LON LAT)', gla(nn-1), gphi(nn-1)
- PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1)
- PRINT *, ' Mass transport : ', voltrpsum/1.e6,' SV'
- PRINT *, ' Heat transport : ', heatrpsum/1.e15,' PW'
- PRINT *, ' Salt transport : ', saltrpsum/1.e6,' kT/s'
- IF (jclass == 1 ) THEN
- WRITE(numout,*) '% nada LONmin LATmin LONmax LATmax'
- WRITE(numout,*) '% Top(m) Bottom(m) MassTrans(Sv) HeatTrans(PW) SaltTrans(kt/s)'
- WRITE(numout,*) 0 ,imin, imax, jmin, jmax
- WRITE(numout,9003) 0. ,gla(1),gphi(1), gla(nn-1), gphi(nn-1)
- ENDIF
- WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), voltrpsum/1.e6, heatrpsum/1.e15, saltrpsum/1.e6
- WRITE(numvtrp,'(e12.6)') voltrpsum
- WRITE(numhtrp,'(e12.6)') heatrpsum
- WRITE(numstrp,'(e12.6)') saltrpsum
-
- IF(lwrtcdf) THEN
-
- ! create output fileset
- cfileoutnc=TRIM(csection)//'_transports.nc'
- ncout =create(cfileoutnc,'none',kx,ky,kz,cdep='depthw')
- ierr= createvar(ncout,typvar,nboutput,ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,kx, &
- ky,kz,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ! netcdf output
- ierr = putvar0d(ncout,id_varout(1), REAL(voltrpsum/1.e6) )
- ierr = putvar0d(ncout,id_varout(2), REAL(heatrpsum/1.e15) )
- ierr = putvar0d(ncout,id_varout(3), REAL(saltrpsum/1.e6) )
- ierr = putvar0d(ncout,id_varout(4), REAL(gla(1)) )
- ierr = putvar0d(ncout,id_varout(5), REAL(gla(nn-1)) )
- ierr = putvar0d(ncout,id_varout(6), REAL(gphi(1)) )
- ierr = putvar0d(ncout,id_varout(7), REAL(gphi(nn-1)) )
- ierr = putvar0d(ncout,id_varout(8), REAL(gdepw(ilev0(jclass))) )
- ierr = putvar0d(ncout,id_varout(9), REAL(gdepw(ilev1(jclass)+1)) )
-
- ierr = closeout(ncout)
-
- ENDIF
-
-
- END DO ! next class
-
- END DO ! infinite loop : gets out when input is EOF
-
-9000 FORMAT(I4,6(f9.3,f8.4))
-9001 FORMAT(I4,6(f9.2,f9.3))
-9002 FORMAT(f9.0,f9.0,f9.2,f9.2,f9.2)
-9003 FORMAT(f9.2,f9.2,f9.2,f9.2,f9.2)
-
- CONTAINS
- SUBROUTINE interm_pt (ydpt,k,pai,pbi,paj,pbj,ydpti)
- !! -----------------------------------------------------
- !! SUBROUTINE INTERM_PT
- !! ********************
- !!
- !! PURPOSE:
- !! --------
- !! Find the best intermediate points on a pathway.
- !!
- !! ARGUMENTS:
- !! ----------
- !! ydpt : complex vector of the positions of the nearest points
- !! k : current working index
- !! pai ,pbi : slope and original ordinate of x(y)
- !! paj ,pbj : slope and original ordinate of y(x)
- !! ydpti : Complex holding the position of intermediate point
- !!
- !! AUTHOR:
- !! -------
- !! 19/07/1999 : Jean-Marc MOLINES
- !! 14/01/2005 : J M M in F90
- !!
- !!--------------------------------------------------------------
- !!
- !! 0. Declarations:
- !! ----------------
- IMPLICIT NONE
- COMPLEX, INTENT(in) :: ydpt(*)
- COMPLEX, INTENT(out) :: ydpti
- REAL(KIND=4), INTENT(IN) :: pai,pbi,paj,pbj
- INTEGER ,INTENT(in) :: k
- ! ... local
- COMPLEX :: ylptmp1, ylptmp2
- REAL(KIND=4) :: za0,zb0,za1,zb1,zd1,zd2
- REAL(KIND=4) :: zxm,zym
- REAL(KIND=4) :: zxp,zyp
- !!
- !! 1. Compute intermediate points
- !! ------------------------------
- !
- ! ... Determines whether we use y(x) or x(y):
- IF (ABS(paj) <= 1) THEN
- ! ..... y(x)
- ! ... possible intermediate points:
- ylptmp1=ydpt(k-1)+(1.,0.)
- ylptmp2=ydpt(k-1)+CMPLX(0.,SIGN(1.,paj))
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=paj
- zb0=pbj
- !
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd1 is the distance MP
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd2 is the distance MP
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- ! ... chose the smallest (zd1,zd2)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- !
- ELSE
- !
- ! ... x(y)
- ylptmp1=ydpt(k-1)+CMPLX(SIGN(1.,pai),0.)
- ylptmp2=ydpt(k-1)+(0.,1.)
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=pai
- zb0=pbi
- !
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- END IF
- END SUBROUTINE interm_pt
-
- END PROGRAM cdftransportiz
diff --git a/cdftransportiz_noheat.f90 b/cdftransportiz_noheat.f90
deleted file mode 100644
index c337e55..0000000
--- a/cdftransportiz_noheat.f90
+++ /dev/null
@@ -1,511 +0,0 @@
-PROGRAM cdftransportiz
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdftransportiz ***
- !!
- !! ** Purpose: Compute Transports across a section
- !! PARTIAL STEPS version
- !!
- !! ** Method: Try to avoid 3 d arrays.
- !! The begining and end point of the section are given in term of f-points index.
- !! This program computes the transport across this section for
- !! (1) Mass transport ( Sv)
- !! (2) Heat Transport (PW)
- !! (3) Salt Transport (kT/sec)
- !! The transport is > 0 left handside of the line
- !! This program use a zig-zag line going through U and V-points.
- !! It takes as input : VT files, gridU, gridV files.
- !! The mesh_hgr.nc, mesh_hzr.nc are required.
- !! It is convenient to use an ASCII file as the standard input to give
- !! the name and the imin imax jmin jmax for eaxh section required
- !! The last name of this ASCII file must be EOF
- !!
- !!
- !! history :
- !! Original : J.M. Molines (jan. 2005)
- !! J.M. Molines Apr 2005 : use modules
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nclass !: number of depth class
- INTEGER ,DIMENSION (:),ALLOCATABLE :: imeter !: limit beetween depth level, in m (nclass -1)
- INTEGER ,DIMENSION (:),ALLOCATABLE :: ilev0,ilev1 !: limit in levels ! nclass
- INTEGER :: jk, jclass !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: imin, imax, jmin, jmax, ik
- INTEGER :: numout = 10, numin=23, numout1 = 24
-
- ! broken line stuff
- INTEGER, PARAMETER :: jpseg=10000
- INTEGER :: i0,j0,i1,j1, i, j
- INTEGER :: n,nn,k, jseg
- INTEGER :: norm_u, norm_v, ist, jst
-
- REAL(KIND=4) :: rxi0,ryj0, rxi1, ryj1
- REAL(KIND=4) :: ai,bi, aj,bj,d
- REAL(KIND=4) :: rxx(jpseg),ryy(jpseg)
- REAL(KIND=4), DIMENSION(jpseg) :: gla, gphi
-
- REAL(KIND=8), DIMENSION(jpseg) :: voltrp, heatrp, saltrp
- REAL(KIND=8) :: voltrpsum, heatrpsum, saltrpsum
- COMPLEX yypt(jpseg), yypti
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, e3v ,gphiv, zv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u ,gphiu, zu, zut, zus !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamu, glamv
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw
- REAL(KIND=4) :: rd1, rd2
- REAL(KIND=4) :: udum, vdum
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku,zwkv, zwkut,zwkvt, zwkus,zwkvs
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: ztrpu, ztrpv, ztrput,ztrpvt, ztrpus,ztrpvs
-
- CHARACTER(LEN=256) :: cfileu, cfilev, csection, cfileout='section_trp.dat'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cdum
-
- INTEGER :: nxtarg
- LOGICAL :: ltest=.FALSE.
-
- ! constants
- REAL(KIND=4) :: rau0=1000., rcp=4000.
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 2 ) THEN
- PRINT *,' Usage : cdftransportiz_noheat [-test u v ] gridUfile gridVfile ''limit of level'' '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in te current directory'
- PRINT *,' Option -test vt u v is used for testing purposes, with constant flow field'
- PRINT *,' Output on standard output and on an ascii file called section_trp.dat'
- PRINT *,' For the sake of portability, the file format is the same than for cdftransportiz, with 0 for heat and salt transport'
- STOP
- ENDIF
-
-
- CALL getarg (1, cfileu)
- IF ( cfileu == '-test') THEN
- ltest = .TRUE.
- CALL getarg (2, cdum)
- READ(cdum,*) udum
- CALL getarg (3, cdum)
- READ(cdum,*) vdum
- CALL getarg (4, cfileu)
- CALL getarg (5, cfilev)
- nxtarg=5
- ELSE
- CALL getarg (2, cfilev)
- nxtarg=2
- ENDIF
- nclass = narg -nxtarg + 1
-
- ALLOCATE ( imeter(nclass -1), ilev0(nclass), ilev1(nclass) )
-
- DO jk=1, nclass -1
- CALL getarg(nxtarg+jk,cdum)
- READ(cdum,*) imeter(jk)
- END DO
-
- npiglo= MAX(1, getdim (cfileu,'x') )
- npjglo= MAX(1 ,getdim (cfileu,'y') )
- npk = getdim (cfileu,'depth')
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE( zu (npiglo,npjglo), zut(npiglo,npjglo), zus(npiglo,npjglo) )
- ALLOCATE( zv (npiglo,npjglo), zvt(npiglo,npjglo), zvs(npiglo,npjglo) )
- !
- ALLOCATE ( zwku (npiglo,npjglo), zwkut(npiglo,npjglo), zwkus(npiglo,npjglo) )
- ALLOCATE ( zwkv (npiglo,npjglo), zwkvt(npiglo,npjglo), zwkvs(npiglo,npjglo) )
- !
- ALLOCATE ( ztrpu (npiglo,npjglo,nclass), ztrpv (npiglo,npjglo,nclass))
- ALLOCATE ( ztrput(npiglo,npjglo,nclass), ztrpvt(npiglo,npjglo,nclass))
- ALLOCATE ( ztrpus(npiglo,npjglo,nclass), ztrpvs(npiglo,npjglo,nclass))
- !
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo))
- !
- ALLOCATE ( gphiu(npiglo,npjglo), gphiv(npiglo,npjglo) )
- ALLOCATE ( glamu(npiglo,npjglo), glamv(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
- !
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
-
- glamv(:,:) = getvar(coordhgr, 'glamv', 1,npiglo,npjglo)
- glamu(:,:) = getvar(coordhgr, 'glamu', 1,npiglo,npjglo)
-
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gphiu(:,:) = getvar(coordhgr, 'gphiu', 1,npiglo,npjglo)
-
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- ! look for nearest level to imeter
- ik = 1
-
- ilev0(1) = 1
- ilev1(nclass) = npk-1
-
- DO jk = 1, nclass -1
- DO WHILE ( gdepw(ik) < imeter(jk) )
- ik = ik +1
- END DO
-
- rd1= ABS(gdepw(ik-1) - imeter(jk) )
- rd2= ABS(gdepw(ik) - imeter(jk) )
- IF ( rd2 < rd1 ) THEN
- ilev1(jk) = ik -1 ! t-levels
- ilev0(jk+1) = ik
- ELSE
- ilev1(jk) = ik -2 ! t-levels
- ilev0(jk+1) = ik -1
- END IF
- END DO
- PRINT *, 'Limits : '
- DO jk = 1, nclass
- PRINT *, ilev0(jk),ilev1(jk), gdepw(ilev0(jk)), gdepw(ilev1(jk)+1)
- END DO
-
- !! compute the transport
- ztrpu (:,:,:)= 0
- ztrpv (:,:,:)= 0
-
- ztrput(:,:,:)= 0
- ztrpvt(:,:,:)= 0
-
- ztrpus(:,:,:)= 0
- ztrpvs(:,:,:)= 0
- DO jclass = 1, nclass
- DO jk = ilev0(jclass),ilev1(jclass)
- PRINT *,'level ',jk
- ! Get velocities, temperature and salinity fluxes at jk
- IF ( ltest ) THEN
- zu (:,:)= udum
- zv (:,:)= vdum
- zut(:,:)= udum
- zvt(:,:)= vdum
- zus(:,:)= udum
- zvs(:,:)= vdum
- ELSE
- zu (:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv (:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- zut(:,:)= 0.
- zvt(:,:)= 0.
- zus(:,:)= 0.
- zvs(:,:)= 0.
- ENDIF
-
- ! get e3u, e3v at level jk
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
-
- zwku (:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)
- zwkv (:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)
- zwkut(:,:) = zut(:,:)*e2u(:,:)*e3u(:,:)
- zwkvt(:,:) = zvt(:,:)*e1v(:,:)*e3v(:,:)
- zwkus(:,:) = zus(:,:)*e2u(:,:)*e3u(:,:)
- zwkvs(:,:) = zvs(:,:)*e1v(:,:)*e3v(:,:)
-
- ! integrates vertically
- ztrpu (:,:,jclass) = ztrpu (:,:,jclass) + zwku (:,:)
- ztrpv (:,:,jclass) = ztrpv (:,:,jclass) + zwkv (:,:)
- ztrput(:,:,jclass) = ztrput(:,:,jclass) + zwkut(:,:) * rau0*rcp
- ztrpvt(:,:,jclass) = ztrpvt(:,:,jclass) + zwkvt(:,:) * rau0*rcp
- ztrpus(:,:,jclass) = ztrpus(:,:,jclass) + zwkus(:,:)
- ztrpvs(:,:,jclass) = ztrpvs(:,:,jclass) + zwkvs(:,:)
-
- END DO ! loop to next level
- END DO ! next class
- OPEN(numout1,FILE='out.txt')
- OPEN(numout,FILE=cfileout)
-! OPEN(numin,FILE='section.dat')
- DO
- PRINT *, ' Give name of section '
-! READ(numin,*) csection
- READ(*,'(a)') csection
-! PRINT *, ' Give name of section : ', TRIM(csection)
- IF (TRIM(csection) == 'EOF' ) CLOSE(numout)
- IF (TRIM(csection) == 'EOF' ) CLOSE(numout1)
- IF (TRIM(csection) == 'EOF' ) EXIT
- PRINT *, ' Give imin, imax, jmin, jmax '
-! READ(numin,*) imin, imax, jmin, jmax
- READ(*,*) imin, imax, jmin, jmax
-! PRINT *, ' Give imin, imax, jmin, jmax ',imin, imax, jmin, jmax
- !! Find the broken line between P1 (imin,jmin) and P2 (imax, jmax)
- !! ---------------------------------------------------------------
- ! ... Initialization
- i0=imin; j0=jmin; i1=imax; j1=jmax
- rxi1=i1; ryj1=j1; rxi0=i0; ryj0=j0
-
- ! .. Compute equation: ryj = aj rxi + bj
- IF ( (rxi1 -rxi0) /= 0 ) THEN
- aj = (ryj1 - ryj0 ) / (rxi1 -rxi0)
- bj = ryj0 - aj * rxi0
- ELSE
- aj=10000.
- bj=0.
- END IF
-
- ! .. Compute equation: rxi = ai ryj + bi
- IF ( (ryj1 -ryj0) /= 0 ) THEN
- ai = (rxi1 - rxi0 ) / ( ryj1 -ryj0 )
- bi = rxi0 - ai * ryj0
- ELSE
- ai=10000.
- bi=0.
- END IF
-
- ! .. Compute the integer pathway:
- n=0
- ! .. Chose the strait line with the smallest slope
- IF (ABS(aj) <= 1 ) THEN
- ! ... Here, the best line is y(x)
- ! ... If i1 < i0 swap points and remember it has been swapped
- IF (i1 < i0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
-
- IF ( j1 >= j0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 1 ; jst = 0
- norm_u = -1 ; norm_v = -1
- END IF
-
- ! ... compute the nearest j point on the line crossing at i
- DO i=i0,i1
- n=n+1
- IF (n > jpseg) STOP 'n > jpseg !'
- j=NINT(aj*i + bj )
- yypt(n) = CMPLX(i,j)
- END DO
- ELSE
- ! ... Here, the best line is x(y)
- ! ... If j1 < j0 swap points and remember it has been swapped
- IF (j1 < j0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
- IF ( i1 >= i0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 0
- jst = 1
- norm_u = 1
- norm_v = 1
- END IF
-
- ! ... compute the nearest i point on the line crossing at j
- DO j=j0,j1
- n=n+1
- IF (n > jpseg) STOP 'n>jpseg !'
- i=NINT(ai*j + bi)
- yypt(n) = CMPLX(i,j)
- END DO
- END IF
-
- !!
- !! Look for intermediate points to be added.
- ! .. The final positions are saved in rxx,ryy
- rxx(1)=REAL(yypt(1))
- ryy(1)=IMAG(yypt(1))
- nn=1
-
- DO k=2,n
- ! .. distance between 2 neighbour points
- d=ABS(yypt(k)-yypt(k-1))
- ! .. intermediate points required if d > 1
- IF ( d > 1 ) THEN
- CALL interm_pt(yypt,k,ai,bi,aj,bj,yypti)
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypti)
- ryy(nn)=IMAG(yypti)
- END IF
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypt(k))
- ryy(nn)=IMAG(yypt(k))
- END DO
-
- ! Now extract the transport through a section
- ! ... Check whether we need a u velocity or a v velocity
- ! Think that the points are f-points and delimit either a U segment
- ! or a V segment (ist and jst are set in order to look for the correct
- ! velocity point on the C-grid
- PRINT *, TRIM(csection)
- PRINT *, 'IMIN IMAX JMIN JMAX', imin, imax, jmin, jmax
- WRITE(numout,*)'% Transport along a section by levels' ,TRIM(csection)
- WRITE(numout,*) '% nada IMIN IMAX JMIN JMAX'
- DO jclass=1,nclass
- voltrpsum = 0.
- heatrpsum = 0.
- saltrpsum = 0.
-
- DO jseg = 1, nn-1
- i0=rxx(jseg)
- j0=ryy(jseg)
- IF ( rxx(jseg) == rxx(jseg+1) ) THEN
- gla(jseg)=glamu(i0,j0+jst) ; gphi(jseg)=gphiu(i0,j0+jst)
- voltrp(jseg)= ztrpu (i0,j0+jst,jclass)*norm_u
- heatrp(jseg)= ztrput(i0,j0+jst,jclass)*norm_u
- saltrp(jseg)= ztrpus(i0,j0+jst,jclass)*norm_u
- ELSE IF ( ryy(jseg) == ryy(jseg+1) ) THEN
- gla(jseg)=glamv(i0+ist,j0) ; gphi(jseg)=gphiv(i0+ist,j0)
- voltrp(jseg)=ztrpv (i0+ist,j0,jclass)*norm_v
- heatrp(jseg)=ztrpvt(i0+ist,j0,jclass)*norm_v
- saltrp(jseg)=ztrpvs(i0+ist,j0,jclass)*norm_v
- ELSE
- PRINT *,' ERROR :', rxx(jseg),ryy(jseg),rxx(jseg+1),ryy(jseg+1)
- END IF
- voltrpsum = voltrpsum+voltrp(jseg)
- heatrpsum = heatrpsum+heatrp(jseg)
- saltrpsum = saltrpsum+saltrp(jseg)
- END DO ! next segment
- IF (jclass == 1 ) PRINT *, 'FROM (LON LAT): ', gla(1),gphi(1),' TO (LON LAT)', gla(nn-1), gphi(nn-1)
- PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1)
- PRINT *, ' Mass transport : ', voltrpsum/1.e6,' SV'
- PRINT *, ' Heat transport : ', heatrpsum/1.e15,' PW'
- PRINT *, ' Salt transport : ', saltrpsum/1.e6,' kT/s'
- IF (jclass == 1 ) THEN
- WRITE(numout,*) '% nada LONmin LATmin LONmax LATmax'
- WRITE(numout,*) '% Top(m) Bottom(m) MassTrans(Sv) HeatTrans(PW) SaltTrans(kt/s)'
- WRITE(numout,*) 0 ,imin, imax, jmin, jmax
- WRITE(numout,9003) 0 ,gla(1),gphi(1), gla(nn-1), gphi(nn-1)
- ENDIF
- WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), voltrpsum/1.e6, 0.e0, 0.e0
- WRITE(numout1,9004) voltrpsum/1.e6
- END DO ! next class
- END DO ! infinite loop : gets out when input is EOF
-
-9000 FORMAT(I4,6(f9.3,f8.4))
-9001 FORMAT(I4,6(f9.2,f9.3))
-9002 FORMAT(f9.0,f9.0,f9.2,f9.2,f9.2)
-9003 FORMAT(f9.2,f9.2,f9.2,f9.2,f9.2)
-9004 FORMAT(f9.2)
-CONTAINS
- SUBROUTINE interm_pt (ydpt,k,pai,pbi,paj,pbj,ydpti)
- !! -----------------------------------------------------
- !! SUBROUTINE INTERM_PT
- !! ********************
- !!
- !! PURPOSE:
- !! --------
- !! Find the best intermediate points on a pathway.
- !!
- !! ARGUMENTS:
- !! ----------
- !! ydpt : complex vector of the positions of the nearest points
- !! k : current working index
- !! pai ,pbi : slope and original ordinate of x(y)
- !! paj ,pbj : slope and original ordinate of y(x)
- !! ydpti : Complex holding the position of intermediate point
- !!
- !! AUTHOR:
- !! -------
- !! 19/07/1999 : Jean-Marc MOLINES
- !! 14/01/2005 : J M M in F90
- !!
- !!--------------------------------------------------------------
- !!
- !! 0. Declarations:
- !! ----------------
- IMPLICIT NONE
- COMPLEX, INTENT(in) :: ydpt(*)
- COMPLEX, INTENT(out) :: ydpti
- REAL(KIND=4), INTENT(IN) :: pai,pbi,paj,pbj
- INTEGER ,INTENT(in) :: k
- ! ... local
- COMPLEX :: ylptmp1, ylptmp2
- REAL(KIND=4) :: za0,zb0,za1,zb1,zd1,zd2
- REAL(KIND=4) :: zxm,zym
- REAL(KIND=4) :: zxp,zyp
- !!
- !! 1. Compute intermediate points
- !! ------------------------------
- !
- ! ... Determines whether we use y(x) or x(y):
- IF (ABS(paj) <= 1) THEN
- ! ..... y(x)
- ! ... possible intermediate points:
- ylptmp1=ydpt(k-1)+(1.,0.)
- ylptmp2=ydpt(k-1)+CMPLX(0.,SIGN(1.,paj))
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=paj
- zb0=pbj
- !
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd1 is the distance MP
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd2 is the distance MP
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- ! ... chose the smallest (zd1,zd2)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- !
- ELSE
- !
- ! ... x(y)
- ylptmp1=ydpt(k-1)+CMPLX(SIGN(1.,pai),0.)
- ylptmp2=ydpt(k-1)+(0.,1.)
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=pai
- zb0=pbi
- !
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- END IF
- END SUBROUTINE interm_pt
-
-END PROGRAM cdftransportiz
diff --git a/cdftransportiz_noheat_obc.f90 b/cdftransportiz_noheat_obc.f90
deleted file mode 100644
index a52b73e..0000000
--- a/cdftransportiz_noheat_obc.f90
+++ /dev/null
@@ -1,656 +0,0 @@
-PROGRAM cdftransportiz_noheat_obc
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdftransportiz_noheat_obc ***
- !!
- !! ** Purpose: Compute Transports across a section
- !! PARTIAL STEPS version
- !!
- !! ** Method: Try to avoid 3 d arrays.
- !! The begining and end point of the section are given in term of f-points index.
- !! This program computes the transport across this section for
- !! (1) Mass transport ( Sv)
- !! (2) Heat Transport (PW)
- !! (3) Salt Transport (kT/sec)
- !! The transport is > 0 left handside of the line
- !! This program use a zig-zag line going through U and V-points.
- !! It takes as input : VT files, gridU, gridV files.
- !! The mesh_hgr.nc, mesh_hzr.nc are required.
- !! It is convenient to use an ASCII file as the standard input to give
- !! the name and the imin imax jmin jmax for eaxh section required
- !! The last name of this ASCII file must be EOF
- !!
- !!
- !! history :
- !! Original : J.M. Molines (jan. 2005)
- !! J.M. Molines Apr 2005 : use modules
- !! J.M. Molines Jun. 2010 : adaptation for OBC files
- !!---------------------------------------------------------------------
- !! $Rev: 264 $
- !! $Date: 2009-09-08 17:49:35 +0200 (Tue, 08 Sep 2009) $
- !! $Id: cdftransportiz_noheat_obc.f90 264 2009-09-08 15:49:35Z mathiot $
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nclass !: number of depth class
- INTEGER ,DIMENSION (:),ALLOCATABLE :: imeter !: limit beetween depth level, in m (nclass -1)
- INTEGER ,DIMENSION (:),ALLOCATABLE :: ilev0,ilev1 !: limit in levels ! nclass
- INTEGER :: jk, jclass, jj !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: imin, imax, jmin, jmax, ik
- INTEGER :: numout = 10, numvtrp=11, numhtrp=12, numstrp=14
- ! added to write in netcdf
- INTEGER :: kx=1, ky=1, kz=1 ! dims of netcdf output file
- INTEGER :: nboutput=7 ! number of values to write in cdf output
- INTEGER :: ncout, ierr ! for netcdf output
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, id_varout
- ! broken line stuff
- INTEGER, PARAMETER :: jpseg=10000
- INTEGER :: i0,j0,i1,j1, i, j
- INTEGER :: n,nn,k, jseg
- INTEGER :: norm_u, norm_v, ist, jst
-
- REAL(KIND=4) :: rxi0,ryj0, rxi1, ryj1
- REAL(KIND=4) :: ai,bi, aj,bj,d
- REAL(KIND=4) :: rxx(jpseg),ryy(jpseg)
- REAL(KIND=4), DIMENSION(jpseg) :: gla, gphi
-
- REAL(KIND=8), DIMENSION(jpseg) :: voltrp, heatrp, saltrp
- REAL(KIND=8) :: voltrpsum, heatrpsum, saltrpsum
- COMPLEX yypt(jpseg), yypti
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, e3v ,gphiv, zv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u ,gphiu, zu, zut, zus !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamu, glamv
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw
- REAL(KIND=4) :: rd1, rd2
- REAL(KIND=4) :: udum, vdum
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku,zwkv, zwkut,zwkvt, zwkus,zwkvs
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zuobc, zvobc
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: ztrpu, ztrpv, ztrput,ztrpvt, ztrpus,ztrpvs
-
- ! added to write in netcdf
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: dumlon, dumlat
- REAL(KIND=4), DIMENSION (1) :: tim ! time counter
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar ! structure of output
- !
- CHARACTER(LEN=256) :: cfilet ,cfileout='section_trp.dat', &
- & cfileu, cfilev, csection , &
- & cfilvtrp='vtrp.txt', cfilhtrp='htrp.txt', cfilstrp='strp.txt'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cdum
-
- INTEGER :: nxtarg
- LOGICAL :: ltest=.FALSE., l_merid=.false., l_zonal=.false.
- ! added to write in netcdf
- CHARACTER(LEN=256) :: cfileoutnc
- ! added to write in netcdf
- LOGICAL :: lwrtcdf=.TRUE.
-
- ! constants
- REAL(KIND=4) :: rau0=1000., rcp=4000.
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 2 ) THEN
- PRINT *,' Usage : cdftransportiz_noheat [-test u v ] gridUfile gridVfile ''limit of level'' '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in te current directory'
- PRINT *,' Option -test vt u v is used for testing purposes, with constant flow field'
- PRINT *,' Output on standard output and on an ascii file called section_trp.dat'
- PRINT *,' For the sake of portability, the file format is the same than for cdftransportiz, with 0 for heat and salt transport'
- STOP
- ENDIF
-
-
- CALL getarg (1, cfileu)
- IF ( cfileu == '-test') THEN
- ltest = .TRUE.
- CALL getarg (2, cdum)
- READ(cdum,*) udum
- CALL getarg (3, cdum)
- READ(cdum,*) vdum
- CALL getarg (4, cfileu)
- CALL getarg (5, cfilev)
- nxtarg=5
- ELSE
- CALL getarg (2, cfilev)
- nxtarg=2
- ENDIF
- nclass = narg -nxtarg + 1
-
- ALLOCATE ( imeter(nclass -1), ilev0(nclass), ilev1(nclass) )
-
- DO jk=1, nclass -1
- CALL getarg(nxtarg+jk,cdum)
- READ(cdum,*) imeter(jk)
- END DO
-
- npiglo= MAX(1, getdim (cfileu,'x') )
- npjglo= MAX(1 ,getdim (cfileu,'y') )
- npk = getdim (cfileu,'depth')
-
- IF(lwrtcdf) THEN
-
- ALLOCATE ( typvar(nboutput), ipk(nboutput), id_varout(nboutput) )
- ALLOCATE (dumlon(1,1) , dumlat(1,1) )
-
- dumlon(:,:)=0.
- dumlat(:,:)=0.
-
- DO jj=1,nboutput
- ipk(jj)=1
- ENDDO
-
- ! define new variables for output
- typvar(1)%name='vtrp'
- typvar(1)%units='Sverdrup'
- typvar%missing_value=99999.
- typvar(1)%valid_min= -1000.
- typvar(1)%valid_max= 1000.
- typvar%scale_factor= 1.
- typvar%add_offset= 0.
- typvar%savelog10= 0.
- typvar(1)%long_name='Mass_Transport'
- typvar(1)%short_name='vtrp'
- typvar%online_operation='N/A'
- typvar%axis='T'
-
- typvar(2)%name='lonmin'
- typvar(2)%units='deg'
- typvar(2)%valid_min= -180.
- typvar(2)%valid_max= 180.
- typvar(2)%long_name='minimum_longitude_of_section'
- typvar(2)%short_name='lonmin'
-
- typvar(3)%name='lonmax'
- typvar(3)%units='deg'
- typvar(3)%valid_min= -180.
- typvar(3)%valid_max= 180.
- typvar(3)%long_name='maximum_longitude_of_section'
- typvar(3)%short_name='lonmax'
-
- typvar(4)%name='latmin'
- typvar(4)%units='deg'
- typvar(4)%valid_min= -90.
- typvar(4)%valid_max= 90.
- typvar(4)%long_name='minimum_latitude_of_section'
- typvar(4)%short_name='latmin'
-
- typvar(5)%name='latmax'
- typvar(5)%units='deg'
- typvar(5)%valid_min= -90.
- typvar(5)%valid_max= 90.
- typvar(5)%long_name='maximum_latitude_of_section'
- typvar(5)%short_name='latmax'
-
- typvar(6)%name='top'
- typvar(6)%units='meters'
- typvar(6)%valid_min= 0.
- typvar(6)%valid_max= 10000.
- typvar(6)%long_name='min_depth_of_the_section'
- typvar(6)%short_name='top'
-
- typvar(7)%name='bottom'
- typvar(7)%units='meters'
- typvar(7)%valid_min= 0.
- typvar(7)%valid_max= 10000.
- typvar(7)%long_name='max_depth_of_the_section'
- typvar(7)%short_name='bottom'
-
- ENDIF
-
-
- IF ( npiglo == 1 ) THEN
- l_merid=.true.
- PRINT *,' Meridional OBC'
- ENDIF
-
- IF ( npjglo == 1 ) THEN
- l_zonal=.true.
- PRINT *,' ZONAL OBC'
- ENDIF
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- IF ( l_merid) THEN
- ALLOCATE (zuobc(npjglo,npk), zvobc(npjglo,npk) )
- ELSEIF (l_zonal) THEN
- ALLOCATE (zuobc(npiglo,npk), zvobc(npiglo,npk) )
- ENDIF
-
-
- ! Allocate arrays
- ALLOCATE( zu (npiglo,npjglo), zut(npiglo,npjglo), zus(npiglo,npjglo) )
- ALLOCATE( zv (npiglo,npjglo), zvt(npiglo,npjglo), zvs(npiglo,npjglo) )
- !
- ALLOCATE ( zwku (npiglo,npjglo), zwkut(npiglo,npjglo), zwkus(npiglo,npjglo) )
- ALLOCATE ( zwkv (npiglo,npjglo), zwkvt(npiglo,npjglo), zwkvs(npiglo,npjglo) )
- !
- ALLOCATE ( ztrpu (npiglo,npjglo,nclass), ztrpv (npiglo,npjglo,nclass))
- ALLOCATE ( ztrput(npiglo,npjglo,nclass), ztrpvt(npiglo,npjglo,nclass))
- ALLOCATE ( ztrpus(npiglo,npjglo,nclass), ztrpvs(npiglo,npjglo,nclass))
- !
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo))
- !
- ALLOCATE ( gphiu(npiglo,npjglo), gphiv(npiglo,npjglo) )
- ALLOCATE ( glamu(npiglo,npjglo), glamv(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
- !
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
-
- glamv(:,:) = getvar(coordhgr, 'glamv', 1,npiglo,npjglo)
- glamu(:,:) = getvar(coordhgr, 'glamu', 1,npiglo,npjglo)
-
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gphiu(:,:) = getvar(coordhgr, 'gphiu', 1,npiglo,npjglo)
-
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- ! look for nearest level to imeter
- ik = 1
-
- ilev0(1) = 1
- ilev1(nclass) = npk-1
-
- DO jk = 1, nclass -1
- DO WHILE ( gdepw(ik) < imeter(jk) )
- ik = ik +1
- END DO
-
- rd1= ABS(gdepw(ik-1) - imeter(jk) )
- rd2= ABS(gdepw(ik) - imeter(jk) )
- IF ( rd2 < rd1 ) THEN
- ilev1(jk) = ik -1 ! t-levels
- ilev0(jk+1) = ik
- ELSE
- ilev1(jk) = ik -2 ! t-levels
- ilev0(jk+1) = ik -1
- END IF
- END DO
- PRINT *, 'Limits : '
- DO jk = 1, nclass
- PRINT *, ilev0(jk),ilev1(jk), gdepw(ilev0(jk)), gdepw(ilev1(jk)+1)
- END DO
-
- !! compute the transport
- ztrpu (:,:,:)= 0
- ztrpv (:,:,:)= 0
-
- ztrput(:,:,:)= 0
- ztrpvt(:,:,:)= 0
-
- ztrpus(:,:,:)= 0
- ztrpvs(:,:,:)= 0
-
-
- ! read u, v on OBC
- IF ( l_zonal ) THEN ! (jpiglo,jpk)
- zuobc(:,:)= getvarxz(cfileu, 'vozocrtx',1,npiglo,npk )
- zvobc(:,:)= getvarxz(cfilev, 'vomecrty',1,npiglo,npk )
- ENDIF
- IF ( l_merid ) THEN ! (jpjglo,jpk)
- zuobc(:,:)= getvaryz(cfileu, 'vozocrtx',1,npjglo,npk )
- zvobc(:,:)= getvaryz(cfilev, 'vomecrty',1,npjglo,npk )
- ENDIF
-
- DO jclass = 1, nclass
- DO jk = ilev0(jclass),ilev1(jclass)
- PRINT *,'level ',jk
- ! Get velocities, temperature and salinity fluxes at jk
- IF ( ltest ) THEN
- zu (:,:)= udum
- zv (:,:)= vdum
- zut(:,:)= udum
- zvt(:,:)= vdum
- zus(:,:)= udum
- zvs(:,:)= vdum
- ELSE
- IF ( l_zonal ) THEN
- zu(:,1)=zuobc(:,jk)
- zv(:,1)=zvobc(:,jk)
- ELSE IF (l_merid ) THEN
- zu(1,:)=zuobc(:,jk)
- zv(1,:)=zvobc(:,jk)
- ENDIF
- zut(:,:)= 0.
- zvt(:,:)= 0.
- zus(:,:)= 0.
- zvs(:,:)= 0.
- ENDIF
-
- ! get e3u, e3v at level jk
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
-
- zwku (:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)
- zwkv (:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)
- zwkut(:,:) = zut(:,:)*e2u(:,:)*e3u(:,:)
- zwkvt(:,:) = zvt(:,:)*e1v(:,:)*e3v(:,:)
- zwkus(:,:) = zus(:,:)*e2u(:,:)*e3u(:,:)
- zwkvs(:,:) = zvs(:,:)*e1v(:,:)*e3v(:,:)
-
- ! integrates vertically
- ztrpu (:,:,jclass) = ztrpu (:,:,jclass) + zwku (:,:)
- ztrpv (:,:,jclass) = ztrpv (:,:,jclass) + zwkv (:,:)
- ztrput(:,:,jclass) = ztrput(:,:,jclass) + zwkut(:,:) * rau0*rcp
- ztrpvt(:,:,jclass) = ztrpvt(:,:,jclass) + zwkvt(:,:) * rau0*rcp
- ztrpus(:,:,jclass) = ztrpus(:,:,jclass) + zwkus(:,:)
- ztrpvs(:,:,jclass) = ztrpvs(:,:,jclass) + zwkvs(:,:)
-
- END DO ! loop to next level
- END DO ! next class
- OPEN(numout,FILE=cfileout)
- DO
- PRINT *, ' Give name of section '
- READ(*,'(a)') csection
-
- IF (TRIM(csection) == 'EOF' ) CLOSE(numout)
- IF (TRIM(csection) == 'EOF' ) EXIT
- PRINT *, ' Give imin, imax, jmin, jmax '
- READ(*,*) imin, imax, jmin, jmax
-
- !! Find the broken line between P1 (imin,jmin) and P2 (imax, jmax)
- !! ---------------------------------------------------------------
- ! ... Initialization
- i0=imin; j0=jmin; i1=imax; j1=jmax
- rxi1=i1; ryj1=j1; rxi0=i0; ryj0=j0
-
- ! .. Compute equation: ryj = aj rxi + bj
- IF ( (rxi1 -rxi0) /= 0 ) THEN
- aj = (ryj1 - ryj0 ) / (rxi1 -rxi0)
- bj = ryj0 - aj * rxi0
- ELSE
- aj=10000.
- bj=0.
- END IF
-
- ! .. Compute equation: rxi = ai ryj + bi
- IF ( (ryj1 -ryj0) /= 0 ) THEN
- ai = (rxi1 - rxi0 ) / ( ryj1 -ryj0 )
- bi = rxi0 - ai * ryj0
- ELSE
- ai=10000.
- bi=0.
- END IF
-
- ! .. Compute the integer pathway:
- n=0
- ! .. Chose the strait line with the smallest slope
- IF (ABS(aj) <= 1 ) THEN
- ! ... Here, the best line is y(x)
- ! ... If i1 < i0 swap points and remember it has been swapped
- IF (i1 < i0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
-
- IF ( j1 >= j0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 1 ; jst = 0
- norm_u = -1 ; norm_v = -1
- END IF
-
- ! ... compute the nearest j point on the line crossing at i
- DO i=i0,i1
- n=n+1
- IF (n > jpseg) STOP 'n > jpseg !'
- j=NINT(aj*i + bj )
- yypt(n) = CMPLX(i,j)
- END DO
- ELSE
- ! ... Here, the best line is x(y)
- ! ... If j1 < j0 swap points and remember it has been swapped
- IF (j1 < j0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
- IF ( i1 >= i0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 0
- jst = 1
- norm_u = 1
- norm_v = 1
- END IF
-
- ! ... compute the nearest i point on the line crossing at j
- DO j=j0,j1
- n=n+1
- IF (n > jpseg) STOP 'n>jpseg !'
- i=NINT(ai*j + bi)
- yypt(n) = CMPLX(i,j)
- END DO
- END IF
-
- !!
- !! Look for intermediate points to be added.
- ! .. The final positions are saved in rxx,ryy
- rxx(1)=REAL(yypt(1))
- ryy(1)=IMAG(yypt(1))
- nn=1
-
- DO k=2,n
- ! .. distance between 2 neighbour points
- d=ABS(yypt(k)-yypt(k-1))
- ! .. intermediate points required if d > 1
- IF ( d > 1 ) THEN
- CALL interm_pt(yypt,k,ai,bi,aj,bj,yypti)
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypti)
- ryy(nn)=IMAG(yypti)
- END IF
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypt(k))
- ryy(nn)=IMAG(yypt(k))
- END DO
-
- ! Now extract the transport through a section
- ! ... Check whether we need a u velocity or a v velocity
- ! Think that the points are f-points and delimit either a U segment
- ! or a V segment (ist and jst are set in order to look for the correct
- ! velocity point on the C-grid
- PRINT *, TRIM(csection)
- PRINT *, 'IMIN IMAX JMIN JMAX', imin, imax, jmin, jmax
- WRITE(numout,*)'% Transport along a section by levels' ,TRIM(csection)
- WRITE(numout,*) '% nada IMIN IMAX JMIN JMAX'
- DO jclass=1,nclass
- voltrpsum = 0.
- heatrpsum = 0.
- saltrpsum = 0.
-
- DO jseg = 1, nn-1
- i0=rxx(jseg)
- j0=ryy(jseg)
- IF ( rxx(jseg) == rxx(jseg+1) ) THEN
- gla(jseg)=glamu(i0,j0+jst) ; gphi(jseg)=gphiu(i0,j0+jst)
- voltrp(jseg)= ztrpu (i0,j0+jst,jclass)*norm_u
- heatrp(jseg)= ztrput(i0,j0+jst,jclass)*norm_u
- saltrp(jseg)= ztrpus(i0,j0+jst,jclass)*norm_u
- ELSE IF ( ryy(jseg) == ryy(jseg+1) ) THEN
- gla(jseg)=glamv(i0+ist,j0) ; gphi(jseg)=gphiv(i0+ist,j0)
- voltrp(jseg)=ztrpv (i0+ist,j0,jclass)*norm_v
- heatrp(jseg)=ztrpvt(i0+ist,j0,jclass)*norm_v
- saltrp(jseg)=ztrpvs(i0+ist,j0,jclass)*norm_v
- ELSE
- PRINT *,' ERROR :', rxx(jseg),ryy(jseg),rxx(jseg+1),ryy(jseg+1)
- END IF
- voltrpsum = voltrpsum+voltrp(jseg)
- heatrpsum = heatrpsum+heatrp(jseg)
- saltrpsum = saltrpsum+saltrp(jseg)
- END DO ! next segment
- IF (jclass == 1 ) PRINT *, 'FROM (LON LAT): ', gla(1),gphi(1),' TO (LON LAT)', gla(nn-1), gphi(nn-1)
- PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1)
- PRINT *, ' Mass transport : ', voltrpsum/1.e6,' SV'
- PRINT *, ' Heat transport : ', heatrpsum/1.e15,' PW'
- PRINT *, ' Salt transport : ', saltrpsum/1.e6,' kT/s'
- IF (jclass == 1 ) THEN
- WRITE(numout,*) '% nada LONmin LATmin LONmax LATmax'
- WRITE(numout,*) '% Top(m) Bottom(m) MassTrans(Sv) HeatTrans(PW) SaltTrans(kt/s)'
- WRITE(numout,*) 0 ,imin, imax, jmin, jmax
- WRITE(numout,9003) 0. ,gla(1),gphi(1), gla(nn-1), gphi(nn-1)
- ENDIF
- WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), voltrpsum/1.e6
- WRITE(numvtrp,'(e12.6)') voltrpsum
-
-
- IF(lwrtcdf) THEN
-
- ! create output fileset
- cfileoutnc=TRIM(csection)//'_transports.nc'
- ncout =create(cfileoutnc,'none',kx,ky,kz,cdep='depthw')
- ierr= createvar(ncout,typvar,nboutput,ipk,id_varout )
- ierr= putheadervar(ncout, cfilev,kx, &
- ky,kz,pnavlon=dumlon,pnavlat=dumlat,pdep=gdepw)
- tim=getvar1d(cfilev,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- ! netcdf output
- ierr = putvar0d(ncout,id_varout(1), REAL(voltrpsum/1.e6) )
-
- ierr = putvar0d(ncout,id_varout(2), REAL(gla(1)) )
- ierr = putvar0d(ncout,id_varout(3), REAL(gla(nn-1)) )
- ierr = putvar0d(ncout,id_varout(4), REAL(gphi(1)) )
- ierr = putvar0d(ncout,id_varout(5), REAL(gphi(nn-1)) )
- ierr = putvar0d(ncout,id_varout(6), REAL(gdepw(ilev0(jclass))) )
- ierr = putvar0d(ncout,id_varout(7), REAL(gdepw(ilev1(jclass)+1)) )
-
- ierr = closeout(ncout)
-
- ENDIF
-
-
- END DO ! next class
- END DO ! infinite loop : gets out when input is EOF
-
-9000 FORMAT(I4,6(f9.3,f8.4))
-9001 FORMAT(I4,6(f9.2,f9.3))
-9002 FORMAT(f9.0,f9.0,f9.2,f9.2,f9.2)
-9003 FORMAT(f9.2,f9.2,f9.2,f9.2,f9.2)
-9004 FORMAT(f9.2)
-CONTAINS
- SUBROUTINE interm_pt (ydpt,k,pai,pbi,paj,pbj,ydpti)
- !! -----------------------------------------------------
- !! SUBROUTINE INTERM_PT
- !! ********************
- !!
- !! PURPOSE:
- !! --------
- !! Find the best intermediate points on a pathway.
- !!
- !! ARGUMENTS:
- !! ----------
- !! ydpt : complex vector of the positions of the nearest points
- !! k : current working index
- !! pai ,pbi : slope and original ordinate of x(y)
- !! paj ,pbj : slope and original ordinate of y(x)
- !! ydpti : Complex holding the position of intermediate point
- !!
- !! AUTHOR:
- !! -------
- !! 19/07/1999 : Jean-Marc MOLINES
- !! 14/01/2005 : J M M in F90
- !!
- !!--------------------------------------------------------------
- !!
- !! 0. Declarations:
- !! ----------------
- IMPLICIT NONE
- COMPLEX, INTENT(in) :: ydpt(*)
- COMPLEX, INTENT(out) :: ydpti
- REAL(KIND=4), INTENT(IN) :: pai,pbi,paj,pbj
- INTEGER ,INTENT(in) :: k
- ! ... local
- COMPLEX :: ylptmp1, ylptmp2
- REAL(KIND=4) :: za0,zb0,za1,zb1,zd1,zd2
- REAL(KIND=4) :: zxm,zym
- REAL(KIND=4) :: zxp,zyp
- !!
- !! 1. Compute intermediate points
- !! ------------------------------
- !
- ! ... Determines whether we use y(x) or x(y):
- IF (ABS(paj) <= 1) THEN
- ! ..... y(x)
- ! ... possible intermediate points:
- ylptmp1=ydpt(k-1)+(1.,0.)
- ylptmp2=ydpt(k-1)+CMPLX(0.,SIGN(1.,paj))
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=paj
- zb0=pbj
- !
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd1 is the distance MP
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd2 is the distance MP
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- ! ... chose the smallest (zd1,zd2)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- !
- ELSE
- !
- ! ... x(y)
- ylptmp1=ydpt(k-1)+CMPLX(SIGN(1.,pai),0.)
- ylptmp2=ydpt(k-1)+(0.,1.)
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=pai
- zb0=pbi
- !
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- END IF
- END SUBROUTINE interm_pt
-
-END PROGRAM cdftransportiz_noheat_obc
diff --git a/cdftransportizpm.f90 b/cdftransportizpm.f90
deleted file mode 100644
index 935f57b..0000000
--- a/cdftransportizpm.f90
+++ /dev/null
@@ -1,549 +0,0 @@
-PROGRAM cdftransportizpm
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdftransportizpm ***
- !!
- !! ** Purpose: Compute Transports across a section
- !! In this version positive and negative contributions are separated
- !! PARTIAL STEPS version
- !!
- !! ** Method: Try to avoid 3 d arrays.
- !! The begining and end point of the section are given in term of f-points index.
- !! This program computes the transport across this section for
- !! (1) Mass transport ( Sv)
- !! (2) Heat Transport (PW)
- !! (3) Salt Transport (kT/sec)
- !! The transport is > 0 left handside of the line
- !! This program use a zig-zag line going through U and V-points.
- !! It takes as input : VT files, gridU, gridV files.
- !! The mesh_hgr.nc, mesh_hzr.nc are required.
- !! It is conveniebt to use an ASCII file as the standard input to give
- !! the name and the imin imax jmin jmax for eaxh section required
- !! The last name of this ASCII file must be EOF
- !!
- !!
- !! history :
- !! Original : J.M. Molines (jan. 2005)
- !! J.M. Molines Apr 2005 : use modules
- !! J.M. Molines Apr 2007 : merge with Julien Jouanno version (std + file output)
- !! G. Hervieux Oct 2007 : plus ans minus separation
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nclass !: number of depth class
- INTEGER ,DIMENSION (:),ALLOCATABLE :: imeter !: limit beetween depth level, in m (nclass -1)
- INTEGER ,DIMENSION (:),ALLOCATABLE :: ilev0,ilev1 !: limit in levels ! nclass
- INTEGER :: jk, jclass !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: imin, imax, jmin, jmax, ik
- INTEGER :: numout = 10
-
- ! broken line stuff
- INTEGER, PARAMETER :: jpseg=10000
- INTEGER :: i0,j0,i1,j1, i, j
- INTEGER :: n,nn,k, jseg
- INTEGER :: norm_u, norm_v, ist, jst
-
- REAL(KIND=4) :: rxi0,ryj0, rxi1, ryj1
- REAL(KIND=4) :: ai,bi, aj,bj,d
- REAL(KIND=4) :: rxx(jpseg),ryy(jpseg)
- REAL(KIND=4), DIMENSION(jpseg) :: gla, gphi
-
- REAL(KIND=8), DIMENSION(jpseg) :: voltrp, heatrp, saltrp
- REAL(KIND=8), DIMENSION(jpseg) :: voltrp_plus,voltrp_minus
- REAL(KIND=8) :: voltrpsum, heatrpsum, saltrpsum
- REAL(KIND=8) :: voltrpsum_plus, voltrpsum_minus
-
- COMPLEX yypt(jpseg), yypti
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, e3v ,gphiv, zv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u ,gphiu, zu, zut, zus !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: glamu, glamv
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdepw
- REAL(KIND=4) :: rd1, rd2
- REAL(KIND=4) :: udum, vdum
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku,zwkv, zwkut,zwkvt, zwkus,zwkvs
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku_plus , zwkv_plus
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku_minus, zwkv_minus
-
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: ztrpu, ztrpv, ztrput,ztrpvt, ztrpus,ztrpvs
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: ztrpu_plus , ztrpv_plus
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: ztrpu_minus, ztrpv_minus
-
- CHARACTER(LEN=256) :: cfilet ,cfileout='section_trp.dat', &
- & cfileu, cfilev, csection
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc', cdum
- CHARACTER(LEN=256) ,DIMENSION(4) :: cvarname !: array of var name for output
-
- INTEGER :: nxtarg
- LOGICAL :: ltest=.FALSE.
-
- ! constants
- REAL(KIND=4) :: rau0=1000., rcp=4000.
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 3 ) THEN
- PRINT *,' Usage : cdftransportizpm [-test u v ] VTfile gridUfile gridVfile ''limit of level'' '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in te current directory'
- PRINT *,' Option -test vt u v is used for testing purposes, with constant flow field'
- PRINT *,' Output on standard output and on an ascii file called section_trp.dat'
- STOP
- ENDIF
-
-
- CALL getarg (1, cfilet)
- IF ( cfilet == '-test') THEN
- ltest = .TRUE.
- CALL getarg (2, cdum)
- READ(cdum,*) udum
- CALL getarg (3, cdum)
- READ(cdum,*) vdum
- CALL getarg (4, cfilet)
- CALL getarg (5, cfileu)
- CALL getarg (6, cfilev)
- nxtarg=6
- ELSE
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
- nxtarg=3
- ENDIF
- nclass = narg -nxtarg + 1
-
- ALLOCATE ( imeter(nclass -1), ilev0(nclass), ilev1(nclass) )
-
- DO jk=1, nclass -1
- CALL getarg(nxtarg+jk,cdum)
- READ(cdum,*) imeter(jk)
- END DO
-
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE( zu (npiglo,npjglo), zut(npiglo,npjglo), zus(npiglo,npjglo) )
- ALLOCATE( zv (npiglo,npjglo), zvt(npiglo,npjglo), zvs(npiglo,npjglo) )
- !
- ALLOCATE ( zwku (npiglo,npjglo), zwkut(npiglo,npjglo), zwkus(npiglo,npjglo) )
- ALLOCATE ( zwkv (npiglo,npjglo), zwkvt(npiglo,npjglo), zwkvs(npiglo,npjglo) )
- ALLOCATE ( zwku_plus (npiglo,npjglo),zwkv_plus (npiglo,npjglo))
- ALLOCATE ( zwku_minus (npiglo,npjglo),zwkv_minus (npiglo,npjglo))
- !
- ALLOCATE ( ztrpu_plus (npiglo,npjglo,nclass), ztrpv_plus (npiglo,npjglo,nclass))
- ALLOCATE ( ztrpu_minus(npiglo,npjglo,nclass), ztrpv_minus(npiglo,npjglo,nclass))
- ALLOCATE ( ztrpu (npiglo,npjglo,nclass), ztrpv (npiglo,npjglo,nclass))
- ALLOCATE ( ztrput(npiglo,npjglo,nclass), ztrpvt(npiglo,npjglo,nclass))
- ALLOCATE ( ztrpus(npiglo,npjglo,nclass), ztrpvs(npiglo,npjglo,nclass))
- !
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo))
- !
- ALLOCATE ( gphiu(npiglo,npjglo), gphiv(npiglo,npjglo) )
- ALLOCATE ( glamu(npiglo,npjglo), glamv(npiglo,npjglo) )
- ALLOCATE ( gdepw(npk) )
- !
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
-
- glamv(:,:) = getvar(coordhgr, 'glamv', 1,npiglo,npjglo)
- glamu(:,:) = getvar(coordhgr, 'glamu', 1,npiglo,npjglo)
-
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gphiu(:,:) = getvar(coordhgr, 'gphiu', 1,npiglo,npjglo)
-
- gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
-
- ! look for nearest level to imeter
- ik = 1
-
- ilev0(1) = 1
- ilev1(nclass) = npk-1
-
- DO jk = 1, nclass -1
- DO WHILE ( gdepw(ik) < imeter(jk) )
- ik = ik +1
- END DO
-
- rd1= ABS(gdepw(ik-1) - imeter(jk) )
- rd2= ABS(gdepw(ik) - imeter(jk) )
- IF ( rd2 < rd1 ) THEN
- ilev1(jk) = ik -1 ! t-levels
- ilev0(jk+1) = ik
- ELSE
- ilev1(jk) = ik -2 ! t-levels
- ilev0(jk+1) = ik -1
- END IF
- END DO
- PRINT *, 'Limits : '
- DO jk = 1, nclass
- PRINT *, ilev0(jk),ilev1(jk), gdepw(ilev0(jk)), gdepw(ilev1(jk)+1)
- END DO
-
- !! compute the transport
- ztrpu_plus (:,:,:)= 0
- ztrpv_plus (:,:,:)= 0
- ztrpu_minus(:,:,:)= 0
- ztrpv_minus(:,:,:)= 0
- ztrpu (:,:,:)= 0
- ztrpv (:,:,:)= 0
-
- ztrput (:,:,:)= 0
- ztrpvt (:,:,:)= 0
-
- ztrpus (:,:,:)= 0
- ztrpvs (:,:,:)= 0
-
- DO jclass = 1, nclass
- DO jk = ilev0(jclass),ilev1(jclass)
- PRINT *,'level ',jk
- ! Get velocities, temperature and salinity fluxes at jk
- IF ( ltest ) THEN
- zu (:,:)= udum
- zv (:,:)= vdum
- zut(:,:)= udum
- zvt(:,:)= vdum
- zus(:,:)= udum
- zvs(:,:)= vdum
- ELSE
- zu (:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv (:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
- zut(:,:)= getvar(cfilet, 'vozout', jk ,npiglo,npjglo)
- zvt(:,:)= getvar(cfilet, 'vomevt', jk ,npiglo,npjglo)
- zus(:,:)= getvar(cfilet, 'vozous', jk ,npiglo,npjglo)
- zvs(:,:)= getvar(cfilet, 'vomevs', jk ,npiglo,npjglo)
- ENDIF
-
- ! get e3u, e3v at level jk
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
-
- zwku_plus = 0.d0 ; zwku_minus = 0.d0
- zwkv_plus = 0.d0 ; zwkv_minus = 0.d0
- WHERE (zu (:,:)>0) zwku_plus (:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)
- WHERE (zu (:,:)<0) zwku_minus(:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)
- zwku (:,:) = zu (:,:)*e2u(:,:)*e3u(:,:)
- WHERE (zv (:,:)>0) zwkv_plus (:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)
- WHERE (zv (:,:)<0) zwkv_minus(:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)
- zwkv (:,:) = zv (:,:)*e1v(:,:)*e3v(:,:)
- zwkut (:,:) = zut(:,:)*e2u(:,:)*e3u(:,:)
- zwkvt (:,:) = zvt(:,:)*e1v(:,:)*e3v(:,:)
- zwkus (:,:) = zus(:,:)*e2u(:,:)*e3u(:,:)
- zwkvs (:,:) = zvs(:,:)*e1v(:,:)*e3v(:,:)
-
- ! integrates vertically
- ztrpu (:,:,jclass) = ztrpu (:,:,jclass) + zwku (:,:)
- ztrpu_plus (:,:,jclass) = ztrpu_plus (:,:,jclass) + zwku_plus (:,:)
- ztrpu_minus(:,:,jclass) = ztrpu_minus(:,:,jclass) + zwku_minus (:,:)
- ztrpv (:,:,jclass) = ztrpv (:,:,jclass) + zwkv (:,:)
- ztrpv_plus (:,:,jclass) = ztrpv_plus (:,:,jclass) + zwkv_plus (:,:)
- ztrpv_minus(:,:,jclass) = ztrpv_minus(:,:,jclass) + zwkv_minus (:,:)
- ztrput (:,:,jclass) = ztrput (:,:,jclass) + zwkut(:,:) * rau0*rcp
- ztrpvt (:,:,jclass) = ztrpvt (:,:,jclass) + zwkvt(:,:) * rau0*rcp
- ztrpus (:,:,jclass) = ztrpus (:,:,jclass) + zwkus(:,:)
- ztrpvs (:,:,jclass) = ztrpvs (:,:,jclass) + zwkvs(:,:)
-
- END DO ! loop to next level
- END DO ! next class
-
- OPEN(numout,FILE=cfileout)
- DO
- PRINT *, ' Give name of section '
- READ(*,'(a)') csection
- IF (TRIM(csection) == 'EOF' ) CLOSE(numout)
- IF (TRIM(csection) == 'EOF' ) EXIT
- PRINT *, ' Give imin, imax, jmin, jmax '
- READ(*,*) imin, imax, jmin, jmax
- !! Find the broken line between P1 (imin,jmin) and P2 (imax, jmax)
- !! ---------------------------------------------------------------
- ! ... Initialization
- i0=imin; j0=jmin; i1=imax; j1=jmax
- rxi1=i1; ryj1=j1; rxi0=i0; ryj0=j0
-
- ! .. Compute equation: ryj = aj rxi + bj
- IF ( (rxi1 -rxi0) /= 0 ) THEN
- aj = (ryj1 - ryj0 ) / (rxi1 -rxi0)
- bj = ryj0 - aj * rxi0
- ELSE
- aj=10000.
- bj=0.
- END IF
-
- ! .. Compute equation: rxi = ai ryj + bi
- IF ( (ryj1 -ryj0) /= 0 ) THEN
- ai = (rxi1 - rxi0 ) / ( ryj1 -ryj0 )
- bi = rxi0 - ai * ryj0
- ELSE
- ai=10000.
- bi=0.
- END IF
-
- ! .. Compute the integer pathway:
- n=0
- ! .. Chose the strait line with the smallest slope
- IF (ABS(aj) <= 1 ) THEN
- ! ... Here, the best line is y(x)
- ! ... If i1 < i0 swap points and remember it has been swapped
- IF (i1 < i0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
-
- IF ( j1 >= j0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 1 ; jst = 0
- norm_u = -1 ; norm_v = -1
- END IF
-
- ! ... compute the nearest j point on the line crossing at i
- DO i=i0,i1
- n=n+1
- IF (n > jpseg) STOP 'n > jpseg !'
- j=NINT(aj*i + bj )
- yypt(n) = CMPLX(i,j)
- END DO
- ELSE
- ! ... Here, the best line is x(y)
- ! ... If j1 < j0 swap points and remember it has been swapped
- IF (j1 < j0 ) THEN
- i = i0 ; j = j0
- i0 = i1 ; j0 = j1
- i1 = i ; j1 = j
- END IF
- IF ( i1 >= i0 ) THEN
- ist = 1 ; jst = 1
- norm_u = 1 ; norm_v = -1
- ELSE
- ist = 0
- jst = 1
- norm_u = 1
- norm_v = 1
- END IF
-
- ! ... compute the nearest i point on the line crossing at j
- DO j=j0,j1
- n=n+1
- IF (n > jpseg) STOP 'n>jpseg !'
- i=NINT(ai*j + bi)
- yypt(n) = CMPLX(i,j)
- END DO
- END IF
-
- !!
- !! Look for intermediate points to be added.
- ! .. The final positions are saved in rxx,ryy
- rxx(1)=REAL(yypt(1))
- ryy(1)=IMAG(yypt(1))
- nn=1
-
- DO k=2,n
- ! .. distance between 2 neighbour points
- d=ABS(yypt(k)-yypt(k-1))
- ! .. intermediate points required if d > 1
- IF ( d > 1 ) THEN
- CALL interm_pt(yypt,k,ai,bi,aj,bj,yypti)
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypti)
- ryy(nn)=IMAG(yypti)
- END IF
- nn=nn+1
- IF (nn > jpseg) STOP 'nn>jpseg !'
- rxx(nn)=REAL(yypt(k))
- ryy(nn)=IMAG(yypt(k))
- END DO
-
- ! Now extract the transport through a section
- ! ... Check whether we need a u velocity or a v velocity
- ! Think that the points are f-points and delimit either a U segment
- ! or a V segment (ist and jst are set in order to look for the correct
- ! velocity point on the C-grid
- PRINT *, TRIM(csection)
- PRINT *, 'IMIN IMAX JMIN JMAX', imin, imax, jmin, jmax
- WRITE(numout,*)'% Transport along a section by levels' ,TRIM(csection)
- WRITE(numout,*) '% nada IMIN IMAX JMIN JMAX'
- DO jclass=1,nclass
- voltrpsum_plus = 0.
- voltrpsum_minus = 0.
- voltrpsum = 0.
- heatrpsum = 0.
- saltrpsum = 0.
-
- DO jseg = 1, nn-1
- i0=rxx(jseg)
- j0=ryy(jseg)
- IF ( rxx(jseg) == rxx(jseg+1) ) THEN
- gla(jseg)=glamu(i0,j0+jst) ; gphi(jseg)=gphiu(i0,j0+jst)
- voltrp_plus (jseg)= ztrpu_plus (i0,j0+jst,jclass)*norm_u
- voltrp_minus(jseg)= ztrpu_minus (i0,j0+jst,jclass)*norm_u
- voltrp (jseg)= ztrpu (i0,j0+jst,jclass)*norm_u
- heatrp (jseg)= ztrput (i0,j0+jst,jclass)*norm_u
- saltrp (jseg)= ztrpus (i0,j0+jst,jclass)*norm_u
- ELSE IF ( ryy(jseg) == ryy(jseg+1) ) THEN
- gla(jseg)=glamv(i0+ist,j0) ; gphi(jseg)=gphiv(i0+ist,j0)
- voltrp_plus (jseg)=ztrpv_plus (i0+ist,j0,jclass)*norm_v
- voltrp_minus(jseg)=ztrpv_minus (i0+ist,j0,jclass)*norm_v
- voltrp (jseg)=ztrpv (i0+ist,j0,jclass)*norm_v
- heatrp (jseg)=ztrpvt (i0+ist,j0,jclass)*norm_v
- saltrp (jseg)=ztrpvs (i0+ist,j0,jclass)*norm_v
- ELSE
- PRINT *,' ERROR :', rxx(jseg),ryy(jseg),rxx(jseg+1),ryy(jseg+1)
- END IF
- voltrpsum_plus = voltrpsum_plus +voltrp_plus(jseg)
- voltrpsum_minus = voltrpsum_minus+voltrp_minus(jseg)
- voltrpsum = voltrpsum +voltrp(jseg)
- heatrpsum = heatrpsum +heatrp(jseg)
- saltrpsum = saltrpsum +saltrp(jseg)
- END DO ! next segment
- IF (jclass == 1 ) PRINT *, 'FROM (LON LAT): ', gla(1),gphi(1),' TO (LON LAT)', gla(nn-1), gphi(nn-1)
- PRINT *, gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1)
- PRINT *, ' Mass transport : ', voltrpsum/1.e6 ,' SV'
- PRINT *, ' Mass transport PLUS: ', voltrpsum_plus/1.e6 ,' SV'
- PRINT *, ' Mass transport MINUS:', voltrpsum_minus/1.e6,' SV'
- PRINT *, ' Heat transport : ', heatrpsum/1.e15 ,' PW'
- PRINT *, ' Salt transport : ', saltrpsum/1.e6 ,' kT/s'
- IF (jclass == 1 ) THEN
- WRITE(numout,*) '% nada LONmin LATmin LONmax LATmax'
- WRITE(numout,*) '% Top(m) Bottom(m) MassTrans(Sv) HeatTrans(PW) SaltTrans(kt/s)'
- WRITE(numout,*) 0 ,imin, imax, jmin, jmax
- WRITE(numout,9003) 0. ,gla(1),gphi(1), gla(nn-1), gphi(nn-1)
- ENDIF
- WRITE(numout,9002) gdepw(ilev0(jclass)), gdepw(ilev1(jclass)+1), voltrpsum/1.e6, voltrpsum_plus/1.e6, voltrpsum_minus/1.e6
-
- END DO ! next class
-
- END DO ! infinite loop : gets out when input is EOF
-
-9000 FORMAT(I4,6(f9.3,f8.4))
-9001 FORMAT(I4,6(f9.2,f9.3))
-9002 FORMAT(f9.0,f9.0,f9.2,f9.2,f9.2)
-9003 FORMAT(f9.2,f9.2,f9.2,f9.2,f9.2)
-9005 FORMAT(f9.0,f9.0,f9.2,f9.2,f9.2,f9.2,f9.2)
-
-CONTAINS
- SUBROUTINE interm_pt (ydpt,k,pai,pbi,paj,pbj,ydpti)
- !! -----------------------------------------------------
- !! SUBROUTINE INTERM_PT
- !! ********************
- !!
- !! PURPOSE:
- !! --------
- !! Find the best intermediate points on a pathway.
- !!
- !! ARGUMENTS:
- !! ----------
- !! ydpt : complex vector of the positions of the nearest points
- !! k : current working index
- !! pai ,pbi : slope and original ordinate of x(y)
- !! paj ,pbj : slope and original ordinate of y(x)
- !! ydpti : Complex holding the position of intermediate point
- !!
- !! AUTHOR:
- !! -------
- !! 19/07/1999 : Jean-Marc MOLINES
- !! 14/01/2005 : J M M in F90
- !!
- !!--------------------------------------------------------------
- !!
- !! 0. Declarations:
- !! ----------------
- IMPLICIT NONE
- COMPLEX, INTENT(in) :: ydpt(*)
- COMPLEX, INTENT(out) :: ydpti
- REAL(KIND=4), INTENT(IN) :: pai,pbi,paj,pbj
- INTEGER ,INTENT(in) :: k
- ! ... local
- COMPLEX :: ylptmp1, ylptmp2
- REAL(KIND=4) :: za0,zb0,za1,zb1,zd1,zd2
- REAL(KIND=4) :: zxm,zym
- REAL(KIND=4) :: zxp,zyp
- !!
- !! 1. Compute intermediate points
- !! ------------------------------
- !
- ! ... Determines whether we use y(x) or x(y):
- IF (ABS(paj) <= 1) THEN
- ! ..... y(x)
- ! ... possible intermediate points:
- ylptmp1=ydpt(k-1)+(1.,0.)
- ylptmp2=ydpt(k-1)+CMPLX(0.,SIGN(1.,paj))
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=paj
- zb0=pbj
- !
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd1 is the distance MP
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- ! ... M is the candidate point:
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zym - za1*zxm
- ! ... P is the projection of M on the strait line
- zxp=-(zb1-zb0)/(za1-za0)
- zyp=za0*zxp + zb0
- ! ... zd2 is the distance MP
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- ! ... chose the smallest (zd1,zd2)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- !
- ELSE
- !
- ! ... x(y)
- ylptmp1=ydpt(k-1)+CMPLX(SIGN(1.,pai),0.)
- ylptmp2=ydpt(k-1)+(0.,1.)
- zxm=REAL(ylptmp1)
- zym=IMAG(ylptmp1)
- za0=pai
- zb0=pbi
- !
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd1=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- !
- zxm=REAL(ylptmp2)
- zym=IMAG(ylptmp2)
- za1=-1./za0
- zb1=zxm - za1*zym
- zyp=-(zb1-zb0)/(za1-za0)
- zxp=za0*zyp + zb0
- zd2=(zxm-zxp)*(zxm-zxp) + (zym-zyp)*(zym-zyp)
- IF (zd2 <= zd1) THEN
- ydpti=ylptmp2
- ELSE
- ydpti=ylptmp1
- END IF
- END IF
- END SUBROUTINE interm_pt
-
-END PROGRAM cdftransportizpm
diff --git a/cdftrp_bathy.f90 b/cdftrp_bathy.f90
deleted file mode 100644
index cadaf36..0000000
--- a/cdftrp_bathy.f90
+++ /dev/null
@@ -1,153 +0,0 @@
-PROGRAM cdftrp_bathy
- !!-------------------------------------------------------------------
- !! PROGRAM cdftrp_bathy
- !! ********************
- !!
- !! ** Purpose: Compute vertically integrated transport components,
- !! along bathymetry( horizontal) and across bathy
- !!
- !! ** Method: Use output from cdfvtrp
- !!
- !! history:
- !! Original: P. Mathiot 2008.
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: ji,jj, jim1,jip1,jjm1,jjp1
- INTEGER :: narg, iargc !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER, DIMENSION(:),ALLOCATABLE :: ipk, id_varout
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: zu, zv, u, v, vmod, hdept
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: e1u, e2v, dhdx, dhdy, alpha, tmask
- REAL(KIND=4) ,DIMENSION(1) :: timean
-
- CHARACTER(LEN=256) :: cfile ,cfilev, cfilew, cfilet, cfileout='trpiso.nc' !: file name
-
- INTEGER :: ncout
- INTEGER :: ierr
-
- !! Read command line
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdftrp_bathy trp.nc (build with cdfvtrp)'
- PRINT *,' need mask.nc, mesh_hgr.nc and hdept.nc in the current directory '
- PRINT *,' (*) hdept.nc is a file with only hdept (2D) variable extracted from'
- PRINT *,' mesh_zgr.nc. It can be a lonk to mesh_zgr'
- STOP
- ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
- CALL getarg (1, cfile)
-
- ALLOCATE ( ipk(2), id_varout(2), typvar(2) )
-
- npiglo = getdim (cfile,'x')
- npjglo = getdim (cfile,'y')
- npk = getdim (cfile,'depth')
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( zu(npiglo,npjglo), zv(npiglo,npjglo) )
- ALLOCATE( u(npiglo,npjglo), v(npiglo,npjglo) )
- ALLOCATE( e1u(npiglo,npjglo), e2v(npiglo,npjglo), hdept(npiglo,npjglo), tmask(npiglo,npjglo))
- ALLOCATE( dhdy(npiglo,npjglo), dhdx(npiglo,npjglo), alpha(npiglo,npjglo) )
-
- ipk(1) = npk
- typvar(1)%name='soualz'
- typvar(1)%units='m3/s'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -10000000.
- typvar(1)%valid_max= 10000000.
- typvar(1)%long_name='Transport at T point along isodepth'
- typvar(1)%short_name='soualz'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
-
- ipk(2) = npk
- typvar(2)%name='sovacz'
- typvar(2)%units='m3/s'
- typvar(2)%missing_value=0.
- typvar(2)%valid_min= -10000000.
- typvar(2)%valid_max= 10000000.
- typvar(2)%long_name='Transport at T point across isodepth'
- typvar(2)%short_name='sovacz'
- typvar(2)%online_operation='N/A'
- typvar(2)%axis='TYX'
-
- ncout =create(cfileout, cfile,npiglo,npjglo,1)
- ierr= createvar(ncout ,typvar,2, ipk,id_varout )
- ierr= putheadervar(ncout, cfile, npiglo, npjglo,1)
-
- zu(:,:) = getvar(cfile,'sozoutrp',1 ,npiglo, npjglo)
- zv(:,:) = getvar(cfile,'somevtrp',1 ,npiglo, npjglo)
-
- ! put velocity components on T points
- u(:,:) = 0. ; v(:,:)=0
- DO ji=1, npiglo
- DO jj=1,npjglo
- jjm1=jj-1
- jim1=ji-1
- IF (jj-1 == 0 ) jjm1=npjglo
- IF (ji-1 == 0 ) jim1=npiglo
- u(ji,jj) = 0.5* (zu(ji,jj)+ zu(jim1,jj))
- v(ji,jj) = 0.5* (zv(ji,jj)+ zv(ji,jjm1))
- END DO
- END DO
-
- tmask(:,:) = getvar('mask.nc','tmask',1 ,npiglo, npjglo)
- hdept(:,:) = getvar('hdept.nc','hdept',1 ,npiglo, npjglo)
- e1u(:,:) = getvar('mesh_hgr.nc','e1u',1 ,npiglo, npjglo)
- e2v(:,:) = getvar('mesh_hgr.nc','e2v',1 ,npiglo, npjglo)
- PRINT *, '',MAXVAL(hdept)
- hdept=hdept*tmask
-
- ! compute bathymetric gradient
- DO jj = 1, npjglo
- DO ji = 1, npiglo
- jjm1=jj-1
- jim1=ji-1
- jjp1=jj+1
- jip1=ji+1
- IF (jj-1 == 0 ) jjm1=npjglo
- IF (ji-1 == 0 ) jim1=npiglo
- IF (jj+1 == npjglo) jjp1=1
- IF (ji+1 == npiglo) jip1=1
- dhdx(ji,jj)=(hdept(jip1,jj )-hdept(jim1,jj ))/(e1u(ji,jj) +e1u(jim1,jj ))*tmask(ji,jj)
- dhdy(ji,jj)=(hdept(ji ,jjp1)-hdept(ji ,jjm1))/(e2v(ji,jj) +e2v(ji ,jjm1))*tmask(ji,jj)
- END DO
- END DO
-
- ! Compute the angle between the bathymetric slope and model coordinates.
- zv=v*tmask
- zu=u*tmask
-
- alpha=ATAN2(dhdy,dhdx)*tmask!*180/3.14159*tmask
-
- u=(zu*COS(alpha)+zv*SIN(alpha))*tmask ! transport accross isoline (oriented from shelf to abyssal plain)
- v=-(-zu*SIN(alpha)+zv*COS(alpha))*tmask ! transport along isoline (oriented at right of u
- PRINT *, 'iso : ',MAXVAL(SQRT(u**2+v**2)), MAXVAL(u), MAXVAL(v)
- PRINT *, 'normal : ',MAXVAL(SQRT(zu**2+zv**2)), MAXVAL(zu), MAXVAL(zv)
- ierr=putvar(ncout,id_varout(1), REAL(v), 1, npiglo, npjglo)
- ierr=putvar(ncout,id_varout(2), REAL(u), 1, npiglo, npjglo)
- PRINT *, ' SUM DRAKE : ', SUM(SQRT(u(437,51:118)**2))
- PRINT *, ' SUM DRAKE : ', SUM(SQRT(v(437,51:118)**2))
-
- PRINT *, ' SUM DRAKE : ', SUM(SQRT(u(443,68:118)**2))
- PRINT *, ' SUM DRAKE : ', SUM(SQRT(v(443,68:118)**2))
-
- timean = getvar1d(cfile,'time_counter',1)
- ierr = putvar1d(ncout,timean,1,'T')
- ierr = closeout(ncout)
-
-END PROGRAM cdftrp_bathy
diff --git a/cdftrp_gaelle.f90 b/cdftrp_gaelle.f90
deleted file mode 100644
index 11c01a6..0000000
--- a/cdftrp_gaelle.f90
+++ /dev/null
@@ -1,364 +0,0 @@
-PROGRAM cdfsigtrp
- !!---------------------------------------------------------------------
- !! *** PROGRAM cdfsigtrp ***
- !!
- !! ** Purpose: Compute density class Mass Transports across a section
- !! PARTIAL STEPS version
- !!
- !! ** Method:
- !! -The begining and end point of the section are given in term of f-points index.
- !! -The program works for zonal or meridional sections.
- !! -The section definitions are given in an ASCII FILE dens_section.dat
- !! foreach sections, 2 lines : (i) : section name (String, no blank)
- !! (ii) : imin imax jmin jmax for the section
- !! -Only vertical slices corrsponding to the sections are read in the files.
- !! read metrics, depth, etc
- !! read normal velocity (either vozocrtx oy vomecrty )
- !! read 2 rows of T and S ( i i+1 or j j+1 )
- !! compute the mean value at velocity point
- !! compute sigma0 (can be easily modified for sigmai )
- !! compute the depths of isopyncal surfaces
- !! compute the transport from surface to the isopycn
- !! compute the transport in each class of density
- !! compute the total transport (for information)
- !!
- !! history :
- !! Original : J.M. Molines March 2006
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
- USE eos
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: nbins !: number of density classes
- INTEGER :: ji, jk, jclass, jsec,jiso , jbin,jarg !: dummy loop index
- INTEGER :: ipos !: working variable
- INTEGER :: narg, iargc, nxtarg !: command line
- INTEGER :: npk, nk !: vertical size, number of wet layers in the section
- INTEGER :: numbimg=10 !: optional bimg logical unit
- INTEGER :: numout=11 !: ascii output
-
- INTEGER :: nsection !: number of sections (overall)
- INTEGER ,DIMENSION(100) :: imina, imaxa, jmina, jmaxa !: sections limits
- INTEGER :: imin, imax, jmin, jmax !: working section limits
- INTEGER :: npts !: working section number of h-points
-
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdept, gdepw !: depth of T and W points
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zs, zt !: salinity and temperature from file
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: tmpm, tmpz !: temporary arrays
-
- ! double precision for cumulative variables and densities
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: eu !: either e1v or e2u
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zu, e3 , zmask !: velocities e3 and umask
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zsig ,gdepu !: density, depth of vel points
- REAL(KIND=8) :: sigma_min, sigma_max,dsigma !: Min and Max for sigma bining
- REAL(KIND=8) :: sigma,zalfa !: current working sigma
- REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: sigma_lev !: built array with sigma levels
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: hiso !: depth of isopycns
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwtrp,zwtrpp, zwtrpm,zwtrpbin, trpbin!: transport arrays
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwtrpsum, zwtrpsump, zwtrpsumm,heightvein
- INTEGER, DIMENSION (:), ALLOCATABLE :: zxxx
-
- CHARACTER(LEN=256), DIMENSION (100) :: csection !: section name
- CHARACTER(LEN=256) :: cfilet, cfileu, cfilev, cfilesec='dens_section.dat' !: files name
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc' !: coordinates files
- CHARACTER(LEN=256) :: cfilout='trpsig.txt' !: output file
- CHARACTER(LEN=256) :: cdum !: dummy string
-
- LOGICAL :: l_merid !: flag is true for meridional working section
- LOGICAL :: l_print=.FALSE. !: flag for printing additional results
- LOGICAL :: l_bimg=.FALSE. !: flag for bimg output
-
- !! * Initialisations
-
- ! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg < 3 ) THEN
- PRINT *,' Usage : cdfsigtrp gridTfile gridUfile gridVfile sigma_min sigma_max nbins [options]'
- PRINT *,' sigma_min, sigma_max : limit for density bining '
- PRINT *,' nbins : number of bins to use '
- PRINT *,' Possible options :'
- PRINT *,' -print :additional output is send to std output'
- PRINT *,' -bimg : 2D (x=lat/lon, y=sigma) output on bimg file for hiso, cumul trp, trp'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc must be in the current directory'
- PRINT *,' File section.dat must also be in the current directory '
- PRINT *,' Output on trpsig.txt'
- STOP
- ENDIF
-
- !! Read arguments
- CALL getarg (1, cfilet)
- CALL getarg (2, cfileu)
- CALL getarg (3, cfilev)
-
-
- DO jarg=7, narg
- CALL getarg(jarg,cdum)
- SELECT CASE (cdum)
- CASE ('-print' )
- l_print = .TRUE.
- CASE ('-bimg')
- l_bimg = .TRUE.
- CASE DEFAULT
- PRINT *,' Unknown option ', TRIM(cdum),' ... ignored'
- END SELECT
- END DO
-
-
- ! Initialise sections from file
- CALL section_init(cfilesec, csection,imina,imaxa,jmina,jmaxa, nsection)
-
- npk = getdim (cfilet,'depth')
-
- ALLOCATE ( gdept(npk), gdepw(npk) )
- ALLOCATE ( zwtrpsum (nsection, 1), zwtrpsump (nsection, 1), zwtrpsumm (nsection, 1) )
- ALLOCATE ( heightvein(nsection, 1))
- ! read gdept, gdepw : it is OK even in partial cells, as we never use the bottom gdep
- gdept(:) = getvare3(coordzgr,'gdept',npk)
- gdepw(:) = getvare3(coordzgr,'gdepw',npk)
- print *, 'gdept', gdept
-
-
- !! * Main loop on sections
-PRINT*,'ok'
-
- DO jsec=1,nsection
- l_merid=.FALSE.
- imin=imina(jsec) ; imax=imaxa(jsec) ; jmin=jmina(jsec) ; jmax=jmaxa(jsec)
- IF (imin == imax ) THEN ! meridional section
- l_merid=.TRUE.
- npts=jmax-jmin
-
- ELSE IF ( jmin == jmax ) THEN ! zonal section
- npts=imax-imin
- PRINT *,' Section ',TRIM(csection(jsec)),' is zonal',npts,imin,imax,jmin,jmax
- ELSE
- PRINT *,' Section ',TRIM(csection(jsec)),' is neither zonal nor meridional :('
- PRINT *,' We skip this section .'
- CYCLE
- ENDIF
-
-
-
-!gh
- nbins=0
-
- print *,' allocate deb'
- ALLOCATE ( zu(npts, npk), zt(npts,npk), zs(npts,npk) ,zsig(npts,0:npk) )
- ALLOCATE ( eu(npts), e3(npts,npk), gdepu(npts, npk), zmask(npts,npk) )
- ALLOCATE ( tmpm(1,npts,2), tmpz(npts,1,2) )
- ALLOCATE ( zwtrp(npts, nbins+1) , zwtrpp(npts,nbins+1), zwtrpm(npts,nbins+1) )
-! ALLOCATE ( zxxx(npts+npk+1) )
- ALLOCATE ( zxxx(2) )
- print *,' allocate fin'
-
- zt = 0. ; zs = 0. ; zu = 0. ; gdepu= 0. ; zmask = 0. ; zsig=0.d0
- print *,' allocate raz'
-
- IF (l_merid ) THEN ! meridional section at i=imin=imax
- tmpm(:,:,1)=getvar(coordhgr, 'e2u', 1,1,npts, kimin=imin, kjmin=jmin+1)
- eu(:)=tmpm(1,:,1) ! metrics varies only horizontally
- DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (PS case)
- tmpm(:,:,1)=getvar(coordzgr,'e3u_ps',jk,1,npts, kimin=imin, kjmin=jmin+1, ldiom=.true.)
- e3(:,jk)=tmpm(1,:,1)
- tmpm(:,:,1)=getvar(coordzgr,'e3w_ps',jk,1,npts, kimin=imin, kjmin=jmin+1, ldiom=.true.)
- tmpm(:,:,2)=getvar(coordzgr,'e3w_ps',jk,1,npts, kimin=imin+1, kjmin=jmin+1, ldiom=.true.)
- IF (jk >= 2 ) THEN
- DO ji=1,npts
- gdepu(ji,jk)= gdepu(ji,jk-1) + MIN(tmpm(1,ji,1), tmpm(1,ji,2))
- END DO
- ENDIF
-
- ! Normal velocity
- tmpm(:,:,1)=getvar(cfileu,'vozocrtx',jk,1,npts, kimin=imin, kjmin=jmin+1)
- zu(:,jk)=tmpm(1,:,1)
-
- ! salinity and deduce umask for the section
- tmpm(:,:,1)=getvar(cfilet,'vosaline',jk,1,npts, kimin=imin , kjmin=jmin+1)
- tmpm(:,:,2)=getvar(cfilet,'vosaline',jk,1,npts, kimin=imin+1, kjmin=jmin+1)
- zmask(:,jk)=tmpm(1,:,1)*tmpm(1,:,2)
- WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
- ! do not take special care for land value, as the corresponding velocity point is masked
- zs(:,jk) = 0.5 * ( tmpm(1,:,1) + tmpm(1,:,2) )
-
- ! limitation to 'wet' points
- IF ( SUM(zs(:,jk)) == 0 ) THEN
- nk=jk ! first vertical point of the section full on land
- EXIT ! as soon as all the points are on land
- ENDIF
-
- END DO
-
- ELSE ! zonal section at j=jmin=jmax
- tmpz(:,:,1)=getvar(coordhgr, 'e1v', 1,npts,1,kimin=imin, kjmin=jmin)
- eu=tmpz(:,1,1)
- DO jk=1,npk
- ! initiliaze gdepu to gdept()
- gdepu(:,jk) = gdept(jk)
-
- ! vertical metrics (PS case)
- tmpz(:,:,1)=getvar(coordzgr,'e3v_ps',jk, npts, 1, kimin=imin+1, kjmin=jmin, ldiom=.true.)
- e3(:,jk)=tmpz(:,1,1)
- tmpz(:,:,1)=getvar(coordzgr,'e3w_ps',jk,npts,1, kimin=imin+1, kjmin=jmin, ldiom=.true.)
- tmpz(:,:,2)=getvar(coordzgr,'e3w_ps',jk,npts,1, kimin=imin+1, kjmin=jmin+1, ldiom=.true.)
- IF (jk >= 2 ) THEN
- DO ji=1,npts
- gdepu(ji,jk)= gdepu(ji,jk-1) + MIN(tmpz(ji,1,1), tmpz(ji,1,2))
- END DO
- ENDIF
-
- ! Normal velocity
- tmpz(:,:,1)=getvar(cfilev,'vomecrty',jk,npts,1, kimin=imin+1, kjmin=jmin)
- zu(:,jk)=tmpz(:,1,1)
-
- ! salinity and mask
- tmpz(:,:,1)=getvar(cfilet,'vosaline',jk, npts, 1, kimin=imin+1, kjmin=jmin)
- tmpz(:,:,2)=getvar(cfilet,'vosaline',jk, npts, 1, kimin=imin+1, kjmin=jmin+1)
- zmask(:,jk)=tmpz(:,1,1)*tmpz(:,1,2)
- WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
- ! do not take special care for land value, as the corresponding velocity point is masked
- zs(:,jk) = 0.5 * ( tmpz(:,1,1) + tmpz(:,1,2) )
-
- ! limitation to 'wet' points
- IF ( SUM(zs(:,jk)) == 0 ) THEN
- nk=jk ! first vertical point of the section full on land
- EXIT ! as soon as all the points are on land
- ENDIF
-
- END DO
-
- ENDIF
- print *,' lecture done '
-
- zxxx=MINLOC(zu)
- print *,'zxxx', zxxx, jsec
- heightvein(jsec,1)=gdept(zxxx(2))
-
- ! compute transport between surface and isopycn
- IF (l_print) PRINT *,' TRP SURF --> ISO (SV)'
- DO jiso = 1, nbins + 1
- DO ji=1,npts
- print *,'debut de raz', ji, nbins, jiso, npts
- zwtrp (ji,jiso) = 0.d0
- zwtrpp(ji,jiso) = 0.d0
- zwtrpm(ji,jiso) = 0.d0
- print *,'debut de bcle jk'
- DO jk=1, nk
- zwtrp(ji,jiso)= zwtrp(ji,jiso) + eu(ji)*e3(ji,jk)*zu(ji,jk)
- IF ( zu(ji,jk) >= 0 ) THEN
- zwtrpp(ji,jiso)= zwtrpp(ji,jiso) + eu(ji)*e3(ji,jk)*zu(ji,jk)
- ELSE
- zwtrpm(ji,jiso)= zwtrpm(ji,jiso) + eu(ji)*e3(ji,jk)*zu(ji,jk)
- ENDIF
-
- END DO
- print *,'fin de bcle jk'
- END DO
-
- zwtrpsum (jsec,1)= SUM( zwtrp (:,jiso) )/1.e6
- zwtrpsump(jsec,1)= SUM( zwtrpp(:,jiso) )/1.e6
- zwtrpsumm(jsec,1)= SUM( zwtrpm(:,jiso) )/1.e6
- END DO
- ! free memory for the next section
- print *,' dealloc '
- DEALLOCATE ( zu,zt, zs ,zsig ,gdepu)
- DEALLOCATE ( eu, e3 ,tmpm, tmpz,zmask )
- DEALLOCATE ( zwtrp ,zwtrpp,zwtrpm ,zxxx)
- print *,' dealloc done '
-
- END DO ! next section
-
- PRINT*,'ok end'
- !! Global Output
-PRINT*,numout,cfilout
- WRITE(1,9006) TRIM(cfilet(1:ipos-1))
- PRINT*,'ok'
- WRITE(1,9008) ' Section : ', ' transport ',' transport v<0 :',' transport v<0 :',' vein height '
- PRINT*,'ok'
- DO jsec=1,nsection
- WRITE(1,9007) csection(jsec),zwtrpsum (jsec,1),zwtrpsump (jsec,1),zwtrpsumm (jsec,1),heightvein(jsec,1)
- ENDDO
-
- OPEN( numout, FILE=cfilout )
- PRINT*,'ok'
- ipos=INDEX(cfilet,'_gridT.nc')
- PRINT*,'ok'
- WRITE(numout,9006) TRIM(cfilet(1:ipos-1))
- PRINT*,'ok'
- WRITE(numout,9008) ' Section : ', ' transport ',' transport v<0 :',' transport v<0 :',' vein height '
- PRINT*,'ok'
- DO jsec=1,nsection
- WRITE(numout,9007) csection(jsec),zwtrpsum (jsec,1),zwtrpsump (jsec,1),zwtrpsumm (jsec,1),heightvein(jsec,1)
- ! WRITE(numout,9004)' transport ', (zwtrpsum (jsec,1),jsec=1,nsection)
- ! WRITE(numout,9004)' transport v<0 ', (zwtrpsump (jsec,1),jsec=1,nsection)
- ! WRITE(numout,9004)' transport v>0 ', (zwtrpsumm (jsec,1),jsec=1,nsection)
- ! WRITE(numout,9004)' vein height ', (heightvein(jsec,1),jsec=1,nsection)
- ENDDO
- CLOSE( numout )
-
- PRINT*,'ok'
-
-9000 FORMAT(i7,25f8.3)
-9001 FORMAT(i7,25f8.0)
-9002 FORMAT(f7.3,25f8.0)
-9003 FORMAT(f7.3,25f8.3)
-!9004 FORMAT(a15,e16.7)
-9004 FORMAT('#',a15, 20(2x,e16.7,2x))
-9005 FORMAT('#',a15, 20(2x,a12,2x) )
-9006 FORMAT('# ',a)
-9007 FORMAT('#',a8, 4(2x,e16.7,2x))
-9008 FORMAT('#',a8, 4(2x,a15,2x) )
-
-CONTAINS
- SUBROUTINE section_init(cdfile,cdsection,kimin,kimax,kjmin,kjmax,knumber)
- IMPLICIT NONE
- ! Arguments
- INTEGER, DIMENSION(100) :: kimin,kimax, kjmin,kjmax
- INTEGER, INTENT(OUT) :: knumber
- CHARACTER(LEN=256), DIMENSION(100) :: cdsection
- CHARACTER(LEN=*), INTENT(IN) :: cdfile
-
- ! Local variables
- INTEGER :: ii, numit=10, jsec
- CHARACTER(LEN=256) :: cline
-
- OPEN(numit, FILE=cdfile)
- ii=0
-
- DO
- READ(numit,'(a)') cline
- IF (INDEX(cline,'EOF') == 0 ) THEN
- READ(numit,*) ! skip one line
- ii = ii + 1
- ELSE
- EXIT
- ENDIF
- END DO
-
- knumber=ii
- IF ( knumber > 100 ) THEN
- PRINT *,' ERROR : no more than 100 sections are allowed'
- STOP
- ENDIF
- REWIND(numit)
- DO jsec=1,knumber
- READ(numit,'(a)') cdsection(jsec)
- READ(numit,*) kimin(jsec), kimax(jsec), kjmin(jsec), kjmax(jsec)
- END DO
-
- CLOSE(numit)
-
- END SUBROUTINE section_init
-
-
-END PROGRAM cdfsigtrp
diff --git a/cdfvT.f90 b/cdfvT.f90
index 11ef831..5aada21 100644
--- a/cdfvT.f90
+++ b/cdfvT.f90
@@ -1,190 +1,160 @@
PROGRAM cdfvT
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfvT ***
+ !!======================================================================
+ !! *** PROGRAM cdfvT ***
+ !!=====================================================================
+ !! ** Purpose : Compute the average values for the products
+ !! V.T, V.S, U.T and U.S, used afterward for heat and
+ !! salt transport.
!!
- !! ** Purpose:
- !!
- !! ** Method: Try to avoid 3 d arrays
- !! Assume that all input files have the same number of time frames
+ !! ** Method : pass the CONFIG name and a series of tags as arguments.
!!
- !! history :
- !! Original : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (apr 2005 ) : use of modules
- !! J.M. Molines (Feb. 2010 ): handle multiframes input files.
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2004 : J.M. Molines : Original code
+ !! 2.1 : 02/2010 : J.M. Molines : handle multiframes input files.
+ !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ USE modutils ! SetFileName function
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk,jt ,jkk,jtt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc
- INTEGER :: npiglo,npjglo, npk, nt !: size of the domain
- INTEGER :: ntframe !: Cumul of time frame
-
- INTEGER, DIMENSION(4) :: ipk, id_varout
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: zcumulut, zcumulus !: Arrays for cumulated values
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: zcumulvt, zcumulvs !: Arrays for cumulated values
- REAL(KIND=8) :: total_time
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal ,& !: Array to read a layer of data
- & zvitu, zvitv, &
- & zworku, zworkv, &
- & rmean
- REAL(KIND=4),DIMENSION(1) :: timean
- REAL(KIND=4),DIMENSION(:),ALLOCATABLE :: tim
-
- CHARACTER(LEN=256) :: cfilet,cfileu,cfilev ,cfileout='vt.nc', config , ctag !:
- TYPE (variable), DIMENSION(4) :: typvar !: structure for attributes
- LOGICAL :: lexist !: to inquire existence of files
-
- INTEGER :: ncout
- INTEGER :: istatus
- LOGICAL :: lcaltmean
+
+ INTEGER(KIND=4) :: ji, jj, jk, jt, jtt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: npiglo,npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ntframe ! Cumul of time frame
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(4) :: ipk, id_varout ! level and varid's of output vars
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp, zsal ! Array to read a layer of data
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, zv ! Velocity component
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zworku, zworkv ! working arrays
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmean ! temporary mean value for netcdf write
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter of individual files
+ REAL(KIND=4), DIMENSION(1) :: timean ! mean time
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulut, dcumulus ! Arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulvt, dcumulvs ! Arrays for cumulated values
+ REAL(KIND=8) :: dtotal_time ! cumulated time
+
+ CHARACTER(LEN=256) :: cf_tfil ! TS file name
+ CHARACTER(LEN=256) :: cf_ufil ! zonal velocity file
+ CHARACTER(LEN=256) :: cf_vfil ! meridional velocity file
+ CHARACTER(LEN=256) :: cf_out='vt.nc' ! output file
+ CHARACTER(LEN=256) :: config ! configuration name
+ CHARACTER(LEN=256) :: ctag ! current tag to work with
+
+ TYPE (variable), DIMENSION(4) :: stypvar ! structure for attributes
+
+ LOGICAL :: lcaltmean ! flag for mean time computation
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
!! Read command line
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfvT CONFIG ''list_of_tags'' '
- PRINT *,' CONFIG is the CONFIG name (eg: ORCA025-G32 ) '
- PRINT *,' list_of_tags is the list of the time tags (y....m.. d..)'
- PRINT *,' on which the mean values of UT, US, VT, VS are computes'
- PRINT *,' Output on vt.nc variables vozout, vozous, vomevt, vomevs '
+ PRINT *,' usage : cdfvT CONFIG ''list_of_tags'' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the time average values for second order products '
+ PRINT *,' V.T, V.S, U.T and U.S used in heat and salt transport computation.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' CONFIG is the config name of a given experiment (eg ORCA025-G70)'
+ PRINT *,' The program will look for gridT, gridU and gridV files for'
+ PRINT *,' this config ( grid_T, grid_U and grid_V are also accepted).'
+ PRINT *,' list_of_tags : a list of time tags that will be used for time'
+ PRINT *,' averaging. e.g. y2000m01d05 y2000m01d10 ...'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ',TRIM(cn_vozout),', ',TRIM(cn_vozous),', ',TRIM(cn_vomevt),' and ',TRIM(cn_vomevs)
STOP
ENDIF
- !!
!! Initialisation from 1st file (all file are assume to have the same geometry)
CALL getarg (1, config)
- CALL getarg (2, ctag)
- WRITE(cfilet,'(a,"_",a,"_gridT.nc")') TRIM(config),TRIM(ctag)
- INQUIRE(FILE=cfilet,EXIST=lexist)
- IF ( .NOT. lexist ) THEN
- WRITE(cfilet,'(a,"_",a,"_grid_T.nc")') TRIM(config),TRIM(ctag)
- INQUIRE(FILE=cfilet,EXIST=lexist)
- IF ( .NOT. lexist ) THEN
- PRINT *,' ERROR : missing gridT or even grid_T file '
- STOP
- ENDIF
- ENDIF
+ CALL getarg (2, ctag )
+
+ cf_tfil = SetFileName( config, ctag, 'T')
- PRINT *,TRIM(cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
ipk(:)= npk ! all variables (input and output are 3D)
! define output variables
- typvar(1)%name= 'vomevt'
- typvar(2)%name= 'vomevs'
- typvar(3)%name= 'vozout'
- typvar(4)%name= 'vozous'
-
- typvar(1)%units='m.DegC.s-1'
- typvar(2)%units='m.PSU.s-1'
- typvar(3)%units='m.DegC.s-1'
- typvar(4)%units='m.PSU.s-1'
-
- typvar%missing_value=0.
- typvar%valid_min= -100.
- typvar%valid_max= 100.
-
- typvar(1)%long_name='Meridional_VT'
- typvar(2)%long_name='Meridional_VS'
- typvar(3)%long_name='Zonal_UT'
- typvar(4)%long_name='Zonal_US'
-
- typvar(1)%short_name='vomevt'
- typvar(2)%short_name='vomevs'
- typvar(3)%short_name='vozout'
- typvar(4)%short_name='vozous'
-
- typvar%online_operation='N/A'
- typvar%axis='TZYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( zcumulut(npiglo,npjglo), zcumulus(npiglo,npjglo) )
- ALLOCATE( zcumulvt(npiglo,npjglo), zcumulvs(npiglo,npjglo) )
- ALLOCATE( zvitu(npiglo,npjglo),zvitv(npiglo,npjglo) )
- ALLOCATE( zworku(npiglo,npjglo),zworkv(npiglo,npjglo) )
- ALLOCATE( ztemp(npiglo,npjglo) ,zsal(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo))
-
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = -100.
+ stypvar%valid_max = 100.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TZYX'
+
+ stypvar(1)%cname = cn_vomevt ; stypvar(1)%cunits = 'm.DegC.s-1'
+ stypvar(2)%cname = cn_vomevs ; stypvar(2)%cunits = 'm.PSU.s-1'
+ stypvar(3)%cname = cn_vozout ; stypvar(3)%cunits = 'm.DegC.s-1'
+ stypvar(4)%cname = cn_vozous ; stypvar(4)%cunits = 'm.PSU.s-1'
+
+ stypvar(1)%clong_name = 'Meridional_VT' ; stypvar(1)%cshort_name = cn_vomevt
+ stypvar(2)%clong_name = 'Meridional_VS' ; stypvar(2)%cshort_name = cn_vomevs
+ stypvar(3)%clong_name = 'Zonal_UT' ; stypvar(3)%cshort_name = cn_vozout
+ stypvar(4)%clong_name = 'Zonal_US' ; stypvar(4)%cshort_name = cn_vozous
+
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npk =', npk
+
+ ALLOCATE( dcumulut(npiglo,npjglo), dcumulus(npiglo,npjglo) )
+ ALLOCATE( dcumulvt(npiglo,npjglo), dcumulvs(npiglo,npjglo) )
+ ALLOCATE( zu(npiglo,npjglo), zv(npiglo,npjglo) )
+ ALLOCATE( zworku(npiglo,npjglo), zworkv(npiglo,npjglo) )
+ ALLOCATE( ztemp(npiglo,npjglo), zsal(npiglo,npjglo) )
+ ALLOCATE( zmean(npiglo,npjglo))
! create output fileset
-
- ncout =create(cfileout, cfilet, npiglo,npjglo,npk)
-
- ierr= createvar(ncout ,typvar,4, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo, npk )
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, npk )
+ ierr = createvar (ncout , stypvar, 4, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, npk )
lcaltmean=.TRUE.
DO jk = 1, npk
PRINT *,'level ',jk
- zcumulut(:,:) = 0.d0 ; zcumulvt(:,:) = 0.d0 ; total_time = 0.
- zcumulus(:,:) = 0.d0 ; zcumulvs(:,:) = 0.d0 ; ntframe = 0
+ dcumulut(:,:) = 0.d0 ; dcumulvt(:,:) = 0.d0 ; dtotal_time = 0.d0
+ dcumulus(:,:) = 0.d0 ; dcumulvs(:,:) = 0.d0 ; ntframe = 0
- DO jt = 2, narg
+ DO jt = 2, narg ! loop on tags
CALL getarg (jt, ctag)
- WRITE(cfilet,'(a,"_",a,"_gridT.nc")') TRIM(config),TRIM(ctag)
- INQUIRE(FILE=cfilet,EXIST=lexist)
- IF ( .NOT. lexist ) THEN
- WRITE(cfilet,'(a,"_",a,"_grid_T.nc")') TRIM(config),TRIM(ctag)
- INQUIRE(FILE=cfilet,EXIST=lexist)
- IF ( .NOT. lexist ) THEN
- PRINT *,' ERROR : missing gridT or even grid_T file '
- STOP
- ENDIF
- ENDIF
- nt=getdim (cfilet,'time_counter')
- IF ( lcaltmean ) THEN
- ALLOCATE (tim(nt) )
- tim=getvar1d(cfilet,'time_counter',nt)
- total_time = total_time + SUM(tim(1:nt) )
- DEALLOCATE(tim)
+ cf_tfil = SetFileName( config, ctag, 'T' )
+
+ npt = getdim (cf_tfil, cn_t)
+ IF ( lcaltmean ) THEN
+ ALLOCATE ( tim(npt) )
+ tim = getvar1d(cf_tfil, cn_vtimec, npt)
+ dtotal_time = dtotal_time + SUM(tim(1:npt) )
+ DEALLOCATE( tim )
END IF
! assume U and V file have same time span ...
- WRITE(cfileu,'(a,"_",a,"_gridU.nc")') TRIM(config),TRIM(ctag)
- INQUIRE(FILE=cfileu,EXIST=lexist)
- IF ( .NOT. lexist ) THEN
- WRITE(cfileu,'(a,"_",a,"_grid_U.nc")') TRIM(config),TRIM(ctag)
- INQUIRE(FILE=cfileu,EXIST=lexist)
- IF ( .NOT. lexist ) THEN
- PRINT *,' ERROR : missing gridU or even grid_U file '
- STOP
- ENDIF
- ENDIF
-
- WRITE(cfilev,'(a,"_",a,"_gridV.nc")') TRIM(config),TRIM(ctag)
- INQUIRE(FILE=cfilev,EXIST=lexist)
- IF ( .NOT. lexist ) THEN
- WRITE(cfilev,'(a,"_",a,"_grid_V.nc")') TRIM(config),TRIM(ctag)
- INQUIRE(FILE=cfilev,EXIST=lexist)
- IF ( .NOT. lexist ) THEN
- PRINT *,' ERROR : missing gridV or even grid_V file '
- STOP
- ENDIF
- ENDIF
-
- DO jtt=1,nt
- ntframe=ntframe+1
- jkk=jk
- zvitu(:,:)= getvar(cfileu, 'vozocrtx' , jkk ,npiglo, npjglo, ktime=jtt )
- zvitv(:,:)= getvar(cfilev, 'vomecrty' , jkk ,npiglo, npjglo, ktime=jtt )
- ztemp(:,:)= getvar(cfilet, 'votemper', jkk ,npiglo, npjglo, ktime=jtt )
- zsal(:,:) = getvar(cfilet, 'vosaline', jkk ,npiglo, npjglo, ktime=jtt )
-
- ! temperature
+ cf_ufil = SetFileName( config, ctag, 'U' )
+ cf_vfil = SetFileName( config, ctag, 'V' )
+
+ DO jtt = 1, npt ! loop on time frame in a single file
+ ntframe = ntframe+1
+ zu(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jtt )
+ zv(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jtt )
+ ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jtt )
+ zsal(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jtt )
+
+ ! temperature at u point, v points
zworku(:,:) = 0. ; zworkv(:,:) = 0.
DO ji=1, npiglo-1
DO jj = 1, npjglo -1
@@ -193,10 +163,10 @@ PROGRAM cdfvT
END DO
END DO
- zcumulut(:,:) = zcumulut(:,:) + zworku(:,:) * zvitu(:,:)
- zcumulvt(:,:) = zcumulvt(:,:) + zworkv(:,:) * zvitv(:,:)
+ dcumulut(:,:) = dcumulut(:,:) + zworku(:,:) * zu(:,:)*1.d0
+ dcumulvt(:,:) = dcumulvt(:,:) + zworkv(:,:) * zv(:,:)*1.d0
- ! salinity
+ ! salinity at u points, v points
zworku(:,:) = 0. ; zworkv(:,:) = 0.
DO ji=1, npiglo-1
DO jj = 1, npjglo -1
@@ -205,33 +175,32 @@ PROGRAM cdfvT
END DO
END DO
- zcumulus(:,:) = zcumulus(:,:) + zworku(:,:) * zvitu(:,:)
- zcumulvs(:,:) = zcumulvs(:,:) + zworkv(:,:) * zvitv(:,:)
+ dcumulus(:,:) = dcumulus(:,:) + zworku(:,:) * zu(:,:)*1.d0
+ dcumulvs(:,:) = dcumulvs(:,:) + zworkv(:,:) * zv(:,:)*1.d0
END DO !jtt
END DO ! jt
! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = zcumulvt(:,:)/ntframe
- ierr = putvar(ncout, id_varout(1) ,rmean, jk,npiglo, npjglo, kwght=ntframe )
+ zmean(:,:) = dcumulvt(:,:)/ntframe
+ ierr = putvar(ncout, id_varout(1), zmean, jk,npiglo, npjglo, kwght=ntframe )
- rmean(:,:) = zcumulvs(:,:)/ntframe
- ierr = putvar(ncout, id_varout(2) ,rmean, jk,npiglo, npjglo, kwght=ntframe )
+ zmean(:,:) = dcumulvs(:,:)/ntframe
+ ierr = putvar(ncout, id_varout(2), zmean, jk,npiglo, npjglo, kwght=ntframe )
- rmean(:,:) = zcumulut(:,:)/ntframe
- ierr = putvar(ncout, id_varout(3) ,rmean, jk,npiglo, npjglo, kwght=ntframe )
+ zmean(:,:) = dcumulut(:,:)/ntframe
+ ierr = putvar(ncout, id_varout(3), zmean, jk,npiglo, npjglo, kwght=ntframe )
- rmean(:,:) = zcumulus(:,:)/ntframe
- ierr = putvar(ncout, id_varout(4) ,rmean, jk,npiglo, npjglo, kwght=ntframe )
+ zmean(:,:) = dcumulus(:,:)/ntframe
+ ierr = putvar(ncout, id_varout(4), zmean, jk,npiglo, npjglo, kwght=ntframe )
IF (lcaltmean ) THEN
- timean(1)= total_time/ntframe
- ierr=putvar1d(ncout,timean,1,'T')
+ timean(1) = dtotal_time/ntframe
+ ierr = putvar1d(ncout, timean, 1, 'T')
END IF
lcaltmean=.FALSE. ! tmean already computed
-
END DO ! loop to next level
- istatus = closeout(ncout)
+ ierr = closeout(ncout)
END PROGRAM cdfvT
diff --git a/cdfvar.f90 b/cdfvar.f90
deleted file mode 100644
index 8142392..0000000
--- a/cdfvar.f90
+++ /dev/null
@@ -1,372 +0,0 @@
-PROGRAM cdfvar
- !!----------------------------------------------------------------------------
- !! *** PROGRAM cdfvar ***
- !!
- !! ** Purpose: Locally transform a data file .... ???
- !!
- !! ** Method: Use OPA9 routine to look for zps. Locally force the depth to give
- !! full depth. Save the modifs as source fortran code.
- !!
- !! ** Usage : cdfvar -f file -zoom imin imax jmin jmax
- !!
- !! History:
- !! 2007 : J-M Molines : Original
- !! 2008 : P. Mathiot : Adaptation from cdfbathy for any variable of a file
- !!
- !!----------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- ! * Module used
- USE cdfio
-
- ! * Local Variable
- IMPLICIT NONE
- !
- INTEGER :: numin,jk,ji,jj,jt,jl, jd, jarg
- INTEGER :: narg, iargc
- INTEGER :: imin, imax, jmin, jmax, klev, istatus, jtime
- INTEGER :: npiglo, npjglo, npk
- INTEGER, DIMENSION(:), ALLOCATABLE :: level
- INTEGER, DIMENSION (:,:), ALLOCATABLE :: mbathy, mask
- ! REAL(KIND=4) :: e3zps_min=25, e3zps_rat=0.2
- REAL(KIND=4) :: e3zps_min=1000, e3zps_rat=1, depmin=600.
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdept, gdepw, e3t, e3w
- !
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: h, rtime
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: bathyin,bathy, e3_bot
- !
- CHARACTER(LEN=256) :: cfilein, cline1, cline2, ctmp, cfileroot, creplace, cdump
- CHARACTER(LEN=256) :: cdim, cvar
-
- LOGICAL :: lexist=.TRUE., lfill=.FALSE., lfullstep=.FALSE., lappend=.FALSE., lreplace=.FALSE.
- LOGICAL :: ldump = .FALSE., lmodif=.FALSE., loverwrite=.false., lraz=.false., ldumpn=.false.
- INTEGER :: iversion=1, iostat, ipos
- !!
- !! 1. Initializations:
- !! -------------------
- !!
- narg = iargc()
- IF (narg == 0) THEN
- PRINT 9999,'USAGE :cdfvar -f file -var cdfvar'// &
- '-zoom imin imax jmin jmax klev jtime -fillzone -fullstep depmin'
- PRINT 9999,' -replace ''file'' -dumpzone ''file'' -a -o '
- PRINT 9999
- PRINT 9999, ' DESCRIPTION OF OPTIONS '
- PRINT 9999, ' ---------------------- '
- PRINT 9999, ' -file (or -f ) : name of var file '
- PRINT 9999, ' -var (or -v ) : name of variable used '
- PRINT 9999, ' -zoom (or -z ) : sub area of the var file to work with (imin imax jmin jmax klev jtime)'
- PRINT 9999, ' -fillzone (or -fz ) : sub area will be filled with 0 up to the first coast line '
- PRINT 9999, ' -raz_zone (or -raz ) : sub area will be filled with 0 up '
- PRINT 9999, ' -fullstep (or -fs ) : sub area will be reshaped as full-step, below depmin'
- PRINT 9999, ' requires the presence of the file zgr_bat.txt (from ocean.output, eg )'
- PRINT 9999, ' -dumpzone (or -d ): sub area will be output to an ascii file, which can be used by -replace'
- PRINT 9999, ' after manual editing '
- PRINT 9999, ' -nicedumpzone (or -nd ): sub area will be output to an ascii file (nice output)'
- PRINT 9999, ' -replace (or -r ) : sub area defined by the file will replace the original var'
- PRINT 9999, ' -append (or -a ) : fortran log file (log.f90) will be append with actual modif'
- PRINT 9999, ' Standard behaviour is to overwrite/create log file'
- PRINT 9999, ' -overwrite (or -o ): input var file will be used as output.'
- PRINT 9999, ' Standard behaviour is to use a work copy of the original file'
- PRINT 9999, ' (indexed from 01 to 99 if necessary ) '
- STOP
- END IF
-9999 FORMAT(a)
- ! Read command line
- jarg=1
- imin=-10 ; imax=-10 ; jmin=-10 ; jmax=-10
- DO WHILE (jarg <= narg)
- CALL getarg(jarg,cline1) ; jarg = jarg + 1
- IF (cline1 == '-file ' .OR. cline1 == '-f') THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- cfilein=cline2
- ELSE IF (cline1 == '-zoom' .OR. cline1 == '-z') THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) imin
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) imax
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) jmin
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) jmax
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) klev
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) jtime
- ELSE IF (cline1 == '-var' .OR. cline1 == '-v' ) THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- cvar=cline2
- ELSE IF (cline1 == '-fillzone' .OR. cline1 == '-fz' ) THEN
- lfill=.TRUE. ; lmodif=.TRUE.
- ELSE IF (cline1 == '-raz_zone' .OR. cline1 == '-raz' ) THEN
- lraz=.TRUE. ; lmodif=.TRUE.
- ELSE IF (cline1 == '-fullstep' .OR. cline1 == '-fs' ) THEN
- lfullstep=.TRUE. ; lmodif=.TRUE.
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) depmin
- ELSE IF (cline1 == '-append' .OR. cline1 == '-a' ) THEN
- lappend=.TRUE.
- ELSE IF (cline1 == '-overwrite' .OR. cline1 == '-o' ) THEN
- loverwrite=.TRUE.
- ELSE IF (cline1 == '-replace' .OR. cline1 == '-r') THEN
- lreplace=.TRUE. ; lmodif=.TRUE.
- CALL getarg(jarg,creplace) ; jarg = jarg +1
- ELSE IF (cline1 == '-dumpzone' .OR. cline1 == '-d') THEN
- ldump=.TRUE.
- CALL getarg(jarg,cdump) ; jarg = jarg +1
- ELSE IF (cline1 == '-nicedumpzone' .OR. cline1 == '-nd') THEN
- ldumpn=.TRUE.
- CALL getarg(jarg,cdump) ; jarg = jarg +1
- ELSE
- PRINT *, cline1,' : unknown option '
- STOP
- END IF
- END DO
-
- IF ( lmodif .AND. .NOT. loverwrite) THEN
- ipos=INDEX(cfilein,'.',.TRUE.)
- READ(cfilein(ipos+1:),*,IOSTAT=iostat) iversion
- IF (iostat /=0 ) THEN
- iversion=0
- cfileroot=cfilein
- ELSE
- cfileroot=cfilein(1:ipos-1)
- ENDIF
- iversion=iversion+1
-
- DO WHILE ( lexist )
- WRITE(ctmp,'(a,a,i2.2)') TRIM(cfileroot),'.',iversion
- INQUIRE(FILE=ctmp,EXIST=lexist)
- iversion=iversion+1
- END DO
- PRINT *, 'Working copy will be : ' ,TRIM(ctmp)
- CALL system(' cp -f '//cfilein//' '//ctmp )
- ELSE
- ctmp=cfilein
- ENDIF
- npiglo=getdim(ctmp,'x')
- npjglo=getdim(ctmp,'y')
- IF ( imin == -10 ) THEN ! no zoom option passed
- imin=1 ; imax=npiglo
- jmin=1 ; jmax=npjglo
- END IF
- PRINT *, 'NPIGLO = ', npiglo
- PRINT *, 'NPJGLO = ', npjglo
- PRINT *, 'IMIN IMAX JMIN JMAX :', imin, imax,jmin,jmax
-
- ALLOCATE (mbathy(npiglo,npjglo), bathy(npiglo,npjglo),bathyin(npiglo,npjglo),e3_bot(npiglo,npjglo))
- ALLOCATE (mask(npiglo,npjglo))
- mask = 0
- bathy(:,:)=getvar(ctmp,cvar,klev, npiglo, npjglo, ktime=jtime)
- bathyin=bathy ! save original
-
- IF (lfullstep ) THEN
- CALL zgr_read ; CALL zgr_zps(imin, imax, jmin, jmax)
- ENDIF
- IF (lfill ) CALL fillzone( imin, imax, jmin, jmax)
- IF (lraz ) CALL raz_zone( imin, imax, jmin, jmax)
- IF (ldump) CALL dumpzone(cdump,imin, imax, jmin, jmax)
- IF (ldumpn) CALL nicedumpzone(cdump,imin, imax, jmin, jmax)
- IF (lreplace) CALL replacezone(creplace)
-
- IF (lmodif ) THEN
- CALL prlog(bathyin,bathy,npiglo,npjglo,lappend)
- istatus=putvar(ctmp,cvar,klev,imax-imin+1,jmax-jmin+1,kimin=imin,kjmin=jmin,ktime=jtime,ptab=bathy(imin:imax,jmin:jmax))
- ENDIF
-
-CONTAINS
- SUBROUTINE zgr_zps ( kimin,kimax ,kjmin, kjmax )
- INTEGER ,INTENT(in) :: kimin,kimax, kjmin,kjmax
- !! * Local declarations
- INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: ik, it ! temporary integers
- INTEGER, PARAMETER :: wp=4
-
- REAL(wp) :: &
- ze3tp, ze3wp, & ! Last ocean level thickness at T- and W-points
- zdepwp, & ! Ajusted ocean depth to avoid too small e3t
- zdepth, & ! " "
- zmax, zmin, & ! Maximum and minimum depth
- zdiff ! temporary scalar
-
- ! Initialization of constant
- zmax = gdepw(npk) + e3t(npk)
- zmin = gdepw(4)
-
- ! initialize mbathy to the maximum ocean level available
- mbathy(kimin:kimax,kjmin:kjmax) = npk-1
-
- ! storage of land and island's number (zero and negative values) in mbathy
- WHERE (bathy(kimin:kimax,kjmin:kjmax) <= 0. ) mbathy(kimin:kimax,kjmin:kjmax)=INT( bathy(kimin:kimax,kjmin:kjmax) )
-
- ! bounded value of bathy
- ! minimum depth == 3 levels
- ! maximum depth == gdepw(jpk)+e3t(jpk)
- ! i.e. the last ocean level thickness cannot exceed e3t(jpkm1)+e3t(jpk)
- WHERE (bathy(kimin:kimax,kjmin:kjmax) <= 0 )
- bathy(kimin:kimax,kjmin:kjmax)=0.
- ELSEWHERE (bathy(kimin:kimax,kjmin:kjmax) < zmin )
- bathy(kimin:kimax,kjmin:kjmax) = zmin
- ELSEWHERE (bathy(kimin:kimax,kjmin:kjmax) >= zmax )
- bathy(kimin:kimax,kjmin:kjmax) = zmax
- END WHERE
-
- ! Compute mbathy for ocean points (i.e. the number of ocean levels)
- ! find the number of ocean levels such that the last level thickness
- ! is larger than the minimum of e3zps_min and e3zps_rat * e3t (where
- ! e3t is the reference level thickness
- DO jk = npk-1, 1, -1
-! zdepth = gdepw(jk) + MIN( e3zps_min, e3t(jk)*e3zps_rat )
- zdepth = gdept(jk)
- WHERE ( bathy(kimin:kimax,kjmin:kjmax) > 0. .AND. bathy (kimin:kimax,kjmin:kjmax) <= zdepth )
- mbathy(kimin:kimax,kjmin:kjmax)=jk-1
- e3_bot(kimin:kimax,kjmin:kjmax)= bathy(kimin:kimax,kjmin:kjmax) - gdepw(jk-1)
- END WHERE
- END DO
-
- DO ji=kimin,kimax
- DO jj=kjmin,kjmax
- jk=mbathy(ji,jj)
- IF (jk /= 0 ) THEN
- IF (gdepw(jk+1) > depmin ) bathy(ji,jj)=gdepw(jk+1)-0.1
- ENDIF
- ENDDO
- END DO
- END SUBROUTINE zgr_zps
-
- SUBROUTINE zgr_read
- INTEGER :: numzgr = 10, il, iostat, idum
- CHARACTER(LEN=256) :: cline, cfile='zgrbat.txt'
- il=0
- OPEN(numzgr, FILE=cfile,IOSTAT=iostat)
-
- DO WHILE ( iostat == 0 )
- READ(numzgr,'(a)',IOSTAT=iostat) cline
- READ(cline,*,IOSTAT=idum )il
- IF ( idum == 0 )npk=il
- END DO
-
- ALLOCATE ( level(npk), gdept(npk), gdepw(npk), e3t(npk), e3w(npk) )
- REWIND(numzgr)
-
- il=0 ; iostat=0
- DO WHILE ( iostat == 0 )
- READ(numzgr,'(a)', IOSTAT=iostat) cline
- READ(cline,*,IOSTAT=idum) il
- IF ( idum == 0 ) READ(cline,*) level(il), gdept(il), gdepw(il), &
- & e3t(il), e3w(il)
- END DO
- END SUBROUTINE zgr_read
-
- SUBROUTINE prlog (ptabold, ptab ,kpi,kpj,ldapp)
- ! * save differences in a log fill
- ! * if ldapp results are append to the logfile
- INTEGER :: kpi,kpj
- REAL(KIND=4), DIMENSION(kpi,kpj) :: ptabold, ptab
- LOGICAL :: ldapp
- ! * Local variables
- INTEGER :: numlog=10
-
- IF (ldapp ) THEN
- OPEN (numlog, FILE='log.f90', POSITION='append')
- ELSE
- OPEN (numlog, FILE='log.f90')
- ENDIF
-
- WRITE(numlog,'(a,a)') '! modification from original file : ', TRIM(cfilein)
- WRITE(numlog,'(a,a)') '! written to : ', TRIM(ctmp)
- DO ji=1,kpi
- DO jj=1,kpj
- IF ( ABS( ptabold(ji,jj) - ptab(ji,jj)) > 0.02 ) THEN ! allow a 2 cm tolerance for rounding purposes
- WRITE(numlog,'(a,i4,a,i4,a,f8.2,a,f8.2)') ' bathy(',ji,',',jj,')=',ptab(ji,jj),' ! instead of ',ptabold(ji,jj)
- END IF
- END DO
- END DO
- CLOSE(numlog)
- END SUBROUTINE prlog
-
- SUBROUTINE fillzone(kimin,kimax,kjmin,kjmax)
- ! * Fill subzone of the bathy file
- INTEGER :: kimin, kimax, kjmin,kjmax
- INTEGER :: ji,jj
- DO jj=kjmin,kjmax
- ji=kimin
- IF ( bathy(ji,jj) /= 0 ) THEN
- DO WHILE ( bathy(ji,jj) /= 0 .AND. ji <= kimax )
- bathy(ji,jj) = 0.
- ji=ji+1
- END DO
- END IF
- END DO
- END SUBROUTINE fillzone
-
- SUBROUTINE raz_zone(kimin,kimax,kjmin,kjmax)
- ! * Fill subzone of the bathy file
- INTEGER :: kimin, kimax, kjmin,kjmax
- bathy(kimin:kimax, kjmin:kjmax) = 0.
- END SUBROUTINE raz_zone
-
-
- SUBROUTINE dumpzone(cdumpf,kimin,kimax,kjmin,kjmax)
- CHARACTER(LEN=*), INTENT(in) :: cdumpf
- INTEGER, INTENT(in) :: kimin,kimax,kjmin,kjmax
- INTEGER :: ji,jj
- INTEGER :: numdmp=20 , ni
- CHARACTER(LEN=256) :: cfmtr, cfmti
- ! PRINT *,' Dumpzone not yet operational' ; STOP
- ni=kimax-kimin+1
- WRITE(cfmtr,99) ni
- WRITE(cfmti,98) ni
- OPEN(numdmp,FILE=cdumpf)
- WRITE(numdmp,*) kimin,kimax,kjmin,kjmax, TRIM(cfmtr)
-99 FORMAT('(I5,',i4.4,'f8.2)')
-98 FORMAT('(5x,',i4.4,'I8)')
- WRITE(numdmp,cfmti)(ji,ji=kimin,kimax)
- DO jj= kjmax,kjmin,-1
- WRITE(numdmp,cfmtr) jj, bathy(kimin:kimax,jj)
- ENDDO
- CLOSE(numdmp)
- END SUBROUTINE dumpzone
-
- SUBROUTINE nicedumpzone(cdumpf,kimin,kimax,kjmin,kjmax)
- CHARACTER(LEN=*), INTENT(in) :: cdumpf
- INTEGER, INTENT(in) :: kimin,kimax,kjmin,kjmax
- INTEGER :: ji,jj
- INTEGER :: numdmp=20 , ni
- CHARACTER(LEN=256) :: cfmtr, cfmti
- ni=kimax-kimin+1
- WRITE(cfmtr,99) ni
- WRITE(cfmti,98) ni
- OPEN(numdmp,FILE=cdumpf)
- WRITE(numdmp,*) kimin,kimax,kjmin,kjmax, TRIM(cfmtr)
-99 FORMAT('(I5,',i4.4,'I5)')
-98 FORMAT('(5x,',i4.4,'I5)')
- WRITE(numdmp,cfmti)(ji,ji=kimin,kimax)
- DO jj= kjmax,kjmin,-1
- WRITE(numdmp,cfmtr) jj, INT(bathy(kimin:kimax,jj))
- WRITE(numdmp,*)
- WRITE(numdmp,*)
- ENDDO
- CLOSE(numdmp)
- END SUBROUTINE nicedumpzone
-
-
- SUBROUTINE replacezone(cdreplace)
- CHARACTER(LEN=*), INTENT(in) :: cdreplace
- INTEGER :: jj
- INTEGER :: iimin,iimax,ijmin,ijmax
- INTEGER :: numrep=20, idum
- ! PRINT *,' replacezone not yet operational' ; STOP
- OPEN(numrep,FILE=cdreplace)
- READ(numrep,*) iimin, iimax, ijmin, ijmax
- READ(numrep,*) ! skip 1 line
- DO jj=ijmax,ijmin,-1
- READ(numrep,*) idum, bathy(iimin:iimax,jj)
- END DO
- CLOSE(numrep)
- END SUBROUTINE replacezone
-
-
-END PROGRAM cdfvar
diff --git a/cdfvertmean.f90 b/cdfvertmean.f90
index 0541820..75e2d1f 100644
--- a/cdfvertmean.f90
+++ b/cdfvertmean.f90
@@ -1,189 +1,250 @@
PROGRAM cdfvertmean
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfvertmean ***
+ !!======================================================================
+ !! *** PROGRAM cdfvertmean ***
+ !!=====================================================================
+ !! ** Purpose : Compute the vertical average of a scalar quantity
+ !! between 2 z layers. Can handle full step configuration
+ !! using the -full option.
!!
- !! ** Purpose : Compute the vertical average of a scalar quantity
- !! between z layers
- !! PARTIAL STEPS
- !!
- !! ** Method : compute the sum ( V * e1 *e2 * e3 *mask )
- !! for the mixed layer stored into gridT file
+ !! ** Method : compute the sum ( V * e1 *e2 * e3 *mask )
!!
- !!
- !! history ;
- !! Original : J.M. Molines ( 2008) January
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2008 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ USE modutils
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk, jvar
- INTEGER :: k1,k2
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvars, ivar
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e3, zs !: metrics, salinity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: hdep !: mxl depth
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: npiglo x npjglo
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zvol2d !: npiglo x npjglo
- REAL(KIND=4),DIMENSION(:), ALLOCATABLE :: gdep !:
-
- REAL(KIND=8) :: zvol, dep_up, dep_down
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zvertmean !: mxl salt content
-
- CHARACTER(LEN=256) :: cfilet
- CHARACTER(LEN=256) :: coordzgr='mesh_zgr.nc',cmask='mask.nc'
- CHARACTER(LEN=256) :: ctype='T'
- CHARACTER(LEN=256) :: cdum
- CHARACTER(LEN=256) :: cvarnam, cdep, ce3, cvmask
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarname !: name of input variables
- TYPE(variable), DIMENSION(:),ALLOCATABLE :: typvarin !: stucture for attributes
-
- ! Output stuff
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(1) :: ipk, id_varout !: only one output variable
- REAL(KIND=4), DIMENSION(1) :: tim,dep !: time output
- CHARACTER(LEN=256) :: cfileout='vertmean.nc'
-
- TYPE(variable), DIMENSION(1) :: typvar !: stucture for attributes
- !! Read command line and output usage message if not compliant.
- narg= iargc()
+
+ INTEGER(KIND=4) :: jk, jvar, jt ! dummy loop index
+ INTEGER(KIND=4) :: ik1, ik2 ! vertical limit of integration
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain,
+ INTEGER(KIND=4) :: nvars, ivar ! variables in input
+ INTEGER(KIND=4) :: ncout, ierr ! ncid and error status
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid's of output vars
+
+ REAL(KIND=4) :: rdep_up ! upper level of integration
+ REAL(KIND=4) :: rdep_down ! lower level of integration
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3 ! metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zv ! working variable
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: hdep ! depth of the levels
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zmask ! mask
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdep ! vertical levels
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metric full
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(1) :: rdep ! dummy depth output
+
+ REAL(KIND=8) :: dvol ! total volume
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dvol2d ! layer volume
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dvertmean ! value of integral
+
+ CHARACTER(LEN=256) :: cf_in ! input file name
+ CHARACTER(LEN=256) :: cf_out='vertmean.nc'! output file
+ CHARACTER(LEN=256) :: cv_in ! variable name
+ CHARACTER(LEN=256) :: cv_out='sovertmean' ! variable name
+ CHARACTER(LEN=256) :: cv_dep ! depth name
+ CHARACTER(LEN=256) :: cv_e3 ! vertical metric name (partial)
+ CHARACTER(LEN=256) :: cv_e31d ! vertical metric name (full)
+ CHARACTER(LEN=256) :: cv_msk ! mask variable name
+ CHARACTER(LEN=256) :: ctype='T' ! position of the variable
+ CHARACTER(LEN=256) :: cglobal ! global attribute
+ CHARACTER(LEN=256) :: cldum ! dummy string
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! name of input variables
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvarin ! stucture for attributes (input)
+ TYPE(variable), DIMENSION(1) :: stypvar ! stucture for attributes (output)
+
+ LOGICAL :: lfull=.FALSE. ! full step flag
+ LOGICAL :: lchk ! file existence flag (true if missing)
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ narg = iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfvertmean datafile varname T|U|V|W z1 z2 '
- PRINT *,' Computes the vertical mean value of variable between z1 and z2'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output ncdf file vertmean.nc, variable 2D sovertmean'
+ PRINT *,' usage : cdfvertmean IN-file IN-var v-type dep1 dep2 [-full]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the vertical mean between dep1 and dep2 given in m,'
+ PRINT *,' for variable IN-var in the input file.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : netcdf input file.'
+ PRINT *,' IN-var : netcdf input variable.'
+ PRINT *,' v-type : one of T U V W indicating position of variable on C-grid'
+ PRINT *,' dep1 dep2 : depths limit for vertical integration (meters). '
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-full ] : for full step configurations. Default is partial step.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ', TRIM(cn_fzgr),' and ',TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cv_out),' (same units as input variable)'
+ PRINT *,' '
STOP
ENDIF
- CALL getarg (1, cfilet)
- CALL getarg (2, cvarnam)
- CALL getarg (3, ctype)
- CALL getarg (4, cdum) ; READ(cdum,*) dep_up
- CALL getarg (5, cdum) ; READ(cdum,*) dep_down
+ ijarg = 1 ; ireq=0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg (ijarg, cldum ) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-full' ) ; lfull = .TRUE.
+ CASE DEFAULT
+ ireq=ireq+1
+ SELECT CASE ( ireq )
+ CASE ( 1 ) ; cf_in=cldum
+ CASE ( 2 ) ; cv_in=cldum
+ CASE ( 3 ) ; ctype=cldum
+ CASE ( 4 ) ; READ(cldum,*) rdep_up
+ CASE ( 5 ) ; READ(cldum,*) rdep_down
+ CASE DEFAULT
+ PRINT *,' Too many arguments ...' ; STOP
+ END SELECT
+ END SELECT
+ ENDDO
+
+ lchk = chkfile (cn_fzgr)
+ lchk = chkfile (cn_fmsk) .OR. lchk
+ lchk = chkfile (cf_in ) .OR. lchk
+ IF ( lchk ) STOP ! missing files
- IF (dep_down < dep_up ) THEN
- PRINT *,'Give depth limits in increasing order !'
- STOP
+ CALL SetGlobalAtt (cglobal)
+
+ IF (rdep_down < rdep_up ) THEN
+ PRINT *,'Give depth limits in increasing order !'
+ STOP
ENDIF
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
+ npiglo = getdim (cf_in,cn_x)
+ npjglo = getdim (cf_in,cn_y)
+ npk = getdim (cf_in,cn_z)
+ npt = getdim (cf_in,cn_t)
- nvars = getnvar(cfilet)
- ALLOCATE( cvarname(nvars), typvarin(nvars) )
- cvarname(:)=getvarname(cfilet,nvars,typvarin)
+ nvars = getnvar(cf_in)
+ ALLOCATE( cv_names(nvars), stypvarin(nvars) )
+ cv_names(:) = getvarname(cf_in, nvars, stypvarin)
ivar=1
DO jvar=1,nvars
- IF ( TRIM(cvarname(jvar)) == TRIM(cvarnam) ) THEN
- EXIT
- ENDIF
- ivar=ivar+1
+ IF ( TRIM(cv_names(jvar)) == TRIM(cv_in) ) THEN
+ EXIT
+ ENDIF
+ ivar=ivar+1
ENDDO
+
IF ( ivar == nvars+1 ) THEN
- PRINT *,' Variable ',TRIM(cvarnam),' not found in ', TRIM(cfilet)
+ PRINT *,' Variable ',TRIM(cv_in),' not found in ', TRIM(cf_in)
STOP
ENDIF
-
-
- dep(1) = 0.
- ipk(:) = 1
- typvar(1)%name= 'sovertmean'
- typvar(1)%units=typvarin(ivar)%units
- typvar(1)%missing_value=typvarin(ivar)%missing_value
- typvar(1)%valid_min= typvarin(ivar)%valid_min
- typvar(1)%valid_max= typvarin(ivar)%valid_max
- typvar(1)%long_name='vertical average of '//TRIM(typvarin(ivar)%long_name)
- typvar(1)%short_name='sovertmean'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+
+ rdep(1) = 0.
+ ipk(:) = 1
+ stypvar(1)%cname = cv_out
+ stypvar(1)%cunits = stypvarin(ivar)%cunits
+ stypvar(1)%rmissing_value = stypvarin(ivar)%rmissing_value
+ stypvar(1)%valid_min = stypvarin(ivar)%valid_min
+ stypvar(1)%valid_max = stypvarin(ivar)%valid_max
+ stypvar(1)%clong_name = 'vertical average of '//TRIM(stypvarin(ivar)%clong_name)
+ stypvar(1)%cshort_name = cv_out
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TYX'
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) , zvertmean(npiglo, npjglo) )
- ALLOCATE ( zs(npiglo,npjglo) ,hdep(npiglo,npjglo) )
- ALLOCATE ( e3(npiglo,npjglo) ,zvol2d(npiglo,npjglo) )
- ALLOCATE ( gdep(npk) )
+ ALLOCATE ( zmask(npiglo,npjglo), dvertmean(npiglo, npjglo) )
+ ALLOCATE ( zv(npiglo,npjglo), hdep(npiglo,npjglo) )
+ ALLOCATE ( e3(npiglo,npjglo), dvol2d(npiglo,npjglo) )
+ ALLOCATE ( gdep(npk), tim(npt) )
+
+ IF ( lfull ) ALLOCATE ( e31d(npk) )
! Initialize output file
- ncout = create(cfileout, cfilet, npiglo,npjglo,1)
- ierr=createvar(ncout ,typvar,1, ipk,id_varout )
- ierr=putheadervar(ncout, cfilet,npiglo, npjglo,1,pdep=dep)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
+ ncout = create (cf_out, cf_in, npiglo, npjglo, 1)
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout, cdglobal=cglobal )
+ ierr = putheadervar(ncout, cf_in, npiglo, npjglo, 1, pdep=rdep)
+
+ tim = getvar1d(cf_in, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
- ! Read vertical depth at w point
SELECT CASE ( ctype)
- CASE( 'T','U','V','t','u','v'); cdep='gdepw' ; ce3='e3t_ps'
- CASE( 'W' ,'w') ; cdep='gdept' ; ce3='e3w_ps'
+ CASE( 'T','U','V','t','u','v'); cv_dep=cn_gdepw ; cv_e3='e3t_ps' ; cv_e31d=cn_ve3t
+ CASE( 'W' ,'w') ; cv_dep=cn_gdept ; cv_e3='e3w_ps' ; cv_e31d=cn_ve3w
CASE DEFAULT ; PRINT *,'Point type ', TRIM(ctype),' not known! ' ; STOP
END SELECT
- gdep(:) = getvare3(coordzgr,cdep,npk)
+
+ gdep(:) = getvare3(cn_fzgr, cv_dep, npk)
+ IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cv_e31d, npk)
! set mask variable name
SELECT CASE (ctype )
- CASE ('T','t','W','w') ; cvmask='tmask'
- CASE ('U','u') ; cvmask='umask'
- CASE ('V','v') ; cvmask='vmask'
+ CASE ('T','t','W','w') ; cv_msk='tmask'
+ CASE ('U','u') ; cv_msk='umask'
+ CASE ('V','v') ; cv_msk='vmask'
END SELECT
- ! Look for k1 and k2 as nearest level of dep_up and dep_down
- k1=1; k2=npk
+ ! Look for ik1 and ik2 as nearest level of rdep_up and rdep_down
+ ik1 = 1; ik2 = npk
DO jk=1,npk
- IF ( gdep(jk) <= dep_up ) k1=jk
- IF ( gdep(jk) <= dep_down ) k2=jk
+ IF ( gdep(jk) <= rdep_up ) ik1 = jk
+ IF ( gdep(jk) <= rdep_down ) ik2 = jk
ENDDO
-
- PRINT *, dep_up, dep_down, k1, k2 , gdep(k1), gdep(k2+1)
-
-
- zvol=0.d0
- zvertmean(:,:)=0.d0
-
- DO jk = k1, k2
- ! Get temperatures at jk
- zs(:,:)= getvar(cfilet, cvarnam, jk ,npiglo,npjglo)
- zmask(:,:)=getvar(cmask,cvmask,jk,npiglo,npjglo)
-
- ! get e3 at level jk ( ps...)
- e3(:,:) = getvar(coordzgr, ce3, jk,npiglo,npjglo, ldiom=.true.)
- IF (jk == k1 ) THEN
- hdep(:,:)=gdep(jk)+e3(:,:)
- e3(:,:)=MIN(e3,hdep-REAL(dep_up))
- ENDIF
- IF ( jk == k2 ) THEN
- e3(:,:)=MIN(e3,REAL(dep_down)-gdep(jk))
- ENDIF
-
- zvol=SUM( e3 * zmask)
- zvol2d=e3(:,:)*zmask+ zvol2d(:,:)
- zvertmean(:,:)=zvertmean(:,:)+ zs*e3*zmask
-
- IF (zvol /= 0 )THEN
- ! go on !
- ELSE
- ! no more layer below !
- EXIT ! get out of the jk loop
- ENDIF
-
- END DO
- ! Output to netcdf file : kg/m2
- WHERE ( zvol2d /= 0 ) zvertmean=zvertmean/zvol2d
- ierr = putvar(ncout, id_varout(1) ,REAL(zvertmean), 1,npiglo, npjglo)
- ierr=closeout(ncout)
+ PRINT '(a,2f8.3)', 'depth limit of integration : ', rdep_up, rdep_down
+ PRINT '(a,2i8 )', 'nearest level found : ', ik1, ik2
+ PRINT '(a,2f8.3)', 'corresponding depth : ', gdep(ik1), gdep(ik2+1)
+
+ dvol = 0.d0
+ dvertmean(:,:) = 0.d0
+
+ DO jt=1,npt
+ DO jk = ik1, ik2
+ ! Get values at jk
+ zv( :,:) = getvar(cf_in, cv_in, jk, npiglo, npjglo, ktime=jt)
+ zmask(:,:) = getvar(cn_fmsk, cv_msk, jk, npiglo, npjglo )
+
+ ! get e3 at level jk ( ps...)
+ IF ( lfull ) THEN ; e3(:,:) = e31d(jk)
+ ELSE ; e3(:,:) = getvar(cn_fzgr, cv_e3, jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+
+ IF ( jk == ik1 ) THEN
+ hdep(:,:) = gdep(jk) + e3(:,:)
+ e3( :,:) = MIN(e3, hdep -rdep_up )
+ ENDIF
+
+ IF ( jk == ik2 ) THEN
+ e3( :,:) = MIN(e3, (rdep_down) - gdep(jk) )
+ ENDIF
+
+ dvol = SUM( DBLE(e3 * zmask) )
+ dvol2d = e3 * zmask * 1.d0 + dvol2d
+ dvertmean = zv * e3 * zmask * 1.d0 + dvertmean
+
+ IF (dvol == 0 )THEN
+ ! no more layer below !
+ EXIT ! get out of the jk loop
+ ENDIF
+ END DO
+
+ ! Output to netcdf file
+ WHERE ( dvol2d /= 0 ) dvertmean = dvertmean/dvol2d
+ ierr = putvar(ncout, id_varout(1), REAL(dvertmean), 1, npiglo, npjglo, ktime=jt)
+ END DO ! loop on time
+
+ ierr = closeout(ncout)
END PROGRAM cdfvertmean
diff --git a/cdfvhst-full.f90 b/cdfvhst-full.f90
deleted file mode 100644
index 4eb714b..0000000
--- a/cdfvhst-full.f90
+++ /dev/null
@@ -1,172 +0,0 @@
-PROGRAM cdfvhst_full
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfvhst_full ***
- !!
- !! ** Purpose : Compute Verticaly integrated Heat Salt Transport.
- !! FULL STEPS
- !!
- !! ** Method : Compute the 2D fields somevt, somevs and sozout, sozous
- !! as the integral on the vertical of ut, vt, us, vs
- !! Save on the nc file
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (jan. 2005) (known then as cdfheattrp-save.f90 )
- !! J.M. Molines : use module
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout
- INTEGER, DIMENSION(4) :: ipk, id_varout !
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e1v, gphiv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, gphiu, zut, zus !: mask, metrics
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: e3t
- REAL(KIND=4) ,DIMENSION(1) :: tim
- REAL(KIND=4) ,DIMENSION(:) , ALLOCATABLE :: gphimean_glo, gphimean_atl, gphimean_pac, &
- & gphimean_ind, gphimean_aus, gphimean_med
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwk , zwks, zwkut, zwkus
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrp, ztrps,ztrput, ztrpus
- REAL(KIND=8) ,DIMENSION(:) , ALLOCATABLE :: zonal_heat_glo, zonal_heat_atl, zonal_heat_pac, &
- & zonal_heat_ind, zonal_heat_aus, zonal_heat_med
- REAL(KIND=8) ,DIMENSION(:) , ALLOCATABLE :: zonal_salt_glo, zonal_salt_atl, zonal_salt_pac, &
- & zonal_salt_ind, zonal_salt_aus, zonal_salt_med
- CHARACTER(LEN=256) :: cfilet , cfileoutnc='trp.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc'
- TYPE (variable), DIMENSION(4) :: typvar !: structure for attribute
-
-
- INTEGER :: istatus
-
- ! constants
- REAL(KIND=4),PARAMETER :: rau0=1000., rcp=4000.
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfvhst_full VTfile '
- PRINT *,' Computes the vertically integrated transports at each grid cell'
- PRINT *,' FULL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc, new_maskglo.nc must be in te current directory'
- PRINT *,' Output on trp.nc, variables somevt somevs sozout sozous '
- STOP
- ENDIF
-
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- ! define new variables for output
- typvar(1)%name= 'somevt'
- typvar(2)%name= 'somevs'
- typvar(3)%name= 'sozout'
- typvar(4)%name= 'sozous'
- typvar(1)%units='W'
- typvar(2)%units='kg.s-1'
- typvar(3)%units='W'
- typvar(4)%units='kg.s-1'
- typvar%missing_value=0.
- typvar%valid_min= -100.
- typvar%valid_max= 100.
-
- typvar(1)%long_name='Meridional_heat_transport'
- typvar(2)%long_name='Meridional_salt_transport'
- typvar(3)%long_name='Zonal_heat_transport'
- typvar(4)%long_name='Zonal_salt_transport'
-
- typvar(1)%short_name='somevt'
- typvar(2)%short_name='somevs'
- typvar(3)%short_name='sozout'
- typvar(4)%short_name='sozous'
- typvar%online_operation='N/A'
- typvar%axis='TYX'
-
- ipk(1) = 1 ! 2D
- ipk(2) = 1 ! 2D
- ipk(3) = 1 ! 2D
- ipk(4) = 1 ! 2D
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( zwk(npiglo,npjglo) ,zvt(npiglo,npjglo) )
- ALLOCATE ( zwks(npiglo,npjglo) ,zvs(npiglo,npjglo) )
- ALLOCATE ( zwkut(npiglo,npjglo) ,zut(npiglo,npjglo) )
- ALLOCATE ( zwkus(npiglo,npjglo) ,zus(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo),e3t(npk), gphiv(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo), gphiu(npiglo,npjglo))
- ALLOCATE ( ztrp(npiglo,npjglo))
- ALLOCATE ( ztrps(npiglo,npjglo))
- ALLOCATE ( ztrput(npiglo,npjglo))
- ALLOCATE ( ztrpus(npiglo,npjglo))
- ALLOCATE ( zonal_heat_glo(npjglo), zonal_heat_atl(npjglo), zonal_heat_pac(npjglo))
- ALLOCATE ( zonal_heat_ind(npjglo), zonal_heat_aus(npjglo), zonal_heat_med(npjglo) )
- ALLOCATE ( zonal_salt_glo(npjglo), zonal_salt_atl(npjglo), zonal_salt_pac(npjglo))
- ALLOCATE ( zonal_salt_ind(npjglo), zonal_salt_aus(npjglo), zonal_salt_med(npjglo) )
- ALLOCATE ( gphimean_glo(npjglo) , gphimean_atl(npjglo), gphimean_pac(npjglo))
- ALLOCATE ( gphimean_ind(npjglo),gphimean_aus(npjglo),gphimean_med(npjglo))
-
- ! create output fileset
- ncout =create(cfileoutnc, cfilet, npiglo,npjglo,npk)
- ierr= createvar(ncout ,typvar,4, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet, npiglo, npjglo, npk)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
- e3t(:) = getvare3(coordzgr,'e3t',npk)
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gphiu(:,:) = getvar(coordhgr, 'gphiu', 1,npiglo,npjglo)
-
- ztrp(:,:) = 0
- ztrps(:,:) = 0
- ztrput(:,:)= 0
- ztrpus(:,:)= 0
-
- DO jk = 1,npk
- PRINT *,'level ',jk
- ! Get temperature and salinity at jk
- zvt(:,:)= getvar(cfilet, 'vomevt', jk ,npiglo,npjglo)
- zvs(:,:)= getvar(cfilet, 'vomevs', jk ,npiglo,npjglo)
- zut(:,:)= getvar(cfilet, 'vozout', jk ,npiglo,npjglo)
- zus(:,:)= getvar(cfilet, 'vozous', jk ,npiglo,npjglo)
-
- ! get e3v at level jk
- zwk(:,:) = zvt(:,:)*e1v(:,:)*e3t(jk)
- zwks(:,:) = zvs(:,:)*e1v(:,:)*e3t(jk)
- zwkut(:,:) = zut(:,:)*e2u(:,:)*e3t(jk)
- zwkus(:,:) = zus(:,:)*e2u(:,:)*e3t(jk)
-
- ! integrates vertically
- ztrp(:,:) = ztrp(:,:) + zwk(:,:) * rau0*rcp
- ztrps(:,:) = ztrps(:,:) + zwks(:,:)
- ztrput(:,:) = ztrput(:,:) + zwkut(:,:) * rau0*rcp
- ztrpus(:,:) = ztrpus(:,:) + zwkus(:,:)
-
- END DO ! loop to next level
-
- ierr = putvar(ncout, id_varout(1) ,SNGL(ztrp), 1, npiglo,npjglo)
- ierr = putvar(ncout, id_varout(2) ,SNGL(ztrps), 1, npiglo,npjglo)
- ierr = putvar(ncout, id_varout(3) ,SNGL(ztrput), 1, npiglo,npjglo)
- ierr = putvar(ncout, id_varout(4) ,SNGL(ztrpus), 1, npiglo,npjglo)
- istatus = closeout(ncout)
-
-END PROGRAM cdfvhst_full
diff --git a/cdfvhst.f90 b/cdfvhst.f90
index a2d2f6b..6cc154f 100644
--- a/cdfvhst.f90
+++ b/cdfvhst.f90
@@ -1,175 +1,191 @@
PROGRAM cdfvhst
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfvhst ***
+ !!======================================================================
+ !! *** PROGRAM cdfvhst ***
+ !!=====================================================================
+ !! ** Purpose : Compute Verticaly integrated Heat Salt Transport.
!!
- !! ** Purpose : Compute Verticaly integrated Heat Salt Transport.
- !! PARTIAL STEPS
- !!
- !! ** Method : Compute the 2D fields somevt, somevs and sozout, sozous
- !! as the integral on the vertical of ut, vt, us, vs
- !! Save on the nc file
+ !! ** Method : Take VT files computed by cdfvT.f90 and integrate
+ !! vertically to produce a 2D file
!!
- !!
- !! history ;
- !! Original : J.M. Molines (jan. 2005) (known then as cdfheattrp-save.f90 )
- !! J.M. Molines : use module
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 01/2005 : J.M. Molines : Original code
+ !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout
- INTEGER, DIMENSION(4) :: ipk, id_varout !
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e1v, e3v ,gphiv, zvt, zvs !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u ,gphiu, zut, zus !: mask, metrics
- REAL(KIND=4) ,DIMENSION(1) :: tim
- REAL(KIND=4) ,DIMENSION(:) , ALLOCATABLE :: gphimean_glo, gphimean_atl, gphimean_pac, &
- & gphimean_ind, gphimean_aus, gphimean_med
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwk , zwks, zwkut, zwkus
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrp, ztrps,ztrput, ztrpus
- REAL(KIND=8) ,DIMENSION(:) , ALLOCATABLE :: zonal_heat_glo, zonal_heat_atl, zonal_heat_pac, &
- & zonal_heat_ind, zonal_heat_aus, zonal_heat_med
- REAL(KIND=8) ,DIMENSION(:) , ALLOCATABLE :: zonal_salt_glo, zonal_salt_atl, zonal_salt_pac, &
- & zonal_salt_ind, zonal_salt_aus, zonal_salt_med
-
- CHARACTER(LEN=256) :: cfilet , cfileoutnc='trp.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc'
- TYPE (variable), DIMENSION(4) :: typvar !: structure for attribute
-
-
- INTEGER :: istatus
- ! constants
- REAL(KIND=4), PARAMETER :: rau0=1000., rcp=4000.
+ INTEGER(KIND=4) :: jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg ! argument counter
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncdf id of output file
+ INTEGER(KIND=4), DIMENSION(4) :: ipk, id_varout ! output variable levels and id's
+
+ REAL(KIND=4), PARAMETER :: pp_rau0=1000. ! fresh water density ( kg/m3)
+ REAL(KIND=4), PARAMETER :: pp_rcp=4000. ! heat capacity of water (J/kg/K)
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1v, e2u ! horizontal metrics
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e3u, e3v ! vertical metrics
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zut, zus ! heat and salt zonal copmponents
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zvt, zvs ! heat and salt meridional components
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics when full step
+
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dtrput, dtrpus ! zonal transport
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dtrpvt, dtrpvs ! meridional transport
+
+ TYPE (variable), DIMENSION(4) :: stypvar ! structure output variables
+
+ CHARACTER(LEN=256) :: cf_vtfil ! input file name (vt)
+ CHARACTER(LEN=256) :: cf_out='trp.nc' ! output file name
+ CHARACTER(LEN=256) :: cldum ! dummy char variable
+
+ LOGICAL :: lfull=.FALSE. ! flag for full step
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line and output usage message if not compliant.
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfvhst VTfile '
- PRINT *,' Computes the vertically integrated transports at each grid cell'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc must be in te current directory'
- PRINT *,' Output on trp.nc, variables somevt somevs sozout sozous '
+ PRINT *,' usage : cdfvhst VTfile [-full ]'
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes the vertically integrated heat and salt transports '
+ PRINT *,' at each grid cell.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' VTfile : file which contains UT, VT, US, VS quantities'
+ PRINT *,' (produced by cdfvT.f90)'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ -full ] : use full step computation (default is partial steps).'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' Files ',TRIM(cn_fhgr),', ',TRIM(cn_fzgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' Netcdf file : ',TRIM(cf_out)
+ PRINT *,' Variables : ', TRIM(cn_somevt),', ',TRIM(cn_somevs),', ',TRIM(cn_sozout),' and ',TRIM(cn_sozous)
STOP
ENDIF
- CALL getarg (1, cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- ! define new variables for output
- typvar(1)%name= 'somevt'
- typvar(2)%name= 'somevs'
- typvar(3)%name= 'sozout'
- typvar(4)%name= 'sozous'
-
- typvar(1)%units='W'
- typvar(2)%units='kg.s-1'
- typvar(3)%units='W'
- typvar(4)%units='kg.s-1'
-
- typvar%missing_value=0.
- typvar%valid_min= -100.
- typvar%valid_max= 100.
-
- typvar(1)%long_name='Meridional_heat_transport'
- typvar(2)%long_name='Meridional_salt_transport'
- typvar(3)%long_name='Zonal_heat_transport'
- typvar(4)%long_name='Zonal_salt_transport'
-
- typvar(1)%short_name='somevt'
- typvar(2)%short_name='somevs'
- typvar(3)%short_name='sozout'
- typvar(4)%short_name='sozous'
- typvar%online_operation='N/A'
- typvar%axis='TYX'
-
- ipk(1) = 1 ! 2D
- ipk(2) = 1 ! 2D
- ipk(3) = 1 ! 2D
- ipk(4) = 1 ! 2D
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ ijarg = 1
+ DO WHILE (ijarg <= narg )
+ CALL getarg(ijarg, cldum ) ; ijarg = ijarg+1
+ SELECT CASE (cldum )
+ CASE ( '-full' )
+ lfull = .TRUE.
+ CASE DEFAULT
+ cf_vtfil = cldum
+ END SELECT
+ END DO
+
+ IF ( chkfile(cf_vtfil) ) STOP ! missing file
+
+ npiglo= getdim (cf_vtfil,cn_x )
+ npjglo= getdim (cf_vtfil,cn_y )
+ npk = getdim (cf_vtfil,cn_z )
+ npt = getdim (cf_vtfil,cn_t )
+
+ ! define new variables for output
+ ipk(:) = 1
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = -100.
+ stypvar%valid_max = 100.
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TYX'
+
+ stypvar(1)%cname = cn_somevt
+ stypvar(2)%cname = cn_somevs
+ stypvar(3)%cname = cn_sozout
+ stypvar(4)%cname = cn_sozous
+
+ stypvar(1)%cunits = 'W'
+ stypvar(2)%cunits = 'kg.s-1'
+ stypvar(3)%cunits = 'W'
+ stypvar(4)%cunits = 'kg.s-1'
+
+ stypvar(1)%clong_name = 'Meridional_heat_transport'
+ stypvar(2)%clong_name = 'Meridional_salt_transport'
+ stypvar(3)%clong_name = 'Zonal_heat_transport'
+ stypvar(4)%clong_name = 'Zonal_salt_transport'
+
+ stypvar(1)%cshort_name = cn_somevt
+ stypvar(2)%cshort_name = cn_somevs
+ stypvar(3)%cshort_name = cn_sozout
+ stypvar(4)%cshort_name = cn_sozous
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( zwk(npiglo,npjglo) ,zvt(npiglo,npjglo) )
- ALLOCATE ( zwks(npiglo,npjglo) ,zvs(npiglo,npjglo) )
- ALLOCATE ( zwkut(npiglo,npjglo) ,zut(npiglo,npjglo) )
- ALLOCATE ( zwkus(npiglo,npjglo) ,zus(npiglo,npjglo) )
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo), gphiv(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo), gphiu(npiglo,npjglo))
- ALLOCATE ( ztrp(npiglo,npjglo))
- ALLOCATE ( ztrps(npiglo,npjglo))
- ALLOCATE ( ztrput(npiglo,npjglo))
- ALLOCATE ( ztrpus(npiglo,npjglo))
- ALLOCATE ( zonal_heat_glo(npjglo), zonal_heat_atl(npjglo), zonal_heat_pac(npjglo))
- ALLOCATE ( zonal_heat_ind(npjglo), zonal_heat_aus(npjglo), zonal_heat_med(npjglo) )
- ALLOCATE ( zonal_salt_glo(npjglo), zonal_salt_atl(npjglo), zonal_salt_pac(npjglo))
- ALLOCATE ( zonal_salt_ind(npjglo), zonal_salt_aus(npjglo), zonal_salt_med(npjglo) )
- ALLOCATE ( gphimean_glo(npjglo) , gphimean_atl(npjglo), gphimean_pac(npjglo))
- ALLOCATE ( gphimean_ind(npjglo),gphimean_aus(npjglo),gphimean_med(npjglo))
+ ALLOCATE ( zvt(npiglo,npjglo), zvs(npiglo,npjglo) )
+ ALLOCATE ( zut(npiglo,npjglo), zus(npiglo,npjglo) )
+ ALLOCATE ( e1v(npiglo,npjglo), e3v(npiglo,npjglo) )
+ ALLOCATE ( e2u(npiglo,npjglo), e3u(npiglo,npjglo) )
+ ALLOCATE ( dtrpvt(npiglo,npjglo), dtrpvs(npiglo,npjglo))
+ ALLOCATE ( dtrput(npiglo,npjglo), dtrpus(npiglo,npjglo))
+ ALLOCATE ( tim(npt), e31d(npk) )
! create output fileset
- ncout =create(cfileoutnc, cfilet, npiglo,npjglo,npk)
- ierr= createvar(ncout ,typvar,4, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,npk)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
- gphiv(:,:) = getvar(coordhgr, 'gphiv', 1,npiglo,npjglo)
- gphiu(:,:) = getvar(coordhgr, 'gphiu', 1,npiglo,npjglo)
-
- ztrp(:,:)= 0
- ztrps(:,:)= 0
- ztrput(:,:)= 0
- ztrpus(:,:)= 0
- DO jk = 1,npk
- PRINT *,'level ',jk
- ! Get temperature and salinity at jk
- zvt(:,:)= getvar(cfilet, 'vomevt', jk ,npiglo,npjglo)
- zvs(:,:)= getvar(cfilet, 'vomevs', jk ,npiglo,npjglo)
- zut(:,:)= getvar(cfilet, 'vozout', jk ,npiglo,npjglo)
- zus(:,:)= getvar(cfilet, 'vozous', jk ,npiglo,npjglo)
-
- ! get e3v at level jk
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
- zwk(:,:) = zvt(:,:)*e1v(:,:)*e3v(:,:)
- zwks(:,:) = zvs(:,:)*e1v(:,:)*e3v(:,:)
- zwkut(:,:) = zut(:,:)*e2u(:,:)*e3u(:,:)
- zwkus(:,:) = zus(:,:)*e2u(:,:)*e3u(:,:)
-
- ! integrates vertically
- ztrp(:,:) = ztrp(:,:) + zwk(:,:) * rau0*rcp
- ztrps(:,:) = ztrps(:,:) + zwks(:,:)
- ztrput(:,:) = ztrput(:,:) + zwkut(:,:) * rau0*rcp
- ztrpus(:,:) = ztrpus(:,:) + zwkus(:,:)
-
- END DO ! loop to next level
-
- ierr = putvar(ncout, id_varout(1) ,SNGL(ztrp), 1, npiglo, npjglo)
- ierr = putvar(ncout, id_varout(2) ,SNGL(ztrps), 1, npiglo, npjglo)
- ierr = putvar(ncout, id_varout(3) ,SNGL(ztrput), 1, npiglo, npjglo)
- ierr = putvar(ncout, id_varout(4) ,SNGL(ztrpus), 1, npiglo, npjglo)
-
- istatus = closeout (ncout)
-
- END PROGRAM cdfvhst
+ ncout = create (cf_out, cf_vtfil, npiglo, npjglo, 1 )
+ ierr = createvar (ncout, stypvar, 4, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_vtfil, npiglo, npjglo, 1 )
+
+ tim = getvar1d(cf_vtfil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ ! read level independent metrics
+ e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo)
+ e2u(:,:) = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo)
+ e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk ) ! used only for full step
+
+ DO jt=1, npt
+ ! reset transport to 0
+ dtrpvt(:,:) = 0.d0
+ dtrpvs(:,:) = 0.d0
+ dtrput(:,:) = 0.d0
+ dtrpus(:,:) = 0.d0
+
+ DO jk = 1,npk
+ PRINT *,'level ',jk, ' time ', jt
+ ! Get heat/salt transport component at jk
+ zvt(:,:)= getvar(cf_vtfil, cn_vomevt, jk ,npiglo, npjglo, ktime=jt)
+ zvs(:,:)= getvar(cf_vtfil, cn_vomevs, jk ,npiglo, npjglo, ktime=jt)
+ zut(:,:)= getvar(cf_vtfil, cn_vozout, jk ,npiglo, npjglo, ktime=jt)
+ zus(:,:)= getvar(cf_vtfil, cn_vozous, jk ,npiglo, npjglo, ktime=jt)
+
+ ! get e3v at level jk ( and multiply by respective horizontal metric)
+ IF ( lfull ) THEN
+ e3v(:,:) = e31d(jk) * e1v(:,:)
+ e3u(:,:) = e31d(jk) * e2u(:,:)
+ ELSE
+ e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.) * e1v(:,:)
+ e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo, npjglo, ldiom=.TRUE.) * e2u(:,:)
+ ENDIF
+
+ ! integrates vertically
+ dtrpvt(:,:) = dtrpvt(:,:) + zvt(:,:) * e3v(:,:) * pp_rau0*pp_rcp * 1.d0
+ dtrpvs(:,:) = dtrpvs(:,:) + zvs(:,:) * e3v(:,:) * 1.d0
+ dtrput(:,:) = dtrput(:,:) + zut(:,:) * e3u(:,:) * pp_rau0*pp_rcp * 1.d0
+ dtrpus(:,:) = dtrpus(:,:) + zus(:,:) * e3u(:,:) * 1.d0
+
+ END DO ! loop to next level
+
+ ! output on file
+ ierr = putvar(ncout, id_varout(1) ,SNGL(dtrpvt), 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(2) ,SNGL(dtrpvs), 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(3) ,SNGL(dtrput), 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(4) ,SNGL(dtrpus), 1, npiglo, npjglo, ktime=jt)
+ END DO ! loop on time step
+
+ ierr = closeout (ncout)
+
+END PROGRAM cdfvhst
diff --git a/cdfvita.f90 b/cdfvita.f90
index e63acb5..c688507 100644
--- a/cdfvita.f90
+++ b/cdfvita.f90
@@ -1,92 +1,125 @@
PROGRAM cdfvita
- !!-------------------------------------------------------------------
- !! PROGRAM CDFVITA
- !! **************
+ !!======================================================================
+ !! *** PROGRAM cdfvita ***
+ !!=====================================================================
+ !! ** Purpose : Compute velocity on t grid
!!
- !! ** Purpose: Compute surface velocity on t grid
- !! gridU , gridV gridT (reference)
- !!
- !! ** Method: Try to avoid 3 d arrays
+ !! ** Method : Read velocity component on input gridU and gridV file
+ !! Use gridT file for the proper location of T points
+ !! The velocity module is also output (same function than
+ !! cdfspeed) If a gridW file is given, (fifth argument)
+ !! then w is also computed on the T grid
!!
- !! history:
- !! Original: J.M. Molines (Nov 2006 ) for ORCA025
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !!
- !! * Modules used
+ !! History : 2.1 : 11/2006 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk, jlev
- INTEGER :: narg, iargc, ijarg !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nlev, nvar, ik
- INTEGER, DIMENSION(:),ALLOCATABLE :: ipk, id_varout, nklev
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: u, v, ua, va, vmod
- REAL(KIND=4) ,DIMENSION(1) :: timean
- REAL(KIND=4) ,DIMENSION(:), ALLOCATABLE :: gdept, gdeptall
-
- CHARACTER(LEN=256) :: cfileu ,cfilev, cfilew, cfilet, cfileout='vita.nc' !: file name
- CHARACTER(LEN=256) :: cdum
-
- INTEGER :: ncout
- INTEGER :: istatus, ierr
- LOGICAL :: lvertical = .false.
-
- !! Read command line
+
+ INTEGER(KIND=4) :: ji, jj, jk, jt, jlev ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line
+ INTEGER(KIND=4) :: npiglo,npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nlev, ik ! number of selected levels, current lev
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: ierr ! error status for cdfio
+ INTEGER(KIND=4) :: nvar ! number of variable
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: nklev ! selected levels
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! output stuff
+
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter array
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdeptall, gdept ! depths and selected depths
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: uc, vc ! velocity component on C grid
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ua, va, vmod ! velocity component on A grid
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! data attributes
+
+ CHARACTER(LEN=256) :: cf_ufil, cf_vfil ! velocity files on C grid
+ CHARACTER(LEN=256) :: cf_wfil ! optional W file on C grid
+ CHARACTER(LEN=256) :: cf_tfil ! GridT file for T position
+ CHARACTER(LEN=256) :: cf_out='vita.nc' ! output file name
+ CHARACTER(LEN=256) :: cldum ! dummy char variable
+
+ LOGICAL :: lvertical = .FALSE. ! vertical velocity flag
+ LOGICAL :: lperio = .FALSE. ! E_W periodicity flag
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfvita gridU gridV gridT2 [-w gridW ] [-lev level_list]'
- PRINT *,' Grid T2 is only required for the Tgrid of output field'
- PRINT *,' if optionnal -w gridW file is given, then the W component '
- PRINT *,' is also interpolated'
- PRINT *,' We suggest to give a gridT2 file, which is smaller '
- PRINT *,' [-lev level_list ] : specify a list of level to be used '
- PRINT *,' (default option is to use all input levels).'
- PRINT *,' This option MUST be the last on the command line !!'
- PRINT *,' Output on vita.nc ,variables sovitua sovitva sovitmod [ sovitwa ]'
+ PRINT *,' usage : cdfvita U-file V_file T-file [-w W-file] [-lev level_list]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Create a file with velocity components and module computed'
+ PRINT *,' at T points from file on C-grid. T-file is used only for'
+ PRINT *,' getting the header of the output file. Any file on T grid'
+ PRINT *,' can be used.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' U-file : netcdf file with zonal component of velocity'
+ PRINT *,' V-file : netcdf file with meridional component of velocity'
+ PRINT *,' T-file : netcdf file with T points header OK.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ -w W-file ] : if used, also compute vertical velocities at'
+ PRINT *,' T points.'
+ PRINT *,' [ -lev level_list] : specify a list of level to be used '
+ PRINT *,' (default option is to use all input levels).'
+ PRINT *,' This option MUST be the last on the command line !!'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : sovitua, sovitva, sovitmod, [sovitwa]'
STOP
ENDIF
- !!
- !! Initialisation from 1st file (all file are assume to have the same geometry)
+
nlev = 0
ijarg=1
DO WHILE ( ijarg <= narg )
- CALL getarg( ijarg, cdum ) ; ijarg=ijarg+1
- SELECT CASE ( cdum )
+ CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
CASE ( '-lev' )
nlev= narg - ijarg + 1
ALLOCATE (nklev(nlev) )
DO jlev = 1, nlev
- CALL getarg( ijarg, cdum ) ; ijarg=ijarg+1 ; READ(cdum,* ) nklev(jlev)
+ CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1 ; READ(cldum,* ) nklev(jlev)
ENDDO
CASE ( '-w' )
- CALL getarg( ijarg, cfilew ) ; ijarg=ijarg+1
- lvertical=.true.
+ CALL getarg( ijarg, cf_wfil ) ; ijarg=ijarg+1
+ lvertical=.TRUE.
CASE DEFAULT
- cfileu=cdum
- CALL getarg( ijarg, cfilev ) ; ijarg=ijarg+1
- CALL getarg( ijarg, cfilet ) ; ijarg=ijarg+1
+ cf_ufil=cldum
+ CALL getarg( ijarg, cf_vfil ) ; ijarg=ijarg+1
+ CALL getarg( ijarg, cf_tfil ) ; ijarg=ijarg+1
END SELECT
ENDDO
! adjust number of variable according to -w option
- IF ( lvertical ) THEN
- nvar = 4
- ELSE
- nvar = 3
- ENDIF
+ nvar=3
+ IF ( lvertical ) nvar = 4
- ALLOCATE ( ipk(nvar), id_varout(nvar), typvar(nvar) )
+ ALLOCATE ( ipk(nvar), id_varout(nvar), stypvar(nvar) )
+
+ IF ( chkfile(cf_ufil) .OR. chkfile(cf_vfil) .OR. chkfile(cf_tfil) ) STOP ! missing file
+
+ IF ( lvertical ) THEN
+ IF ( chkfile(cf_wfil) ) STOP ! missing file
+ ENDIF
- npiglo = getdim (cfileu,'x')
- npjglo = getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
+ npiglo = getdim (cf_ufil,cn_x)
+ npjglo = getdim (cf_ufil,cn_y)
+ npk = getdim (cf_ufil,cn_z)
+ npt = getdim (cf_ufil,cn_t)
IF ( nlev == 0 ) THEN ! take all levels
nlev = npk
@@ -98,111 +131,132 @@ PROGRAM cdfvita
ALLOCATE ( gdept(nlev) )
- ipk(1) = nlev
- typvar(1)%name='sovitua'
- typvar(1)%units='m/s'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= 0.
- typvar(1)%valid_max= 10000.
- typvar(1)%long_name='Zonal Velocity T point'
- typvar(1)%short_name='sovitua'
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TYX'
-
- ipk(2) = nlev
- typvar(2)%name='sovitva'
- typvar(2)%units='m/s'
- typvar(2)%missing_value=0.
- typvar(2)%valid_min= 0.
- typvar(2)%valid_max= 10000.
- typvar(2)%long_name='Meridional Velocity T point'
- typvar(2)%short_name='sovitva'
- typvar(2)%online_operation='N/A'
- typvar(2)%axis='TYX'
-
- ipk(3) = nlev
- typvar(3)%name='sovitmod'
- typvar(3)%units='m/s'
- typvar(3)%missing_value=0.
- typvar(3)%valid_min= 0.
- typvar(3)%valid_max= 10000.
- typvar(3)%long_name='Velocity module T point'
- typvar(3)%short_name='sovitmod'
- typvar(3)%online_operation='N/A'
- typvar(3)%axis='TYX'
+ ! Zonal Velocity T point
+ ipk(1) = nlev
+ stypvar(1)%cname = 'sovitua'
+ stypvar(1)%cunits = 'm/s'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = 0.
+ stypvar(1)%valid_max = 10000.
+ stypvar(1)%clong_name = 'Zonal Velocity T point'
+ stypvar(1)%cshort_name = 'sovitua'
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
+
+ ! Meridional Velocity T point
+ ipk(2) = nlev
+ stypvar(2)%cname = 'sovitva'
+ stypvar(2)%cunits = 'm/s'
+ stypvar(2)%rmissing_value = 0.
+ stypvar(2)%valid_min = 0.
+ stypvar(2)%valid_max = 10000.
+ stypvar(2)%clong_name = 'Meridional Velocity T point'
+ stypvar(2)%cshort_name = 'sovitva'
+ stypvar(2)%conline_operation = 'N/A'
+ stypvar(2)%caxis = 'TZYX'
+
+ ! Velocity module T point
+ ipk(3) = nlev
+ stypvar(3)%cname = 'sovitmod'
+ stypvar(3)%cunits = 'm/s'
+ stypvar(3)%rmissing_value = 0.
+ stypvar(3)%valid_min = 0.
+ stypvar(3)%valid_max = 10000.
+ stypvar(3)%clong_name = 'Velocity module T point'
+ stypvar(3)%cshort_name = 'sovitmod'
+ stypvar(3)%conline_operation = 'N/A'
+ stypvar(3)%caxis = 'TZYX'
IF ( lvertical ) THEN
- ipk(4) = nlev
- typvar(4)%name='sovitwa'
- typvar(4)%units='mm/s'
- typvar(4)%missing_value=0.
- typvar(4)%valid_min= 0.
- typvar(4)%valid_max= 10000.
- typvar(4)%long_name='Vertical Velocity at T point'
- typvar(4)%short_name='sovitwa'
- typvar(4)%online_operation='N/A'
- typvar(4)%axis='TYX'
+ ! Vertical Velocity at T point
+ ipk(nvar) = nlev
+ stypvar(nvar)%cname = 'sovitwa'
+ stypvar(nvar)%cunits = 'mm/s'
+ stypvar(nvar)%rmissing_value = 0.
+ stypvar(nvar)%valid_min = 0.
+ stypvar(nvar)%valid_max = 10000.
+ stypvar(nvar)%clong_name = 'Vertical Velocity at T point'
+ stypvar(nvar)%cshort_name = 'sovitwa'
+ stypvar(nvar)%conline_operation = 'N/A'
+ stypvar(nvar)%caxis = 'TZYX'
ENDIF
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npk =', npk
+ PRINT *, 'npt =', npt
+ PRINT *, 'nlev =', nlev
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'nlev =', nlev
-
- ALLOCATE( u(npiglo,npjglo), v(npiglo,npjglo) , gdeptall(npk) )
+ ALLOCATE( uc(npiglo,npjglo), vc(npiglo,npjglo) )
ALLOCATE( ua(npiglo,npjglo), va(npiglo,npjglo), vmod(npiglo,npjglo) )
+ ALLOCATE( tim(npt), gdeptall(npk) )
- gdeptall(:) = getvar1d(cfilet,'deptht',npk)
-
+ gdeptall(:) = getvar1d(cf_tfil,cn_vdeptht, npk)
DO jlev = 1, nlev
ik = nklev(jlev)
gdept(jlev) = gdeptall(ik)
ENDDO
- ncout =create(cfileout, cfilet, npiglo, npjglo, nlev)
- ierr= createvar(ncout, typvar, nvar, ipk, id_varout )
- ierr= putheadervar(ncout, cfilet, npiglo, npjglo, nlev, pdep=gdept)
+ ! check E-W periodicity using uc array as working space
+ uc(:,:) = getvar(cf_tfil, cn_vlon2d, 1, npiglo, npjglo )
+ IF ( uc(1,1) == uc(npiglo-1,1) ) THEN
+ lperio = .TRUE.
+ PRINT *,' E-W periodicity detected.'
+ ENDIF
- DO jlev = 1, nlev
- ik = nklev(jlev)
- u(:,:) = getvar(cfileu,'vozocrtx',ik ,npiglo, npjglo)
- v(:,:) = getvar(cfilev,'vomecrty',ik ,npiglo, npjglo)
-
- ua = 0. ; va = 0. ; ua(:,:) = 0. ; va(:,:)=0. ; vmod(:,:)=0.
- DO ji=2, npiglo
- DO jj=2,npjglo
- ua(ji,jj) = 0.5* (u(ji,jj)+ u(ji-1,jj))
- va(ji,jj) = 0.5* (v(ji,jj)+ v(ji,jj-1))
- vmod(ji,jj) = SQRT( ua(ji,jj)*ua(ji,jj) + va(ji,jj)*va(ji,jj) )
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, nlev )
+ ierr = createvar (ncout , stypvar, nvar, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, nlev, pdep=gdept )
+
+ DO jt = 1, npt
+ DO jlev = 1, nlev
+ ik = nklev(jlev)
+ uc(:,:) = getvar(cf_ufil, cn_vozocrtx, ik ,npiglo, npjglo, ktime=jt )
+ vc(:,:) = getvar(cf_vfil, cn_vomecrty, ik ,npiglo, npjglo, ktime=jt )
+
+ ua = 0. ; va = 0. ; ua(:,:) = 0. ; va(:,:)=0. ; vmod(:,:)=0.
+ DO ji=2, npiglo
+ DO jj=2,npjglo
+ ua(ji,jj) = 0.5* (uc(ji,jj)+ uc(ji-1,jj))
+ va(ji,jj) = 0.5* (vc(ji,jj)+ vc(ji,jj-1))
+ vmod(ji,jj) = SQRT( ua(ji,jj)*ua(ji,jj) + va(ji,jj)*va(ji,jj) )
+ END DO
END DO
+ IF ( lperio) THEN ! periodic E-W boundary ...
+ ua (1,:) = ua (npiglo-1,:)
+ va (1,:) = va (npiglo-1,:)
+ vmod(1,:) = vmod(npiglo-1,:)
+ ENDIF
+
+ ierr=putvar(ncout, id_varout(1), ua, jlev ,npiglo, npjglo, ktime=jt )
+ ierr=putvar(ncout, id_varout(2), va, jlev ,npiglo, npjglo, ktime=jt )
+ ierr=putvar(ncout, id_varout(3), vmod, jlev ,npiglo, npjglo, ktime=jt )
END DO
- ierr=putvar(ncout,id_varout(1), ua, jlev ,npiglo, npjglo)
- ierr=putvar(ncout,id_varout(2), va, jlev ,npiglo, npjglo)
- ierr=putvar(ncout,id_varout(3), vmod, jlev ,npiglo, npjglo)
END DO
IF ( lvertical ) THEN
- ! reuse u an v arrays to store Wk and Wk+1
- DO jlev=1, nlev-1
- u(:,:) = getvar(cfilew,'vovecrtz',nklev(jlev) ,npiglo, npjglo)
- v(:,:) = getvar(cfilew,'vovecrtz',nklev(jlev)+1 ,npiglo, npjglo)
- ua(:,:)=0.5*(u(:,:) + v(:,:))*1000. ! mm/sec
- ierr=putvar(ncout,id_varout(4), ua, jlev ,npiglo, npjglo)
- END DO
-
- IF (nlev == npk ) THEN
- ua(:,:)=0.e0
- ELSE
- u(:,:) = getvar(cfilew,'vovecrtz',nklev(nlev) ,npiglo, npjglo)
- v(:,:) = getvar(cfilew,'vovecrtz',nklev(nlev)+1 ,npiglo, npjglo)
- ua(:,:)=0.5*(u(:,:) + v(:,:))*1000. ! mm/sec
+ ! reuse uc an vc arrays to store Wk and Wk+1
+ DO jt = 1, npt
+ DO jlev=1, nlev - 1
+ uc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(jlev), npiglo, npjglo, ktime=jt )
+ vc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(jlev)+1, npiglo, npjglo, ktime=jt )
+ ua(:,:) = 0.5*(uc(:,:) + vc(:,:))*1000. ! mm/sec
+ ierr = putvar(ncout, id_varout(4), ua, jlev, npiglo, npjglo, ktime=jt )
+ uc(:,:) = vc(:,:)
+ END DO
+ IF ( nlev == npk ) THEN
+ ua(:,:) = 0.e0 ! npk
+ ELSE
+ uc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(nlev), npiglo, npjglo, ktime=jt )
+ vc(:,:) = getvar(cf_wfil, cn_vovecrtz, nklev(nlev)+1, npiglo, npjglo, ktime=jt )
+ ua(:,:) = 0.5*(uc(:,:) + vc(:,:))*1000. ! mm/sec
ENDIF
- ierr=putvar(ncout,id_varout(4), ua, nlev ,npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(4), ua, nlev ,npiglo, npjglo, ktime=jt )
+ ENDDO
ENDIF
- timean=getvar1d(cfileu,'time_counter',1)
- ierr=putvar1d(ncout,timean,1,'T')
- istatus = closeout(ncout)
+ tim = getvar1d(cf_ufil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+ ierr = closeout(ncout)
END PROGRAM cdfvita
diff --git a/cdfvsig.f90 b/cdfvsig.f90
index 8681b3f..c441c91 100644
--- a/cdfvsig.f90
+++ b/cdfvsig.f90
@@ -1,258 +1,292 @@
PROGRAM cdfvsig
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfvsig ***
+ !!======================================================================
+ !! *** PROGRAM cdfvsig ***
+ !!=====================================================================
+ !! ** Purpose : Compute the average values for the products
+ !! U.sig, V.sig, W.sig where sig is the potential density.
!!
- !! ** Purpose:
- !!
- !! ** Method: Try to avoid 3 d arrays
+ !! ** Method : pass the CONFIG name and a series of tags as arguments.
+ !! Tracers are interpolated on velocity points. The product
+ !! is evaluated at velocity points.
!!
- !! history :
- !! Original : J.M. Molines (Nov 2004 ) for ORCA025
- !! J.M. Molines (apr 2005 ) : use of modules
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2004 : J.M. Molines : Original code
+ !! 2.1 : 02/2010 : J.M. Molines : handle multiframes input files.
+ !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
USE eos
-
- !! * Local variables
+ USE modcdfnames
+ USE modutils
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk,jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc , ntags !:
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: zcumulusig, zcumulsigu, zcumulu !: Arrays for cumulated values
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: zcumulvsig, zcumulsigv, zcumulv !: Arrays for cumulated values
- REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: zcumulwsig, zcumulsigw, zcumulw !: Arrays for cumulated values
- REAL(KIND=8) :: total_time
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: umask, vmask, wmask !: mask of the velocity points
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztemp, zsal !: Array to read a layer of data
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztempu, zsalu !: Array to read a layer of data
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztempup, zsalup !: Array to read a layer of data
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztempv, zsalv !: Array to read a layer of data
- REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: ztempw, zsalw ,& !: Array to read a layer of data
- & zvitu, zvitv, zvitw , &
- & zworku, zworkv, zworkw , &
- & rmean
- REAL(KIND=4),DIMENSION(1) :: timean, tim
-
- CHARACTER(LEN=256) :: config , ctag !:
- CHARACTER(LEN=256) :: cfilet,cfileu,cfilev, cfilew
- CHARACTER(LEN=256) :: cfilmask='mask.nc'
- CHARACTER(LEN=256) :: cfilusig='usig.nc', cfilvsig='vsig.nc', cfilwsig='wsig.nc' !:
- INTEGER, DIMENSION(3) :: ipkusig, id_varoutusig,&
- ipkvsig, id_varoutvsig,&
- ipkwsig, id_varoutwsig
-
- TYPE (variable), DIMENSION(3) :: typvarusig ,& !: structure for attributes
- typvarvsig ,& !: structure for attributes
- typvarwsig !: structure for attributes
- LOGICAL :: lexist !: to inquire existence of files
-
- INTEGER :: ncoutusig, ncoutvsig, ncoutwsig
- INTEGER :: istatus
+
+ INTEGER(KIND=4) :: ji, jj, jk, jt, jtt ! dummy loop index
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: npiglo,npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ntframe ! Cumul of time frame
+ INTEGER(KIND=4) :: ncoutu ! ncid of output file
+ INTEGER(KIND=4) :: ncoutv ! ncid of output file
+ INTEGER(KIND=4) :: ncoutw ! ncid of output file
+ INTEGER(KIND=4), DIMENSION(3) :: ipku, id_varoutu ! level and varid's of output vars
+ INTEGER(KIND=4), DIMENSION(3) :: ipkv, id_varoutv ! level and varid's of output vars
+ INTEGER(KIND=4), DIMENSION(3) :: ipkw, id_varoutw ! level and varid's of output vars
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztemp, zsal ! Array to read a layer of data
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: zu, zv, zw ! Velocity component
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztempu, zsalu ! Array to read a layer of data
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztempv, zsalv ! Array to read a layer of data
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ztempw, zsalw ! Array to read a layer of data
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: umask, vmask, wmask ! masks
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter of individual files
+ REAL(KIND=4), DIMENSION(1) :: timean ! mean time
+
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulus ! Arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulvs ! Arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulws ! Arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulsu ! Arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulsv ! Arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulsw ! Arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulu ! Arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulv ! Arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dcumulw ! Arrays for cumulated values
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsigu ! Array for sigma0 at u point
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsigv ! Array for sigma0 at v point
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dsigw ! Array for sigma0 at w point
+ REAL(KIND=8) :: dtotal_time ! cumulated time
+
+ CHARACTER(LEN=256) :: cf_tfil ! TS file name
+ CHARACTER(LEN=256) :: cf_ufil ! zonal velocity file
+ CHARACTER(LEN=256) :: cf_vfil ! meridional velocity file
+ CHARACTER(LEN=256) :: cf_wfil ! vertical velocity file
+ CHARACTER(LEN=256) :: cf_outu='usig.nc' ! output file
+ CHARACTER(LEN=256) :: cf_outv='vsig.nc' ! output file
+ CHARACTER(LEN=256) :: cf_outw='wsig.nc' ! output file
+ CHARACTER(LEN=256) :: config ! configuration name
+ CHARACTER(LEN=256) :: ctag ! current tag to work with
+
+ TYPE (variable), DIMENSION(3) :: stypvaru ! structure for attributes
+ TYPE (variable), DIMENSION(3) :: stypvarv ! structure for attributes
+ TYPE (variable), DIMENSION(3) :: stypvarw ! structure for attributes
+
+ LOGICAL :: lcaltmean ! flag for mean time computation
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
!! Read command line
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfvsig CONFIG ''list_of_tags'' '
- PRINT *,' CONFIG is the CONFIG name (eg: ORCA025-G32 ) '
- PRINT *,' list_of_tags is the list of the time tags (y....m.. d..)'
- PRINT *,' on which the mean values of Usigma, Vsigma, Wsigma are computes'
- PRINT *,' Output on usig.nc variables vousig vosigu vozocrtx '
- PRINT *,' Output on vsig.nc variables vovsig vosigv vomecrty '
- PRINT *,' Output on wsig.nc variables vowsig vosigw vovecrtz '
+ PRINT *,' usage : cdfvsig CONFIG ''list_of_tags'' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the time average values for second order products '
+ PRINT *,' U.sig, V.sig and W.sig. Also save mean sigma-0 interpolated at'
+ PRINT *,' velocity points, as well as mean velocity component, for further use.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' CONFIG is the config name of a given experiment (eg ORCA025-G70)'
+ PRINT *,' The program will look for gridT, gridU, gridV and gridW files for'
+ PRINT *,' this config ( grid_T, grid_U, grid_V and grid_W are also accepted).'
+ PRINT *,' list_of_tags : a list of time tags that will be used for time'
+ PRINT *,' averaging. e.g. y2000m01d05 y2000m01d10 ...'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_outu),', ',TRIM(cf_outv),' and ', TRIM(cf_outw)
+ PRINT *,' variables : vousig, vovsig, vowsig : mean product v x sigma-0 '
+ PRINT *,' at velocity point.'
+ PRINT *,' vosigu, vosigv, vosigw : mean sigma-0 at velocity point.'
+ PRINT *,' ',TRIM(cn_vozocrtx),', ',TRIM(cn_vomecrty),', ',TRIM(cn_vovecrtz),' : mean velocity components.'
STOP
ENDIF
- ntags = narg -1 ! first argument is the config name
- !!
!! Initialisation from 1st file (all file are assume to have the same geometry)
CALL getarg (1, config)
- CALL getarg (2, ctag)
- cfilet=filnam(config, ctag,'T' )
- cfileu=filnam(config, ctag,'U' )
- cfilev=filnam(config, ctag,'V' )
- cfilew=filnam(config, ctag,'W' )
-
- PRINT *,TRIM(cfilet)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
- npk = getdim (cfilet,'depth')
-
- ipkusig(:)= npk ! all variables (input and output are 3D)
- ipkvsig(:)= npk ! all variables (input and output are 3D)
- ipkwsig(:)= npk ! all variables (input and output are 3D)
-
- ! define output variables
- typvarusig(1)%name= 'vousig' ; typvarvsig(1)%name= 'vovsig' ; typvarwsig(1)%name= 'vowsig'
- typvarusig(2)%name= 'vosigu' ; typvarvsig(2)%name= 'vosigv' ; typvarwsig(2)%name= 'vosigw'
- typvarusig(3)%name= 'vozocrtx' ; typvarvsig(3)%name= 'vomecrty' ; typvarwsig(3)%name= 'vovecrtz'
-
- typvarusig(1)%units='kg.m-2.s-1' ; typvarvsig(1)%units='kg.m-2.s-1' ; typvarwsig(1)%units='kg.m-2.s-1'
- typvarusig(2)%units='kg.m-3' ; typvarvsig(2)%units='kg.m-3' ; typvarwsig(2)%units='kg.m-3'
- typvarusig(3)%units='m.s-1' ; typvarvsig(3)%units='m.s-1' ; typvarwsig(3)%units='m.s-1'
-
- typvarusig%missing_value=0. ; typvarvsig%missing_value=0. ; typvarwsig%missing_value=0.
- typvarusig%valid_min= -100. ; typvarvsig%valid_min= -100. ; typvarwsig%valid_min= -100.
- typvarusig%valid_max= 100. ; typvarvsig%valid_max= 100. ; typvarwsig%valid_max= 100.
-
- typvarusig(1)%long_name='Mean U x sigma0' ; typvarvsig(1)%long_name='Mean V x sigma0'
- typvarwsig(1)%long_name='Mean W x sigma0'
- typvarusig(2)%long_name='Mean sigma0 at U point' ; typvarvsig(2)%long_name='Mean sigma0 at V point'
- typvarwsig(2)%long_name='Mean sigma0 at W point'
- typvarusig(3)%long_name='Mean zonal velocity' ; typvarvsig(3)%long_name='Mean meridional velocity'
- typvarwsig(3)%long_name='Mean vertical velocity'
-
- typvarusig(1)%short_name= 'vousig' ; typvarvsig(1)%short_name= 'vovsig' ; typvarwsig(1)%short_name= 'vowsig'
- typvarusig(2)%short_name= 'vosigu' ; typvarvsig(2)%short_name= 'vosigv' ; typvarwsig(2)%short_name= 'vosigw'
- typvarusig(3)%short_name= 'vozocrtx' ; typvarvsig(3)%short_name= 'vomecrty' ; typvarwsig(3)%short_name= 'vovecrtz'
-
- typvarusig%online_operation='N/A' ; typvarvsig%online_operation='N/A'; typvarwsig%online_operation='N/A'
- typvarusig%axis='TZYX' ; typvarvsig%axis='TZYX' ; typvarwsig%axis='TZYX'
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ALLOCATE( zcumulusig(npiglo,npjglo), zcumulsigu(npiglo,npjglo), zcumulu(npiglo,npjglo) )
- ALLOCATE( zcumulvsig(npiglo,npjglo), zcumulsigv(npiglo,npjglo), zcumulv(npiglo,npjglo) )
- ALLOCATE( zcumulwsig(npiglo,npjglo), zcumulsigw(npiglo,npjglo), zcumulw(npiglo,npjglo) )
- ALLOCATE( zvitu(npiglo,npjglo),zvitv(npiglo,npjglo),zvitw(npiglo,npjglo) )
- ALLOCATE( zworku(npiglo,npjglo),zworkv(npiglo,npjglo),zworkw(npiglo,npjglo) )
- ALLOCATE( ztemp(npiglo,npjglo) ,zsal(npiglo,npjglo) )
- ALLOCATE( ztempup(npiglo,npjglo) ,zsalup(npiglo,npjglo) )
- ALLOCATE( ztempu(npiglo,npjglo) ,zsalu(npiglo,npjglo) )
- ALLOCATE( ztempv(npiglo,npjglo) ,zsalv(npiglo,npjglo) )
- ALLOCATE( ztempw(npiglo,npjglo) ,zsalw(npiglo,npjglo) )
- ALLOCATE( rmean(npiglo,npjglo))
- ALLOCATE( umask(npiglo,npjglo), vmask(npiglo,npjglo), wmask(npiglo,npjglo) )
-
-
- ! create output fileset
-
- ncoutusig =create(cfilusig, cfileu, npiglo,npjglo,npk)
- ncoutvsig =create(cfilvsig, cfilev, npiglo,npjglo,npk)
- ncoutwsig =create(cfilwsig, cfilew, npiglo,npjglo,npk)
-
- ierr= createvar(ncoutusig ,typvarusig,3, ipkusig,id_varoutusig )
- ierr= createvar(ncoutvsig ,typvarvsig,3, ipkvsig,id_varoutvsig )
- ierr= createvar(ncoutwsig ,typvarwsig,3, ipkwsig,id_varoutwsig )
-
- ierr= putheadervar(ncoutusig, cfileu,npiglo, npjglo, npk )
- ierr= putheadervar(ncoutvsig, cfilev,npiglo, npjglo, npk )
- ierr= putheadervar(ncoutwsig, cfilew,npiglo, npjglo, npk )
-
+ CALL getarg (2, ctag )
+
+ cf_tfil = SetFileName ( config, ctag, 'T')
+ cf_ufil = SetFileName ( config, ctag, 'U')
+ cf_vfil = SetFileName ( config, ctag, 'V')
+ cf_wfil = SetFileName ( config, ctag, 'W')
+
+ npiglo = getdim (cf_tfil,cn_x)
+ npjglo = getdim (cf_tfil,cn_y)
+ npk = getdim (cf_tfil,cn_z)
+
+ ipku(:)= npk ! all variables (input and output are 3D)
+ ipkv(:)= npk ! " "
+ ipkw(:)= npk ! " "
+
+ ! define output variables U points
+ stypvaru%rmissing_value = 0.
+ stypvaru%valid_min = -100.
+ stypvaru%valid_max = 100.
+ stypvaru%conline_operation = 'N/A'
+ stypvaru%caxis = 'TZYX'
+
+ stypvaru(1)%cname = 'vousig' ; stypvaru(1)%cunits = 'kg.m-2.s-1'
+ stypvaru(2)%cname = 'vosigu' ; stypvaru(2)%cunits = 'kg.m-3'
+ stypvaru(3)%cname = cn_vozocrtx ; stypvaru(3)%cunits = 'm/s'
+
+ stypvaru(1)%clong_name = 'Mean U x sigma0' ; stypvaru(1)%cshort_name = 'vousig'
+ stypvaru(2)%clong_name = 'Mean sigma0 at U' ; stypvaru(2)%cshort_name = 'vosigu'
+ stypvaru(3)%clong_name = 'Mean zonal vel' ; stypvaru(3)%cshort_name = cn_vozocrtx
+
+ ! define output variables V points
+ stypvarv%rmissing_value = 0.
+ stypvarv%valid_min = -100.
+ stypvarv%valid_max = 100.
+ stypvarv%conline_operation = 'N/A'
+ stypvarv%caxis = 'TZYX'
+
+ stypvarv(1)%cname = 'vovsig' ; stypvarv(1)%cunits = 'kg.m-2.s-1'
+ stypvarv(2)%cname = 'vosigv' ; stypvarv(2)%cunits = 'kg.m-3'
+ stypvarv(3)%cname = cn_vomecrty ; stypvarv(3)%cunits = 'm/s'
+
+ stypvarv(1)%clong_name = 'Mean V x sigma0' ; stypvarv(1)%cshort_name = 'vovsig'
+ stypvarv(2)%clong_name = 'Mean sigma0 at V' ; stypvarv(2)%cshort_name = 'vosigv'
+ stypvarv(3)%clong_name = 'Mean merid vel' ; stypvarv(3)%cshort_name = cn_vomecrty
+
+ ! define output variables W points
+ stypvarw%rmissing_value = 0.
+ stypvarw%valid_min = -100.
+ stypvarw%valid_max = 100.
+ stypvarw%conline_operation = 'N/A'
+ stypvarw%caxis = 'TZYX'
+
+ stypvarw(1)%cname = 'vowsig' ; stypvarw(1)%cunits = 'kg.m-2.s-1'
+ stypvarw(2)%cname = 'vosigw' ; stypvarw(2)%cunits = 'kg.m-3'
+ stypvarw(3)%cname = cn_vovecrtz ; stypvarw(3)%cunits = 'm/s'
+
+ stypvarw(1)%clong_name = 'Mean W x sigma0' ; stypvarw(1)%cshort_name = 'vowsig'
+ stypvarw(2)%clong_name = 'Mean sigma0 at W' ; stypvarw(2)%cshort_name = 'vosigw'
+ stypvarw(3)%clong_name = 'Mean vert. vel' ; stypvarw(3)%cshort_name = cn_vovecrtz
+
+ PRINT *, 'npiglo =', npiglo
+ PRINT *, 'npjglo =', npjglo
+ PRINT *, 'npk =', npk
+
+ ALLOCATE( dcumulus(npiglo,npjglo), dcumulvs(npiglo,npjglo), dcumulws(npiglo,npjglo) )
+ ALLOCATE( dcumulsu(npiglo,npjglo), dcumulsv(npiglo,npjglo), dcumulsw(npiglo,npjglo) )
+ ALLOCATE( dcumulu(npiglo,npjglo), dcumulv(npiglo,npjglo), dcumulw(npiglo,npjglo) )
+ ALLOCATE( ztemp(npiglo,npjglo), zsal(npiglo,npjglo) )
+ ALLOCATE( zu(npiglo,npjglo), zv(npiglo,npjglo), zw(npiglo,npjglo) )
+ ALLOCATE( dsigu(npiglo,npjglo), dsigv(npiglo,npjglo), dsigw(npiglo,npjglo) )
+ ALLOCATE( umask(npiglo,npjglo), vmask(npiglo,npjglo), wmask(npiglo,npjglo) )
+
+ ! create output fileset
+ ncoutu = create (cf_outu, cf_ufil, npiglo, npjglo, npk )
+ ierr = createvar (ncoutu, stypvaru, 3, ipku, id_varoutu )
+ ierr = putheadervar(ncoutu, cf_ufil, npiglo, npjglo, npk )
+
+ ncoutv = create (cf_outv, cf_vfil, npiglo, npjglo, npk )
+ ierr = createvar (ncoutv, stypvarv, 3, ipkv, id_varoutv )
+ ierr = putheadervar(ncoutv, cf_vfil, npiglo, npjglo, npk )
+
+ ncoutw = create (cf_outw, cf_wfil, npiglo, npjglo, npk )
+ ierr = createvar (ncoutw, stypvarw, 3, ipku, id_varoutw )
+ ierr = putheadervar(ncoutw, cf_wfil, npiglo, npjglo, npk )
+
+ lcaltmean=.TRUE.
DO jk = 1, npk
PRINT *,'level ',jk
- total_time = 0.
- zcumulusig(:,:) = 0.d0 ; zcumulvsig(:,:) = 0.d0 ; zcumulwsig(:,:) = 0.d0
- zcumulsigu(:,:) = 0.d0 ; zcumulsigv(:,:) = 0.d0 ; zcumulsigw(:,:) = 0.d0
- zcumulu(:,:) = 0.d0 ; zcumulv(:,:) = 0.d0 ; zcumulw(:,:) = 0.d0
-
- umask(:,:)= getvar(cfilmask, 'umask' , jk ,npiglo, npjglo )
- vmask(:,:)= getvar(cfilmask, 'vmask' , jk ,npiglo, npjglo )
- wmask(:,:)= getvar(cfilmask, 'tmask' , jk ,npiglo, npjglo )
-
- DO jt = 2, narg
+ dcumulus(:,:) = 0.d0 ; dcumulvs(:,:) = 0.d0 ; dcumulws(:,:) = 0.d0
+ dcumulsu(:,:) = 0.d0 ; dcumulsv(:,:) = 0.d0 ; dcumulsw(:,:) = 0.d0
+ dcumulu(:,:) = 0.d0 ; dcumulv(:,:) = 0.d0 ; dcumulw(:,:) = 0.d0
+ dtotal_time = 0.d0 ; ntframe = 0
+
+ umask(:,:) = getvar(cn_fmsk, 'umask' , jk, npiglo, npjglo )
+ vmask(:,:) = getvar(cn_fmsk, 'vmask' , jk, npiglo, npjglo )
+ wmask(:,:) = getvar(cn_fmsk, 'tmask' , jk, npiglo, npjglo )
+
+ DO jt = 2, narg ! loop on tags
CALL getarg (jt, ctag)
- cfilet=filnam(config,ctag,'T')
- cfileu=filnam(config,ctag,'U')
- cfilev=filnam(config,ctag,'V')
- cfilew=filnam(config,ctag,'W')
-
- IF (jk == 1 ) THEN
- tim=getvar1d(cfilet,'time_counter',1)
- total_time = total_time + tim(1)
+ cf_tfil = SetFileName ( config, ctag, 'T' )
+ cf_ufil = SetFileName ( config, ctag, 'U' )
+ cf_vfil = SetFileName ( config, ctag, 'V' )
+ cf_wfil = SetFileName ( config, ctag, 'W' )
+
+ npt = getdim (cf_tfil, cn_t)
+ IF ( lcaltmean ) THEN
+ ALLOCATE ( tim(npt) )
+ tim = getvar1d(cf_tfil, cn_vtimec, npt)
+ dtotal_time = dtotal_time + SUM(tim(1:npt) )
+ DEALLOCATE( tim )
END IF
- zvitu(:,:)= getvar(cfileu, 'vozocrtx' , jk ,npiglo, npjglo )
- zvitv(:,:)= getvar(cfilev, 'vomecrty' , jk ,npiglo, npjglo )
- zvitw(:,:)= getvar(cfilew, 'vovecrtz' , jk ,npiglo, npjglo )
- ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo )
- zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo )
-
- ! density horizontal flux
- zworku(:,:) = 0. ; zworkv(:,:) = 0.
- DO ji=1, npiglo-1
- DO jj = 1, npjglo -1
- ztempu(ji,jj) = 0.5 * ( ztemp(ji,jj) + ztemp(ji+1,jj) ) ! temper at Upoint
- zsalu(ji,jj) = 0.5 * ( zsal(ji,jj) + zsal(ji+1,jj) ) ! temper at Upoint
- ztempv(ji,jj) = 0.5 * ( ztemp(ji,jj) + ztemp(ji,jj+1) ) ! temper at Vpoint
- zsalv(ji,jj) = 0.5 * ( zsal(ji,jj) + zsal(ji,jj+1) ) ! temper at Upoint
+ DO jtt = 1, npt ! loop on time frame in a single file
+ ntframe = ntframe+1
+ zu(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jtt )
+ zv(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jtt )
+ zw(:,:) = getvar(cf_wfil, cn_vovecrtz, jk, npiglo, npjglo, ktime=jtt )
+ ztemp(:,:) = getvar(cf_tfil, cn_votemper, jk, npiglo, npjglo, ktime=jtt )
+ zsal(:,:) = getvar(cf_tfil, cn_vosaline, jk, npiglo, npjglo, ktime=jtt )
+
+ ! temperature at u point, v points
+ dsigu(:,:) = 0.d0 ; dsigv(:,:) = 0.d0
+ DO ji=1, npiglo-1
+ DO jj = 1, npjglo -1
+ ztempu(ji,jj) = 0.5 * ( ztemp(ji,jj) + ztemp(ji+1,jj) ) ! temper at Upoint
+ ztempv(ji,jj) = 0.5 * ( ztemp(ji,jj) + ztemp(ji,jj+1) ) ! temper at Vpoint
+ zsalu(ji,jj) = 0.5 * ( zsal(ji,jj) + zsal(ji+1,jj) ) ! sal at U point
+ zsalv(ji,jj) = 0.5 * ( zsal(ji,jj) + zsal(ji,jj+1) ) ! sal at v point
+ END DO
END DO
- END DO
- zworku(:,:)=sigma0(ztempu, zsalu,npiglo, npjglo) * umask(:,:)
- zworkv(:,:)=sigma0(ztempv, zsalv,npiglo, npjglo) * vmask(:,:)
-
- zcumulusig(:,:) = zcumulusig(:,:) + zworku(:,:) * zvitu(:,:)
- zcumulvsig(:,:) = zcumulvsig(:,:) + zworkv(:,:) * zvitv(:,:)
- zcumulsigu(:,:) = zcumulsigu(:,:) + zworku(:,:)
- zcumulsigv(:,:) = zcumulsigv(:,:) + zworkv(:,:)
- zcumulu(:,:) = zcumulu(:,:) + zvitu(:,:)
- zcumulv(:,:) = zcumulv(:,:) + zvitv(:,:)
-
- IF (jk > 1 ) THEN ! compute wsig
- ztempw=0.5*(ztempup + ztemp)
- zsalw=0.5*(zsalup + zsal)
- zworkw=sigma0(ztempw, zsalw, npiglo,npjglo) * wmask (:,:) ! yes w mask is ok from up to down
- zcumulwsig(:,:)=zcumulwsig(:,:) + zworkw(:,:) * zvitw(:,:)
- zcumulsigw(:,:)=zcumulsigw(:,:) + zworkw(:,:)
- zcumulw(:,:) = zcumulw(:,:) + zvitw(:,:)
- ENDIF
- ! save upper T and S for next jk vertical interp at w point
- ztempup=ztemp
- zsalup=zsal
-
- END DO ! time loop
-
+
+ dsigu(:,:) = sigma0(ztempu, zsalu, npiglo, npjglo) * umask(:,:)
+ dsigv(:,:) = sigma0(ztempv, zsalv, npiglo, npjglo) * vmask(:,:)
+
+ dcumulus(:,:) = dcumulus(:,:) + dsigu(:,:) * zu(:,:) * 1.d0
+ dcumulvs(:,:) = dcumulvs(:,:) + dsigv(:,:) * zv(:,:) * 1.d0
+ dcumulsu(:,:) = dcumulsu(:,:) + dsigu(:,:) * 1.d0
+ dcumulsv(:,:) = dcumulsv(:,:) + dsigv(:,:) * 1.d0
+ dcumulu(:,:) = dcumulu(:,:) + zu(:,:) * 1.d0
+ dcumulv(:,:) = dcumulv(:,:) + zv(:,:) * 1.d0
+
+ IF ( jk > 1 ) THEN ! now wsig
+ ztempw(:,:) = 0.5 * ( ztemp(:,:) + getvar(cf_tfil, cn_votemper, jk-1, npiglo, npjglo, ktime=jtt ))
+ zsalw(:,:) = 0.5 * ( zsal(:,:) + getvar(cf_tfil, cn_vosaline, jk-1, npiglo, npjglo, ktime=jtt ))
+ dsigw(:,:) = sigma0(ztempw, zsalw, npiglo, npjglo) * wmask(:,:)
+ dcumulws(:,:) = dcumulws(:,:) + dsigw(:,:) * zw(:,:) * 1.d0
+ dcumulsw(:,:) = dcumulsw(:,:) + dsigw(:,:) * 1.d0
+ dcumulw(:,:) = dcumulw(:,:) + zw(:,:) * 1.d0
+ ENDIF
+
+ END DO !jtt
+ END DO ! jt
! finish with level jk ; compute mean (assume spval is 0 )
- rmean(:,:) = zcumulusig(:,:)/ntags ; ierr = putvar(ncoutusig, id_varoutusig(1) ,rmean, jk,npiglo, npjglo )
- rmean(:,:) = zcumulsigu(:,:)/ntags ; ierr = putvar(ncoutusig, id_varoutusig(2) ,rmean, jk,npiglo, npjglo )
- rmean(:,:) = zcumulu(:,:)/ntags ; ierr = putvar(ncoutusig, id_varoutusig(3) ,rmean, jk,npiglo, npjglo )
-
- rmean(:,:) = zcumulvsig(:,:)/ntags ; ierr = putvar(ncoutvsig, id_varoutvsig(1) ,rmean, jk,npiglo, npjglo )
- rmean(:,:) = zcumulsigv(:,:)/ntags ; ierr = putvar(ncoutvsig, id_varoutvsig(2) ,rmean, jk,npiglo, npjglo )
- rmean(:,:) = zcumulv(:,:)/ntags ; ierr = putvar(ncoutvsig, id_varoutvsig(3) ,rmean, jk,npiglo, npjglo )
-
- rmean(:,:) = zcumulwsig(:,:)/ntags ; ierr = putvar(ncoutwsig, id_varoutwsig(1) ,rmean, jk,npiglo, npjglo )
- rmean(:,:) = zcumulsigw(:,:)/ntags ; ierr = putvar(ncoutwsig, id_varoutwsig(2) ,rmean, jk,npiglo, npjglo )
- rmean(:,:) = zcumulw(:,:)/ntags ; ierr = putvar(ncoutwsig, id_varoutwsig(3) ,rmean, jk,npiglo, npjglo )
-
- IF (jk == 1 ) THEN
- timean(1)= total_time/ntags
- ierr=putvar1d(ncoutusig,timean,1,'T')
- ierr=putvar1d(ncoutvsig,timean,1,'T')
- ierr=putvar1d(ncoutwsig,timean,1,'T')
+ ierr = putvar(ncoutu, id_varoutu(1), SNGL(dcumulus(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe )
+ ierr = putvar(ncoutu, id_varoutu(2), SNGL(dcumulsu(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe )
+ ierr = putvar(ncoutu, id_varoutu(3), SNGL(dcumulu(:,:) /ntframe), jk, npiglo, npjglo, kwght=ntframe )
+
+ ierr = putvar(ncoutv, id_varoutv(1), SNGL(dcumulvs(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe )
+ ierr = putvar(ncoutv, id_varoutv(2), SNGL(dcumulsv(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe )
+ ierr = putvar(ncoutv, id_varoutv(3), SNGL(dcumulv(:,:) /ntframe), jk, npiglo, npjglo, kwght=ntframe )
+
+ ierr = putvar(ncoutw, id_varoutw(1), SNGL(dcumulws(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe )
+ ierr = putvar(ncoutw, id_varoutw(2), SNGL(dcumulsw(:,:)/ntframe), jk, npiglo, npjglo, kwght=ntframe )
+ ierr = putvar(ncoutw, id_varoutw(3), SNGL(dcumulw(:,:) /ntframe), jk, npiglo, npjglo, kwght=ntframe )
+
+ IF ( lcaltmean ) THEN
+ timean(1) = dtotal_time/ntframe
+ ierr = putvar1d(ncoutu, timean, 1, 'T')
+ ierr = putvar1d(ncoutv, timean, 1, 'T')
+ ierr = putvar1d(ncoutw, timean, 1, 'T')
END IF
+ lcaltmean = .FALSE. ! tmean already computed
+
END DO ! loop to next level
- istatus = closeout(ncoutusig)
- istatus = closeout(ncoutvsig)
- istatus = closeout(ncoutwsig)
-
- CONTAINS
-
- CHARACTER(LEN=256) FUNCTION filnam(cdconf, cdtag, cdgrid)
- !!------------------------------------------------------
- !! ** Purpose : build filename from config tag and grid
- !!------------------------------------------------------
- CHARACTER(LEN=*), INTENT(in) :: cdconf, cdtag, cdgrid
- WRITE(filnam,'(a,"_",a,"_grid",a,".nc")') TRIM(config),TRIM(ctag),TRIM(cdgrid)
- INQUIRE(FILE=filnam,EXIST=lexist)
- IF ( .NOT. lexist ) THEN
- WRITE(filnam,'(a,"_",a,"_grid_",a,".nc")') TRIM(config),TRIM(ctag), TRIM(cdgrid)
- INQUIRE(FILE=filnam,EXIST=lexist)
- IF ( .NOT. lexist ) THEN
- PRINT *,' ERROR : missing grid',TRIM(cdgrid),'or even grid_',TRIM(cdgrid),' file '
- STOP
- ENDIF
- ENDIF
- END FUNCTION filnam
+ ierr = closeout(ncoutu)
+ ierr = closeout(ncoutv)
+ ierr = closeout(ncoutw)
END PROGRAM cdfvsig
diff --git a/cdfvtrp.f90 b/cdfvtrp.f90
index dc0617c..a144655 100644
--- a/cdfvtrp.f90
+++ b/cdfvtrp.f90
@@ -1,138 +1,257 @@
PROGRAM cdfvtrp
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfvtrp ***
+ !!======================================================================
+ !! *** PROGRAM cdfvtrp ***
+ !!=====================================================================
+ !! ** Purpose : Compute verticaly integrated transport.
!!
- !! ** Purpose : Compute Verticaly integrated Heat Salt Transport.
- !! PARTIAL STEPS
- !!
- !! ** Method : Compute the 2D fields somevt, somevs and sozout, sozous
- !! as the integral on the vertical of ut, vt, us, vs
- !! Save on the nc file
+ !! ** Method : Read the velocity components, and computed the verticaly
+ !! averaged transport at each grid cell ( velocity location).
!!
- !!
- !! history ;
- !! Original : J.M. Molines (jan. 2005) (known then as cdfheattrp-save.f90 )
- !! J.M. Molines : use module
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 01/2005 : J.M. Molines : Original code
+ !! : 01/2008 : P. Mathiot for -lbathy option
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic., merge
+ !! with cdftrp_bathy
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jk !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout
- INTEGER, DIMENSION(4) :: ipk, id_varout !
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, e1v, e3v !: mask, metrics
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u !: mask, metrics
- REAL(KIND=4) ,DIMENSION(1) :: tim
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: ierr, ireq ! working integer
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: nvarout = 2 ! number of output variables
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipk, id_varout ! for variable output
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku , zwkv, zu, zv
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrpu, ztrpv
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1u, e1v ! horizontal metrics
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e2v ! " "
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e3u, e3v ! vertical metrics
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: tmask, hdepw ! tmask and bathymetry
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdhdx, zdhdy ! bottom slope
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zalpha ! angle of rotation
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zu, zv ! velocity components
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! e3t metrics (full step)
- CHARACTER(LEN=256) :: cfileu, cfilev , cfileoutnc='trp.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc'
- TYPE (variable), DIMENSION(4) :: typvar !: structure for attribute
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dwku , dwkv ! working arrays
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dtrpu, dtrpv ! barotropic transport
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: stypvar ! structure for attribute
- INTEGER :: istatus
+ CHARACTER(LEN=256) :: cf_ufil ! input U- file
+ CHARACTER(LEN=256) :: cf_vfil ! input V- file
+ CHARACTER(LEN=256) :: cf_out='trp.nc' ! output file
+ CHARACTER(LEN=256) :: cv_soastrp='soastrp' ! Along Slope TRansPort
+ CHARACTER(LEN=256) :: cv_socstrp='socstrp' ! Cross Slope TRansPort
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
- ! constants
+ LOGICAL :: lfull = .FALSE. ! flag for full step
+ LOGICAL :: lbathy = .FALSE. ! flag for slope current
+ LOGICAL :: lchk = .FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line and output usage message if not compliant.
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfvtrp Ufile Vfile '
- PRINT *,' Computes the vertically integrated transports at each grid cell'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc must be in te current directory'
- PRINT *,' Output on trp.nc, variables somevtrp sozoutrp '
+ PRINT *,' usage : cdfvtrp U-file V-file [ -full ] [ -bathy ]'
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes the vertically integrated transports at each grid cell.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' U-file : netcdf gridU file'
+ PRINT *,' V-file : netcdf gridV file'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr)
+ PRINT *,' ',TRIM(cn_fmsk),' is required only with -bathy option.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-full ] : To be used in case of full step configuration.'
+ PRINT *,' Default is partial steps.'
+ PRINT *,' [-bathy ] : When used, cdfvtrp also compute the along slope'
+ PRINT *,' and cross slope transport components.'
+ PRINT *,' Bathymetry is read from ',TRIM(cn_fzgr),' file.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : '
+ PRINT *,' ', TRIM(cn_sozoutrp),' : zonal transport.'
+ PRINT *,' ', TRIM(cn_somevtrp),' : meridional transport.'
+ PRINT *,' If option -bathy is used :'
+ PRINT *,' ', TRIM(cv_soastrp),' : along slope transport'
+ PRINT *,' ', TRIM(cv_socstrp),' : cross slope transport'
STOP
ENDIF
- CALL getarg (1, cfileu)
- CALL getarg (2, cfilev)
- npiglo= getdim (cfileu,'x')
- npjglo= getdim (cfileu,'y')
- npk = getdim (cfileu,'depth')
-
- ! define new variables for output
- typvar(2)%name= 'somevtrp'
- typvar(1)%name= 'sozoutrp'
+ ! scan command line and set flags
+ ijarg = 1 ; ireq=0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg(ijarg, cldum) ; ijarg=ijarg+1
+ SELECT CASE ( cldum )
+ CASE ('-full' ) ; lfull = .TRUE.
+ CASE ('-bathy' ) ; lbathy = .TRUE. ; nvarout = 4
+ CASE DEFAULT
+ ireq=ireq+1 ! required arguments
+ SELECT CASE ( ireq )
+ CASE ( 1 ) ; cf_ufil = cldum
+ CASE ( 2 ) ; cf_vfil = cldum
+ END SELECT
+ END SELECT
+ ENDDO
+
+ ! file existence check
+ lchk = lchk .OR. chkfile ( cn_fzgr )
+ lchk = lchk .OR. chkfile ( cn_fhgr )
+ lchk = lchk .OR. chkfile ( cf_ufil )
+ lchk = lchk .OR. chkfile ( cf_vfil )
+ IF ( lbathy ) lchk = lchk .OR. chkfile ( cn_fmsk )
+ IF ( lchk ) STOP ! missing files
- typvar(1)%units='m3/s'
- typvar(2)%units='m3/s'
+ ALLOCATE ( ipk(nvarout), id_varout(nvarout), stypvar(nvarout) )
- typvar%missing_value=0.
- typvar%valid_min= -100.
- typvar%valid_max= 100.
+ npiglo = getdim (cf_ufil, cn_x)
+ npjglo = getdim (cf_ufil, cn_y)
+ npk = getdim (cf_ufil, cn_z)
+ npt = getdim (cf_ufil, cn_t)
- typvar(2)%long_name='Z_Integrated_Meridional_mass_transport'
- typvar(1)%long_name='Z_Integrated_Zonal_mass_transport'
+ ! define variables for output
+ ipk(:) = 1 ! all 2D variables
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = -100.
+ stypvar%valid_max = 100.
+ stypvar%cunits = 'm3/s'
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TYX'
- typvar(2)%short_name='somevtrp'
- typvar(1)%short_name='sozoutrp'
+ stypvar(1)%cname = cn_sozoutrp ; stypvar(2)%cname = cn_somevtrp
+ stypvar(1)%clong_name = 'Zonal_barotropic_transport' ; stypvar(2)%clong_name = 'Meridional_barotropic_transport'
+ stypvar(1)%cshort_name = cn_sozoutrp ; stypvar(2)%cshort_name = cn_somevtrp
- typvar%online_operation='N/A'
- typvar%axis='TYX'
+ IF ( lbathy ) THEN
+ stypvar(3)%cname = cv_soastrp ; stypvar(4)%cname = cv_socstrp
+ stypvar(3)%clong_name = 'Along_Slope_Barotropic_Transp' ; stypvar(4)%clong_name = 'Cross_Slope_Barotropic_Transp'
+ stypvar(3)%cshort_name = cv_soastrp ; stypvar(4)%cshort_name = cv_socstrp
+ ENDIF
- ipk(1) = 1 ! 2D
- ipk(2) = 1 ! 2D
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
+ ALLOCATE ( e1v(npiglo,npjglo), e3v(npiglo,npjglo) )
+ ALLOCATE ( e2u(npiglo,npjglo), e3u(npiglo,npjglo) )
+ ALLOCATE ( zu(npiglo,npjglo), zv(npiglo,npjglo) )
+ ALLOCATE ( dwku(npiglo,npjglo), dwkv(npiglo,npjglo) )
+ ALLOCATE ( dtrpu(npiglo,npjglo), dtrpv(npiglo,npjglo))
+ ALLOCATE ( e31d(npk), tim(npt) )
- ALLOCATE ( e1v(npiglo,npjglo),e3v(npiglo,npjglo))
- ALLOCATE ( e2u(npiglo,npjglo),e3u(npiglo,npjglo))
- ALLOCATE ( zwku(npiglo,npjglo), zwkv(npiglo,npjglo))
- ALLOCATE ( ztrpu(npiglo,npjglo), ztrpv(npiglo,npjglo))
- ALLOCATE ( zu(npiglo,npjglo), zv(npiglo,npjglo))
-
+ IF ( lbathy ) THEN ! allocate extra arrays
+ ALLOCATE ( e1u(npiglo, npjglo), e2v(npiglo, npjglo))
+ ALLOCATE ( tmask(npiglo,npjglo), hdepw(npiglo, npjglo) )
+ ALLOCATE ( zdhdx(npiglo,npjglo), zdhdy(npiglo, npjglo) )
+ ALLOCATE ( zalpha(npiglo,npjglo) )
+ ENDIF
! create output fileset
- ncout =create(cfileoutnc, cfileu, npiglo,npjglo,1)
- ierr= createvar(ncout ,typvar,2, ipk,id_varout )
- ierr= putheadervar(ncout, cfileu,npiglo, npjglo,1)
- tim=getvar1d(cfileu,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
-
- e1v(:,:) = getvar(coordhgr, 'e1v', 1,npiglo,npjglo)
- e2u(:,:) = getvar(coordhgr, 'e2u', 1,npiglo,npjglo)
-
- ztrpu(:,:)= 0
- ztrpv(:,:)= 0
- DO jk = 1,npk
- PRINT *,'level ',jk
- ! Get temperature and salinity at jk
- zu(:,:)= getvar(cfileu, 'vozocrtx', jk ,npiglo,npjglo)
- zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo)
-
- ! get e3v at level jk
- e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo, ldiom=.true.)
- e3u(:,:) = getvar(coordzgr, 'e3u_ps', jk,npiglo,npjglo, ldiom=.true.)
- zwku(:,:) = zu(:,:)*e2u(:,:)*e3u(:,:)
- zwkv(:,:) = zv(:,:)*e1v(:,:)*e3v(:,:)
- ! integrates vertically
- ztrpu(:,:) = ztrpu(:,:) + zwku(:,:)
- ztrpv(:,:) = ztrpv(:,:) + zwkv(:,:)
-
- END DO ! loop to next level
+ ncout = create (cf_out, cf_ufil, npiglo, npjglo, 1 )
+ ierr = createvar (ncout, stypvar, nvarout, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_ufil, npiglo, npjglo, 1 )
+
+ tim = getvar1d(cf_ufil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ e1v(:,:) = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo)
+ e2u(:,:) = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo)
+ IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk )
- ierr = putvar(ncout, id_varout(1) ,REAL(ztrpu(:,:)), 1, npiglo, npjglo)
- ierr = putvar(ncout, id_varout(2) ,REAL(ztrpv(:,:)), 1, npiglo, npjglo)
+ IF ( lbathy ) THEN ! read extra metrics
+ e1u(:,:) = getvar(cn_fhgr, cn_ve1u, 1, npiglo, npjglo)
+ e2v(:,:) = getvar(cn_fhgr, cn_ve2v, 1, npiglo, npjglo)
+ tmask(:,:) = getvar(cn_fmsk, 'tmask', 1, npiglo, npjglo)
+ hdepw(:,:) = getvar(cn_fzgr, cn_hdepw, 1, npiglo, npjglo)
+ ENDIF
+
+ DO jt = 1, npt
+ dtrpu(:,:)= 0.d0
+ dtrpv(:,:)= 0.d0
+ DO jk = 1,npk
+ PRINT *,'level ',jk
+ ! Get velocities at jk
+ zu(:,:)= getvar(cf_ufil, cn_vozocrtx, jk ,npiglo, npjglo, ktime=jt)
+ zv(:,:)= getvar(cf_vfil, cn_vomecrty, jk ,npiglo, npjglo, ktime=jt)
+
+ ! get e3v at level jk
+ IF ( lfull ) THEN
+ e3v(:,:) = e31d(jk)
+ e3u(:,:) = e31d(jk)
+ ELSE
+ e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+ dwku(:,:) = zu(:,:)*e2u(:,:)*e3u(:,:)*1.d0
+ dwkv(:,:) = zv(:,:)*e1v(:,:)*e3v(:,:)*1.d0
+ ! integrates vertically
+ dtrpu(:,:) = dtrpu(:,:) + dwku(:,:)
+ dtrpv(:,:) = dtrpv(:,:) + dwkv(:,:)
+
+ END DO ! loop to next level
+
+ ierr = putvar(ncout, id_varout(1) ,REAL(dtrpu(:,:)), 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(2) ,REAL(dtrpv(:,:)), 1, npiglo, npjglo, ktime=jt)
+
+ IF ( lbathy ) THEN
+ ! compute transport component at T point
+ dwku(:,:) = 0.d0 ! U direction
+ DO jj=1, npjglo
+ DO ji= 2,npiglo
+ dwku(ji,jj) = 0.5 * ( dtrpu(ji,jj) + dtrpu(ji-1,jj) )
+ ENDDO
+ ! E-W periodicity :
+ dwku(1,jj) = dwku(npiglo-1, jj)
+ ENDDO
+ dwkv(:,:) = 0.d0 ! V direction
+ DO jj=2, npjglo
+ DO ji= 1,npiglo
+ dwkv(ji,jj) = 0.5 * ( dtrpv(ji,jj) + dtrpv(ji,jj-1) )
+ ENDDO
+ ENDDO
+
+ ! compute bathymetric slope at T point (centered scheme)
+ zdhdx = 0.e0 ! U direction
+ DO jj=1,npjglo
+ DO ji=2, npiglo-1
+ zdhdx(ji,jj) = ( hdepw(ji+1,jj) - hdepw(ji-1,jj)) / ( e1u(ji,jj) + e1u(ji-1,jj) ) * tmask(ji,jj)
+ END DO
+ END DO
+
+ zdhdy = 0.e0 ! V direction
+ DO jj=2,npjglo-1
+ DO ji=1, npiglo
+ zdhdy(ji,jj) = ( hdepw(ji,jj+1) - hdepw(ji,jj-1)) / ( e2v(ji,jj) + e2v(ji,jj-1) ) * tmask(ji,jj)
+ END DO
+ END DO
+
+ ! compute the angle between the bathymetric slope and model coordinates
+ zalpha(:,:) = ATAN2( zdhdx, zdhdy ) * tmask(:,:)
+
+ ! apply the rotation on the transport
+ dtrpu(:,:) = ( dwku(:,:) * COS(zalpha) + dwkv(:,:)* SIN(zalpha) ) * tmask(:,:)
+ dtrpv(:,:) = ( -dwku(:,:) * SIN(zalpha) + dwkv(:,:)* COS(zalpha) ) * tmask(:,:)
+
+ ierr = putvar(ncout, id_varout(3) ,REAL(dtrpu(:,:)), 1, npiglo, npjglo, ktime=jt)
+ ierr = putvar(ncout, id_varout(4) ,REAL(dtrpv(:,:)), 1, npiglo, npjglo, ktime=jt)
+ ENDIF
+ END DO
- istatus = closeout (ncout)
+ ierr = closeout (ncout)
- END PROGRAM cdfvtrp
+END PROGRAM cdfvtrp
diff --git a/cdfw.f90 b/cdfw.f90
index a095586..fc50f13 100644
--- a/cdfw.f90
+++ b/cdfw.f90
@@ -1,149 +1,202 @@
PROGRAM cdfw
- !!---------------------------------------------------------------------------
- !! *** PROGRAM cdfw ***
+ !!======================================================================
+ !! *** PROGRAM cdfw ***
+ !!=====================================================================
+ !! ** Purpose : Compute the 3D w for given gridU gridV files
+ !! and variables
!!
- !! ** Purpose: Compute the 3D w for given gridU gridV files and variables
- !!
- !! ** Method : Use the equation on continuity: Integrate the horizontal
- !! divergence from bottom to the top.
- !! ( Use the same routines than in the code )
- !! PARTIAL STEPS
+ !! ** Method : Use the equation on continuity: Integrate the
+ !! horizontal divergence from bottom to the top.
+ !! ( Use the same routines than in the NEMO code )
!!
- !! history :
- !! Original : J.M. Molines (June 2005)
- !!---------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 06/2005 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: ji,jj,jk !: dummy loop index
- INTEGER :: npiglo, npjglo, npk !: size of the domain
- INTEGER :: narg, iargc, ncout, ierr !:
- INTEGER, DIMENSION(1) :: ipk, id_varout !
- INTEGER :: itop = 1 , ibot = 2 , itmp
-
- REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: e1v, e2u, e1t, e2t !: metrics
- REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: e3u,e3v,e3t !: ""
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: glamt, gphit !: longitude latitude
- REAL(kind=4), DIMENSION(:) , ALLOCATABLE :: gdepw !:
- REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: un, vn
- REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: hdivn
- REAL(kind=4), DIMENSION(:,:,:), ALLOCATABLE :: wn !: vertical velocity on the top
- ! !: and bottom of a cell.
- ! !: wn(top) is computed
- REAL(KIND=4) ,DIMENSION(1) :: tim
-
- CHARACTER(LEN=256) :: cfilu, cfilv
- CHARACTER(LEN=256) :: chgr='mesh_hgr.nc', czgr='mesh_zgr.nc', cfileout='w.nc'
- CHARACTER(LEN=256) :: cvaru='vozocrtx', cvarv='vomecrty', cvarw='vovecrtz'
-
- TYPE(variable), DIMENSION(1) :: typvar !: structure for attributes
- !!
+ INTEGER(KIND=4) :: ji, jj, jk, jt ! dummy loop index
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: ierr ! error status
+ INTEGER(KIND=4) :: itop = 1 ! top array index
+ INTEGER(KIND=4) :: ibot = 2 ! bottom array index
+ INTEGER(KIND=4) :: itmp ! working integer for level swap
+ INTEGER(KIND=4), DIMENSION(1) :: ipk, id_varout ! levels and varid's of output vars
+
+ REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: wn ! vertical velocity on the top
+ ! ! and bottom of a cell.
+ ! ! wn(top) is computed
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1t, e2t ! horizontal T metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e1v, e2u ! horizontal V and U metrics
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: e3u, e3v, e3t ! vertical metrics (partial steps)
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glamt, gphit ! T longitude latitude
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: un, vn ! horizontal velocity component
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: hdivn ! horizontal divergence
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: gdepw ! depth of W points
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: e31d ! vertical metrics ( full step)
+
+ CHARACTER(LEN=256) :: cf_ufil ! U file name
+ CHARACTER(LEN=256) :: cf_vfil ! V file name
+ CHARACTER(LEN=256) :: cf_out='w.nc' ! W file name ( output)
+ CHARACTER(LEN=256) :: cldum ! dummy string
+
+ TYPE(variable), DIMENSION(1) :: stypvar ! output attributes
+
+ LOGICAL :: lchk ! missing files flag
+ LOGICAL :: lfull=.FALSE. ! full step flag
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg = iargc()
IF ( narg < 2 ) THEN
- PRINT *,' USAGE : cdfw fileU fileV [varU varV] '
- PRINT *,' version PARTIAL STEPS '
- PRINT *,' Produce a cdf file w.nc with vovecrtz variable'
- PRINT *,' Need mesh_hgr.nc mesh_zgr.nc'
- PRINT *,' If no varU and varV variables given, assume vozocrtx, vomecrty'
+ PRINT *,' usage : cdfw U-file V-file [ U-var V-var ] [ -full]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the vertical velocity from the vertical integration of'
+ PRINT *,' of the horizontal divergence of the velocity.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' U-file : netcdf file with the zonal velocity component.'
+ PRINT *,' V-file : netcdf file with the meridional velocity component.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [ U-var V-var ] : names of the zonal and meridional velocity '
+ PRINT *,' components. Default are ', TRIM(cn_vozocrtx),' and ', TRIM(cn_vomecrty)
+ PRINT *,' [ -full ] : in case of full step configuration. Default is partial step.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fhgr),' and ',TRIM(cn_fzgr)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : ', TRIM(cn_vovecrtz),' (m/s)'
STOP
ENDIF
- CALL getarg(1, cfilu)
- CALL getarg(2, cfilv)
- IF ( narg >2 ) THEN
- CALL getarg(3, cvaru)
- CALL getarg(4, cvarv)
- ENDIF
-
- npiglo = getdim(cfilu,'x')
- npjglo = getdim(cfilu,'y')
- npk = getdim(cfilu,'depth')
-
- ! define new variables for output ( must update att.txt)
- typvar(1)%name= TRIM(cvarw)
- typvar(1)%units='m/s'
- typvar(1)%missing_value=0.
- typvar(1)%valid_min= -1.
- typvar(1)%valid_max= 1.
- typvar(1)%long_name='Vertical_Velocity'
- typvar(1)%short_name=TRIM(cvarw)
- typvar(1)%online_operation='N/A'
- typvar(1)%axis='TZYX'
-
- ipk(1) = npk ! 3D
+ ijarg = 1
+ CALL getarg(ijarg, cf_ufil) ; ijarg = ijarg + 1
+ CALL getarg(ijarg, cf_vfil) ; ijarg = ijarg + 1
+
+ DO WHILE (ijarg <= narg )
+ CALL getarg(ijarg, cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-full' )
+ lfull = .TRUE.
+ CASE DEFAULT
+ CALL getarg(ijarg, cn_vozocrtx) ; ijarg = ijarg + 1
+ CALL getarg(ijarg, cn_vomecrty) ; ijarg = ijarg + 1
+ END SELECT
+ END DO
+
+ lchk = chkfile (cn_fhgr)
+ lchk = chkfile (cn_fzgr) .OR. lchk
+ lchk = chkfile (cf_ufil) .OR. lchk
+ lchk = chkfile (cf_vfil) .OR. lchk
+ IF ( lchk ) STOP ! missing files
+
+ npiglo = getdim(cf_ufil,cn_x)
+ npjglo = getdim(cf_ufil,cn_y)
+ npk = getdim(cf_ufil,cn_z)
+ npt = getdim(cf_ufil,cn_t)
+
+ ! define new variables for output
+ ipk(1) = npk
+ stypvar(1)%cname = TRIM(cn_vovecrtz)
+ stypvar(1)%cunits = 'm/s'
+ stypvar(1)%rmissing_value = 0.
+ stypvar(1)%valid_min = -1.
+ stypvar(1)%valid_max = 1.
+ stypvar(1)%clong_name = 'Vertical_Velocity'
+ stypvar(1)%cshort_name = TRIM(cn_vovecrtz)
+ stypvar(1)%conline_operation = 'N/A'
+ stypvar(1)%caxis = 'TZYX'
! Allocate the memory
- ALLOCATE ( e1v(npiglo,npjglo) ,e2u(npiglo,npjglo) )
- ALLOCATE ( e1t(npiglo,npjglo) ,e2t(npiglo,npjglo) )
- ALLOCATE ( e3u(npiglo,npjglo) ,e3v(npiglo,npjglo) ,e3t(npiglo,npjglo) )
+ ALLOCATE ( e1v(npiglo,npjglo), e2u(npiglo,npjglo) )
+ ALLOCATE ( e1t(npiglo,npjglo), e2t(npiglo,npjglo) )
+ ALLOCATE ( e3u(npiglo,npjglo), e3v(npiglo,npjglo), e3t(npiglo,npjglo) )
ALLOCATE ( glamt(npiglo,npjglo), gphit(npiglo,npjglo) )
- ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) ,hdivn(npiglo,npjglo) )
- ALLOCATE ( wn(npiglo,npjglo,2) , gdepw(npk) )
+ ALLOCATE ( un(npiglo,npjglo), vn(npiglo,npjglo), hdivn(npiglo,npjglo) )
+ ALLOCATE ( wn(npiglo,npjglo,2) )
+ ALLOCATE ( gdepw(npk), tim(npt) )
+ IF ( lfull ) ALLOCATE ( e31d (npk) )
! Read the metrics from the mesh_hgr file
- e2u= getvar(chgr, 'e2u', 1,npiglo,npjglo)
- e1v= getvar(chgr, 'e1v', 1,npiglo,npjglo)
- e1t= getvar(chgr, 'e1t', 1,npiglo,npjglo)
- e2t= getvar(chgr, 'e2t', 1,npiglo,npjglo)
+ e2u = getvar(cn_fhgr, cn_ve2u, 1, npiglo, npjglo)
+ e1v = getvar(cn_fhgr, cn_ve1v, 1, npiglo, npjglo)
+ e1t = getvar(cn_fhgr, cn_ve1t, 1, npiglo, npjglo)
+ e2t = getvar(cn_fhgr, cn_ve2t, 1, npiglo, npjglo)
! and the coordinates from the mesh_hgr file
- glamt = getvar(chgr, 'glamt', 1,npiglo,npjglo)
- gphit = getvar(chgr, 'gphit', 1,npiglo,npjglo)
+ glamt = getvar(cn_fhgr, cn_glamt, 1, npiglo, npjglo)
+ gphit = getvar(cn_fhgr, cn_gphit, 1, npiglo, npjglo)
! Read the depth of the w points (in the file, it is not a vector but a 1x1xnpk array)
- gdepw(:) = getvare3(czgr,'gdepw',npk)
+ gdepw(:) = getvare3(cn_fzgr, cn_gdepw, npk)
+ IF ( lfull ) e31d(:) = getvare3(cn_fzgr, cn_ve3t, npk)
! create output fileset
- ncout =create(cfileout, cfilu, npiglo,npjglo,npk,cdep='depthw')
- ierr= createvar(ncout ,typvar,1, ipk,id_varout )
- ierr= putheadervar(ncout, 'dummy', npiglo, npjglo, npk, glamt, gphit, gdepw )
-
-
- tim=getvar1d(cfilu,'time_counter',1)
- ierr=putvar1d(ncout,tim,1,'T')
-
- wn(:,:,:) = 0.
-
- ! Main level loop from bottom to top
- DO jk = npk-1, 1, -1
- print *,' jk = ', jk
-
- ! veloccities at level jk
- un(:,:) = getvar(cfilu, cvaru, jk ,npiglo,npjglo)
- vn(:,:) = getvar(cfilv, cvarv, jk ,npiglo,npjglo)
-
- ! e3 metrics at level jk ( Partial steps)
- e3u(:,:) = getvar(czgr,'e3u_ps',jk ,npiglo,npjglo, ldiom=.true.)
- e3v(:,:) = getvar(czgr,'e3v_ps',jk ,npiglo,npjglo, ldiom=.true.)
- e3t(:,:) = getvar(czgr,'e3t_ps',jk ,npiglo,npjglo, ldiom=.true.)
-
- ! Compute divergence :
- DO jj = 2, npjglo -1
- DO ji = 2, npiglo -1
- hdivn(ji,jj) = &
- ( e2u(ji,jj)*e3u(ji,jj) * un(ji,jj) - e2u(ji-1,jj )*e3u(ji-1,jj) * un(ji-1,jj ) &
- + e1v(ji,jj)*e3v(ji,jj) * vn(ji,jj) - e1v(ji ,jj-1)*e3v(ji ,jj-1) * vn(ji ,jj-1) ) &
- / ( e1t(ji,jj) * e2t(ji,jj) * e3t(ji,jj) )
+ ncout = create (cf_out, cf_ufil, npiglo, npjglo, npk, cdep=cn_vdepthw )
+ ierr = createvar (ncout, stypvar, 1, ipk, id_varout )
+ ierr = putheadervar(ncout, 'dummy', npiglo, npjglo, npk, glamt, gphit, gdepw )
+
+ tim = getvar1d(cf_ufil, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ DO jt = 1, npt
+ wn(:,:,:) = 0.
+ ! Main level loop from bottom to top
+ DO jk = npk-1, 1, -1
+ PRINT *,'jt = ', jt,' jk = ', jk
+
+ ! velocities at level jk
+ un(:,:) = getvar(cf_ufil, cn_vozocrtx, jk, npiglo, npjglo, ktime=jt)
+ vn(:,:) = getvar(cf_vfil, cn_vomecrty, jk, npiglo, npjglo, ktime=jt)
+
+ IF ( lfull ) THEN
+ e3u(:,:) = e31d(jk)
+ e3v(:,:) = e31d(jk)
+ e3t(:,:) = e31d(jk)
+ ELSE
+ ! e3 metrics at level jk ( Partial steps)
+ e3u(:,:) = getvar(cn_fzgr, 'e3u_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ e3v(:,:) = getvar(cn_fzgr, 'e3v_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ e3t(:,:) = getvar(cn_fzgr, 'e3t_ps', jk, npiglo, npjglo, ldiom=.TRUE.)
+ ENDIF
+
+ ! Compute divergence :
+ DO jj = 2, npjglo -1
+ DO ji = 2, npiglo -1
+ hdivn(ji,jj) = &
+ & ( e2u(ji,jj)*e3u(ji,jj) * un(ji,jj) - e2u(ji-1,jj )*e3u(ji-1,jj ) * un(ji-1,jj ) &
+ & + e1v(ji,jj)*e3v(ji,jj) * vn(ji,jj) - e1v(ji ,jj-1)*e3v(ji ,jj-1) * vn(ji ,jj-1) ) &
+ & / ( e1t(ji,jj)*e2t(ji,jj) * e3t(ji,jj) )
+ END DO
END DO
- END DO
- ! Computation from the bottom
- wn(:,:,itop) = wn(:,:,ibot) - e3t(:,:) * hdivn(:,:)
+ ! Computation from the bottom
+ wn(:,:,itop) = wn(:,:,ibot) - e3t(:,:) * hdivn(:,:)
+
+ ! write wn on file at level jk (This coculd be epensive at it writes from the bottom ...
+ ierr = putvar(ncout, id_varout(1), wn(:,:,itop), jk, npiglo, npjglo, ktime=jt)
- ! write wn on file at level jk (This coculd be epensive at it writes from the bottom ...
- ierr = putvar(ncout, id_varout(1) ,wn(:,:,itop), jk ,npiglo, npjglo)
+ ! swap top and bottom index
+ itmp=itop ; itop=ibot ; ibot=itmp
- ! swap top and bottom index
- itmp=itop ; itop = ibot ; ibot = itmp
+ END DO ! loop to next level
+ END DO ! loop on time
- ENDDO ! loop to next level
ierr = closeout(ncout)
diff --git a/cdfweight.f90 b/cdfweight.f90
index 874162c..7c7bfd6 100644
--- a/cdfweight.f90
+++ b/cdfweight.f90
@@ -1,541 +1,428 @@
PROGRAM cdfweight
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfweight ***
+ !!======================================================================
+ !! *** PROGRAM cdfweight ***
+ !!=====================================================================
+ !! ** Purpose : Compute a wheight file for further bi-linear colocalisation
+ !! done with cdfcoloc.
!!
- !! ** Purpose : return a binary weight file to be used by cdfcoloc
- !!
- !! ** Method : Use Greg Holloway iyxz.txt file type as input, to specify
- !! the points to search in the model grid.
- !! Read the coordinate/mesh_hgr file and look
- !! for the glam, gphi variables
- !! Then use a seach algorithm to find the corresponding I J
- !! The point type ( T U V F ) is specified on the command line
- !! as well as the name of the coordinate/mesh hgr file.
+ !! ** Method : Use Greg Holloway iyxz.txt file type as input, to specify
+ !! the points to search in the model grid.
+ !! Read the coordinate/mesh_hgr file and look
+ !! for the glam, gphi variables
+ !! Then use a search algorithm to find the corresponding I J
+ !! The point type ( T U V F ) is specified on the command line
+ !! as well as the name of the coordinate/mesh hgr file.
+ !! If -2d option is used, only horizontal weight are produced.
!!
- !! history ;
- !! Original : J.M. Molines (November 2005 )
- !! J.M. Molines (May 2007 for weight)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.0 : 11/2005 : J.M. Molines : Original code
+ !! : 05/2007 : J.M. Molines : for weight
+ !! 3.0 : 03/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! SUBROUTINE localcoord( palpha, pbeta, plam, pphi)
+ !! FUNCTION det(p1,p2,p3,p4)
+ !! FUNCTION heading(plona, plonb, plata, platb)
+ !!----------------------------------------------------------------------
USE cdfio
- !! * Local variables
+ USE cdftools ! cdf_find_ij
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: narg, iargc, niter
- INTEGER :: jk
- INTEGER :: imin, jmin
- INTEGER :: iloc, jloc, kloc
- INTEGER :: npiglo, npjglo, iquadran, npk
- INTEGER :: numgreg=10, numbin=20, ios
-
- ! Greg Holloway input data
- INTEGER :: id
- REAL(KIND=8) :: xmin, ymin
- REAL(KIND=4) :: dep
-
- REAL(KIND=8) :: emax, hPp !: local maximum metrics
- REAL(KIND=8) :: glam0 !: longitude of grid point ji=1
- REAL(KIND=8) :: glamin, gphimin !: coordinates of the nearest point (NP)
- REAL(KIND=8) :: glamN, gphiN, hN !: grid point North of NP, true heding from NP
- REAL(KIND=8) :: glamE, gphiE, hE !: grid point East of NP, true heding from NP
- REAL(KIND=8) :: glamS, gphiS, hS !: grid point South of NP, true heding from NP
- REAL(KIND=8) :: glamW, gphiW, hW !: grid point West of NP, true heding from NP
- REAL(KIND=8), DIMENSION(0:4) :: glami, gphii !: the 4 grid points around target (1-4) + the target (0)
- REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: glam, gphi, e1, e2 !: grid layout and metrics
- REAL(KIND=8), DIMENSION(:) , ALLOCATABLE :: gdept !: vertical depth
- REAL(KIND=8) :: hP, rdis !: true heading and distance of target point from NP
- REAL(KIND=8) :: alpha, beta, gamma !: reduced coordinates (0-1) in the NP gridcell
- !: vertical weight
-
- CHARACTER(LEN=256) :: coord='coordinates.nc', ctype='F', cfile, czgr='mesh_zgr.nc'
- CHARACTER(LEN=256) :: cweight !: weight file name
-
- LOGICAL :: lagain, lbord, ldebug=.false. !: additional debug print if ldebug=true
-
- !! Read command line and output usage message if not compliant.
+
+ INTEGER(KIND=4) :: jk ! dummy loop counter
+ INTEGER(KIND=4) :: idum ! dummy working integer
+ INTEGER(KIND=4) :: narg, iargc, iarg ! Argument management
+ INTEGER(KIND=4) :: iimin, ijmin ! i j position of target point
+ INTEGER(KIND=4) :: ikloc ! k position of target point
+ INTEGER(KIND=4) :: npiglo, npjglo, npk ! domain size
+ INTEGER(KIND=4) :: iquadran ! quadran
+ INTEGER(KIND=4) :: numgreg=10 ! logical unit of ASCII input file
+ INTEGER(KIND=4) :: numbin=20 ! logical unit of BINARY weight file
+ INTEGER(KIND=4) :: ios ! iostat variable
+ ! Greg Holloway input data ( 5 variables)
+ INTEGER(KIND=4) :: id ! station ID
+ REAL(KIND=4) :: xmin, ymin, rdep ! longitude, latitude, depth
+
+ REAL(KIND=8) :: dl_xmin, dl_ymin
+ REAL(KIND=8) :: dl_hPp ! local maximum metrics
+ REAL(KIND=8) :: dl_lam0 ! longitude of grid point ji=1
+ REAL(KIND=8) :: dl_lamin, dl_phimin ! coordinates of the nearest point (NP)
+ REAL(KIND=8) :: dl_lamN, dl_phiN, dl_hN ! grid point North of NP, true heading from NP
+ REAL(KIND=8) :: dl_lamE, dl_phiE, dl_hE ! grid point East of NP, true heading from NP
+ REAL(KIND=8) :: dl_lamS, dl_phiS, dl_hS ! grid point South of NP, true heading from NP
+ REAL(KIND=8) :: dl_lamW, dl_phiW, dl_hW ! grid point West of NP, true heading from NP
+ REAL(KIND=8), DIMENSION(0:4) :: dl_lami, dl_phii ! the 4 grid points around target (1-4)
+ ! + the target (0)
+ REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: dl_lam, dl_phi ! grid layout and metrics
+ REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: dl_dept ! vertical depth
+ REAL(KIND=8) :: dl_hP ! true heading of target point from NP
+ REAL(KIND=8) :: dl_alpha, dl_beta ! reduced coordinates (0-1) in the NP gridcell
+ REAL(KIND=8) :: dl_gam ! vertical weight
+
+ CHARACTER(LEN=256) :: cf_coord, cf_in ! file names (in)
+ CHARACTER(LEN=256) :: cf_weight ! weight file name (out)
+ CHARACTER(LEN=256) :: ctype, cldum ! C-grid type point, dummy character
+
+ LOGICAL :: lldebug = .FALSE. ! verbose/debug flag
+ LOGICAL :: ll2d = .FALSE. ! 2D field flag
+ LOGICAL :: llchk = .FALSE. ! for checking missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
+ ! default values
+ cf_coord = cn_fcoo
+ ctype = 'F'
+
narg= iargc()
- IF ( narg < 1 ) THEN
- PRINT *,' Usage : cdfweight Greg_File [coord_file] [point_type]'
- PRINT *,' return the i,j position for the x,y point (nearest point ) '
- PRINT *,' as read in coord_file for the point type specified by point_type'
- PRINT *, TRIM(czgr),' files must be present in the current dir'
- PRINT *, 'if not given as argument, ',TRIM(coord),' must also be present in current dir'
- PRINT *, 'produce a weight file called weight_point_type.bin'
- PRINT *,' Example : cdfweight iyxz7904.txt coordinate_ORCA025.nc F '
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfweight [-f] IN-file [-c COORD-file] ... '
+ PRINT *,' ... [-t point_type] [-2d] [-v] '
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Produce a weight file for further bilinear collocalisation '
+ PRINT *,' with cdfcoloc program. It takes the position of the points'
+ PRINT *,' to be collocated into a simple ascii file. '
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' [-f ] IN-file : input file is a iyxz ASCII file, 1 line per point.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-c COORD-file] : coordinate file [',TRIM(cf_coord),']'
+ PRINT *,' [-t point_type] : point type on C-grid (either T U V or F ) [',TRIM(ctype),']'
+ PRINT *,' [-2d ] : tell cdfweight that only 2D weights are to be computed.'
+ PRINT *,' [-v ] : Verbose mode for extra information (debug mode).'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cf_coord),' file if not passed as argument.'
+ PRINT *,' If working with 3D files, ',TRIM(cn_fzgr),' is required.'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' binary weight file : weight_point_type.bin'
+ PRINT *,' standard output : almost the same info that is saved in the binary file'
+ PRINT *,' When using -v option, even more informations !'
STOP
ENDIF
- CALL getarg (1, cfile )
- ! if 3rd argument not given coordinates.nc is assumed
- IF ( narg > 1 ) THEN
- CALL getarg (2, coord )
- ENDIF
- ! if 4th argument not given, assume F point
- IF ( narg == 3 ) THEN
- CALL getarg (3, ctype )
+ iarg=1
+ DO WHILE (iarg <= narg )
+ CALL getarg(iarg, cldum) ; iarg=iarg+1
+ SELECT CASE ( cldum )
+ CASE ('-f' ) ; CALL getarg(iarg, cf_in ) ; iarg=iarg+1
+ CASE ('-c' ) ; CALL getarg(iarg, cf_coord) ; iarg=iarg+1
+ CASE ('-t' ) ; CALL getarg(iarg, ctype ) ; iarg=iarg+1
+ CASE ('-2d') ; ll2d = .TRUE.
+ CASE ('-v' ) ; lldebug = .TRUE.
+ CASE DEFAULT ; CALL getarg(iarg, cf_in ) ; iarg=iarg+1 ! if no switch assume file name
+ END SELECT
+ END DO
+
+ llchk = llchk .OR. chkfile(cf_in)
+ llchk = llchk .OR. chkfile(cf_coord)
+ IF ( .NOT. ll2d ) llchk = llchk .OR. chkfile(cn_fzgr)
+ IF ( llchk ) STOP ! missing files
+
+ npiglo = getdim (cf_coord,cn_x)
+ npjglo = getdim (cf_coord,cn_y)
+
+ IF ( .NOT. ll2d ) THEN
+ npk = getdim (cn_fzgr,cn_z )
+ ALLOCATE (dl_dept(npk) )
+ ! read depth of model T points (hence U and V)
+ dl_dept(:)=getvare3(cn_fzgr, cn_gdept, npk)
ENDIF
- npiglo= getdim (coord,'x')
- npjglo= getdim (coord,'y')
- npk= getdim (czgr,'z')
-
- ALLOCATE (glam(npiglo,npjglo), gphi(npiglo,npjglo) )
- ALLOCATE (e1(npiglo,npjglo), e2(npiglo,npjglo),gdept(npk) )
+ ALLOCATE (dl_lam(npiglo,npjglo), dl_phi(npiglo,npjglo) )
! set name and open output weight file
- WRITE(cweight,'("weight_",a,".bin")') TRIM(ctype)
- OPEN(numbin, FILE=cweight,FORM='unformatted')
-
- ! read depth of model T points (hence U and V)
- gdept(:)=getvare3(czgr,'gdept',npk)
+ WRITE(cf_weight,'("weight_",a,".bin")') TRIM(ctype)
+ OPEN(numbin, FILE=cf_weight,FORM='unformatted')
SELECT CASE ( ctype )
CASE ('T' , 't' )
- glam(:,:) = getvar(coord, 'glamt',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphit',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1t' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2t' ,1,npiglo,npjglo)
+ dl_lam(:,:) = getvar(cf_coord, cn_glamt, 1, npiglo, npjglo)
+ dl_phi(:,:) = getvar(cf_coord, cn_gphit, 1, npiglo, npjglo)
CASE ('U','u' )
- glam(:,:) = getvar(coord, 'glamu',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphiu',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1u' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2u' ,1,npiglo,npjglo)
+ dl_lam(:,:) = getvar(cf_coord, cn_glamu, 1, npiglo, npjglo)
+ dl_phi(:,:) = getvar(cf_coord, cn_gphiu, 1, npiglo, npjglo)
CASE ('V','v' )
- glam(:,:) = getvar(coord, 'glamv',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphiv',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1v' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2v' ,1,npiglo,npjglo)
+ dl_lam(:,:) = getvar(cf_coord, cn_glamv, 1, npiglo, npjglo)
+ dl_phi(:,:) = getvar(cf_coord, cn_gphiv, 1, npiglo, npjglo)
CASE ('F','f' )
- glam(:,:) = getvar(coord, 'glamf',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphif',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1f' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2f' ,1,npiglo,npjglo)
+ dl_lam(:,:) = getvar(cf_coord, cn_glamf, 1, npiglo, npjglo)
+ dl_phi(:,:) = getvar(cf_coord, cn_gphif, 1, npiglo, npjglo)
CASE DEFAULT
PRINT *,' ERROR : type of point not known: ', TRIM(ctype)
END SELECT
! work with longitude between 0 and 360 to avoid the date line.
- WHERE( glam < 0 ) glam(:,:)=glam(:,:)+360.
+ WHERE( dl_lam < 0 ) dl_lam(:,:)=dl_lam(:,:)+360.d0
! For Orca grid, the longitude of ji=1 is about 70 E
- glam0=glam(1, npjglo/2)
- WHERE( glam < glam0 ) glam=glam+360.
+ dl_lam0 = dl_lam(1, npjglo/2)
+ WHERE( dl_lam < dl_lam0 ) dl_lam=dl_lam+360.d0
- OPEN(numgreg,FILE=cfile)
+ OPEN(numgreg,FILE=cf_in)
! Greg (Holloway) files are iyxz.txt file
ios=0
! loop for each line of Greg File
DO WHILE (ios == 0 )
- READ(numgreg,*,iostat=ios) id,ymin,xmin,dep
+ READ(numgreg,*,iostat=ios) id,ymin,xmin,rdep
+ dl_xmin=xmin ; dl_ymin=ymin
IF( ios == 0 ) THEN ! EOF not reached
- ! look for kloc = k index of point above dep
- kloc=1
- DO jk=1, npk-1
- IF ( dep >= gdept(jk) ) THEN
- kloc=jk
- ELSE
- EXIT
+ IF ( .NOT. ll2d ) THEN
+ ! Look for vertical position
+ ! ikloc = k index of point above rdep
+ ikloc=1
+ DO WHILE ( dl_dept(ikloc) <= rdep .AND. ikloc < npk )
+ ikloc = ikloc+1
+ ENDDO
+ ikloc = ikloc -1 ! up one level
+
+ ! compute dl_gam such that Vint= (1-dl_gam) x V(ikloc) + dl_gam x V(ikloc +1)
+ dl_gam=(rdep - dl_dept(ikloc))/(dl_dept(ikloc+1)-dl_dept(ikloc) )
+
+ IF (ikloc == npk -1 ) dl_gam = 0.d0
+
+ IF ( dl_gam < 0 ) THEN
+ ikloc=1
+ dl_gam = 0.d0
ENDIF
- ENDDO
- ! compute gamma such that Vint= (1-gamma) x V(kloc) + gamma x V(kloc +1)
- gamma=(dep - gdept(kloc))/(gdept(kloc+1)-gdept(kloc) )
- IF (kloc == npk -1 ) gamma=0
- IF ( ldebug) print '("DEP", f8.1,i8,f8.0,f8.4)', gdept(kloc), dep, gdept(kloc+1), gamma
- IF ( gamma < 0 ) THEN
- kloc=1
- gamma = 0.
- ENDIF
- IF ( gamma > 1 ) THEN
- kloc=npk -1
- gamma = 0.
+ IF ( dl_gam > 1 ) THEN
+ ikloc=npk -1
+ dl_gam = 0.d0
+ ENDIF
+ ELSE
+ dl_gam = 0.d0
ENDIF
- ! Now deal with horizontal interpolation
- ! set longitude of input point in accordance with glam ( [glam0, 360+glam0 [ )
- IF ( xmin < 0. ) xmin = xmin + 360.
- IF ( xmin < glam0 ) xmin = xmin + 360.
-
- lagain = .TRUE. ; niter = 0
- DO WHILE (lagain)
- CALL Nearestpoint(xmin,ymin,npiglo,npjglo,glam,gphi,iloc,jloc,lbord)
- ! distance between the target point and the nearest point
- rdis=dist(xmin,glam(iloc,jloc),ymin,gphi(iloc,jloc) ) ! in km
+ IF ( lldebug) PRINT '("DEP", f8.1,i8,f8.0,f8.4)', dl_dept(ikloc), rdep, dl_dept(ikloc+1), dl_gam
- ! typical grid size (diagonal) in the vicinity of nearest point
- emax= MAX(e1(iloc,jloc),e2(iloc,jloc))/1000.*SQRT(2.) ! in km
+ ! Now deal with horizontal interpolation
+ CALL cdf_findij ( xmin, xmin, ymin, ymin, iimin, idum, ijmin, idum, cd_coord=cf_coord, cd_point=ctype)
+ IF ( iimin /= -1000 .AND. ijmin /= -1000 ) THEN
! Latitude and longitude of the neighbours on the grid
! define longitudes between 0 and 360 deg
- glamin=MOD(glam(iloc,jloc),360.d0) ; gphimin=gphi(iloc,jloc) ! nearest point
- glamN=MOD(glam(iloc,jloc+1),360.d0) ; gphiN=gphi(iloc,jloc+1) ! N (grid)
- glamE=MOD(glam(iloc+1,jloc),360.d0) ; gphiE=gphi(iloc+1,jloc) ! E (grid)
- glamS=MOD(glam(iloc,jloc-1),360.d0) ; gphiS=gphi(iloc,jloc-1) ! S (grid)
- glamW=MOD(glam(iloc-1,jloc),360.d0) ; gphiW=gphi(iloc-1,jloc) ! W (grid)
-
- IF (rdis > emax ) THEN
- ! The nearest point was not found, try one iteration (jmm ???)
- IF ( niter < 2 ) THEN
- lagain = .TRUE.
- jloc = npjglo-2 ! change initial point
- niter = niter +1
- ELSE
- ! set iloc, jloc to -1000 -1000 ( flag value)
- lagain = .FALSE.
- iloc=-1000 ; jloc=-1000
- ENDIF
- ELSE
- ! The nearest point is found
- lagain = .FALSE.
- END IF
- END DO ! iteration loop
-
- ! transfert Nearest point to imin, jmin
- imin=iloc
- jmin=jloc
-
- ! Restore target point longitude between 0 and 360
- xmin=MOD(xmin,360.d0)
-
- ! Compute heading of target point and neighbours from the nearest point
- hP=heading(glamin,xmin,gphimin,ymin) ! target point
- hN=heading(glamin,glamN,gphimin,gphiN) ! 'north' on the grid
- hE=heading(glamin,glamE,gphimin,gphiE) ! 'east' on the grid
- hS=heading(glamin,glamS,gphimin,gphiS) ! 'south' on the grid
- hW=heading(glamin,glamW,gphimin,gphiW) ! 'west' on the grid
-
- ! determine the sector in wich the target point is located: ( from 1, to 4 resp. NE, SE, SW, NW of the grid)
- iquadran=4
- ! to avoid problem with the GW meridian, pass to -180, 180 when working around GW
- IF ( hP > 180 ) THEN
- hPp=hP-360
- ELSE
- hPp=hP
- ENDIF
+ dl_lamin = MOD(dl_lam(iimin ,ijmin ),360.d0) ; dl_phimin = dl_phi(iimin ,ijmin ) ! nearest point
+ dl_lamN = MOD(dl_lam(iimin ,ijmin+1),360.d0) ; dl_phiN = dl_phi(iimin ,ijmin+1) ! N (grid)
+ dl_lamE = MOD(dl_lam(iimin+1,ijmin ),360.d0) ; dl_phiE = dl_phi(iimin+1,ijmin ) ! E (grid)
+ dl_lamS = MOD(dl_lam(iimin ,ijmin-1),360.d0) ; dl_phiS = dl_phi(iimin ,ijmin-1) ! S (grid)
+ dl_lamW = MOD(dl_lam(iimin-1,ijmin ),360.d0) ; dl_phiW = dl_phi(iimin-1,ijmin ) ! W (grid)
+
+ ! Compute heading of target point and neighbours from the nearest point
+ dl_hP = heading(dl_lamin, dl_xmin, dl_phimin, dl_ymin) ! target point
+ dl_hN = heading(dl_lamin, dl_lamN, dl_phimin, dl_phiN) ! 'north' on the grid
+ dl_hE = heading(dl_lamin, dl_lamE, dl_phimin, dl_phiE) ! 'east' on the grid
+ dl_hS = heading(dl_lamin, dl_lamS, dl_phimin, dl_phiS) ! 'south' on the grid
+ dl_hW = heading(dl_lamin, dl_lamW, dl_phimin, dl_phiW) ! 'west' on the grid
+
+ ! determine the sector in wich the target point is located:
+ ! ( from 1, to 4 resp. NE, SE, SW, NW of the grid)
+ iquadran = 4
+ ! to avoid problem with the GW meridian, pass to -180, 180 when working around GW
+ IF ( dl_hP > 180.d0 ) THEN
+ dl_hPp = dl_hP - 360.d0
+ dl_hPp = dl_hP
+ ENDIF
- IF ( hN > hE ) hN=hN -360.
- IF ( hPp > hN .AND. hPp <= hE ) iquadran=1
- IF ( hP > hE .AND. hP <= hS ) iquadran=2
- IF ( hP > hS .AND. hP <= hW ) iquadran=3
- IF ( hP > hW .AND. hPp <= hN) iquadran=4
-
- glami(0) = xmin ; gphii(0) = ymin ! fill glami, gphii for 0 = target point
- glami(1) = glamin ; gphii(1) = gphimin ! 1 = nearest point
- IF ( iloc /= -1000 ) THEN
- SELECT CASE ( iquadran ) ! point 2 3 4 are counter clockwise in the respective sector
- CASE ( 1 )
- glami(2) = glamE ; gphii(2) = gphiE
- glami(3) = MOD(glam(imin+1,jmin+1), 360.d0) ; gphii(3) = gphi(imin+1,jmin+1)
- glami(4) = glamN ; gphii(4) = gphiN
- CASE ( 2 )
- glami(2) = glamS ; gphii(2) = gphiS
- glami(3) = MOD(glam(imin+1,jmin-1), 360.d0) ; gphii(3) = gphi(imin+1,jmin-1)
- glami(4) = glamE ; gphii(4) = gphiE
- CASE ( 3 )
- glami(2) = glamW ; gphii(2) = gphiW
- glami(3) = MOD(glam(imin-1,jmin-1), 360.d0) ; gphii(3) = gphi(imin-1,jmin-1)
- glami(4) = glamS ; gphii(4) = gphiS
- CASE ( 4 )
- glami(2) = glamN ; gphii(2) = gphiN
- glami(3) = MOD(glam(imin-1,jmin+1), 360.d0) ; gphii(3) = gphi(imin-1,jmin+1)
- glami(4) = glamW ; gphii(4) = gphiW
- END SELECT
-
- ! resolve a non linear system of equation for alpha and beta ( the non dimensional coordinates of target point)
- CALL localcoord( alpha, beta, glami, gphii)
+ IF ( dl_hN > dl_hE ) dl_hN = dl_hN - 360.d0
+ IF ( dl_hPp > dl_hN .AND. dl_hPp <= dl_hE ) iquadran = 1
+ IF ( dl_hP > dl_hE .AND. dl_hP <= dl_hS ) iquadran = 2
+ IF ( dl_hP > dl_hS .AND. dl_hP <= dl_hW ) iquadran = 3
+ IF ( dl_hP > dl_hW .AND. dl_hPp <= dl_hN ) iquadran = 4
+
+ dl_lami(0) = xmin ; dl_phii(0) = ymin ! fill dl_lami, dl_phii for 0 = target point
+ dl_lami(1) = dl_lamin ; dl_phii(1) = dl_phimin ! 1 = nearest point
+ SELECT CASE ( iquadran ) ! point 2 3 4 are counter clockwise in the respective sector
+ CASE ( 1 )
+ dl_lami(2) = dl_lamE ; dl_phii(2) = dl_phiE
+ dl_lami(3) = MOD(dl_lam(iimin+1,ijmin+1), 360.d0) ; dl_phii(3) = dl_phi(iimin+1,ijmin+1)
+ dl_lami(4) = dl_lamN ; dl_phii(4) = dl_phiN
+ CASE ( 2 )
+ dl_lami(2) = dl_lamS ; dl_phii(2) = dl_phiS
+ dl_lami(3) = MOD(dl_lam(iimin+1,ijmin-1), 360.d0) ; dl_phii(3) = dl_phi(iimin+1,ijmin-1)
+ dl_lami(4) = dl_lamE ; dl_phii(4) = dl_phiE
+ CASE ( 3 )
+ dl_lami(2) = dl_lamW ; dl_phii(2) = dl_phiW
+ dl_lami(3) = MOD(dl_lam(iimin-1,ijmin-1), 360.d0) ; dl_phii(3) = dl_phi(iimin-1,ijmin-1)
+ dl_lami(4) = dl_lamS ; dl_phii(4) = dl_phiS
+ CASE ( 4 )
+ dl_lami(2) = dl_lamN ; dl_phii(2) = dl_phiN
+ dl_lami(3) = MOD(dl_lam(iimin-1,ijmin+1), 360.d0) ; dl_phii(3) = dl_phi(iimin-1,ijmin+1)
+ dl_lami(4) = dl_lamW ; dl_phii(4) = dl_phiW
+ END SELECT
+
+ ! resolve a non linear system of equation for dl_alpha and dl_beta
+ !( the non dimensional coordinates of target point)
+ CALL localcoord( dl_alpha, dl_beta, dl_lami, dl_phii)
ELSE ! point is outside the domaine, put dummy values
- alpha=-1000. ; beta=-1000.
+ dl_alpha=-1000.d0 ; dl_beta=-1000.d0
+ ENDIF
+
+ IF (lldebug) THEN
+ PRINT 9001, id, ymin, xmin, rdep ,iimin, ijmin, dl_hP, dl_hPp, dl_hN, &
+ & dl_hE, dl_hS, dl_hW, iquadran, dl_alpha, dl_beta
ENDIF
-
- IF (ldebug) PRINT 9001, id, ymin, xmin, dep ,imin, jmin, rdis, hP, hPp, hN, hE, hS, hW, iquadran, alpha, beta
! output both on std output and binary weight file (same info).
- PRINT 9002, id, ymin, xmin, dep ,imin, jmin, kloc, iquadran, alpha, beta, gamma
- WRITE(numbin) id, ymin, xmin, dep ,imin, jmin, kloc, iquadran, hN, alpha, beta, gamma
+ PRINT 9002, id, ymin, xmin, rdep ,iimin, ijmin, ikloc, iquadran, dl_alpha, dl_beta, dl_gam
+ WRITE(numbin) id, ymin, xmin, rdep ,iimin, ijmin, ikloc, iquadran, dl_hN, dl_alpha, dl_beta, dl_gam
ENDIF
ENDDO
-9001 FORMAT(i10, 3f10.4,2i6,7f10.4,I4,2f8.4)
+9001 FORMAT(i10, 3f10.4,2i6,6f10.4,I4,2f8.4)
9002 FORMAT(i10, 3f10.4,3i6,I4,3f11.4)
- CLOSE(numbin)
+ CLOSE(numbin)
CONTAINS
- SUBROUTINE Nearestpoint(pplon,pplat,kpi,kpj,plam,pphi,kpiloc,kpjloc,ldbord)
- !!----------------------------------------------------------------------------
- !! *** SUBROUTINE NEARESTPOINT ***
- !!
- !! ** Purpose: Computes the positions of the nearest i,j in the grid
- !! from the given longitudes and latitudes
- !!
- !! ** Method : Starts on the middle of the grid, search in a 20x20 box, and move
- !! the box in the direction where the distance between the box and the
- !! point is minimum
- !! Iterates ...
- !! Stops when the point is outside the grid.
- !! This algorithm does not work on the Mediteranean grid !
- !!
- !! * history:
- !! Anne de Miranda et Pierre-Antoine Darbon Jul. 2000 (CLIPPER)
- !! Jean-Marc Molines : In NEMO form
- !!----------------------------------------------------------------------------
- IMPLICIT NONE
- !* arguments
- REAL(KIND=8),INTENT(in) :: pplon,pplat !: lon and lat of target point
- INTEGER,INTENT (in) :: kpi,kpj !: grid size
- INTEGER,INTENT (inout) :: kpiloc,kpjloc !: nearest point location
- REAL(KIND=8),DIMENSION(kpi,kpj),INTENT(in) :: pphi,plam !: model grid layout
- LOGICAL :: ldbord !: reach boundary flag
-
- ! * local variables
- INTEGER :: ji,jj,i0,j0,i1,j1
- INTEGER :: itbl
- REAL(KIND=4) :: zdist,zdistmin,zdistmin0
- LOGICAL, SAVE :: lbordcell, lfirst=.TRUE.
- !!
- ! Initial values
- kpiloc = kpi/2 ; kpjloc = kpj/2 ! seek from the middle of domain
- itbl = 10 ! block size for search
- zdistmin=1000000. ; zdistmin0=1000000.
- i0=kpiloc ; j0=kpjloc
- lbordcell=.TRUE.; ldbord=.FALSE.
-
- ! loop until found or boundary reach
- DO WHILE ( lbordcell .AND. .NOT. ldbord)
- i0=kpiloc-itbl ; i1=kpiloc+itbl
- j0=kpjloc-itbl ; j1=kpjloc+itbl
-
- ! search only the inner domain
- IF (i0 <= 0) i0=2
- IF (i1 > kpi) i1=kpi-1
- IF (j0 <= 0) j0=2
- IF( j1 > kpj) j1=kpj-1
-
- ! within a block itbl+1 x itbl+1:
- DO jj=j0,j1
- DO ji=i0,i1
- ! compute true distance (orthodromy) between target point and grid point
- zdist=dist(pplon,plam(ji,jj),pplat,pphi(ji,jj) )
- zdistmin=MIN(zdistmin,zdist)
- ! update kpiloc, kpjloc if distance decreases
- IF (zdistmin .NE. zdistmin0 ) THEN
- kpiloc=ji
- kpjloc=jj
- ENDIF
- zdistmin0=zdistmin
- END DO
- END DO
- lbordcell=.FALSE.
- ! if kpiloc, kpjloc belong to block boundary proceed to next block, centered on kpiloc, kpjloc
- IF (kpiloc == i0 .OR. kpiloc == i1) lbordcell=.TRUE.
- IF (kpjloc == j0 .OR. kpjloc == j1) lbordcell=.TRUE.
- ! boundary reach ---> not found
- IF (kpiloc == 2 .OR. kpiloc ==kpi-1) ldbord=.TRUE.
- IF (kpjloc == 2 .OR. kpjloc ==kpj-1) ldbord=.TRUE.
- END DO
- END SUBROUTINE NEARESTPOINT
-
- SUBROUTINE localcoord( palpha, pbeta, plam, pphi)
- !!----------------------------------------------------------
- !! *** SUBROUTINE localcoord ***
+
+ SUBROUTINE localcoord( dpalpha, dpbeta, dplam, dpphi)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE localcoord ***
!!
- !! ** Purpose : Compute the local coordinate in a grid cell
+ !! ** Purpose : compute the local coordinate in a grid cell
!!
- !! ** Method : from N. Daget Web page :
- !! http://aton.cerfacs.fr/~daget/TECHREPORT/TR_CMGC_06_18_html/node8.html
+ !! ** Method : See reference
!!
- !! * history:
- !! Original : J.M. Molines ( May 2007)
- !!----------------------------------------------------------
- IMPLICIT NONE
- ! * Arguments
- REAL(KIND=8), DIMENSION(0:4), INTENT(in) :: plam, pphi
- REAL(KIND=8) , INTENT(out) :: palpha, pbeta
-
- ! * Local variables
- REAL(KIND=8) :: zalpha=0.d0 , zbeta=0.d0, zresmax=0.001, zres
- REAL(KIND=8) :: zdeta, zdalp, zdbet
- REAL(KIND=8) :: zdlam, zdphi, z1, z2, z3, z4
- REAL(KIND=8), DIMENSION(2,2):: za
- REAL(KIND=8), DIMENSION(0:4):: zplam
- INTEGER :: itermax=200, niter=0 !: maximum of iteration and iteration counter
-
- zplam=plam !: save input longitude in workinh array
- IF ( ldebug ) THEN
- print *,plam(0), pphi(0)
- print *,9999,9999
- print *,plam(1), pphi(1)
- print *,plam(2), pphi(2)
- print *,plam(3), pphi(3)
- print *,plam(4), pphi(4)
- print *,plam(1), pphi(1)
- print *,9999,9999
+ !! References : from N. Daget Web page :
+ !! http://aton.cerfacs.fr/~daget/TECHREPORT/TR_CMGC_06_18_html/node8.html
+ !!----------------------------------------------------------------------
+ REAL(KIND=8), DIMENSION(0:4), INTENT(in) :: dplam, dpphi
+ REAL(KIND=8) , INTENT(out) :: dpalpha, dpbeta
+
+ INTEGER(KIND=4) :: itermax=200 ! maximum of iteration
+ INTEGER(KIND=4) :: iter=0 ! iteration counter
+ REAL(KIND=8) :: dlalpha=0.d0 ! working variable, initialized to 1rst guess
+ REAL(KIND=8) :: dlbeta=0.d0 ! "" ""
+ REAL(KIND=8) :: dlresmax=0.001 ! Convergence criteria
+ REAL(KIND=8) :: dlres ! residual
+ REAL(KIND=8) :: dldeta
+ REAL(KIND=8) :: dldalp
+ REAL(KIND=8) :: dldbet
+ REAL(KIND=8) :: dldlam
+ REAL(KIND=8) :: dldphi
+ REAL(KIND=8) :: dl1, dl2, dl3, dl4
+ REAL(KIND=8), DIMENSION(2,2) :: dla
+ REAL(KIND=8), DIMENSION(0:4) :: dlplam
+ !!----------------------------------------------------------------------
+ dlplam=dplam !: save input longitude in working array
+ IF ( lldebug ) THEN
+ PRINT *,dplam(0), dpphi(0)
+ PRINT *,9999,9999
+ PRINT *,dplam(1), dpphi(1)
+ PRINT *,dplam(2), dpphi(2)
+ PRINT *,dplam(3), dpphi(3)
+ PRINT *,dplam(4), dpphi(4)
+ PRINT *,dplam(1), dpphi(1)
+ PRINT *,9999,9999
+ ENDIF
+ IF ( ABS( dlplam(1) -dlplam(4) ) >= 180.d0 .OR. ABS( dlplam(1) -dlplam(2) ) >=180.d0) THEN
+ ! then we are near the 0 deg line and we must work in the frame -180 180
+ WHERE ( dlplam >= 180.d0 ) dlplam=dlplam -360.d0
ENDIF
- IF ( ABS( zplam(1) -zplam(4) ) >= 180. .OR. ABS( zplam(1) -zplam(2) ) >=180.) THEN
- ! then we are near the 0 deg line and we must work in the frame -180 180
- WHERE ( zplam >= 180. ) zplam=zplam -360.
- ENDIF
-
- zres=1000.; zdlam=0.5; zdphi=0.5 ; zalpha=0.d0 ; zbeta=0.d0; niter=0
-
- DO WHILE (zres > zresmax .AND. niter < itermax)
- z1=(zplam(2)- zplam(1) )
- z2=(zplam(1) -zplam(4) )
- z3=(zplam(3) -zplam(2) )
-
- za(1,1) = z1 + (z2 + z3 )* zbeta
- za(1,2) = -z2 + (z2 + z3 )* zalpha
-
- za(2,1) = pphi(2)-pphi(1) + (pphi(1) -pphi(4) +pphi(3) -pphi(2))* zbeta
- za(2,2) = pphi(4)-pphi(1) + (pphi(1) -pphi(4) +pphi(3) -pphi(2))* zalpha
-
- ! determinant
- zdeta=det(za(1,1), za(1,2), za(2,1), za(2,2) )
-
- ! solution of
- ! | zdlam | | zdalp |
- ! | | = za .| |
- ! | zdphi | | zdbet |
- zdalp=det(zdlam, za(1,2) , zdphi, za(2,2) )/zdeta
- zdbet=det(za(1,1) , zdlam, za(2,1) ,zdphi)/zdeta
-
- ! compute residual ( loop criteria)
- zres=sqrt(zdalp*zdalp + zdbet*zdbet )
-
- ! Compute alpha and beta from 1rst guess :
- zalpha = zalpha + zdalp
- zbeta = zbeta + zdbet
-
- ! compute corresponding lon/lat for this alpha, beta
- zdlam=zplam(0) - ((1.-zalpha)*(1-zbeta)*zplam(1) + zalpha*(1-zbeta)*zplam(2) + &
- & zalpha*zbeta*zplam(3) + (1-zalpha)*zbeta*zplam(4))
- zdphi=pphi(0) - ((1.-zalpha)*(1-zbeta)*pphi(1) + zalpha*(1-zbeta)*pphi(2) + &
- & zalpha*zbeta*pphi(3) + (1-zalpha)*zbeta*pphi(4))
-
- niter=niter + 1 ! increment iteration counter
- END DO ! loop until zres small enough (or itermax reach )
-
- palpha = zalpha
- pbeta = zbeta
- END SUBROUTINE localcoord
- FUNCTION det(p1,p2,p3,p4)
- !!----------------------------------------------------------
- !! *** FUNCTION DET ***
- !!
- !! ** Purpose : compute determinant
- !!
- !! * history:
- !! J.M. Molines may 2007
- !!----------------------------------------------------------
- IMPLICIT NONE
- ! * Arguments
- REAL(KIND=8),INTENT(in) :: p1, p2, p3, p4
- REAL(KIND=8) :: det
-
- det = p1*p4 - p2*p3
- END FUNCTION det
+ dlres=1000.; dldlam=0.5; dldphi=0.5 ; dlalpha=0.d0 ; dlbeta=0.d0; iter=0
- FUNCTION dist(plona,plonb,plata,platb)
- !!----------------------------------------------------------
- !! *** FUNCTION DIST ***
- !!
- !! ** Purpose : Compute the distance (km) between
- !! point A (lona, lata) and B(lonb,latb)
- !!
- !! ** Method : Compute the distance along the orthodromy
- !!
- !! * history : J.M. Molines in CHART, f90, may 2007
- !!----------------------------------------------------------
- IMPLICIT NONE
- ! Argument
- REAL(KIND=8), INTENT(in) :: plata, plona, platb, plonb
- REAL(KIND=8) :: dist
- ! Local variables
- REAL(KIND=8),SAVE :: zlatar, zlatbr, zlonar, zlonbr
- REAL(KIND=8) :: zpds
- REAL(KIND=8),SAVE :: zux, zuy, zuz
- REAL(KIND=8) :: zvx, zvy, zvz
-
- REAL(KIND=8), SAVE :: prevlat=-1000., prevlon=-1000, zr, zpi, zconv
- LOGICAL :: lfirst=.TRUE.
-
- ! initialise some values at first call
- IF ( lfirst ) THEN
- lfirst=.FALSE.
- ! constants
- zpi=ACOS(-1.)
- zconv=zpi/180. ! for degree to radian conversion
- ! Earth radius
- zr=(6378.137+6356.7523)/2.0 ! km
- ENDIF
+ DO WHILE (dlres > dlresmax .AND. iter < itermax)
+ dl1=(dlplam(2)- dlplam(1) )
+ dl2=(dlplam(1) -dlplam(4) )
+ dl3=(dlplam(3) -dlplam(2) )
- ! compute these term only if they differ from previous call
- IF ( plata /= prevlat .OR. plona /= prevlon) THEN
- zlatar=plata*zconv
- zlonar=plona*zconv
- zux=COS(zlonar)*COS(zlatar)
- zuy=SIN(zlonar)*COS(zlatar)
- zuz=SIN(zlatar)
- prevlat=plata
- prevlon=plona
- ENDIF
+ dla(1,1) = dl1 + (dl2 + dl3 )* dlbeta
+ dla(1,2) = -dl2 + (dl2 + dl3 )* dlalpha
- zlatbr=platb*zconv
- zlonbr=plonb*zconv
- zvx=COS(zlonbr)*COS(zlatbr)
- zvy=SIN(zlonbr)*COS(zlatbr)
- zvz=SIN(zlatbr)
+ dla(2,1) = dpphi(2)-dpphi(1) + (dpphi(1) -dpphi(4) +dpphi(3) -dpphi(2))* dlbeta
+ dla(2,2) = dpphi(4)-dpphi(1) + (dpphi(1) -dpphi(4) +dpphi(3) -dpphi(2))* dlalpha
- zpds=zux*zvx+zuy*zvy+zuz*zvz
+ ! determinant
+ dldeta=det(dla(1,1), dla(1,2), dla(2,1), dla(2,2) )
- IF (zpds >= 1.) THEN
- dist=0.
- ELSE
- dist=zr*ACOS(zpds)
- ENDIF
- END FUNCTION dist
+ ! solution of
+ ! | zdlam | | zdalp |
+ ! | | = za .| |
+ ! | zdphi | | zdbet |
+ dldalp=det(dldlam, dla(1,2), dldphi, dla(2,2))/dldeta
+ dldbet=det(dla(1,1), dldlam, dla(2,1), dldphi )/dldeta
+
+ ! compute residual ( loop criteria)
+ dlres=SQRT(dldalp*dldalp + dldbet*dldbet )
+
+ ! Compute alpha and beta from 1rst guess :
+ dlalpha = dlalpha + dldalp
+ dlbeta = dlbeta + dldbet
+
+ ! compute corresponding lon/lat for this alpha, beta
+ dldlam = dlplam(0) - ((1.-dlalpha)*(1-dlbeta)*dlplam(1) + dlalpha*(1-dlbeta)*dlplam(2) + &
+ & dlalpha*dlbeta*dlplam(3) + (1-dlalpha)*dlbeta*dlplam(4))
+ dldphi = dpphi(0) - ((1.-dlalpha)*(1-dlbeta)*dpphi(1) + dlalpha*(1-dlbeta)*dpphi(2) + &
+ & dlalpha*dlbeta*dpphi(3) + (1-dlalpha)*dlbeta*dpphi(4))
+
+ iter=iter + 1 ! increment iteration counter
+ END DO ! loop until dlres small enough (or itermax reach )
- FUNCTION heading(plona, plonb, plata, platb)
- !!--------------------------------------------------------------
- !! *** FUNCTION HEADING ***
+ dpalpha = dlalpha
+ dpbeta = dlbeta
+ END SUBROUTINE localcoord
+
+ FUNCTION det(dp1,dp2,dp3,dp4)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION det ***
+ !!
+ !! ** Purpose : compute determinant
+ !!
+ !! ** Method : just multiply and add !
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=8), INTENT(in) :: dp1, dp2, dp3, dp4 ! matrix elements
+ REAL(KIND=8) :: det ! return value
+ !!----------------------------------------------------------------------
+ det = dp1*dp4 - dp2*dp3
+ END FUNCTION det
+
+ FUNCTION heading(dplona, dplonb, dplata, dplatb)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION heading ***
!!
- !! ** Purpose: Compute true heading between point a and b
+ !! ** Purpose : Compute true heading between point a and b
!!
- !! ** Method : suppose that the 2 points are not too far away from each other
- !! so that heading can be computed with loxodromy
+ !! ** Method : Suppose that the 2 points are not too far away
+ !! from each other so that heading can be computed
+ !! with loxodromy.
!!
- !! * history
- !! J.M. Molines, may 2007
- !!--------------------------------------------------------------
- IMPLICIT NONE
- !* Arguments
- REAL(KIND=8), INTENT(in) :: plata, plona, platb, plonb
- REAL(KIND=8) :: heading
-
- ! * Local variables
- REAL(KIND=8) :: zpi, zconv
- REAL(KIND=8) :: angled, pi,cut_dist
- REAL(KIND=8) :: xa,xb,ya,yb, xb_xa
-
- zpi=ACOS(-1.d0)
- zconv=zpi/180.d0 ! for degree to radian conversion
+ !!----------------------------------------------------------------------
+ REAL(KIND=8), INTENT(in) :: dplata, dplona ! lat lon of point a
+ REAL(KIND=8), INTENT(in) :: dplatb, dplonb ! lat lon of point b
+ REAL(KIND=8) :: heading ! return value in degree
+
+ REAL(KIND=8) :: dlpi, dlconv ! pi and conversion factor
+ REAL(KIND=8) :: dlxa,dlya ! working variable
+ REAL(KIND=8) :: dlxb,dlyb ! working variable
+ REAL(KIND=8) :: dlxb_xa ! "" ""
+ !!----------------------------------------------------------------------
+
+ dlpi = ACOS(-1.d0)
+ dlconv = dlpi/180.d0 ! for degree to radian conversion
! there is a problem if the Greenwich meridian pass between a and b
- IF ( ldebug) print *,' Plonb Plona ' , plonb, plona
- xa=plona*zconv
- xb=plonb*zconv
+ IF ( lldebug) PRINT *,' Plonb Plona ' , dplonb, dplona
+ dlxa = dplona*dlconv
+ dlxb = dplonb*dlconv
+
+ dlya = -LOG(TAN(dlpi/4.-dlconv*dplata/2.d0))
+ dlyb = -LOG(TAN(dlpi/4.-dlconv*dplatb/2.d0))
- ya=-LOG(tan(zpi/4.-zconv*plata/2.d0))
- yb=-LOG(tan(zpi/4.-zconv*platb/2.d0))
+ IF (lldebug) PRINT *,' dlxa_xb , modulo 2pi', dlxb-dlxa, MOD((dlxb-dlxa),2*dlpi)
+ dlxb_xa = MOD((dlxb-dlxa),2*dlpi)
- IF (ldebug) PRINT *,' xa_xb , modulo 2pi', xb-xa, MOD((xb-xa),2*zpi)
- xb_xa=MOD((xb-xa),2*zpi)
+ IF ( dlxb_xa >= dlpi ) dlxb_xa = dlxb_xa -2*dlpi
+ IF ( dlxb_xa <= -dlpi ) dlxb_xa = dlxb_xa +2*dlpi
+ IF (lldebug) PRINT *, 'dlyb -dlya, dlxb_xa ',dlyb -dlya , dlxb_xa
- IF ( xb_xa >= zpi ) xb_xa = xb_xa -2*zpi
- IF ( xb_xa <= - zpi ) xb_xa = xb_xa +2*zpi
- IF (ldebug) print *, 'yb -ya, xb_xa ',yb -ya , xb_xa
+ heading=ATAN2(dlxb_xa,(dlyb-dlya))*180.d0/dlpi
- angled=ATAN2(xb_xa,(yb-ya))
- heading=angled*180.d0/zpi
IF (heading < 0) heading=heading+360.d0
END FUNCTION heading
diff --git a/cdfweight2D.f90 b/cdfweight2D.f90
deleted file mode 100644
index a31c132..0000000
--- a/cdfweight2D.f90
+++ /dev/null
@@ -1,516 +0,0 @@
-PROGRAM cdfweight2D
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfweight2D ***
- !!
- !! ** Purpose : return a binary weight file to be used by cdfcoloc
- !!
- !! ** Method : Use Greg Holloway iyxz.txt file type as input, to specify
- !! the points to search in the model grid.
- !! Read the coordinate/mesh_hgr file and look
- !! for the glam, gphi variables
- !! Then use a seach algorithm to find the corresponding I J
- !! The point type ( T U V F ) is specified on the command line
- !! as well as the name of the coordinate/mesh hgr file.
- !!
- !! history ;
- !! Original : J.M. Molines (November 2005 )
- !! J.M. Molines (May 2007 for weight)
- !!-------------------------------------------------------------------
- !! $Rev: 131 $
- !! $Date: 2007-12-14 09:21:24 +0100 (Fri, 14 Dec 2007) $
- !! $Id: cdfweight.f90 131 2007-12-14 08:21:24Z molines $
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: narg, iargc, niter
- INTEGER :: jk
- INTEGER :: imin, jmin
- INTEGER :: iloc, jloc, kloc
- INTEGER :: npiglo, npjglo, iquadran, npk
- INTEGER :: numgreg=10, numbin=20, ios
-
- ! Greg Holloway input data
- INTEGER :: id
- REAL(KIND=8) :: xmin, ymin
- REAL(KIND=4) :: dep
-
- REAL(KIND=8) :: emax, hPp !: local maximum metrics
- REAL(KIND=8) :: glam0 !: longitude of grid point ji=1
- REAL(KIND=8) :: glamin, gphimin !: coordinates of the nearest point (NP)
- REAL(KIND=8) :: glamN, gphiN, hN !: grid point North of NP, true heading from NP
- REAL(KIND=8) :: glamE, gphiE, hE !: grid point East of NP, true heading from NP
- REAL(KIND=8) :: glamS, gphiS, hS !: grid point South of NP, true heading from NP
- REAL(KIND=8) :: glamW, gphiW, hW !: grid point West of NP, true heading from NP
- REAL(KIND=8), DIMENSION(0:4) :: glami, gphii !: the 4 grid points around target (1-4) + the target (0)
- REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: glam, gphi, e1, e2 !: grid layout and metrics
- REAL(KIND=8), DIMENSION(:) , ALLOCATABLE :: gdept !: vertical depth
- REAL(KIND=8) :: hP, rdis !: true heading and distance of target point from NP
- REAL(KIND=8) :: alpha, beta, gamma !: reduced coordinates (0-1) in the NP gridcell
- !: vertical weight
-
- CHARACTER(LEN=80) :: coord='coordinates.nc', ctype='F', cfile
- CHARACTER(LEN=80) :: cweight !: weight file name
-
- LOGICAL :: lagain, lbord, ldebug=.false. !: additional debug print if ldebug=true
-
- !! Read command line and output usage message if not compliant.
- gamma=0.d0 ! not used in 2D colocation but kept for compatibility
- narg= iargc()
- IF ( narg < 1 ) THEN
- PRINT *,' Usage : cdfweight Greg_File [coord_file] [point_type]'
- PRINT *,' return the i,j position for the x,y point (nearest point ) '
- PRINT *,' as read in coord_file for the point type specified by point_type'
- PRINT *, 'if not given as argument, ',TRIM(coord),' must also be present in current dir'
- PRINT *, 'produce a weight file called weight_point_type.bin'
- PRINT *,' Example : cdfweight iyxz7904.txt coordinate_ORCA025.nc F '
- STOP
- ENDIF
-
- CALL getarg (1, cfile )
- ! if 3rd argument not given coordinates.nc is assumed
- IF ( narg > 1 ) THEN
- CALL getarg (2, coord )
- ENDIF
- ! if 4th argument not given, assume F point
- IF ( narg == 3 ) THEN
- CALL getarg (3, ctype )
- ENDIF
-
- npiglo= getdim (coord,'x')
- npjglo= getdim (coord,'y')
-
- ALLOCATE (glam(npiglo,npjglo), gphi(npiglo,npjglo) )
- ALLOCATE (e1(npiglo,npjglo), e2(npiglo,npjglo),gdept(npk) )
-
- ! set name and open output weight file
- WRITE(cweight,'("weight_",a,".bin")') TRIM(ctype)
- OPEN(numbin, FILE=cweight,FORM='unformatted')
-
- SELECT CASE ( ctype )
- CASE ('T' , 't' )
- glam(:,:) = getvar(coord, 'glamt',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphit',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1t' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2t' ,1,npiglo,npjglo)
- CASE ('U','u' )
- glam(:,:) = getvar(coord, 'glamu',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphiu',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1u' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2u' ,1,npiglo,npjglo)
- CASE ('V','v' )
- glam(:,:) = getvar(coord, 'glamv',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphiv',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1v' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2v' ,1,npiglo,npjglo)
- CASE ('F','f' )
- glam(:,:) = getvar(coord, 'glamf',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphif',1,npiglo,npjglo)
- e1 (:,:) = getvar(coord, 'e1f' ,1,npiglo,npjglo)
- e2 (:,:) = getvar(coord, 'e2f' ,1,npiglo,npjglo)
- CASE DEFAULT
- PRINT *,' ERROR : type of point not known: ', TRIM(ctype)
- END SELECT
- ! work with longitude between 0 and 360 to avoid the date line.
- WHERE( glam < 0 ) glam(:,:)=glam(:,:)+360.
-
- ! For Orca grid, the longitude of ji=1 is about 70 E
- glam0=glam(1, npjglo/2)
- WHERE( glam < glam0 ) glam=glam+360.
-
- OPEN(numgreg,FILE=cfile)
- ! Greg (Holloway) files are iyxz.txt file
- ios=0
- ! loop for each line of Greg File
- DO WHILE (ios == 0 )
- READ(numgreg,*,iostat=ios) id,ymin,xmin,dep
- IF( ios == 0 ) THEN ! EOF not reached
- ! Now deal with horizontal interpolation
- ! set longitude of input point in accordance with glam ( [glam0, 360+glam0 [ )
- IF ( xmin < 0. ) xmin = xmin + 360.
- IF ( xmin < glam0 ) xmin = xmin + 360.
-
- lagain = .TRUE. ; niter = 0
- DO WHILE (lagain)
- CALL Nearestpoint(xmin,ymin,npiglo,npjglo,glam,gphi,iloc,jloc,lbord)
- ! distance between the target point and the nearest point
- rdis=dist(xmin,glam(iloc,jloc),ymin,gphi(iloc,jloc) ) ! in km
-
- ! typical grid size (diagonal) in the vicinity of nearest point
- emax= MAX(e1(iloc,jloc),e2(iloc,jloc))/1000.*SQRT(2.) ! in km
-
- ! Latitude and longitude of the neighbours on the grid
- ! define longitudes between 0 and 360 deg
- glamin=MOD(glam(iloc,jloc),360.d0) ; gphimin=gphi(iloc,jloc) ! nearest point
- glamN=MOD(glam(iloc,jloc+1),360.d0) ; gphiN=gphi(iloc,jloc+1) ! N (grid)
- glamE=MOD(glam(iloc+1,jloc),360.d0) ; gphiE=gphi(iloc+1,jloc) ! E (grid)
- glamS=MOD(glam(iloc,jloc-1),360.d0) ; gphiS=gphi(iloc,jloc-1) ! S (grid)
- glamW=MOD(glam(iloc-1,jloc),360.d0) ; gphiW=gphi(iloc-1,jloc) ! W (grid)
-
- IF (rdis > emax ) THEN
- ! The nearest point was not found, try one iteration (jmm ???)
- IF ( niter < 2 ) THEN
- lagain = .TRUE.
- jloc = npjglo-2 ! change initial point
- niter = niter +1
- ELSE
- ! set iloc, jloc to -1000 -1000 ( flag value)
- lagain = .FALSE.
- iloc=-1000 ; jloc=-1000
- ENDIF
- ELSE
- ! The nearest point is found
- lagain = .FALSE.
- END IF
- END DO ! iteration loop
-
- ! transfert Nearest point to imin, jmin
- imin=iloc
- jmin=jloc
-
- ! Restore target point longitude between 0 and 360
- xmin=MOD(xmin,360.d0)
-
- ! Compute heading of target point and neighbours from the nearest point
- hP=heading(glamin,xmin,gphimin,ymin) ! target point
- hN=heading(glamin,glamN,gphimin,gphiN) ! 'north' on the grid
- hE=heading(glamin,glamE,gphimin,gphiE) ! 'east' on the grid
- hS=heading(glamin,glamS,gphimin,gphiS) ! 'south' on the grid
- hW=heading(glamin,glamW,gphimin,gphiW) ! 'west' on the grid
-
- ! determine the sector in wich the target point is located: ( from 1, to 4 resp. NE, SE, SW, NW of the grid)
- iquadran=4
- ! to avoid problem with the GW meridian, pass to -180, 180 when working around GW
- IF ( hP > 180 ) THEN
- hPp=hP-360
- ELSE
- hPp=hP
- ENDIF
-
- IF ( hN > hE ) hN=hN -360.
- IF ( hPp > hN .AND. hPp <= hE ) iquadran=1
- IF ( hP > hE .AND. hP <= hS ) iquadran=2
- IF ( hP > hS .AND. hP <= hW ) iquadran=3
- IF ( hP > hW .AND. hPp <= hN) iquadran=4
-
- glami(0) = xmin ; gphii(0) = ymin ! fill glami, gphii for 0 = target point
- glami(1) = glamin ; gphii(1) = gphimin ! 1 = nearest point
- IF ( iloc /= -1000 ) THEN
- SELECT CASE ( iquadran ) ! point 2 3 4 are counter clockwise in the respective sector
- CASE ( 1 )
- glami(2) = glamE ; gphii(2) = gphiE
- glami(3) = MOD(glam(imin+1,jmin+1), 360.d0) ; gphii(3) = gphi(imin+1,jmin+1)
- glami(4) = glamN ; gphii(4) = gphiN
- CASE ( 2 )
- glami(2) = glamS ; gphii(2) = gphiS
- glami(3) = MOD(glam(imin+1,jmin-1), 360.d0) ; gphii(3) = gphi(imin+1,jmin-1)
- glami(4) = glamE ; gphii(4) = gphiE
- CASE ( 3 )
- glami(2) = glamW ; gphii(2) = gphiW
- glami(3) = MOD(glam(imin-1,jmin-1), 360.d0) ; gphii(3) = gphi(imin-1,jmin-1)
- glami(4) = glamS ; gphii(4) = gphiS
- CASE ( 4 )
- glami(2) = glamN ; gphii(2) = gphiN
- glami(3) = MOD(glam(imin-1,jmin+1), 360.d0) ; gphii(3) = gphi(imin-1,jmin+1)
- glami(4) = glamW ; gphii(4) = gphiW
- END SELECT
-
- ! resolve a non linear system of equation for alpha and beta ( the non dimensional coordinates of target point)
- CALL localcoord( alpha, beta, glami, gphii)
- ELSE ! point is outside the domaine, put dummy values
- alpha=-1000. ; beta=-1000.
- ENDIF
-
- IF (ldebug) PRINT 9001, id, ymin, xmin, dep ,imin, jmin, rdis, hP, hPp, hN, hE, hS, hW, iquadran, alpha, beta
- ! output both on std output and binary weight file (same info).
- PRINT 9002, id, ymin, xmin, dep ,imin, jmin, kloc, iquadran, alpha, beta, gamma
- WRITE(numbin) id, ymin, xmin, dep ,imin, jmin, kloc, iquadran, hN, alpha, beta, gamma
- ENDIF
- ENDDO
-9001 FORMAT(i10, 3f10.4,2i6,7f10.4,I4,2f8.4)
-9002 FORMAT(i10, 3f10.4,3i6,I4,3f11.4)
- CLOSE(numbin)
-
-CONTAINS
- SUBROUTINE Nearestpoint(pplon,pplat,kpi,kpj,plam,pphi,kpiloc,kpjloc,ldbord)
- !!----------------------------------------------------------------------------
- !! *** SUBROUTINE NEARESTPOINT ***
- !!
- !! ** Purpose: Computes the positions of the nearest i,j in the grid
- !! from the given longitudes and latitudes
- !!
- !! ** Method : Starts on the middle of the grid, search in a 20x20 box, and move
- !! the box in the direction where the distance between the box and the
- !! point is minimum
- !! Iterates ...
- !! Stops when the point is outside the grid.
- !! This algorithm does not work on the Mediteranean grid !
- !!
- !! * history:
- !! Anne de Miranda et Pierre-Antoine Darbon Jul. 2000 (CLIPPER)
- !! Jean-Marc Molines : In NEMO form
- !!----------------------------------------------------------------------------
- IMPLICIT NONE
- !* arguments
- REAL(KIND=8),INTENT(in) :: pplon,pplat !: lon and lat of target point
- INTEGER,INTENT (in) :: kpi,kpj !: grid size
- INTEGER,INTENT (inout) :: kpiloc,kpjloc !: nearest point location
- REAL(KIND=8),DIMENSION(kpi,kpj),INTENT(in) :: pphi,plam !: model grid layout
- LOGICAL :: ldbord !: reach boundary flag
-
- ! * local variables
- INTEGER :: ji,jj,i0,j0,i1,j1
- INTEGER :: itbl
- REAL(KIND=4) :: zdist,zdistmin,zdistmin0
- LOGICAL, SAVE :: lbordcell, lfirst=.TRUE.
- !!
- ! Initial values
- kpiloc = kpi/2 ; kpjloc = kpj/2 ! seek from the middle of domain
- itbl = 10 ! block size for search
- zdistmin=1000000. ; zdistmin0=1000000.
- i0=kpiloc ; j0=kpjloc
- lbordcell=.TRUE.; ldbord=.FALSE.
-
- ! loop until found or boundary reach
- DO WHILE ( lbordcell .AND. .NOT. ldbord)
- i0=kpiloc-itbl ; i1=kpiloc+itbl
- j0=kpjloc-itbl ; j1=kpjloc+itbl
-
- ! search only the inner domain
- IF (i0 <= 0) i0=2
- IF (i1 > kpi) i1=kpi-1
- IF (j0 <= 0) j0=2
- IF( j1 > kpj) j1=kpj-1
-
- ! within a block itbl+1 x itbl+1:
- DO jj=j0,j1
- DO ji=i0,i1
- ! compute true distance (orthodromy) between target point and grid point
- zdist=dist(pplon,plam(ji,jj),pplat,pphi(ji,jj) )
- zdistmin=MIN(zdistmin,zdist)
- ! update kpiloc, kpjloc if distance decreases
- IF (zdistmin .NE. zdistmin0 ) THEN
- kpiloc=ji
- kpjloc=jj
- ENDIF
- zdistmin0=zdistmin
- END DO
- END DO
- lbordcell=.FALSE.
- ! if kpiloc, kpjloc belong to block boundary proceed to next block, centered on kpiloc, kpjloc
- IF (kpiloc == i0 .OR. kpiloc == i1) lbordcell=.TRUE.
- IF (kpjloc == j0 .OR. kpjloc == j1) lbordcell=.TRUE.
- ! boundary reach ---> not found
- IF (kpiloc == 2 .OR. kpiloc ==kpi-1) ldbord=.TRUE.
- IF (kpjloc == 2 .OR. kpjloc ==kpj-1) ldbord=.TRUE.
- END DO
- END SUBROUTINE NEARESTPOINT
-
- SUBROUTINE localcoord( palpha, pbeta, plam, pphi)
- !!----------------------------------------------------------
- !! *** SUBROUTINE localcoord ***
- !!
- !! ** Purpose : Compute the local coordinate in a grid cell
- !!
- !! ** Method : from N. Daget Web page :
- !! http://aton.cerfacs.fr/~daget/TECHREPORT/TR_CMGC_06_18_html/node8.html
- !!
- !! * history:
- !! Original : J.M. Molines ( May 2007)
- !!----------------------------------------------------------
- IMPLICIT NONE
- ! * Arguments
- REAL(KIND=8), DIMENSION(0:4), INTENT(in) :: plam, pphi
- REAL(KIND=8) , INTENT(out) :: palpha, pbeta
-
- ! * Local variables
- REAL(KIND=8) :: zalpha=0.d0 , zbeta=0.d0, zresmax=0.001, zres
- REAL(KIND=8) :: zdeta, zdalp, zdbet
- REAL(KIND=8) :: zdlam, zdphi, z1, z2, z3, z4
- REAL(KIND=8), DIMENSION(2,2):: za
- REAL(KIND=8), DIMENSION(0:4):: zplam
- INTEGER :: itermax=200, niter=0 !: maximum of iteration and iteration counter
-
- zplam=plam !: save input longitude in workinh array
- IF ( ldebug ) THEN
- print *,plam(0), pphi(0)
- print *,9999,9999
- print *,plam(1), pphi(1)
- print *,plam(2), pphi(2)
- print *,plam(3), pphi(3)
- print *,plam(4), pphi(4)
- print *,plam(1), pphi(1)
- print *,9999,9999
- ENDIF
- IF ( ABS( zplam(1) -zplam(4) ) >= 180. .OR. ABS( zplam(1) -zplam(2) ) >=180.) THEN
- ! then we are near the 0 deg line and we must work in the frame -180 180
- WHERE ( zplam >= 180. ) zplam=zplam -360.
- ENDIF
-
- zres=1000.; zdlam=0.5; zdphi=0.5 ; zalpha=0.d0 ; zbeta=0.d0; niter=0
-
- DO WHILE (zres > zresmax .AND. niter < itermax)
- z1=(zplam(2)- zplam(1) )
- z2=(zplam(1) -zplam(4) )
- z3=(zplam(3) -zplam(2) )
-
- za(1,1) = z1 + (z2 + z3 )* zbeta
- za(1,2) = -z2 + (z2 + z3 )* zalpha
-
- za(2,1) = pphi(2)-pphi(1) + (pphi(1) -pphi(4) +pphi(3) -pphi(2))* zbeta
- za(2,2) = pphi(4)-pphi(1) + (pphi(1) -pphi(4) +pphi(3) -pphi(2))* zalpha
-
- ! determinant
- zdeta=det(za(1,1), za(1,2), za(2,1), za(2,2) )
-
- ! solution of
- ! | zdlam | | zdalp |
- ! | | = za .| |
- ! | zdphi | | zdbet |
- zdalp=det(zdlam, za(1,2) , zdphi, za(2,2) )/zdeta
- zdbet=det(za(1,1) , zdlam, za(2,1) ,zdphi)/zdeta
-
- ! compute residual ( loop criteria)
- zres=sqrt(zdalp*zdalp + zdbet*zdbet )
-
- ! Compute alpha and beta from 1rst guess :
- zalpha = zalpha + zdalp
- zbeta = zbeta + zdbet
-
- ! compute corresponding lon/lat for this alpha, beta
- zdlam=zplam(0) - ((1.-zalpha)*(1-zbeta)*zplam(1) + zalpha*(1-zbeta)*zplam(2) + &
- & zalpha*zbeta*zplam(3) + (1-zalpha)*zbeta*zplam(4))
- zdphi=pphi(0) - ((1.-zalpha)*(1-zbeta)*pphi(1) + zalpha*(1-zbeta)*pphi(2) + &
- & zalpha*zbeta*pphi(3) + (1-zalpha)*zbeta*pphi(4))
-
- niter=niter + 1 ! increment iteration counter
- END DO ! loop until zres small enough (or itermax reach )
-
- palpha = zalpha
- pbeta = zbeta
- END SUBROUTINE localcoord
-
- FUNCTION det(p1,p2,p3,p4)
- !!----------------------------------------------------------
- !! *** FUNCTION DET ***
- !!
- !! ** Purpose : compute determinant
- !!
- !! * history:
- !! J.M. Molines may 2007
- !!----------------------------------------------------------
- IMPLICIT NONE
- ! * Arguments
- REAL(KIND=8),INTENT(in) :: p1, p2, p3, p4
- REAL(KIND=8) :: det
-
- det = p1*p4 - p2*p3
- END FUNCTION det
-
- FUNCTION dist(plona,plonb,plata,platb)
- !!----------------------------------------------------------
- !! *** FUNCTION DIST ***
- !!
- !! ** Purpose : Compute the distance (km) between
- !! point A (lona, lata) and B(lonb,latb)
- !!
- !! ** Method : Compute the distance along the orthodromy
- !!
- !! * history : J.M. Molines in CHART, f90, may 2007
- !!----------------------------------------------------------
- IMPLICIT NONE
- ! Argument
- REAL(KIND=8), INTENT(in) :: plata, plona, platb, plonb
- REAL(KIND=8) :: dist
- ! Local variables
- REAL(KIND=8),SAVE :: zlatar, zlatbr, zlonar, zlonbr
- REAL(KIND=8) :: zpds
- REAL(KIND=8),SAVE :: zux, zuy, zuz
- REAL(KIND=8) :: zvx, zvy, zvz
-
- REAL(KIND=8), SAVE :: prevlat=-1000., prevlon=-1000, zr, zpi, zconv
- LOGICAL :: lfirst=.TRUE.
-
- ! initialise some values at first call
- IF ( lfirst ) THEN
- lfirst=.FALSE.
- ! constants
- zpi=ACOS(-1.)
- zconv=zpi/180. ! for degree to radian conversion
- ! Earth radius
- zr=(6378.137+6356.7523)/2.0 ! km
- ENDIF
-
- ! compute these term only if they differ from previous call
- IF ( plata /= prevlat .OR. plona /= prevlon) THEN
- zlatar=plata*zconv
- zlonar=plona*zconv
- zux=COS(zlonar)*COS(zlatar)
- zuy=SIN(zlonar)*COS(zlatar)
- zuz=SIN(zlatar)
- prevlat=plata
- prevlon=plona
- ENDIF
-
- zlatbr=platb*zconv
- zlonbr=plonb*zconv
- zvx=COS(zlonbr)*COS(zlatbr)
- zvy=SIN(zlonbr)*COS(zlatbr)
- zvz=SIN(zlatbr)
-
- zpds=zux*zvx+zuy*zvy+zuz*zvz
-
- IF (zpds >= 1.) THEN
- dist=0.
- ELSE
- dist=zr*ACOS(zpds)
- ENDIF
- END FUNCTION dist
-
- FUNCTION heading(plona, plonb, plata, platb)
- !!--------------------------------------------------------------
- !! *** FUNCTION HEADING ***
- !!
- !! ** Purpose: Compute true heading between point a and b
- !!
- !! ** Method : suppose that the 2 points are not too far away from each other
- !! so that heading can be computed with loxodromy
- !!
- !! * history
- !! J.M. Molines, may 2007
- !!--------------------------------------------------------------
- IMPLICIT NONE
- !* Arguments
- REAL(KIND=8), INTENT(in) :: plata, plona, platb, plonb
- REAL(KIND=8) :: heading
-
- ! * Local variables
- REAL(KIND=8) :: zpi, zconv
- REAL(KIND=8) :: angled, pi,cut_dist
- REAL(KIND=8) :: xa,xb,ya,yb, xb_xa
-
- zpi=ACOS(-1.d0)
- zconv=zpi/180.d0 ! for degree to radian conversion
-
- ! there is a problem if the Greenwich meridian pass between a and b
- IF ( ldebug) print *,' Plonb Plona ' , plonb, plona
- xa=plona*zconv
- xb=plonb*zconv
-
- ya=-LOG(tan(zpi/4.-zconv*plata/2.d0))
- yb=-LOG(tan(zpi/4.-zconv*platb/2.d0))
-
- IF (ldebug) PRINT *,' xa_xb , modulo 2pi', xb-xa, MOD((xb-xa),2*zpi)
- xb_xa=MOD((xb-xa),2*zpi)
-
- IF ( xb_xa >= zpi ) xb_xa = xb_xa -2*zpi
- IF ( xb_xa <= - zpi ) xb_xa = xb_xa +2*zpi
- IF (ldebug) print *, 'yb -ya, xb_xa ',yb -ya , xb_xa
-
- angled=ATAN2(xb_xa,(yb-ya))
- heading=angled*180.d0/zpi
- IF (heading < 0) heading=heading+360.d0
- END FUNCTION heading
-
-END PROGRAM cdfweight2D
diff --git a/cdfwflx.f90 b/cdfwflx.f90
index 396728f..ee412f4 100644
--- a/cdfwflx.f90
+++ b/cdfwflx.f90
@@ -1,134 +1,146 @@
PROGRAM cdfwflx
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfwflx ***
+ !!======================================================================
+ !! *** PROGRAM cdfwflx ***
+ !!=====================================================================
+ !! ** Purpose : Produce a file with the water flux separated into
+ !! 4 components: E (soevap), P (soprecip), R (sorunoff),
+ !! dmp (sowafldp).
+ !! The total water flux is E -P -R + dmp. Units in this
+ !! program are mm/days.
!!
- !! ** Purpose : Produce a file with the water flux separated into 4 components:
- !! E (soevap), P (soprecip), R (sorunoff), dmp (sowafldp).
- !! The total water flux is E -P -R + dmp. Units in this program
- !! are mm/days.
- !!
- !! ** Method : Evap is computed from the latent heat flux : evap=-qla/Lv
- !! Runoff is read from the climatological input file
- !! dmp is read from the file (sowafldp)
- !! Precip is then computed as the difference between the
- !! total water flux (sowaflup) and the E-R+dmp. In the high latitudes
- !! this precip includes the effect of snow (storage/melting). Therefore
- !! it may differ slightly from the input precip file.
+ !! ** Method : Evap is computed from the latent heat flux : evap=-qla/Lv
+ !! Runoff is read from the climatological input file
+ !! dmp is read from the file (sowafldp)
+ !! Precip is then computed as the difference between the
+ !! total water flux (sowaflup) and the E-R+dmp. In the high
+ !! latitudes this precip includes the effect of snow
+ !! (storage/melting). Therefore it may differ slightly from
+ !! the input precip file.
!!
- !! history ;
- !! Original : J.M. Molines (January 2008 )
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 01/2008 : J.M. Molines : Original code
+ !! 3.0 : 04/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jj, jk ,ji !: dummy loop index
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo !: size of the domain
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, zwk !: work array
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: evap, precip, runoff, wdmp !: water flux components
- REAL(KIND=4) :: Lv=2.5e6 !: latent HF <--> evap conversion
-
- CHARACTER(LEN=256) :: cfilet , cfiler
- INTEGER :: istatus
- ! output stuff
- INTEGER, PARAMETER :: jpvarout=5
- INTEGER :: ncout, ierr
- INTEGER, DIMENSION(jpvarout) :: ipk, id_varout !: only one output variable
- REAL(KIND=4), DIMENSION(1) :: tim,dep !: time output
- CHARACTER(LEN=256) :: cfileout='wflx.nc'
+ INTEGER(KIND=4), PARAMETER :: jpvarout = 5 ! number of output variables
+ INTEGER(KIND=4) :: jj, jk, ji ! dummy loop index
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ncout, ierr ! netcdf i/o
+ INTEGER(KIND=4), DIMENSION(jpvarout) :: ipk, id_varout ! levels and varid of output vars
+
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, zwk ! work array
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: evap, precip ! water flux components
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: runoff, wdmp ! water flux components
+ REAL(KIND=4), DIMENSION(1) :: tim, dep ! time_counter and dummy depth
+ REAL(KIND=4) :: Lv=2.5e6 ! latent HF <--> evap conversion
+
+ CHARACTER(LEN=256) :: cf_tfil ! input gridT file name
+ CHARACTER(LEN=256) :: cf_rnf ! input runoff file name
+ CHARACTER(LEN=256) :: cf_out='wflx.nc' ! output file
+
+ TYPE(variable), DIMENSION(jpvarout) :: stypvar ! structure for attributes
+
+ LOGICAL :: lchk ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- TYPE(variable), DIMENSION(jpvarout) :: typvar !: structure for attributes
-
-
- !! Read command line and output usage message if not compliant.
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfwflx Tfile Runoff file'
- PRINT *,' Computes the water fluxes components'
- PRINT *,' Output on wflx.nc, soevap,soprecip,sorunoff,sowadmp,sowaflup'
+ PRINT *,' usage : cdfwflx T-file Runoff'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Computes the water fluxes components. Suitable for '
+ PRINT *,' annual means files. All output variables are in mm/days.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' T-file : model output file with water fluxes (gridT) '
+ PRINT *,' Runoff : file with the climatological runoff on the'
+ PRINT *,' model grid.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : soevap, soprecip, sorunoff, sowadmp, sowaflux'
STOP
ENDIF
- CALL getarg (1, cfilet)
- CALL getarg (2, cfiler)
- npiglo= getdim (cfilet,'x')
- npjglo= getdim (cfilet,'y')
+ CALL getarg (1, cf_tfil)
+ CALL getarg (2, cf_rnf )
+
+ lchk = lchk .OR. chkfile ( cf_tfil)
+ lchk = lchk .OR. chkfile ( cf_rnf )
+ IF ( lchk ) STOP ! missing file
+
+ npiglo= getdim (cf_tfil, cn_x)
+ npjglo= getdim (cf_tfil, cn_y)
! prepare output variables
dep(1) = 0.
- ipk(:)= 1 ! all variables ( output are 2D)
-
- typvar(1)%name= 'soevap'
- typvar(2)%name= 'soprecip'
- typvar(3)%name= 'sorunoff'
- typvar(4)%name= 'sowadmp'
- typvar(5)%name= 'sowaflux'
- typvar%units='mm/day'
- typvar%missing_value=0.
- typvar%valid_min= -100.
- typvar%valid_max= 100.
- typvar(1)%long_name='Evaporation'
- typvar(2)%long_name='Precipitation'
- typvar(3)%long_name='Runoff'
- typvar(4)%long_name='SSS damping'
- typvar(5)%long_name='Total water flux'
- typvar(1)%short_name='soevap'
- typvar(2)%short_name='soprecip'
- typvar(3)%short_name='sorunoff'
- typvar(4)%short_name='sowadmp'
- typvar(5)%short_name='sowaflux'
- typvar%online_operation='N/A'
- typvar%axis='TYX'
+ ipk(:) = 1 ! all variables ( output are 2D)
+
+ stypvar%rmissing_value = 0.
+ stypvar%valid_min = -100.
+ stypvar%valid_max = 100.
+ stypvar%cunits = 'mm/day'
+ stypvar%conline_operation = 'N/A'
+ stypvar%caxis = 'TYX'
+ stypvar(1)%cname = 'soevap' ; stypvar(1)%clong_name = 'Evaporation' ; stypvar(1)%cshort_name = 'soevap'
+ stypvar(2)%cname = 'soprecip' ; stypvar(2)%clong_name = 'Precipitation' ; stypvar(2)%cshort_name = 'soprecip'
+ stypvar(3)%cname = 'sorunoff' ; stypvar(3)%clong_name = 'Runoff' ; stypvar(3)%cshort_name = 'sorunoff'
+ stypvar(4)%cname = 'sowadmp' ; stypvar(4)%clong_name = 'SSS damping' ; stypvar(4)%cshort_name = 'sowadmp'
+ stypvar(5)%cname = 'sowaflux' ; stypvar(5)%clong_name = 'Total water flux' ; stypvar(5)%cshort_name = 'sowaflux'
PRINT *, 'npiglo=', npiglo
PRINT *, 'npjglo=', npjglo
-
ALLOCATE ( zmask(npiglo,npjglo), zwk(npiglo,npjglo))
ALLOCATE ( evap(npiglo,npjglo), precip(npiglo,npjglo), runoff(npiglo,npjglo), wdmp(npiglo,npjglo) )
! read vosaline for masking purpose
- zwk(:,:) = getvar(cfilet, 'vosaline', 1 ,npiglo,npjglo)
- zmask=1. ; WHERE ( zwk == 0 ) zmask=0.
-
+ zwk(:,:) = getvar(cf_tfil, cn_vosaline, 1 ,npiglo,npjglo)
+ zmask = 1. ; WHERE ( zwk == 0 ) zmask = 0.
! Evap :
- evap(:,:)= -1.* getvar(cfilet, 'solhflup', 1 ,npiglo,npjglo)/Lv*86400. *zmask(:,:) ! mm/days
+ evap(:,:) = -1.* getvar(cf_tfil, cn_solhflup, 1 ,npiglo, npjglo)/Lv*86400. *zmask(:,:) ! mm/days
print *,'Evap done'
! Wdmp
- wdmp(:,:)= getvar(cfilet, 'sowafldp', 1 ,npiglo,npjglo)*86400.*zmask(:,:) ! mm/days
+ wdmp(:,:) = getvar(cf_tfil, cn_sowafldp, 1 ,npiglo, npjglo) * 86400. * zmask(:,:) ! mm/days
print *,'Damping done'
! Runoff
- runoff(:,:)= getvar(cfiler, 'sorunoff', 1 ,npiglo,npjglo)*86400.*zmask(:,:) ! mm/days
+ runoff(:,:) = getvar(cf_rnf, 'sorunoff', 1 ,npiglo, npjglo) * 86400. * zmask(:,:) ! mm/days
print *,'Runoff done'
! total water flux
- zwk(:,:) = getvar(cfilet, 'sowaflup', 1 ,npiglo,npjglo)*86400.*zmask(:,:) ! mm/days
+ zwk(:,:) = getvar(cf_tfil, cn_sowaflup, 1 ,npiglo, npjglo) * 86400. *zmask(:,:) ! mm/days
print *,'Total water flux done'
! Precip:
- precip(:,:)= evap(:,:)-runoff(:,:)+wdmp(:,:)-zwk(:,:) ! mm/day
+ precip(:,:)= evap(:,:) - runoff(:,:) + wdmp(:,:) - zwk(:,:) ! mm/day
print *,'Precip done'
! Write output file
- !
- ncout = create(cfileout, cfilet, npiglo,npjglo,1)
- ierr = createvar(ncout ,typvar ,jpvarout, ipk,id_varout )
- ierr= putheadervar(ncout, cfilet,npiglo, npjglo,1,pdep=dep)
- tim=getvar1d(cfilet,'time_counter',1)
- ierr = putvar(ncout, id_varout(1) ,evap, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(2) ,precip, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(3) ,runoff, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(4) ,wdmp, 1,npiglo, npjglo)
- ierr = putvar(ncout, id_varout(5) ,zwk, 1,npiglo, npjglo)
- ierr=putvar1d(ncout,tim,1,'T')
+ ncout = create (cf_out, cf_tfil, npiglo, npjglo, 1 )
+ ierr = createvar (ncout, stypvar, jpvarout, ipk, id_varout )
+ ierr = putheadervar(ncout, cf_tfil, npiglo, npjglo, 1, pdep=dep)
+
+ ierr = putvar(ncout, id_varout(1), evap, 1, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(2), precip, 1, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(3), runoff, 1, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(4), wdmp, 1, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(5), zwk, 1, npiglo, npjglo)
+
+ tim = getvar1d(cf_tfil, cn_vtimec, 1 )
+ ierr = putvar1d(ncout, tim, 1, 'T')
ierr=closeout(ncout)
- END PROGRAM cdfwflx
+END PROGRAM cdfwflx
diff --git a/cdfwhereij.f90 b/cdfwhereij.f90
index bbd784c..ceb2dd6 100644
--- a/cdfwhereij.f90
+++ b/cdfwhereij.f90
@@ -1,86 +1,116 @@
PROGRAM cdfwhereij
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfwhereij ***
+ !!======================================================================
+ !! *** PROGRAM cdfwhereij ***
+ !!=====================================================================
+ !! ** Purpose : Give the values of longitude latitude for a given i, j
!!
- !! ** Purpose : Give the values of longitude latitude for a given i, j
- !!
- !! ** Method : Read the coordinate/mesh_hgr file and look
- !! for the glam, gphi variables
- !! The point type ( T U V F ) is specified on the command line
+ !! ** Method : Read the coordinate/mesh_hgr file and look for the glam,
+ !! gphi variables. The point type ( T U V F ) is specified
+ !! on the command line.
!!
- !! history ;
- !! Original : J.M. Molines (May 2005 )
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 05/2005 : J.M. Molines : Original code
+ !! 3.0 : 01/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: narg, iargc
- INTEGER :: imin, imax, jmin, jmax
- INTEGER :: npiglo, npjglo
- REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glam, gphi
-
- CHARACTER(LEN=256) :: cdum, coord, ctype
- !! Read command line and output usage message if not compliant.
+ INTEGER(KIND=4) :: narg, iargc ! browse line
+ INTEGER(KIND=4) :: ijarg, ireq ! browse line
+ INTEGER(KIND=4) :: iimin, iimax ! i-zoom limit
+ INTEGER(KIND=4) :: ijmin, ijmax ! j-zoom limit
+ INTEGER(KIND=4) :: npiglo, npjglo ! global size
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: glam, gphi ! longitude, latitude
+
+ CHARACTER(LEN=256) :: cv_lam ! longitude name
+ CHARACTER(LEN=256) :: cv_phi ! latitude name
+ CHARACTER(LEN=256) :: ctype='T' ! type of point on C-grid
+ CHARACTER(LEN=256) :: cldum ! dummmy string
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg= iargc()
- IF ( narg /= 6 ) THEN
- PRINT *,' Usage : cdfwhereij imin imax jmin jmax coord_file point_type'
- PRINT *,' return the geographical position for the zoomed area '
- PRINT *,' as read in coord_file for the point type specified by point_type'
- PRINT *,' Example : cdfwhereij 200 400 600 750 coordinate_ORCA025.nc F '
+ IF ( narg < 4 ) THEN
+ PRINT *,' usage : cdfwhereij imin imax jmin jmax [-c COOR-file ] [ -p point_type]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Return the geographical coordinates of a model sub-area specified'
+ PRINT *,' in i,j space on the command line.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' imin imax jmin jmax : (i,j) space window coordinates'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-c COOR_file ] : specify a coordinates file.'
+ PRINT *,' default is ', TRIM(cn_fcoo)
+ PRINT *,' [-p point type ] : specify a point type on the C-grid (T U V F) '
+ PRINT *,' default is ', TRIM(ctype)
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fcoo),' or COOR-file given in the -c option'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' Standard output'
STOP
ENDIF
- CALL getarg (1, cdum )
- READ(cdum,*) imin
- CALL getarg (2, cdum )
- READ(cdum,*) imax
- CALL getarg (3, cdum )
- READ(cdum,*) jmin
- CALL getarg (4, cdum )
- READ(cdum,*) jmax
- CALL getarg (5, coord )
- CALL getarg (6, ctype )
+ ijarg = 1 ; ireq = 0
+ DO WHILE ( ijarg <= narg)
+ CALL getarg( ijarg, cldum ) ; ijarg= ijarg+1
+ SELECT CASE ( cldum )
+ CASE ( '-c' ) ; CALL getarg(ijarg, cn_fcoo ) ; ijarg=ijarg+1
+ CASE ( '-p' ) ; CALL getarg(ijarg, ctype ) ; ijarg=ijarg+1
+ CASE DEFAULT
+ ireq=ireq+1
+ SELECT CASE (ireq)
+ CASE ( 1 ) ; READ(cldum,*) iimin
+ CASE ( 2 ) ; READ(cldum,*) iimax
+ CASE ( 3 ) ; READ(cldum,*) ijmin
+ CASE ( 4 ) ; READ(cldum,*) ijmax
+ CASE DEFAULT
+ PRINT *,' Too many arguments !' ; STOP
+ END SELECT
+ END SELECT
+ END DO
+
+ IF ( chkfile(cn_fcoo) ) STOP ! missing file
- npiglo= getdim (coord,'x')
- npjglo= getdim (coord,'y')
- IF ( imax > npiglo ) THEN
- PRINT *,' ERROR : imax is greater than the maximum size ', imax, npiglo
- STOP
+ npiglo = getdim (cn_fcoo, cn_x)
+ npjglo = getdim (cn_fcoo, cn_y)
+
+ IF ( iimax > npiglo ) THEN
+ PRINT *,' ERROR : imax is greater than the maximum size ', iimax, npiglo
+ STOP
ENDIF
- IF ( jmax > npjglo ) THEN
- PRINT *,' ERROR : jmax is greater than the maximum size ', jmax, npjglo
- STOP
+ IF ( ijmax > npjglo ) THEN
+ PRINT *,' ERROR : jmax is greater than the maximum size ', ijmax, npjglo
+ STOP
END IF
-
+
ALLOCATE (glam(npiglo,npjglo), gphi(npiglo,npjglo) )
SELECT CASE ( ctype )
- CASE ('T' , 't' )
- glam(:,:) = getvar(coord, 'glamt',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphit',1,npiglo,npjglo)
- CASE ('U','u' )
- glam(:,:) = getvar(coord, 'glamu',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphiu',1,npiglo,npjglo)
- CASE ('V','v' )
- glam(:,:) = getvar(coord, 'glamv',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphiv',1,npiglo,npjglo)
- CASE ('F','f' )
- glam(:,:) = getvar(coord, 'glamf',1,npiglo,npjglo)
- gphi(:,:) = getvar(coord, 'gphif',1,npiglo,npjglo)
+ CASE ('T' , 't' ) ; cv_lam = cn_glamt ; cv_phi = cn_gphit
+ CASE ('U' , 'u' ) ; cv_lam = cn_glamu ; cv_phi = cn_gphiu
+ CASE ('V' , 'v' ) ; cv_lam = cn_glamv ; cv_phi = cn_gphiv
+ CASE ('F' , 'f' ) ; cv_lam = cn_glamf ; cv_phi = cn_gphif
CASE DEFAULT
PRINT *,' ERROR : type of point not known: ', TRIM(ctype)
END SELECT
- PRINT '(2a)' ,' Type of point : ', TRIM(ctype)
- PRINT '(a,4i6)' ,' I J zoom : ', imin, imax, jmin, jmax
- PRINT '(a,4f9.3)',' LON LAT zoom : ', glam(imin,jmin), glam(imax,jmax), gphi(imin,jmin), gphi(imax,jmax)
+ glam(:,:) = getvar(cn_fcoo, cv_lam, 1, npiglo, npjglo)
+ gphi(:,:) = getvar(cn_fcoo, cv_phi, 1, npiglo, npjglo)
+
+ PRINT '(2a)' ,' Type of point : ', TRIM(ctype)
+ PRINT '(a,4i6)' ,' I J zoom : ', iimin, iimax, ijmin, ijmax
+ PRINT '(a,4f9.3)',' LON LAT zoom : ', glam(iimin,ijmin), glam(iimax,ijmax), gphi(iimin,ijmin), gphi(iimax,ijmax)
- END PROGRAM cdfwhereij
+END PROGRAM cdfwhereij
diff --git a/cdfzeromean.f90 b/cdfzeromean.f90
deleted file mode 100644
index ae9d773..0000000
--- a/cdfzeromean.f90
+++ /dev/null
@@ -1,239 +0,0 @@
-PROGRAM cdfzeromean
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfzeromean ***
- !!
- !! ** Purpose : Compute the Mean Value over the ocean
- !! Produce a file with a 'zeromean' variable
- !! PARTIAL STEPS
- !!
- !! ** Method : compute the sum ( V * e1 *e2 * e3 *mask )/ sum( e1 * e2 * e3 *mask )
- !! The mean( 3D) value is rested from the initial field
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (Oct. 2005)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: jk, ik, jt, ivar !: dummy loop index
- INTEGER :: imin=0, imax=0, jmin=0, jmax=0 !: domain limitation for computation
- INTEGER :: kmin=0, kmax=0 !: domain limitation for computation
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk, nt !: size of the domain
- INTEGER :: npiglo_fi,npjglo_fi
- INTEGER :: nvpk !: vertical levels in working variable
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, e3, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask !: npiglo x npjglo
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep !: depth
-
- REAL(KIND=8) :: zvol, zsum, zvol2d, zsum2d, zsurf, zmean !: double precision cumul/mean
- REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: zmean2d !: per level mean
-
- CHARACTER(LEN=256) :: cfilev , cdum, cfileout='zeromean.nc'
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmask='mask.nc'
- CHARACTER(LEN=256) :: cvar, cvartype
- CHARACTER(LEN=20) :: ce1, ce2, ce3, cvmask, cvtype, cdep
-
- ! output stuff variables
- INTEGER :: ncout, nvars ! number of variables in the input file
- INTEGER, DIMENSION(1) :: ipk, id_varout
- REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: tim, dep
- TYPE (variable), DIMENSION(1) :: typvar !: structure for attibutes
- TYPE (variable), DIMENSION(:),ALLOCATABLE :: typvarin !: structure for attibutes
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarname
- LOGICAL :: lnodep=.FALSE.
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfzeromean ncfile cdfvar T| U | V | F | W [imin imax jmin jmax kmin kmax] '
- PRINT *,' Computes the mean value of the field (3D, weighted) '
- PRINT *,' and return a ncdf file with the variable (field - mean) '
- PRINT *,' imin imax jmin jmax kmin kmax can be given in option '
- PRINT *,' if imin = 0 then ALL i are taken'
- PRINT *,' if jmin = 0 then ALL j are taken'
- PRINT *,' if kmin = 0 then ALL k are taken'
- PRINT *,' PARTIAL CELLS VERSION'
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on standard output and on zeromean.nc file, variable same as input'
- STOP
- ENDIF
-
- CALL getarg (1, cfilev)
- CALL getarg (2, cvar)
- CALL getarg (3, cvartype)
-
- IF (narg > 3 ) THEN
- IF ( narg /= 9 ) THEN
- PRINT *, ' ERROR : You must give 6 optional values (imin imax jmin jmax kmin kmax)'
- STOP
- ELSE
- ! input optional imin imax jmin jmax
- CALL getarg ( 4,cdum) ; READ(cdum,*) imin
- CALL getarg ( 5,cdum) ; READ(cdum,*) imax
- CALL getarg ( 6,cdum) ; READ(cdum,*) jmin
- CALL getarg ( 7,cdum) ; READ(cdum,*) jmax
- CALL getarg ( 8,cdum) ; READ(cdum,*) kmin
- CALL getarg ( 9,cdum) ; READ(cdum,*) kmax
- ENDIF
- ENDIF
-
- ! get dimensions from input file
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
- nt = getdim (cfilev,'time')
- nvpk = getvdim(cfilev,cvar)
- IF (npk == 0 ) THEN ; lnodep=.TRUE. ; npk = 1 ; ENDIF ! no depth dimension ==> 1 level
- ! save original npiglo, npiglo
- npiglo_fi=npiglo
- npjglo_fi=npjglo
-
- IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF
- IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF
- IF (kmin /= 0 ) THEN ; npk =kmax -kmin + 1; ELSE ; kmin=1 ; ENDIF
-
- IF (nvpk == 2 ) nvpk = 1
- IF (nvpk == 3 ) nvpk = npk
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'nt =', nt
- PRINT *, 'nvpk =', nvpk
-
- ! Allocate arrays
- ALLOCATE ( zmask(npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo), e3(npiglo,npjglo) )
- ALLOCATE ( gdep (npk) ,zmean2d(nvpk) )
- ALLOCATE ( tim(nt) ,dep (nvpk))
-
- SELECT CASE (TRIM(cvartype))
- CASE ( 'T' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3t_ps'
- cvmask='tmask'
- cdep='gdept'
- CASE ( 'U' )
- ce1='e1u'
- ce2='e2u'
- ce3='e3t_ps'
- cvmask='umask'
- cdep='gdept'
- CASE ( 'V' )
- ce1='e1v'
- ce2='e2v'
- ce3='e3t_ps'
- cvmask='vmask'
- cdep='gdept'
- CASE ( 'F' )
- ce1='e1f'
- ce2='e2f'
- ce3='e3t_ps'
- cvmask='fmask'
- cdep='gdept'
- CASE ( 'W' )
- ce1='e1t'
- ce2='e2t'
- ce3='e3w_ps'
- cvmask='tmask'
- cdep='gdepw'
- CASE DEFAULT
- PRINT *, 'this type of variable is not known :', TRIM(cvartype)
- STOP
- END SELECT
-
- e1(:,:) = getvar(coordhgr, ce1, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- e2(:,:) = getvar(coordhgr, ce2, 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
- gdep(:) = getvare3(coordzgr,cdep,npk)
-
- DO jt=1,nt
- zvol=0.d0
- zsum=0.d0
- DO jk = 1,nvpk
- ik = jk+kmin-1
- dep(ik)=gdep(jk)
- ! Get velocities v at ik
- zv(:,:)= getvar(cfilev, cvar, ik ,npiglo,npjglo,kimin=imin,kjmin=jmin)
- ! zv(:,:)= getvar(cfilev, cvar, jt ,npiglo,npjglo,kimin=imin,kjmin=jmin,ktime=jt)
- zmask(:,:)=getvar(cmask,cvmask,ik,npiglo,npjglo,kimin=imin,kjmin=jmin)
- ! zmask(:,npjglo)=0.
-
- ! get e3 at level ik ( ps...)
- e3(:,:) = getvar(coordzgr, ce3, ik,npiglo,npjglo,kimin=imin,kjmin=jmin, ldiom=.TRUE.)
-
- !
- zsurf=SUM(e1 * e2 * zmask)
- zvol2d=SUM(e1 * e2 * e3 * zmask)
- zvol=zvol+zvol2d
- zsum2d=SUM(zv*e1*e2*e3*zmask)
- zsum=zsum+zsum2d
- IF (zvol2d /= 0 )THEN
- PRINT *, ' Mean value at level ',ik,'(',gdep(ik),' m) ',zsum2d/zvol2d, 'surface = ',zsurf/1.e6,' km^2'
- zmean2d(ik) = zsum2d/zvol2d
- ELSE
- PRINT *, ' No points in the water at level ',ik,'(',gdep(ik),' m) '
- ENDIF
-
- END DO
- zmean=zsum/zvol
- PRINT * ,' Mean value over the ocean: ', zmean, jt
- END DO
- DEALLOCATE ( zv, zmask)
- npiglo=npiglo_fi ; npjglo=npjglo_fi
- ALLOCATE (zv(npiglo,npjglo), zmask(npiglo,npjglo) )
- ! re-read file and rest mean value from the variable and store on file
- nvars = getnvar(cfilev)
- ALLOCATE ( typvarin(nvars), cvarname(nvars) )
- cvarname(:) = getvarname(cfilev,nvars,typvarin)
- ! look for the working variable
- DO ivar = 1, nvars
- IF ( TRIM(cvarname(ivar)) == TRIM(cvar) ) EXIT
- END DO
-
- typvar(1)%name= cvar
- typvar%units=typvarin(ivar)%units
- typvar%missing_value=typvarin(ivar)%missing_value
- typvar%valid_min=typvarin(ivar)%valid_min-zmean
- typvar%valid_max=typvarin(ivar)%valid_max-zmean
- typvar(1)%long_name=typvarin(ivar)%long_name//' zero mean '
- typvar(1)%short_name=cvar
- typvar%online_operation='N/A'
- typvar%axis=typvarin(ivar)%axis
- ipk(1)=nvpk
-
- ik=nvpk
- IF ( lnodep ) ik = 0 ! no depth variable in input file : the same in output file
- ncout = create(cfileout, cfilev, npiglo,npjglo,ik)
- ierr = createvar(ncout ,typvar ,1, ipk,id_varout )
- ierr= putheadervar(ncout, cfilev,npiglo, npjglo,ik,pdep=dep)
- tim=getvar1d(cfilev,'time_counter',nt)
-
- DO jt=1,nt
- DO jk = 1,nvpk
- ik = jk+kmin-1
- ! Get velocities v at ik
- zv(:,:)= getvar(cfilev, cvar, ik ,npiglo,npjglo)
- ! zv(:,:)= getvar(cfilev, cvar, jt ,npiglo,npjglo,kimin=imin,kjmin=jmin,ktime=jt)
- zmask(:,:)=getvar(cmask,cvmask,ik,npiglo,npjglo)
- ! zmask(:,npjglo)=0.
- WHERE (zmask /= 0 ) zv(:,:) = zv(:,:) - zmean
- ierr = putvar(ncout, id_varout(1) ,zv, ik,npiglo, npjglo )
- END DO
- END DO
- ierr=putvar1d(ncout,tim,nt,'T')
- ierr=closeout(ncout)
-
-END PROGRAM cdfzeromean
diff --git a/cdfzonalintdeg.f90 b/cdfzonalintdeg.f90
deleted file mode 100644
index 169843e..0000000
--- a/cdfzonalintdeg.f90
+++ /dev/null
@@ -1,287 +0,0 @@
-PROGRAM cdfzonalintdeg
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfzonalintdeg ***
- !!
- !! ** Purpose : Compute the zonal sum per degree of latitude
- !!
- !! ** Method :
- !! Results are saved on zonalintdeg.nc file with
- !! variables name respectively as follow:
- !! same as input except that the 2 first char are
- !! changed to zo. Then a suffix is append to the
- !! name of the variable : glo atl inp ind and pac
- !! if a subbasin mask is given on input., else
- !! the suffix glo is used. Example :
- !! sosaline_glo sosaline_atl etc ...
- !!
- !!
- !! history ;
- !! Original : J.M. Molines (nov. 2005)
- !!-------------------------------------------------------------------
- !! $Rev: 256 $
- !! $Date: 2009-07-21 17:49:27 +0200 (mar 21 jui 2009) $
- !! $Id: cdfzonalsum.f90 256 2009-07-21 15:49:27Z molines $
- !!--------------------------------------------------------------
- !! * Modules used
- USE cdfio
-
- !! * Local variables
- IMPLICIT NONE
- INTEGER :: npbasins=1, ivar = 0 !: number of subbasin, number of output var
- INTEGER :: jbasin, jj, jk ,ji ,jvar ,jjvar !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout
- INTEGER :: nvars , mvar !: number of variables in the file
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, ijvar, ipko, id_varout !: jpbasin x nvar
- INTEGER, DIMENSION(2) :: iloc
-
- REAL(KIND=4) :: ra = 6371229 !: earth radius
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, gphi, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: alpha !: number of degrees for a given latitude
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmaskvar
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep !: gdept or gdepw
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo
- REAL(KIND=4), DIMENSION (1) :: tim
- REAL(KIND=8) :: zpi !: pi
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zomsf , area !: jpbasins x npjglo x npk
-
- CHARACTER(LEN=256) :: cfilev , cfileoutnc='zonalintdeg.nc', cdum
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmaskfil='mask.nc',cbasinmask='none'
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarname !: array of var name for input
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarnameo !: array of var name for output
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvaro !: structure for attribute
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar !: structure for attribute
-
- CHARACTER(LEN=10) :: ce1, ce2, cphi, cdep,cmask, cdepo
- CHARACTER(LEN=4),DIMENSION(5) :: cbasin=(/'_glo','_atl','_inp','_ind','_pac'/)
-
- LOGICAL :: lrevert_dep = .TRUE. !: flag to revert depth order for plotting facility
-
- !! Read command line and output usage message if not compliant.
- narg= iargc()
- IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfzonalintdeg file T | U | V | F | W [new_maskglo.nc]'
- PRINT *,' Computes the zonal sum per degree of latitude'
- PRINT *,' If no new_maskglo specified, assume global '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on zonalintdeg.nc: '
- PRINT *,' variables zoixxxx_glo : Global ocean '
- PRINT *,' variables zoixxxx_atl : Atlantic Ocean '
- PRINT *,' variables zoixxxx_inp : Indo Pacific '
- PRINT *,' variables zoixxxx_ind : Indian Ocean alone'
- PRINT *,' variables zoixxxx_pac : Pacific Ocean alone'
- PRINT *,' Depth variable output is negative (standard) unless '
- PRINT *,' you recompile the tool with lrevert_dep=.false.'
- STOP
- ENDIF
-
- CALL getarg (1, cfilev)
- CALL getarg (2, cdum )
-
- ! set the metrics according to C grid point
- SELECT CASE (cdum)
- CASE ('T', 't', 'S', 's')
- ce1='e1t'
- ce2='e2t'
- cdep='gdept'
- cdepo='deptht'
- cphi='gphit'
- cmask='tmask'
- CASE ('U', 'u')
- ce1='e1u'
- ce2='e2u'
- cdep='gdepu'
- cdepo='depthu'
- cphi='gphiu'
- cmask='umask'
- CASE ('V', 'v')
- ce1='e1v'
- ce2='e2v'
- cdep='gdepv'
- cdepo='depthv'
- cphi='gphiv'
- cmask='vmask'
- CASE ('F', 'f')
- ce1='e1f'
- ce2='e2f'
- cdep='gdepf'
- cdepo='deptht'
- cphi='gphif'
- cmask='fmask'
- CASE ('W', 'w')
- ce1='e1t'
- ce2='e2t'
- cdep='gdepw'
- cdepo='depthw'
- cphi='gphit'
- cmask='tmask'
- CASE DEFAULT
- PRINT *, ' C grid:', TRIM(cdum),' point not known!'
- STOP
- END SELECT
-
-
- ! Read sub_basin file name (optional)
- IF (narg == 3 ) THEN
- CALL getarg(3, cbasinmask)
- npbasins=5
- ENDIF
-
- nvars = getnvar(cfilev)
- ALLOCATE ( cvarname(nvars) ,ipk(nvars), ijvar(nvars), typvar(nvars) )
- ALLOCATE ( cvarnameo(npbasins*nvars),ipko(npbasins*nvars),id_varout(npbasins*nvars) )
- ALLOCATE ( typvaro(npbasins*nvars) )
-
- cvarname(1:nvars) = getvarname(cfilev,nvars,typvar)
- ipk(1:nvars) = getipk(cfilev,nvars)
-
- ! buildt output filename
- ivar = 0 ; mvar = 0
- DO jvar = 1,nvars
- ! skip variables such as nav_lon, nav_lat, time_counter deptht ...
- IF (ipk(jvar) == 0 ) THEN
- cvarname(jvar)='none'
- ELSE
- mvar = mvar + 1 ! count for valid input variables
- ijvar(mvar) = jvar ! use indirect adressing for those variables
- DO jbasin=1,npbasins
- ivar=ivar + 1 ! count for output variables
- cvarnameo(ivar)='zoi'//TRIM(cvarname(jvar)(3:))//TRIM(cbasin(jbasin) )
- ! intercept case of duplicate zonal name
- IF (cvarname(jvar) == 'iowaflup' ) cvarnameo(ivar)='zoiwaflio'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'cfc11' ) cvarnameo(ivar)='zoicfc11'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'bombc14' ) cvarnameo(ivar)='zoibc14'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'invcfc' ) cvarnameo(ivar)='zoiinvcfc'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'invc14' ) cvarnameo(ivar)='zoiinvc14'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qtrcfc' ) cvarnameo(ivar)='zoiqtrcfc'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qtrc14' ) cvarnameo(ivar)='zoiqtrc14'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qintcfc' ) cvarnameo(ivar)='zoiqintcfc'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qintc14' ) cvarnameo(ivar)='zoiqintc14'//TRIM(cbasin(jbasin) )
-
- typvaro(ivar)%name=cvarnameo(ivar)
- ! units can be build automatically: add .m2 at the end (not very nice ...)
- ! a special function to parse the unit and build the proper one is to be done
- ! this is tricky as many details are to be taken into account :
- ! eg : mol/m2, kg.m-2, W/m2
- typvaro(ivar)%units=TRIM(typvar(jvar)%units)//'.m2.degree-1'
- ! missing value, valid min and valid max : idem original field
- typvaro(ivar)%missing_value=typvar(jvar)%missing_value
- typvaro(ivar)%valid_min=typvar(jvar)%valid_min
- typvaro(ivar)%valid_max=typvar(jvar)%valid_max
- ! longname : prefix=Zonal_Integral suffix=TRIM(cbasin(jbasin)
- typvaro(ivar)%long_name='Zonal_Integral_per_degree_'//TRIM(typvar(jvar)%long_name)//TRIM(cbasin(jbasin) )
- ! shortname=name
- typvaro(ivar)%short_name=typvaro(ivar)%name
- ! online operation : N/A (as usual ...)
- typvaro(ivar)%online_operation='/N/A'
- ! axis : either TY( original 2D) or TZY (original 3D)
- IF (ipk(jvar) == 1 ) THEN
- typvaro(ivar)%axis='TY'
- ELSE
- typvaro(ivar)%axis='TZY'
- ENDIF
-
-
-
- ipko(ivar)=ipk(jvar)
- END DO
- ENDIF
- END DO
-
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
- ! Initialisation
- zpi=ACOS(-1.)
-
- ! Allocate arrays
- ALLOCATE ( zmask(npbasins,npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( zmaskvar(npiglo,npjglo) )
- ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo), gphi(npiglo,npjglo) ,gdep(npk) )
- ALLOCATE ( zomsf( npjglo, npk) ,area( npjglo, npk) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
- ALLOCATE ( alpha(npjglo))
-
- ! get the metrics
- e1(:,:) = getvar(coordhgr, ce1, 1,npiglo,npjglo)
- e2(:,:) = getvar(coordhgr, ce2, 1,npiglo,npjglo)
- gphi(:,:) = getvar(coordhgr, cphi, 1,npiglo,npjglo)
- gdep(:) = getvare3(coordzgr, cdep ,npk)
- IF ( lrevert_dep ) gdep(:) = -1.* gdep(:) ! helps for plotting the results
-
- ! compute alpha
- DO jj=1,npjglo
- alpha(jj) = (e2(0,jj)*360)/(2*zpi*ra)
- ENDDO
-
- ! Look for the i-index that go through the North Pole
- iloc = MAXLOC(gphi)
- dumlat(1,:) = gphi(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
-
- ! create output fileset
- ncout = create(cfileoutnc, cfilev, 1,npjglo,npk,cdep=cdepo)
- ierr = createvar(ncout ,typvaro,ivar, ipko,id_varout )
- ierr = putheadervar(ncout, cfilev,1,npjglo,npk,pnavlon=dumlon,pnavlat=dumlat,pdep=gdep)
- tim = getvar1d(cfilev,'time_counter',1)
- ierr = putvar1d(ncout,tim,1,'T')
-
- ! reading the surface mask masks
- ! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif
- zmask(1,:,:) = getvar(cmaskfil,cmask,1,npiglo,npjglo)
- IF ( cbasinmask /= 'none' ) THEN
- zmask(2,:,:) = getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- zmask(4,:,:) = getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
- zmask(5,:,:) = getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- zmask(3,:,:) = zmask(5,:,:)+zmask(4,:,:)
- ! ensure that there are no overlapping on the masks
- WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1
- ENDIF
-
- ! main computing loop
- ivar = 0
- DO jjvar = 1, mvar
- jvar = ijvar(jjvar)
- DO jk = 1, ipk(jvar)
- PRINT *,TRIM(cvarname(jvar)), ' level ',jk
- ! Get variables and mask at level jk
- zv(:,:) = getvar(cfilev, cvarname(jvar), jk ,npiglo,npjglo)
- zmaskvar(:,:) = getvar(cmaskfil, cmask, jk ,npiglo,npjglo)
-
- ! For all basins
- DO jbasin = 1, npbasins
- zomsf(:,:) = 0.d0
- area(:,:) = 0.d0
- ! integrates 'zonally' (along i-coordinate)
- DO ji=2,npiglo
- DO jj=1,npjglo
- zomsf(jj,jk) = zomsf(jj,jk) + e1(ji,jj)*e2(ji,jj)* zmask(jbasin,ji,jj)*zmaskvar(ji,jj)*zv(ji,jj)
- END DO
- END DO
- ! Divide by number of degrees at the corresponding latitude
- zomsf(:,jk) = zomsf(:,jk)/alpha(:)
-
- ivar= (jjvar-1)*npbasins + jbasin
- ierr = putvar (ncout, id_varout(ivar),REAL(zomsf(:,jk)), jk,1,npjglo)
-
- END DO !next basin
- END DO ! next k
-
- END DO ! next variable
-
- ierr = closeout(ncout)
-
-END PROGRAM cdfzonalintdeg
diff --git a/cdfzonalmean.f90 b/cdfzonalmean.f90
index f160b56..ab8ed88 100644
--- a/cdfzonalmean.f90
+++ b/cdfzonalmean.f90
@@ -1,281 +1,316 @@
PROGRAM cdfzonalmean
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfzonalmean ***
+ !!======================================================================
+ !! *** PROGRAM cdfzonalmean ***
+ !!=====================================================================
+ !! ** Purpose : Compute the zonal mean of a file
!!
- !! ** Purpose : Compute the zonal mean
- !!
- !! ** Method :
- !! Results are saved on zonalmean.nc file with
- !! variables name respectively as follow:
- !! same as input except that the 2 first char are
- !! changed to zo. Then a suffix is append to the
- !! name of the variable : glo atl inp ind and pac
- !! if a subbasin mask is given on input., else
- !! the suffix glo is used. Example :
- !! sosaline_glo sosaline_atl etc ...
+ !! ** Method : In this program the 'zonal' mean is in fact a mean
+ !! along the I coordinate.
!!
- !!
- !! history ;
- !! Original : J.M. Molines (nov. 2005)
- !! Modified : P. Mathiot (June 2007) Update for forcing fields format
- !! + for many time steps
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2005 : J.M. Molines : Original code
+ !! : 06/2007 : P. Mathiot : adaptation for 2D files
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
!! * Local variables
IMPLICIT NONE
- INTEGER :: npbasins=1, ivar = 0 !: number of subbasin, number of output var
- INTEGER :: jbasin, jj, jk ,ji ,jvar ,jjvar,jkk !: dummy loop index
- INTEGER :: jt !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk, nt !: size of the domain
- INTEGER :: ncout
- INTEGER :: nvars , mvar !: number of variables in the file
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, ijvar, ipko, id_varout !: jpbasin x nvar
- INTEGER, DIMENSION(2) :: iloc
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, gphi, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmaskvar
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep !: gdept or gdepw
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo
- REAL(KIND=4), DIMENSION (1) :: tim
- REAL(KIND=4) :: spval=99999.
+ INTEGER(KIND=4) :: ji, jj, jk ,jt ! dummy loop index
+ INTEGER(KIND=4) :: jbasin, jvar ! dummy loop index
+ INTEGER(KIND=4) :: ijvar ! variable counter
+ INTEGER(KIND=4) :: npbasins=1 ! number of subbasin
+ INTEGER(KIND=4) :: ivar = 0 ! output variable counter
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvarin, nvar ! number of input variables: all/valid
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipki, id_varin ! jpbasin x nvar
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipko, id_varout ! jpbasin x nvar
+ INTEGER(KIND=4), DIMENSION(2) :: ijloc ! working array for maxloc
+
+ REAL(KIND=4) :: zspval=99999. ! missing value
+ REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep ! gdept or gdepw
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, gphi, zv ! metrics, latitude, data value
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdumlon ! dummy longitude = 0.
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdumlat ! latitude for i = north pole
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmaskvar ! variable mask
+ REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask ! basin mask jpbasins x npiglo x npjglo
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zomsf , area !: jpbasins x npjglo x npk
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dzomean , darea ! jpbasins x npjglo x npk
- CHARACTER(LEN=256) :: cfilev , cfileoutnc='zonalmean.nc', cdum
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmaskfil='mask.nc',cbasinmask='none'
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarname !: array of var name for input
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarnameo !: array of var name for output
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar !: structure for attributes
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvaro !: structure for attributes
- CHARACTER(LEN=10) :: ce1, ce2, cphi, cdep,cmask, cdepo
- CHARACTER(LEN=4),DIMENSION(5) :: cbasin=(/'_glo','_atl','_inp','_ind','_pac'/)
+ CHARACTER(LEN=256) :: cf_in ! input file name
+ CHARACTER(LEN=256) :: cf_out='zonalmean.nc' ! output file name
+ CHARACTER(LEN=256) :: cf_basins='none' ! sub basin file name
+ CHARACTER(LEN=10 ) :: cv_e1, cv_e2 ! horizontal metrics variable names
+ CHARACTER(LEN=10 ) :: cv_phi ! latitude variable name
+ CHARACTER(LEN=10 ) :: cv_msk ! mask variable name
+ CHARACTER(LEN=10 ) :: cv_depi, cv_depo ! depth variable name (input/output)
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+ CHARACTER(LEN=256) :: ctyp ! variable type on C-grid
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_namesi ! input variable names
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nameso ! output variable names
+ CHARACTER(LEN=4 ), DIMENSION(5) :: cbasin=(/'_glo','_atl','_inp','_ind','_pac'/) ! sub basin suffixes
- LOGICAL :: lrevert_dep = .TRUE. !: flag to revert the order of depth in the output file (plotting facility)
- LOGICAL :: lforcing = .FALSE.
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvari ! structure for input variables
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvaro ! structure for output variables
+
+ LOGICAL :: lpdep =.FALSE. ! flag for depth sign (default dep < 0)
+ LOGICAL :: l2d =.FALSE. ! flag for 2D files
+ LOGICAL :: lchk =.FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line and output usage message if not compliant.
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfzonalmean file T | U | V | F | W [new_maskglo.nc]'
- PRINT *,' Computes the zonal mean '
- PRINT *,' If no new_maskglo specified, assume global '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on zonalmean.nc: '
- PRINT *,' variables zoxxxx_glo : Global ocean '
- PRINT *,' variables zoxxxx_atl : Atlantic Ocean '
- PRINT *,' variables zoxxxx_inp : Indo Pacific '
- PRINT *,' variables zoxxxx_ind : Indian Ocean alone'
- PRINT *,' variables zoxxxx_pac : Pacific Ocean alone'
- PRINT *,' Depth variable output is negative (standard) unless '
- PRINT *,' you recompile the tool with lrevert_dep=.false.'
+ PRINT *,' usage : cdfzonalmean IN-file point_type [ BASIN-file] ...'
+ PRINT *,' ... [-pdep | --positive_depths]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the zonal mean of all the variables available in the'
+ PRINT *,' input file. This program assume that all the variables are'
+ PRINT *,' located on the same C-grid point, specified on the command line.'
+ PRINT *,' '
+ PRINT *,' Zonal mean is in fact the mean value computed along the I coordinate.'
+ PRINT *,' The result is a vertical slice, in the meridional direction.'
+ PRINT *,' '
+ PRINT *,' REMARK : partial step are not handled properly (but probably '
+ PRINT *,' minor impact on results).'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : input netcdf file.'
+ PRINT *,' point_type : indicate the location on C-grid (T|U|V|F|W)'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [BASIN-file] : netcdf file describing sub basins, similar to '
+ PRINT *,' ', TRIM(cn_fbasins),'. If this name is not given '
+ PRINT *,' as option, only the global zonal mean is computed.'
+ PRINT *,' [-pdep | --positive_depths ] : use positive depths in the output file.'
+ PRINT *,' Default behaviour is to have negative depths.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fhgr),', ', TRIM(cn_fzgr),' and ', TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out)
+ PRINT *,' variables : output variable names are built with the following'
+ PRINT *,' convention: zoxxxx_bas'
+ PRINT *,' where zo replace vo/so prefix of the input variable'
+ PRINT *,' where bas is a suffix for each sub-basins (or glo)'
+ PRINT *,' if a BASIN-file is used.'
STOP
ENDIF
- CALL getarg (1, cfilev)
- CALL getarg (2, cdum )
+ ijarg = 1 ; ireq = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1
+ SELECT CASE (cldum)
+ CASE ( '-pdep' , '--positive_depths' ) ; lpdep =.TRUE.
+ CASE DEFAULT
+ ireq=ireq+1
+ SELECT CASE (ireq)
+ CASE (1) ; cf_in = cldum ! file name is the 1rst argument
+ CASE (2) ; ctyp = cldum ! point type is the 2nd
+ CASE (3) ; cf_basins = cldum ! sub basin file is the 3rd (optional)
+ npbasins = 5
+ lchk = chkfile (cf_basins)
+ CASE DEFAULT
+ PRINT *,' Too many arguments ...' ; STOP
+ END SELECT
+ END SELECT
+ END DO
+
+ ! check files existence
+ lchk = lchk .OR. chkfile (cn_fhgr)
+ lchk = lchk .OR. chkfile (cn_fzgr)
+ lchk = lchk .OR. chkfile (cn_fmsk)
+ lchk = lchk .OR. chkfile (cf_in )
+ IF ( lchk ) STOP ! missing files
! set the metrics according to C grid point
- SELECT CASE (cdum)
+ SELECT CASE (ctyp)
CASE ('T', 't', 'S', 's')
- ce1='e1t'
- ce2='e2t'
- cdep='gdept'
- cdepo='deptht'
- cphi='gphit'
- cmask='tmask'
+ cv_e1 = cn_ve1t ; cv_e2 = cn_ve2t
+ cv_depi = cn_gdept ; cv_depo = cn_vdeptht
+ cv_phi = cn_gphit ; cv_msk = 'tmask'
CASE ('U', 'u')
- ce1='e1u'
- ce2='e2u'
- cdep='gdepu'
- cdepo='depthu'
- cphi='gphiu'
- cmask='umask'
+ cv_e1 = cn_ve1u ; cv_e2 = cn_ve2u
+ cv_depi = cn_gdept ; cv_depo = cn_vdepthu
+ cv_phi = cn_gphiu ; cv_msk = 'umask'
CASE ('V', 'v')
- ce1='e1v'
- ce2='e2v'
- cdep='gdepv'
- cdepo='depthv'
- cphi='gphiv'
- cmask='vmask'
+ cv_e1 = cn_ve1v ; cv_e2 = cn_ve2v
+ cv_depi = cn_gdept ; cv_depo = cn_vdepthv
+ cv_phi = cn_gphiv ; cv_msk = 'vmask'
CASE ('F', 'f')
- ce1='e1f'
- ce2='e2f'
- cdep='gdepf'
- cdepo='deptht'
- cphi='gphif'
- cmask='fmask'
+ cv_e1 = cn_ve1f ; cv_e2 = cn_ve2f
+ cv_depi = cn_gdept ; cv_depo = cn_vdeptht
+ cv_phi = cn_gphif ; cv_msk = 'fmask'
CASE ('W', 'w')
- ce1='e1t'
- ce2='e2t'
- cdep='gdepw'
- cdepo='depthw'
- cphi='gphit'
- cmask='tmask'
+ cv_e1 = cn_ve1t ; cv_e2 = cn_ve2t
+ cv_depi = cn_gdepw ; cv_depo = cn_vdepthw
+ cv_phi = cn_gphit ; cv_msk = 'tmask'
CASE DEFAULT
- PRINT *, ' C grid:', TRIM(cdum),' point not known!'
- STOP
+ PRINT *, ' C grid:', TRIM(ctyp),' point not known!' ; STOP
END SELECT
- ! Read sub_basin file name (optional)
- IF (narg == 3 ) THEN
- CALL getarg(3, cbasinmask)
- npbasins=5
- ENDIF
+ nvarin = getnvar(cf_in) ! number of input variables
+ ALLOCATE ( cv_namesi(nvarin), ipki(nvarin), id_varin (nvarin) )
+ ALLOCATE ( cv_nameso(npbasins*nvarin), ipko(npbasins*nvarin), id_varout(npbasins*nvarin) )
+ ALLOCATE ( stypvari(nvarin) )
+ ALLOCATE ( stypvaro(npbasins*nvarin) )
- nvars = getnvar(cfilev)
- ALLOCATE ( cvarname(nvars) ,ipk(nvars), ijvar(nvars), typvar(nvars) )
- ALLOCATE ( cvarnameo(npbasins*nvars),ipko(npbasins*nvars),id_varout(npbasins*nvars) )
- ALLOCATE ( typvaro(npbasins*nvars))
- cvarname(1:nvars) = getvarname(cfilev,nvars,typvar)
- ipk(1:nvars) = getipk(cfilev,nvars)
+ cv_namesi(1:nvarin) = getvarname(cf_in, nvarin, stypvari )
+ ipki (1:nvarin) = getipk (cf_in, nvarin )
! buildt output filename
- ivar = 0
- mvar = 0
- DO jvar = 1,nvars
+ nvar = 0 ! over all number of valid variables for zonal mean ( < nvarin)
+ ivar = 0 ! over all variable counter ( nvar x basins)
+ DO jvar = 1,nvarin
! skip variables such as nav_lon, nav_lat, time_counter deptht ...
- IF (ipk(jvar) == 0 ) THEN
- cvarname(jvar)='none'
+ IF (ipki(jvar) == 0 ) THEN
+ cv_namesi(jvar)='none'
ELSE
- mvar = mvar + 1 ! count for valid input variables
- ijvar(mvar) = jvar ! use indirect adressing for those variables
+ nvar = nvar + 1 ! count for valid input variables
+ id_varin(nvar) = jvar ! use indirect adressing for those variables
DO jbasin=1,npbasins
ivar=ivar + 1 ! count for output variables
- cvarnameo(ivar)='zo'//TRIM(cvarname(jvar)(3:))//TRIM(cbasin(jbasin) )
+ cv_nameso(ivar)='zo'//TRIM(cv_namesi(jvar)(3:))//TRIM(cbasin(jbasin) )
! intercept case of duplicate zonal name
- IF (cvarname(jvar) == 'iowaflup' ) cvarnameo(ivar)='zowaflio'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'cfc11' ) cvarnameo(ivar)='zocfc11'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'bombc14' ) cvarnameo(ivar)='zobc14'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'invcfc' ) cvarnameo(ivar)='zoinvcfc'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'invc14' ) cvarnameo(ivar)='zoinvc14'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qtrcfc' ) cvarnameo(ivar)='zoqtrcfc'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qtrc14' ) cvarnameo(ivar)='zoqtrc14'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qintcfc' ) cvarnameo(ivar)='zoqintcfc'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qintc14' ) cvarnameo(ivar)='zoqintc14'//TRIM(cbasin(jbasin) )
- typvaro(ivar)%name=cvarnameo(ivar)
- ! units can be build automatically ( the same as original variable)
- typvaro(ivar)%units=typvar(jvar)%units
- ! missing value, valid min and valid max : idem original field
- typvaro(ivar)%missing_value=spval
- typvaro(ivar)%valid_min=typvar(jvar)%valid_min
- typvaro(ivar)%valid_max=typvar(jvar)%valid_max
- ! longname : prefix=Zonal_Mean_ suffix=TRIM(cbasin(jbasin)
- typvaro(ivar)%long_name='Zonal_Mean_'//TRIM(typvar(jvar)%long_name)//TRIM(cbasin(jbasin) )
- ! shortname=name
- typvaro(ivar)%short_name=typvaro(ivar)%name
- ! online operation : N/A (as usual ...)
- typvaro(ivar)%online_operation='/N/A'
- ! axis : either TY( original 2D) or TZY (original 3D)
- IF (ipk(jvar) == 1 ) THEN
- typvaro(ivar)%axis='TY'
+ IF (cv_namesi(jvar) == 'iowaflup' ) cv_nameso(ivar)='zowaflio' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'cfc11' ) cv_nameso(ivar)='zocfc11' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'bombc14' ) cv_nameso(ivar)='zobc14' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'invcfc' ) cv_nameso(ivar)='zoinvcfc' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'invc14' ) cv_nameso(ivar)='zoinvc14' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'qtrcfc' ) cv_nameso(ivar)='zoqtrcfc' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'qtrc14' ) cv_nameso(ivar)='zoqtrc14' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'qintcfc' ) cv_nameso(ivar)='zoqintcfc' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'qintc14' ) cv_nameso(ivar)='zoqintc14' // TRIM(cbasin(jbasin) )
+
+ stypvaro(ivar)%cname = cv_nameso(ivar)
+ stypvaro(ivar)%cunits = stypvari(jvar)%cunits
+ stypvaro(ivar)%rmissing_value = zspval
+ stypvaro(ivar)%valid_min = stypvari(jvar)%valid_min
+ stypvaro(ivar)%valid_max = stypvari(jvar)%valid_max
+ stypvaro(ivar)%clong_name = 'Zonal_Mean_'//TRIM(stypvari(jvar)%clong_name)//TRIM(cbasin(jbasin) )
+ stypvaro(ivar)%cshort_name = stypvaro(ivar)%cname
+ stypvaro(ivar)%conline_operation = '/N/A'
+
+ IF (ipki(jvar) == 1 ) THEN
+ stypvaro(ivar)%caxis ='TY'
ELSE
- typvaro(ivar)%axis='TZY'
+ stypvaro(ivar)%caxis ='TZY'
ENDIF
-
- ipko(ivar)=ipk(jvar)
+
+ ipko(ivar)=ipki(jvar)
END DO
ENDIF
END DO
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
- nt = getdim (cfilev,'time_counter')
+ npiglo = getdim (cf_in, cn_x)
+ npjglo = getdim (cf_in, cn_y)
+ npk = getdim (cf_in, cn_z)
+ npt = getdim (cf_in, cn_t)
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
- PRINT *, 'nt =', nt
- ! if forcing fields, npk=0, assume 1
- IF (npk==0) THEN
+ ! if 2D fields, npk=0, assume 1
+ IF ( npk == 0 ) THEN
npk = 1
- lforcing= .TRUE.
- PRINT *,' It is a forcing field, assume npk=1 and gdep=0'
+ l2d = .TRUE.
+ PRINT *,' It is a 2D field, assume npk=1 and gdep=0'
END IF
! Allocate arrays
- ALLOCATE ( zmask(npbasins,npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( zmaskvar(npiglo,npjglo) )
- ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo), gphi(npiglo,npjglo) ,gdep(npk) )
- ALLOCATE ( zomsf( npjglo, npk) ,area( npjglo, npk) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
+ ALLOCATE ( zmask(npbasins,npiglo,npjglo) )
+ ALLOCATE ( zv(npiglo,npjglo), zmaskvar(npiglo,npjglo) )
+ ALLOCATE ( e1(npiglo,npjglo), e2 (npiglo,npjglo) )
+ ALLOCATE ( gphi(npiglo,npjglo), gdep(npk), tim(npt) )
+ ALLOCATE ( zdumlon(1,npjglo), zdumlat(1,npjglo) )
+ ALLOCATE ( dzomean(npjglo,npk), darea(npjglo,npk) )
! get the metrics
- e1(:,:) = getvar(coordhgr, ce1, 1,npiglo,npjglo)
- e2(:,:) = getvar(coordhgr, ce2, 1,npiglo,npjglo)
- gphi(:,:) = getvar(coordhgr, cphi, 1,npiglo,npjglo)
- IF (.NOT. lforcing) gdep(:) = getvare3(coordzgr, cdep ,npk)
- IF (lforcing) gdep(:) = 0
- IF ( lrevert_dep ) gdep(:) = -1.* gdep(:) ! helps for plotting the results
+ e1(:,:) = getvar(cn_fhgr, cv_e1, 1, npiglo, npjglo)
+ e2(:,:) = getvar(cn_fhgr, cv_e2, 1, npiglo, npjglo)
+ gphi(:,:) = getvar(cn_fhgr, cv_phi, 1, npiglo, npjglo)
+
+ IF (l2d) THEN
+ gdep(:) = 0
+ ELSE
+ gdep(:) = getvare3(cn_fzgr, cv_depi ,npk)
+ ENDIF
+
+ IF ( .NOT. lpdep ) gdep(:) = -1.* gdep(:) ! helps for plotting the results
! Look for the i-index that go through the North Pole
- iloc = MAXLOC(gphi)
- dumlat(1,:) = gphi(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
+ ijloc = MAXLOC(gphi)
+ zdumlat(1,:) = gphi(ijloc(1),:)
+ zdumlon(:,:) = 0. ! set the dummy longitude to 0
! create output fileset
- ncout = create(cfileoutnc, cfilev, 1,npjglo,npk,cdep=cdepo)
- ierr = createvar(ncout ,typvaro,ivar, ipko,id_varout )
- ierr = putheadervar(ncout, cfilev,1,npjglo,npk,pnavlon=dumlon,pnavlat=dumlat,pdep=gdep)
- tim = getvar1d(cfilev,'time_counter',1)
- ierr = putvar1d(ncout,tim,1,'T')
+ ncout = create (cf_out, cf_in, 1, npjglo, npk, cdep=cv_depo )
+ ierr = createvar (ncout, stypvaro, ivar, ipko, id_varout )
+ ierr = putheadervar(ncout, cf_in, 1, npjglo, npk, pnavlon=zdumlon, pnavlat=zdumlat, pdep=gdep )
+
+ tim = getvar1d(cf_in, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
- ! reading the surface mask masks
+ ! reading the surface masks
! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif
- zmask(1,:,:) = getvar(cmaskfil,cmask,1,npiglo,npjglo)
- IF ( cbasinmask /= 'none' ) THEN
- zmask(2,:,:) = getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- zmask(4,:,:) = getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
- zmask(5,:,:) = getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- zmask(3,:,:) = zmask(5,:,:)+zmask(4,:,:)
+ zmask(1,:,:) = getvar(cn_fmsk, cv_msk, 1, npiglo, npjglo)
+ IF ( cf_basins /= 'none' ) THEN
+ zmask(2,:,:) = getvar(cf_basins, 'tmaskatl', 1, npiglo, npjglo )
+ zmask(4,:,:) = getvar(cf_basins, 'tmaskind', 1, npiglo, npjglo )
+ zmask(5,:,:) = getvar(cf_basins, 'tmaskpac', 1, npiglo, npjglo )
+ zmask(3,:,:) = zmask(5,:,:) + zmask(4,:,:)
! ensure that there are no overlapping on the masks
WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1
ENDIF
! main computing loop
ivar = 0
- DO jjvar = 1, mvar
- jvar = ijvar(jjvar)
- DO jt = 1,nt
- IF (MOD(jt,100)==0) PRINT *, jt,'/',nt
- DO jkk = 1, ipk(jvar)
- PRINT *,TRIM(cvarname(jvar)), ' level ',jkk
+ DO jvar = 1, nvar
+ ijvar = id_varin(jvar)
+ DO jt = 1,npt
+ IF (MOD(jt,100)==0) PRINT *, jt,'/',npt
+ DO jk = 1, ipki(ijvar)
+ PRINT *,TRIM(cv_namesi(ijvar)), ' level ',jk
! Get variables and mask at level jk
- zv(:,:) = getvar(cfilev, cvarname(jvar),jkk ,npiglo,npjglo,ktime=jt)
- zmaskvar(:,:) = getvar(cmaskfil, cmask, jkk ,npiglo,npjglo)
+ zv(:,:) = getvar(cf_in, cv_namesi(ijvar),jk ,npiglo, npjglo, ktime=jt)
+ zmaskvar(:,:) = getvar(cn_fmsk, cv_msk , jk ,npiglo, npjglo )
! For all basins
DO jbasin = 1, npbasins
- zomsf(:,:) = 0.d0
- area(:,:) = 0.d0
+ dzomean(:,:) = 0.d0
+ darea(:,:) = 0.d0
! integrates 'zonally' (along i-coordinate)
DO ji=1,npiglo
DO jj=1,npjglo
- zomsf(jj,jkk) = zomsf(jj,jkk) + e1(ji,jj)*e2(ji,jj)* zmask(jbasin,ji,jj)*zmaskvar(ji,jj)*zv(ji,jj)
- area(jj,jkk) = area(jj,jkk) + e1(ji,jj)*e2(ji,jj)* zmask(jbasin,ji,jj)*zmaskvar(ji,jj)
+ dzomean(jj,jk) = dzomean(jj,jk) + e1(ji,jj)*e2(ji,jj)* zmask(jbasin,ji,jj)*zmaskvar(ji,jj)*zv(ji,jj)*1.d0
+ darea(jj,jk) = darea(jj,jk) + e1(ji,jj)*e2(ji,jj)* zmask(jbasin,ji,jj)*zmaskvar(ji,jj)*1.d0
END DO
END DO
- ! compute the mean value if the area is not 0, else assign spval
- WHERE (area /= 0 )
- zomsf=zomsf/area
+ ! compute the mean value if the darea is not 0, else assign spval
+ WHERE (darea /= 0 )
+ dzomean=dzomean/darea
ELSEWHERE
- zomsf=spval
+ dzomean=zspval
ENDWHERE
- ivar= (jjvar-1)*npbasins + jbasin
- ierr = putvar (ncout, id_varout(ivar),REAL(zomsf(:,jkk)), jkk,1,npjglo, ktime=jt)
+ ivar = (jvar-1)*npbasins + jbasin
+ ierr = putvar (ncout, id_varout(ivar), REAL(dzomean(:,jk)), jk, 1, npjglo, ktime=jt)
END DO !next basin
END DO ! next k
END DO ! next time
diff --git a/cdfzonalout.f90 b/cdfzonalout.f90
index 927b0c9..630b6e4 100644
--- a/cdfzonalout.f90
+++ b/cdfzonalout.f90
@@ -1,103 +1,123 @@
PROGRAM cdfzonalout
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfzonalout ***
+ !!======================================================================
+ !! *** PROGRAM cdfzonalout ***
+ !!=====================================================================
+ !! ** Purpose : Output zonal mean/integral as ascii files
!!
- !! ** Purpose : Output zonal mean/integral as ascii files
- !!
- !! ** Method :
- !! Read zonalmean or zonalsum file, determine 1D variable and dump them on an ASCII file
+ !! ** Method : Read zonalmean or zonalsum file, determine 1D variable
+ !! and dump them on the standard output.
!!
- !!
- !! history ;
- !! Original : J.M. Molines (Feb. 2006)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 02/2006 : J.M. Molines : Original code
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- !! * Local variables
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER :: jbasin, jj, jk ,ji ,jvar ,jjvar !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: nvars , mvar !: number of variables in the file
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, ijvar, ipko, id_varout !: jpbasin x nvar
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4), DIMENSION (1) :: tim
+ INTEGER(KIND=4) :: jj, jvar, jt ! dummy loop index
+ INTEGER(KIND=4) :: ivar ! variable counter
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: npjglo, npt ! size of the domain
+ INTEGER(KIND=4) :: nvarin, nvar ! variables count
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipki ! input ipk variables
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: id_varin ! input variables id's
- REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: zv
+ REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdumlat ! latitude for i = north pole
+ REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zv ! data values
- CHARACTER(LEN=256) :: cfilev
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarname !: array of var name for input
- TYPE(variable), DIMENSION(:),ALLOCATABLE :: typvar
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvar ! dummy structure
+
+ CHARACTER(LEN=256) :: cf_zonal ! input file name
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_names ! input variable names
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line and output usage message if not compliant.
narg= iargc()
+
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfzonalout file '
+ PRINT *,' usage : cdfzonalout ZONAL-file'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' This is a formatting program for zonal files, either mean or integral.'
+ PRINT *,' It displays results on the standard output from the input zonal file.'
+ PRINT *,' It only works with 1D zonal variables, skipping 2D variables, that'
+ PRINT *,' cannot be easily displayed !'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' ZONAL-file : input netcdf zonal file produced by one of the zonal'
+ PRINT *,' tools.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' - Standard output, structured in columns:'
+ PRINT *,' J LAT ( zonal mean, var = 1--> nvar) '
STOP
ENDIF
- CALL getarg (1, cfilev)
+ CALL getarg (1, cf_zonal)
+ IF ( chkfile(cf_zonal) ) STOP ! missing file
- nvars = getnvar(cfilev)
- ALLOCATE ( cvarname(nvars) ,ipk(nvars), ijvar(nvars), typvar(nvars) )
- cvarname(1:nvars) = getvarname(cfilev,nvars,typvar)
- ipk(1:nvars) = getipk(cfilev,nvars)
+ nvarin = getnvar(cf_zonal)
+ ALLOCATE ( cv_names(nvarin), ipki(nvarin), id_varin(nvarin), stypvar(nvarin) )
+
+ cv_names(:) = getvarname(cf_zonal, nvarin, stypvar )
+ ipki(:) = getipk (cf_zonal, nvarin )
! Open standard output with reclen 2048 for avoid wrapping with ifort
OPEN(6,FORM='FORMATTED',RECL=2048)
! look for 1D var ( f(lat) )
- mvar = 0
- DO jvar = 1,nvars
+ nvar = 0
+ DO jvar = 1,nvarin
! skip variables such as nav_lon, nav_lat, time_counter deptht ...
- IF (ipk(jvar) == 0 .OR. ipk(jvar) > 1 ) THEN
- cvarname(jvar)='none'
+ IF (ipki(jvar) == 0 .OR. ipki(jvar) > 1 ) THEN
+ cv_names(jvar)='none'
ELSE
- mvar = mvar + 1 ! count for valid input variables
- ijvar(mvar) = jvar ! use indirect adressing for those variables
+ nvar = nvar + 1 ! count for elligible input variables
+ id_varin(nvar) = jvar ! use indirect adressing for those variables
ENDIF
END DO
- WRITE(6,*) 'Number of 1D variables :', mvar
- DO jjvar=1,mvar
- jvar=ijvar(jjvar)
- WRITE(6,*) ' ',TRIM(cvarname(jvar))
- ENDDO
-
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
+ WRITE(6,*) 'Number of 1D variables :', nvar
+ DO jvar=1,nvar
+ ivar=id_varin(jvar)
+ WRITE(6,*) ' ',TRIM(cv_names(ivar))
+ ENDDO
+ npjglo = getdim (cf_zonal,cn_y)
+ npt = getdim (cf_zonal,cn_t)
- WRITE(6,*) 'npiglo=', npiglo
- WRITE(6,*) 'npjglo=', npjglo
- WRITE(6,*) 'npk =', npk
+ WRITE(6,*) 'npjglo =', npjglo
+ WRITE(6,*) 'npt =', npt
! Allocate arrays
- ALLOCATE ( zv(npiglo,npjglo,mvar) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
-
+ ALLOCATE ( zv(1,npjglo,nvar), tim(npt) )
+ ALLOCATE ( zdumlat(1,npjglo) )
- dumlat(:,:) = getvar(cfilev,'nav_lat',1,1,npjglo)
+ zdumlat(:,:) = getvar (cf_zonal, 'nav_lat', 1, 1, npjglo)
+ tim(:) = getvar1d(cf_zonal, cn_vtimec, npt )
- ! main computing loop
- DO jjvar = 1, mvar
- jvar = ijvar(jjvar)
- ! Get variables and mask at level jk
- zv(:,:,jjvar) = getvar(cfilev, cvarname(jvar), 1 ,1,npjglo)
+ DO jt = 1, npt ! time loop
+ ! main elligible variable loop
+ DO jvar = 1, nvar
+ ivar = id_varin(jvar)
+ zv(:,:,jvar) = getvar(cf_zonal, cv_names(ivar), 1, 1, npjglo, ktime=jt)
+ END DO ! next variable
- END DO ! next variable
+ WRITE(6,*) ' JT = ', jt, ' TIME = ', tim(jt)
+ WRITE(6,*) ' J LAT ', (TRIM(cv_names(id_varin(jvar))),' ',jvar=1,nvar)
- WRITE(6,*) ' J LAT ', (TRIM(cvarname(ijvar(jjvar))),' ',jjvar=1,mvar)
- DO jj=npjglo,1,-1
- WRITE(6,*) jj, dumlat(1,jj), zv(1,jj,1:mvar)
+ DO jj=npjglo,1,-1
+ WRITE(6,*) jj, zdumlat(1,jj), zv(1,jj,1:nvar)
+ ENDDO
ENDDO
diff --git a/cdfzonalsum.f90 b/cdfzonalsum.f90
index 75afbb3..858809a 100644
--- a/cdfzonalsum.f90
+++ b/cdfzonalsum.f90
@@ -1,271 +1,342 @@
PROGRAM cdfzonalsum
- !!-------------------------------------------------------------------
- !! *** PROGRAM cdfzonalsum ***
+ !!======================================================================
+ !! *** PROGRAM cdfzonalsum ***
+ !!=====================================================================
+ !! ** Purpose : Compute the zonal sum of a file
!!
- !! ** Purpose : Compute the zonal sum
- !!
- !! ** Method :
- !! Results are saved on zonalsum.nc file with
- !! variables name respectively as follow:
- !! same as input except that the 2 first char are
- !! changed to zo. Then a suffix is append to the
- !! name of the variable : glo atl inp ind and pac
- !! if a subbasin mask is given on input., else
- !! the suffix glo is used. Example :
- !! sosaline_glo sosaline_atl etc ...
+ !! ** Method : In this program the 'zonal' sum is in fact a sum
+ !! along the I coordinate.
!!
- !!
- !! history ;
- !! Original : J.M. Molines (nov. 2005)
- !!-------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- !! * Modules used
+ !! History : 2.1 : 11/2005 : J.M. Molines : Original code
+ !! : 06/2007 : P. Mathiot : adaptation for 2D files
+ !! 3.0 : 05/2011 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2011, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
!! * Local variables
IMPLICIT NONE
- INTEGER :: npbasins=1, ivar = 0 !: number of subbasin, number of output var
- INTEGER :: jbasin, jj, jk ,ji ,jvar ,jjvar !: dummy loop index
- INTEGER :: ierr !: working integer
- INTEGER :: narg, iargc !: command line
- INTEGER :: npiglo,npjglo, npk !: size of the domain
- INTEGER :: ncout
- INTEGER :: nvars , mvar !: number of variables in the file
- INTEGER, DIMENSION(:), ALLOCATABLE :: ipk, ijvar, ipko, id_varout !: jpbasin x nvar
- INTEGER, DIMENSION(2) :: iloc
-
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, gphi, zv !: metrics, velocity
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlon !: dummy longitude = 0.
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: dumlat !: latitude for i = north pole
- REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmaskvar
- REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep !: gdept or gdepw
- REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask !: jpbasins x npiglo x npjglo
- REAL(KIND=4), DIMENSION (1) :: tim
-
- REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zomsf , area !: jpbasins x npjglo x npk
- CHARACTER(LEN=256) :: cfilev , cfileoutnc='zonalsum.nc', cdum
- CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc',cmaskfil='mask.nc',cbasinmask='none'
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarname !: array of var name for input
- CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarnameo !: array of var name for output
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvaro !: structure for attribute
- TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar !: structure for attribute
-
- CHARACTER(LEN=10) :: ce1, ce2, cphi, cdep,cmask, cdepo
- CHARACTER(LEN=4),DIMENSION(5) :: cbasin=(/'_glo','_atl','_inp','_ind','_pac'/)
-
- LOGICAL :: lrevert_dep = .TRUE. !: flag to revert depth order for plotting facility
+ INTEGER(KIND=4) :: ji, jj, jk ,jt ! dummy loop index
+ INTEGER(KIND=4) :: jbasin, jvar ! dummy loop index
+ INTEGER(KIND=4) :: ijvar ! variable counter
+ INTEGER(KIND=4) :: npbasins=1 ! number of subbasin
+ INTEGER(KIND=4) :: ivar = 0 ! output variable counter
+ INTEGER(KIND=4) :: narg, iargc ! command line
+ INTEGER(KIND=4) :: ijarg, ireq ! command line
+ INTEGER(KIND=4) :: npiglo, npjglo ! size of the domain
+ INTEGER(KIND=4) :: npk, npt ! size of the domain
+ INTEGER(KIND=4) :: nvarin, nvar ! number of input variables: all/valid
+ INTEGER(KIND=4) :: ncout ! ncid of output file
+ INTEGER(KIND=4) :: ierr ! working integer
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipki, id_varin ! jpbasin x nvar
+ INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ipko, id_varout ! jpbasin x nvar
+ INTEGER(KIND=4), DIMENSION(2) :: ijloc ! working array for maxloc
+
+ REAL(KIND=4) :: ra = 6371229. ! earth radius (m)
+ REAL(KIND=4) :: z2pi ! 2 x 3.14...
+ REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: tim ! time counter
+ REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: gdep ! gdept or gdepw
+ REAL(KIND=4), DIMENSION (:), ALLOCATABLE :: alpha !
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e1, e2, gphi, zv ! metrics, latitude, data value
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdumlon ! dummy longitude = 0.
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zdumlat ! latitude for i = north pole
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmaskvar ! variable mask
+ REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: zmask ! basin mask jpbasins x npiglo x npjglo
+
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: dzosum ! jpbasins x npjglo x npk
+
+ CHARACTER(LEN=256) :: cf_in ! input file name
+ CHARACTER(LEN=256) :: cf_out='zonalsum.nc' ! output file name
+ CHARACTER(LEN=256) :: cf_pdeg='zonalintdeg.nc' ! output file name
+ CHARACTER(LEN=256) :: cf_basins='none' ! sub basin file name
+ CHARACTER(LEN=10 ) :: cv_e1, cv_e2 ! horizontal metrics variable names
+ CHARACTER(LEN=10 ) :: cv_phi ! latitude variable name
+ CHARACTER(LEN=10 ) :: cv_msk ! mask variable name
+ CHARACTER(LEN=10 ) :: cv_depi, cv_depo ! depth variable name (input/output)
+ CHARACTER(LEN=256) :: cldum ! dummy character variable
+ CHARACTER(LEN=256) :: ctyp ! variable type on C-grid
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_namesi ! input variable names
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cv_nameso ! output variable names
+ CHARACTER(LEN=4 ), DIMENSION(5) :: cbasin=(/'_glo','_atl','_inp','_ind','_pac'/) ! sub basin suffixes
+
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvari ! structure for input variables
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: stypvaro ! structure for output variables
+
+ LOGICAL :: lpdep =.FALSE. ! flag for depth sign (default dep < 0)
+ LOGICAL :: lpdeg =.FALSE. ! flag for per degree normalization
+ LOGICAL :: l2d =.FALSE. ! flag for 2D files
+ LOGICAL :: lchk =.FALSE. ! flag for missing files
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
- !! Read command line and output usage message if not compliant.
narg= iargc()
IF ( narg == 0 ) THEN
- PRINT *,' Usage : cdfzonalsum file T | U | V | F | W [new_maskglo.nc]'
- PRINT *,' Computes the zonal sum '
- PRINT *,' If no new_maskglo specified, assume global '
- PRINT *,' Files mesh_hgr.nc, mesh_zgr.nc ,mask.nc '
- PRINT *,' must be in the current directory'
- PRINT *,' Output on zonalsum.nc: '
- PRINT *,' variables zoixxxx_glo : Global ocean '
- PRINT *,' variables zoixxxx_atl : Atlantic Ocean '
- PRINT *,' variables zoixxxx_inp : Indo Pacific '
- PRINT *,' variables zoixxxx_ind : Indian Ocean alone'
- PRINT *,' variables zoixxxx_pac : Pacific Ocean alone'
- PRINT *,' Depth variable output is negative (standard) unless '
- PRINT *,' you recompile the tool with lrevert_dep=.false.'
+ PRINT *,' usage : cdfzonalsum IN-file point_type [ BASIN-file] ...'
+ PRINT *,' ... [-pdep | --positive_depths]'
+ PRINT *,' ... [-pdeg | --per_degree]'
+ PRINT *,' '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Compute the zonal sum of all the variables available in the'
+ PRINT *,' input file. This program assume that all the variables are'
+ PRINT *,' located on the same C-grid point, specified on the command line.'
+ PRINT *,' '
+ PRINT *,' Zonal sum is in fact the integral value computed along the I coordinate.'
+ PRINT *,' The result is a vertical slice, in the meridional direction.'
+ PRINT *,' '
+ PRINT *,' REMARK : partial step are not handled properly (but probably '
+ PRINT *,' minor impact on results).'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' IN-file : input netcdf file.'
+ PRINT *,' point_type : indicate the location on C-grid (T|U|V|F|W)'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [BASIN-file] : netcdf file describing sub basins, similar to '
+ PRINT *,' ', TRIM(cn_fbasins),'. If this name is not given '
+ PRINT *,' as option, only the global zonal integral is computed.'
+ PRINT *,' [-pdep | --positive_depths ] : use positive depths in the output file.'
+ PRINT *,' Default behaviour is to have negative depths.'
+ PRINT *,' [-pdeg | --per_degree ] : When using this option, the zonal integral'
+ PRINT *,' is normalized per degree of latitude. This was formally'
+ PRINT *,' done with cdfzonalintdeg program, which is now merged'
+ PRINT *,' in this one.'
+ PRINT *,' Default behaviour is not to normalize.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' ',TRIM(cn_fhgr),', ', TRIM(cn_fzgr),' and ', TRIM(cn_fmsk)
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' netcdf file : ', TRIM(cf_out),' or ', TRIM(cf_pdeg),' (-pdeg option)'
+ PRINT *,' variables : output variable names are built with the following'
+ PRINT *,' convention: zoixxxx_bas'
+ PRINT *,' where zoi replace vo/so prefix of the input variable'
+ PRINT *,' where bas is a suffix for each sub-basins (or glo)'
+ PRINT *,' if a BASIN-file is used.'
+ PRINT *,' Units are modified by adding ''.m2'' at the end. Can be improved !'
+ PRINT *,' In addition, ''.degree-1'' is append to unit with -pdeg option.'
STOP
ENDIF
- CALL getarg (1, cfilev)
- CALL getarg (2, cdum )
+ ijarg = 1 ; ireq = 0
+ DO WHILE ( ijarg <= narg )
+ CALL getarg( ijarg, cldum ) ; ijarg=ijarg+1
+ SELECT CASE (cldum)
+ CASE ( '-pdep' , '--positive_depths' ) ; lpdep =.TRUE.
+ CASE ( '-pdeg' , '--per_degree' ) ; lpdeg =.TRUE.
+ CASE DEFAULT
+ ireq=ireq+1
+ SELECT CASE (ireq)
+ CASE (1) ; cf_in = cldum ! file name is the 1rst argument
+ CASE (2) ; ctyp = cldum ! point type is the 2nd
+ CASE (3) ; cf_basins = cldum ! sub basin file is the 3rd (optional)
+ npbasins = 5
+ lchk = chkfile (cf_basins)
+ CASE DEFAULT
+ PRINT *,' Too many arguments ...' ; STOP
+ END SELECT
+ END SELECT
+ END DO
+
+ ! check files existence
+ lchk = lchk .OR. chkfile (cn_fhgr)
+ lchk = lchk .OR. chkfile (cn_fzgr)
+ lchk = lchk .OR. chkfile (cn_fmsk)
+ lchk = lchk .OR. chkfile (cf_in )
+ IF ( lchk ) STOP ! missing files
! set the metrics according to C grid point
- SELECT CASE (cdum)
+ SELECT CASE (ctyp)
CASE ('T', 't', 'S', 's')
- ce1='e1t'
- ce2='e2t'
- cdep='gdept'
- cdepo='deptht'
- cphi='gphit'
- cmask='tmask'
+ cv_e1 = cn_ve1t ; cv_e2 = cn_ve2t
+ cv_depi = cn_gdept ; cv_depo = cn_vdeptht
+ cv_phi = cn_gphit ; cv_msk = 'tmask'
CASE ('U', 'u')
- ce1='e1u'
- ce2='e2u'
- cdep='gdepu'
- cdepo='depthu'
- cphi='gphiu'
- cmask='umask'
+ cv_e1 = cn_ve1u ; cv_e2 = cn_ve2u
+ cv_depi = cn_gdept ; cv_depo = cn_vdepthu
+ cv_phi = cn_gphiu ; cv_msk = 'umask'
CASE ('V', 'v')
- ce1='e1v'
- ce2='e2v'
- cdep='gdepv'
- cdepo='depthv'
- cphi='gphiv'
- cmask='vmask'
+ cv_e1 = cn_ve1v ; cv_e2 = cn_ve2v
+ cv_depi = cn_gdept ; cv_depo = cn_vdepthv
+ cv_phi = cn_gphiv ; cv_msk = 'vmask'
CASE ('F', 'f')
- ce1='e1f'
- ce2='e2f'
- cdep='gdepf'
- cdepo='deptht'
- cphi='gphif'
- cmask='fmask'
+ cv_e1 = cn_ve1f ; cv_e2 = cn_ve2f
+ cv_depi = cn_gdept ; cv_depo = cn_vdeptht
+ cv_phi = cn_gphif ; cv_msk = 'fmask'
CASE ('W', 'w')
- ce1='e1t'
- ce2='e2t'
- cdep='gdepw'
- cdepo='depthw'
- cphi='gphit'
- cmask='tmask'
+ cv_e1 = cn_ve1t ; cv_e2 = cn_ve2t
+ cv_depi = cn_gdepw ; cv_depo = cn_vdepthw
+ cv_phi = cn_gphit ; cv_msk = 'tmask'
CASE DEFAULT
- PRINT *, ' C grid:', TRIM(cdum),' point not known!'
- STOP
+ PRINT *, ' C grid:', TRIM(ctyp),' point not known!' ; STOP
END SELECT
- ! Read sub_basin file name (optional)
- IF (narg == 3 ) THEN
- CALL getarg(3, cbasinmask)
- npbasins=5
- ENDIF
-
- nvars = getnvar(cfilev)
- ALLOCATE ( cvarname(nvars) ,ipk(nvars), ijvar(nvars), typvar(nvars) )
- ALLOCATE ( cvarnameo(npbasins*nvars),ipko(npbasins*nvars),id_varout(npbasins*nvars) )
- ALLOCATE ( typvaro(npbasins*nvars) )
+ nvarin = getnvar(cf_in) ! number of input variables
+ ALLOCATE ( cv_namesi(nvarin), ipki(nvarin), id_varin (nvarin) )
+ ALLOCATE ( cv_nameso(npbasins*nvarin), ipko(npbasins*nvarin), id_varout(npbasins*nvarin) )
+ ALLOCATE ( stypvari(nvarin) )
+ ALLOCATE ( stypvaro(npbasins*nvarin) )
- cvarname(1:nvars) = getvarname(cfilev,nvars,typvar)
- ipk(1:nvars) = getipk(cfilev,nvars)
+ cv_namesi(1:nvarin) = getvarname(cf_in, nvarin, stypvari )
+ ipki (1:nvarin) = getipk (cf_in, nvarin )
! buildt output filename
- ivar = 0 ; mvar = 0
- DO jvar = 1,nvars
+ nvar = 0 ! over all number of valid variables for zonal sum ( < nvarin)
+ ivar = 0 ! over all variable counter ( nvar x basins)
+ DO jvar = 1,nvarin
! skip variables such as nav_lon, nav_lat, time_counter deptht ...
- IF (ipk(jvar) == 0 ) THEN
- cvarname(jvar)='none'
+ IF (ipki(jvar) == 0 ) THEN
+ cv_namesi(jvar)='none'
ELSE
- mvar = mvar + 1 ! count for valid input variables
- ijvar(mvar) = jvar ! use indirect adressing for those variables
+ nvar = nvar + 1 ! count for valid input variables
+ id_varin(nvar) = jvar ! use indirect adressing for those variables
DO jbasin=1,npbasins
ivar=ivar + 1 ! count for output variables
- cvarnameo(ivar)='zoi'//TRIM(cvarname(jvar)(3:))//TRIM(cbasin(jbasin) )
+ cv_nameso(ivar)='zoi'//TRIM(cv_namesi(jvar)(3:))//TRIM(cbasin(jbasin) )
! intercept case of duplicate zonal name
- IF (cvarname(jvar) == 'iowaflup' ) cvarnameo(ivar)='zoiwaflio'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'cfc11' ) cvarnameo(ivar)='zoicfc11'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'bombc14' ) cvarnameo(ivar)='zoibc14'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'invcfc' ) cvarnameo(ivar)='zoiinvcfc'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'invc14' ) cvarnameo(ivar)='zoiinvc14'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qtrcfc' ) cvarnameo(ivar)='zoiqtrcfc'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qtrc14' ) cvarnameo(ivar)='zoiqtrc14'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qintcfc' ) cvarnameo(ivar)='zoiqintcfc'//TRIM(cbasin(jbasin) )
- IF (cvarname(jvar) == 'qintc14' ) cvarnameo(ivar)='zoiqintc14'//TRIM(cbasin(jbasin) )
-
- typvaro(ivar)%name=cvarnameo(ivar)
+ IF (cv_namesi(jvar) == 'iowaflup' ) cv_nameso(ivar)='zoiwaflio' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'cfc11' ) cv_nameso(ivar)='zoicfc11' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'bombc14' ) cv_nameso(ivar)='zoibc14' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'invcfc' ) cv_nameso(ivar)='zoiinvcfc' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'invc14' ) cv_nameso(ivar)='zoiinvc14' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'qtrcfc' ) cv_nameso(ivar)='zoiqtrcfc' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'qtrc14' ) cv_nameso(ivar)='zoiqtrc14' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'qintcfc' ) cv_nameso(ivar)='zoiqintcfc' // TRIM(cbasin(jbasin) )
+ IF (cv_namesi(jvar) == 'qintc14' ) cv_nameso(ivar)='zoiqintc14' // TRIM(cbasin(jbasin) )
+
+ stypvaro(ivar)%cname = cv_nameso(ivar)
! units can be build automatically: add .m2 at the end (not very nice ...)
! a special function to parse the unit and build the proper one is to be done
! this is tricky as many details are to be taken into account :
! eg : mol/m2, kg.m-2, W/m2
- typvaro(ivar)%units=TRIM(typvar(jvar)%units)//'.m2'
- ! missing value, valid min and valid max : idem original field
- typvaro(ivar)%missing_value=typvar(jvar)%missing_value
- typvaro(ivar)%valid_min=typvar(jvar)%valid_min
- typvaro(ivar)%valid_max=typvar(jvar)%valid_max
- ! longname : prefix=Zonal_Integral suffix=TRIM(cbasin(jbasin)
- typvaro(ivar)%long_name='Zonal_Integral'//TRIM(typvar(jvar)%long_name)//TRIM(cbasin(jbasin) )
- ! shortname=name
- typvaro(ivar)%short_name=typvaro(ivar)%name
- ! online operation : N/A (as usual ...)
- typvaro(ivar)%online_operation='/N/A'
- ! axis : either TY( original 2D) or TZY (original 3D)
- IF (ipk(jvar) == 1 ) THEN
- typvaro(ivar)%axis='TY'
+ IF ( lpdeg ) THEN
+ cf_out = cf_pdeg
+ stypvaro(ivar)%cunits = stypvari(jvar)%cunits//'.m2.degree-1'
+ stypvaro(ivar)%clong_name = 'Zonal_Integral_per_pegree_'//TRIM(stypvari(jvar)%clong_name)//TRIM(cbasin(jbasin) )
ELSE
- typvaro(ivar)%axis='TZY'
+ stypvaro(ivar)%cunits = stypvari(jvar)%cunits//'.m2'
+ stypvaro(ivar)%clong_name = 'Zonal_Integral_'//TRIM(stypvari(jvar)%clong_name)//TRIM(cbasin(jbasin) )
+ ENDIF
+ stypvaro(ivar)%rmissing_value = stypvari(ivar)%rmissing_value
+ stypvaro(ivar)%valid_min = stypvari(jvar)%valid_min
+ stypvaro(ivar)%valid_max = stypvari(jvar)%valid_max
+ stypvaro(ivar)%cshort_name = stypvaro(ivar)%cname
+ stypvaro(ivar)%conline_operation = '/N/A'
+
+ IF (ipki(jvar) == 1 ) THEN
+ stypvaro(ivar)%caxis ='TY'
+ ELSE
+ stypvaro(ivar)%caxis ='TZY'
ENDIF
-
-
- ipko(ivar)=ipk(jvar)
+ ipko(ivar)=ipki(jvar)
END DO
ENDIF
END DO
- npiglo= getdim (cfilev,'x')
- npjglo= getdim (cfilev,'y')
- npk = getdim (cfilev,'depth')
-
-
- PRINT *, 'npiglo=', npiglo
- PRINT *, 'npjglo=', npjglo
- PRINT *, 'npk =', npk
-
+ npiglo = getdim (cf_in, cn_x)
+ npjglo = getdim (cf_in, cn_y)
+ npk = getdim (cf_in, cn_z)
+ npt = getdim (cf_in, cn_t)
+
+ PRINT *, 'npiglo = ', npiglo
+ PRINT *, 'npjglo = ', npjglo
+ PRINT *, 'npk = ', npk
+ PRINT *, 'npt = ', npt
+
+ ! if 2D fields, npk=0, assume 1
+ IF ( npk == 0 ) THEN
+ npk = 1
+ l2d = .TRUE.
+ PRINT *,' It is a 2D field, assume npk=1 and gdep=0'
+ END IF
! Allocate arrays
- ALLOCATE ( zmask(npbasins,npiglo,npjglo) )
- ALLOCATE ( zv(npiglo,npjglo) )
- ALLOCATE ( zmaskvar(npiglo,npjglo) )
- ALLOCATE ( e1(npiglo,npjglo),e2(npiglo,npjglo), gphi(npiglo,npjglo) ,gdep(npk) )
- ALLOCATE ( zomsf( npjglo, npk) ,area( npjglo, npk) )
- ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
-
+ ALLOCATE ( zmask(npbasins,npiglo,npjglo) )
+ ALLOCATE ( zv(npiglo,npjglo), zmaskvar(npiglo,npjglo) )
+ ALLOCATE ( e1(npiglo,npjglo), e2 (npiglo,npjglo) )
+ ALLOCATE ( gphi(npiglo,npjglo), gdep(npk), tim(npt) )
+ ALLOCATE ( zdumlon(1,npjglo), zdumlat(1,npjglo) )
+ ALLOCATE ( dzosum(npjglo,npk), alpha(npjglo) )
+
! get the metrics
- e1(:,:) = getvar(coordhgr, ce1, 1,npiglo,npjglo)
- e2(:,:) = getvar(coordhgr, ce2, 1,npiglo,npjglo)
- gphi(:,:) = getvar(coordhgr, cphi, 1,npiglo,npjglo)
- gdep(:) = getvare3(coordzgr, cdep ,npk)
- IF ( lrevert_dep ) gdep(:) = -1.* gdep(:) ! helps for plotting the results
+ e1(:,:) = getvar(cn_fhgr, cv_e1, 1, npiglo, npjglo)
+ e2(:,:) = getvar(cn_fhgr, cv_e2, 1, npiglo, npjglo)
+ gphi(:,:) = getvar(cn_fhgr, cv_phi, 1, npiglo, npjglo)
+
+ ! compute the size of the meridional mesh size in degree
+ IF ( lpdeg ) THEN
+ z2pi = 2.0 * ACOS( -1.)
+ alpha(:) = e2(1,:) *360. / z2pi / ra
+ ELSE
+ alpha(:) = 1.e0
+ ENDIF
+
+ IF (l2d) THEN
+ gdep(:) = 0
+ ELSE
+ gdep(:) = getvare3(cn_fzgr, cv_depi ,npk)
+ ENDIF
+
+ IF ( .NOT. lpdep ) gdep(:) = -1.* gdep(:) ! helps for plotting the results
! Look for the i-index that go through the North Pole
- iloc = MAXLOC(gphi)
- dumlat(1,:) = gphi(iloc(1),:)
- dumlon(:,:) = 0. ! set the dummy longitude to 0
+ ijloc = MAXLOC(gphi)
+ zdumlat(1,:) = gphi(ijloc(1),:)
+ zdumlon(:,:) = 0. ! set the dummy longitude to 0
! create output fileset
- ncout = create(cfileoutnc, cfilev, 1,npjglo,npk,cdep=cdepo)
- ierr = createvar(ncout ,typvaro,ivar, ipko,id_varout )
- ierr = putheadervar(ncout, cfilev,1,npjglo,npk,pnavlon=dumlon,pnavlat=dumlat,pdep=gdep)
- tim = getvar1d(cfilev,'time_counter',1)
- ierr = putvar1d(ncout,tim,1,'T')
+ ncout = create (cf_out, cf_in, 1, npjglo, npk, cdep=cv_depo )
+ ierr = createvar (ncout, stypvaro, ivar, ipko, id_varout )
+ ierr = putheadervar(ncout, cf_in, 1, npjglo, npk, pnavlon=zdumlon, pnavlat=zdumlat, pdep=gdep )
- ! reading the surface mask masks
+ tim = getvar1d(cf_in, cn_vtimec, npt )
+ ierr = putvar1d(ncout, tim, npt, 'T')
+
+ ! reading the surface masks
! 1 : global ; 2 : Atlantic ; 3 : Indo-Pacif ; 4 : Indian ; 5 : Pacif
- zmask(1,:,:) = getvar(cmaskfil,cmask,1,npiglo,npjglo)
- IF ( cbasinmask /= 'none' ) THEN
- zmask(2,:,:) = getvar(cbasinmask,'tmaskatl',1,npiglo,npjglo)
- zmask(4,:,:) = getvar(cbasinmask,'tmaskind',1,npiglo,npjglo)
- zmask(5,:,:) = getvar(cbasinmask,'tmaskpac',1,npiglo,npjglo)
- zmask(3,:,:) = zmask(5,:,:)+zmask(4,:,:)
+ zmask(1,:,:) = getvar(cn_fmsk, cv_msk, 1, npiglo, npjglo)
+ IF ( cf_basins /= 'none' ) THEN
+ zmask(2,:,:) = getvar(cf_basins, 'tmaskatl', 1, npiglo, npjglo )
+ zmask(4,:,:) = getvar(cf_basins, 'tmaskind', 1, npiglo, npjglo )
+ zmask(5,:,:) = getvar(cf_basins, 'tmaskpac', 1, npiglo, npjglo )
+ zmask(3,:,:) = zmask(5,:,:) + zmask(4,:,:)
! ensure that there are no overlapping on the masks
WHERE(zmask(3,:,:) > 0 ) zmask(3,:,:) = 1
ENDIF
! main computing loop
ivar = 0
- DO jjvar = 1, mvar
- jvar = ijvar(jjvar)
- DO jk = 1, ipk(jvar)
- PRINT *,TRIM(cvarname(jvar)), ' level ',jk
- ! Get variables and mask at level jk
- zv(:,:) = getvar(cfilev, cvarname(jvar), jk ,npiglo,npjglo)
- zmaskvar(:,:) = getvar(cmaskfil, cmask, jk ,npiglo,npjglo)
-
- ! For all basins
- DO jbasin = 1, npbasins
- zomsf(:,:) = 0.d0
- area(:,:) = 0.d0
- ! integrates 'zonally' (along i-coordinate)
- DO ji=2,npiglo
- DO jj=1,npjglo
- zomsf(jj,jk) = zomsf(jj,jk) + e1(ji,jj)*e2(ji,jj)* zmask(jbasin,ji,jj)*zmaskvar(ji,jj)*zv(ji,jj)
+ DO jvar = 1, nvar
+ ijvar = id_varin(jvar)
+ DO jt = 1,npt
+ IF (MOD(jt,100)==0) PRINT *, jt,'/',npt
+ DO jk = 1, ipki(ijvar)
+ PRINT *,TRIM(cv_namesi(ijvar)), ' level ',jk
+ ! Get variables and mask at level jk
+ zv(:,:) = getvar(cf_in, cv_namesi(ijvar), jk ,npiglo, npjglo, ktime=jt)
+ zmaskvar(:,:) = getvar(cn_fmsk, cv_msk, jk ,npiglo, npjglo )
+
+ ! For all basins
+ DO jbasin = 1, npbasins
+ dzosum(:,:) = 0.d0
+ ! integrates 'zonally' (along i-coordinate)
+ DO ji=1,npiglo
+ DO jj=1,npjglo
+ dzosum(jj,jk) = dzosum(jj,jk) + e1(ji,jj)*e2(ji,jj)* zmask(jbasin,ji,jj)*zmaskvar(ji,jj)*zv(ji,jj)*1.d0
+ END DO
END DO
- END DO
-
- ivar= (jjvar-1)*npbasins + jbasin
- ierr = putvar (ncout, id_varout(ivar),REAL(zomsf(:,jk)), jk,1,npjglo)
-
- END DO !next basin
- END DO ! next k
-
+ dzosum(:,jk) = dzosum(:,jk) / alpha(:) ! eventual normalization per degree
+ ivar = (jvar-1)*npbasins + jbasin
+ ierr = putvar (ncout, id_varout(ivar), REAL(dzosum(:,jk)), jk, 1, npjglo, ktime=jt)
+ END DO !next basin
+ END DO ! next k
+ END DO ! next time
END DO ! next variable
ierr = closeout(ncout)
diff --git a/cdfzoom.f90 b/cdfzoom.f90
index 7fa1b54..e26bf63 100644
--- a/cdfzoom.f90
+++ b/cdfzoom.f90
@@ -1,102 +1,116 @@
PROGRAM cdfzoom
- !!----------------------------------------------------------------------------
- !! *** PROGRAM cdfzoom ***
+ !!======================================================================
+ !! *** PROGRAM cdfzoom ***
+ !!=====================================================================
+ !! ** Purpose : Extract a sub area of a cdf output file and print it
+ !! on the screen with an easy to read format.
!!
- !! ** Purpose: Extract a sub area of a cdf output file and print it on the screen
- !! with an easy to read format
+ !! ** Method : specify the variable name and file on the command line
!!
- !! ** Method: Read command line, open the file get the variable and show the sub area
- !!
- !! ** Usage : cdfzoom -f file -zoom imin imax jmin jmax -fact factor -lev klev
- !!
- !! History:
- !! 1999 : Anne de Miranda (bimgzoom)
- !! 2001 : J-M Molines for normalization
- !! 2004 : J-M Molines : support for NetCdf IOIPSL files
- !! 2006 : J-M Molines : included as cdfzoom in cdftools
- !!
- !!----------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
- ! * Module used
+ !! History : --- : 1999 : A. de Miranda : Original code in bimgtools
+ !! History : 2.1 : 11/2004 : J.M. Molines : port to CDFTOOLS
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
USE cdfio
-
- ! * Local Variable
+ USE modcdfnames
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
IMPLICIT NONE
- INTEGER ,PARAMETER :: jpk=100, jpt=700
!
- INTEGER :: numin,jk,ji,jj,jt,jl, jd, jarg
- INTEGER :: narg, iargc
- INTEGER :: isdirect
- INTEGER :: ni,nj,nk,nt,icod,ndim
- INTEGER :: niz,njz, nkz, itime, nvars
- INTEGER :: imin, imax, jmin, jmax,kext, istatus, kmin, kmax
- INTEGER :: ipmin, ipmax, jpmin, jpmax
+ INTEGER(KIND=4) :: ji, jj, jt ! dummy loop index
+ INTEGER(KIND=4) :: narg, iargc, ijarg ! browse line
+ INTEGER(KIND=4) :: ni, nj, nk, nt, ndim ! domain dimension
+ INTEGER(KIND=4) :: niz, njz, nkz ! size of zoom
+ INTEGER(KIND=4) :: iimin, iimax ! i-limits
+ INTEGER(KIND=4) :: ijmin, ijmax ! j-limits
+ INTEGER(KIND=4) :: ikmin, ikmax ! k-limits
+ INTEGER(KIND=4) :: itmin, itmax ! t-limit
+ INTEGER(KIND=4) :: ikext, ierr !
+ INTEGER(KIND=4) :: iipmin, iipmax !
+ INTEGER(KIND=4) :: ijpmin, ijpmax !
!
- REAL ,DIMENSION(:),ALLOCATABLE :: h, rtime
- REAL ,DIMENSION (:,:), ALLOCATABLE :: v2d
- REAL :: fact
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d ! data array
+ REAL(KIND=4) :: fact ! multiplying factor
!
- CHARACTER(LEN=256) :: cfilein, cline1, cline2
- CHARACTER(LEN=256) :: cvar='none', cdim
- !!
- !! 1. Initializations:
- !! -------------------
- !!
+ CHARACTER(LEN=256) :: cldum ! summy character variable
+ CHARACTER(LEN=256) :: cf_in ! input file name
+ CHARACTER(LEN=256) :: cv_in='none' ! variable name
+ !!----------------------------------------------------------------------
+ CALL ReadCdfNames()
+
narg = iargc()
- IF (narg == 0) THEN
- PRINT *,'usage :cdfzoom -f file '// &
- ' -lev kmin kmax -fact facteur' // &
- ' -zoom imin imax jmin jmax' // &
- ' -var cdfvarname '
+ IF ( narg == 0 ) THEN
+ PRINT *,' usage : cdfzoom -f file -zoom imin imax jmin jmax ...'
+ PRINT *,' ... -var cdfvar [-lev kmin kmax ] ...'
+ PRINT *,' ... [ -time tmin tmax ] [ -fact factor] '
+ PRINT *,' PURPOSE :'
+ PRINT *,' Display the numerical values of a zoomed area. By'
+ PRINT *,' default, all times and levels are shown. If the zoomed'
+ PRINT *,' area is degenerated to a single line, then the vertical'
+ PRINT *,' slab is displayed.'
+ PRINT *,' '
+ PRINT *,' ARGUMENTS :'
+ PRINT *,' -f file : name of input file'
+ PRINT *,' -zoom imin imax jmin jmax : spatial window definition'
+ PRINT *,' -var cdfvar : cdf variable name to work with.'
+ PRINT *,' '
+ PRINT *,' OPTIONS :'
+ PRINT *,' [-lev kmin kmax ] : vertical limits for display.'
+ PRINT *,' [-time tmin tmax ] : time limits for display.'
+ PRINT *,' [-fact factor ] : use a multiplicative factor for display.'
+ PRINT *,' '
+ PRINT *,' REQUIRED FILES :'
+ PRINT *,' none'
+ PRINT *,' '
+ PRINT *,' OUTPUT : '
+ PRINT *,' display on standard output'
STOP
- END IF
+ ENDIF
!
- kext=1 ; kmin=1 ; kmax=1
- fact=1
- numin = 10
- jarg=1
+ ikext = 1 ; ikmin = 1 ; ikmax = 1 ; itmin = 1 ; itmax = 1
+ fact = 1
+
+ ijarg = 1
! Read command line
- DO WHILE (jarg <= narg)
- CALL getarg(jarg,cline1)
- jarg = jarg + 1
- IF (cline1 == '-f') THEN
- CALL getarg(jarg,cline2); jarg = jarg + 1
- cfilein=cline2
- ELSE IF (cline1 == '-lev') THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) kmin
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) kmax
- ELSE IF (cline1 == '-fact') THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) fact
- ELSE IF (cline1 == '-zoom') THEN
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) imin
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) imax
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) jmin
- CALL getarg(jarg,cline2) ; jarg = jarg + 1
- READ(cline2,*) jmax
- ELSE IF ( cline1 == '-var') THEN
- CALL getarg(jarg,cvar) ; jarg = jarg + 1
- ELSE
- PRINT *, cline1,' : unknown option '
+ DO WHILE (ijarg <= narg)
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1
+ SELECT CASE ( cldum )
+ CASE ( '-f' )
+ CALL getarg(ijarg, cf_in) ; ijarg = ijarg + 1
+ CASE ( '-lev' )
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmin
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ikmax
+ CASE ( '-time' )
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itmin
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) itmax
+ CASE ( '-fact' )
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) fact
+ CASE ( '-zoom' )
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimin
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) iimax
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmin
+ CALL getarg(ijarg,cldum) ; ijarg = ijarg + 1 ; READ(cldum,*) ijmax
+ CASE ( '-var' )
+ CALL getarg(ijarg,cv_in) ; ijarg = ijarg + 1
+ CASE DEFAULT
+ PRINT *, TRIM(cldum),' : unknown option '
STOP
- END IF
+ END SELECT
END DO
+
+ IF ( chkfile (cf_in) ) STOP ! missing file
!
- ni=0 ; nj=0; nk=0; nt=0
- niz=imax-imin+1
- njz=jmax-jmin+1
- nkz=kmax-kmin+1
- kext=kmin
+ ni=0 ; nj=0 ; nk=0 ; nt=0
+ niz = iimax - iimin + 1
+ njz = ijmax - ijmin + 1
+ nkz = ikmax - ikmin + 1
+ ikext= ikmin
- IF (nkz > 1 ) THEN
+ IF ( nkz > 1 ) THEN
!working with vertical slab, either niz or njz must be 1
IF ( niz == 1 ) THEN ! y/z slab
ELSE IF ( njz == 1 ) THEN ! x/z slab
@@ -106,106 +120,112 @@ PROGRAM cdfzoom
ENDIF
ENDIF
- ni=getdim(cfilein,'x',cdim,istatus)
- IF ( istatus == 1 ) THEN
- ni=getdim(cfilein,'lon',cdim,istatus)
- IF ( istatus == 1 ) THEN
+ ni = getdim(cf_in, cn_x, cldum, ierr)
+ IF ( ierr == 1 ) THEN
+ ni = getdim(cf_in, 'lon', cldum, ierr)
+ IF ( ierr == 1 ) THEN
PRINT *,' No X or lon dim found ' ; STOP
ENDIF
ENDIF
- nj=getdim(cfilein,'y',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nj=getdim(cfilein,'lat',cdim,istatus)
- IF ( istatus == 1 ) THEN
+ nj = getdim(cf_in, cn_y, cldum, ierr)
+ IF ( ierr == 1 ) THEN
+ nj = getdim(cf_in, 'lat', cldum, ierr)
+ IF ( ierr == 1 ) THEN
PRINT *,' No y or lat dim found ' ; STOP
ENDIF
ENDIF
- nk=getdim(cfilein,'dep',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nk=getdim(cfilein,'z',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nk=getdim(cfilein,'lev',cdim,istatus)
- IF ( istatus == 1 ) THEN
+ nk = getdim(cf_in, cn_z, cldum, ierr)
+ IF ( ierr == 1 ) THEN
+ nk = getdim(cf_in, 'z', cldum, ierr)
+ IF ( ierr == 1 ) THEN
+ nk = getdim(cf_in, 'lev', cldum, ierr)
+ IF ( ierr == 1 ) THEN
PRINT *,' No dep or z or lev dim found '
ENDIF
ENDIF
ENDIF
- nt=getdim(cfilein,'time',cdim,istatus)
- IF ( istatus == 1 ) THEN
- nt=getdim(cfilein,'step',cdim,istatus)
- IF ( istatus == 1 ) THEN
+ nt = getdim(cf_in, cn_t, cldum, ierr)
+ IF ( ierr == 1 ) THEN
+ nt = getdim(cf_in, 'step', cldum, ierr)
+ IF ( ierr == 1 ) THEN
PRINT *,' No time or step dim found '
ENDIF
ENDIF
- IF (nk == 0 ) THEN ; nk = 1 ; kext=1 ; ENDIF ! assume a 2D variable
- IF (nt == 0 ) THEN ; nt = 1 ; itime=1 ; ENDIF! assume a 1 time frame file
- ALLOCATE (h(nk), rtime(nt))
+ IF ( itmax > nt ) THEN
+ PRINT *,' Not enough time steps in this file'
+ STOP
+ ENDIF
+
+ IF (nk == 0 ) THEN ; nk = 1 ; ikext = 1 ; ENDIF ! assume a 2D variable
+ IF (nt == 0 ) THEN ; nt = 1 ; ENDIF ! assume a 1 time frame file
- IF (nkz == 1 ) THEN
- ALLOCATE (v2d(niz,njz) )
+ IF ( nkz == 1 ) THEN
+ ALLOCATE ( v2d(niz,njz) )
ELSE
IF ( niz == 1 ) THEN
- ALLOCATE (v2d(njz,nkz))
+ ALLOCATE( v2d(njz,nkz))
ELSE
- ALLOCATE(v2d(niz,nkz))
+ ALLOCATE( v2d(niz,nkz))
ENDIF
ENDIF
- DO
- ndim=getvdim(cfilein,cvar)+1 ! getvdim gives ndim-1 !
- PRINT *,TRIM(cvar), ndim, kext
- SELECT CASE (nkz)
- CASE (1)
- ipmin=imin ; ipmax=imax; jpmin=jmin; jpmax=jmax
- SELECT CASE (ndim)
- CASE( 2 ) ! assume x,y variable
- v2d(:,:)=getvar(cfilein,cvar,1,niz,njz,imin,jmin)
- EXIT
- CASE( 3 ) ! assume x,y,t variable
- v2d(:,:)=getvar(cfilein,cvar,1,niz,njz,imin,jmin)
- EXIT
- CASE( 4 ) ! assume x,y,z,t variable
- v2d(:,:)=getvar(cfilein,cvar,kext,niz,njz,imin,jmin)
- EXIT
- CASE DEFAULT
- PRINT *,' Non mapable variables x-y :('
- cvar='none'
- END SELECT
+ DO jt = itmin, itmax
+ DO ! for exit statement
+ ndim = getvdim(cf_in, cv_in)+1 ! getvdim gives ndim-1 !
+ PRINT *,TRIM(cv_in), ndim, ikext
+ SELECT CASE (nkz)
+ CASE (1)
+ iipmin=iimin ; iipmax=iimax; ijpmin=ijmin; ijpmax=ijmax
+ SELECT CASE (ndim)
+ CASE( 2 ) ! assume x,y variable
+ v2d(:,:) = getvar(cf_in, cv_in, 1, niz, njz, iimin, ijmin, ktime=jt)
+ EXIT
+ CASE( 3 ) ! assume x,y,t variable
+ v2d(:,:) = getvar(cf_in, cv_in, 1, niz, njz, iimin, ijmin, ktime=jt)
+ EXIT
+ CASE( 4 ) ! assume x,y,z,t variable
+ v2d(:,:) = getvar(cf_in, cv_in, ikext, niz, njz, iimin, ijmin, ktime=jt)
+ EXIT
+ CASE DEFAULT
+ PRINT *,' Non mapable variables x-y :('
+ cv_in='none'
+ END SELECT
- CASE DEFAULT
- SELECT CASE (ndim)
- CASE( 4 ) ! assume x,y,z,t variable
- IF ( njz == 1 ) THEN
- ipmin=imin ; ipmax=imax; jpmin=kmin; jpmax=kmax
- v2d(:,:)=getvarxz(cfilein,cvar,jmin,niz,nkz,imin,kmin)
- ELSE
- ipmin=jmin ; ipmax=jmax; jpmin=kmin; jpmax=kmax
- v2d(:,:)=getvaryz(cfilein,cvar,imin,njz,nkz,jmin,kmin)
- ENDIF
- EXIT
CASE DEFAULT
- PRINT *,' Non mapable variables x-z or y-z :('
- cvar='none'
- END SELECT
+ SELECT CASE (ndim)
+ CASE( 4 ) ! assume x,y,z,t variable
+ IF ( njz == 1 ) THEN
+ iipmin=iimin ; iipmax=iimax; ijpmin=ikmin; ijpmax=ikmax
+ v2d(:,:) = getvarxz(cf_in, cv_in, ijmin, niz, nkz, iimin, ikmin, ktime=jt)
+ ELSE
+ iipmin=ijmin ; iipmax=ijmax; ijpmin=ikmin; ijpmax=ikmax
+ v2d(:,:) = getvaryz(cf_in, cv_in, iimin, njz, nkz, ijmin, ikmin, ktime=jt)
+ ENDIF
+ EXIT
+ CASE DEFAULT
+ PRINT *,' Non mapable variables x-z or y-z :('
+ cv_in='none'
+ END SELECT
- END SELECT ! nkz
- ENDDO
+ END SELECT ! nkz
+ ENDDO
- PRINT *,'IMIN IMAX JMIN JMAX KMIN KMAX', imin,imax,jmin,jmax,kmin,kmax
- PRINT 9001,' ',(ji,ji=ipmin,ipmax)
- IF (nkz == 1 ) THEN
- DO jj=jpmax,jpmin,-1
- PRINT 9000,jj,' ',(v2d(ji-ipmin+1,jj-jpmin+1)/fact,ji=ipmin,ipmax)
- END DO
- ELSE
- DO jj=jpmin,jpmax
- PRINT 9000,jj,' ',(v2d(ji-ipmin+1,jj-jpmin+1)/fact,ji=ipmin,ipmax)
- END DO
- ENDIF
+ PRINT *,'IMIN IMAX JMIN JMAX KMIN KMAX TIME', iimin,iimax,ijmin,ijmax,ikmin,ikmax, jt
+ PRINT 9001,' ',(ji,ji=iipmin,iipmax)
+ IF (nkz == 1 ) THEN
+ DO jj=ijpmax,ijpmin,-1
+ PRINT 9000,jj,' ',(v2d(ji-iipmin+1,jj-ijpmin+1)/fact,ji=iipmin,iipmax)
+ END DO
+ ELSE
+ DO jj=ijpmin,ijpmax
+ PRINT 9000,jj,' ',(v2d(ji-iipmin+1,jj-ijpmin+1)/fact,ji=iipmin,iipmax)
+ END DO
+ ENDIF
+ ENDDO
9000 FORMAT(i4,a,20f12.4)
9001 FORMAT(a,20i12)
diff --git a/coordinates2hgr.f90 b/coordinates2hgr.f90
deleted file mode 100644
index 068825b..0000000
--- a/coordinates2hgr.f90
+++ /dev/null
@@ -1,277 +0,0 @@
-PROGRAM coordinates2hgr
- !!-------------------------------------------------------------------------
- !! PROGRAM coordinates2hgr
- !! **********************
- !! ** Purpose:
- !! transform a "clipper" coordinates file into an
- !! ioipsl coordinate file
- !!
- !! History :
- !! February 2003 : Anne de Miranda
- !! June 2003 : J.M. Molines : modif for getarg (filename)
- !!--------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- USE netcdf
- IMPLICIT NONE
-
- INTEGER(4) :: jpi , jpj
- INTEGER(2) , PARAMETER :: wp = 8
- INTEGER(4) , PARAMETER :: jpk=43
-
- REAL(wp) :: zjpiglo, zjpjglo, znbsel, zrecl8, ztimm8
- REAL(wp) :: znt, zdim, xx1, yy1, ddx, ddy, sspval
-
- CHARACTER(80) :: cltextco
- INTEGER(4) :: numcoo, nummsh
- INTEGER(4) :: nrecl8
- INTEGER(4) :: ngrid
- INTEGER(4) :: ni,nj, nk
- INTEGER(4) :: jj, jk
-
- REAL(wp) , DIMENSION(:,:), ALLOCATABLE :: zlamt, zphit, zdta
- REAL(wp) , DIMENSION(1) :: zdep
- REAL(wp) zdt,zdate0 , omega, pi
- REAL(wp), DIMENSION(jpk) :: gdept, gdepw, e3t, e3w
-
- CHARACTER (len=21) :: clname
- INTEGER ilev, itime, iargc, narg
- LOGICAL clog
- CHARACTER(LEN=256) :: cfilin, cfilout
-
- REAL(wp) , DIMENSION(:,:), ALLOCATABLE :: &
- glamt, glamu, glamv, glamf, gphit, gphiu, gphiv, gphif, &
- e1t, e1u, e1v, e1f, e2t, e2u, e2v, e2f, ff
-
- ! netcdf stuff
- INTEGER :: istatus, ncid
- INTEGER :: id_x, id_y, id_z, id_time, id_xa, id_ya, id_za
- INTEGER :: id_lon, id_lat, id_lev, id_tim, id_ts
- INTEGER :: id_lamt, id_lamu, id_lamv, id_lamf
- INTEGER :: id_phit, id_phiu, id_phiv, id_phif
- INTEGER :: id_e1t, id_e1u, id_e1v, id_e1f
- INTEGER :: id_e2t, id_e2u, id_e2v, id_e2f, id_ff
-
-
- numcoo = 10
- nummsh = 11
- narg=iargc()
-
- IF ( narg /= 1 ) THEN
- PRINT *,' >>> Usage: coordinates2hgr ''coordinates file'' '
- PRINT *,' Output is done on mesh_hgr.nc '
- STOP
- END IF
-
- CALL getarg(1,cfilin)
- cfilout='mesh_hgr.nc'
- !
- ! ... Read coordinates (only the used metric is read)
- !
- nrecl8 = 200
- OPEN( numcoo, FILE = cfilin, status='old' &
- ,form = 'unformatted', access ='direct',recl = nrecl8)
- READ(numcoo, rec = 1) cltextco, zrecl8, zjpiglo, zjpjglo
- CLOSE(numcoo)
- !
- print *, cltextco, zrecl8, zjpiglo, zjpjglo
- nrecl8 = zrecl8
- print*, nrecl8
-
- OPEN(numcoo, FILE=cfilin, status='old', form='unformatted', &
- access='direct',recl=nrecl8)
- READ (numcoo, rec = 1) cltextco, zrecl8, zjpiglo, zjpjglo, znbsel, znt, &
- zdim, xx1, yy1, ddx, ddy, sspval &
- ,(gdept(jk),jk=1,jpk), &
- ztimm8, &
- (gdepw(jk),jk=1,jpk), &
- (e3t(jk),jk=1,jpk), &
- (e3w(jk),jk=1,jpk)
- ni = zjpiglo
- nj = zjpjglo
- print *, 'ni=',ni,'nj=',nj
- ALLOCATE(glamt(ni,nj))
- ALLOCATE(glamu(ni,nj))
- ALLOCATE(glamv(ni,nj))
- ALLOCATE(glamf(ni,nj))
- ALLOCATE(gphit(ni,nj))
- ALLOCATE(gphiu(ni,nj))
- ALLOCATE(gphiv(ni,nj))
- ALLOCATE(gphif(ni,nj))
- ALLOCATE(e1t(ni,nj))
- ALLOCATE(e1u(ni,nj))
- ALLOCATE(e1v(ni,nj))
- ALLOCATE(e1f(ni,nj))
- ALLOCATE(e2t(ni,nj))
- ALLOCATE(e2u(ni,nj))
- ALLOCATE(e2v(ni,nj))
- ALLOCATE(e2f(ni,nj))
- ALLOCATE(ff(ni,nj))
-
- READ(numcoo,rec=2) glamt
- READ(numcoo,rec=3) glamu
- READ(numcoo,rec=4) glamv
- READ(numcoo,rec=5) glamf
- READ(numcoo,rec=6) gphit
- READ(numcoo,rec=7) gphiu
- READ(numcoo,rec=8) gphiv
- READ(numcoo,rec=9) gphif
- READ(numcoo,rec=10) e1t
- READ(numcoo,rec=11) e1u
- READ(numcoo,rec=12) e1v
- READ(numcoo,rec=13) e1f
- READ(numcoo,rec=14) e2t
- READ(numcoo,rec=15) e2u
- READ(numcoo,rec=16) e2v
- READ(numcoo,rec=17) e2f
-
- print *, 'Reading ',TRIM(cfilin),' OK.'
- print *,'e2f:',(jj,e2f(1,jj),jj=289,nj)
- pi=acos(-1.d0)
- omega=2*pi/86400.d0
- ff=2*omega*sin(gphit*pi/180.)
-
- clname = cfilout
- ilev = 1
- itime = 0
- zdate0 = 0.
- zdt = 0.
- clog = .FALSE.
-
- ALLOCATE(zlamt(ni,nj))
- ALLOCATE(zphit(ni,nj))
-
- zlamt(:,:) = 0.
- zphit(:,:) = 0.
- zdep(1) = 0.
-
- jpi = zjpiglo
- jpj = zjpjglo
- print* , jpi, jpj
-
- print *,ngrid, ncid
- istatus=NF90_CREATE(cfilout,NF90_CLOBBER,ncid)
- ! define dimension x, y, z=1, time=unlimited
- istatus=NF90_DEF_DIM(ncid,'x',jpi,id_x)
- istatus=NF90_DEF_DIM(ncid,'y',jpj,id_y)
- istatus=NF90_DEF_DIM(ncid,'z',jpk ,id_z)
- istatus=NF90_DEF_DIM(ncid,'time',NF90_UNLIMITED ,id_time)
- istatus=NF90_DEF_DIM(ncid,'x_a',1,id_xa)
- istatus=NF90_DEF_DIM(ncid,'y_a',1,id_ya)
- istatus=NF90_DEF_DIM(ncid,'z_a',1 ,id_za)
-
- ! define variables
- istatus=NF90_DEF_VAR(ncid,'nav_lon',NF90_FLOAT,(/id_x,id_y/),id_lon)
- istatus=NF90_DEF_VAR(ncid,'nav_lat',NF90_FLOAT,(/id_x,id_y/),id_lat)
- istatus=NF90_DEF_VAR(ncid,'nav_lev',NF90_FLOAT,(/id_z/),id_lev)
- istatus=NF90_DEF_VAR(ncid,'time' ,NF90_FLOAT,(/id_time/),id_tim)
- istatus=NF90_DEF_VAR(ncid,'time_steps',NF90_INT,(/id_time/),id_ts)
-
- ! Horizontal grid-point position
- istatus=NF90_DEF_VAR(ncid,'glamt',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_lamt)
- istatus=NF90_DEF_VAR(ncid,'glamu',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_lamu)
- istatus=NF90_DEF_VAR(ncid,'glamv',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_lamv)
- istatus=NF90_DEF_VAR(ncid,'glamf',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_lamf)
-
- istatus=NF90_DEF_VAR(ncid,'gphit',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_phit)
- istatus=NF90_DEF_VAR(ncid,'gphiu',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_phiu)
- istatus=NF90_DEF_VAR(ncid,'gphiv',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_phiv)
- istatus=NF90_DEF_VAR(ncid,'gphif',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_phif)
-
- ! Horizontal scale factors
- istatus=NF90_DEF_VAR(ncid,'e1t',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e1t)
- istatus=NF90_DEF_VAR(ncid,'e1u',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e1u)
- istatus=NF90_DEF_VAR(ncid,'e1v',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e1v)
- istatus=NF90_DEF_VAR(ncid,'e1f',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e1f)
-
- istatus=NF90_DEF_VAR(ncid,'e2t',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e2t)
- istatus=NF90_DEF_VAR(ncid,'e2u',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e2u)
- istatus=NF90_DEF_VAR(ncid,'e2v',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e2v)
- istatus=NF90_DEF_VAR(ncid,'e2f',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e2f)
-
- istatus=NF90_DEF_VAR(ncid,'ff',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_ff)
-
- ! attributes
- !nav_lon:
- istatus=NF90_PUT_ATT(ncid,id_lon,'units','degrees_east')
- istatus=NF90_PUT_ATT(ncid,id_lon,'valid_min',-180.)
- istatus=NF90_PUT_ATT(ncid,id_lon,'valid_max',180.)
- istatus=NF90_PUT_ATT(ncid,id_lon,'long_name','Longitude')
- !nav_lat:
- istatus=NF90_PUT_ATT(ncid,id_lat,'units','degrees_north')
- istatus=NF90_PUT_ATT(ncid,id_lat,'valid_min',-90.)
- istatus=NF90_PUT_ATT(ncid,id_lat,'valid_max',90.)
- istatus=NF90_PUT_ATT(ncid,id_lat,'long_name','Latitude')
- !nav_lev:
- istatus=NF90_PUT_ATT(ncid,id_lev,'units','model_levels')
- istatus=NF90_PUT_ATT(ncid,id_lev,'valid_min',0.)
- istatus=NF90_PUT_ATT(ncid,id_lev,'valid_max',0.)
- istatus=NF90_PUT_ATT(ncid,id_lev,'long_name','Model levels')
- !time:
- istatus=NF90_PUT_ATT(ncid,id_tim,'units','seconds since 0000-01-01 00:00:00')
- istatus=NF90_PUT_ATT(ncid,id_tim,'calendar','gregorian')
- istatus=NF90_PUT_ATT(ncid,id_tim,'title','Time')
- istatus=NF90_PUT_ATT(ncid,id_tim,'long_name','Time axis')
- istatus=NF90_PUT_ATT(ncid,id_tim,'time_origin',' 0000-JAN-01 00:00:00')
- !time_steps:
- istatus=NF90_PUT_ATT(ncid,id_ts,'units','timesteps since 0000-01-01 00:00:00')
- istatus=NF90_PUT_ATT(ncid,id_ts,'title','Time steps')
- istatus=NF90_PUT_ATT(ncid,id_ts,'tstep_sec',0.)
- istatus=NF90_PUT_ATT(ncid,id_ts,'long_name','Time step axis')
- istatus=NF90_PUT_ATT(ncid,id_ts,'time_origin',' 0000-JAN-01 00:00:00')
-
- ! variables glamx, gphix, e?x
- istatus=NF90_PUT_ATT(ncid,id_lamt,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_lamu,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_lamv,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_lamf,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_phit,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_phiu,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_phiv,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_phif,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e1t,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e1u,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e1v,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e2f,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e2t,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e2u,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e2v,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e2f,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_ff,'missing_value',1.e+20)
-
- istatus=NF90_ENDDEF(ncid)
-
- ! Now fill the variables !
- istatus=NF90_PUT_VAR(ncid,id_lon,glamt)
- istatus=NF90_PUT_VAR(ncid,id_lat,gphit)
- istatus=NF90_PUT_VAR(ncid,id_lev,gdept)
- istatus=NF90_PUT_VAR(ncid,id_tim,0.)
- istatus=NF90_PUT_VAR(ncid,id_ts,1)
-
- istatus=NF90_PUT_VAR(ncid,id_lamt,glamt)
- istatus=NF90_PUT_VAR(ncid,id_lamu,glamu)
- istatus=NF90_PUT_VAR(ncid,id_lamv,glamv)
- istatus=NF90_PUT_VAR(ncid,id_lamf,glamf)
-
- istatus=NF90_PUT_VAR(ncid,id_phit,gphit)
- istatus=NF90_PUT_VAR(ncid,id_phiu,gphiu)
- istatus=NF90_PUT_VAR(ncid,id_phiv,gphiv)
- istatus=NF90_PUT_VAR(ncid,id_phif,gphif)
-
- istatus=NF90_PUT_VAR(ncid,id_e1t,e1t)
- istatus=NF90_PUT_VAR(ncid,id_e1u,e1u)
- istatus=NF90_PUT_VAR(ncid,id_e1v,e1v)
- istatus=NF90_PUT_VAR(ncid,id_e1f,e1f)
-
- istatus=NF90_PUT_VAR(ncid,id_e2t,e2t)
- istatus=NF90_PUT_VAR(ncid,id_e2u,e2u)
- istatus=NF90_PUT_VAR(ncid,id_e2v,e2v)
- istatus=NF90_PUT_VAR(ncid,id_e2f,e2f)
- istatus=NF90_PUT_VAR(ncid,id_ff,ff)
-
- istatus=NF90_CLOSE(ncid)
-
-END PROGRAM coordinates2hgr
diff --git a/coordinates2hgr_karine.f90 b/coordinates2hgr_karine.f90
deleted file mode 100644
index c3dc6a9..0000000
--- a/coordinates2hgr_karine.f90
+++ /dev/null
@@ -1,282 +0,0 @@
-PROGRAM coordinates2hgr
- !!-------------------------------------------------------------------------
- !! PROGRAM coordinates2hgr
- !! **********************
- !! ** Purpose:
- !! transform a "clipper" coordinates file into an
- !! ioipsl coordinate file
- !!
- !! History :
- !! February 2003 : Anne de Miranda
- !! June 2003 : J.M. Molines : modif for getarg (filename)
- !!--------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- USE netcdf
- IMPLICIT NONE
-
- INTEGER(4) :: jpi , jpj
- INTEGER(2) , PARAMETER :: wp = 8
- INTEGER(4) , PARAMETER :: jpk=43
-
- REAL(wp) :: zjpiglo, zjpjglo, znbsel, zrecl8, ztimm8
- REAL(wp) :: znt, zdim, xx1, yy1, ddx, ddy, sspval, bidon
-
- CHARACTER(256) :: cltextco
- INTEGER(4) :: numcoo, nummsh
- INTEGER(4) :: nrecl8
- INTEGER(4) :: ngrid
- INTEGER(4) :: ni,nj, nk
- INTEGER(4) :: jj, jk
-
- REAL(wp) , DIMENSION(:,:), ALLOCATABLE :: zlamt, zphit, zdta
- REAL(wp) , DIMENSION(1) :: zdep
- REAL(wp) zdt,zdate0 , omega, pi
- REAL(wp), DIMENSION(jpk) :: gdept, gdepw, e3t, e3w
-
- CHARACTER (len=21) :: clname
- INTEGER ilev, itime, iargc, narg
- LOGICAL clog
- CHARACTER(LEN=256) :: cfilin, cfilout
-
- REAL(wp) , DIMENSION(:,:), ALLOCATABLE :: &
- glamt, glamu, glamv, glamf, gphit, gphiu, gphiv, gphif, &
- e1t, e1u, e1v, e1f, e2t, e2u, e2v, e2f, ff
-
- ! netcdf stuff
- INTEGER :: istatus, ncid
- INTEGER :: id_x, id_y, id_z, id_time, id_xa, id_ya, id_za
- INTEGER :: id_lon, id_lat, id_lev, id_tim, id_ts
- INTEGER :: id_lamt, id_lamu, id_lamv, id_lamf
- INTEGER :: id_phit, id_phiu, id_phiv, id_phif
- INTEGER :: id_e1t, id_e1u, id_e1v, id_e1f
- INTEGER :: id_e2t, id_e2u, id_e2v, id_e2f, id_ff
-
-
- numcoo = 10
- nummsh = 11
- narg=iargc()
-
- IF ( narg /= 1 ) THEN
- PRINT *,' >>> Usage: coordinates2hgr ''coordinates file'' '
- PRINT *,' Output is done on mesh_hgr.nc '
- STOP
- END IF
-
- CALL getarg(1,cfilin)
- cfilout='mesh_hgr.nc'
- !
- ! ... Read coordinates (only the used metric is read)
- !
- nrecl8 = 200
- OPEN( numcoo, FILE = cfilin, status='old' &
- ,form = 'unformatted', access ='direct',recl = nrecl8)
- READ(numcoo, rec = 1) cltextco, zrecl8, zjpiglo, zjpjglo
- CLOSE(numcoo)
- !
- print *, cltextco, zrecl8, zjpiglo, zjpjglo
- nrecl8 = zrecl8
- print*, nrecl8
-
- OPEN(numcoo, FILE=cfilin, status='old', form='unformatted', &
- access='direct',recl=nrecl8)
- READ(numcoo,rec=1) &
- cltextco,zrecl8,zjpiglo,zjpjglo,znbsel,znt,zdim, &
- xx1,yy1,ddx,ddy,sspval, &
- (bidon,jk=1,INT(znbsel)), &
- ztimm8, &
- (gdept(jk),jk=1,jpk), &
- (bidon,jk=1,jpk), &
- (gdepw(jk),jk=1,jpk), &
- (bidon,jk=1,jpk), &
- (e3t(jk),jk=1,jpk), &
- (bidon,jk=1,jpk), &
- (e3w(jk),jk=1,jpk)
- ni = zjpiglo
- nj = zjpjglo
- print *, 'ni=',ni,'nj=',nj
- ALLOCATE(glamt(ni,nj))
- ALLOCATE(glamu(ni,nj))
- ALLOCATE(glamv(ni,nj))
- ALLOCATE(glamf(ni,nj))
- ALLOCATE(gphit(ni,nj))
- ALLOCATE(gphiu(ni,nj))
- ALLOCATE(gphiv(ni,nj))
- ALLOCATE(gphif(ni,nj))
- ALLOCATE(e1t(ni,nj))
- ALLOCATE(e1u(ni,nj))
- ALLOCATE(e1v(ni,nj))
- ALLOCATE(e1f(ni,nj))
- ALLOCATE(e2t(ni,nj))
- ALLOCATE(e2u(ni,nj))
- ALLOCATE(e2v(ni,nj))
- ALLOCATE(e2f(ni,nj))
- ALLOCATE(ff(ni,nj))
-
- READ(numcoo,rec=3) glamt
- READ(numcoo,rec=4) glamu
- READ(numcoo,rec=5) glamv
- READ(numcoo,rec=6) glamf
- READ(numcoo,rec=7) gphit
- READ(numcoo,rec=8) gphiu
- READ(numcoo,rec=9) gphiv
- READ(numcoo,rec=10) gphif
- READ(numcoo,rec=11) e1t
- READ(numcoo,rec=12) e1u
- READ(numcoo,rec=13) e1v
- READ(numcoo,rec=14) e1f
- READ(numcoo,rec=15) e2t
- READ(numcoo,rec=16) e2u
- READ(numcoo,rec=17) e2v
- READ(numcoo,rec=18) e2f
-
- print *, 'Reading ',TRIM(cfilin),' OK.'
- print *,'e2f:',(jj,e2f(1,jj),jj=289,nj)
- pi=acos(-1.d0)
- omega=2*pi/86400.d0
- ff=2*omega*sin(gphit*pi/180.)
-
- clname = cfilout
- ilev = 1
- itime = 0
- zdate0 = 0.
- zdt = 0.
- clog = .FALSE.
-
- ALLOCATE(zlamt(ni,nj))
- ALLOCATE(zphit(ni,nj))
-
- zlamt(:,:) = 0.
- zphit(:,:) = 0.
- zdep(1) = 0.
-
- jpi = zjpiglo
- jpj = zjpjglo
- print* , jpi, jpj
-
- print *,ngrid, ncid
- istatus=NF90_CREATE(cfilout,NF90_CLOBBER,ncid)
- ! define dimension x, y, z=1, time=unlimited
- istatus=NF90_DEF_DIM(ncid,'x',jpi,id_x)
- istatus=NF90_DEF_DIM(ncid,'y',jpj,id_y)
- istatus=NF90_DEF_DIM(ncid,'z',jpk ,id_z)
- istatus=NF90_DEF_DIM(ncid,'time',NF90_UNLIMITED ,id_time)
- istatus=NF90_DEF_DIM(ncid,'x_a',1,id_xa)
- istatus=NF90_DEF_DIM(ncid,'y_a',1,id_ya)
- istatus=NF90_DEF_DIM(ncid,'z_a',1 ,id_za)
-
- ! define variables
- istatus=NF90_DEF_VAR(ncid,'nav_lon',NF90_FLOAT,(/id_x,id_y/),id_lon)
- istatus=NF90_DEF_VAR(ncid,'nav_lat',NF90_FLOAT,(/id_x,id_y/),id_lat)
- istatus=NF90_DEF_VAR(ncid,'nav_lev',NF90_FLOAT,(/id_z/),id_lev)
- istatus=NF90_DEF_VAR(ncid,'time' ,NF90_FLOAT,(/id_time/),id_tim)
- istatus=NF90_DEF_VAR(ncid,'time_steps',NF90_INT,(/id_time/),id_ts)
-
- ! Horizontal grid-point position
- istatus=NF90_DEF_VAR(ncid,'glamt',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_lamt)
- istatus=NF90_DEF_VAR(ncid,'glamu',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_lamu)
- istatus=NF90_DEF_VAR(ncid,'glamv',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_lamv)
- istatus=NF90_DEF_VAR(ncid,'glamf',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_lamf)
-
- istatus=NF90_DEF_VAR(ncid,'gphit',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_phit)
- istatus=NF90_DEF_VAR(ncid,'gphiu',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_phiu)
- istatus=NF90_DEF_VAR(ncid,'gphiv',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_phiv)
- istatus=NF90_DEF_VAR(ncid,'gphif',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_phif)
-
- ! Horizontal scale factors
- istatus=NF90_DEF_VAR(ncid,'e1t',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e1t)
- istatus=NF90_DEF_VAR(ncid,'e1u',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e1u)
- istatus=NF90_DEF_VAR(ncid,'e1v',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e1v)
- istatus=NF90_DEF_VAR(ncid,'e1f',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e1f)
-
- istatus=NF90_DEF_VAR(ncid,'e2t',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e2t)
- istatus=NF90_DEF_VAR(ncid,'e2u',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e2u)
- istatus=NF90_DEF_VAR(ncid,'e2v',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e2v)
- istatus=NF90_DEF_VAR(ncid,'e2f',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_e2f)
-
- istatus=NF90_DEF_VAR(ncid,'ff',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_ff)
-
- ! attributes
- !nav_lon:
- istatus=NF90_PUT_ATT(ncid,id_lon,'units','degrees_east')
- istatus=NF90_PUT_ATT(ncid,id_lon,'valid_min',-180.)
- istatus=NF90_PUT_ATT(ncid,id_lon,'valid_max',180.)
- istatus=NF90_PUT_ATT(ncid,id_lon,'long_name','Longitude')
- !nav_lat:
- istatus=NF90_PUT_ATT(ncid,id_lat,'units','degrees_north')
- istatus=NF90_PUT_ATT(ncid,id_lat,'valid_min',-90.)
- istatus=NF90_PUT_ATT(ncid,id_lat,'valid_max',90.)
- istatus=NF90_PUT_ATT(ncid,id_lat,'long_name','Latitude')
- !nav_lev:
- istatus=NF90_PUT_ATT(ncid,id_lev,'units','model_levels')
- istatus=NF90_PUT_ATT(ncid,id_lev,'valid_min',0.)
- istatus=NF90_PUT_ATT(ncid,id_lev,'valid_max',0.)
- istatus=NF90_PUT_ATT(ncid,id_lev,'long_name','Model levels')
- !time:
- istatus=NF90_PUT_ATT(ncid,id_tim,'units','seconds since 0000-01-01 00:00:00')
- istatus=NF90_PUT_ATT(ncid,id_tim,'calendar','gregorian')
- istatus=NF90_PUT_ATT(ncid,id_tim,'title','Time')
- istatus=NF90_PUT_ATT(ncid,id_tim,'long_name','Time axis')
- istatus=NF90_PUT_ATT(ncid,id_tim,'time_origin',' 0000-JAN-01 00:00:00')
- !time_steps:
- istatus=NF90_PUT_ATT(ncid,id_ts,'units','timesteps since 0000-01-01 00:00:00')
- istatus=NF90_PUT_ATT(ncid,id_ts,'title','Time steps')
- istatus=NF90_PUT_ATT(ncid,id_ts,'tstep_sec',0.)
- istatus=NF90_PUT_ATT(ncid,id_ts,'long_name','Time step axis')
- istatus=NF90_PUT_ATT(ncid,id_ts,'time_origin',' 0000-JAN-01 00:00:00')
-
- ! variables glamx, gphix, e?x
- istatus=NF90_PUT_ATT(ncid,id_lamt,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_lamu,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_lamv,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_lamf,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_phit,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_phiu,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_phiv,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_phif,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e1t,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e1u,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e1v,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e2f,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e2t,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e2u,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e2v,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e2f,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_ff,'missing_value',1.e+20)
-
- istatus=NF90_ENDDEF(ncid)
-
- ! Now fill the variables !
- istatus=NF90_PUT_VAR(ncid,id_lon,glamt)
- istatus=NF90_PUT_VAR(ncid,id_lat,gphit)
- istatus=NF90_PUT_VAR(ncid,id_lev,gdept)
- istatus=NF90_PUT_VAR(ncid,id_tim,0.)
- istatus=NF90_PUT_VAR(ncid,id_ts,1)
-
- istatus=NF90_PUT_VAR(ncid,id_lamt,glamt)
- istatus=NF90_PUT_VAR(ncid,id_lamu,glamu)
- istatus=NF90_PUT_VAR(ncid,id_lamv,glamv)
- istatus=NF90_PUT_VAR(ncid,id_lamf,glamf)
-
- istatus=NF90_PUT_VAR(ncid,id_phit,gphit)
- istatus=NF90_PUT_VAR(ncid,id_phiu,gphiu)
- istatus=NF90_PUT_VAR(ncid,id_phiv,gphiv)
- istatus=NF90_PUT_VAR(ncid,id_phif,gphif)
-
- istatus=NF90_PUT_VAR(ncid,id_e1t,e1t)
- istatus=NF90_PUT_VAR(ncid,id_e1u,e1u)
- istatus=NF90_PUT_VAR(ncid,id_e1v,e1v)
- istatus=NF90_PUT_VAR(ncid,id_e1f,e1f)
-
- istatus=NF90_PUT_VAR(ncid,id_e2t,e2t)
- istatus=NF90_PUT_VAR(ncid,id_e2u,e2u)
- istatus=NF90_PUT_VAR(ncid,id_e2v,e2v)
- istatus=NF90_PUT_VAR(ncid,id_e2f,e2f)
- istatus=NF90_PUT_VAR(ncid,id_ff,ff)
-
- istatus=NF90_CLOSE(ncid)
-
-END PROGRAM coordinates2hgr
diff --git a/coordinates2zgr.f90 b/coordinates2zgr.f90
deleted file mode 100644
index a401122..0000000
--- a/coordinates2zgr.f90
+++ /dev/null
@@ -1,239 +0,0 @@
-PROGRAM coordinates2zgr
- !!-------------------------------------------------------------------------
- !! PROGRAM coordinates2zgr
- !! **********************
- !! ** Purpose:
- !! transform a "clipper" coordinates file into an
- !! ioipsl coordinate file
- !!
- !! History :
- !! February 2003 : Anne de Miranda
- !! June 2003 : J.M. Molines : modif for getarg (filename)
- !!--------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- USE netcdf
- IMPLICIT NONE
-
- INTEGER(4) :: jpi , jpj
- INTEGER(2) , PARAMETER :: wp = 8
- INTEGER(4) , PARAMETER :: jpk=43
-
- REAL(wp) :: zjpiglo, zjpjglo, znbsel, zrecl8, ztimm8
- REAL(wp) :: znt, zdim, xx1, yy1, ddx, ddy, sspval
-
- CHARACTER(80) :: cltextco
- INTEGER(4) :: numcoo, nummsh, numbat
- INTEGER(4) :: nrecl8
- INTEGER(4) :: ngrid
- INTEGER(4) :: ni,nj, nk
- INTEGER(4) :: jj, jk, iim,ijm, il1, il2, ifreq, jn, ii, ji , ij
- INTEGER(KIND=4) :: ierr=0, npi, npj, npizoom=1, npjzoom=1
- INTEGER(KIND=4) , DIMENSION(:,:), ALLOCATABLE :: idata
-
- REAL(wp) , DIMENSION(:,:), ALLOCATABLE :: glamt,gphit
- REAL(wp) , DIMENSION(1) :: zdep
- REAL(wp) zdt,zdate0 , omega, pi
- REAL(wp), DIMENSION(jpk) :: gdept, gdepw, e3t, e3w
-
- CHARACTER (len=21) :: clname
- INTEGER ilev, itime, iargc, narg
- LOGICAL clog
- CHARACTER(LEN=256) :: cfilin, cfilout, cbathy, clexp, clfmt, cdum
-
- REAL(wp) , DIMENSION(:,:), ALLOCATABLE :: bathy
- LOGICAL :: ln_glo
-
- ! netcdf stuff
- INTEGER :: istatus, ncid
- INTEGER :: id_x, id_y, id_z, id_time, id_xa, id_ya, id_za
- INTEGER :: id_lon, id_lat, id_lev, id_tim, id_ts
- INTEGER :: id_bat, id_dept, id_depw, id_e3t, id_e3w
-
-
- numcoo = 10
- nummsh = 11
- numbat = 12
- narg=iargc()
-
- IF ( narg < 2 ) THEN
- PRINT *,' >>> Usage: coordinates2zgr ''coordinates file'' '' ascii bathy'' [ jpizoom jpjzoom]'
- PRINT *,' Output is done on mesh_zgr.nc '
- PRINT *,' If optional arguments jpizoom and jpjzoom are given, bathy is extracted with regard to these values'
- PRINT *,' the global domain size is then read from the header of bathy file '
- STOP
- END IF
-
- CALL getarg(1,cfilin)
- CALL getarg(2,cbathy)
- IF ( narg > 2 ) THEN
- CALL getarg(3, cdum) ; READ(cdum,*) npizoom
- CALL getarg(4, cdum) ; READ(cdum,*) npjzoom
- ENDIF
- cfilout='mesh_zgr.nc'
-
- ! Read ASCII BATHY_LEVEL
- OPEN( UNIT=numbat, FILE=cbathy, FORM='FORMATTED', &
- ACCESS='SEQUENTIAL', STATUS='OLD' )
- ! read bathymetry file
- REWIND numbat
- READ(numbat,9001) clexp, iim, ijm
- nrecl8 = 200
- ! open and read header of coordinates files (
- OPEN( numcoo, FILE = cfilin, status='old' &
- ,form = 'unformatted', access ='direct',recl = nrecl8)
- READ(numcoo, rec = 1) cltextco, zrecl8, zjpiglo, zjpjglo
- CLOSE(numcoo)
- print *, iim,ijm, INT(zjpiglo), INT(zjpjglo)
-
- ! BATHY ASCII is alway on the full domain
- ! coordinates.diags may be on the full domain or on the zoomed domain: check dimensions !
- npi=INT(zjpiglo) ; npj=INT(zjpjglo) ; ierr = 0
- IF ( iim == npi .AND. ijm == npj ) THEN
- ln_glo=.true.
- ELSE
- ln_glo=.false.
- ENDIF
-
- ! ALLOCATE bathy array
- ALLOCATE(idata(iim,ijm), bathy(npi,npj), glamt(npi,npj),gphit(npi,npj) )
- READ(numbat,'(/)')
- clfmt = '(i3,41i3)'
- IF ( ijm >= 1000 ) clfmt = '(i4,41i3)'
- ifreq=40
- il1=1
- DO jn=1,iim/ifreq+1
- READ(numbat,'(/)')
- il2 = MIN( iim, il1+ifreq-1 )
- READ(numbat,9002) ( ii, ji = il1, il2, 5 )
- READ(numbat,'(/)')
- DO jj = ijm, 1, -1
- READ(numbat,clfmt) ij, ( idata(ji,jj), ji = il1, il2 )
- END DO
- il1 = il1 + ifreq
- END DO
- CLOSE(numbat)
- bathy(:,:)=idata(npizoom:npizoom+npi-1, npjzoom:npjzoom+npj-1)
-
-9001 FORMAT(1x,a15,2i8)
-9002 FORMAT(3x,13(i3,12x))
- !
- ! ... Read coordinates (only the used metric is read)
- !
- nrecl8 = 200
- OPEN( numcoo, FILE = cfilin, status='old' &
- ,form = 'unformatted', access ='direct',recl = nrecl8)
- READ(numcoo, rec = 1) cltextco, zrecl8, zjpiglo, zjpjglo
- CLOSE(numcoo)
- !
- print *, cltextco, zrecl8, zjpiglo, zjpjglo
- nrecl8 = zrecl8
- print*, nrecl8
-
- OPEN(numcoo, FILE=cfilin, status='old', form='unformatted', &
- access='direct',recl=nrecl8)
- READ (numcoo, rec = 1) cltextco, zrecl8, zjpiglo, zjpjglo, znbsel, znt, &
- zdim, xx1, yy1, ddx, ddy, sspval &
- ,(gdept(jk),jk=1,jpk), &
- ztimm8, &
- (gdepw(jk),jk=1,jpk), &
- (e3t(jk),jk=1,jpk), &
- (e3w(jk),jk=1,jpk)
- ni = zjpiglo
- nj = zjpjglo
- print *, 'ni=',ni,'nj=',nj
- READ(numcoo,rec=2) glamt
- READ(numcoo,rec=6) gphit
-
- clname = cfilout
- ilev = 1
- itime = 0
- zdate0 = 0.
- zdt = 0.
- clog = .FALSE.
-
- jpi = zjpiglo
- jpj = zjpjglo
- print* , jpi, jpj
-
- istatus=NF90_CREATE(cfilout,NF90_CLOBBER,ncid)
- ! define dimension x, y, z=1, time=unlimited
- istatus=NF90_DEF_DIM(ncid,'x',jpi,id_x)
- istatus=NF90_DEF_DIM(ncid,'y',jpj,id_y)
- istatus=NF90_DEF_DIM(ncid,'z',jpk ,id_z)
- istatus=NF90_DEF_DIM(ncid,'time',NF90_UNLIMITED ,id_time)
- istatus=NF90_DEF_DIM(ncid,'x_a',1,id_xa)
- istatus=NF90_DEF_DIM(ncid,'y_a',1,id_ya)
- istatus=NF90_DEF_DIM(ncid,'z_a',1 ,id_za)
-
- ! define variables
- istatus=NF90_DEF_VAR(ncid,'nav_lon',NF90_FLOAT,(/id_x,id_y/),id_lon)
- istatus=NF90_DEF_VAR(ncid,'nav_lat',NF90_FLOAT,(/id_x,id_y/),id_lat)
- istatus=NF90_DEF_VAR(ncid,'nav_lev',NF90_FLOAT,(/id_z/),id_lev)
- istatus=NF90_DEF_VAR(ncid,'time' ,NF90_FLOAT,(/id_time/),id_tim)
- istatus=NF90_DEF_VAR(ncid,'time_steps',NF90_INT,(/id_time/),id_ts)
-
- ! Horizontal grid-point position
- istatus=NF90_DEF_VAR(ncid,'mbathy',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_bat)
- istatus=NF90_DEF_VAR(ncid,'gdept',NF90_DOUBLE,(/id_xa,id_ya,id_z,id_time/),id_dept)
- istatus=NF90_DEF_VAR(ncid,'gdepw',NF90_DOUBLE,(/id_xa,id_ya,id_z,id_time/),id_depw)
- istatus=NF90_DEF_VAR(ncid,'e3t',NF90_DOUBLE,(/id_xa,id_ya,id_z,id_time/),id_e3t)
- istatus=NF90_DEF_VAR(ncid,'e3w',NF90_DOUBLE,(/id_xa,id_ya,id_z,id_time/),id_e3w)
-
- ! attributes
- !nav_lon:
- istatus=NF90_PUT_ATT(ncid,id_lon,'units','degrees_east')
- istatus=NF90_PUT_ATT(ncid,id_lon,'valid_min',-180.)
- istatus=NF90_PUT_ATT(ncid,id_lon,'valid_max',180.)
- istatus=NF90_PUT_ATT(ncid,id_lon,'long_name','Longitude')
- !nav_lat:
- istatus=NF90_PUT_ATT(ncid,id_lat,'units','degrees_north')
- istatus=NF90_PUT_ATT(ncid,id_lat,'valid_min',-90.)
- istatus=NF90_PUT_ATT(ncid,id_lat,'valid_max',90.)
- istatus=NF90_PUT_ATT(ncid,id_lat,'long_name','Latitude')
- !nav_lev:
- istatus=NF90_PUT_ATT(ncid,id_lev,'units','model_levels')
- istatus=NF90_PUT_ATT(ncid,id_lev,'valid_min',0.)
- istatus=NF90_PUT_ATT(ncid,id_lev,'valid_max',0.)
- istatus=NF90_PUT_ATT(ncid,id_lev,'long_name','Model levels')
- !time:
- istatus=NF90_PUT_ATT(ncid,id_tim,'units','seconds since 0000-01-01 00:00:00')
- istatus=NF90_PUT_ATT(ncid,id_tim,'calendar','gregorian')
- istatus=NF90_PUT_ATT(ncid,id_tim,'title','Time')
- istatus=NF90_PUT_ATT(ncid,id_tim,'long_name','Time axis')
- istatus=NF90_PUT_ATT(ncid,id_tim,'time_origin',' 0000-JAN-01 00:00:00')
- !time_steps:
- istatus=NF90_PUT_ATT(ncid,id_ts,'units','timesteps since 0000-01-01 00:00:00')
- istatus=NF90_PUT_ATT(ncid,id_ts,'title','Time steps')
- istatus=NF90_PUT_ATT(ncid,id_ts,'tstep_sec',0.)
- istatus=NF90_PUT_ATT(ncid,id_ts,'long_name','Time step axis')
- istatus=NF90_PUT_ATT(ncid,id_ts,'time_origin',' 0000-JAN-01 00:00:00')
-
- ! variables glamx, gphix, e?x
- istatus=NF90_PUT_ATT(ncid,id_bat,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_dept,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_depw,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e3t,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e3w,'missing_value',1.e+20)
-
- istatus=NF90_ENDDEF(ncid)
-
- ! Now fill the variables !
- istatus=NF90_PUT_VAR(ncid,id_lon,glamt)
- istatus=NF90_PUT_VAR(ncid,id_lat,gphit)
- istatus=NF90_PUT_VAR(ncid,id_lev,gdept)
- istatus=NF90_PUT_VAR(ncid,id_tim,0.)
- istatus=NF90_PUT_VAR(ncid,id_ts,1)
-
- istatus=NF90_PUT_VAR(ncid,id_bat,bathy )
- istatus=NF90_PUT_VAR(ncid,id_dept,gdept, start=(/1,1,1,1/),count=(/1,1,jpk,1/))
- istatus=NF90_PUT_VAR(ncid,id_depw,gdepw , start=(/1,1,1,1/),count=(/1,1,jpk,1/))
- istatus=NF90_PUT_VAR(ncid,id_e3t,e3t, start=(/1,1,1,1/),count=(/1,1,jpk,1/))
- istatus=NF90_PUT_VAR(ncid,id_e3w,e3w, start=(/1,1,1,1/),count=(/1,1,jpk,1/))
-
- istatus=NF90_CLOSE(ncid)
-
-END PROGRAM coordinates2zgr
diff --git a/coordinates2zgr_karine.f90 b/coordinates2zgr_karine.f90
deleted file mode 100644
index 91eaceb..0000000
--- a/coordinates2zgr_karine.f90
+++ /dev/null
@@ -1,244 +0,0 @@
-PROGRAM coordinates2zgr
- !!-------------------------------------------------------------------------
- !! PROGRAM coordinates2zgr
- !! **********************
- !! ** Purpose:
- !! transform a "clipper" coordinates file into an
- !! ioipsl coordinate file
- !!
- !! History :
- !! February 2003 : Anne de Miranda
- !! June 2003 : J.M. Molines : modif for getarg (filename)
- !!--------------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- USE netcdf
- IMPLICIT NONE
-
- INTEGER(4) :: jpi , jpj
- INTEGER(2) , PARAMETER :: wp = 8
- INTEGER(4) , PARAMETER :: jpk=43
-
- REAL(wp) :: zjpiglo, zjpjglo, znbsel, zrecl8, ztimm8
- REAL(wp) :: znt, zdim, xx1, yy1, ddx, ddy, sspval, bidon
-
- CHARACTER(256) :: cltextco
- INTEGER(4) :: numcoo, nummsh, numbat
- INTEGER(4) :: nrecl8
- INTEGER(4) :: ngrid
- INTEGER(4) :: ni,nj, nk
- INTEGER(4) :: jj, jk, iim,ijm, il1, il2, ifreq, jn, ii, ji , ij
- INTEGER(KIND=4) :: ierr=0, npi, npj, npizoom=1, npjzoom=1
- INTEGER(KIND=4) , DIMENSION(:,:), ALLOCATABLE :: idata
-
- REAL(wp) , DIMENSION(:,:), ALLOCATABLE :: glamt,gphit
- REAL(wp) , DIMENSION(1) :: zdep
- REAL(wp) zdt,zdate0 , omega, pi
- REAL(wp), DIMENSION(jpk) :: gdept, gdepw, e3t, e3w
-
- CHARACTER (len=21) :: clname
- INTEGER ilev, itime, iargc, narg
- LOGICAL clog
- CHARACTER(LEN=256) :: cfilin, cfilout, cbathy, clexp, clfmt, cdum
-
- REAL(wp) , DIMENSION(:,:), ALLOCATABLE :: bathy
- LOGICAL :: ln_glo
-
- ! netcdf stuff
- INTEGER :: istatus, ncid
- INTEGER :: id_x, id_y, id_z, id_time, id_xa, id_ya, id_za
- INTEGER :: id_lon, id_lat, id_lev, id_tim, id_ts
- INTEGER :: id_bat, id_dept, id_depw, id_e3t, id_e3w
-
-
- numcoo = 10
- nummsh = 11
- numbat = 12
- narg=iargc()
-
- IF ( narg < 2 ) THEN
- PRINT *,' >>> Usage: coordinates2zgr ''coordinates file'' '' ascii bathy'' [ jpizoom jpjzoom]'
- PRINT *,' Output is done on mesh_zgr.nc '
- PRINT *,' If optional arguments jpizoom and jpjzoom are given, bathy is extracted with regard to these values'
- PRINT *,' the global domain size is then read from the header of bathy file '
- STOP
- END IF
-
- CALL getarg(1,cfilin)
- CALL getarg(2,cbathy)
- IF ( narg > 2 ) THEN
- CALL getarg(3, cdum) ; READ(cdum,*) npizoom
- CALL getarg(4, cdum) ; READ(cdum,*) npjzoom
- ENDIF
- cfilout='mesh_zgr.nc'
-
- ! Read ASCII BATHY_LEVEL
- OPEN( UNIT=numbat, FILE=cbathy, FORM='FORMATTED', &
- ACCESS='SEQUENTIAL', STATUS='OLD' )
- ! read bathymetry file
- REWIND numbat
- READ(numbat,9001) clexp, iim, ijm
- nrecl8 = 200
- ! open and read header of coordinates files (
- OPEN( numcoo, FILE = cfilin, status='old' &
- ,form = 'unformatted', access ='direct',recl = nrecl8)
- READ(numcoo, rec = 1) cltextco, zrecl8, zjpiglo, zjpjglo
- CLOSE(numcoo)
- print *, iim,ijm, INT(zjpiglo), INT(zjpjglo)
-
- ! BATHY ASCII is alway on the full domain
- ! coordinates.diags may be on the full domain or on the zoomed domain: check dimensions !
- npi=INT(zjpiglo) ; npj=INT(zjpjglo) ; ierr = 0
- IF ( iim == npi .AND. ijm == npj ) THEN
- ln_glo=.true.
- ELSE
- ln_glo=.false.
- ENDIF
-
- ! ALLOCATE bathy array
- ALLOCATE(idata(iim,ijm), bathy(npi,npj), glamt(npi,npj),gphit(npi,npj) )
- READ(numbat,'(/)')
- clfmt = '(i3,41i3)'
- IF ( ijm >= 1000 ) clfmt = '(i4,41i3)'
- ifreq=40
- il1=1
- DO jn=1,iim/ifreq+1
- READ(numbat,'(/)')
- il2 = MIN( iim, il1+ifreq-1 )
- READ(numbat,9002) ( ii, ji = il1, il2, 5 )
- READ(numbat,'(/)')
- DO jj = ijm, 1, -1
- READ(numbat,clfmt) ij, ( idata(ji,jj), ji = il1, il2 )
- END DO
- il1 = il1 + ifreq
- END DO
- CLOSE(numbat)
- bathy(:,:)=idata(npizoom:npizoom+npi-1, npjzoom:npjzoom+npj-1)
-
-9001 FORMAT(1x,a15,2i8)
-9002 FORMAT(3x,13(i3,12x))
- !
- ! ... Read coordinates (only the used metric is read)
- !
- nrecl8 = 200
- OPEN( numcoo, FILE = cfilin, status='old' &
- ,form = 'unformatted', access ='direct',recl = nrecl8)
- READ(numcoo, rec = 1) cltextco, zrecl8, zjpiglo, zjpjglo
- CLOSE(numcoo)
- !
- print *, cltextco, zrecl8, zjpiglo, zjpjglo
- nrecl8 = zrecl8
- print*, nrecl8
-
- OPEN(numcoo, FILE=cfilin, status='old', form='unformatted', &
- access='direct',recl=nrecl8)
- READ(numcoo,rec=1) &
- cltextco,zrecl8,zjpiglo,zjpjglo,znbsel,znt,zdim, &
- xx1,yy1,ddx,ddy,sspval, &
- (bidon,jk=1,INT(znbsel)), &
- ztimm8, &
- (gdept(jk),jk=1,jpk), &
- (bidon,jk=1,jpk), &
- (gdepw(jk),jk=1,jpk), &
- (bidon,jk=1,jpk), &
- (e3t(jk),jk=1,jpk), &
- (bidon,jk=1,jpk), &
- (e3w(jk),jk=1,jpk)
- ni = zjpiglo
- nj = zjpjglo
- print *, 'ni=',ni,'nj=',nj
- READ(numcoo,rec=3) glamt
- READ(numcoo,rec=7) gphit
-
- clname = cfilout
- ilev = 1
- itime = 0
- zdate0 = 0.
- zdt = 0.
- clog = .FALSE.
-
- jpi = zjpiglo
- jpj = zjpjglo
- print* , jpi, jpj
-
- istatus=NF90_CREATE(cfilout,NF90_CLOBBER,ncid)
- ! define dimension x, y, z=1, time=unlimited
- istatus=NF90_DEF_DIM(ncid,'x',jpi,id_x)
- istatus=NF90_DEF_DIM(ncid,'y',jpj,id_y)
- istatus=NF90_DEF_DIM(ncid,'z',jpk ,id_z)
- istatus=NF90_DEF_DIM(ncid,'time',NF90_UNLIMITED ,id_time)
- istatus=NF90_DEF_DIM(ncid,'x_a',1,id_xa)
- istatus=NF90_DEF_DIM(ncid,'y_a',1,id_ya)
- istatus=NF90_DEF_DIM(ncid,'z_a',1 ,id_za)
-
- ! define variables
- istatus=NF90_DEF_VAR(ncid,'nav_lon',NF90_FLOAT,(/id_x,id_y/),id_lon)
- istatus=NF90_DEF_VAR(ncid,'nav_lat',NF90_FLOAT,(/id_x,id_y/),id_lat)
- istatus=NF90_DEF_VAR(ncid,'nav_lev',NF90_FLOAT,(/id_z/),id_lev)
- istatus=NF90_DEF_VAR(ncid,'time' ,NF90_FLOAT,(/id_time/),id_tim)
- istatus=NF90_DEF_VAR(ncid,'time_steps',NF90_INT,(/id_time/),id_ts)
-
- ! Horizontal grid-point position
- istatus=NF90_DEF_VAR(ncid,'mbathy',NF90_DOUBLE,(/id_x,id_y,id_za,id_time/),id_bat)
- istatus=NF90_DEF_VAR(ncid,'gdept',NF90_DOUBLE,(/id_xa,id_ya,id_z,id_time/),id_dept)
- istatus=NF90_DEF_VAR(ncid,'gdepw',NF90_DOUBLE,(/id_xa,id_ya,id_z,id_time/),id_depw)
- istatus=NF90_DEF_VAR(ncid,'e3t',NF90_DOUBLE,(/id_xa,id_ya,id_z,id_time/),id_e3t)
- istatus=NF90_DEF_VAR(ncid,'e3w',NF90_DOUBLE,(/id_xa,id_ya,id_z,id_time/),id_e3w)
-
- ! attributes
- !nav_lon:
- istatus=NF90_PUT_ATT(ncid,id_lon,'units','degrees_east')
- istatus=NF90_PUT_ATT(ncid,id_lon,'valid_min',-180.)
- istatus=NF90_PUT_ATT(ncid,id_lon,'valid_max',180.)
- istatus=NF90_PUT_ATT(ncid,id_lon,'long_name','Longitude')
- !nav_lat:
- istatus=NF90_PUT_ATT(ncid,id_lat,'units','degrees_north')
- istatus=NF90_PUT_ATT(ncid,id_lat,'valid_min',-90.)
- istatus=NF90_PUT_ATT(ncid,id_lat,'valid_max',90.)
- istatus=NF90_PUT_ATT(ncid,id_lat,'long_name','Latitude')
- !nav_lev:
- istatus=NF90_PUT_ATT(ncid,id_lev,'units','model_levels')
- istatus=NF90_PUT_ATT(ncid,id_lev,'valid_min',0.)
- istatus=NF90_PUT_ATT(ncid,id_lev,'valid_max',0.)
- istatus=NF90_PUT_ATT(ncid,id_lev,'long_name','Model levels')
- !time:
- istatus=NF90_PUT_ATT(ncid,id_tim,'units','seconds since 0000-01-01 00:00:00')
- istatus=NF90_PUT_ATT(ncid,id_tim,'calendar','gregorian')
- istatus=NF90_PUT_ATT(ncid,id_tim,'title','Time')
- istatus=NF90_PUT_ATT(ncid,id_tim,'long_name','Time axis')
- istatus=NF90_PUT_ATT(ncid,id_tim,'time_origin',' 0000-JAN-01 00:00:00')
- !time_steps:
- istatus=NF90_PUT_ATT(ncid,id_ts,'units','timesteps since 0000-01-01 00:00:00')
- istatus=NF90_PUT_ATT(ncid,id_ts,'title','Time steps')
- istatus=NF90_PUT_ATT(ncid,id_ts,'tstep_sec',0.)
- istatus=NF90_PUT_ATT(ncid,id_ts,'long_name','Time step axis')
- istatus=NF90_PUT_ATT(ncid,id_ts,'time_origin',' 0000-JAN-01 00:00:00')
-
- ! variables glamx, gphix, e?x
- istatus=NF90_PUT_ATT(ncid,id_bat,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_dept,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_depw,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e3t,'missing_value',1.e+20)
- istatus=NF90_PUT_ATT(ncid,id_e3w,'missing_value',1.e+20)
-
- istatus=NF90_ENDDEF(ncid)
-
- ! Now fill the variables !
- istatus=NF90_PUT_VAR(ncid,id_lon,glamt)
- istatus=NF90_PUT_VAR(ncid,id_lat,gphit)
- istatus=NF90_PUT_VAR(ncid,id_lev,gdept)
- istatus=NF90_PUT_VAR(ncid,id_tim,0.)
- istatus=NF90_PUT_VAR(ncid,id_ts,1)
-
- istatus=NF90_PUT_VAR(ncid,id_bat,bathy )
- istatus=NF90_PUT_VAR(ncid,id_dept,gdept, start=(/1,1,1,1/),count=(/1,1,jpk,1/))
- istatus=NF90_PUT_VAR(ncid,id_depw,gdepw , start=(/1,1,1,1/),count=(/1,1,jpk,1/))
- istatus=NF90_PUT_VAR(ncid,id_e3t,e3t, start=(/1,1,1,1/),count=(/1,1,jpk,1/))
- istatus=NF90_PUT_VAR(ncid,id_e3w,e3w, start=(/1,1,1,1/),count=(/1,1,jpk,1/))
-
- istatus=NF90_CLOSE(ncid)
-
-END PROGRAM coordinates2zgr
diff --git a/eos.f90 b/eos.f90
index 2716abc..b172e2d 100644
--- a/eos.f90
+++ b/eos.f90
@@ -1,340 +1,478 @@
MODULE eos
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
-IMPLICIT NONE
-PRIVATE
-PUBLIC sigma0, eosbn2, sigmai, albet, beta
+ !!======================================================================
+ !! *** MODULE eos ***
+ !! All routines dealing with the Equation Of State of sea water
+ !!=====================================================================
+ !! History : 2.1 ! 2004 : J.M. Molines : Original code ported
+ !! from NEMO
+ !! 3.0 12/2010 : J.M. Molines : Doctor norm + Lic.
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! sigma0 : compute sigma-0
+ !! eosbn2 : compute Brunt Vaissala Frequency
+ !! sigmai : compute sigma-i ( refered to a depth given in argument
+ !! albet : Compute the ratio alpha/beta ( Thermal/haline exapnsion)
+ !! beta : compute beta (haline expension)
+ !!----------------------------------------------------------------------
+ IMPLICIT NONE
+
+ PRIVATE
+ PUBLIC :: sigma0
+ PUBLIC :: eosbn2
+ PUBLIC :: sigmai
+ PUBLIC :: albet
+ PUBLIC :: beta
+
+ INTERFACE sigmai
+ MODULE PROCEDURE sigmai_dep, sigmai_dep2d
+ END INTERFACE
+
+
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
CONTAINS
- FUNCTION sigma0 ( ptem, psal, kpi,kpj)
- !! --------------------------------------------------------------------
- !! ** Purpose : Compute the in situ density (ratio rho/rau0) and the
- !! potential volumic mass (Kg/m3) from potential temperature and
- !! salinity fields using an equation of state defined through the
- !! namelist parameter neos.
- !!
- !! ** Method :
- !! Jackett and McDougall (1994) equation of state.
- !! the in situ density is computed directly as a function of
- !! potential temperature relative to the surface (the opa t
- !! variable), salt and pressure (assuming no pressure variation
- !! along geopotential surfaces, i.e. the pressure p in decibars
- !! is approximated by the depth in meters.
- !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
- !! rhop(t,s) = rho(t,s,0)
- !! with pressure p decibars
- !! potential temperature t deg celsius
- !! salinity s psu
- !! reference volumic mass rau0 kg/m**3
- !! in situ volumic mass rho kg/m**3
- !! in situ density anomalie prd no units
- !! --------------------------------------------------------------------
-
- !! * Arguments
- INTEGER,INTENT(in) :: kpi,kpj !: dimension of 2D arrays
- REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal
- REAL(KIND=8), DIMENSION(kpi,kpj) :: sigma0
-
- !! * local variables
- INTEGER :: ji,jj
- REAL(KIND=8), DIMENSION (kpi,kpj) :: zws
- REAL(KIND=8) :: zt, zs, zsr, zr1, zr2, zr3, zr4, zrau0=1000.
-
-
- zws = 0.d0
- sigma0 = 0.d0
- DO jj = 1, kpj
- DO ji = 1, kpi
- zws(ji,jj) = SQRT( ABS( psal(ji,jj) ) )
- END DO
+
+
+ FUNCTION sigma0 ( ptem, psal, kpi, kpj)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION sigma0 ***
+ !!
+ !! ** Purpose : Compute the in situ density (ratio rho/rau0) and the
+ !! potential volumic mass (Kg/m3) from potential temperature
+ !! and salinity fields using an equation of state defined
+ !! through the namelist parameter neos.
+ !!
+ !! ** Method : Jackett and McDougall (1994) equation of state.
+ !! The in situ density is computed directly as a function of
+ !! potential temperature relative to the surface (the opa t
+ !! variable), salt and pressure (assuming no pressure variation
+ !! along geopotential surfaces, i.e. the pressure p in decibars
+ !! is approximated by the depth in meters.
+ !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+ !! rhop(t,s) = rho(t,s,0)
+ !! with pressure p decibars
+ !! potential temperature t deg celsius
+ !! salinity s psu
+ !! reference volumic mass rau0 kg/m**3
+ !! in situ volumic mass rho kg/m**3
+ !! in situ density anomalie prd no units
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal ! temperature and salinity
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! dimension of 2D arrays
+ REAL(KIND=8), DIMENSION(kpi,kpj) :: sigma0 ! returned value
+
+ INTEGER(KIND=4) :: ji, jj
+ REAL(KIND=8), DIMENSION (kpi,kpj) :: zws
+ REAL(KIND=8) :: zt, zs, zsr, zrau0=1000.
+ REAL(KIND=8) :: zr1, zr2, zr3, zr4
+ !!----------------------------------------------------------------------
+ zws = 0.d0
+ sigma0 = 0.d0
+ DO jj = 1, kpj
+ DO ji = 1, kpi
+ zws(ji,jj) = SQRT( ABS( psal(ji,jj) ) )
END DO
-
- DO jj = 1, kpj
- !
- DO ji = 1, kpi
-
- zt = ptem (ji,jj) ! interpolated T
- zs = psal (ji,jj) ! interpolated S
- zsr= zws(ji,jj) ! square root of interpolated S
-
- ! compute volumic mass pure water at atm pressure
- zr1 = ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt &
- -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
- ! seawater volumic mass atm pressure
- zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 )*zt+7.6438e-5 ) *zt &
- -4.0899e-3 ) *zt+0.824493
- zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
- zr4= 4.8314e-4
-
- ! potential volumic mass (reference to the surface)
- sigma0(ji,jj) = ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 -zrau0
- END DO
+ END DO
+
+ DO jj = 1, kpj
+ !
+ DO ji = 1, kpi
+
+ zt = ptem (ji,jj) ! interpolated T
+ zs = psal (ji,jj) ! interpolated S
+ zsr = zws (ji,jj) ! square root of interpolated S
+
+ ! compute volumic mass pure water at atm pressure
+ zr1 = ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt &
+ -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+ ! seawater volumic mass atm pressure
+ zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 )*zt+7.6438e-5 ) *zt &
+ -4.0899e-3 ) *zt+0.824493
+ zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
+ zr4= 4.8314e-4
+
+ ! potential volumic mass (reference to the surface)
+ sigma0(ji,jj) = ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 - zrau0
END DO
-
- END FUNCTION sigma0
-
- FUNCTION sigmai ( ptem, psal, pref, kpi,kpj)
- !! --------------------------------------------------------------------
- !! ** Purpose : Compute the density referenced to pref (ratio rho/rau0)
- !! from potential temperature and
- !! salinity fields using an equation of state defined through the
- !! namelist parameter neos.
- !!
- !! ** Method :
- !! Jackett and McDougall (1994) equation of state.
- !! the in situ density is computed directly as a function of
- !! potential temperature relative to the surface (the opa t
- !! variable), salt and pressure (assuming no pressure variation
- !! along geopotential surfaces, i.e. the pressure p in decibars
- !! is approximated by the depth in meters.
- !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
- !! rhop(t,s) = rho(t,s,0)
- !! with pressure p decibars
- !! potential temperature t deg celsius
- !! salinity s psu
- !! reference volumic mass rau0 kg/m**3
- !! in situ volumic mass rho kg/m**3
- !! in situ density anomalie prd no units
- !! --------------------------------------------------------------------
-
- !! * Arguments
- INTEGER,INTENT(in) :: kpi,kpj !: dimension of 2D arrays
- REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal
- REAL(KIND=4), INTENT(in) :: pref !: reference pressure (meters or db)
- REAL(KIND=8), DIMENSION(kpi,kpj) :: sigmai
-
- REAL(kind=8),PARAMETER :: dpr4=4.8314d-4,dpd=-2.042967d-2 , dprau0 = 1000;
-
- !! * local variables
- INTEGER :: ji,jj
- REAL(KIND=8), DIMENSION (kpi,kpj) :: dlrs
- REAL(KIND=8) :: dlt, dls
- REAL(KIND=8) :: dla,dla1,dlaw,dlb,dlb1,dlbw,dlc,dle,dlk0,dlkw
- REAL(kind=8) :: dlrhop, dlr1,dlr2,dlr3, dlref
-
- dlref = pref
- sigmai = 0.d0
- DO jj = 1, kpj
- DO ji = 1, kpi
- dlrs(ji,jj) = SQRT( ABS( psal(ji,jj) ) )
- END DO
+ END DO
+
+ END FUNCTION sigma0
+
+ FUNCTION sigmai_dep ( ptem, psal, pref, kpi,kpj)
+ !! --------------------------------------------------------------------
+ !! ** Purpose : Compute the density referenced to pref (ratio rho/rau0)
+ !! from potential temperature and
+ !! salinity fields using an equation of state defined through the
+ !! namelist parameter neos.
+ !!
+ !! ** Method :
+ !! Jackett and McDougall (1994) equation of state.
+ !! the in situ density is computed directly as a function of
+ !! potential temperature relative to the surface (the opa t
+ !! variable), salt and pressure (assuming no pressure variation
+ !! along geopotential surfaces, i.e. the pressure p in decibars
+ !! is approximated by the depth in meters.
+ !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+ !! rhop(t,s) = rho(t,s,0)
+ !! with pressure p decibars
+ !! potential temperature t deg celsius
+ !! salinity s psu
+ !! reference volumic mass rau0 kg/m**3
+ !! in situ volumic mass rho kg/m**3
+ !! in situ density anomalie prd no units
+ !! --------------------------------------------------------------------
+ REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal ! temperature salinity
+ INTEGER(KIND=4), INTENT(in) :: kpi,kpj ! dimension of 2D arrays
+ REAL(KIND=4), INTENT(in) :: pref ! reference pressure (meters or db)
+ REAL(KIND=8), DIMENSION(kpi,kpj) :: sigmai_dep ! return value
+
+ REAL(kind=8), PARAMETER :: dpr4=4.8314d-4, dpd=-2.042967d-2 , dprau0 = 1000.d0
+
+ INTEGER(KIND=4) :: ji, jj
+ REAL(KIND=8), DIMENSION (kpi,kpj) :: dlrs
+ REAL(KIND=8) :: dlt, dls
+ REAL(KIND=8) :: dla, dla1, dlaw, dlb, dlb1, dlbw, dlc, dle, dlk0, dlkw
+ REAL(kind=8) :: dlrhop, dlr1, dlr2, dlr3, dlref
+
+ dlref = pref
+ sigmai_dep = 0.d0
+ DO jj = 1, kpj
+ DO ji = 1, kpi
+ dlrs(ji,jj) = SQRT( ABS( psal(ji,jj) ) )
END DO
-
- DO jj=1,kpj
- DO ji=1,kpi
+ END DO
-! Convert T and S to double precision.
- dlt=DBLE(ptem(ji,jj))
- dls=DBLE(psal(ji,jj))
+ DO jj=1,kpj
+ DO ji=1,kpi
+ ! Convert T and S to double precision.
+ dlt = DBLE(ptem(ji,jj))
+ dls = DBLE(psal(ji,jj))
-! Compute the volumic mass of pure water at atmospheric pressure.
- dlr1=((((6.536332d-9*dlt-1.120083d-6)&
- *dlt+1.001685d-4)&
+ ! Compute the volumic mass of pure water at atmospheric pressure.
+ dlr1=((((6.536332d-9*dlt-1.120083d-6)&
+ *dlt+1.001685d-4)&
*dlt-9.095290d-3)&
- *dlt+6.793952d-2)&
- *dlt+999.842594d0
+ *dlt+6.793952d-2)&
+ *dlt+999.842594d0
-! Compute the seawater volumic mass at atmospheric pressure.
- dlr2=(((5.3875d-9*dlt-8.2467d-7)&
+ ! Compute the seawater volumic mass at atmospheric pressure.
+ dlr2=(((5.3875d-9*dlt-8.2467d-7)&
*dlt+7.6438d-5)&
- *dlt-4.0899d-3)&
- *dlt+0.824493d0
+ *dlt-4.0899d-3)&
+ *dlt+0.824493d0
- dlr3=(-1.6546d-6*dlt+1.0227d-4)&
- *dlt-5.72466d-3
+ dlr3=(-1.6546d-6*dlt+1.0227d-4)&
+ *dlt-5.72466d-3
-! Compute the potential volumic mass (referenced to the surface).
- dlrhop=(dpr4*dls+dlr3*dlrs(ji,jj)+dlr2)*dls+dlr1
+ ! Compute the potential volumic mass (referenced to the surface).
+ dlrhop=(dpr4*dls+dlr3*dlrs(ji,jj)+dlr2)*dls+dlr1
-! Compute the compression terms.
- dle=(-3.508914d-8*dlt-1.248266d-8)&
- *dlt-2.595994d-6
+ ! Compute the compression terms.
+ dle=(-3.508914d-8*dlt-1.248266d-8)&
+ *dlt-2.595994d-6
- dlbw=(1.296821d-6*dlt-5.782165d-9)&
- *dlt+1.045941d-4
+ dlbw=(1.296821d-6*dlt-5.782165d-9)&
+ *dlt+1.045941d-4
- dlb=dlbw+dle*dls
+ dlb=dlbw+dle*dls
- dlc=(-7.267926d-5*dlt+2.598241d-3 )&
- *dlt+0.1571896d0
+ dlc=(-7.267926d-5*dlt+2.598241d-3 )&
+ *dlt+0.1571896d0
- dlaw=((5.939910d-6*dlt+2.512549d-3)&
- *dlt-0.1028859d0)&
- *dlt-4.721788d0
+ dlaw=((5.939910d-6*dlt+2.512549d-3)&
+ *dlt-0.1028859d0)&
+ *dlt-4.721788d0
- dla=(dpd*dlrs(ji,jj)+dlc)*dls+dlaw
+ dla=(dpd*dlrs(ji,jj)+dlc)*dls+dlaw
- dlb1=(-0.1909078d0*dlt+7.390729d0)&
- *dlt-55.87545d0
+ dlb1=(-0.1909078d0*dlt+7.390729d0)&
+ *dlt-55.87545d0
- dla1=((2.326469d-3*dlt+1.553190d0)&
- *dlt-65.00517d0)&
- *dlt+1044.077d0
+ dla1=((2.326469d-3*dlt+1.553190d0)&
+ *dlt-65.00517d0)&
+ *dlt+1044.077d0
- dlkw=(((-1.361629d-4*dlt-1.852732d-2)&
+ dlkw=(((-1.361629d-4*dlt-1.852732d-2)&
*dlt-30.41638d0)&
- *dlt+2098.925d0)&
- *dlt+190925.6d0
+ *dlt+2098.925d0)&
+ *dlt+190925.6d0
- dlk0=(dlb1*dlrs(ji,jj)+dla1)*dls+dlkw
+ dlk0=(dlb1*dlrs(ji,jj)+dla1)*dls+dlkw
-! Compute the potential density anomaly.
- sigmai(ji,jj)=dlrhop/(1.0d0-dlref/(dlk0-dlref*(dla-dlref*dlb)))&
- -dprau0
+ ! Compute the potential density anomaly.
+ sigmai_dep(ji,jj)=dlrhop/(1.0d0-dlref/(dlk0-dlref*(dla-dlref*dlb)))&
+ -dprau0
- ENDDO
+ ENDDO
ENDDO
-
- END FUNCTION sigmai
-
- FUNCTION eosbn2 ( ptem, psal, pdep,pe3w, kpi,kpj,kup,kdown)
- !! ----------------------------------------------------------------------
- !! ** Purpose : Compute the local Brunt-Vaisala frequency at the time-
- !! step of the input arguments
- !!
- !! ** Method :
- !! * UNESCO sea water properties
- !! The brunt-vaisala frequency is computed using the
- !! polynomial expression of McDougall (1987):
- !! N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
- !!---------------------------------------------------------------------
- ! * Arguments
- INTEGER, INTENT(in) :: kpi,kpj
- INTEGER, INTENT(in) :: kup,kdown
- REAL(KIND=4), DIMENSION(kpi,kpj,2), INTENT(in) :: ptem, psal
- REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: pe3w
- REAL(KIND=4) :: pdep
- REAL(KIND=4), DIMENSION(kpi,kpj) :: eosbn2
-
- ! * Local variables
- INTEGER :: ji, jj ! dummy loop indices
- REAL(KIND=8) :: &
- zgde3w, zt, zs, zh, & ! temporary scalars
- zalbet, zbeta ! "
- REAL(KIND=8) :: grav=9.81
-
- zh = pdep
- DO jj = 1, kpj
- DO ji = 1, kpi
- zgde3w = grav / pe3w(ji,jj)
- zt = 0.5 * ( ptem(ji,jj,kup) + ptem(ji,jj,kdown) ) ! potential temperature at w-point
- zs = 0.5 * ( psal(ji,jj,kup) + psal(ji,jj,kdown) ) - 35.0 ! salinity anomaly (s-35) at w-point
-
- zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt & ! ratio alpha/beta
- & - 0.203814e-03 ) * zt &
- & + 0.170907e-01 ) * zt &
- & + 0.665157e-01 &
- & + ( - 0.678662e-05 * zs &
- & - 0.846960e-04 * zt + 0.378110e-02 ) * zs &
- & + ( ( - 0.302285e-13 * zh &
- & - 0.251520e-11 * zs &
- & + 0.512857e-12 * zt * zt ) * zh &
- & - 0.164759e-06 * zs &
- & +( 0.791325e-08 * zt - 0.933746e-06 ) * zt &
- & + 0.380374e-04 ) * zh
-
- zbeta = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt & ! beta
- & - 0.301985e-05 ) * zt &
- & + 0.785567e-03 &
- & + ( 0.515032e-08 * zs &
- & + 0.788212e-08 * zt - 0.356603e-06 ) * zs &
- & +( ( 0.121551e-17 * zh &
- & - 0.602281e-15 * zs &
- & - 0.175379e-14 * zt + 0.176621e-12 ) * zh &
- & + 0.408195e-10 * zs &
- & + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt &
- & - 0.121555e-07 ) * zh
-
- eosbn2(ji,jj) = zgde3w * zbeta & ! N^2
- & * ( zalbet * ( ptem(ji,jj,kup) - ptem(ji,jj,kdown) ) &
- & - ( psal(ji,jj,kup) - psal(ji,jj,kdown) ) )
- END DO
- END DO
-
-
- END FUNCTION eosbn2
-
- FUNCTION albet( ptem, psal, pdep, kpi,kpj)
- !!-------------------------------------------------------------------------------------------
- !! *** FUNCTION albet ***
- !!
- !! * Purpose: Compute the ratio alpha/beta
- !! -----------------------------------------------------------------------------------------
- !! * Arguments
- INTEGER, INTENT(in) :: kpi, kpj
- REAL(KIND=4), DIMENSION(kpi,kpj),INTENT(in) :: ptem, psal
- REAL(KIND=4), INTENT(in) :: pdep
-
- REAL(KIND=8), DIMENSION(kpi,kpj) :: albet
-
- !! * Local variables
- INTEGER :: ji,jj
- REAL(KIND=8) :: zt, zs, zh
-
- zh = pdep
- DO ji=1,kpi
- DO jj=1,kpj
- zt = ptem(ji,jj) ! potential temperature
- zs = psal(ji,jj)- 35.0 ! salinity anomaly (s-35)
-
- albet(ji,jj) = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt & ! ratio alpha/beta
- & - 0.203814e-03 ) * zt &
- & + 0.170907e-01 ) * zt &
- & + 0.665157e-01 &
- & + ( - 0.678662e-05 * zs &
- & - 0.846960e-04 * zt + 0.378110e-02 ) * zs &
- & + ( ( - 0.302285e-13 * zh &
- & - 0.251520e-11 * zs &
- & + 0.512857e-12 * zt * zt ) * zh &
- & - 0.164759e-06 * zs &
- & +( 0.791325e-08 * zt - 0.933746e-06 ) * zt &
- & + 0.380374e-04 ) * zh
- END DO
+
+ END FUNCTION sigmai_dep
+
+ FUNCTION sigmai_dep2d ( ptem, psal, pref, kpi,kpj)
+ !! --------------------------------------------------------------------
+ !! ** Purpose : Compute the density referenced to pref (ratio rho/rau0)
+ !! from potential temperature and
+ !! salinity fields using an equation of state defined through the
+ !! namelist parameter neos.
+ !!
+ !! ** Method :
+ !! Jackett and McDougall (1994) equation of state.
+ !! the in situ density is computed directly as a function of
+ !! potential temperature relative to the surface (the opa t
+ !! variable), salt and pressure (assuming no pressure variation
+ !! along geopotential surfaces, i.e. the pressure p in decibars
+ !! is approximated by the depth in meters.
+ !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+ !! rhop(t,s) = rho(t,s,0)
+ !! with pressure p decibars
+ !! potential temperature t deg celsius
+ !! salinity s psu
+ !! reference volumic mass rau0 kg/m**3
+ !! in situ volumic mass rho kg/m**3
+ !! in situ density anomalie prd no units
+ !! --------------------------------------------------------------------
+ REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal ! temperature salinity
+ INTEGER(KIND=4), INTENT(in) :: kpi,kpj ! dimension of 2D arrays
+ REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: pref ! reference pressure (meters or db) (2d Array)
+ REAL(KIND=8), DIMENSION(kpi,kpj) :: sigmai_dep2d ! return value
+
+ REAL(kind=8), PARAMETER :: dpr4=4.8314d-4, dpd=-2.042967d-2 , dprau0 = 1000.d0
+
+ INTEGER(KIND=4) :: ji, jj
+ REAL(KIND=8), DIMENSION (kpi,kpj) :: dlrs
+ REAL(KIND=8) :: dlt, dls
+ REAL(KIND=8) :: dla, dla1, dlaw, dlb, dlb1, dlbw, dlc, dle, dlk0, dlkw
+ REAL(kind=8) :: dlrhop, dlr1, dlr2, dlr3, dlref
+
+ sigmai_dep2d = 0.d0
+ DO jj = 1, kpj
+ DO ji = 1, kpi
+ dlrs(ji,jj) = SQRT( ABS( psal(ji,jj) ) )
END DO
+ END DO
- END FUNCTION albet
-
- FUNCTION beta ( ptem, psal, pdep, kpi,kpj)
- !!-------------------------------------------------------------------------------------------
- !! *** FUNCTION beta ***
- !!
- !! * Purpose: Compute the beta
- !! -----------------------------------------------------------------------------------------
- !! * Arguments
- INTEGER, INTENT(in) :: kpi, kpj
- REAL(KIND=4), DIMENSION(kpi,kpj),INTENT(in) :: ptem, psal
- REAL(KIND=4), INTENT(in) :: pdep
-
- REAL(KIND=8), DIMENSION(kpi,kpj) :: beta
-
- !! * Local variables
- INTEGER :: ji,jj
- REAL(KIND=8) :: zt, zs, zh
-
- zh = pdep
+ DO jj=1,kpj
DO ji=1,kpi
- DO jj=1,kpj
- zt = ptem(ji,jj) ! potential temperature
- zs = psal(ji,jj)- 35.0 ! salinity anomaly (s-35)
-
- beta(ji,jj) = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt & ! beta
- & - 0.301985e-05 ) * zt &
- & + 0.785567e-03 &
- & + ( 0.515032e-08 * zs &
- & + 0.788212e-08 * zt - 0.356603e-06 ) * zs &
- & +( ( 0.121551e-17 * zh &
- & - 0.602281e-15 * zs &
- & - 0.175379e-14 * zt + 0.176621e-12 ) * zh &
- & + 0.408195e-10 * zs &
- & + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt &
- & - 0.121555e-07 ) * zh
- END DO
+
+ ! Convert T and S to double precision.
+ dlt = DBLE(ptem(ji,jj))
+ dls = DBLE(psal(ji,jj))
+ dlref = DBLE(pref(ji,jj))
+
+ ! Compute the volumic mass of pure water at atmospheric pressure.
+ dlr1=((((6.536332d-9*dlt-1.120083d-6)&
+ *dlt+1.001685d-4)&
+ *dlt-9.095290d-3)&
+ *dlt+6.793952d-2)&
+ *dlt+999.842594d0
+
+ ! Compute the seawater volumic mass at atmospheric pressure.
+ dlr2=(((5.3875d-9*dlt-8.2467d-7)&
+ *dlt+7.6438d-5)&
+ *dlt-4.0899d-3)&
+ *dlt+0.824493d0
+
+ dlr3=(-1.6546d-6*dlt+1.0227d-4)&
+ *dlt-5.72466d-3
+
+ ! Compute the potential volumic mass (referenced to the surface).
+ dlrhop=(dpr4*dls+dlr3*dlrs(ji,jj)+dlr2)*dls+dlr1
+
+ ! Compute the compression terms.
+ dle=(-3.508914d-8*dlt-1.248266d-8)&
+ *dlt-2.595994d-6
+
+ dlbw=(1.296821d-6*dlt-5.782165d-9)&
+ *dlt+1.045941d-4
+
+ dlb=dlbw+dle*dls
+
+ dlc=(-7.267926d-5*dlt+2.598241d-3 )&
+ *dlt+0.1571896d0
+
+ dlaw=((5.939910d-6*dlt+2.512549d-3)&
+ *dlt-0.1028859d0)&
+ *dlt-4.721788d0
+
+ dla=(dpd*dlrs(ji,jj)+dlc)*dls+dlaw
+
+ dlb1=(-0.1909078d0*dlt+7.390729d0)&
+ *dlt-55.87545d0
+
+ dla1=((2.326469d-3*dlt+1.553190d0)&
+ *dlt-65.00517d0)&
+ *dlt+1044.077d0
+
+ dlkw=(((-1.361629d-4*dlt-1.852732d-2)&
+ *dlt-30.41638d0)&
+ *dlt+2098.925d0)&
+ *dlt+190925.6d0
+
+ dlk0=(dlb1*dlrs(ji,jj)+dla1)*dls+dlkw
+
+ ! Compute the potential density anomaly.
+ sigmai_dep2d(ji,jj)=dlrhop/(1.0d0-dlref/(dlk0-dlref*(dla-dlref*dlb)))&
+ -dprau0
+
+ ENDDO
+ ENDDO
+
+ END FUNCTION sigmai_dep2d
+
+
+ FUNCTION eosbn2 ( ptem, psal, pdep, pe3w, kpi, kpj, kup, kdown)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION eosbn2 ***
+ !!
+ !! ** Purpose : Compute the local Brunt-Vaisala frequency at the time-
+ !! step of the input arguments
+ !!
+ !! ** Method : UNESCO sea water properties
+ !! The brunt-vaisala frequency is computed using the
+ !! polynomial expression of McDougall (1987):
+ !! N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), DIMENSION(kpi,kpj,2), INTENT(in) :: ptem, psal ! temperaature salinity
+ REAL(KIND=4) :: pdep ! reference depth
+ REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: pe3w ! e3w of the current layer
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! size of the array
+ INTEGER(KIND=4), INTENT(in) :: kup, kdown ! index of levels up and down
+ REAL(KIND=4), DIMENSION(kpi,kpj) :: eosbn2 ! returned values
+
+ INTEGER(KIND=4) :: ji, jj ! dummy loop indices
+ REAL(KIND=8) :: zgde3w, zt, zs, zh
+ REAL(KIND=8) :: zalbet, zbeta
+ REAL(KIND=8) :: zgrav=9.81
+ !!----------------------------------------------------------------------
+
+ zh = pdep
+ DO jj = 1, kpj
+ DO ji = 1, kpi
+ zgde3w = zgrav / pe3w(ji,jj)
+ zt = 0.5 * ( ptem(ji,jj,kup) + ptem(ji,jj,kdown) ) ! potential temperature at w-point
+ zs = 0.5 * ( psal(ji,jj,kup) + psal(ji,jj,kdown) ) - 35.0 ! salinity anomaly (s-35) at w-point
+
+ zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt & ! ratio alpha/beta
+ & - 0.203814e-03 ) * zt &
+ & + 0.170907e-01 ) * zt &
+ & + 0.665157e-01 &
+ & + ( - 0.678662e-05 * zs &
+ & - 0.846960e-04 * zt + 0.378110e-02 ) * zs &
+ & + ( ( - 0.302285e-13 * zh &
+ & - 0.251520e-11 * zs &
+ & + 0.512857e-12 * zt * zt ) * zh &
+ & - 0.164759e-06 * zs &
+ & +( 0.791325e-08 * zt - 0.933746e-06 ) * zt &
+ & + 0.380374e-04 ) * zh
+
+ zbeta = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt & ! beta
+ & - 0.301985e-05 ) * zt &
+ & + 0.785567e-03 &
+ & + ( 0.515032e-08 * zs &
+ & + 0.788212e-08 * zt - 0.356603e-06 ) * zs &
+ & +( ( 0.121551e-17 * zh &
+ & - 0.602281e-15 * zs &
+ & - 0.175379e-14 * zt + 0.176621e-12 ) * zh &
+ & + 0.408195e-10 * zs &
+ & + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt &
+ & - 0.121555e-07 ) * zh
+
+ eosbn2(ji,jj) = zgde3w * zbeta & ! N^2
+ & * ( zalbet * ( ptem(ji,jj,kup) - ptem(ji,jj,kdown) ) &
+ & - ( psal(ji,jj,kup) - psal(ji,jj,kdown) ) )
+ END DO
+ END DO
+
+ END FUNCTION eosbn2
+
+
+ FUNCTION albet( ptem, psal, pdep, kpi, kpj)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION albet ***
+ !!
+ !! ** Purpose : Compute the ratio alpha/beta
+ !!
+ !! ** Method : Follow Mc Dougal et al as in other functions
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), DIMENSION(kpi,kpj), INTENT(in) :: ptem, psal ! temperature salinity
+ REAL(KIND=4), INTENT(in) :: pdep ! refererence depth
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! size of the arrays
+
+ REAL(KIND=8), DIMENSION(kpi,kpj) :: albet ! returned value
+
+ INTEGER(KIND=4) :: ji, jj ! dummy loop index
+ REAL(KIND=8) :: zt, zs, zh ! working local variables
+ !!----------------------------------------------------------------------
+ zh = pdep
+ DO ji=1,kpi
+ DO jj=1,kpj
+ zt = ptem(ji,jj) ! potential temperature
+ zs = psal(ji,jj)- 35.0 ! salinity anomaly (s-35)
+
+ albet(ji,jj) = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt & ! ratio alpha/beta
+ & - 0.203814e-03 ) * zt &
+ & + 0.170907e-01 ) * zt &
+ & + 0.665157e-01 &
+ & + ( - 0.678662e-05 * zs &
+ & - 0.846960e-04 * zt + 0.378110e-02 ) * zs &
+ & + ( ( - 0.302285e-13 * zh &
+ & - 0.251520e-11 * zs &
+ & + 0.512857e-12 * zt * zt ) * zh &
+ & - 0.164759e-06 * zs &
+ & +( 0.791325e-08 * zt - 0.933746e-06 ) * zt &
+ & + 0.380374e-04 ) * zh
+ END DO
+ END DO
+
+ END FUNCTION albet
+
+
+ FUNCTION beta ( ptem, psal, pdep, kpi, kpj)
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION beta ***
+ !!
+ !! ** Purpose : Compute the beta
+ !!
+ !! ** Method : Follow Mc Dougal et al as in other functions
+ !!
+ !!----------------------------------------------------------------------
+ REAL(KIND=4), DIMENSION(kpi,kpj),INTENT(in) :: ptem, psal ! temperature salinity
+ REAL(KIND=4), INTENT(in) :: pdep ! reference depth
+ INTEGER(KIND=4), INTENT(in) :: kpi, kpj ! size of the array
+ REAL(KIND=8), DIMENSION(kpi,kpj) :: beta ! returned values
+
+ INTEGER(KIND=4) :: ji, jj ! dummy loop index
+ REAL(KIND=8) :: zt, zs, zh ! working variables
+ !!----------------------------------------------------------------------
+ zh = pdep
+ DO ji=1,kpi
+ DO jj=1,kpj
+ zt = ptem(ji,jj) ! potential temperature
+ zs = psal(ji,jj)- 35.0 ! salinity anomaly (s-35)
+
+ beta(ji,jj) = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt & ! beta
+ & - 0.301985e-05 ) * zt &
+ & + 0.785567e-03 &
+ & + ( 0.515032e-08 * zs &
+ & + 0.788212e-08 * zt - 0.356603e-06 ) * zs &
+ & +( ( 0.121551e-17 * zh &
+ & - 0.602281e-15 * zs &
+ & - 0.175379e-14 * zt + 0.176621e-12 ) * zh &
+ & + 0.408195e-10 * zs &
+ & + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt &
+ & - 0.121555e-07 ) * zh
END DO
+ END DO
- END FUNCTION beta
+ END FUNCTION beta
END MODULE eos
diff --git a/modcdfnames.f90 b/modcdfnames.f90
new file mode 100644
index 0000000..0755443
--- /dev/null
+++ b/modcdfnames.f90
@@ -0,0 +1,290 @@
+MODULE modCdfNames
+ !!======================================================================
+ !! *** MODULE modCdfNames ***
+ !! Declare all dimension name, variable name, attribute name as variable
+ !! This will ease the generalization of CDFTOOLS
+ !!=====================================================================
+ !! History : 3.0 ! 12/2010 ! J.M. Molines : Original code
+ !!----------------------------------------------------------------------
+ IMPLICIT NONE
+
+ PUBLIC
+
+ ! Dimension name : cn_. [ 1 letter only ]
+ CHARACTER(LEN=20) :: cn_x='x' !: longitude, I dimension
+ CHARACTER(LEN=20) :: cn_y='y' !: latitude, J dimension
+ CHARACTER(LEN=20) :: cn_z='depth' !: depth, z dimension
+ CHARACTER(LEN=20) :: cn_t='time_counter' !: time dimension
+
+ ! Dimension variable
+ CHARACTER(LEN=20) :: cn_vlon2d = 'nav_lon' !: longitude
+ CHARACTER(LEN=20) :: cn_vlat2d = 'nav_lat' !: latitude
+ CHARACTER(LEN=20) :: cn_vdeptht = 'deptht' !: depth
+ CHARACTER(LEN=20) :: cn_vdepthu = 'depthu' !: depth
+ CHARACTER(LEN=20) :: cn_vdepthv = 'depthv' !: depth
+ CHARACTER(LEN=20) :: cn_vdepthw = 'depthw' !: depth
+ CHARACTER(LEN=20) :: cn_vtimec = 'time_counter' !: time
+
+ ! Attribute of a variable
+ CHARACTER(LEN=20) :: cn_missing_value = 'missing_value' !: missing value (to be replaced bby _Fill_Value)
+
+ ! Metrics
+ CHARACTER(LEN=20) :: cn_ve1t='e1t', cn_ve2t='e2t' !: e.t
+ CHARACTER(LEN=20) :: cn_ve1u='e1u', cn_ve2u='e2u' !: e.u
+ CHARACTER(LEN=20) :: cn_ve1v='e1v', cn_ve2v='e2v' !: e.v
+ CHARACTER(LEN=20) :: cn_ve1f='e1f', cn_ve2f='e2f' !: e.v
+ CHARACTER(LEN=20) :: cn_ve3t='e3t', cn_ve3w='e3w' !: e3.
+ CHARACTER(LEN=20) :: cn_vff='ff'
+
+ CHARACTER(LEN=20) :: cn_gdept='gdept', cn_gdepw='gdepw' !: 1d dep variable
+ CHARACTER(LEN=20) :: cn_hdept='hdept', cn_hdepw='hdepw' !: 2d dep variable
+
+ CHARACTER(LEN=20) :: cn_glamt='glamt', cn_gphit='gphit' !: glam gphi
+ CHARACTER(LEN=20) :: cn_glamu='glamu', cn_gphiu='gphiu' !: glam gphi
+ CHARACTER(LEN=20) :: cn_glamv='glamv', cn_gphiv='gphiv' !: glam gphi
+ CHARACTER(LEN=20) :: cn_glamf='glamf', cn_gphif='gphif' !: glam gphi
+
+ ! Generic mesh-mask file names cn_f...
+ CHARACTER(LEN=20) :: cn_fzgr='mesh_zgr.nc'
+ CHARACTER(LEN=20) :: cn_fhgr='mesh_hgr.nc'
+ CHARACTER(LEN=20) :: cn_fmsk='mask.nc'
+ CHARACTER(LEN=20) :: cn_fcoo='coordinates.nc'
+ CHARACTER(LEN=20) :: cn_fbasins='new_maskglo.nc'
+
+ ! Variable name : cn_v... [ starts with cn_v ]
+ CHARACTER(LEN=20) :: cn_votemper='votemper' !: temperature
+ CHARACTER(LEN=20) :: cn_vosaline='vosaline' !: salinity
+ CHARACTER(LEN=20) :: cn_vozocrtx='vozocrtx' !: zonal velocity
+ CHARACTER(LEN=20) :: cn_vomecrty='vomecrty' !: meridional velocity
+ CHARACTER(LEN=20) :: cn_vomeeivv='vomeeivv' !: meridional Eddy Induced Velocity
+ CHARACTER(LEN=20) :: cn_vovecrtz='vovecrtz' !: vertical velocity
+ CHARACTER(LEN=20) :: cn_sossheig='sossheig' !: Sea Surface Height
+ CHARACTER(LEN=20) :: cn_somxl010='somxl010' !: Mixed layer depth (density criterium)
+ CHARACTER(LEN=20) :: cn_somxlt02='somxlt02' !: Mixed layer depth (temperature criterium)
+
+ CHARACTER(LEN=20) :: cn_sohefldo='sohefldo' !: Total Heat FLux
+ CHARACTER(LEN=20) :: cn_solhflup='solhflup' !: Latent Heat FLux
+ CHARACTER(LEN=20) :: cn_sosbhfup='sosbhfup' !: Sensible heat Flux
+ CHARACTER(LEN=20) :: cn_solwfldo='solwfldo' !: Long Wave downward Heat Flux
+ CHARACTER(LEN=20) :: cn_soshfldo='soshfldo' !: Solar Heat FLux
+
+ CHARACTER(LEN=20) :: cn_sowaflup='sowaflup' !: Fresh Water Flux
+ CHARACTER(LEN=20) :: cn_sowaflcd='sowaflcd' !: Concentration Dilution water flux
+ CHARACTER(LEN=20) :: cn_sowafldp='sowafldp' !: SSS damping water Flux
+ CHARACTER(LEN=20) :: cn_iowaflup='iowaflup' !: Ice Ocean Water flux ( + = freezing, - = melting)
+ CHARACTER(LEN=20) :: cn_soicecov='soicecov' !: Ice cover
+
+ ! MOC variables
+ CHARACTER(LEN=20) :: cn_zomsfatl='zomsfatl' !: moc in the Atlantic
+ CHARACTER(LEN=20) :: cn_zomsfglo='zomsfglo' !: moc in the Global ocean
+ CHARACTER(LEN=20) :: cn_zomsfpac='zomsfpac' !: moc in the Pacific
+ CHARACTER(LEN=20) :: cn_zomsfinp='zomsfinp' !: moc in the Indo-Pacific
+ CHARACTER(LEN=20) :: cn_zomsfind='zomsfind' !: moc in the Indian ocean
+
+ ! transport variables
+ CHARACTER(LEN=20) :: cn_vozout='vozout' !: product U x T at U point
+ CHARACTER(LEN=20) :: cn_vomevt='vomevt' !: product V x T at V point
+ CHARACTER(LEN=20) :: cn_vozous='vozous' !: product U x S at U point
+ CHARACTER(LEN=20) :: cn_vomevs='vomevs' !: product V x S at V point
+ CHARACTER(LEN=20) :: cn_sozout='sozout' !: product U x T at U point
+ CHARACTER(LEN=20) :: cn_somevt='somevt' !: product V x T at V point
+ CHARACTER(LEN=20) :: cn_sozous='sozous' !: product U x S at U point
+ CHARACTER(LEN=20) :: cn_somevs='somevs' !: product V x S at V point
+ CHARACTER(LEN=20) :: cn_sozoutrp='sozoutrp' !: vertically integrated trp at U point
+ CHARACTER(LEN=20) :: cn_somevtrp='somevtrp' !: vertically integrated trp at V point
+
+ ! density, isopycnal diagnostics
+ CHARACTER(LEN=20) :: cn_vosigma0='vosigma0' !: potential density refered to surface
+ CHARACTER(LEN=20) :: cn_vosigmai='vosigmai' !: potential density refered to a partiular depth
+ CHARACTER(LEN=20) :: cn_vodepiso='vodepiso' !: depth of isopycnal
+ CHARACTER(LEN=20) :: cn_isothick='isothick' !: isopycnal tickness (from cdfsigintegr)
+
+ ! Passive tracer variable
+ CHARACTER(LEN=20) :: cn_invcfc='invcfc' !: CFC inventory
+ CHARACTER(LEN=20) :: cn_cfc11='cfc11' !: CFC concentration
+ CHARACTER(LEN=20) :: cn_pendep='pendep' !: CFC penetration depth (from cdfpendep)
+
+ ! ice variable names
+ CHARACTER(LEN=20) :: cn_iicethic='iicethic' !: ice thickness
+ CHARACTER(LEN=20) :: cn_ileadfra='ileadfra' !: ice concentration
+
+ ! Bathymetry
+ CHARACTER(LEN=20) :: cn_fbathymet='bathy_meter.nc' !: file Bathymetry in meters
+ CHARACTER(LEN=20) :: cn_fbathylev='bathy_level.nc' !: file Bathymetry in levels
+
+ CHARACTER(LEN=20) :: cn_bathymet='Bathymetry' !: variable Bathymetry in meters
+ CHARACTER(LEN=20) :: cn_bathylev='bathy_level'!: variable Bathymetry in levels
+
+ ! variables to be squared when performing cdfmoy
+ INTEGER(KIND=4), PARAMETER :: jp_sqdvarmax=10
+ INTEGER(KIND=4) :: nn_sqdvar = 4
+ INTEGER(KIND=4), PRIVATE :: ji
+ CHARACTER(LEN=15), DIMENSION(jp_sqdvarmax) :: cn_sqdvar = &
+ & (/'vozocrtx','vomecrty','vovecrtz','sossheig',(' ', ji=jp_sqdvarmax-5,jp_sqdvarmax) /)
+
+ ! variables eligible for 3rd moment computation when performing cdfmoy
+ INTEGER(KIND=4), PARAMETER :: jp_cubvarmax=10
+ INTEGER(KIND=4) :: nn_cubvar = 2
+ CHARACTER(LEN=15), DIMENSION(jp_cubvarmax) :: cn_cubvar = &
+ & (/'sossheig','votemper',(' ', ji=3,jp_cubvarmax) /)
+
+! INTERFACE
+! SUBROUTINE fdate( cldate)
+! CHARACTER(LEN=24) :: cldate
+! END SUBROUTINE fdate
+! END INTERFACE
+
+ PUBLIC :: ReadCdfNames
+ PUBLIC :: PrintCdfNames
+
+ !! NAMELIST STATEMENTS
+ ! dimensions
+ NAMELIST/namdim/ cn_x, cn_y, cn_z, cn_t ! dimensions
+
+ ! dimension variables
+ NAMELIST/namdimvar/ cn_vlon2d, cn_vlat2d, cn_vdeptht, cn_vtimec
+ NAMELIST/namdimvar/ cn_vdeptht, cn_vdepthu, cn_vdepthv, cn_vdepthw
+
+ ! attributes
+ NAMELIST/namdimvar/ cn_missing_value
+
+ ! metrics in coordinates, mesh_hgr
+ NAMELIST/nammetrics/ cn_ve1t, cn_ve1u, cn_ve1v, cn_ve1f
+ NAMELIST/nammetrics/ cn_ve2t, cn_ve2u, cn_ve2v, cn_ve2f
+ NAMELIST/nammetrics/ cn_ve3t, cn_ve3w
+ NAMELIST/nammetrics/ cn_vff
+ NAMELIST/nammetrics/ cn_glamt, cn_glamu, cn_glamv, cn_glamf
+ NAMELIST/nammetrics/ cn_gphit, cn_gphiu, cn_gphiv, cn_gphif
+ ! mesh_zgr
+ NAMELIST/nammetrics/ cn_gdept, cn_gdepw
+ NAMELIST/nammetrics/ cn_hdept, cn_hdepw
+
+ ! variables
+ NAMELIST/namvars/ cn_votemper, cn_vosaline
+ NAMELIST/namvars/ cn_vozocrtx, cn_vomecrty, cn_vomeeivv, cn_vovecrtz
+ NAMELIST/namvars/ cn_sossheig, cn_somxl010, cn_somxlt02
+ NAMELIST/namvars/ cn_sohefldo, cn_solhflup, cn_sosbhfup
+ NAMELIST/namvars/ cn_solwfldo, cn_soshfldo
+ NAMELIST/namvars/ cn_sowaflup, cn_sowaflcd, cn_sowafldp, cn_iowaflup
+ NAMELIST/namvars/ cn_zomsfatl, cn_zomsfglo, cn_zomsfpac, cn_zomsfinp, cn_zomsfind
+ NAMELIST/namvars/ cn_vozout, cn_vomevt, cn_vozous, cn_vomevs
+ NAMELIST/namvars/ cn_sozout, cn_somevt, cn_sozous, cn_somevs
+ NAMELIST/namvars/ cn_sozoutrp, cn_somevtrp
+ NAMELIST/namvars/ cn_soicecov
+ NAMELIST/namvars/ cn_vosigma0, cn_vosigmai, cn_vodepiso, cn_isothick
+ NAMELIST/namvars/ cn_iicethic, cn_ileadfra
+ NAMELIST/namvars/ cn_invcfc, cn_cfc11, cn_pendep
+
+ ! list of variable to be squared by cdfmoy
+ NAMELIST/namsqdvar/ nn_sqdvar, cn_sqdvar
+
+ ! list of variable to be cubed by cdfmoy ( option )
+ NAMELIST/namcubvar/ nn_cubvar, cn_cubvar
+
+ ! name of mesh_mask files
+ NAMELIST/nammeshmask/ cn_fzgr, cn_fhgr, cn_fmsk, cn_fcoo, cn_fbasins
+
+ ! Bathymetry
+ NAMELIST/nambathy/ cn_fbathymet, cn_fbathylev, cn_bathymet, cn_bathylev
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
+
+CONTAINS
+
+ SUBROUTINE ReadCdfNames ()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE ReadCdfNames ***
+ !!
+ !! ** Purpose : update the standard NetCdfName using a dedicated
+ !! namelist ( nam_cdf_names )
+ !!
+ !! ** Method : Look for this namelist in the following order :
+ !! 1. current dir
+ !! 2. HOME/CDTOOLS_cfg directory
+ !!
+ !! nam_cdf_nam can be adjusted with environment
+ !! variable NAM_CDF_NAMES
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=90) :: cl_namlist= 'nam_cdf_names'
+ CHARACTER(LEN=20) :: cl_env = 'NAM_CDF_NAMES'
+ CHARACTER(LEN=90) :: cldum, cl_home
+ LOGICAL :: ll_exist
+ INTEGER(KIND=4) :: inam = 10
+ !!----------------------------------------------------------------------
+ CALL getenv ('HOME', cl_home)
+
+ ! Look for cdf namelist name
+ CALL getenv (cl_env, cldum )
+
+ IF ( cldum /= ' ' ) cl_namlist = cldum
+
+ ! Now look for existence of the namelist
+ INQUIRE( FILE=cl_namlist, EXIST=ll_exist )
+
+ IF ( .NOT. ll_exist ) THEN
+ cldum=TRIM(cl_home)//'/CDFTOOLS_cfg/'//TRIM(cl_namlist)
+ cl_namlist=cldum
+ INQUIRE( FILE=cl_namlist, EXIST= ll_exist )
+ IF ( .NOT. ll_exist ) THEN
+ RETURN ! assuming that there is no need to read
+ ! a namelist for cdf names
+ ENDIF
+ ENDIF
+
+ PRINT *, ' CAUTION : dim names and variable names are now set according to '
+ PRINT *, ' ======= the following namelist : ', TRIM(cl_namlist)
+
+ OPEN(inam, FILE=cl_namlist, RECL=200)
+ REWIND(inam)
+
+ READ(inam, namdim )
+ READ(inam, namdimvar )
+ READ(inam, nammetrics )
+ READ(inam, namvars )
+ READ(inam, nambathy )
+ READ(inam, namsqdvar )
+ READ(inam, nammeshmask )
+ CLOSE ( inam )
+
+ END SUBROUTINE ReadCdfNames
+
+ SUBROUTINE PrintCdfNames()
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE PrintCdfNames ***
+ !!
+ !! ** Purpose : Print a namelist like file from the actual netcdf names
+ !!
+ !! ** Method : Use namelist facilities
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=80) :: cl_filout='PrintCdfNames.namlist'
+ CHARACTER(LEN=24) :: cl_date
+ INTEGER(KIND=4) :: iout=3
+ !!----------------------------------------------------------------------
+ CALL fdate(cl_date)
+! cl_date=fdate()
+ OPEN(iout, FILE=cl_filout, RECL=200)
+ WRITE(iout, '(a,a)' ) ' ! ', cl_date
+ WRITE(iout, '(a)' ) ' ! Namelist automatically generated by PrintCdfNames '
+ WRITE(iout, '(a)' ) ' ! Do not edit without changing its name ... '
+ WRITE(iout, '(a)' ) ' ! ------------------------------------------'
+ WRITE(iout, namdim )
+ WRITE(iout, namdimvar )
+ WRITE(iout, nammetrics )
+ WRITE(iout, namvars )
+ WRITE(iout, nambathy )
+ WRITE(iout,'(a)' ) ' ! Namelist entry namsqdvar needs manual formating before'
+ WRITE(iout,'(a)' ) ' ! it can be used as input : put variables names in between '' '
+ WRITE(iout,'(a)' ) ' ! and separate variables by , '
+ WRITE(iout, namsqdvar )
+ WRITE(iout, nammeshmask )
+ CLOSE (iout)
+
+ END SUBROUTINE PrintCdfNames
+
+END MODULE modCdfNames
diff --git a/modpoly.f90 b/modpoly.f90
index 2debdbc..90eedfb 100644
--- a/modpoly.f90
+++ b/modpoly.f90
@@ -1,221 +1,197 @@
MODULE modpoly
- !------------------------------------------------------------------------
- ! *** MODULE modpoly ***
- !
- ! ** Purpose : The main function of this module is the function InPoly,
- ! which returns a boolean set to true, if the point given in input
- ! is within a defined polygon, set to false in the contrary.
- !
- ! ** Method : Use algorithms developped in the late 80's for a finite element
- ! mesh generator (TRIGRID) by R. Walters, C. Werner et Al.
- ! Some original comments are maintained for references.
- ! - DEFINITIONS
- ! vertx(,) = 2dim. array of polygons and their X coordinates.
- ! verty(,) = 2dim. array of polygons and their Y coordinates.
- ! nvertcnt() = # vertices in a given polygon.
- ! numpolys = # of polygons currently defined.
- !
- ! PARAMETERS set for polygon storage in MASTER1.PAR (before)
- ! jpvert = max # vertices a polygon may have.
- ! jpolys = max # polygons that may be defined.
- ! maxpolydels = array dimension for pd(), the pending deletion array.
- !
- ! history:
- ! Original code : late 80's trigrid (Walters et Al.)
- ! adaptation to model diagnostics : J.M. Molines (03/2006)
- !-----------------------------------------------------------------------
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
-
- ! Module Variables
+ !!======================================================================
+ !! *** MODULE modpoly ***
+ !! Determine if a given point is within a polygon or not. This module is
+ !! inherited from de finite element mesh generator program (TRIGRID)
+ !!=====================================================================
+ !! History : 2.1 : 03/2006 : J.M. Molines : Port from trigrid
+ !! 3.0 : 12/2010 : J.M. Molines : Doctor norm + Licence
+ !!
+ !! Use algorithms developped in the late 80's for a finite element
+ !! mesh generator (TRIGRID) by R. Walters, C. Werner et Al.
+ !! Some original comments are maintained for references.
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! ReadPoly : Read polygon file
+ !! PrepPoly : Compute elements of the sides of polygon
+ !! InPoly : Check if a point in in or out of a polygon
+ !! PointSlope : Internal routine which computes slopes and coeff, of the side
+ !!----------------------------------------------------------------------
+
IMPLICIT NONE
+
PRIVATE
- INTEGER,PUBLIC , PARAMETER :: jpvert = 50, & !: Number of vertex per polygon
- & jpolys = 20 !: Number of polygons.
+ INTEGER(KIND=4), PUBLIC , PARAMETER :: jpvert = 50 !: Number of vertex per polygon
+ INTEGER(KIND=4), PUBLIC , PARAMETER :: jpolys = 20 !: Number of polygons.
! - Storage for polygon definitions
- INTEGER :: numpolys
- INTEGER,DIMENSION(jpolys) :: nvertcnt
-
- REAL(KIND=4), DIMENSION(jpolys,jpvert+1) :: vertx, verty
- REAL(KIND=4) :: pmaxx, pmaxy, pminx, pminy
- REAL(KIND=8), DIMENSION(jpvert) :: slope, a, b, c
-
- PUBLIC ReadPoly, PrepPoly, InPoly
+ INTEGER(KIND=4) :: numpolys ! number of of polygons currently defined
+ INTEGER(KIND=4), DIMENSION(jpolys) :: nvertcnt ! number of vertices of a given polygon
+
+ REAL(KIND=4), DIMENSION(jpolys,jpvert+1) :: vertx, verty ! 2dim. array of polygons and their X,Y coordinates
+ REAL(KIND=4) :: rmaxx, rmaxy ! max x,y of polygon coordinates
+ REAL(KIND=4) :: rminx, rminy ! min x,y of polygon coordinates
+ REAL(KIND=8), DIMENSION(jpvert) :: slope ! slope of the sides of polygone
+ REAL(KIND=8), DIMENSION(jpvert) :: ra, rb, rc ! equation of side of polygon
+
+ PUBLIC :: ReadPoly
+ PUBLIC :: PrepPoly
+ PUBLIC :: InPoly
+ PRIVATE :: PointSlope
+
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE ReadPoly(cdfront,kpoly,cdarea)
- !!-------------------------------------------------------------------------
- !! *** SUBROUTINE ReadPoly ***
- !!
- !! ** Purpose : read an ASCII file with names of polygon area
- !! and vertices.
+ SUBROUTINE ReadPoly(cdfront, kpoly, cdarea)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE ReadPoly ***
!!
- !! ** Method :
+ !! ** Purpose : read an ASCII file with names of polygon area
+ !! and vertices.
!!
- !! history :
- !! Original code : late 80's trigrid (Walters et Al.)
- !! adaptation to model diagnostics : J.M. Molines (03/2006)
- !!-------------------------------------------------------------------------
- ! * Arguments
- INTEGER, INTENT(OUT) :: kpoly
- CHARACTER(LEN=*),INTENT(IN) :: cdfront !: Name of input file
- CHARACTER(LEN=*),DIMENSION (:),INTENT(OUT) :: cdarea !: Name of the polygonal area
-
- ! * Local Variables
- INTEGER,DIMENSION(jpolys) :: ipac !: flag for Pacific area (across date line )
- INTEGER :: numpol=8 !: logical unit for input file
- INTEGER :: ipoly ! polygon counter
- INTEGER :: jj, jmax
-
- OPEN (numpol,FILE=cdfront)
+ !! References : late 80's trigrid (Walters et Al.)
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdfront ! Name of input file
+ INTEGER(KIND=4), INTENT(out) :: kpoly ! number of poylgons
+ CHARACTER(LEN=*), DIMENSION (:), INTENT(out) :: cdarea ! Name of the polygonal area
+
+ INTEGER(KIND=4) :: jj ! dummy loop index
+ INTEGER(KIND=4),DIMENSION(jpolys) :: ipac ! flag for Pacific area (across date line )
+ INTEGER(KIND=4) :: inum=8 ! logical unit for input file
+ INTEGER(KIND=4) :: ipoly ! polygon counter
+ INTEGER(KIND=4) :: ivert ! number of vertices of a polygon
+ !!----------------------------------------------------------------------
+ OPEN (inum,FILE=cdfront)
ipoly=0
!
DO WHILE (.TRUE.)
ipoly=ipoly+1
- READ(numpol,'(a)',END=995) cdarea(ipoly) ! 1rst line of block : name of polygon
- READ(numpol,*)nvertcnt(ipoly),ipac(ipoly) ! 2nd : number of vertices,
- jmax=nvertcnt(ipoly)
- READ(numpol,*)(vertx(ipoly,jj),verty(ipoly,jj),jj=1,jmax) ! 3rd : (x,y) pairs foreach vertex
+ READ(inum,'(a)',END=995) cdarea(ipoly) ! 1rst line of block : name of polygon
+ READ(inum,*)nvertcnt(ipoly), ipac(ipoly) ! 2nd : number of vertices,
+ ivert=nvertcnt(ipoly)
+ READ(inum,*)(vertx(ipoly,jj),verty(ipoly,jj),jj=1,ivert) ! 3rd : (x,y) pairs foreach vertex
! take care of the date line for pacific zone
IF (ipac(ipoly) == 1 ) THEN
- DO jj=1,jmax
+ DO jj=1,ivert
IF (vertx(ipoly,jj) < 0 ) vertx(ipoly,jj) = vertx(ipoly,jj) + 360.
END DO
ENDIF
! Automatically close the polygon
- vertx(ipoly,jmax+1)=vertx(ipoly,1)
- verty(ipoly,jmax+1)=verty(ipoly,1)
- ! take care not to have integer values on polygon vertices
- DO jj=1, jmax+1
+ vertx(ipoly,ivert+1)=vertx(ipoly,1)
+ verty(ipoly,ivert+1)=verty(ipoly,1)
+ ! add dummy 0.001 to integer vertex coordinates... to avoid singular problem
+ DO jj=1, ivert+1
IF ( (vertx(ipoly, jj) - INT( vertx(ipoly, jj) ) ) == 0 ) vertx(ipoly, jj) = vertx(ipoly, jj)+0.001
IF ( (verty(ipoly, jj) - INT( verty(ipoly, jj) ) ) == 0 ) verty(ipoly, jj) = verty(ipoly, jj)+0.001
END DO
-
ENDDO
+
995 kpoly=ipoly-1
- CLOSE(numpol)
+
+ CLOSE(inum)
END SUBROUTINE ReadPoly
+
SUBROUTINE PrepPoly ( kpolyid )
!!---------------------------------------------------------------------
- !! *** SUBROUTINE PrepPoly ***
+ !! *** ROUTINE PrepPoly ***
+ !!
+ !! ** Purpose : determine polygon information in preparation for
+ !! a call to InPoly.
!!
- !! ** Purpose : To determine certain polygon information in preparation for
- !! a call to InPoly.
- !!
- !! ** Method :
- !! GIVEN: polyid = the id number of polygon to use in Common POLYDEFS
- !! in PolyStor.Inc.
- !! RETURNS: In Common /SLOP/:
- !! slope = array of slopes of polygon sides
- !! a, b, c = arrays of line equation components of polygon sides
- !! pmaxx, pmaxy, pminx, pminy = min/max x,y polygon coordinates
- !!
- !! history:
- !! WRITTEN: June 1990 by JDM for NODER.
- !! for model diagnostics, J.M. Molines (03/2006)
- !-----------------------------------------------------------------------
- IMPLICIT NONE
-
- !! * Arguments
- INTEGER ,INTENT(IN) :: kpolyid
-
- !! * Local Variables
- INTEGER ji, numvert
+ !! ** Method : returns slope and equation of lines (ra, rc, rb)
+ !! as well as the min/max of polygon coordinates
+ !!
+ !! References : Trigrid
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4) ,INTENT(in) :: kpolyid ! polygon Id
+ INTEGER(KIND=4) ji ! dummy loop index
+ INTEGER(KIND=4) inumvert ! number of vertices for polygon kpolyid
+ !!----------------------------------------------------------------------
! - get slopes & line equations for each polygon boundary
- numvert = nvertcnt(kpolyid)
- DO ji = 1, numvert-1
- CALL PointSlope ( slope(ji), vertx(kpolyid,ji), &
- & vertx(kpolyid,ji+1), verty(kpolyid,ji), &
- & verty(kpolyid,ji+1), a(ji), b(ji), c(ji) )
+ inumvert = nvertcnt(kpolyid)
+ DO ji = 1, inumvert-1
+ CALL PointSlope ( slope(ji), vertx(kpolyid,ji), vertx(kpolyid,ji+1), &
+ & verty(kpolyid,ji), verty(kpolyid,ji+1), &
+ & ra(ji), rb(ji), rc(ji) )
END DO
- ! - ( ji = 1, numvert-1 )
- CALL PointSlope ( slope(numvert), vertx(kpolyid,numvert), &
- & vertx(kpolyid,1), verty(kpolyid,numvert), &
- & verty(kpolyid,1), a(numvert), &
- & b(numvert), c(numvert) )
+ ! - ( ji = 1, inumvert-1 )
+ CALL PointSlope ( slope(inumvert), vertx(kpolyid,inumvert), vertx(kpolyid,1), &
+ & verty(kpolyid,inumvert), verty(kpolyid,1), &
+ & ra(inumvert), rb(inumvert), rc(inumvert) )
! - calculate the max x,y's of polygon
- pmaxx = vertx(kpolyid,1)
- pmaxy = verty(kpolyid,1)
- DO ji = 1, numvert
- IF (vertx(kpolyid,ji) > pmaxx) pmaxx = vertx(kpolyid,ji)
- IF (verty(kpolyid,ji) > pmaxy) pmaxy = verty(kpolyid,ji)
+ rmaxx = vertx(kpolyid,1)
+ rmaxy = verty(kpolyid,1)
+ DO ji = 1, inumvert
+ IF (vertx(kpolyid,ji) > rmaxx) rmaxx = vertx(kpolyid,ji)
+ IF (verty(kpolyid,ji) > rmaxy) rmaxy = verty(kpolyid,ji)
END DO
! - calculate the min x,y's of polygon
- pminx = vertx(kpolyid,1)
- pminy = verty(kpolyid,1)
- DO ji = 1, numvert
- IF (vertx(kpolyid,ji) < pminx) pminx = vertx(kpolyid,ji)
- IF (verty(kpolyid,ji) < pminy) pminy = verty(kpolyid,ji)
+ rminx = vertx(kpolyid,1)
+ rminy = verty(kpolyid,1)
+ DO ji = 1, inumvert
+ IF (vertx(kpolyid,ji) < rminx) rminx = vertx(kpolyid,ji)
+ IF (verty(kpolyid,ji) < rminy) rminy = verty(kpolyid,ji)
END DO
END SUBROUTINE PrepPoly
SUBROUTINE InPoly ( kpolyid, pxpoint, pypoint, ld_in )
- !!------------------------------------------------------------------------
- !! *** SUBROUTINE InPoly ***
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE InPoly ***
!!
- !! ** Purpose: To see if a point is inside or outside of the specified
- !! polygon.
+ !! ** Purpose : To see if a point is inside or outside of the specified
+ !! polygon.
!!
- !! ** Method:
- !! GIVEN: Polygon data in Common SLOP, this data must be obtained by a
- !! call to PrepPoly prior to any calls to InPoly referencing the
- !! same polygon. When kpolyid changes between calls to InPoly,
- !! PrepPoly must be called to obtain the new info for the new polygon.
- !! Passed Arguments;
- !! kpolyid = the id number of polygon to use in Common POLYDEFS
- !! in PolyStor.Inc.
- !! pxpoint, pypoint = x,y coordinates of point to test.
- !! RETURNS: ld_in = TRUE if point is in polygon, else FALSE.
+ !! ** Method : Use the equation of the side of the polygon to determine
+ !! if a point is in (ld_in = true) or out (ld_in = false)
!!
- !! history:
- !! Original : TRIGRID June 1990 by JDM for NODER, based on InOut in SplitMod.For.
- !! Model diags : J.M. Molines (03/2006)
- !!-----------------------------------------------------------------------
- IMPLICIT NONE
-
- !* Arguments
- INTEGER,INTENT(IN) :: kpolyid ! Polygon ID
- REAL(KIND=4),INTENT(IN) :: pxpoint, pypoint ! Position to check
- LOGICAL,INTENT(OUT) :: ld_in ! True if in the polygon
-
- !* Local Variables
- INTEGER :: icross, ji, numvert
- REAL(KIND=8) :: zxpt, zx, zy, zevenodd
-
- numvert = nvertcnt(kpolyid)
+ !! References : Trigrid
+ !!----------------------------------------------------------------------
+ INTEGER(KIND=4), INTENT(in) :: kpolyid ! Polygon ID
+ REAL(KIND=4), INTENT(in) :: pxpoint, pypoint ! Position to check
+ LOGICAL, INTENT(out) :: ld_in ! True if in the polygon
+
+ INTEGER(KIND=4) :: ji
+ INTEGER(KIND=4) :: icross, inumvert
+ REAL(KIND=8) :: zxpt, zx, zy, zevenodd
+ !!----------------------------------------------------------------------
+ inumvert = nvertcnt(kpolyid)
! - store coordinates of point to test
zx = pxpoint
zy = pypoint
! - get the number of cross with the polygon boundary
icross = 0
! - see if point falls in the max and min range of polygon
- IF ( zx <= pmaxx ) THEN
- IF ( zx >= pminx ) THEN
- IF ( zy <= pmaxy ) THEN
- IF ( zy >= pminy ) THEN
+ IF ( zx <= rmaxx ) THEN
+ IF ( zx >= rminx ) THEN
+ IF ( zy <= rmaxy ) THEN
+ IF ( zy >= rminy ) THEN
! - step through the polygon boundaries
- DO ji = 1, numvert
+ DO ji = 1, inumvert
! - see if slope = 9999 and if point is on same y axis
IF ( slope(ji) == 9999 ) THEN
IF ( zx >= vertx(kpolyid,ji) ) THEN
- IF ( ji == numvert ) THEN
- IF ( ( (zy <= verty(kpolyid,numvert) ) .AND. &
- & (zy > verty(kpolyid,1) ) ) .OR. &
- & ( (zy >= verty(kpolyid,numvert) ) .AND. &
- & (zy < verty(kpolyid,1) ) ) ) THEN
+ IF ( ji == inumvert ) THEN
+ IF ( ( (zy <= verty(kpolyid,inumvert) ) .AND. &
+ & (zy > verty(kpolyid,1) ) ) .OR. &
+ & ( (zy >= verty(kpolyid,inumvert) ) .AND. &
+ & (zy < verty(kpolyid,1) ) ) ) THEN
! - it has crossed the polygon boundary
icross = icross + 1
! if (zy == 398) print *, zx, zy, icross ,'A', ji
@@ -227,17 +203,17 @@ CONTAINS
! - it has crossed the polygon boundary
icross = icross + 1
! if (zy == 398) print *, zx, zy, icross,'B', ji
- ENDIF ! ( ji = numvert )
+ ENDIF ! ( ji = inumvert )
ENDIF ! ( zx >= vertx(kpolyid,ji) )
! - see if normal slope (+ or -), and if point is not
! - higher or lower than y endpoints of the vertices
ELSEIF ( slope(ji) .NE. 0 ) THEN
- zxpt = ( c(ji) + zy ) / a(ji)
- IF ( ji == numvert ) THEN
- IF ( ( (zxpt <= vertx(kpolyid,numvert) ) .AND. &
- & (zxpt > vertx(kpolyid,1) ) ) .OR. &
- & ( (zxpt >= vertx(kpolyid,numvert) ) .AND. &
- & (zxpt < vertx(kpolyid,1) ) ) ) THEN
+ zxpt = ( rc(ji) + zy ) / ra(ji)
+ IF ( ji == inumvert ) THEN
+ IF ( ( (zxpt <= vertx(kpolyid,inumvert) ) .AND. &
+ & (zxpt > vertx(kpolyid,1) ) ) .OR. &
+ & ( (zxpt >= vertx(kpolyid,inumvert) ) .AND. &
+ & (zxpt < vertx(kpolyid,1) ) ) ) THEN
IF ( zx >= zxpt) THEN
! - it has crossed the polygon boundary
icross = icross + 1
@@ -253,9 +229,9 @@ CONTAINS
icross = icross + 1
! if (zy == 398) print *, zx, zy, icross,'D', ji, slope(ji), zxpt
ENDIF ! ( zx >= zxpt )
- ENDIF ! ( ji = numvert )
+ ENDIF ! ( ji = inumvert )
ENDIF ! ( zxpt test )
- END DO ! ( ji = 1, numvert )
+ END DO ! ( ji = 1, inumvert )
! - decide how many times scanline crossed poly bounds
zevenodd = AMOD ( ( icross * 1.0 ), 2.0 )
IF ( zevenodd .NE. 0 ) THEN
@@ -268,63 +244,59 @@ CONTAINS
ELSE
ld_in = .FALSE.
ENDIF
- ! - ( zy >= pminy )
+ ! - ( zy >= rminy )
ELSE
ld_in = .FALSE.
ENDIF
- ! - ( zy <= pmaxy )
+ ! - ( zy <= rmaxy )
ELSE
ld_in = .FALSE.
ENDIF
- ! - ( zx >= pminx )
+ ! - ( zx >= rminx )
ELSE
ld_in = .FALSE.
ENDIF
- ! - ( zx <= pmaxx )
+ ! - ( zx <= rmaxx )
END SUBROUTINE InPoly
SUBROUTINE PointSlope ( pslup, pvertxa, pvertxb, pvertya, pvertyb, pax, pby, pcnstnt )
- !!-------------------------------------------------------------------------
- !! *** SUBROUTINE PointSlope ***
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE PointSlope ***
!!
- !! ** Purpose: To get the slope and general equations of lines.
+ !! ** Purpose : To get the slope and general equations of lines.
!!
- !! ** Method:
- !! GIVEN: vertxa, vertxb, vertya, vertyb = endpoints of line section
+ !! ** Method : GIVEN: vertxa, vertxb, vertya, vertyb = endpoints of line section
!! to operate on.
- !! RETURNS: slup = slope of the line section
- !! ax, by, cnstnt = general eqation of the line section.
+ !! RETURNS: slup = slope of the line section
+ !! ax, by, cnstnt = general eqation of the line section.
!!
- !! history:
- !! Original : TRIGRID
- !! for model diags ; J.M. Molines (03/2006)
- !!-----------------------------------------------------------------------
- IMPLICIT NONE
-
- !* Arguments
- REAL(KIND=4), INTENT(IN) :: pvertxa, pvertxb, pvertya, pvertyb
- REAL(KIND=8), INTENT(OUT) :: pax, pby, pcnstnt
- REAL(KIND=8), INTENT(OUT) :: pslup
-
- !* Local Variables
+ !! References : trigrid
+ !!----------------------------------------------------------------------
+ REAL(KIND=8), INTENT(out) :: pslup
+ REAL(KIND=4), INTENT(in) :: pvertxa, pvertxb, pvertya, pvertyb
+ REAL(KIND=8), INTENT(out) :: pax, pby, pcnstnt
+
REAL(KIND=8) :: zvertxa, zvertxb, zvertya, zvertyb
- REAL(KIND=8) :: zrise, zrun
+ REAL(KIND=8) :: zrise, zrun
+ !!----------------------------------------------------------------------
- zvertxa=pvertxa ; zvertxb=pvertxb
- zvertya=pvertya ; zvertyb=pvertyb
+ zvertxa = pvertxa ; zvertxb = pvertxb
+ zvertya = pvertya ; zvertyb = pvertyb
zrise = zvertyb - zvertya
- zrun = zvertxb - zvertxa
+ zrun = zvertxb - zvertxa
IF ( zrun == 0 ) THEN
pslup = 9999
ELSE
pslup = zrise / zrun
ENDIF
+
IF ( ABS(pslup) <= 0.001 ) THEN
pslup = 0.0
ENDIF
+
IF ( pslup == 0 ) THEN
pax = pslup
pby = 1
diff --git a/modutils.f90 b/modutils.f90
new file mode 100644
index 0000000..6482e31
--- /dev/null
+++ b/modutils.f90
@@ -0,0 +1,90 @@
+MODULE modutils
+ !!======================================================================
+ !! *** MODULE modutils ***
+ !! Hold functions and subroutine dedicated to common utility task
+ !!=====================================================================
+ !! History : 3.0 : 04/2011 : J.M. Molines : Original code
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! routines : description
+ !! SetGlobalAtt : Set Global Attribute to the command line
+ !!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
+ !! CDFTOOLS_3.0 , MEOM 2011
+ !! $Id$
+ !! Copyright (c) 2010, J.-M. Molines
+ !! Software governed by the CeCILL licence (Licence/CDFTOOLSCeCILL.txt)
+ !!----------------------------------------------------------------------
+ USE cdfio
+
+ IMPLICIT NONE
+
+ PRIVATE
+ PUBLIC SetGlobalAtt
+ PUBLIC SetFileName
+
+CONTAINS
+ SUBROUTINE SetGlobalAtt(cdglobal, cd_append)
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE SetGlobalAtt ***
+ !!
+ !! ** Purpose : Append command line to the string given as argument.
+ !! This is basically used for setting a global attribute
+ !! in the output files
+ !!
+ !! ** Method : Decrypt line command with getarg
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(inout) :: cdglobal
+ CHARACTER(LEN=1), OPTIONAL, INTENT(in ) :: cd_append
+
+ INTEGER(KIND=4) :: iargc, inarg
+ INTEGER(KIND=4) :: jarg
+ CHARACTER(LEN=100) :: cl_arg
+ CHARACTER(LEN=1 ) :: cl_app
+ !!----------------------------------------------------------------------
+ cl_app = 'N'
+ IF ( PRESENT( cd_append ) ) THEN
+ cl_app = 'A'
+ ENDIF
+
+ CALL getarg(0, cl_arg)
+ SELECT CASE ( cl_app)
+ CASE ('A')
+ cdglobal = TRIM(cdglobal)//' ; '//TRIM(cl_arg)
+ CASE ('N')
+ cdglobal = TRIM(cl_arg)
+ END SELECT
+
+ inarg = iargc()
+ DO jarg=1, inarg
+ CALL getarg(jarg,cl_arg)
+ cdglobal = TRIM(cdglobal)//' '//TRIM(cl_arg)
+ END DO
+
+ END SUBROUTINE SetGlobalAtt
+
+ CHARACTER(LEN=256) FUNCTION SetFileName(cdconf, cdtag, cdgrid )
+ !!---------------------------------------------------------------------
+ !! *** FUNCTION SetFileName ***
+ !!
+ !! ** Purpose : Build filename from cdconf, tag and grid
+ !!
+ !! ** Method : Check 2 forms of file names and return
+ !! error is file is missing
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=*), INTENT(in) :: cdconf, cdtag, cdgrid
+ !!----------------------------------------------------------------------
+ WRITE( SetFileName,'(a,"_",a,"_grid",a,".nc")') TRIM(cdconf), TRIM(cdtag), TRIM(cdgrid)
+ IF ( chkfile(SetFileName ) ) THEN ! look for another name
+ WRITE(SetFileName,'(a,"_",a,"_grid_",a,".nc")') TRIM(cdconf), TRIM(cdtag), TRIM(cdgrid)
+ IF ( chkfile( SetFileName) ) THEN
+ PRINT *,' ERROR : missing grid',TRIM(cdgrid),'or even grid_',TRIM(cdgrid),' file '
+ STOP
+ ENDIF
+ ENDIF
+ END FUNCTION SetFileName
+
+
+END MODULE modutils
diff --git a/section.dat b/section.dat
deleted file mode 100644
index 23b3a94..0000000
--- a/section.dat
+++ /dev/null
@@ -1,57 +0,0 @@
-Lombok Strait
-173 175 464 464
-Malaisie-Sumatra
-116 116 506 511
-Sumatra-Java (Sond Strait)
-133 133 473 477
-Java- Australia
-166 166 409 465
-Australia -PNG
-280 280 455 462
-PNG-Mindanao (Philipines)
-216 239 528 497
-Mindanao -Samar
-211 210 538 539
-Samar-Northern Philipines
-206 207 549 549
-Philipines - Taiwan
-193 193 574 589
-Taiwan - China
-196 196 603 617
-Fram-Strait
-1069 1107 946 942
-Spitsberg Russia
-1133 1221 939 911
-North of Baffin Bay
-935 962 856 850
-Atlantic 26N
-828 1093 608 608
-Cuba Florida
-827 827 603 593
-Gibraltar Strait
-1126 1126 652 654
-Atlantic 28S
-955 1215 381 381
-Indian 28S-West
-1280 1441 385 385
-Indian 28S-East
-2 174 385 385
-Mozambique Channel
-1290 1325 405 405
-Bering Strait
-454 460 836 834
-Pacific 27N
-193 689 615 615
-Pacific 12S
-288 844 441 441
-Pacific 32S
-322 866 385 385
-Drake
-884 895 234 159
-20E South Africa
-1228 1228 351 102
-Tasmania Antarctica
-297 297 304 125
-Bass Strait
-297 297 318 332
-EOF
diff --git a/tag b/tag
deleted file mode 100644
index c9ed62b..0000000
--- a/tag
+++ /dev/null
@@ -1,4 +0,0 @@
- !! $Rev$
- !! $Date$
- !! $Id$
- !!--------------------------------------------------------------
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/cdftools.git
More information about the debian-science-commits
mailing list