[cdftools] 02/228: JMM reorganizing the tree on servforge
Alastair McKinstry
mckinstry at moszumanska.debian.org
Fri Jun 12 08:21:21 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 c3a565b31d1e617cd46fbee5cf1e4391a1b75195
Author: molines <molines at 1055176f-818a-41d9-83e1-73fbe5b947c5>
Date: Mon Feb 15 16:28:46 2010 +0000
JMM reorganizing the tree on servforge
git-svn-id: http://servforge.legi.grenoble-inp.fr/svn/CDFTOOLS/trunk@277 1055176f-818a-41d9-83e1-73fbe5b947c5
---
DOC/cdftools_prog.pdf | Bin 0 -> 130318 bytes
DOC/cdftools_user.pdf | Bin 0 -> 327764 bytes
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 | 258 +++++
JOBS/cdfmoy.ll | 323 +++++++
JOBS/cdfmoy_multiple.ksh | 78 ++
JOBS/cdfmoy_skel_new.ksh | 108 +++
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_skel_new.ksh | 108 +++
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/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/mkordre | 32 +
JOBS/monitor.csh | 365 +++++++
JOBS/monitor_noheat.csh | 255 +++++
JOBS/monitor_prod.ksh | 642 ++++++++++++
JOBS/monitor_prod_jade.ksh | 529 ++++++++++
JOBS/monitor_prod_kiel.ksh | 955 ++++++++++++++++++
JOBS/monitor_testOK_jade.ksh | 7 +
JOBS/testOK.ksh | 7 +
JOBS/trpsig_postproc.ksh | 90 ++
Makefile | 496 ++++++++++
Makefile_ursus | 241 +++++
bimgcaltrans.f90 | 68 ++
bimgmoy4.f90 | 334 +++++++
cdf16bit.f90 | 536 ++++++++++
cdfbathy.f90 | 363 +++++++
cdfbci.f90 | 197 ++++
cdfbn2-full.f90 | 153 +++
cdfbn2.f90 | 147 +++
cdfbottom.f90 | 150 +++
cdfbottomsig0.f90 | 114 +++
cdfbottomsigi.f90 | 117 +++
cdfbti.f90 | 239 +++++
cdfbuoyflx.f90 | 285 ++++++
cdfcensus.f90 | 328 +++++++
cdfclip.f90 | 232 +++++
cdfcofdis.f90 | 303 ++++++
cdfcofpoint.f90 | 128 +++
cdfcoloc.f90 | 306 ++++++
cdfcoloc2.f90 | 332 +++++++
cdfcoloc2D.f90 | 239 +++++
cdfcoloc3.f90 | 345 +++++++
cdfconvert.f90 | 546 +++++++++++
cdfcsp.f90 | 111 +++
cdfcurl.f90 | 174 ++++
cdfdifmask.f90 | 102 ++
cdfeke.f90 | 104 ++
cdfets.f90 | 240 +++++
cdffindij.f90 | 322 ++++++
cdfflxconv.f90 | 574 +++++++++++
cdfgeo-uv.f90 | 163 ++++
cdfheatc-full.f90 | 171 ++++
cdfheatc.f90 | 171 ++++
cdfhflx.f90 | 249 +++++
cdficediags.f90 | 227 +++++
cdfimprovechk.f90 | 120 +++
cdfio.f90 | 1938 +++++++++++++++++++++++++++++++++++++
cdfisopycdep.f90 | 182 ++++
cdfkempemekeepe.f90 | 133 +++
cdflinreg.f90 | 250 +++++
cdflspv.f90 | 157 +++
cdfmasstrp-full.f90 | 469 +++++++++
cdfmasstrp.f90 | 469 +++++++++
cdfmax-test.f90 | 285 ++++++
cdfmax.f90 | 287 ++++++
cdfmax_sp.f90 | 288 ++++++
cdfmaxmoc.f90 | 221 +++++
cdfmean-full.f90 | 173 ++++
cdfmean.f90 | 283 ++++++
cdfmeanvar.f90 | 184 ++++
cdfmhst-full.f90 | 359 +++++++
cdfmhst.f90 | 365 +++++++
cdfmht_gsop.f90 | 523 ++++++++++
cdfmkmask-zone.f90 | 142 +++
cdfmkmask.f90 | 122 +++
cdfmltmask.f90 | 152 +++
cdfmoc-full.f90 | 201 ++++
cdfmoc.f90 | 211 ++++
cdfmoc_gsop.f90 | 424 ++++++++
cdfmoc_gsop_x.f90 | 507 ++++++++++
cdfmocatl.f90 | 156 +++
cdfmocsig-full.f90 | 247 +++++
cdfmocsig.f90 | 251 +++++
cdfmoy.f90 | 194 ++++
cdfmoy3.f90 | 261 +++++
cdfmoy_annual.f90 | 143 +++
cdfmoy_chsp.f90 | 198 ++++
cdfmoy_freq.f90 | 196 ++++
cdfmoy_mpp.f90 | 282 ++++++
cdfmoy_sal2_temp2.f90 | 169 ++++
cdfmoy_sp.f90 | 196 ++++
cdfmoyt.f90 | 196 ++++
cdfmoyuv.f90 | 193 ++++
cdfmoyuvwt.f90 | 328 +++++++
cdfmsk.f90 | 60 ++
cdfmsksal.f90 | 78 ++
cdfmxl-full.f90 | 181 ++++
cdfmxl.f90 | 184 ++++
cdfmxlhcsc.f90 | 263 +++++
cdfmxlheatc-full.f90 | 138 +++
cdfmxlheatc.f90 | 136 +++
cdfmxlsaltc.f90 | 133 +++
cdfnrjcomp.f90 | 169 ++++
cdfpendep.f90 | 99 ++
cdfpolymask.f90 | 132 +++
cdfprobe.f90 | 41 +
cdfprofile.f90 | 69 ++
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 | 158 +++
cdfpv.f90 | 205 ++++
cdfpvor.f90 | 237 +++++
cdfrhoproj.f90 | 249 +++++
cdfrmsssh.f90 | 92 ++
cdfsections.f90 | 899 +++++++++++++++++
cdfsig0.f90 | 112 +++
cdfsigi.f90 | 121 +++
cdfsiginsitu.f90 | 110 +++
cdfsigintegr.f90 | 281 ++++++
cdfsigitrp.f90 | 461 +++++++++
cdfsigtrp-full.f90 | 449 +++++++++
cdfsigtrp.f90 | 554 +++++++++++
cdfsigtrp2.f90 | 394 ++++++++
cdfsmooth.f90 | 376 +++++++
cdfspeed.f90 | 146 +++
cdfsstconv.f90 | 576 +++++++++++
cdfstatcoord.f90 | 79 ++
cdfstd.f90 | 160 +++
cdfstdevts.f90 | 110 +++
cdfstdevw.f90 | 92 ++
cdfstrconv.f90 | 287 ++++++
cdfsum.f90 | 190 ++++
cdftemptrp-full.f90 | 425 ++++++++
cdftempvol-full.f90 | 335 +++++++
cdftransportiz-full.f90 | 506 ++++++++++
cdftransportiz.f90 | 641 ++++++++++++
cdftransportiz_noheat.f90 | 510 ++++++++++
cdftransportizpm.f90 | 549 +++++++++++
cdftrp_bathy.f90 | 153 +++
cdftrp_gaelle.f90 | 364 +++++++
cdfvT.f90 | 223 +++++
cdfvar.f90 | 372 +++++++
cdfvertmean.f90 | 189 ++++
cdfvhst-full.f90 | 172 ++++
cdfvhst.f90 | 175 ++++
cdfvita.f90 | 154 +++
cdfvsig.f90 | 258 +++++
cdfvtrp.f90 | 138 +++
cdfw.f90 | 151 +++
cdfweight.f90 | 542 +++++++++++
cdfweight2D.f90 | 516 ++++++++++
cdfwflx.f90 | 134 +++
cdfwhereij.f90 | 86 ++
cdfzeromean.f90 | 239 +++++
cdfzonalmean.f90 | 286 ++++++
cdfzonalout.f90 | 104 ++
cdfzonalsum.f90 | 273 ++++++
cdfzoom.f90 | 212 ++++
coordinates2hgr.f90 | 277 ++++++
coordinates2hgr_karine.f90 | 282 ++++++
coordinates2zgr.f90 | 239 +++++
coordinates2zgr_karine.f90 | 244 +++++
eos.f90 | 340 +++++++
macro.g95 | 19 +
macro.gorgon | 7 +
macro.ifort | 16 +
macro.ifort_ursus | 13 +
macro.jade | 14 +
macro.mac | 17 +
macro.mirage | 12 +
macro.nymphea | 12 +
macro.p630 | 14 +
macro.pgi | 13 +
macro.porzig | 13 +
macro.rhodes | 15 +
macro.sx8 | 17 +
macro.vargas | 15 +
macro.zahir | 16 +
mkupdate | 2 +
modpoly.f90 | 338 +++++++
section.dat | 57 ++
tag | 5 +
252 files changed, 47048 insertions(+)
diff --git a/DOC/cdftools_prog.pdf b/DOC/cdftools_prog.pdf
new file mode 100644
index 0000000..b9f3653
Binary files /dev/null and b/DOC/cdftools_prog.pdf differ
diff --git a/DOC/cdftools_user.pdf b/DOC/cdftools_user.pdf
new file mode 100644
index 0000000..4504599
Binary files /dev/null and b/DOC/cdftools_user.pdf differ
diff --git a/JOBS/MKMTL/gib.ksh b/JOBS/MKMTL/gib.ksh
new file mode 100755
index 0000000..5306eed
--- /dev/null
+++ b/JOBS/MKMTL/gib.ksh
@@ -0,0 +1,34 @@
+#!/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
new file mode 100755
index 0000000..7a2f0d6
--- /dev/null
+++ b/JOBS/MKMTL/heat.ksh
@@ -0,0 +1,78 @@
+#!/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
new file mode 100755
index 0000000..4ce06d7
--- /dev/null
+++ b/JOBS/MKMTL/ice.ksh
@@ -0,0 +1,37 @@
+#!/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
new file mode 100755
index 0000000..7320da0
--- /dev/null
+++ b/JOBS/MKMTL/ice_month.ksh
@@ -0,0 +1,65 @@
+#!/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
new file mode 100755
index 0000000..9f9b9d4
--- /dev/null
+++ b/JOBS/MKMTL/maxmoc.ksh
@@ -0,0 +1,72 @@
+#!/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
new file mode 100755
index 0000000..2fa07b5
--- /dev/null
+++ b/JOBS/MKMTL/maxmoc40.ksh
@@ -0,0 +1,49 @@
+#!/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
new file mode 100755
index 0000000..e6b47b7
--- /dev/null
+++ b/JOBS/MKMTL/mkmtl.ksh
@@ -0,0 +1,66 @@
+#!/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
new file mode 100755
index 0000000..cbead37
--- /dev/null
+++ b/JOBS/MKMTL/nino.ksh
@@ -0,0 +1,9 @@
+#!/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
new file mode 100755
index 0000000..be6ce6c
--- /dev/null
+++ b/JOBS/MKMTL/profile.ksh
@@ -0,0 +1,69 @@
+#!/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
new file mode 100755
index 0000000..3eb4ff1
--- /dev/null
+++ b/JOBS/MKMTL/profile_lev.ksh
@@ -0,0 +1,93 @@
+#!/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
new file mode 100755
index 0000000..0cbcc04
--- /dev/null
+++ b/JOBS/MKMTL/section.ksh
@@ -0,0 +1,57 @@
+#!/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
new file mode 100755
index 0000000..f9fa78f
--- /dev/null
+++ b/JOBS/MKMTL/trc.ksh
@@ -0,0 +1,75 @@
+#!/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
new file mode 100755
index 0000000..6a4ba21
--- /dev/null
+++ b/JOBS/MKMTL/trpsig.ksh
@@ -0,0 +1,40 @@
+#!/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
new file mode 100755
index 0000000..0998a4c
--- /dev/null
+++ b/JOBS/cdf16bit.ll
@@ -0,0 +1,24 @@
+#!/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
new file mode 100755
index 0000000..68a5893
--- /dev/null
+++ b/JOBS/cdfbn2.ll
@@ -0,0 +1,45 @@
+#!/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
new file mode 100755
index 0000000..60aede1
--- /dev/null
+++ b/JOBS/cdfbuoyflx.ksh
@@ -0,0 +1,33 @@
+#!/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
new file mode 100755
index 0000000..9ef3bf1
--- /dev/null
+++ b/JOBS/cdfeke-inter.ll
@@ -0,0 +1,42 @@
+#!/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
new file mode 100755
index 0000000..94a3852
--- /dev/null
+++ b/JOBS/cdfeke.ll
@@ -0,0 +1,43 @@
+#!/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
new file mode 100755
index 0000000..cb22085
--- /dev/null
+++ b/JOBS/cdfets.ll
@@ -0,0 +1,45 @@
+#!/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
new file mode 100644
index 0000000..f2595fe
--- /dev/null
+++ b/JOBS/cdfflxconv.ll
@@ -0,0 +1,100 @@
+#!/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
new file mode 100644
index 0000000..0be031e
--- /dev/null
+++ b/JOBS/cdfgib.ll
@@ -0,0 +1,55 @@
+#!/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
new file mode 100755
index 0000000..b30041e
--- /dev/null
+++ b/JOBS/cdfhflx.ll
@@ -0,0 +1,45 @@
+#!/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
new file mode 100755
index 0000000..dc579d5
--- /dev/null
+++ b/JOBS/cdfice.ll
@@ -0,0 +1,54 @@
+#!/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
new file mode 100755
index 0000000..2487c47
--- /dev/null
+++ b/JOBS/cdfmaxmoc.ll
@@ -0,0 +1,72 @@
+#!/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
new file mode 100755
index 0000000..4158fbf
--- /dev/null
+++ b/JOBS/cdfmaxmoc40.ll
@@ -0,0 +1,27 @@
+#!/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
new file mode 100755
index 0000000..c02682d
--- /dev/null
+++ b/JOBS/cdfmeanvar.ll
@@ -0,0 +1,57 @@
+#!/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
new file mode 100644
index 0000000..885fc6f
--- /dev/null
+++ b/JOBS/cdfmeanvar.log
@@ -0,0 +1,10 @@
+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
new file mode 100755
index 0000000..a632708
--- /dev/null
+++ b/JOBS/cdfmhst-full.ll
@@ -0,0 +1,50 @@
+#!/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
new file mode 100755
index 0000000..abb3049
--- /dev/null
+++ b/JOBS/cdfmhst.ll
@@ -0,0 +1,50 @@
+#!/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
new file mode 100755
index 0000000..27851ed
--- /dev/null
+++ b/JOBS/cdfmoc-full.ll
@@ -0,0 +1,45 @@
+#!/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
new file mode 100755
index 0000000..f1a69be
--- /dev/null
+++ b/JOBS/cdfmoc-inter.ll
@@ -0,0 +1,49 @@
+#!/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
new file mode 100755
index 0000000..3f9a73a
--- /dev/null
+++ b/JOBS/cdfmoc.ll
@@ -0,0 +1,49 @@
+#!/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
new file mode 100755
index 0000000..ece679e
--- /dev/null
+++ b/JOBS/cdfmoy-ets.ll
@@ -0,0 +1,46 @@
+#!/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
new file mode 100755
index 0000000..a98c844
--- /dev/null
+++ b/JOBS/cdfmoy-inter.ll
@@ -0,0 +1,258 @@
+#!/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.ll b/JOBS/cdfmoy.ll
new file mode 100755
index 0000000..8637b15
--- /dev/null
+++ b/JOBS/cdfmoy.ll
@@ -0,0 +1,323 @@
+#!/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_multiple.ksh b/JOBS/cdfmoy_multiple.ksh
new file mode 100755
index 0000000..67cfff3
--- /dev/null
+++ b/JOBS/cdfmoy_multiple.ksh
@@ -0,0 +1,78 @@
+#!/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
new file mode 100755
index 0000000..2d2d9e0
--- /dev/null
+++ b/JOBS/cdfmoy_skel_new.ksh
@@ -0,0 +1,108 @@
+#!/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%
+
+
+#################################################################################
+# 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
new file mode 100755
index 0000000..ba23a68
--- /dev/null
+++ b/JOBS/cdfmoy_skel_vargas.ksh
@@ -0,0 +1,80 @@
+#!/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
new file mode 100755
index 0000000..77ccb1a
--- /dev/null
+++ b/JOBS/cdfmoy_trc_skel_new.ksh
@@ -0,0 +1,102 @@
+#!/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
new file mode 100755
index 0000000..66cd849
--- /dev/null
+++ b/JOBS/cdfmoymxl.ll
@@ -0,0 +1,48 @@
+#!/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
new file mode 100755
index 0000000..93d9cf1
--- /dev/null
+++ b/JOBS/cdfmoyvt_jade_new.ksh
@@ -0,0 +1,139 @@
+#!/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=02:30: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/.
+ 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 ;
+
+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
new file mode 100755
index 0000000..37f61c3
--- /dev/null
+++ b/JOBS/cdfmoyvt_skel_new.ksh
@@ -0,0 +1,328 @@
+#!/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
new file mode 100755
index 0000000..347b263
--- /dev/null
+++ b/JOBS/cdfmxl.ll
@@ -0,0 +1,44 @@
+#!/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
new file mode 100755
index 0000000..4f2ddd4
--- /dev/null
+++ b/JOBS/cdfpsi-inter.ll
@@ -0,0 +1,44 @@
+#!/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
new file mode 100755
index 0000000..60f7697
--- /dev/null
+++ b/JOBS/cdfpsi.ll
@@ -0,0 +1,49 @@
+#!/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
new file mode 100755
index 0000000..3a84f4a
--- /dev/null
+++ b/JOBS/cdfrms.ll
@@ -0,0 +1,51 @@
+#!/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
new file mode 100755
index 0000000..c3961ab
--- /dev/null
+++ b/JOBS/cdfsigma0.ll
@@ -0,0 +1,43 @@
+#!/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
new file mode 100755
index 0000000..45ea194
--- /dev/null
+++ b/JOBS/cdfsigtrp_1month.ll
@@ -0,0 +1,82 @@
+#!/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
new file mode 100644
index 0000000..3d7601e
--- /dev/null
+++ b/JOBS/cdfsstconv.ll
@@ -0,0 +1,101 @@
+#!/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
new file mode 100644
index 0000000..c9d8208
--- /dev/null
+++ b/JOBS/cdfstrconv.ll
@@ -0,0 +1,86 @@
+#!/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
new file mode 100755
index 0000000..81d3e60
--- /dev/null
+++ b/JOBS/cdftransportiz-full.ll
@@ -0,0 +1,52 @@
+#!/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
new file mode 100755
index 0000000..b09af4d
--- /dev/null
+++ b/JOBS/cdftransportiz.ll
@@ -0,0 +1,56 @@
+#!/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
new file mode 100755
index 0000000..d4f8565
--- /dev/null
+++ b/JOBS/cdftrc.ll
@@ -0,0 +1,81 @@
+#!/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
new file mode 100755
index 0000000..fbc26da
--- /dev/null
+++ b/JOBS/cdfvT-inter.ll
@@ -0,0 +1,57 @@
+#!/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
new file mode 100755
index 0000000..6d35a33
--- /dev/null
+++ b/JOBS/cdfvT.ll
@@ -0,0 +1,108 @@
+#!/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_skel_new.ksh b/JOBS/cdfvT_skel_new.ksh
new file mode 100755
index 0000000..2c6596f
--- /dev/null
+++ b/JOBS/cdfvT_skel_new.ksh
@@ -0,0 +1,108 @@
+#!/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%
+
+
+#################################################################################
+# 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
+
+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
new file mode 100755
index 0000000..1b18d0f
--- /dev/null
+++ b/JOBS/cdfvT_skel_vargas.ksh
@@ -0,0 +1,80 @@
+#!/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
new file mode 100755
index 0000000..9482846
--- /dev/null
+++ b/JOBS/cdfvhst-full.ll
@@ -0,0 +1,56 @@
+#!/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
new file mode 100755
index 0000000..3dd13bc
--- /dev/null
+++ b/JOBS/cdfvhst.ll
@@ -0,0 +1,57 @@
+#!/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
new file mode 100755
index 0000000..07dccbc
--- /dev/null
+++ b/JOBS/cdfvsig_skel.ksh
@@ -0,0 +1,92 @@
+#!/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
new file mode 100755
index 0000000..842eacf
--- /dev/null
+++ b/JOBS/cdfwflx.ksh
@@ -0,0 +1,30 @@
+#!/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
new file mode 100644
index 0000000..abae873
--- /dev/null
+++ b/JOBS/config_def_ORCA025_zahir.ksh
@@ -0,0 +1,23 @@
+#!/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
new file mode 100644
index 0000000..9b5351c
--- /dev/null
+++ b/JOBS/config_def_SKEL_brodie.ksh
@@ -0,0 +1,24 @@
+#!/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
new file mode 100644
index 0000000..2d21a23
--- /dev/null
+++ b/JOBS/config_def_SKEL_jade.ksh
@@ -0,0 +1,33 @@
+#!/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
new file mode 100644
index 0000000..215ea4c
--- /dev/null
+++ b/JOBS/config_def_SKEL_mirage.ksh
@@ -0,0 +1,24 @@
+#!/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
new file mode 100644
index 0000000..923332c
--- /dev/null
+++ b/JOBS/config_def_SKEL_zahir.ksh
@@ -0,0 +1,24 @@
+#!/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
new file mode 100755
index 0000000..f2ddc96
--- /dev/null
+++ b/JOBS/convclipper2nc.ksh
@@ -0,0 +1,53 @@
+#!/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/function_def_jade.ksh b/JOBS/function_def_jade.ksh
new file mode 100644
index 0000000..c0a0509
--- /dev/null
+++ b/JOBS/function_def_jade.ksh
@@ -0,0 +1,123 @@
+#!/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
new file mode 100644
index 0000000..ac9a723
--- /dev/null
+++ b/JOBS/function_def_mirage.ksh
@@ -0,0 +1,82 @@
+#!/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
new file mode 100755
index 0000000..3ab0abf
--- /dev/null
+++ b/JOBS/function_def_vargas.ksh
@@ -0,0 +1,84 @@
+#!/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
new file mode 100644
index 0000000..65ded81
--- /dev/null
+++ b/JOBS/function_def_zahir.ksh
@@ -0,0 +1,84 @@
+#!/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
new file mode 100644
index 0000000..6f77f35
--- /dev/null
+++ b/JOBS/icemonth.ksh
@@ -0,0 +1,61 @@
+# 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
new file mode 100644
index 0000000..a03c97e
--- /dev/null
+++ b/JOBS/meta-moy-mon.skel.ll
@@ -0,0 +1,34 @@
+#!/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
new file mode 100644
index 0000000..fa4c652
--- /dev/null
+++ b/JOBS/metamon
@@ -0,0 +1,72 @@
+#!/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
new file mode 100644
index 0000000..7f457cd
--- /dev/null
+++ b/JOBS/metamon_skel_vargas.ksh
@@ -0,0 +1,79 @@
+#!/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
new file mode 100755
index 0000000..2da3cdc
--- /dev/null
+++ b/JOBS/metamoy.ksh
@@ -0,0 +1,36 @@
+#!/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/mkordre b/JOBS/mkordre
new file mode 100755
index 0000000..2ef612f
--- /dev/null
+++ b/JOBS/mkordre
@@ -0,0 +1,32 @@
+#!/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; 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/monitor.csh b/JOBS/monitor.csh
new file mode 100755
index 0000000..02947af
--- /dev/null
+++ b/JOBS/monitor.csh
@@ -0,0 +1,365 @@
+#!/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
new file mode 100755
index 0000000..1ed7040
--- /dev/null
+++ b/JOBS/monitor_noheat.csh
@@ -0,0 +1,255 @@
+#!/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
new file mode 100755
index 0000000..8678bde
--- /dev/null
+++ b/JOBS/monitor_prod.ksh
@@ -0,0 +1,642 @@
+#!/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
new file mode 100755
index 0000000..58c2c93
--- /dev/null
+++ b/JOBS/monitor_prod_jade.ksh
@@ -0,0 +1,529 @@
+#!/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
+############################################################################################
+############################################################################################
+#=============================================================================
+# 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
new file mode 100755
index 0000000..cc3e88c
--- /dev/null
+++ b/JOBS/monitor_prod_kiel.ksh
@@ -0,0 +1,955 @@
+#!/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_testOK_jade.ksh b/JOBS/monitor_testOK_jade.ksh
new file mode 100755
index 0000000..5055d4b
--- /dev/null
+++ b/JOBS/monitor_testOK_jade.ksh
@@ -0,0 +1,7 @@
+#!/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
new file mode 100644
index 0000000..41b2968
--- /dev/null
+++ b/JOBS/testOK.ksh
@@ -0,0 +1,7 @@
+#!/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
new file mode 100755
index 0000000..062c6d5
--- /dev/null
+++ b/JOBS/trpsig_postproc.ksh
@@ -0,0 +1,90 @@
+#!/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/Makefile b/Makefile
new file mode 100644
index 0000000..bfec060
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,496 @@
+# 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 cdfmoyt cdfmoy_sp cdfstd cdfmoy_sal2_temp2 cdfmoy_annual cdfmoy_chsp cdfmoy_freq cdfvT cdfvsig cdfspeed cdfsum\
+ cdfmoyuv cdfmoyuvwt \
+ cdfeke cdfrmsssh cdfstdevw cdfstdevts cdflinreg cdfimprovechk\
+ cdfbn2 cdfbn2-full cdfsig0 cdfsigi cdfsiginsitu cdfbottomsig0 cdfbottomsigi cdfbottom cdfets cdfcurl cdfw cdfgeo-uv cdfmxl cdfmxl-full\
+ cdfrhoproj cdfisopycdep cdfsigintegr cdfpv cdflspv cdfpvor\
+ cdfmhst cdfmhst-full cdfvhst cdfvhst-full cdftransportiz cdftransportiz_noheat 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\
+ cdfpendep cdfzonalsum cdficediags cdfzonalout\
+ cdfprofile cdfwhereij cdffindij cdfweight cdfmaxmoc cdfcensus cdfzoom cdfmax cdfmax_sp cdfprobe \
+ bimgmoy4 bimgcaltrans cdf16bit cdfvita cdfconvert cdfflxconv cdfclip cdfsstconv cdfstrconv cdfbathy cdfvar cdfmkmask-zone\
+ cdfcsp cdfcoloc cdfmltmask cdfstatcoord cdfpolymask cdfsmooth cdfmkmask cdfdifmask\
+ cdfkempemekeepe cdfbci cdfbti cdfnrjcomp cdfcofdis cdfsections
+
+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)
+
+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)
+
+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)
+
+cdfmoyuvwt: cdfio.o cdfmoyuvwt.f90
+ $(F90) cdfmoyuvwt.f90 -o cdfmoyuvwt cdfio.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)
+
+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)
+
+cdfvsig: cdfio.o eos.o cdfvsig.f90
+ $(F90) cdfvsig.f90 -o cdfvsig cdfio.o eos.o $(FFLAGS)
+
+cdfspeed: cdfio.o cdfspeed.f90
+ $(F90) cdfspeed.f90 -o cdfspeed cdfio.o $(FFLAGS)
+
+cdfimprovechk: cdfio.o cdfimprovechk.f90
+ $(F90) cdfimprovechk.f90 -o cdfimprovechk cdfio.o $(FFLAGS)
+
+cdflinreg: cdfio.o cdflinreg.f90
+ $(F90) cdflinreg.f90 -o cdflinreg cdfio.o $(FFLAGS)
+
+## Derived quantities programs
+cdfbn2: cdfio.o eos.o cdfbn2.f90
+ $(F90) cdfbn2.f90 -o cdfbn2 cdfio.o eos.o $(FFLAGS)
+
+cdfbn2-full: cdfio.o eos.o cdfbn2-full.f90
+ $(F90) cdfbn2-full.f90 -o cdfbn2-full cdfio.o eos.o $(FFLAGS)
+
+cdfsig0: cdfio.o eos.o cdfsig0.f90
+ $(F90) cdfsig0.f90 -o cdfsig0 cdfio.o eos.o $(FFLAGS)
+
+cdfsigi: cdfio.o eos.o cdfsigi.f90
+ $(F90) cdfsigi.f90 -o cdfsigi cdfio.o eos.o $(FFLAGS)
+
+cdfsiginsitu: cdfio.o eos.o cdfsiginsitu.f90
+ $(F90) cdfsiginsitu.f90 -o cdfsiginsitu cdfio.o eos.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)
+
+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)
+
+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)
+
+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)
+
+cdfdifmask: cdfio.o cdfdifmask.f90
+ $(F90) cdfdifmask.f90 -o cdfdifmask 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)
+
+cdfgeo-uv: cdfio.o cdfgeo-uv.f90
+ $(F90) cdfgeo-uv.f90 -o cdfgeo-uv cdfio.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)
+
+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)
+
+cdfpv: cdfio.o cdfpv.f90
+ $(F90) cdfpv.f90 -o cdfpv cdfio.o eos.o $(FFLAGS)
+
+cdflspv: cdfio.o cdflspv.f90
+ $(F90) cdflspv.f90 -o cdflspv cdfio.o eos.o $(FFLAGS)
+
+cdfpvor: cdfio.o cdfpvor.f90
+ $(F90) cdfpvor.f90 -o cdfpvor cdfio.o eos.o $(FFLAGS)
+
+cdfkempemekeepe: cdfio.o cdfkempemekeepe.f90
+ $(F90) cdfkempemekeepe.f90 -o cdfkempemekeepe cdfio.o $(FFLAGS)
+
+cdfbci: cdfio.o cdfbci.f90
+ $(F90) cdfbci.f90 -o cdfbci cdfio.o $(FFLAGS)
+
+cdfbti: cdfio.o cdfbti.f90
+ $(F90) cdfbti.f90 -o cdfbti cdfio.o $(FFLAGS)
+
+cdfnrjcomp: cdfio.o cdfnrjcomp.f90
+ $(F90) cdfnrjcomp.f90 -o cdfnrjcomp cdfio.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)
+
+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)
+
+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)
+
+cdftransportiz: cdfio.o cdftransportiz.f90
+ $(F90) cdftransportiz.f90 -o cdftransportiz 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-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-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)
+
+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)
+
+cdfmoc_gsop: cdfio.o eos.o cdfmoc_gsop.f90
+ $(F90) cdfmoc_gsop.f90 -o cdfmoc_gsop cdfio.o eos.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)
+
+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)
+
+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)
+
+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)
+
+cdfzeromean: cdfio.o cdfzeromean.f90
+ $(F90) cdfzeromean.f90 -o cdfzeromean cdfio.o $(FFLAGS)
+
+cdfheatc: cdfio.o cdfheatc.f90
+ $(F90) cdfheatc.f90 -o cdfheatc cdfio.o $(FFLAGS)
+
+cdfheatc-full: cdfio.o cdfheatc-full.f90
+ $(F90) cdfheatc-full.f90 -o cdfheatc-full cdfio.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)
+
+cdfmxlhcsc: cdfio.o eos.o cdfmxlhcsc.f90
+ $(F90) cdfmxlhcsc.f90 -o cdfmxlhcsc cdfio.o eos.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)
+
+cdfwflx: cdfio.o cdfwflx.f90
+ $(F90) cdfwflx.f90 -o cdfwflx cdfio.o $(FFLAGS)
+
+cdfbuoyflx: cdfio.o eos.o cdfbuoyflx.f90
+ $(F90) cdfbuoyflx.f90 -o cdfbuoyflx cdfio.o eos.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)
+
+cdfweight: cdfio.o cdfweight.f90
+ $(F90) cdfweight.f90 -o cdfweight cdfio.o $(FFLAGS)
+
+cdfweight2D: cdfio.o cdfweight2D.f90
+ $(F90) cdfweight2D.f90 -o cdfweight2D cdfio.o $(FFLAGS)
+
+cdfcoloc: cdfio.o cdfcoloc.f90
+ $(F90) cdfcoloc.f90 -o cdfcoloc cdfio.o $(FFLAGS)
+
+cdfcoloc2D: cdfio.o cdfcoloc2D.f90
+ $(F90) cdfcoloc2D.f90 -o cdfcoloc2D cdfio.o $(FFLAGS)
+
+cdfcoloc2: cdfio.o cdfcoloc2.f90
+ $(F90) cdfcoloc2.f90 -o cdfcoloc2 cdfio.o $(FFLAGS)
+
+cdfcoloc3: cdfio.o cdfcoloc3.f90
+ $(F90) cdfcoloc3.f90 -o cdfcoloc3 cdfio.o $(FFLAGS)
+
+cdfstatcoord: cdfio.o cdfstatcoord.f90
+ $(F90) cdfstatcoord.f90 -o cdfstatcoord 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)
+
+cdfmax_sp: cdfio.o cdfmax_sp.f90
+ $(F90) cdfmax_sp.f90 -o cdfmax_sp cdfio.o $(FFLAGS)
+
+cdfprobe: cdfio.o cdfprobe.f90
+ $(F90) cdfprobe.f90 -o cdfprobe cdfio.o $(FFLAGS)
+
+cdfclip: cdfio.o cdfclip.f90
+ $(F90) cdfclip.f90 -o cdfclip cdfio.o $(FFLAGS)
+
+cdfsmooth: cdfio.o cdfsmooth.f90
+ $(F90) cdfsmooth.f90 -o cdfsmooth cdfio.o $(FFLAGS)
+
+cdfpendep: cdfio.o cdfpendep.f90
+ $(F90) cdfpendep.f90 -o cdfpendep cdfio.o $(FFLAGS)
+
+cdfzgrv3: cdfio.o cdfzgrv3.f90
+ $(F90) cdfzgrv3.f90 -o cdfzgrv3 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)
+
+cdftrp_bathy: cdfio.o cdftrp_bathy.f90
+ $(F90) cdftrp_bathy.f90 -o cdftrp_bathy cdfio.o $(FFLAGS)
+
+cdfconvert: cdfio.o cdfconvert.f90
+ $(F90) cdfconvert.f90 -o cdfconvert cdfio.o $(FFLAGS)
+
+cdfflxconv: cdfio.o cdfflxconv.f90
+ $(F90) cdfflxconv.f90 -o cdfflxconv cdfio.o $(FFLAGS)
+
+cdfsstconv: cdfio.o cdfsstconv.f90
+ $(F90) cdfsstconv.f90 -o cdfsstconv cdfio.o $(FFLAGS)
+
+cdfstrconv: cdfio.o cdfstrconv.f90
+ $(F90) cdfstrconv.f90 -o cdfstrconv cdfio.o $(FFLAGS)
+
+cdfbathy: cdfio.o cdfbathy.f90
+ $(F90) cdfbathy.f90 -o cdfbathy cdfio.o $(FFLAGS)
+
+cdfcofdis: cdfio.o cdfcofdis.f90
+ $(F90) cdfcofdis.f90 -o cdfcofdis cdfio.o $(FFLAGS)
+
+cdfcoastline: cdfio.o cdfcoastline.f90
+ $(F90) cdfcoastline.f90 -o cdfcoastline cdfio.o $(FFLAGS)
+
+cdfvar: cdfio.o cdfvar.f90
+ $(F90) cdfvar.f90 -o cdfvar cdfio.o $(FFLAGS)
+
+cdfcsp: cdfio.o cdfcsp.f90
+ $(F90) cdfcsp.f90 -o cdfcsp cdfio.o $(FFLAGS)
+
+cdfpolymask: cdfio.o modpoly.o cdfpolymask.f90
+ $(F90) cdfpolymask.f90 -o cdfpolymask cdfio.o modpoly.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)
+
+## Modules
+
+cdfio.o: cdfio.f90
+ $(F90) -c cdfio.f90 $(FFLAGS)
+
+eos.o: eos.f90
+ $(F90) -c eos.f90 $(FFLAGS)
+
+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.* )
+
+clean:
+ \rm -f *.mod *.o *~
+
+cleanexe: clean
+ \rm -f $(EXEC)
+
+install:
+ \cp $(EXEC) $(INSTALL)
diff --git a/Makefile_ursus b/Makefile_ursus
new file mode 100644
index 0000000..fa33133
--- /dev/null
+++ b/Makefile_ursus
@@ -0,0 +1,241 @@
+# 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
new file mode 100644
index 0000000..0d7d390
--- /dev/null
+++ b/bimgcaltrans.f90
@@ -0,0 +1,68 @@
+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
new file mode 100644
index 0000000..2bbc684
--- /dev/null
+++ b/bimgmoy4.f90
@@ -0,0 +1,334 @@
+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
new file mode 100644
index 0000000..d7dbf4e
--- /dev/null
+++ b/cdf16bit.f90
@@ -0,0 +1,536 @@
+PROGRAM cdf16bit
+ !!-----------------------------------------------------------------------
+ !! *** PROGRAM cdf16bit ***
+ !!
+ !! ** 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.
+ !! 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
+ USE cdfio
+
+ !! * Local variables
+ 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()
+ 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.'
+ STOP
+ ENDIF
+ !!
+ CALL getarg (1, cfile)
+
+ ! 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
+ l_chk=.true.
+ ELSE IF ( cdum == '-verbose' ) THEN
+ l_chk=.true. ; l_verbose=.true.
+ ELSE
+ PRINT *,' OPTION ',TRIM(cdum),' not supported.' ; STOP
+ ENDIF
+ END DO
+ ENDIF
+
+ ! get domain dimension from input file
+ 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
+
+ ! Allocate memory
+ ALLOCATE( v2d(npiglo,npjglo), i2d(npiglo,npjglo), lmask(npiglo, npjglo) )
+ ALLOCATE( zmin(npk) , zmax(npk) )
+
+ ! Get the number of variables held in the file, allocate arrays
+ 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)
+
+ ! flags variable not to be treated by changing their name to none
+ WHERE( ipk == 0 ) cvarname='none'
+ typvar(:)%name=cvarname
+
+ ! 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)
+ END DO
+
+ ! create output file taking the sizes in cfile
+ ncout =create(cfileout, cfile,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)
+
+ ! Get time and write time
+ tim=getvar1d(cfile,'time_counter',1) ; ierr=putvar1d(ncout,tim,1,'T')
+ ! Loop on all variables of the file
+ DO jvar = 1,nvars
+ IF (cvarname(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
+ END IF
+ END DO ! loop to next var in file
+
+ istatus = closeout(ncout)
+
+ 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
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ ! 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.
+
+ 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.
+
+ ! 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.
+
+ 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.
+
+ ! 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.
+
+ 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.
+
+ !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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ 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.
+
+ ! 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.
+
+ CASE ('bombc14') ! Concentration tracer 1
+ zvmin= 0. ; zvmax = 0.0001
+ typvar(kvar)%add_offset=0.
+ typvar(kvar)%scale_factor= 1.
+ typvar(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
+ 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
+ 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)
+ 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
+ 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
+ END IF ! last level
+ END IF ! check mode
+ END SUBROUTINE checkscaling
+
+END PROGRAM cdf16bit
diff --git a/cdfbathy.f90 b/cdfbathy.f90
new file mode 100644
index 0000000..6d94630
--- /dev/null
+++ b/cdfbathy.f90
@@ -0,0 +1,363 @@
+PROGRAM cdfbathy
+ !!----------------------------------------------------------------------------
+ !! *** PROGRAM cdfbathy ***
+ !!
+ !! ** Purpose: Locally transform a bathy_meter file into a z-step like bathy
+ !!
+ !! ** 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
+ USE cdfio
+
+ ! * Local Variable
+ 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.
+ 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) :: cvar='none', cdim
+
+ 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 :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, ' -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, ' -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 ) '
+ 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
+ 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,'Bathymetry',1, npiglo,npjglo)
+ 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,'Bathymetry',1,imax-imin+1,jmax-jmin+1,kimin=imin,kjmin=jmin,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 cdfbathy
diff --git a/cdfbci.f90 b/cdfbci.f90
new file mode 100644
index 0000000..13203c1
--- /dev/null
+++ b/cdfbci.f90
@@ -0,0 +1,197 @@
+PROGRAM cdfbci
+ !!---------------------------------------------------------------------------
+ !! *** PROGRAM cdfbci ***
+ !!
+ !! ** 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
+ !!
+ !! history :
+ !! Original : A. Melet (Feb 2008)
+ !!---------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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
+
+ !!
+ 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)'
+ 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='dTdx'
+ typvar(1)%long_name='zonal derivate of Tbar on T point (*1000)'
+ typvar(1)%short_name='dTdx'
+
+ typvar(2)%name='dTdy'
+ typvar(2)%long_name='meridional derivate of Tbar on T point (*1000)'
+ typvar(2)%short_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'
+
+ typvar(4)%name='vT'
+ typvar(4)%long_name='anomaly of v times anomaly of T on T point'
+ typvar(4)%short_name='vT'
+
+ typvar(5)%name='bci'
+ typvar(5)%long_name='transfert of energy for the baroclinic instability (*1000)'
+ typvar(5)%short_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'
+
+ ipk(:) = npk
+
+ !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,5, ipk,id_varout )
+ ierr= putheadervar(ncout, cfile, npiglo, npjglo,npk)
+
+ ! Allocate the memory
+ ALLOCATE ( e1t(npiglo,npjglo) , e2t(npiglo,npjglo) )
+ ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) )
+ ALLOCATE ( tn(npiglo,npjglo) )
+ 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 ( anout(npiglo,npjglo) , anovt(npiglo,npjglo) )
+ ALLOCATE ( bci(npiglo,npjglo) )
+
+ e1t= getvar(coord, 'e1t', 1,npiglo,npjglo)
+ e2t= getvar(coord, 'e2t', 1,npiglo,npjglo)
+
+ tim=getvar1d(cfile,'time_counter',nt)
+ ierr=putvar1d(ncout,tim,1,'T')
+
+ DO jk=1, npk
+ PRINT *,' level ',jk
+
+ dtdx(:,:) = 0.d0
+ dtdy(:,:) = 0.d0
+
+ 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)
+
+ ! 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)
+ 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.
+ END DO
+ END DO
+
+ 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) &
+ & / ( 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) &
+ & / ( 0.5* ( e2t(ji,jj+1) + e2t(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) &
+ & - 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) )
+
+ 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)
+ END DO
+ ierr = closeout(ncout)
+
+END PROGRAM cdfbci
+
diff --git a/cdfbn2-full.f90 b/cdfbn2-full.f90
new file mode 100644
index 0000000..7af629a
--- /dev/null
+++ b/cdfbn2-full.f90
@@ -0,0 +1,153 @@
+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
new file mode 100644
index 0000000..3ad7f76
--- /dev/null
+++ b/cdfbn2.f90
@@ -0,0 +1,147 @@
+PROGRAM cdfbn2
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfbn2 ***
+ !!
+ !! ** 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
+ !! 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(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 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 '
+ 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
+
+ ! 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')
+
+ 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)
+
+END PROGRAM cdfbn2
diff --git a/cdfbottom.f90 b/cdfbottom.f90
new file mode 100644
index 0000000..a8df28f
--- /dev/null
+++ b/cdfbottom.f90
@@ -0,0 +1,150 @@
+PROGRAM cdfbottom
+ !!-------------------------------------------------------------------
+ !! *** 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
+ USE cdfio
+
+ !! * 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
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar !: structure for variable attribute
+
+ INTEGER :: ncout
+ INTEGER :: istatus
+
+ !! Read command line
+ 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'
+ STOP
+ ENDIF
+
+ CALL getarg (1, cfile)
+ npiglo= getdim (cfile,'x')
+ npjglo= getdim (cfile,'y')
+ npk = getdim (cfile,'depth')
+
+ ALLOCATE (zfield(npiglo,npjglo), zbot(npiglo,npjglo),zmask(npiglo,npjglo))
+
+ IF (narg == 2 ) THEN
+ CALL getarg (2, ctype )
+
+ SELECT CASE ( ctype )
+ CASE ( 'T', 't', 'S', 's' )
+ cvmask='tmask'
+ CASE ( 'U', 'u' )
+ cvmask='umask'
+ CASE ( 'V', 'v' )
+ cvmask='vmask'
+ CASE ( 'F', 'f' )
+ cvmask='fmask'
+ PRINT *, 'Be carefull with fmask ... !!!'
+ CASE DEFAULT
+ PRINT *, ' ERROR : This type of point ', ctype,' is not known !'
+ STOP
+ END SELECT
+
+ ENDIF
+
+ ! look for the number of variables in the input file
+ nvars = getnvar(cfile)
+ PRINT *,' nvars =', nvars
+
+ ALLOCATE (cvarname(nvars) ,typvar(nvars))
+ ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars) ,ipko(nvars) )
+
+ 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)
+ ipko(:)= 1 ! all variables output are 2D
+
+ WHERE( ipk <= 1 ) cvarname='none'
+! typvar%name=cvarname
+! typvar%axis='TYX'
+ 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)
+ END DO
+ ! create output fileset
+ ! create output file taking the sizes in cfile
+
+ ncout =create(cfileout, cfile,npiglo,npjglo,1)
+
+ ierr= createvar(ncout , typvar, nvars, ipko, id_varout )
+
+ ierr= putheadervar(ncout , cfile, npiglo, npjglo, 1)
+
+ DO jvar = 1,nvars
+ zfield = 0.
+ zbot = 0.
+
+ IF (cvarname(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)
+ ENDIF
+
+ END DO
+ ierr=putvar1d(ncout,tim,1,'T')
+
+ istatus = closeout(ncout)
+END PROGRAM cdfbottom
diff --git a/cdfbottomsig0.f90 b/cdfbottomsig0.f90
new file mode 100644
index 0000000..adad2e5
--- /dev/null
+++ b/cdfbottomsig0.f90
@@ -0,0 +1,114 @@
+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
new file mode 100644
index 0000000..65deade
--- /dev/null
+++ b/cdfbottomsigi.f90
@@ -0,0 +1,117 @@
+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
new file mode 100644
index 0000000..1d31b5e
--- /dev/null
+++ b/cdfbti.f90
@@ -0,0 +1,239 @@
+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
+ !!
+ !! history :
+ !! Original : A. Melet (Feb 2008)
+ !!---------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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
+
+ !!
+ 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)'
+ 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='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
+
+ ! 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)
+
+ ! Allocate the memory
+ ALLOCATE ( e1t(npiglo,npjglo) , e1f(npiglo,npjglo) )
+ ALLOCATE ( e2t(npiglo,npjglo) , e2f(npiglo,npjglo) )
+ ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) )
+ ALLOCATE ( fmask(npiglo,npjglo) )
+ ALLOCATE ( umask(npiglo,npjglo) , vmask(npiglo,npjglo) )
+ ALLOCATE ( dudx(npiglo,npjglo) , dudy(npiglo,npjglo) )
+ ALLOCATE ( dvdx(npiglo,npjglo) , dvdy(npiglo,npjglo) )
+ ALLOCATE ( u2n(npiglo,npjglo) , v2n(npiglo,npjglo) )
+ ALLOCATE ( uvn(npiglo,npjglo) )
+ ALLOCATE ( anousqrt(npiglo,npjglo) , anovsqrt(npiglo,npjglo) )
+ ALLOCATE ( anouv(npiglo,npjglo), bti(npiglo,npjglo) )
+
+ 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.
+ 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.
+ 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) ))
+
+ END DO
+ 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
+ ierr = closeout(ncout)
+
+END PROGRAM cdfbti
+
diff --git a/cdfbuoyflx.f90 b/cdfbuoyflx.f90
new file mode 100644
index 0000000..cdb8627
--- /dev/null
+++ b/cdfbuoyflx.f90
@@ -0,0 +1,285 @@
+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)
+ !!
+ !! 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 )
+ !! (TF = thermal part, SF = haline part )
+ !! 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
+ USE cdfio
+ USE eos
+
+ !! * Local variables
+ 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
+
+
+ !! 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) '
+ STOP
+ ENDIF
+
+ CALL getarg (1, cfilet)
+ CALL getarg (2, cfiler)
+ npiglo= getdim (cfilet,'x')
+ npjglo= getdim (cfilet,'y')
+
+ ! prepare output variables
+ dep(1) = 0.
+ ipk(:)= 1 ! all variables ( output are 2D)
+ typvar%online_operation='N/A'
+ typvar%axis='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'
+
+ ! 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'
+
+ ! 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
+
+
+ ALLOCATE ( zmask(npiglo,npjglo), wnet(npiglo,npjglo), zalbet(npiglo,npjglo), zbeta(npiglo, npjglo) )
+ ALLOCATE ( zcoefq(npiglo,npjglo), zcoefw(npiglo,npjglo) )
+ ALLOCATE ( evap(npiglo,npjglo), precip(npiglo,npjglo), runoff(npiglo,npjglo), wdmp(npiglo,npjglo) )
+ ALLOCATE ( wice(npiglo,npjglo), precip_runoff(npiglo,npjglo) )
+ 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:
+ precip(:,:)= evap(:,:)-runoff(:,:)+wdmp(:,:)-wnet(:,:)+wice(:,:) ! mm/day
+ print *,'Precip done'
+ ! 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
diff --git a/cdfcensus.f90 b/cdfcensus.f90
new file mode 100644
index 0000000..77d7198
--- /dev/null
+++ b/cdfcensus.f90
@@ -0,0 +1,328 @@
+PROGRAM cdfcensus
+ !!-----------------------------------------------------------------------------
+ !! *** PROGRAM cdfcensus ***
+ !!
+ !! ** 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
+ !!
+ !! 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
+ USE cdfio
+ USE eos
+
+ ! * Local Variables
+ 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.
+
+ ! Initialisations
+ DATA tmin, tmax, dt /-2.0, 38.0, 0.05/
+ DATA smin, smax, ds /25.0, 40.0, 0.02/
+
+
+ voltotal=0.d0
+
+ ! 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
+
+ CALL getarg(1,cfilTS)
+ CALL getarg(2,cline1)
+ READ(cline1,*) nlog
+ PRINT *,' TS_FILE = ',TRIM(cfilTS)
+ 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
+
+ ! Allocate memory
+ ALLOCATE (t(npiglo,npjglo),s(npiglo,npjglo))
+ ALLOCATE (e1t(npiglo,npjglo),e2t(npiglo,npjglo),e3t(npk),e3t_ps(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
+
+ ! default is full domain, full depth
+ i1 = 1
+ i2 = npiglo
+ j1 = 1
+ j2 = npjglo
+ k1 = 1
+ k2 = 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
+
+ ! 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
+
+ ! Compute the census on the requested domain
+ PRINT *,' Water mass census on the file '
+ PRINT *, TRIM(cfilTS)
+ PRINT *, ' running .........'
+ xt = (tmax - tmin )/dt + 1
+ xs = (smax - smin )/ds + 1
+ nt = NINT(xt)
+ ns = NINT(xs)
+
+ ! Allocate arrays
+ ALLOCATE ( rcensus (ns,nt), dump(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.
+
+ ! 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
+ 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.
+
+ 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)
+
+ 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
+
+ ! 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))
+ END DO
+ END DO
+ END DO
+
+ 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)
+ 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)
+ ENDIF
+
+ PRINT *,' Done.'
+END PROGRAM cdfcensus
diff --git a/cdfclip.f90 b/cdfclip.f90
new file mode 100644
index 0000000..5edfb05
--- /dev/null
+++ b/cdfclip.f90
@@ -0,0 +1,232 @@
+PROGRAM cdfclip
+ !!-----------------------------------------------------------------------
+ !! *** PROGRAM cdfclip ***
+ !!
+ !! ** 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$
+ !!--------------------------------------------------------------
+ !!
+ USE cdfio
+
+ 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
+ CHARACTER(LEN=256) ,DIMENSION(:), ALLOCATABLE:: cvarname !: array of var name
+ CHARACTER(LEN=255) :: cglobal !: global attribute to write on output file
+
+ TYPE (variable), DIMENSION(:), ALLOCATABLE :: typvar
+
+ INTEGER :: ncout
+ INTEGER :: istatus
+ LOGICAL :: lzonal=.false. , lmeridian=.false.
+
+ !!
+
+ !! 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 '
+ STOP
+ ENDIF
+ !!
+ jarg=1
+ DO WHILE (jarg < narg )
+ CALL getarg (jarg, cdum)
+ SELECT CASE ( cdum)
+ CASE ('-f' )
+ jarg=jarg+1 ; CALL getarg(jarg,cdum) ; cfile=cdum
+ 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
+ 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
+ ENDIF
+ CASE DEFAULT
+ PRINT *,' Unknown option :', TRIM(cdum) ; 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
+ ELSE
+ WRITE(cglobal,'(a,a,a,4i5)') 'cdfclip -f ',TRIM(cfile),' -zoom ',imin,imax,jmin,jmax
+ ENDIF
+
+ IF ( imin == imax ) THEN ; lmeridian=.true.; print *,' Meridional section ' ; ENDIF
+ IF ( jmin == jmax ) 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
+ ELSE
+ npiglo= imax-imin+1
+ ENDIF
+
+ npjglo= jmax-jmin+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
+ PRINT *,' assume file with no depth'
+ IF ( kmin > 0 ) THEN
+ PRINT *,' You cannot specify limits on k level !' ; STOP
+ ENDIF
+ npk=0 ! means no dim level in file (implicitly 1 level)
+ ENDIF
+ 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')
+ PRINT *, 'npiglo=', npiglo
+ PRINT *, 'npjglo=', npjglo
+ PRINT *, 'npk =', npk ,' npkk =', npkk
+ PRINT *, 'nt =', nt
+
+ 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)
+ STOP
+ ENDIF
+
+ ALLOCATE( v2d(npiglo,npjglo),rlon(npiglo,npjglo), rlat(npiglo,npjglo), depg(npk) , dep(npkk))
+ ALLOCATE( zxz(npiglo,1), zyz(1,npjglo) )
+ ALLOCATE( timean(nt), tim(nt) )
+
+ nvars = getnvar(cfile)
+ PRINT *,' nvars =', nvars
+
+ ALLOCATE (cvarname(nvars),ndim(nvars) )
+ ALLOCATE (typvar(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)
+
+ IF ( npk /= 0 ) THEN
+ depg=getvar1d(cfile,cdep,npk)
+ dep(:)=depg(kmin:kmax)
+ ENDIF
+
+ ! get list of variable names and collect attributes in typvar (optional)
+ cvarname(:)=getvarname(cfile,nvars,typvar)
+
+ ! save variable dimension in ndim
+ ! 1 = either time or depth : noclip
+ ! 2 = nav_lon, nav_lat
+ ! 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 ...
+ 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
+
+ ! 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)
+
+ 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' )
+ ! skip
+ CASE DEFAULT
+ IF ( lzonal ) THEN
+ ALLOCATE( v2dxz(npiglo,ipk(jvar)) )
+ print *, TRIM(cvarname(jvar)), jmin,npiglo, ipk(jvar), imin
+ 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)) )
+ print *, TRIM(cvarname(jvar)), imin,npjglo, ipk(jvar), jmin
+ 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)
+ 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)
+
+
+END PROGRAM cdfclip
diff --git a/cdfcofdis.f90 b/cdfcofdis.f90
new file mode 100644
index 0000000..9d99d1d
--- /dev/null
+++ b/cdfcofdis.f90
@@ -0,0 +1,303 @@
+PROGRAM cdfcofdis
+ !!--------------------------------------------------------------------------
+ !! *** PROGRAM cdfcofdis ***
+ !!
+ !! ** 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
+ !!
+ !!-------------------------------------------------------------------------
+ USE cdfio
+ IMPLICIT NONE
+ ! Global variables
+ INTEGER :: jpi,jpj,jpk, jpim1, jpjm1, nperio=4
+ INTEGER :: narg, iargc
+ 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)
+
+ 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
+
+ !
+ 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
+ ENDIF
+
+ CALL getarg(1,coordhgr)
+ CALL getarg(2,cmask)
+ CALL getarg(3,cfilet)
+
+ ! read domain dimensions in the mask file
+ jpi=getdim(cfilet,'x')
+ jpj=getdim(cfilet,'y')
+ jpk=getdim(cfilet,'depth')
+ IF (jpk == 0 ) THEN
+ jpk=getdim(cfilet,'z')
+ IF ( jpk == 0 ) THEN
+ PRINT *,' ERROR in determining jpk form gridT file ....'
+ STOP
+ ENDIF
+ ENDIF
+ PRINT *, jpi,jpj,jpk
+ jpim1=jpi-1 ; jpjm1=jpj-1
+
+ ! ALLOCATION of the arrays
+ ALLOCATE ( glamt(jpi,jpj), glamu(jpi,jpj), glamv(jpi,jpj), glamf(jpi,jpj) )
+ ALLOCATE ( gphit(jpi,jpj), gphiu(jpi,jpj), gphiv(jpi,jpj), gphif(jpi,jpj) )
+ ALLOCATE ( tmask(jpi,jpj), umask(jpi,jpj), vmask(jpi,jpj), fmask(jpi,jpj) )
+ ALLOCATE ( pdct(jpi,jpj) )
+
+ 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.'
+
+ 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.'
+
+ ! 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)
+
+ 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
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE cofdis ***
+ !!
+ !! ** Purpose : Compute the distance between ocean T-points and the
+ !! ocean model coastlines. Save the distance in a NetCDF file.
+ !!
+ !! ** Method : For each model level, the distance-to-coast is
+ !! computed as follows :
+ !! - The coastline is defined as the serie of U-,V-,F-points
+ !! that are at the ocean-land bound.
+ !! - For each ocean T-point, the distance-to-coast is then
+ !! computed as the smallest distance (on the sphere) between the
+ !! T-point and all the coastline points.
+ !! - For land T-points, the distance-to-coast is set to zero.
+ !! C A U T I O N : Computation not yet implemented in mpp case.
+ !!
+ !! ** 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
+ LOGICAL, DIMENSION(jpi,jpj) :: llcotu, llcotv, llcotf ! ???
+ CHARACTER (len=32) :: clname
+ REAL(KIND=4) :: zdate0
+ REAL(KIND=4), DIMENSION(jpi,jpj) :: zxt, zyt, zzt, zmask ! cartesian coordinates for T-points
+ REAL(KIND=4), DIMENSION(3*jpi*jpj) :: zxc, zyc, zzc, zdis ! temporary workspace
+ !!----------------------------------------------------------------------
+
+ ! 0. Initialization
+ ! -----------------
+ PRINT *, 'COFDIS init'
+ zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) )
+ zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) )
+ zzt(:,:) = SIN( rad * gphit(:,:) )
+
+
+ ! 1. Loop on vertical levels
+ ! --------------------------
+ ! ! ===============
+ DO jk = 1, jpk ! Horizontal slab
+ ! ! ===============
+ PRINT *,'WORKING for level ', jk, nperio
+ pdct(:,:) = 0.e0
+ ! 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)
+ PRINT *, ' READ masks done.'
+ ! Define the coastline points (U, V and F)
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1
+ zmask(ji,jj) = ( tmask(ji,jj+1) + tmask(ji+1,jj+1) &
+ & + tmask(ji,jj ) + tmask(ji+1,jj ) )
+ llcotu(ji,jj) = ( tmask(ji,jj ) + tmask(ji+1,jj ) == 1. )
+ llcotv(ji,jj) = ( tmask(ji,jj ) + tmask(ji ,jj+1) == 1. )
+ llcotf(ji,jj) = ( zmask(ji,jj) > 0. ) .AND. ( zmask(ji,jj) < 4. )
+ END DO
+ END DO
+ PRINT *,' llcot? set now.'
+
+ ! Lateral boundaries conditions
+ llcotu(:, 1 ) = umask(:, 2 ) == 1
+ llcotu(:,jpj) = umask(:,jpjm1) == 1
+ llcotv(:, 1 ) = vmask(:, 2 ) == 1
+ llcotv(:,jpj) = vmask(:,jpjm1) == 1
+ llcotf(:, 1 ) = fmask(:, 2 ) == 1
+ llcotf(:,jpj) = fmask(:,jpjm1) == 1
+
+ IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+ llcotu( 1 ,:) = llcotu(jpim1,:)
+ llcotu(jpi,:) = llcotu( 2 ,:)
+ llcotv( 1 ,:) = llcotv(jpim1,:)
+ llcotv(jpi,:) = llcotv( 2 ,:)
+ llcotf( 1 ,:) = llcotf(jpim1,:)
+ llcotf(jpi,:) = llcotf( 2 ,:)
+ ELSE
+ llcotu( 1 ,:) = umask( 2 ,:) == 1
+ llcotu(jpi,:) = umask(jpim1,:) == 1
+ llcotv( 1 ,:) = vmask( 2 ,:) == 1
+ llcotv(jpi,:) = vmask(jpim1,:) == 1
+ llcotf( 1 ,:) = fmask( 2 ,:) == 1
+ llcotf(jpi,:) = fmask(jpim1,:) == 1
+ ENDIF
+ IF( nperio == 3 .OR. nperio == 4 ) THEN
+ DO ji = 1, jpim1
+ iju = jpi - ji + 1
+ llcotu(ji,jpj ) = llcotu(iju,jpj-2)
+ llcotf(ji,jpjm1) = llcotf(iju,jpj-2)
+ llcotf(ji,jpj ) = llcotf(iju,jpj-3)
+ END DO
+ DO ji = jpi/2, jpim1
+ iju = jpi - ji + 1
+ llcotu(ji,jpjm1) = llcotu(iju,jpjm1)
+ END DO
+ DO ji = 2, jpi
+ ijt = jpi - ji + 2
+ llcotv(ji,jpjm1) = llcotv(ijt,jpj-2)
+ llcotv(ji,jpj ) = llcotv(ijt,jpj-3)
+ END DO
+ ENDIF
+ IF( nperio == 5 .OR. nperio == 6 ) THEN
+ DO ji = 1, jpim1
+ iju = jpi - ji
+ llcotu(ji,jpj ) = llcotu(iju,jpjm1)
+ llcotf(ji,jpj ) = llcotf(iju,jpj-2)
+ END DO
+ DO ji = jpi/2, jpim1
+ iju = jpi - ji
+ llcotf(ji,jpjm1) = llcotf(iju,jpjm1)
+ END DO
+ DO ji = 1, jpi
+ ijt = jpi - ji + 1
+ llcotv(ji,jpj ) = llcotv(ijt,jpjm1)
+ END DO
+ DO ji = jpi/2+1, jpi
+ ijt = jpi - ji + 1
+ llcotv(ji,jpjm1) = llcotv(ijt,jpjm1)
+ END DO
+ ENDIF
+
+ ! Compute cartesian coordinates of coastline points
+ ! and the number of coastline points
+
+ icoast = 0
+ PRINT *,' START computing cartesian coord of coastlines '
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( llcotf(ji,jj) ) THEN
+ icoast = icoast + 1
+ zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) )
+ zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) )
+ zzc(icoast) = SIN( rad*gphif(ji,jj) )
+ ENDIF
+ IF( llcotu(ji,jj) ) THEN
+ icoast = icoast+1
+ zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) )
+ zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) )
+ zzc(icoast) = SIN( rad*gphiu(ji,jj) )
+ ENDIF
+ IF( llcotv(ji,jj) ) THEN
+ icoast = icoast+1
+ zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) )
+ zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) )
+ zzc(icoast) = SIN( rad*gphiv(ji,jj) )
+ ENDIF
+ END DO
+ END DO
+ PRINT *,' END computing cartesian coord of coastlines '
+
+ ! Distance for the T-points
+
+ PRINT *,' START computing distance for T points', icoast
+ DO jj = 1, jpj
+ print *, jj
+ DO ji = 1, jpi
+ IF( tmask(ji,jj) == 0. ) THEN
+ pdct(ji,jj) = 0.
+ ELSE
+ DO jl = 1, icoast
+ zdis(jl) = ( zxt(ji,jj) - zxc(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) ) )
+ ENDIF
+ END DO
+ END DO
+ PRINT *,' END computing distance for T points'
+
+ ierr=putvar(ncout,id_varout(1),pdct,jk,jpi,jpj)
+ ! ! ===============
+ END DO ! End of slab
+ ! ! ===============
+ timean(:)=0.
+ ierr=putvar1d(ncout,timean,1,'T')
+ ierr = closeout(ncout)
+
+ END SUBROUTINE cofdis
+
+ END PROGRAM cdfcofdis
diff --git a/cdfcofpoint.f90 b/cdfcofpoint.f90
new file mode 100644
index 0000000..bd3f29b
--- /dev/null
+++ b/cdfcofpoint.f90
@@ -0,0 +1,128 @@
+PROGRAM cdfcofpoint
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfmean ***
+ !!
+ !! ** Purpose : Compute distance of first coast in grid point
+ !!
+ !! ** Method : long iterative method (check furtehr time all mask point)
+ !!
+ !!
+ !! history ;
+ !! Original : P. Mathiot (June, 2009)
+ !!-------------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+ !! * Local variables
+ IMPLICIT NONE
+ INTEGER :: npiglo, npjglo, npk, nt, npi, npj !: size of the domain
+ INTEGER :: ji, jj, jk, jt, i
+ 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
+
+
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zmask, mask, mask_out !: npiglo x npjglo
+
+ CHARACTER(LEN=256) :: cfile, cdum
+ CHARACTER(LEN=256) :: cmask='mask.nc'
+
+ ! output stuff
+ INTEGER, DIMENSION(1) :: ipk, id_varout
+ TYPE(variable), DIMENSION(1) :: typvar
+ REAL(KIND=4) ,DIMENSION(1) :: timean
+ CHARACTER(LEN=256) :: cfileout='pointcoast.nc'
+ INTEGER :: ncout, ierr
+
+ narg= iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfmean filemask [imin imax jmin jmax kmin kmax] '
+ 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 *,' output file is pointcoast.nc '
+ STOP
+ ENDIF
+
+ CALL getarg (1, cfile)
+
+ npi= getdim (cfile,'x')
+ npj= getdim (cfile,'y')
+ npk = getdim (cfile,'depth')
+ nt = getdim (cfile,'time')
+
+ imin=1; jmin=1; jmax=npj; imax=npi
+
+ IF (narg > 3 ) THEN
+ IF ( narg /= 5 ) 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
+ ENDIF
+ ENDIF
+
+ 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
+
+ WRITE(6, *) 'npiglo=', npiglo
+ WRITE(6, *) 'npjglo=', npjglo
+ WRITE(6, *) 'npi =', npi
+ WRITE(6, *) 'npj =', npj
+ WRITE (6,*) 'npk =', npk
+ WRITE (6,*) 'nt =', nt
+
+ ! Allocate arrays
+ ALLOCATE ( zmask(npi,npj), mask_out(npi,npj), mask(npi,npj) )
+ mask_out(:,:)=0
+ mask(:,:)= getvar(cfile, 'tmask', 1 ,npi,npj)
+ i=0
+ DO WHILE ( SUM(mask(imin+1:imax-1,jmin+1:jmax-1)) .NE. 0 )
+ i=i+1
+ zmask=0
+ IF (MOD(i,10)==0) PRINT *, 'i = ',i, ' SUM(mask) = ',SUM(mask(imin+1:imax-1,jmin+1:jmax-1))
+ DO ji=imin+1,imax-1
+ DO jj=jmin+1,jmax-1
+ IF ((mask(ji,jj)==0) .AND. (mask_out(ji,jj)==i-1)) THEN
+ IF (mask(ji+1,jj )==1) zmask(ji+1,jj )=1
+ IF (mask(ji ,jj-1)==1) zmask(ji ,jj-1)=1
+ IF (mask(ji-1,jj )==1) zmask(ji-1,jj )=1
+ IF (mask(ji ,jj+1)==1) zmask(ji ,jj+1)=1
+ END IF
+ END DO
+ END DO
+ WHERE (zmask==1) mask=0
+ WHERE (zmask==1) mask_out=i
+ END DO
+
+ ! 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'
+ PRINT *,' CREATE ...'
+ ncout=create(cfileout, cfile,npi,npj,1)
+
+ PRINT *,' CREATEVAR ...'
+ ierr= createvar(ncout ,typvar,1, ipk,id_varout )
+ PRINT *,' PUTHEADERVAR ...'
+ ierr= putheadervar(ncout, cfile, npi,npj,npk)
+ ierr=putvar(ncout,id_varout(1),mask_out,1,npi,npj)
+ timean(:)=0.
+ ierr=putvar1d(ncout,timean,1,'T')
+ ierr = closeout(ncout)
+
+END PROGRAM cdfcofpoint
diff --git a/cdfcoloc.f90 b/cdfcoloc.f90
new file mode 100644
index 0000000..98ab3dc
--- /dev/null
+++ b/cdfcoloc.f90
@@ -0,0 +1,306 @@
+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=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
+
+ ! 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
+
+ ! 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 '/)
+ !! 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'
+ STOP
+ ENDIF
+
+ CALL getarg (1, cweight_root )
+ CALL getarg (2, cgridt )
+ CALL getarg (3, cgridu )
+ CALL getarg (4, cgridv )
+
+ npiglo= getdim (cgridt,'x')
+ npjglo= getdim (cgridt,'y')
+ npk= getdim (cgridt,'depth')
+
+ 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 ('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)
+ 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, idep ,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, 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
+ ! 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)
+ ELSE
+ ! save discarted stations for control
+ WRITE(numskip, '(I5, I6, 5f10.4)') id, idep, (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/cdfcoloc2.f90 b/cdfcoloc2.f90
new file mode 100644
index 0000000..a1024f1
--- /dev/null
+++ b/cdfcoloc2.f90
@@ -0,0 +1,332 @@
+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
new file mode 100644
index 0000000..dc7364f
--- /dev/null
+++ b/cdfcoloc2D.f90
@@ -0,0 +1,239 @@
+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
new file mode 100644
index 0000000..b7567e9
--- /dev/null
+++ b/cdfcoloc3.f90
@@ -0,0 +1,345 @@
+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
new file mode 100644
index 0000000..c90e69f
--- /dev/null
+++ b/cdfconvert.f90
@@ -0,0 +1,546 @@
+PROGRAM cdfconvert
+ !!-------------------------------------------------------------------
+ !! 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
+ !! 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
+ USE cdfio
+
+ !! * Local variables
+ 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=256) :: 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
+
+ !! 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'
+ 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'
+
+ 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'
+
+ ! 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 )
+
+ READ(numt,REC=1) cver, cheader, ii, npiglo, npjglo, npk
+
+ 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.
+
+ ! Build gridT file with votemper, vosaline, sossheig, ... fluxes ...
+ INQUIRE(FILE=cdimgssh, EXIST=lexist)
+ IF ( lexist ) THEN
+ irecl=isdirect(cdimgssh); OPEN( numssh,FILE=cdimgssh, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ nvar=10
+ ELSE
+ 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'
+ 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'
+ 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'
+ 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'
+ 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'
+ 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'
+ 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'
+ 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'
+ 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'
+ 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 )
+
+ 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)
+ END DO
+ 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)
+ END DO
+ 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'
+ 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'
+
+ ! 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'
+
+ ! 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'
+
+ ! 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'
+
+ ! 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'
+
+ ! 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'
+
+ ! 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'
+
+ istatus=putvar1d(ncout,timean,1,'T')
+ istatus=CLOSEOUT(ncout)
+ DEALLOCATE ( typvar, ipk, id_varout )
+
+
+!!!!! GRID U !!!!!
+ ! Build gridU file with vozocrtx, sozotaux
+ INQUIRE(FILE=cdimguu, EXIST=lexist)
+ IF ( lexist ) THEN
+ irecl=isdirect(cdimguu); OPEN( numuu,FILE=cdimguu, 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
+
+ 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'
+ ENDIF
+
+ glam=getvar(coordhgr,'glamu',1,npiglo,npjglo)
+ gphi=getvar(coordhgr,'gphiu',1,npiglo,npjglo)
+ dep=getvare3(coordzgr,'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 )
+
+ 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)
+ END DO
+ 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'
+
+ 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)
+ END DO
+ print *, 'Done for UU'
+ ENDIF
+
+
+ istatus=putvar1d(ncout,timean,1,'T')
+ istatus=CLOSEOUT(ncout)
+ DEALLOCATE ( typvar, ipk, id_varout )
+
+!!!!! GRID V !!!!!
+ ! Build gridV file with vomecrty, sometauy
+ INQUIRE(FILE=cdimgvv, EXIST=lexist)
+ IF ( lexist ) THEN
+ irecl=isdirect(cdimgvv); OPEN( numvv,FILE=cdimgvv, 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='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'
+ 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'
+ ENDIF
+
+
+ glam=getvar(coordhgr,'glamv',1,npiglo,npjglo)
+ gphi=getvar(coordhgr,'gphiv',1,npiglo,npjglo)
+ dep=getvare3(coordzgr,'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 )
+
+ 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)
+ END DO
+ 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'
+
+ 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)
+ END DO
+ print *, 'Done for VV'
+ ENDIF
+
+ istatus=putvar1d(ncout,timean,1,'T')
+ istatus=CLOSEOUT(ncout)
+
+ DEALLOCATE ( typvar, ipk, id_varout )
+
+!!!!! PSI !!!!!
+ ! 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)
+
+ 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 )
+
+ 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'
+
+ istatus=putvar1d(ncout,timean,1,'T')
+ istatus=CLOSEOUT(ncout)
+
+ DEALLOCATE ( typvar, 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=256) :: clheader
+!
+ INTEGER :: irecl
+
+!
+ OPEN(100,FILE=clname, FORM ='UNFORMATTED', ACCESS ='DIRECT', RECL =88)
+ READ(100,REC=1) cver ,clheader,irecl
+ CLOSE(100)
+!
+ IF (cver == '@!01' ) THEN
+ isdirect=irecl
+ ELSE
+ isdirect=0
+ END IF
+!
+ END FUNCTION isdirect
+END PROGRAM cdfconvert
diff --git a/cdfcsp.f90 b/cdfcsp.f90
new file mode 100644
index 0000000..af273a4
--- /dev/null
+++ b/cdfcsp.f90
@@ -0,0 +1,111 @@
+PROGRAM cdfcsp
+ !!-----------------------------------------------------------------------
+ !! *** 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
+ USE cdfio
+
+ !! * Local variables
+ 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()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfcsp ''list_of_ioipsl_model_output_files'' '
+ 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
+ PRINT *, "ASSUME NO VERTICAL DIMENSIONS !"
+ npk=0
+ ENDIF
+ ENDIF
+
+ PRINT *, 'npiglo=', npiglo
+ PRINT *, 'npjglo=', npjglo
+ PRINT *, 'npk =', npk
+
+ 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 spval 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
+ ierr = getvaratt (cfile,cvarname(jvar),cunits,spval,clname,csname)
+ ierr = cvaratt (cfile,cvarname(jvar),cunits,0.,clname,csname)
+ 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( tab(:,:) == spval ) tab(:,:) = 0.
+ ierr = putvar(ncid, id_var(jvar) ,tab, jkk, npiglo, npjglo, ktime=jt)
+ ENDDO
+ END DO
+ ENDIF
+ ENDDO
+ ENDDO
+
+ istatus = closeout(ncid)
+
+END PROGRAM cdfcsp
diff --git a/cdfcurl.f90 b/cdfcurl.f90
new file mode 100644
index 0000000..7251007
--- /dev/null
+++ b/cdfcurl.f90
@@ -0,0 +1,174 @@
+PROGRAM cdfcurl
+ !!---------------------------------------------------------------------------
+ !! *** PROGRAM cdfcurl ***
+ !!
+ !! ** Purpose: Compute the curl on F-points for given gridU gridV files and variables
+ !!
+ !! history :
+ !! Original : J.M. Molines (May 2005)
+ !! Modified : P. Mathiot (June 2007) update for forcing fields
+ !!---------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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.
+
+ 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)'
+ 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'
+
+ ipk(1) = 1 ! 2D
+
+ npiglo = getdim(cfilu,'x')
+ npjglo = getdim(cfilu,'y')
+ npk = getdim(cfilu,'depth')
+ nt = getdim(cfilu,'time_counter') !PM
+
+ PRINT *, 'npiglo =',npiglo
+ PRINT *, 'npjglo =',npjglo
+ PRINT *, 'npk =',npk
+ PRINT *, 'nt =',nt !PM
+ PRINT *, 'ilev =',ilev
+
+ !test if lev exists
+ IF ((npk==0) .AND. (ilev .GT. 0) ) THEN
+ PRINT *, 'Problem : npk = 0 and lev > 0 STOP'
+ STOP
+ END IF
+
+ ! if forcing field (PM)
+ 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
+ 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) )
+ ALLOCATE ( e2v(npiglo,npjglo) , e2f(npiglo,npjglo) )
+ ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) )
+ ALLOCATE ( zun(npiglo,npjglo) , zvn(npiglo,npjglo) )
+ ALLOCATE ( rotn(npiglo,npjglo) , fmask(npiglo,npjglo) )
+ ALLOCATE ( tim(nt) )
+
+ 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)
+
+ tim=getvar1d(cfilu,'time_counter',nt)
+ ierr=putvar1d(ncout,tim,nt,'T')
+
+ DO jt=1,nt
+
+ 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,:))
+ END DO
+ !
+ DO jj=1, npjglo-1
+ vn(:,jj) = 0.5*(zvn(:,jj) + zvn(:,jj+1))
+ END DO
+ ! end compute u and v on U and V point
+ ELSE
+ un(:,:) = zun(:,:)
+ vn(:,:) = zvn(:,:)
+ END IF
+
+ ! compute the mask
+ IF (jt==1) THEN
+ 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
+ END IF
+
+ rotn(:,:) = 0.
+ 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) )
+ END DO
+ END DO
+ !
+ ! 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
+ END DO
+ ierr = closeout(ncout)
+
+END PROGRAM cdfcurl
+
diff --git a/cdfdifmask.f90 b/cdfdifmask.f90
new file mode 100644
index 0000000..8c52257
--- /dev/null
+++ b/cdfdifmask.f90
@@ -0,0 +1,102 @@
+PROGRAM cdfdifmask
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfdifmask ***
+ !!
+ !! ** 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
+ USE cdfio
+
+ !! * Local variables
+ 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 :: ncout, npt
+ INTEGER :: istatus
+ REAL(4) :: ss
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfdifmask mask1 mask2'
+ STOP
+ ENDIF
+
+ CALL getarg (1, cfile1)
+ CALL getarg (2, cfile2)
+ npiglo= getdim (cfile1,'x')
+ npjglo= getdim (cfile1,'y')
+ npk = getdim (cfile1,'z')
+
+ 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='by'
+
+ ncout =create(cfileout, cfile1,npiglo,npjglo,npk,cdep='z',cdepvar='nav_lev')
+
+ ierr= createvar(ncout ,typvar,4, ipk,id_varout )
+ ierr= putheadervar(ncout, cfile1, npiglo, npjglo,npk,cdep='nav_lev')
+
+
+ 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
+ END DO
+ timean(:)=0.
+ ierr=putvar1d(ncout,timean,1,'T')
+ istatus = closeout(ncout)
+
+
+END PROGRAM cdfdifmask
diff --git a/cdfeke.f90 b/cdfeke.f90
new file mode 100644
index 0000000..a9fcb65
--- /dev/null
+++ b/cdfeke.f90
@@ -0,0 +1,104 @@
+PROGRAM cdfeke
+ !!-------------------------------------------------------------------
+ !! PROGRAM CDFEKE
+ !! **************
+ !!
+ !! ** Purpose: Compute EKE from mean files :
+ !! mean gridU , MS gridU mean gridV MS gridV
+ !!
+ !! ** Method: Try to avoid 3 d arrays
+ !!
+ !! history:
+ !! Original: J.M. Molines (Nov 2004 ) for ORCA025
+ !! J.M. Molines (Apr 2005) : use of modules
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !!
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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 :: ncout
+ INTEGER :: istatus, ierr
+
+ !! 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'
+ 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 )
+ END DO
+ 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 PROGRAM cdfeke
diff --git a/cdfets.f90 b/cdfets.f90
new file mode 100644
index 0000000..cdac354
--- /dev/null
+++ b/cdfets.f90
@@ -0,0 +1,240 @@
+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.
+ !!
+ !! *** 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
+ !! (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
+ !!
+ !! *** 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
+ USE cdfio
+ USE eos
+
+ !! * 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 :: 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.
+ 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'
+ 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= '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
+ ipk(2) = 1 ! 2D
+
+ PRINT *, 'npiglo=', npiglo
+ PRINT *, 'npjglo=', npjglo
+ PRINT *, 'npk =', npk
+
+ ! 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) )
+
+ ! 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)
+
+ 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)
+
+ ! eliminates zeros (which corresponds to land points where no procs were used)
+ WHERE ( e1u == 0 )
+ ff = 1.e-6
+ e1u = 1
+ e2v = 1
+ END WHERE
+
+ ff(:,:) = ABS(ff(:,:))* zpi
+ ! need ff at T points, zwp(:,:,iup) is used as work array here.
+ DO ji = 2, npiglo
+ DO jj =2, npjglo
+ zwk(ji,jj,iup) = 0.25 * ( ff(ji,jj) + ff(ji,jj-1) + ff(ji-1,jj) + ff(ji-1,jj-1) )
+ 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)
+
+ ! zwk will hold N2 at W level
+ zwk(:,:,iup) = eosbn2 ( ztemp,zsal,gdepw(jk),e3w,npiglo,npjglo, iup, idown ) ! not masked
+ WHERE( zwk(:,:,iup) < 0 ) zwk(:,:,iup) = 0. ! when < 0 set N2 = 0
+ WHERE( zmask == 0 ) zwk(:,:,iup) = spval ! set to spval on land
+
+ ! now put zn2 at T level (k )
+ WHERE ( zwk(:,:,idown) == spval )
+ zn2(:,:) = zwk(:,:,iup)
+ ELSEWHERE
+ 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)
+ ELSEWHERE
+ zn2=spval
+ END WHERE
+
+ ! integrates vertically (ff is already ABS(ff) * pi
+ zlda(:,:) = zlda(:,:) + e3w(:,:)/ff(:,:) * zn2(:,:)* zmask(:,:)
+
+ ! Compute buoyancy at level Tk ( idown)
+ buoy(:,:) = - 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) )
+ END DO
+ END DO
+
+ ! M2 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)) &
+ + 0.25*(dbv(ji,jj) + dbv(ji,jj-1)) * (dbv(ji,jj) + dbv(ji,jj-1))
+ END DO
+ END DO
+ M2(:,:) = SQRT( M2(:,:) )
+
+ ! Eddy Time Scale = N / M2
+ ets(:,:) = spval
+ WHERE (M2 /= 0 )
+ ets = zn2/M2/86400. ! in seconds
+ ELSEWHERE
+ ets = -10. ! flag ocean points with M2 = 0 (very few ?)
+ END WHERE
+ WHERE (zmask == 0 ) ets = spval
+
+ ! write ets at level jk on the output file
+ ierr = putvar(ncout, id_varout(1) ,SNGL(ets), jk, npiglo, npjglo)
+
+ ! 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)
+
+ ! Save zlda on file
+ WHERE (zmask == 0 ) zlda=spval
+ ierr = putvar(ncout, id_varout(2) ,SNGL(zlda), 1,npiglo, npjglo)
+
+ istatus = closeout(ncout)
+
+ END PROGRAM cdfets
diff --git a/cdffindij.f90 b/cdffindij.f90
new file mode 100644
index 0000000..8d83155
--- /dev/null
+++ b/cdffindij.f90
@@ -0,0 +1,322 @@
+PROGRAM cdffindij
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdffindij ***
+ !!
+ !! ** 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.
+ !!
+ !! history ;
+ !! Original : J.M. Molines (November 2005 )
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ IMPLICIT NONE
+ INTEGER :: narg, iargc, niter
+ INTEGER :: imin, imax, jmin, jmax
+ INTEGER :: 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
+ !! 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 '
+ 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
+ ! 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
+
+ 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
+ PRINT 9001, imin,imax, jmin, 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)
+9000 FORMAT(a,f8.2,a,f8.2,2i5)
+9001 FORMAT(4i10)
+9002 FORMAT(4f10.4)
+
+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
+ IF ( lfirst ) THEN
+ kpiloc = kpi/2 ; kpjloc = kpj/2 ! seek from the middle of domain
+ lfirst=.false.
+ ENDIF
+ 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
+ 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
+END PROGRAM cdffindij
diff --git a/cdfflxconv.f90 b/cdfflxconv.f90
new file mode 100644
index 0000000..d69b5c7
--- /dev/null
+++ b/cdfflxconv.f90
@@ -0,0 +1,574 @@
+PROGRAM cdfflxconv
+ !!-------------------------------------------------------------------
+ !! PROGRAM CDFFLXCONV
+ !! ******************
+ !!
+ !! ** Purpose: Convert a set of fluxes dimgfile (Clipper like)
+ !! to a set of CDF files (Drakkar like )
+ !!
+ !! ** Method: takes the current year as input, and config name
+ !! automatically read
+ !! ECMWF.Y${year}.M??.FLUX.${config}.dimg (daily, 1 file per month)
+ !! ECMWF.Y${year}.M??.STRESS.${config}.dimg (daily, 1 file per month)
+ !! REYNOLDS.Y${year}.SST.${config}.dimg ( weekly, 1 file per year ) ! Danger !
+ !! creates 6 netcdf daily files :
+ !! ECMWF_emp_1d_${year}.${config}.nc
+ !! ECMWF_qnet_1d_${year}.${config}.nc
+ !! ECMWF_qsr_1d_${year}.${config}.nc
+ !! ECMWF_sst_1d_${year}.${config}.nc
+ !! ECMWF_taux_1d_${year}.${config}.nc
+ !! ECMWF_tauy_1d_${year}.${config}.nc
+ !! Requires coordinates.diags file (to be input consistent)
+ !!
+ !! history:
+ !! Original: J.M. Molines (Feb. 2007 )
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !!
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ IMPLICIT NONE
+ INTEGER :: ji,jj,jk, jvar, jmonth, jdim, jday, jt
+ INTEGER :: narg, iargc, nvar
+ INTEGER :: npiglo,npjglo, npk !: size of the domain
+ INTEGER :: iyear, icurrday, jul, jul1, jul2
+ INTEGER :: id1, id2, ii1, ii2, ntime, ntp, ntn, itt
+ INTEGER :: january1, december31
+ INTEGER, DIMENSION(:), ALLOCATABLE :: itime
+
+ REAL(KIND=4) , DIMENSION (:,:,:), ALLOCATABLE :: v2d
+ REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glam, gphi, z2d, v2daily
+ REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamu, gphiu
+ REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamv, gphiv
+ REAL(KIND=4) , DIMENSION (:), ALLOCATABLE :: dep, timetab
+ REAL(KIND=8) , DIMENSION (:), ALLOCATABLE :: timetag, timetagp,timetagn
+ REAL(KIND=4) ,DIMENSION(1) :: timean
+
+ CHARACTER(LEN=256) :: ctag, confcase
+
+ ! Dimg stuff
+ INTEGER :: irecl, ii, nt, ndim, irec
+ INTEGER :: numflx=10, numcoo=11, numtau=12, numsst=14, numsstp=15, numsstn=16
+ CHARACTER(LEN=256) :: cflux, ctau, csstr,csstrp, csstrn
+ CHARACTER(LEN=256) :: coord='coordinates.diags'
+ CHARACTER(LEN=256) :: cheader, cdum, config
+ CHARACTER(LEN=4) :: cver
+ REAL(KIND=4) :: x1,y1, dx,dy, spval
+ ! coordinates.diags
+ INTEGER :: nrecl8
+ REAL(KIND=8) :: zrecl8, zpiglo,zpjglo
+ REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: dzvar
+ CHARACTER(LEN=256) :: cltextco
+ LOGICAL :: lexist
+
+ ! Netcdf Stuff
+ CHARACTER(LEN=256) :: cemp, cqnet, cqsr, ctaux, ctauy, csst
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvaremp,typvarqnet,typvarqsr
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvartaux,typvartauy,typvarsst
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ipkemp, ipkqnet, ipkqsr, id_varoutemp,id_varoutqnet, id_varoutqsr
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ipktaux, ipktauy, ipksst, id_varouttaux,id_varouttauy, id_varoutsst
+ INTEGER :: ncoutemp, ncoutqnet, ncoutqsr, ncouttaux, ncouttauy, ncoutsst
+ INTEGER :: istatus
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg /= 2 ) THEN
+ PRINT *,' Usage : cdfflxconv YEAR config '
+ PRINT *,' Output 6 cdf files : for emp, qnet, qsr, sst, taux, tauy with standard var name :'
+ PRINT *,' sowaflup, sohefldo, soshfldo, sst, sozotaux, sometauy '
+ PRINT *,' coordinates.diags ( clipper like) is required in current dir '
+ STOP
+ ENDIF
+ !!
+ CALL getarg (1, cdum)
+ READ(cdum,*) iyear
+ CALL getarg (2, config)
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !! ..... FLUXES FLUXES FLUXES ..... !!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ PRINT *, 'Doing fluxes ... '
+
+ !! read glam gphi in the coordinates file for T point (fluxes)
+ nrecl8=200
+ OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8)
+ READ(numcoo,rec=1) cltextco,zrecl8,zpiglo,zpjglo
+ CLOSE(numcoo)
+ nrecl8=zrecl8 ; npiglo=zpiglo ; npjglo=zpjglo
+ ALLOCATE ( glam(npiglo,npjglo), gphi(npiglo,npjglo) ,dzvar(npiglo,npjglo) )
+ OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8)
+ READ(numcoo,REC=2)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glam(:,:) = dzvar(:,:)
+ READ(numcoo,REC=6)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphi(:,:) = dzvar(:,:)
+ DEALLOCATE ( dzvar )
+ CLOSE(numcoo)
+
+ !! build nc output files
+ WRITE(cemp,'(a,I4.4,a)') 'ECMWF_emp_1d_',iyear,'.'//TRIM(config)//'.nc'
+ WRITE(cqnet,'(a,I4.4,a)') 'ECMWF_qnet_1d_',iyear,'.'//TRIM(config)//'.nc'
+ WRITE(cqsr,'(a,I4.4,a)') 'ECMWF_qsr_1d_',iyear,'.'//TRIM(config)//'.nc'
+
+ jmonth=1
+ !! Build dimg file names
+ WRITE(cflux,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.FLUX.'//TRIM(config)//'.dimg'
+ ! WRITE(ctau ,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',imonth,'.STRESS.'//TRIM(config)//'.dimg'
+ ! WRITE(csst ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg'
+
+ ! open (and check ?? if they exists )
+ irecl=isdirect(cflux) ; OPEN( numflx,FILE=cflux, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+
+ READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk
+
+ ALLOCATE (v2d(npiglo, npjglo,4), dep(npk) )
+ ALLOCATE (z2d(npiglo, npjglo) )
+ READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, &
+ x1,y1,dx,dy,spval, &
+ (dep(jk),jk=1,npk), &
+ timean(1)
+ CLOSE(numflx)
+
+ ! Build cdf files output
+ nvar = 1 ! 1 var but many files ... (OK ... 3 actually )
+ ALLOCATE ( typvaremp(nvar), ipkemp(nvar), id_varoutemp(nvar) )
+ ALLOCATE ( typvarqnet(nvar), ipkqnet(nvar), id_varoutqnet(nvar) )
+ 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)%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'
+
+ ipkqnet(jvar) = 1
+ typvarqnet(jvar)%name='sohefldo' ! QNET = dim 1 dimgfile
+ typvarqnet(jvar)%units='W/m2'
+ typvarqnet(jvar)%missing_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'
+
+ ipkqsr(jvar) = 1
+ typvarqsr(jvar)%name='soshfldo' ! QSR = dim 2 dimgfile
+ typvarqsr(jvar)%units='W/m2'
+ typvarqsr(jvar)%missing_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'
+
+ ncoutemp =create(cemp, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncoutemp ,typvaremp,nvar, ipkemp,id_varoutemp )
+ istatus= putheadervar(ncoutemp, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+ ncoutqnet =create(cqnet, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncoutqnet ,typvarqnet,nvar, ipkqnet,id_varoutqnet )
+ istatus= putheadervar(ncoutqnet, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+ ncoutqsr =create(cqsr, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncoutqsr ,typvarqsr,nvar, ipkqsr,id_varoutqsr )
+ istatus= putheadervar(ncoutqsr, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+
+ ! Ready for time loop on month
+ icurrday=0
+ DO jmonth = 1, 12
+ WRITE(cflux,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.FLUX.'//TRIM(config)//'.dimg'
+ irecl=isdirect(cflux) ; OPEN( numflx,FILE=cflux, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim
+ ! loop for days in files
+ DO jday=1,nt
+ icurrday=icurrday +1
+ DO jdim=1,ndim
+ irec=1+(jday-1)*ndim +jdim
+ READ(numflx,REC=irec) (( v2d(ji,jj,jdim),ji=1,npiglo),jj=1,npjglo)
+ END DO
+ ! emp
+ z2d=(v2d(:,:,3) - v2d(:,:,4) )/ 86400. ! scaling from mm/d to kg/m2/s
+ istatus = putvar(ncoutemp,id_varoutemp(1),z2d,icurrday,npiglo,npjglo)
+ ! qnet
+ istatus = putvar(ncoutqnet,id_varoutqnet(1),v2d(:,:,1),icurrday,npiglo,npjglo)
+ ! qsr
+ istatus = putvar(ncoutqsr,id_varoutqsr(1),v2d(:,:,2),icurrday,npiglo,npjglo)
+ END DO ! loop on days
+ CLOSE(numflx)
+ END DO ! loop on month
+
+ ! update time_counter
+ ALLOCATE( timetab (icurrday) )
+ timetab=(/(jt,jt=1,icurrday)/)
+ istatus=putvar1d(ncoutemp,timetab,icurrday,'T')
+ istatus=putvar1d(ncoutqnet,timetab,icurrday,'T')
+ istatus=putvar1d(ncoutqsr,timetab,icurrday,'T')
+ ! close fluxes files
+ istatus=closeout(ncoutemp)
+ istatus=closeout(ncoutqnet)
+ istatus=closeout(ncoutqsr)
+ DEALLOCATE (v2d , dep, z2d , timetab )
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !! ..... STRESSES STRESSES STRESSES ...... !!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ PRINT *,' Doing Stresses ...'
+
+ !! read glam gphi in the coordinates file for U point (fluxes)
+ nrecl8=200
+ OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8)
+ READ(numcoo,rec=1) cltextco,zrecl8,zpiglo,zpjglo
+ CLOSE(numcoo)
+ nrecl8=zrecl8 ; npiglo=zpiglo ; npjglo=zpjglo
+ ALLOCATE ( glamu(npiglo,npjglo), gphiu(npiglo,npjglo) ,dzvar(npiglo,npjglo) )
+ ALLOCATE ( glamv(npiglo,npjglo), gphiv(npiglo,npjglo) )
+ OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8)
+ READ(numcoo,REC=3)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamu(:,:) = dzvar(:,:)
+ READ(numcoo,REC=7)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiu(:,:) = dzvar(:,:)
+ READ(numcoo,REC=4)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamv(:,:) = dzvar(:,:)
+ READ(numcoo,REC=8)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiv(:,:) = dzvar(:,:)
+ DEALLOCATE ( dzvar )
+ CLOSE(numcoo)
+
+ !! build nc output files
+ WRITE(ctaux,'(a,I4.4,a)') 'ECMWF_taux_1d_',iyear,'.'//TRIM(config)//'.nc'
+ WRITE(ctauy,'(a,I4.4,a)') 'ECMWF_tauy_1d_',iyear,'.'//TRIM(config)//'.nc'
+
+ jmonth=1
+ !! Build dimg file names
+ WRITE(ctau ,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg'
+ ! WRITE(csst ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg'
+
+ ! open (and check ?? if they exists )
+ irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+
+ READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk
+
+ ALLOCATE (v2d(npiglo, npjglo,2), dep(npk) )
+ ALLOCATE (z2d(npiglo, npjglo) )
+ READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, &
+ x1,y1,dx,dy,spval, &
+ (dep(jk),jk=1,npk), &
+ timean(1)
+ CLOSE(numtau)
+
+ ! Build cdf files output
+ nvar = 1 ! 1 var but many files ... (OK ... 3 actually )
+ ALLOCATE ( typvartaux(nvar), ipktaux(nvar), id_varouttaux(nvar) )
+ 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)%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'
+
+ ipktauy(jvar) = 1
+ typvartauy(jvar)%name='sometauy' ! tauy dim 2 of dimgfile
+ typvartauy(jvar)%units='N/m2'
+ typvartauy(jvar)%missing_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'
+
+ ncouttaux =create(ctaux, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncouttaux ,typvartaux,nvar, ipktaux,id_varouttaux )
+ istatus= putheadervar(ncouttaux, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+
+ ncouttauy =create(ctauy, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncouttauy ,typvartauy,nvar, ipktauy,id_varouttauy )
+ istatus= putheadervar(ncouttauy, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+
+ ! Ready for time loop on month
+ icurrday=0
+ DO jmonth = 1, 12
+ WRITE(ctau,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg'
+ irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim
+ ! loop for days in files
+ DO jday=1,nt
+ icurrday=icurrday +1
+ DO jdim=1,ndim
+ irec=1+(jday-1)*ndim +jdim
+ READ(numtau,REC=irec) (( v2d(ji,jj,jdim),ji=1,npiglo),jj=1,npjglo)
+ END DO
+ ! taux
+ istatus = putvar(ncouttaux,id_varouttaux(1),v2d(:,:,1),icurrday,npiglo,npjglo)
+ ! tauy
+ istatus = putvar(ncouttauy,id_varouttauy(1),v2d(:,:,2),icurrday,npiglo,npjglo)
+ END DO ! loop on days
+ CLOSE(numtau)
+ END DO ! loop on month
+
+ ! update time_counter
+ ALLOCATE( timetab (icurrday) )
+ timetab=(/(jt,jt=1,icurrday)/)
+ istatus=putvar1d(ncouttaux,timetab,icurrday,'T')
+ istatus=putvar1d(ncouttauy,timetab,icurrday,'T')
+ ! close fluxes files
+ istatus=closeout(ncouttaux)
+ istatus=closeout(ncouttauy)
+ DEALLOCATE (v2d , dep, z2d , timetab)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !! ..... SST SST SST .....
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ PRINT *,' Doing SST ...'
+
+ !! glam gphi are already read ( T point)
+
+ !! build nc output files
+ WRITE(csst,'(a,I4.4,a)') 'REYNOLDS_sst_1d_',iyear,'.'//TRIM(config)//'.nc'
+
+ !! Build dimg file names
+ WRITE(csstr ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg'
+
+ ! open (and check ?? if they exists )
+ irecl=isdirect(csstr) ; OPEN( numsst,FILE=csstr, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+
+ READ(numsst,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt
+
+ ALLOCATE (v2d(npiglo, npjglo,nt+2),itime(nt+2), dep(npk) ,timetab(nt), timetag(nt) )
+ ALLOCATE (z2d(npiglo, npjglo) ,v2daily(npiglo,npjglo) )
+ READ(numsst,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, &
+ x1,y1,dx,dy,spval, &
+ (dep(jk),jk=1,npk), &
+ (timetab(jt), jt=1,nt)
+ timetag=timetab ! convert to dble precision
+ DEALLOCATE(timetab)
+
+ ! Build cdf files output
+ nvar = 1 ! 1 var but many files ... (OK ... 3 actually )
+ 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)%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'
+
+ ncoutsst =create(csst, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncoutsst ,typvarsst,nvar, ipksst,id_varoutsst )
+ istatus= putheadervar(ncoutsst, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+
+ ! We want to interpolate the data for every day. (weekly in the file)
+ ! if first day of the file is not 01/01, needs to read previous year
+ ! Clipper SST files are not y2k compliant ...
+ IF (timetag (1) < 10000 ) THEN
+ timetag(:)=timetag(:)+20000000.
+ ELSE
+ timetag(:)=timetag(:)+19000000.
+ ENDIF
+ january1=iyear*10000+01*100+01
+ december31=iyear*10000+12*100+31
+ jul1=julday(january1)
+ jul2=julday(december31)
+
+ itt=0
+ IF (jul1 < julday(INT(timetag(1))) ) THEN
+ ! need to read previous year
+ WRITE(csstrp ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear-1,'.SST.'//TRIM(config)//'.dimg'
+ irecl=isdirect(csstrp) ; OPEN( numsstp,FILE=csstrp, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ READ(numsstp,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntp
+ ALLOCATE (timetagp (ntp) ,timetab(ntp))
+ READ(numsstp,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntp, ndim, &
+ x1,y1,dx,dy,spval, &
+ (dep(jk),jk=1,npk), &
+ (timetab(jt), jt=1,ntp)
+ timetagp=timetab
+ DEALLOCATE(timetab)
+ IF (timetagp (1) < 10000 ) THEN
+ timetagp(:)=timetagp(:)+20000000.
+ ELSE
+ timetagp(:)=timetagp(:)+19000000.
+ ENDIF
+ IF ( julday(INT(timetagp (ntp))) <= jul1 ) THEN
+ !read ntp sst as 1 data
+ itt = itt +1
+ READ(numsstp,REC=ntp+1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday( INT(timetagp(ntp)) )
+ ELSE IF ( julday(INT(timetagp (ntp-1)) ) <= jul1 ) THEN
+ itt = itt +1
+ READ(numsstp,REC=ntp) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT(timetagp(ntp-1)) )
+ ELSE IF ( julday(INT(timetagp (ntp-2) )) <= jul1 ) THEN
+ itt = itt +1
+ READ(numsstp,REC=ntp-1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT(timetagp(ntp-2)) )
+ ELSE
+ PRINT *,' Something is wrong in previous file SST ' ; STOP
+ ENDIF
+ ENDIF
+ DO jt=1,nt
+ itt = itt +1
+ READ(numsst,REC=jt+1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT(timetag(jt)) )
+ END DO
+
+ IF ( jul2 > julday(INT(timetag(nt))) ) THEN
+ ! need to read next year
+ IF ( iyear == 2000 ) THEN ! persistance ...
+ itt=itt+1 ; v2d(:,:,itt)= v2d(:,:,itt-1) ; itime(itt)=jul2
+ ELSE
+ WRITE(csstrn ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear+1,'.SST.'//TRIM(config)//'.dimg'
+ irecl=isdirect(csstrn) ; OPEN( numsstn,FILE=csstrn, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ READ(numsstn,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntn
+ ALLOCATE (timetagn (ntn) ,timetab(ntn))
+ READ(numsstn,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntn, ndim, &
+ x1,y1,dx,dy,spval, &
+ (dep(jk),jk=1,npk), &
+ (timetab(jt), jt=1,ntn)
+ timetagn=timetab
+ DEALLOCATE( timetab)
+ IF (timetagn (1) < 10000 ) THEN
+ timetagn(:)=INT(timetagn(:))+20000000
+ ELSE
+ timetagn(:)=INT(timetagn(:))+19000000
+ ENDIF
+
+ IF ( julday(INT(timetagn (1) )) >= jul2 ) THEN
+ !read 1 sst as 1 data
+ itt = itt +1
+ READ(numsstn,REC=2) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT(timetagn(1)) )
+ ELSE IF ( julday(INT(timetagn (2)) ) >= jul2 ) THEN
+ itt = itt +1
+ READ(numsstn,REC=3) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT( timetagn(2)) )
+ ELSE IF ( julday(INT(timetagn (3))) >= jul2 ) THEN
+ itt = itt +1
+ READ(numsstn,REC=4) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT(timetagn(3)) )
+ ELSE
+ PRINT *,' Something is wrong in next file SST ' ; STOP
+ ENDIF
+ ENDIF
+ ENDIF
+ ntime=itt
+
+ icurrday=0
+ ii1=1 ; ii2 = 2 ; id1=itime(ii1) ; id2=itime(ii2)
+ DO jul = jul1, jul2
+ icurrday=icurrday + 1
+ IF ( jul > id2 ) THEN
+ ii1=ii1+1 ; ii2=ii2+1 ; id1=itime(ii1) ; id2=itime(ii2)
+ ENDIF
+ v2daily(:,:)=FLOAT((jul - id1 ))/(FLOAT(id2-id1))*(v2d(:,:,ii2) - v2d(:,:,ii1) ) + v2d(:,:,ii1)
+ istatus = putvar(ncoutsst,id_varoutsst(1),v2daily(:,:),icurrday,npiglo,npjglo)
+ END DO
+
+ ! update time_counter
+ ALLOCATE( timetab (icurrday) )
+ timetab=(/(jt,jt=1,icurrday)/)
+ istatus=putvar1d(ncoutsst,timetab,icurrday,'T')
+ ! close fluxes files
+ istatus=closeout(ncoutsst)
+ istatus=closeout(ncoutsst)
+ DEALLOCATE (v2d , dep, z2d )
+
+ 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=256) :: clheader
+ !
+ INTEGER :: irecl
+
+ !
+ OPEN(100,FILE=clname, FORM ='UNFORMATTED', ACCESS ='DIRECT', RECL =88)
+ READ(100,REC=1) cver ,clheader,irecl
+ CLOSE(100)
+ !
+ IF (cver == '@!01' ) THEN
+ isdirect=irecl
+ ELSE
+ isdirect=0
+ END IF
+ !
+ END FUNCTION isdirect
+
+ FUNCTION julday(kdastp)
+ !! ------------------------------------------------------------------
+ !! *** FUNCTION JULDAY ***
+ !!
+ !! Purpose: This routine returns the julian day number which begins at noon
+ !! of the calendar date specified by month kmm, day kid, and year kiyyy.
+ !! positive year signifies a.d.; negative, b.c. (remember that the
+ !! year after 1 b.c. was 1 a.d.)
+ !! routine handles changeover to gregorian calendar on oct. 15, 1582.
+ !!
+ !! Method: This routine comes directly from the Numerical Recipe Book,
+ !! press et al., numerical recipes, cambridge univ. press, 1986.
+ !!
+ !! Arguments:
+ !! kdastp : OPA date yyyymmdd (instead of kmm kid kiyyy)
+ !! kmm : input, corresponding month
+ !! kid : input, corresponding day
+ !! kiyyy : input, corresponding year, positive IF a.d, negative b.c.
+ !!
+ !!
+ !! history
+ !! 1998: J.M. Molines for the Doctor form.
+ !! 2007 : J.M. Molines in F90
+ !! -----------------------------------------------------------------
+ ! * Declarations
+ !
+ INTEGER :: julday, kiyyy,kid,kmm
+ INTEGER, INTENT(in) ::kdastp
+ ! * Local
+ INTEGER, PARAMETER ::jpgreg=15+31*(10+12*1582)
+ INTEGER :: iy, im, ia
+ ! ... Year 0 never existed ...
+ kiyyy=kdastp/10000
+ kmm=(kdastp - kiyyy*10000)/100
+ kid= kdastp - kiyyy*10000 - kmm*100
+ IF (kiyyy == 0) STOP 101
+ !
+ IF (kiyyy < 0) kiyyy = kiyyy + 1
+ IF (kmm > 2) THEN
+ iy = kiyyy
+ im = kmm + 1
+ ELSE
+ iy = kiyyy - 1
+ im = kmm + 13
+ END IF
+ !
+ julday = INT(365.25*iy) + INT(30.6001*im) + kid + 1720995
+ IF (kid+31*(kmm+12*kiyyy).GE.jpgreg) THEN
+ ia = INT(0.01*iy)
+ julday = julday + 2 - ia + INT(0.25*ia)
+ END IF
+ END FUNCTION JULDAY
+ END PROGRAM cdfflxconv
diff --git a/cdfgeo-uv.f90 b/cdfgeo-uv.f90
new file mode 100644
index 0000000..b729b4c
--- /dev/null
+++ b/cdfgeo-uv.f90
@@ -0,0 +1,163 @@
+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
+ !!
+ !! ** Note : ug is located on a V 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
+ USE cdfio
+
+ !! * Local variables
+ 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
+
+ !!
+ 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'
+ 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'
+
+
+ ! Allocate the memory
+ 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) )
+
+ ! 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')
+
+ ! 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)
+
+ ierr = closeout(ncoutu)
+ ierr = closeout(ncoutv)
+
+END PROGRAM cdfgeo_uv
+
diff --git a/cdfheatc-full.f90 b/cdfheatc-full.f90
new file mode 100644
index 0000000..96d758b
--- /dev/null
+++ b/cdfheatc-full.f90
@@ -0,0 +1,171 @@
+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
new file mode 100644
index 0000000..64e40b5
--- /dev/null
+++ b/cdfheatc.f90
@@ -0,0 +1,171 @@
+PROGRAM cdfheatc
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfheatc ***
+ !!
+ !! ** Purpose : Compute the heat content
+ !! PARTIAL STEPS
+ !!
+ !! ** Method : compute the sum ( rho cp T * e1 *e2 * e3 *mask )
+ !!
+ !!
+ !! history ;
+ !! Original : J.M. Molines (March 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=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()
+ 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'
+ 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 ( 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.)
+
+ !
+ 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
+
+ END DO
+ PRINT * ,' Total Heat content : ', rprho0*rpcp*zsum ,' Joules'
+ PRINT * ,' Total Heat content/volume : ', rprho0*rpcp*zsum/zvol ,' Joules/m3 '
+
+ END PROGRAM cdfheatc
diff --git a/cdfhflx.f90 b/cdfhflx.f90
new file mode 100644
index 0000000..d309e5f
--- /dev/null
+++ b/cdfhflx.f90
@@ -0,0 +1,249 @@
+PROGRAM cdfhflx
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfhflx ***
+ !!
+ !! ** 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)
+ !!
+ !!
+ !! 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
+ USE cdfio
+
+ !! * Local variables
+ 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' , cflagcdf
+ 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=.FALSE.
+
+ INTEGER :: istatus
+
+ !! Read command line and output usage message if not compliant.
+ narg= iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfhflx T file [cdfout]'
+ 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 )'
+ STOP
+ ENDIF
+
+ 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
+ ENDIF
+
+ IF ( narg == 2 ) THEN
+ CALL getarg (2, cflagcdf)
+ IF (cflagcdf == 'cdfout') THEN
+ lwrtcdf=.TRUE.
+ ELSE
+ PRINT *,'Uncorrect second argument'
+ PRINT *,'second argument must be "cdfout" to write in NetCDF'
+ ENDIF
+ ENDIF
+
+ ! Detects newmaskglo file
+ INQUIRE( FILE='new_maskglo.nc', EXIST=llglo )
+ IF (llglo) THEN
+ jpbasins = 5
+ ELSE
+ jpbasins = 1
+ ENDIF
+
+ ! Allocate arrays
+ ALLOCATE ( zmask(jpbasins,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(1)%long_name='Heat_Fluxes_Global'
+ typvar(1)%short_name='hflx_glo'
+ typvar%online_operation='N/A'
+ typvar%axis='ZT'
+
+ IF (llglo) THEN
+
+ typvar(1)%name='hflx_atl'
+ typvar(1)%long_name='Heat_Fluxes_Atlantic'
+ typvar(1)%short_name='hflx_atl'
+
+ typvar(1)%name='hflx_indopacif'
+ typvar(1)%long_name='Heat_Fluxes_Indo-Pacific'
+ typvar(1)%short_name='hflx_indopacif'
+
+ typvar(1)%name='hflx_indian'
+ typvar(1)%long_name='Heat_Fluxes_Indian'
+ typvar(1)%short_name='hflx_indian'
+
+ typvar(1)%name='hflx_pacif'
+ typvar(1)%long_name='Heat_Fluxes_Pacific'
+ typvar(1)%short_name='hflx_pacif'
+
+ ENDIF
+ ENDIF
+
+ e1t(:,:) = getvar(coordhgr, 'e1t', 1,npiglo,npjglo)
+ e2t(:,:) = getvar(coordhgr, 'e2t', 1,npiglo,npjglo)
+ gphit(:,:) = getvar(coordhgr, 'gphit', 1,npiglo,npjglo)
+
+ iloc=MAXLOC(gphit)
+ dumlat(1,:) = gphit(iloc(1),:)
+ dumlon(:,:) = 0. ! set the dummy longitude to 0
+
+ ! 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.
+ 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
+ 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)
+ 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))
+
+ IF (lwrtcdf) THEN
+
+ ! 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')
+
+ ! netcdf output
+ DO jj=1, jpbasins
+ ierr = putvar(ncout, id_varout(jj), htrp(jj,:), ipk(jj), kx, npjglo )
+ END DO
+
+ ierr = closeout(ncout)
+
+ ENDIF
+
+END PROGRAM cdfhflx
diff --git a/cdficediags.f90 b/cdficediags.f90
new file mode 100644
index 0000000..af21f9e
--- /dev/null
+++ b/cdficediags.f90
@@ -0,0 +1,227 @@
+PROGRAM cdficediag
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdficediag ***
+ !!
+ !! ** 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)
+ !!
+ !! history ;
+ !! Original : J.M. Molines (Jan. 2006)
+ !! R. Dussin (Jul. 2009) : Add netcdf output
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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
+ !
+ CHARACTER(LEN=256) :: cfilev , cdum
+ CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', cmask='mask.nc'
+ ! added to write in netcdf
+ CHARACTER(LEN=256) :: cfileoutnc='icediags.nc' , cflagcdf
+ ! added to write in netcdf
+ LOGICAL :: lwrtcdf=.FALSE.
+
+ INTEGER :: istatus
+
+ ! constants
+
+ !! Read command line and output usage message if not compliant.
+ narg= iargc()
+ IF ( narg == 0 .OR. narg >= 3 ) THEN
+ PRINT *,' Usage : cdficediag ncfile [cdfout]'
+ PRINT *,' Files mesh_hgr.nc, mask.nc '
+ PRINT *,' must be in the current directory'
+ PRINT *,' Output on standard output'
+ PRINT *,' Optional Output in NetCDF with cdfout option'
+ STOP
+ ENDIF
+
+ CALL getarg (1, cfilev)
+
+ npiglo= getdim (cfilev,'x')
+ npjglo= getdim (cfilev,'y')
+
+ IF ( narg == 2 ) THEN
+ CALL getarg (2, cflagcdf)
+ IF (cflagcdf=='cdfout') THEN
+ lwrtcdf=.TRUE.
+ ELSE
+ PRINT *, 'unknown option'
+ ENDIF
+ ENDIF
+
+ ALLOCATE ( zmask(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(cfilev, 'iicethic', 1 ,npiglo,npjglo)
+ riceldfra(:,:)= getvar(cfilev, 'ileadfra', 1 ,npiglo,npjglo)
+
+ ! 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)
+ 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.
+ CASE (6)
+ zmask(1:2,:)=0.
+ zmask(:,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, cfilev,kx, &
+ ky,kz,pnavlon=dumlon,pnavlat=dumlat)
+ tim=getvar1d(cfilev,'time_counter',1)
+ ierr=putvar1d(ncout,tim,1,'T')
+
+ ! 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
+
+
+END PROGRAM cdficediag
diff --git a/cdfimprovechk.f90 b/cdfimprovechk.f90
new file mode 100644
index 0000000..be86008
--- /dev/null
+++ b/cdfimprovechk.f90
@@ -0,0 +1,120 @@
+PROGRAM cdfimprovechk
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfimprovechk ***
+ !!
+ !! ** 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
+ !!
+ !! history:
+ !! Original : J.M. Molines (Nov. 2005)
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * 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 :: 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()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfimprovechk cdfvar obs.nc ref.nc tst.nc '
+ PRINT *,' Output on chk.nc, same variable '
+ STOP
+ ENDIF
+
+ CALL getarg (1, cvar)
+ CALL getarg (2, cfilobs)
+ CALL getarg (3, cfilref)
+ CALL getarg (4, cfiltst)
+
+ npiglo= getdim (cfilref,'x')
+ npjglo= getdim (cfilref,'y')
+ npk = getdim (cfilref,'depth')
+
+ nvpk = getvdim (cfilref,cvar)
+ 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'
+
+
+ PRINT *, 'npiglo=', npiglo
+ PRINT *, 'npjglo=', npjglo
+ PRINT *, 'npk =', npk
+
+ ALLOCATE (zobs(npiglo,npjglo), zref(npiglo,npjglo), ztst(npiglo,npjglo) ,zmask(npiglo,npjglo))
+ ALLOCATE (zchk(npiglo,npjglo) )
+
+ ! 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)
+END PROGRAM cdfimprovechk
diff --git a/cdfio.f90 b/cdfio.f90
new file mode 100644
index 0000000..18bd31e
--- /dev/null
+++ b/cdfio.f90
@@ -0,0 +1,1938 @@
+ MODULE cdfio
+ !!---------------------------------------------------------------------------------------------------
+ !! *** MODULE cdfio ***
+ !!
+ !! ** 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
+ !!------------------------------------------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ USE netcdf
+
+ 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
+
+ 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.
+ 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
+ END TYPE variable
+
+ INTERFACE putvar
+ MODULE PROCEDURE putvarr8, putvarr4, putvari2, putvarzo, reputvarr4
+ END INTERFACE
+
+
+ PRIVATE
+ PUBLIC copyatt, create, createvar, getvaratt,cvaratt
+ PUBLIC putatt, putheadervar, putvar, putvar1d, putvar0d
+ PUBLIC getatt, getdim, getvdim, getipk, getnvar, getvarname, getvarid, getspval
+ PUBLIC getvar, getvarxz, getvaryz, getvar1d, getvare3
+ PUBLIC gettimeseries
+ PUBLIC closeout, ncopen
+ PUBLIC ERR_HDL
+
+
+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
+ CHARACTER(LEN=*), INTENT(in) :: cdvar
+ INTEGER :: copyatt
+
+ ! * Local variable
+ INTEGER :: istatus, idvar, iatt, ja
+ CHARACTER(LEN=256) :: clatt
+
+ IF ( kcin /= -9999) THEN
+ 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 )
+ CASE ('nav_lon' )
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'units', 'degrees_east')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_min', -180.)
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_max', 180.)
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'long_name', 'Longitude')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'nav_model', 'Default grid')
+ CASE ('nav_lat' )
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'units', 'degrees_north')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_min', -90.)
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'valid_max', 90.)
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'long_name', 'Latitude')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'nav_model', 'Default grid')
+ CASE ('time_counter' )
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'calendar', 'gregorian')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'units', 'seconds since 0006-01-01 00:00:00')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'time_origin', '0001-JAN-01 00:00:00')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'title', 'Time')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'long_name', 'Time axis')
+ CASE ('deptht', 'depthu' ,'depthv' , 'depthw', 'dep')
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'units', 'm')
+ 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', 5875.)
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'title', TRIM(cdvar))
+ istatus=NF90_PUT_ATT(kcout, kidvar, 'long_name', 'Vertical Levels')
+ END SELECT
+ ENDIF
+
+ copyatt = istatus
+ 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
+
+ istatus = NF90_CREATE(cdfile,NF90_CLOBBER, icout)
+ istatus = NF90_DEF_DIM(icout,'x',kx, id_x)
+ istatus = NF90_DEF_DIM(icout,'y',ky, id_y)
+
+ IF ( kz /= 0 ) THEN
+ ! try to find out the name I will use for depth dimension in the new file ...
+ IF (PRESENT (cdep) ) THEN
+ cldep = cdep
+ idum=getdim(cdfilref,cldep,cldepref) ! look for depth dimension name in ref file
+ IF (cldepref =='unknown' ) cldepref=cdep
+ ELSE
+ idum=getdim(cdfilref,'depth',cldep ) ! look for depth dimension name in ref file
+ cldepref=cldep
+ ENDIF
+ cldepvar=cldep
+ istatus = NF90_DEF_DIM(icout,TRIM(cldep),kz, id_z)
+ IF (PRESENT (cdepvar) ) THEN
+ cldepvar=cdepvar
+ ENDIF
+ ENDIF
+
+
+ istatus = NF90_DEF_DIM(icout,'time_counter',NF90_UNLIMITED, id_t)
+
+ nvdim(1) = id_x ; nvdim(2) = id_y ; nvdim(3) = id_z ; nvdim(4) = id_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)
+ ELSE
+ ncid = -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)
+ IF ( kz /= 0 ) THEN
+ istatus = NF90_DEF_VAR(icout,TRIM(cldepvar),NF90_FLOAT,(/id_z/),id_dep)
+ ! JMM bug fix : if cdep present, then chose attribute from cldepref
+ istatus = copyatt(TRIM(cldepvar),id_dep,ncid,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_CLOSE(ncid)
+
+ 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
+
+
+ DO jv = 1, kvar
+
+ ! Create variables whose name is not 'none'
+ IF ( ptyvar(jv)%name /= 'none' ) THEN
+ IF (kpk(jv) == 1 ) THEN
+ idims=3
+ iidims(1) = id_x ; iidims(2) = id_y ; iidims(3) = id_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
+ ELSE
+ PRINT *,' ERROR: ipk = ',kpk(jv), jv , ptyvar(jv)%name
+ 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) )
+ ENDIF
+ ENDIF
+
+ ! add attributes
+ istatus = putatt(ptyvar(jv), kout,kidvo(jv),cdglobal=cdglobal)
+ createvar=istatus
+ ENDIF
+ END DO
+ istatus = NF90_ENDDEF(kout)
+
+ END FUNCTION createvar
+
+ FUNCTION getvarid( cdfile, knvars )
+ !! ------------------------------------------------------------------------------------------
+ !! *** return a real array with the nvar variable id
+ !!
+ !! ------------------------------------------------------------------------------------------
+ ! * Arguments
+ CHARACTER(LEN=*), INTENT(in) :: cdfile
+ INTEGER, INTENT(in) :: knvars ! Number of variables in cdfile
+ INTEGER, DIMENSION(knvars) :: getvarid
+
+ !! * local declarations
+ CHARACTER(LEN=256), DIMENSION(knvars) :: cdvar
+ INTEGER :: ncid, jv
+ INTEGER :: istatus
+
+
+ istatus = NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
+ DO jv = 1, knvars
+ istatus = NF90_INQUIRE_VARIABLE(ncid,jv,cdvar(jv) )
+ istatus = NF90_INQ_VARID(ncid,cdvar(jv),getvarid(jv))
+ ENDDO
+ istatus=NF90_CLOSE(ncid)
+
+ END FUNCTION getvarid
+
+ FUNCTION getvaratt (cdfile,cdvar,cdunits, pmissing_value, cdlong_name, cdshort_name)
+ !! ----------------------------------------------------------------------------------------------------
+ !! *** Change variable attributs in an existing variable
+ !!
+ !! ----------------------------------------------------------------------------------------------------
+ ! * Arguments
+ CHARACTER(LEN=256), INTENT(in) :: cdfile, cdvar
+ 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)
+
+ 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_ENDDEF(ncid)
+ getvaratt=istatus
+ istatus=NF90_CLOSE(ncid)
+
+ END FUNCTION getvaratt
+
+
+ FUNCTION cvaratt (cdfile,cdvar,cdunits,pmissing_value, cdlong_name, cdshort_name)
+ !! ----------------------------------------------------------------------------------------------------
+ !! *** 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
+
+ !! * local declarations
+ INTEGER :: istatus
+ INTEGER :: ncid, varid
+
+ istatus = NF90_OPEN(cdfile,NF90_WRITE,ncid)
+ istatus = NF90_REDEF(ncid)
+ istatus = NF90_INQ_VARID(ncid,cdvar,varid)
+
+ 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)
+ cvaratt=istatus
+ istatus=NF90_CLOSE(ncid)
+
+ 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
+ !!
+ !! ----------------------------------------------------------------------------------------------------
+ ! * 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)
+ IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt units'; ENDIF
+ putatt=NF90_PUT_ATT(kout,kid,'missing_value',tyvar%missing_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)
+ IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt valid_min'; ENDIF
+ putatt=NF90_PUT_ATT(kout,kid,'valid_max',tyvar%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)
+ IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt longname'; ENDIF
+ putatt=NF90_PUT_ATT(kout,kid,'short_name',tyvar%short_name)
+ IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt short name'; ENDIF
+ putatt=NF90_PUT_ATT(kout,kid,'online_operation',tyvar%online_operation)
+ IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt online oper'; ENDIF
+ putatt=NF90_PUT_ATT(kout,kid,'axis',tyvar%axis)
+ 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)
+ IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt scale fact'; ENDIF
+ putatt=NF90_PUT_ATT(kout,kid,'add_offset',tyvar%add_offset)
+ IF (putatt /= 0 ) THEN ;PRINT *, NF90_STRERROR(putatt) ; STOP 'putatt add offset'; ENDIF
+ putatt=NF90_PUT_ATT(kout,kid,'savelog10',tyvar%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
+ ENDIF
+
+ END FUNCTION putatt
+
+ 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
+ !!
+ !! 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
+
+ REAL(KIND=4) :: getatt
+
+ !! * 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)
+ 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)
+
+ END FUNCTION getatt
+
+ 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
+ CHARACTER(LEN=256) :: clnam
+ LOGICAL :: lexact=.false.
+ clnam = '-------------'
+
+ IF ( PRESENT(kstatus) ) kstatus=0
+ IF ( PRESENT(ldexact) ) lexact=ldexact
+ istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
+ 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
+
+ IF ( lexact ) THEN
+ istatus=NF90_INQ_DIMID(ncid,cdim_name,id_var)
+ 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)
+ 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
+ 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 ( PRESENT(kstatus) ) kstatus=1 ! error send optionally to the calling program
+ getdim=0
+ IF ( PRESENT(cdtrue) ) cdtrue='unknown'
+ ENDIF
+ istatus=NF90_CLOSE(ncid)
+ ELSE
+ IF ( PRESENT(cdtrue) ) cdtrue='unknown'
+ IF ( PRESENT(kstatus) ) kstatus=1
+ ENDIF
+ ! reset lexact to false for next call
+ lexact=.false.
+
+ END FUNCTION getdim
+
+ FUNCTION getspval (cdfile,cdvar)
+ !!-----------------------------------------------------------
+ !! *** FUNCTION getspval ***
+ !!
+ !! ** 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
+
+ ! * Local variables
+ INTEGER :: ncid, id_var
+ INTEGER :: 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)
+
+ END FUNCTION getspval
+
+ FUNCTION getvdim (cdfile, cdvar)
+ !!-----------------------------------------------------------
+ !! *** FUNCTION getvdim ***
+ !!
+ !! ** 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.
+ !!
+ !! history:
+ !! 31/10/2005 : Jean-Marc Molines : Original Code
+ !!-----------------------------------------------------------
+ !! * Arguments declarations
+ 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
+ CHARACTER(LEN=256) :: clongname='long_name', clongn
+
+ CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,ncid))
+ istatus0 = NF90_INQ_VARID ( ncid,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)
+ 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)
+ ENDDO
+ !
+ CALL ERR_HDL(NF90_INQUIRE_VARIABLE (ncid, id_var, cdvar,ndims=idi))
+ getvdim=idi-1
+ CALL ERR_HDL (NF90_CLOSE(ncid))
+ END FUNCTION getvdim
+
+ FUNCTION getnvar (cdfile)
+ !!-----------------------------------------------------------
+ !! *** FUNCTION getnvar ***
+ !!
+ !! ** Purpose : return the number of variables in cdfile
+ !!
+ !! ** Method :
+ !!
+ !! 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)
+
+ END FUNCTION getnvar
+
+ FUNCTION getipk (cdfile,knvars,cdep)
+ !!-----------------------------------------------------------
+ !! *** FUNCTION getipk ***
+ !!
+ !! ** Purpose : return the number of levels for all the variables
+ !! in cdfile. Return 0 if the variable in a vector.
+ !!
+ !! ** 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'
+
+
+ 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)
+ 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)
+ IF (ipk == 4 ) THEN
+ getipk(jv) = iipk
+ ELSE IF (ipk == 3 ) THEN
+ getipk(jv) = 1
+ ELSE
+ getipk(jv) = 0
+ ENDIF
+ END DO
+ istatus=NF90_CLOSE(ncid)
+
+ END FUNCTION getipk
+
+ FUNCTION getvarname (cdfile, knvars, ptypvar)
+ !!-----------------------------------------------------------
+ !! *** FUNCTION getvarname ***
+ !!
+ !! ** Purpose : return a character array with the knvars variable
+ !! name corresponding to cdfile
+ !!
+ !! ** Method :
+ !!
+ !!
+ !! 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=256), DIMENSION(knvars) :: getvarname
+ TYPE (variable), DIMENSION (knvars) :: ptypvar ! Retrieve variables attribute
+
+ !! * local declarations
+ INTEGER :: ncid, jv, ILEN
+ INTEGER :: istatus
+ CHARACTER(LEN=256) :: cldum=''
+ REAL(KIND=4) :: zatt
+
+ 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)
+ ! 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 =''
+ ELSE
+ ptypvar(jv)%units='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
+ ELSE
+ ptypvar(jv)%missing_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
+ ELSE
+ ptypvar(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
+ ELSE
+ ptypvar(jv)%valid_max=0.
+ 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=''
+ ELSE
+ ptypvar(jv)%long_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=''
+ ELSE
+ ptypvar(jv)%short_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=''
+ ELSE
+ ptypvar(jv)%online_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=''
+ ELSE
+ ptypvar(jv)%axis='N/A'
+ ENDIF
+
+ END DO
+ istatus=NF90_CLOSE(ncid)
+
+ END FUNCTION getvarname
+
+ 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
+ REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: zend, zstart
+
+ llperio=.false.
+ IF (PRESENT(klev) ) THEN
+ ilev=klev
+ ELSE
+ ilev=1
+ ENDIF
+
+ 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.)
+ IF (imin+kpi-1 > ipiglo ) THEN
+ llperio=.true.
+ imax=kpi+1 +imin -ipiglo
+ ENDIF
+ ELSE
+ imin=1
+ ENDIF
+
+ IF (PRESENT(kjmin) ) THEN
+ jmin=kjmin
+ ELSE
+ jmin=1
+ ENDIF
+
+ IF (PRESENT(ktime) ) THEN
+ itime=ktime
+ ELSE
+ itime=1
+ ENDIF
+
+ IF (PRESENT(ldiom) ) THEN
+ lliom=ldiom
+ ELSE
+ lliom=.false.
+ ENDIF
+
+ clvar=cdvar
+
+ ! Must reset the flags to false for every call to getvar
+ llog=.FALSE.
+ lsf=.FALSE.
+ lao=.FALSE.
+
+ 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)
+ 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)
+ 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)
+ 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
+
+ istatus=NF90_INQ_VARID (ncid,'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_INQ_VARID (ncid,'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_INQ_VARID (ncid,'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_INQ_VARID (ncid,'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_INQ_VARID (ncid,'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/) )
+ DO ji=1,ii
+ DO jj=1,ij
+ IF ( e3t_ps (ji,jj) == 0 ) e3t_ps(ji,jj)=e3t_0(mbathy(ji,jj))
+ END DO
+ END DO
+ ENDIF
+ ! zgr v3
+ SELECT CASE ( clvar )
+ CASE ('e3u_ps') ; clvar='e3t_ps'
+ CASE ('e3v_ps') ; clvar='e3t_ps'
+ CASE ('e3w_ps') ; clvar='e3w_ps'
+ END SELECT
+ ELSE
+ ! zgr v2
+ SELECT CASE ( clvar )
+ CASE ('e3t_ps') ; clvar='e3t'
+ CASE ('e3u_ps') ; clvar='e3u'
+ CASE ('e3v_ps') ; clvar='e3v'
+ CASE ('e3w_ps') ; clvar='e3w'
+ END SELECT
+ ENDIF
+ ENDIF
+ ENDIF
+
+ istatus=NF90_INQUIRE(ncid,unlimitedDimId=id_dimunlim)
+ CALL ERR_HDL(NF90_INQ_VARID ( ncid,clvar,id_var))
+ ! look for time dim in variable
+ nldim=0
+ istatus=NF90_INQUIRE_VARIABLE(ncid, id_var,ndims=nbdim,dimids=nldim(:) )
+
+ 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
+ istart(3) = itime
+ istart(4) = 1
+ ELSE
+ istart(3) = ilev
+ istart(4) = itime
+ ENDIF
+
+ icount(1)=kpi
+ icount(2)=kpj
+ icount(3)=1
+ icount(4)=1
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'missing_value')
+ IF (istatus == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(ncid,id_var,'missing_value',spval)
+ ELSE
+ ! assume spval is 0 ?
+ spval = 0.
+ ENDIF
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,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)
+ IF ( ilog /= 0 ) llog=.TRUE.
+ ENDIF
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,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)
+ IF ( sf /= 1. ) lsf=.TRUE.
+ ENDIF
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,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)
+ IF ( ao /= 0.) lao=.TRUE.
+ ENDIF
+
+
+ IF (llperio ) THEN
+ ALLOCATE (zend (ipiglo-imin,kpj), zstart(imax-1,kpj) )
+ IF (l_mbathy .AND. &
+ & ( cdvar == 'e3t_ps' .OR. cdvar == 'e3w_ps' .OR. cdvar == 'e3u_ps' .OR. cdvar == 'e3v_ps')) THEN
+ istatus=0
+ clvar=cdvar
+ SELECT CASE ( clvar )
+ CASE ( 'e3t_ps', 'e3u_ps', 'e3v_ps' )
+ DO ji=1,ipiglo-imin
+ DO jj=1,kpj
+ ik=mbathy(imin+ji-1, jmin+jj-1)
+ IF (ilev == ik ) THEN
+ zend(ji,jj)=e3t_ps(imin+ji-1, jmin+jj-1)
+ ELSE
+ zend(ji,jj)=e3t_0(ilev)
+ ENDIF
+ END DO
+ END DO
+ DO ji=1,imax-1
+ DO jj=1,kpj
+ ik=mbathy(ji+1, jmin+jj-1)
+ IF (ilev == ik ) THEN
+ zstart(ji,jj)=e3t_ps(ji+1, jmin+jj-1)
+ ELSE
+ zstart(ji,jj)=e3t_0(ilev)
+ ENDIF
+ END DO
+ END DO
+ getvar(1:ipiglo-imin,:)=zend
+ getvar(ipiglo-imin+1:kpi,:)=zstart
+ IF (clvar == 'e3u_ps') THEN
+ DO ji=1,kpi-1
+ DO jj=1,kpj
+ getvar(ji,jj)=MIN(getvar(ji,jj),getvar(ji+1,jj))
+ END DO
+ END DO
+ ! not very satisfactory but still....
+ getvar(kpi,:)=getvar(kpi-1,:)
+ ENDIF
+
+ IF (clvar == 'e3v_ps') THEN
+ DO ji=1,kpi
+ DO jj=1,kpj-1
+ getvar(ji,jj)=MIN(getvar(ji,jj),getvar(ji,jj+1))
+ END DO
+ END DO
+ ! not very satisfactory but still....
+ getvar(:,kpj)=getvar(:,kpj-1)
+ ENDIF
+
+ CASE ( 'e3w_ps')
+ DO ji=1,ipiglo-imin
+ DO jj=1,kpj
+ ik=mbathy(imin+ji-1, jmin+jj-1)
+ IF (ilev == ik ) THEN
+ zend(ji,jj)=e3w_ps(imin+ji-1, jmin+jj-1)
+ ELSE
+ zend(ji,jj)=e3w_0(ilev)
+ ENDIF
+ END DO
+ END DO
+ DO ji=1,imax-1
+ DO jj=1,kpj
+ ik=mbathy(ji+1, jmin+jj-1)
+ IF (ilev == ik ) THEN
+ zstart(ji,jj)=e3w_ps(ji+1, jmin+jj-1)
+ ELSE
+ zstart(ji,jj)=e3w_0(ilev)
+ ENDIF
+ END DO
+ END DO
+ getvar(1:ipiglo-imin,:)=zend
+ getvar(ipiglo-imin+1:kpi,:)=zstart
+
+ 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/))
+ getvar(1:ipiglo-imin,:)=zend
+ getvar(ipiglo-imin+1:kpi,:)=zstart
+ ENDIF
+ DEALLOCATE(zstart, zend )
+ ELSE
+ IF (l_mbathy .AND. &
+ & ( cdvar == 'e3t_ps' .OR. cdvar == 'e3w_ps' .OR. cdvar == 'e3u_ps' .OR. cdvar == 'e3v_ps')) THEN
+ istatus=0
+ clvar=cdvar
+ SELECT CASE ( clvar )
+ CASE ( 'e3t_ps', 'e3u_ps', 'e3v_ps' )
+ DO ji=1,kpi
+ DO jj=1,kpj
+ ik=mbathy(imin+ji-1, jmin+jj-1)
+ IF (ilev == ik ) THEN
+ getvar(ji,jj)=e3t_ps(imin+ji-1, jmin+jj-1)
+ ELSE
+ getvar(ji,jj)=e3t_0(ilev)
+ ENDIF
+ END DO
+ END DO
+ IF (clvar == 'e3u_ps') THEN
+ DO ji=1,kpi-1
+ DO jj=1,kpj
+ getvar(ji,jj)=MIN(getvar(ji,jj),getvar(ji+1,jj))
+ END DO
+ END DO
+ ! not very satisfactory but still....
+ getvar(kpi,:)=getvar(2,:)
+ ENDIF
+ IF (clvar == 'e3v_ps') THEN
+ DO ji=1,kpi
+ DO jj=1,kpj-1
+ getvar(ji,jj)=MIN(getvar(ji,jj),getvar(ji,jj+1))
+ END DO
+ END DO
+ ! not very satisfactory but still....
+ getvar(:,kpj)=getvar(:,kpj-1)
+ ENDIF
+
+ CASE ( 'e3w_ps')
+ DO ji=1,kpi
+ DO jj=1,kpj
+ ik=mbathy(imin+ji-1, jmin+jj-1)
+ IF (ilev == ik ) THEN
+ getvar(ji,jj)=e3w_ps(imin+ji-1, jmin+jj-1)
+ ELSE
+ getvar(ji,jj)=e3w_0(ilev)
+ ENDIF
+ END DO
+ END DO
+
+ END SELECT
+ ELSE
+ istatus=NF90_GET_VAR(ncid,id_var,getvar, start=istart,count=icount)
+ ENDIF
+ ENDIF
+ IF ( istatus /= 0 ) THEN
+ PRINT *,' Problem in getvar for ', TRIM(clvar)
+ CALL ERR_HDL(istatus)
+ STOP
+ ENDIF
+
+ ! Caution : order does matter !
+ IF (lsf ) WHERE (getvar /= spval ) getvar=getvar*sf
+ IF (lao ) WHERE (getvar /= spval ) getvar=getvar + ao
+ IF (llog) WHERE (getvar /= spval ) getvar=10**getvar
+
+ istatus=NF90_CLOSE(ncid)
+
+ END 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
+
+
+ IF (PRESENT(kimin) ) THEN
+ imin=kimin
+ ELSE
+ imin=1
+ ENDIF
+
+ IF (PRESENT(kkmin) ) THEN
+ kmin=kkmin
+ ELSE
+ kmin=1
+ ENDIF
+
+ IF (PRESENT(ktime) ) THEN
+ itime=ktime
+ ELSE
+ itime=1
+ ENDIF
+
+ ! Must reset the flags to false for every call to getvar
+ llog=.FALSE.
+ lsf=.FALSE.
+ lao=.FALSE.
+
+ istart(1) = imin
+ istart(2) = kj
+ istart(3) = kmin
+ ! JMM ! it workd for X Y Z T file, not for X Y T .... try to found a fix !
+ istart(4) = itime
+
+ icount(1)=kpi
+ icount(2)=1
+ icount(3)=kpz
+ icount(4)=1
+
+ CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,ncid) )
+ CALL ERR_HDL(NF90_INQ_VARID ( ncid,cdvar,id_var))
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'missing_value')
+ IF (istatus == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(ncid,id_var,'missing_value',spval)
+ ELSE
+ ! assume spval is 0 ?
+ spval = 0.
+ ENDIF
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,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)
+ IF ( ilog /= 0 ) llog=.TRUE.
+ ENDIF
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,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)
+ IF ( sf /= 1. ) lsf=.TRUE.
+ ENDIF
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,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)
+ IF ( ao /= 0.) lao=.TRUE.
+ ENDIF
+
+ istatus=NF90_GET_VAR(ncid,id_var,getvarxz, start=istart,count=icount)
+ IF ( istatus /= 0 ) THEN
+ PRINT *,' Problem in getvarxz for ', TRIM(cdvar)
+ CALL ERR_HDL(istatus)
+ STOP
+ ENDIF
+
+ ! Caution : order does matter !
+ IF (lsf ) WHERE (getvarxz /= spval ) getvarxz=getvarxz*sf
+ IF (lao ) WHERE (getvarxz /= spval ) getvarxz=getvarxz + ao
+ IF (llog) WHERE (getvarxz /= spval ) getvarxz=10**getvarxz
+
+ istatus=NF90_CLOSE(ncid)
+
+ END FUNCTION getvarxz
+
+ 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
+
+ IF (PRESENT(kjmin) ) THEN
+ jmin=kjmin
+ ELSE
+ jmin=1
+ ENDIF
+
+ IF (PRESENT(kkmin) ) THEN
+ kmin=kkmin
+ ELSE
+ kmin=1
+ ENDIF
+
+ IF (PRESENT(ktime) ) THEN
+ itime=ktime
+ ELSE
+ itime=1
+ ENDIF
+
+ ! Must reset the flags to false for every call to getvar
+ llog=.FALSE.
+ lsf=.FALSE.
+ lao=.FALSE.
+
+ istart(1) = ki
+ istart(2) = jmin
+ istart(3) = kmin
+ istart(4) = 1
+
+ icount(1)=1
+ icount(2)=kpj
+ icount(3)=kpz
+ ! JMM ! it workd for X Y Z T file, not for X Y T .... try to found a fix !
+ icount(4)=itime
+
+ CALL ERR_HDL(NF90_OPEN(cdfile,NF90_NOWRITE,ncid) )
+ CALL ERR_HDL(NF90_INQ_VARID ( ncid,cdvar,id_var))
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,id_var,'missing_value')
+ IF (istatus == NF90_NOERR ) THEN
+ istatus=NF90_GET_ATT(ncid,id_var,'missing_value',spval)
+ ELSE
+ ! assume spval is 0 ?
+ spval = 0.
+ ENDIF
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,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)
+ IF ( ilog /= 0 ) llog=.TRUE.
+ ENDIF
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,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)
+ IF ( sf /= 1. ) lsf=.TRUE.
+ ENDIF
+
+ istatus=NF90_INQUIRE_ATTRIBUTE(ncid,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)
+ IF ( ao /= 0.) lao=.TRUE.
+ ENDIF
+
+ istatus=NF90_GET_VAR(ncid,id_var,getvaryz, start=istart,count=icount)
+ IF ( istatus /= 0 ) THEN
+ PRINT *,' Problem in getvaryz for ', TRIM(cdvar)
+ CALL ERR_HDL(istatus)
+ STOP
+ ENDIF
+
+ ! Caution : order does matter !
+ IF (lsf ) WHERE (getvaryz /= spval ) getvaryz=getvaryz*sf
+ IF (lao ) WHERE (getvaryz /= spval ) getvaryz=getvaryz + ao
+ IF (llog) WHERE (getvaryz /= spval ) getvaryz=10**getvaryz
+
+ istatus=NF90_CLOSE(ncid)
+
+ END FUNCTION getvaryz
+
+ 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
+
+ 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)
+ IF ( istatus == NF90_NOERR ) THEN
+ istatus=NF90_GET_VAR(ncid,id_var,getvar1d,start=istart,count=icount)
+ ELSE
+ IF ( PRESENT(kstatus) ) kstatus= istatus
+ getvar1d=99999999999.
+ ENDIF
+
+ istatus=NF90_CLOSE(ncid)
+
+ END FUNCTION getvar1d
+
+ FUNCTION getvare3 (cdfile,cdvar,kk)
+ !!-----------------------------------------------------------
+ !! *** 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)
+
+ istart(:) = 1
+ icount(:) = 1
+ icount(3)=kk
+ clvar=cdvar
+
+ istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
+ ! 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)
+ IF ( istatus == NF90_NOERR) THEN
+ icount(1)=kk ; icount(3)=1
+ SELECT CASE (clvar)
+ CASE ('gdepw')
+ clvar='gdepw_0'
+ CASE ('gdept')
+ clvar='gdept_0'
+ CASE ('e3t')
+ clvar='e3t_0'
+ CASE ('e3w')
+ clvar='e3w_0'
+ END SELECT
+ ENDIF
+
+ istatus=NF90_INQ_VARID ( ncid,clvar,id_var)
+ istatus=NF90_GET_VAR(ncid,id_var,getvare3,start=istart,count=icount)
+ IF ( istatus /= 0 ) THEN
+ PRINT *,' Problem in getvare3 for ', TRIM(cdvar)
+ PRINT *,TRIM(cdfile), kk
+ CALL ERR_HDL(istatus)
+ STOP
+ ENDIF
+
+ istatus=NF90_CLOSE(ncid)
+ END FUNCTION getvare3
+
+
+ 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
+ !! 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).
+ !! 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
+ 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
+
+ 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)
+
+ IF (PRESENT(pnavlat) ) THEN
+ z2d = pnavlat
+ ELSE
+ z2d=getvar(cdfile,'nav_lat', 1,kpi,kpj)
+ ENDIF
+
+ istatus = putvar(kout,id_lat,z2d,1,kpi,kpj)
+
+ IF (kpk /= 0 ) THEN
+ IF (PRESENT(pdep) ) THEN
+ z1d = pdep
+ ELSE
+ idep = NF90_NOERR
+
+ IF ( PRESENT (cdep)) THEN
+ z1d=getvar1d(cdfile,cdep,kpk,idep)
+ ENDIF
+
+ IF ( .NOT. PRESENT(cdep) .OR. idep /= NF90_NOERR ) THEN ! look for standard dep name
+ DO jj = 1,jpdep
+ cldep=cldept(jj)
+ z1d=getvar1d(cdfile,cldep,kpk,idep)
+ IF ( idep == NF90_NOERR ) EXIT
+ END DO
+ IF (jj == jpdep +1 ) THEN
+ PRINT *,' No depth variable found in ', TRIM(cdfile)
+ STOP
+ ENDIF
+ ENDIF
+ ENDIF
+
+ istatus = putvar1d(kout,z1d,kpk,'D')
+ ENDIF
+ putheadervar=istatus
+ DEALLOCATE (z2d)
+
+ END FUNCTION putheadervar
+
+ FUNCTION putvarr8(kout, kid,ptab, klev, kpi, kpj,ktime)
+ !!-----------------------------------------------------------
+ !! *** 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
+ 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
+
+ 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
+ istart(3)=itime ; istart(4)=1
+ ELSE
+ istart(3)=klev ; istart(4)=itime
+ ENDIF
+ icount(:) = 1 ; icount(1) = kpi ; icount(2) = kpj
+ istatus=NF90_PUT_VAR(kout,kid, ptab, start=istart,count=icount)
+ putvarr8=istatus
+
+ END FUNCTION putvarr8
+
+ FUNCTION putvarr4(kout, kid,ptab, klev, kpi, kpj,ktime)
+ !!-----------------------------------------------------------
+ !! *** 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
+ 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
+
+ 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
+ istart(3)=itime ; istart(4)=1
+ ELSE
+ istart(3)=klev ; istart(4)=itime
+ ENDIF
+ icount(:) = 1 ; icount(1) = kpi ; icount(2) = kpj
+ istatus=NF90_PUT_VAR(kout,kid, ptab, start=istart,count=icount)
+ putvarr4=istatus
+
+ END FUNCTION putvarr4
+
+ FUNCTION reputvarr4 (cdfile,cdvar,klev,kpi,kpj,kimin,kjmin, ktime,ptab)
+ !!-----------------------------------------------------------
+ !! *** 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
+ 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)
+ !! look for eventual unlimited dim (time_counter)
+ istatus=NF90_INQUIRE(ncid,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'
+ reputvarr4=istatus
+ istatus=NF90_CLOSE(ncid)
+
+ 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 :
+ !!
+ !! ** 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
+ 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
+
+ ilev=klev
+ IF (PRESENT(ktime) ) THEN
+ itime=ktime
+ ELSE
+ itime=1
+ 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
+ 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)
+ putvarzo=istatus
+
+ 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
+ !!
+ !! ** 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(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 putvar1d(kout,ptab,kk,cdtype)
+ !!-----------------------------------------------------------
+ !! *** FUNCTION putvar1d ***
+ !!
+ !! ** 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 :: putvar1d ! return status
+
+ !! * Local variables
+ INTEGER :: istatus, iid
+ INTEGER, DIMENSION(1) :: istart, icount
+
+ SELECT CASE ( cdtype )
+ CASE ('T', 't' )
+ iid = id_tim
+ CASE ('D', 'd' )
+ iid = id_dep
+ END SELECT
+
+ istart(:) = 1
+ icount(:) = kk
+ istatus=NF90_PUT_VAR(kout,iid, ptab, start=istart,count=icount)
+ putvar1d=istatus
+
+ END FUNCTION putvar1d
+
+ FUNCTION putvar0d(kout,varid,value)
+ !!-----------------------------------------------------------
+ !! *** FUNCTION putvar0d ***
+ !!
+ !! ** Purpose : Copy single value, with id varid, into file id kout
+ !!
+ !! ** Method :
+ !!
+ !! ** Action : single value variable written
+ !!
+ !!-----------------------------------------------------------
+ !! * 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
+
+ ! Local variables
+ INTEGER :: istatus
+
+ istatus=NF90_PUT_VAR(kout,varid,value)
+ putvar0d=istatus
+
+ END FUNCTION putvar0d
+
+ FUNCTION closeout(kout)
+ !!----------------------------------------------------------
+ !! *** FUNCTION closeout ***
+ !!
+ !! ** Purpose : close open 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
+ closeout=NF90_CLOSE(kout)
+ END FUNCTION closeout
+
+ 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
+ END FUNCTION ncopen
+
+ SUBROUTINE ERR_HDL(kstatus)
+ !! ----------------------------------------------------------
+ !! *** SUBROUTINE err_hdl
+ !!
+ !! ** Purpose : Error handle for NetCDF routine.
+ !! Stop if kstatus indicates error conditions.
+ !!
+ !! History :
+ !! Original: J.M. Molines (01/99)
+ !!
+ !! -----------------------------------------------------------
+ IMPLICIT NONE
+ INTEGER, 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
+ !!
+ !! History :
+ !! Original: J.M. Molines (03/2007)
+ !!
+ !! -----------------------------------------------------------
+ !* 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
+
+ ! Klev can be used to give the model level we want to look at
+ IF ( PRESENT(klev) ) THEN
+ jk=klev
+ ELSE
+ jk=1
+ ENDIF
+
+ ! Open cdf dataset
+ istatus=NF90_OPEN(cdfile,NF90_NOWRITE,ncid)
+
+ ! read time dimension
+ istatus=NF90_INQ_DIMID(ncid,'time_counter',id_t)
+ istatus=NF90_INQUIRE_DIMENSION(ncid,id_t,len=nt)
+
+ ! Allocate space
+ ALLOCATE (ztime(nt), zval(nt) )
+
+ ! gettime
+ istatus=NF90_INQ_VARID(ncid,'time_counter',id_var)
+ istatus=NF90_GET_VAR(ncid,id_var,ztime,(/1/),(/nt/) )
+
+ ! 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)
+ IF ( istatus == NF90_NOERR ) zao = ztmp
+ istatus=NF90_GET_ATT(ncid,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/) )
+ ELSE
+ PRINT *,' ERROR : variable ',TRIM(cdvar),' has ', ndim, &
+ & ' dimensions !. Only 3 or 4 supported'
+ STOP
+ ENDIF
+
+ ! convert to physical values
+ zval=zval*zsf + zao
+
+ ! display results :
+ DO jt=1,nt
+ PRINT *,ztime(jt)/86400., zval(jt)
+ ENDDO
+
+ istatus=NF90_CLOSE(ncid)
+
+ END SUBROUTINE gettimeseries
+
+END MODULE cdfio
+
diff --git a/cdfisopycdep.f90 b/cdfisopycdep.f90
new file mode 100644
index 0000000..540240d
--- /dev/null
+++ b/cdfisopycdep.f90
@@ -0,0 +1,182 @@
+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
new file mode 100644
index 0000000..bb82c6e
--- /dev/null
+++ b/cdfkempemekeepe.f90
@@ -0,0 +1,133 @@
+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)
+ !!
+ !! history :
+ !! Original : A. Melet (Mar 2008)
+ !!---------------------------------------------------------------------
+ !!--------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+
+ USE cdfio
+
+ !! * Local variables
+ 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
+
+ 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 *,' '
+ 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')
+
+ PRINT *, 'npiglo =',npiglo
+ PRINT *, 'npjglo =',npjglo
+ PRINT *, 'npk =',npk
+ PRINT *, 'nt =',nt
+
+ ! 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'
+
+ 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'
+
+ 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
+
+ !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)
+
+ ! 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) )
+
+ tim=getvar1d(cfile,'time_counter',nt)
+ ierr=putvar1d(ncout,tim,1,'T')
+
+ DO jj = 1, npjglo
+ print*, 'jj : ',jj
+ wbartbarxz(:,:) = 0.d0
+ anowtxz(:,:) = 0.d0
+ wtxz(:,:) = 0.d0
+ wxz(:,:) = 0.d0
+ txz(:,:) = 0.d0
+
+ 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)
+
+ 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 )
+ END DO
+ wbartbar(:,jj,:) = wbartbarxz(:,:)
+ 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 )
+ END DO
+ ierr = closeout(ncout)
+
+END PROGRAM cdfkempemekeepe
+
diff --git a/cdflinreg.f90 b/cdflinreg.f90
new file mode 100644
index 0000000..350b7fc
--- /dev/null
+++ b/cdflinreg.f90
@@ -0,0 +1,250 @@
+PROGRAM cdflinreg
+ !!-----------------------------------------------------------------------
+ !! *** PROGRAM cdflinreg ***
+ !!
+ !! ** 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
+ !! 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)
+ !! 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)
+ !!
+ !! history :
+ !! Original code : J.M. Molines (Jan 2008 ) from cdfmoy
+ !!
+ !!-----------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+
+ USE cdfio
+
+ 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
+
+ !!
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdflinreg ''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( 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) )
+
+ nvars = getnvar(cfile)
+ 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) )
+
+ ! get list of variable names and collect attributes in typvar (optional)
+ cvarname(:)=getvarname(cfile,nvars,typvar)
+
+ 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)
+ 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)
+ 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)
+ 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)
+
+! ierr= createvar(ncout , typvar, nvars, ipk, id_varout )
+ ierr= createvar(ncout2, typvar2, 3*nvars, ipk2, id_varout2)
+
+! ierr= putheadervar(ncout , cfile, npiglo, npjglo, npk,cdep=cdep)
+ ierr= putheadervar(ncout2, cfile, npiglo, npjglo, npk,cdep=cdep)
+
+ lcaltmean=.TRUE. ; zt=0.d0 ; zt2=0.d0
+ DO jvar = 1,nvars
+ ijvar=(jvar-1)*3 +1
+ IF (cvarname(jvar) == 'nav_lon' .OR. &
+ cvarname(jvar) == 'nav_lat' ) 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
+ 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)/)
+ 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)
+ 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)
+ IF (lcaltmean ) THEN
+ timean(1)= zt/ntframe
+ timean(2)= zt2/ntframe
+! ierr=putvar1d(ncout,timean,2,'T')
+ ierr=putvar1d(ncout2,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
+ ELSEWHERE
+ areg=spval ; breg=spval ; rpear=spval
+ 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
+ END DO ! loop to next level
+ END IF
+ END DO ! loop to next var in file
+
+! istatus = closeout(ncout)
+ istatus = closeout(ncout2)
+
+
+END PROGRAM cdflinreg
diff --git a/cdflspv.f90 b/cdflspv.f90
new file mode 100644
index 0000000..1075116
--- /dev/null
+++ b/cdflspv.f90
@@ -0,0 +1,157 @@
+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/cdfmasstrp-full.f90 b/cdfmasstrp-full.f90
new file mode 100644
index 0000000..4482ea0
--- /dev/null
+++ b/cdfmasstrp-full.f90
@@ -0,0 +1,469 @@
+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
new file mode 100644
index 0000000..1548118
--- /dev/null
+++ b/cdfmasstrp.f90
@@ -0,0 +1,469 @@
+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
new file mode 100644
index 0000000..a9cb904
--- /dev/null
+++ b/cdfmax-test.f90
@@ -0,0 +1,285 @@
+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
new file mode 100644
index 0000000..6b3c0cb
--- /dev/null
+++ b/cdfmax.f90
@@ -0,0 +1,287 @@
+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 ]
+ !! [-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
+ !
+ 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 *, ' spval is assumed to be 0 (not taken into account)'
+ 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
+
+ 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 == 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
+ 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
diff --git a/cdfmax_sp.f90 b/cdfmax_sp.f90
new file mode 100644
index 0000000..ead5835
--- /dev/null
+++ b/cdfmax_sp.f90
@@ -0,0 +1,288 @@
+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
new file mode 100644
index 0000000..285489a
--- /dev/null
+++ b/cdfmaxmoc.f90
@@ -0,0 +1,221 @@
+PROGRAM cdfmaxmoc
+ !!---------------------------------------------------------------------------------------------------
+ !! *** 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$
+ !!--------------------------------------------------------------
+ !!
+ USE cdfio
+ 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
+ !
+ 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
+ !
+ CHARACTER(LEN=256) :: cdum, cfile, comment, cbasin, cvar
+ ! added to write in netcdf
+ CHARACTER(LEN=256) :: cfileoutnc='maxmoc.nc' , cflagcdf
+ ! added to write in netcdf
+ LOGICAL :: lwrtcdf=.FALSE.
+
+ ! * main program
+ narg=iargc()
+ IF (narg >= 6 .AND. narg <= 7 ) 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
+ IF (narg==7) THEN
+ CALL getarg(7,cdum)
+ READ(cdum,*) cflagcdf
+ ENDIF
+ ELSE
+ PRINT *,' USAGE: cdfmaxmoc ''ovt_file.nc'' cbasin latmin latmax depmin depmax [cdfout]'
+ PRINT *,' cbasin is one of atl glo inp ind or pac '
+ PRINT *,' Output on standard output by default'
+ PRINT *,' Output on netcdf is available adding cdfout as last argument'
+ STOP
+ ENDIF
+
+ IF(cflagcdf=='cdfout') THEN
+ lwrtcdf=.TRUE.
+ ENDIF
+
+ npjglo=getdim(cfile,'y')
+ npk=getdim(cfile,'depth')
+
+ ALLOCATE ( zomoc (1,npjglo,npk) ,gdepw(npk), rlat(1,npjglo))
+ gdepw(:) = -getvar1d(cfile,'depthw',npk)
+ rlat(:,:) = getvar(cfile,'nav_lat',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'
+ 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
+
+ DO jk=1,npk
+ zomoc (:,:,jk) = getvar(cfile,cvar,jk,1,npjglo)
+ END DO
+
+ ! look for jmin-jmax :
+ DO jj=1, npjglo
+ IF ( rlat(1,jj) <= rlatmin ) jmin = jj
+ IF ( rlat(1,jj) <= rlatmax ) jmax = jj
+ END DO
+
+ ! look for kmin kmax
+ DO jk=1,npk
+ IF ( gdepw(jk) <= depmin ) kmin = jk
+ IF ( gdepw(jk) <= depmax ) kmax = jk
+ END DO
+
+ ! look for max/min overturning
+ ovtmax = MAXVAL(zomoc(1,jmin:jmax,kmin:kmax))
+ ovtmin = MINVAL(zomoc(1,jmin:jmax,kmin:kmax))
+
+ ! find location of min/max
+ iminloc =MINLOC(zomoc(:,jmin:jmax,kmin:kmax))
+ imaxloc =MAXLOC(zomoc(:,jmin:jmax,kmin:kmax))
+
+ ! 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
+
+END PROGRAM cdfmaxmoc
diff --git a/cdfmean-full.f90 b/cdfmean-full.f90
new file mode 100644
index 0000000..6c1eaec
--- /dev/null
+++ b/cdfmean-full.f90
@@ -0,0 +1,173 @@
+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
new file mode 100644
index 0000000..3571c7c
--- /dev/null
+++ b/cdfmean.f90
@@ -0,0 +1,283 @@
+PROGRAM cdfmean
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfmean ***
+ !!
+ !! ** Purpose : Compute the Mean Value 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)
+ !! R. Dussin (Jul 2009) : add cdf output
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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' , cflagcdf
+ CHARACTER(LEN=256) :: cdunits, cdlong_name, cdshort_name
+ ! added to write in netcdf
+ LOGICAL :: lwrtcdf=.FALSE.
+
+
+ INTEGER :: istatus
+
+ ! constants
+
+ !! Read command line and output usage message if not compliant.
+ 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'
+ STOP
+ ENDIF
+ ! Open standard output with recl=256 to avoid wrapping of long lines (ifort)
+ OPEN(6,FORM='FORMATTED',RECL=256)
+
+ CALL getarg (1, cfilev)
+ CALL getarg (2, cvar)
+ CALL getarg (3, cvartype)
+
+ IF (narg > 3 ) THEN
+ IF ( narg < 9 .OR. narg > 10 ) 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
+ IF ( narg==10 ) THEN
+ CALL getarg (10,cdum) ; READ(cdum,*) cflagcdf
+ ENDIF
+ ENDIF
+ ENDIF
+
+ IF(cflagcdf=='cdfout') THEN
+ lwrtcdf=.TRUE.
+ ENDIF
+
+ 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
+ PRINT *,' assume file with no depth'
+ npk=0
+ 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
+
+ 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)
+
+ ! 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)
+
+ 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, 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
+ 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
diff --git a/cdfmeanvar.f90 b/cdfmeanvar.f90
new file mode 100644
index 0000000..1dd52b4
--- /dev/null
+++ b/cdfmeanvar.f90
@@ -0,0 +1,184 @@
+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
new file mode 100644
index 0000000..3030a0f
--- /dev/null
+++ b/cdfmhst-full.f90
@@ -0,0 +1,359 @@
+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
new file mode 100644
index 0000000..6241575
--- /dev/null
+++ b/cdfmhst.f90
@@ -0,0 +1,365 @@
+PROGRAM cdfmhst
+ !!--------------------------------------------------------------------
+ !! *** PROGRAM cdfmhst ***
+ !!
+ !! ** 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).
+ !!
+ !!
+ !! 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
+ 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, 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.
+
+ !! 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'
+ 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),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 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,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
+ 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)
+
+
+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
new file mode 100644
index 0000000..232de4e
--- /dev/null
+++ b/cdfmht_gsop.f90
@@ -0,0 +1,523 @@
+PROGRAM cdfmht_gsop
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfmht_gsop ***
+ !!
+ !! ** Purpose : Compute the Meridional Heat Transport (MHT)
+ !! Components for GSOP intercomparison
+ !! PARTIAL STEPS
+ !!
+ !! ** Method : The MHT is computed from the V velocity field and T temperature field, integrated
+ !! from the bottom to the surface.
+ !! The MHT is decomposed into 3 components : BT, SH, AG.
+ !! Results are saved on gsopmht.nc file with variables name respectively
+ !! zomhtatl, zobtmhta, zoshmhta, zoagmhta
+ !!
+ !!
+ !! 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
+ !!
+ !! A. Lecointre (Dec 2008) Replaced by a MHT decomposition
+ !!
+ !!-------------------------------------------------------------------
+ !! $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 :: btht
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zt,zt_v,zsal,tmask,umask,vmask, vgeoz
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zsig0
+ REAL(KIND=4), DIMENSION (:,:,:), ALLOCATABLE :: vgeo,vgeosh,vageosh,vfull,tfull,vmaskz,tmaskz
+ REAL(KIND=4) :: rau0, grav, f0, fcor, zmsv, zphv, rpi
+! REAL(KIND=4) :: 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 :: zomht !: jpbasins x npjglo
+ REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zomht_gsop !: jpgsop x npjglo
+ REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zomht_geos_full !: npjglo x npk
+ REAL(KIND=8) ,DIMENSION(:,:) , ALLOCATABLE :: zomht_ageos_full !: npjglo x npk
+ REAL(KIND=8) ,DIMENSION(:,:,:) , ALLOCATABLE :: zomhtfull !: jpbasin x npjglo x npk
+
+
+ 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
+ LOGICAL :: llglo = .false. !: indicator for presence of new_maskglo.nc file
+ INTEGER :: istatus
+
+ ! constants
+ REAL(KIND=4),PARAMETER :: rho0=1000., rcp=4000. ! rau0 en kg x m-3 et rcp en m2 x s-2 x degC-1
+
+ !! Read command line and output usage message if not compliant.
+ narg= iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfmht_gsop V file Tfile'
+ PRINT *,' Computes the MHT for atlantic basin'
+ 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 gsopmht.nc: '
+ PRINT *,' variables zomhtatl : MHT Atlantic Ocean '
+ PRINT *,' variables zobtmhta : Barotropic component '
+ PRINT *,' variables zoshmhta : Vertical shear geostrophic component '
+ PRINT *,' variables zoagmhta : vertical shear ageostrophic component (Ekman + residu)'
+ 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
+
+ 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'
+
+ 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 ( tmaskz(npiglo,npjglo,npk) )
+ ALLOCATE ( umask(npiglo,npjglo) )
+ ALLOCATE ( vmask(npiglo,npjglo) )
+ ALLOCATE ( vmaskz(npiglo,npjglo,npk) )
+ ALLOCATE ( zv(npiglo,npjglo) )
+ ALLOCATE ( vfull(npiglo,npjglo,npk) )
+ ALLOCATE ( zt(npiglo,npjglo), zt_v(npiglo,npjglo) ) ! temperature au point T et au point V
+ ALLOCATE ( tfull(npiglo,npjglo,npk) ) ! temperature au point V
+ ALLOCATE ( e1u(npiglo,npjglo),e1v(npiglo,npjglo),e3v(npiglo,npjglo), gphiv(npiglo,npjglo) ,gdepw(npk) )
+ ALLOCATE ( Hdep(npiglo,npjglo), vbt(npiglo,npjglo) )
+ ALLOCATE ( e3vz(npiglo,npjglo,npk) )
+ ALLOCATE ( zomhtfull(jpbasins,npjglo,npk) )
+ ALLOCATE ( zomht(jpbasins, npjglo) )
+ ALLOCATE ( zomht_gsop(jpgsop, npjglo) )
+ ALLOCATE ( btht(npjglo,npk) )
+ ALLOCATE ( zsal(npiglo,npjglo), zsig0(npiglo,npjglo) )
+ ALLOCATE ( deptht(npk) )
+ ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
+ ALLOCATE ( zzmask(npiglo,npjglo) )
+ ALLOCATE ( vgeo(npiglo,npjglo,npk) )
+ ALLOCATE ( vgeoz(npiglo,npjglo) )
+ ALLOCATE ( vgeosh(npiglo,npjglo,npk) )
+ ALLOCATE ( zomht_geos_full(npjglo,npk) )
+ ALLOCATE ( vageosh(npiglo,npjglo,npk) )
+ ALLOCATE ( zomht_ageos_full(npjglo,npk) )
+
+ 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,1,cdep='depthw')
+ ierr= createvar(ncout ,typvar,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')
+
+ ! 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 mht to 0
+ zomht(:,:) = 0.
+ zomhtfull(:,:,:) = 0.
+ zomht_gsop(:,:) = 0.
+ vbt(:,:) = 0.0
+ Hdep(:,:) = 0.0
+ btht(:,:) = 0.0
+ vgeo(:,:,:)=0.0
+ vfull(:,:,:)=0.0
+ tfull(:,:,:)=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 temperature T and e3v_ps and masks at all levels
+ DO jk = 1,npk
+ vmask(:,:)=getvar('mask.nc','vmask',jk,npiglo,npjglo)
+ vmaskz(:,:,jk) = vmask(:,:)
+ tmask(:,:)=getvar('mask.nc','tmask',jk,npiglo,npjglo)
+ tmaskz(:,:,jk) = tmask(:,:)
+ zv(:,:)= getvar(cfilev, 'vomecrty', jk ,npiglo,npjglo) ! au point V
+ vfull(:,:,jk) = zv(:,:) ! au point V
+ zt(:,:)= getvar(cfilet, 'votemper', jk,npiglo,npjglo) ! au point T
+ DO ji = 1,npiglo ! mettre la temperature au point V
+ DO jj = 1,npjglo-1
+ zt_v(ji,jj)= ((zt(ji,jj) + zt(ji,jj+1)) * tmask(ji,jj) * tmask(ji,jj+1))/2
+ END DO
+ END DO
+ tfull(:,:,jk)= zt_v(:,:) ! au point V
+ e3v(:,:) = getvar(coordzgr, 'e3v_ps', jk,npiglo,npjglo)
+ e3vz(:,:,jk) = e3v(:,:)
+ ENDDO
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! CALCUL OF THE TOTAL MHT
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ DO jk = 1,npk-1
+ ! MHT totale au point V
+ ! integrates 'zonally' (along i-coordinate)
+ DO ji=1,npiglo
+ ! For all basins
+ DO jbasin = 1, jpbasins
+ DO jj=1,npjglo
+ zomhtfull(jbasin,jj,jk) = zomhtfull(jbasin,jj,jk) + vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(jbasin,ji,jj)*vfull(ji,jj,jk)*tfull(ji,jj,jk)*rho0*rcp/1.e15
+ 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 the total MHT
+ DO jk=npk , 1 , -1
+ zomht(:,:) = zomht(:,:) + zomhtfull(:,:,jk)
+ END DO ! loop to next level
+ ! Save variable in zomht_gsop
+ zomht_gsop(4,:) = zomht(2,:)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! CALCUL OF THE BAROTROPIC MHT
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ ! Calculate ATLANTIC Barotropic velocity au point V
+ 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
+ btht(jj,jk) = btht(jj,jk) + vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vbt(ji,jj)*tfull(ji,jj,jk)*rho0*rcp/1.e15
+ ENDDO
+ ENDDO
+ ENDDO
+
+ ! Now Integrate vertically to get Barotropic Meridional Heat Transport
+ DO jk=npk , 1 , -1
+ zomht_gsop(1,:)=zomht_gsop(1,:) + btht(:,jk)
+ END DO ! loop to next level
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! CALCUL OF THE GEOSTROPHIC MHT
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! reinitialiser la temperature au point T a 0
+zt(:,:)=0.0
+ DO jk = 1,npk-1
+ ! Calculate density !! attention, density est au point U, il faut la mettre au point V
+ zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo)
+ zt(:,:)= getvar(cfilet, 'votemper', jk,npiglo,npjglo) ! au point T
+
+ zzmask=1
+ WHERE(zsal(:,:)* zmask(2,:,:) == 0 ) zzmask = 0
+ ! geostrophic calculation must use in situ density gradient
+ ! la il faut prendre la temperature au point T
+ zsig0(:,:) = sigmai ( zt,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 MHT - integrate over x
+ zomht_geos_full(:,:) = 0.0
+ DO jk=1, npk
+ DO jj=1,npjglo
+ DO ji=1,npiglo
+ zomht_geos_full(jj,jk) = zomht_geos_full(jj,jk) + &
+ & vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vgeosh(ji,jj,jk)*tfull(ji,jj,jk)*rho0*rcp/1.e15
+ END DO
+ ENDDO
+ ENDDO
+ ! Integrate vertically the geostrophic MHT
+ DO jk=npk , 1 , -1
+ zomht_gsop(2,:) = zomht_gsop(2,:) + zomht_geos_full(:,jk)
+ END DO ! loop to next level
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! CALCUL OF THE AGEOSTROPHIC MHT
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ vageosh(:,:,:)=0.0
+ ! Calculate Vageostrophique au point V
+ DO jk=1,npk
+ vageosh(:,:,jk)=vfull(:,:,jk)-vgeosh(:,:,jk)-vbt(:,:)
+ END DO
+
+ ! Calculate vertical shear ageostrophique streamfunction - integrate over x
+ zomht_ageos_full(:,:) = 0.0
+ DO jk=1, npk
+ DO jj=1,npjglo
+ DO ji=1,npiglo
+ zomht_ageos_full(jj,jk) = zomht_ageos_full(jj,jk) + vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vageosh(ji,jj,jk)*tfull(ji,jj,jk)*rho0*rcp/1.e15
+ END DO
+ ENDDO
+ ENDDO
+
+ ! Now Integrate vertically to get streamfunction AGEOSTROPHIE
+ DO jk=npk , 1 , -1
+ zomht_gsop(3,:) = zomht_gsop(3,:) + zomht_ageos_full(:,jk)
+ END DO ! loop to next level
+
+
+
+
+! ! integrates vertically from bottom to surface the total MHT
+! DO jk=npk-1 , 1 , -1
+! zomht(:,:,jk) = zomht(:,:,jk+1) + zomht(:,:,jk)
+! END DO ! 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
+! END DO
+! ENDDO
+
+! ! Calculate Barotropic Meridional Heat Transport - integrate over x
+! DO jk=1, npk
+! DO jj=1,npjglo
+! DO ji=1,npiglo
+! btht(jj,jk) = btht(jj,jk) - vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vbt(ji,jj)*ztfull(ji,jj,jk)/1.e15
+! END DO
+! ENDDO
+! ENDDO
+
+ ! Now Integrate vertically to get Barotropic Meridional Heat Transport
+! DO jk=npk-1 , 1 , -1
+! btht(:,jk) = btht(:,jk+1) + btht(:,jk)
+! END DO ! loop to next level
+
+! ! Calculate Vageostrophique au point V
+! DO jk=1,npk
+! vageosh(:,:,jk)=vfull(:,:,jk)-vgeosh(:,:,jk)-vbt(:,:)
+! END DO
+
+! ! Calculate vertical shear ageostrophique streamfunction - integrate over x
+! DO jk=1, npk
+! DO jj=1,npjglo
+! DO ji=1,npiglo
+! zomht_gsop(3,jj,jk) = zomht_gsop(3,jj,jk) - vmaskz(ji,jj,jk)*e1v(ji,jj)*e3vz(ji,jj,jk)*zmask(2,ji,jj)*vageosh(ji,jj,jk)*ztfull(ji,jj,jk)/1.e15
+! END DO
+! ENDDO
+! ENDDO
+
+! ! Now Integrate vertically to get streamfunction AGEOSTROPHIE
+! DO jk=npk-1 , 1 , -1
+! zomht_gsop(3,:,jk) = zomht_gsop(3,:,jk+1) + zomht_gsop(3,:,jk)
+! END DO ! loop to next level
+
+! ! Save variables in zomht_gsop
+! zomht_gsop(1,:,:) = btht(:,:)
+! zomht_gsop(4,:,:) = zomht(2,:,:)
+
+ jj = 190
+ FIND26: DO jj=1,npjglo
+ IF ( dumlat(1,jj) > 26.0 ) EXIT FIND26
+ ENDDO FIND26
+ print *, 'MHT:zomht_gsop(4,jj) = ', zomht_gsop(4,jj)
+ print *, 'BT:zomht_gsop(1,jj) = ', zomht_gsop(1,jj)
+ print *, 'SH:zomht_gsop(2,jj) = ', zomht_gsop(2,jj)
+ print *, 'AG:zomht_gsop(3,jj) = ', zomht_gsop(3,jj)
+
+ !---------------------------------
+ ! netcdf output
+ !---------------------------------
+
+ !print *, 'Writing netcdf...'
+ DO jgsop = 1, jpgsop
+ ierr = putvar (ncout, id_varout_gsop(jgsop),REAL(zomht_gsop(jgsop,:)), 1,1,npjglo)
+ ENDDO
+
+ ierr = closeout(ncout)
+
+END PROGRAM cdfmht_gsop
diff --git a/cdfmkmask-zone.f90 b/cdfmkmask-zone.f90
new file mode 100644
index 0000000..3ac4f31
--- /dev/null
+++ b/cdfmkmask-zone.f90
@@ -0,0 +1,142 @@
+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
new file mode 100644
index 0000000..c47828c
--- /dev/null
+++ b/cdfmkmask.f90
@@ -0,0 +1,122 @@
+PROGRAM cdfmkmask
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfmkmask ***
+ !!
+ !! ** 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$
+ !! $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 !: 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()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfmkmask gridT '
+ 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
+ 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.
+ 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
diff --git a/cdfmltmask.f90 b/cdfmltmask.f90
new file mode 100644
index 0000000..b92f128
--- /dev/null
+++ b/cdfmltmask.f90
@@ -0,0 +1,152 @@
+PROGRAM cdfmltmask
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfmltmask ***
+ !!
+ !! ** 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
+ USE cdfio
+
+ !! * Local variables
+ 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()
+ 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'
+ STOP
+ ENDIF
+
+ CALL getarg (1, cfilev)
+ CALL getarg (2, cfilemask)
+ CALL getarg (3, cvar)
+ CALL getarg (4, cvartype)
+
+ ! 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
+ PRINT *,' assume file with no depth'
+ npk=0
+ ENDIF
+ ENDIF
+ 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
+ PRINT *,' assume file with no depth'
+ npkmask=0
+ ENDIF
+ ENDIF
+ ENDIF
+
+ npt = getdim (cfilev,'time')
+ nvpk = getvdim(cfilev,cvar)
+
+ 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
+
+ IF (npk==0) npk=1
+
+ ! Allocate arrays
+ ALLOCATE ( zmask(npiglo,npjglo) )
+ ALLOCATE ( zv(npiglo,npjglo) )
+ ALLOCATE(zvmask(npiglo,npjglo))
+
+ SELECT CASE (TRIM(cvartype))
+ CASE ( 'T' )
+ cvmask='tmask'
+ CASE ( 'U' )
+ cvmask='umask'
+ CASE ( 'V' )
+ cvmask='vmask'
+ CASE ( 'F' )
+ cvmask='fmask'
+ CASE ( 'W' )
+ cvmask='tmask'
+ CASE ( 'P' ) ! for polymask
+ cvmask='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)
+ 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)
+ IF ( npkmask > 1 ) THEN
+ ! Read mask
+ zmask(:,:)=getvar(cfilemask,cvmask,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)
+ 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)
+
+
+END PROGRAM cdfmltmask
diff --git a/cdfmoc-full.f90 b/cdfmoc-full.f90
new file mode 100644
index 0000000..955cc0b
--- /dev/null
+++ b/cdfmoc-full.f90
@@ -0,0 +1,201 @@
+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
new file mode 100644
index 0000000..eb476e0
--- /dev/null
+++ b/cdfmoc.f90
@@ -0,0 +1,211 @@
+PROGRAM cdfmoc
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfmoc ***
+ !!
+ !! ** 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
+ !!
+ !!
+ !! history ;
+ !! Original : J.M. Molines (jul. 2005)
+ !! A.M. Treguier (april 2006) adaptation to NATL4 case
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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.
+ 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'
+ 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
+ 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
+ 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(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, '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')
+
+
+ ! 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.
+ ENDIF
+
+ ! 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
+ 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
diff --git a/cdfmoc_gsop.f90 b/cdfmoc_gsop.f90
new file mode 100644
index 0000000..338ae59
--- /dev/null
+++ b/cdfmoc_gsop.f90
@@ -0,0 +1,424 @@
+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
new file mode 100644
index 0000000..7f292e9
--- /dev/null
+++ b/cdfmoc_gsop_x.f90
@@ -0,0 +1,507 @@
+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
new file mode 100644
index 0000000..dc7c7d8
--- /dev/null
+++ b/cdfmocatl.f90
@@ -0,0 +1,156 @@
+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
new file mode 100644
index 0000000..bfefaf7
--- /dev/null
+++ b/cdfmocsig-full.f90
@@ -0,0 +1,247 @@
+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
new file mode 100644
index 0000000..3987c00
--- /dev/null
+++ b/cdfmocsig.f90
@@ -0,0 +1,251 @@
+PROGRAM cdfmocsig
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfmocs1 ***
+ !!
+ !! ** Purpose : Compute the Meridional Overturning Cell (MOC)
+ !! PARTIAL 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)
+ ! 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'
+
+ 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_2')
+ 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, 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
+ 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/cdfmoy.f90 b/cdfmoy.f90
new file mode 100644
index 0000000..0ec9e90
--- /dev/null
+++ b/cdfmoy.f90
@@ -0,0 +1,194 @@
+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
+ !! 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 :: 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
+ npk = getdim (cfile,'nav_lev',cdtrue=cdep,kstatus=istatus)
+ IF ( istatus /= 0 ) THEN
+ PRINT *,' assume file with no depth'
+ npk=0
+ ENDIF
+ 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) )
+ 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
+
+ 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 )
+ 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
diff --git a/cdfmoy3.f90 b/cdfmoy3.f90
new file mode 100644
index 0000000..17676c1
--- /dev/null
+++ b/cdfmoy3.f90
@@ -0,0 +1,261 @@
+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
new file mode 100644
index 0000000..41f7c3c
--- /dev/null
+++ b/cdfmoy_annual.f90
@@ -0,0 +1,143 @@
+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
new file mode 100644
index 0000000..eb0a506
--- /dev/null
+++ b/cdfmoy_chsp.f90
@@ -0,0 +1,198 @@
+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
new file mode 100644
index 0000000..ad851ee
--- /dev/null
+++ b/cdfmoy_freq.f90
@@ -0,0 +1,196 @@
+PROGRAM cdfmoy_freq
+ !!-----------------------------------------------------------------------
+ !! *** 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
+ !! Modified : P. Mathiot (June 2007) update for forcing fields
+ !!-----------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !!
+ USE cdfio
+
+ 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
+
+ !!
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfmoy_freq forcing_field frequency (monthly or daily or annual)'
+ STOP
+ ENDIF
+ !!
+ !! Initialisation from 1st file (all file are assume to have the same geometry)
+ CALL getarg (1, cfile)
+ 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'
+ STOP
+ END IF
+
+
+ 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), 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
+
+ PRINT *, '',cvarname
+
+ ! 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
+
+ IF (nt .LE. nt_out) THEN
+ PRINT *, 'You don''t need to use it, or it is impossible'
+ STOP
+ END IF
+ jt=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
+ ! 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
+ 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
+ IF (nt_out==12) THEN
+ IF (ntframe .EQ. njm(nmois)*nt_in/365) THEN
+ PRINT *, nmois, jtt,'/',nt
+ jt=jt+1
+ ! finish with level jk ; compute mean (assume spval is 0 )
+ rmean(:,:) = tab(:,:)/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
+ 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
+ ! finish with level jk ; compute mean (assume spval is 0 )
+ rmean(:,:) = tab(:,:)/ntframe
+ PRINT *, '',rmean(100,100)
+ ! store variable on outputfile
+ ierr = putvar(ncout, id_varout(jvar) ,rmean, jt, npiglo, npjglo, jt)
+ tab(:,:) = 0.d0 ; total_time = 0.; ntframe=0
+ END IF
+ END IF
+ ENDDO
+ END IF
+ END DO ! loop to next var in file
+
+ istatus = closeout(ncout)
+
+
+END PROGRAM cdfmoy_freq
diff --git a/cdfmoy_mpp.f90 b/cdfmoy_mpp.f90
new file mode 100644
index 0000000..381d67a
--- /dev/null
+++ b/cdfmoy_mpp.f90
@@ -0,0 +1,282 @@
+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
new file mode 100644
index 0000000..871406c
--- /dev/null
+++ b/cdfmoy_sal2_temp2.f90
@@ -0,0 +1,169 @@
+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
new file mode 100644
index 0000000..22b9620
--- /dev/null
+++ b/cdfmoy_sp.f90
@@ -0,0 +1,196 @@
+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/cdfmoyt.f90 b/cdfmoyt.f90
new file mode 100644
index 0000000..993bb0b
--- /dev/null
+++ b/cdfmoyt.f90
@@ -0,0 +1,196 @@
+PROGRAM cdfmoyt
+ !!-----------------------------------------------------------------------
+ !! *** PROGRAM cdfmoyt ***
+ !!
+ !! ** 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$
+ !!--------------------------------------------------------------
+ !!
+ USE cdfio
+
+ 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
+
+ !!
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfmoyt ''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)
+ 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
+ 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) )
+ ALLOCATE ( total_time(nt) ,timean(nt), tim(nt) )
+
+ 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) /= 'sst' ) 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)
+
+ 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
+ END DO
+ ierr=putvar1d(ncout,timean,nt,'T')
+ ierr=putvar1d(ncout2,timean,nt,'T')
+
+ istatus = closeout(ncout)
+ istatus = closeout(ncout2)
+
+
+END PROGRAM cdfmoyt
diff --git a/cdfmoyuv.f90 b/cdfmoyuv.f90
new file mode 100644
index 0000000..52c367a
--- /dev/null
+++ b/cdfmoyuv.f90
@@ -0,0 +1,193 @@
+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
new file mode 100644
index 0000000..0bb5865
--- /dev/null
+++ b/cdfmoyuvwt.f90
@@ -0,0 +1,328 @@
+PROGRAM cdfmoyuvwt
+ !!---------------------------------------------------------------------------
+ !! *** 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, 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
+
+ !!
+ 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
+ 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
+ END DO
+
+ 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(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'
+
+ 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
+
+ ! 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)
+
+ ! 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
+ 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) )
+ 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)
+
+
+ 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 = closeout(ncout)
+
+END PROGRAM cdfmoyuvwt
+
diff --git a/cdfmsk.f90 b/cdfmsk.f90
new file mode 100644
index 0000000..355a22e
--- /dev/null
+++ b/cdfmsk.f90
@@ -0,0 +1,60 @@
+PROGRAM cdfmsk
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfmsk ***
+ !!
+ !! ** 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
+ 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
+
+ INTEGER :: ncout, npt
+ INTEGER :: istatus
+ REAL(4) :: ss
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfmsk maskfile '
+ STOP
+ ENDIF
+
+ CALL getarg (1, cfilet)
+ npiglo= getdim (cfilet,'x')
+ npjglo= getdim (cfilet,'y')
+ npk = getdim (cfilet,'z')
+
+ ALLOCATE (zmask(npiglo,npjglo))
+
+ npt= 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,' %'
+
+END PROGRAM cdfmsk
diff --git a/cdfmsksal.f90 b/cdfmsksal.f90
new file mode 100644
index 0000000..da17ed5
--- /dev/null
+++ b/cdfmsksal.f90
@@ -0,0 +1,78 @@
+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
new file mode 100644
index 0000000..12d9b50
--- /dev/null
+++ b/cdfmxl-full.f90
@@ -0,0 +1,181 @@
+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
new file mode 100644
index 0000000..88120fb
--- /dev/null
+++ b/cdfmxl.f90
@@ -0,0 +1,184 @@
+PROGRAM cdfmxl
+ !!---------------------------------------------------------------------
+ !! *** PROGRAM cdfmxl ***
+ !!
+ !! ** 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
+ !!
+ !! history :
+ !! Original : J.M. Molines (October 2005)
+ !!---------------------------------------------------------------------
+ !! $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
+
+ 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'
+ 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)
+ INQUIRE (FILE=cbathy, EXIST=lexist)
+ IF ( lexist ) THEN
+ temp(:,:) = getvar(cbathy,'Bathy_level',1, npiglo, npjglo)
+ ELSE
+ temp(:,:) = getvar(coordzgr,'mbathy',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)
+
+
+END PROGRAM cdfmxl
diff --git a/cdfmxlhcsc.f90 b/cdfmxlhcsc.f90
new file mode 100644
index 0000000..077b71a
--- /dev/null
+++ b/cdfmxlhcsc.f90
@@ -0,0 +1,263 @@
+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 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
+ !!
+ !! 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
+ USE cdfio
+ USE eos
+
+ !! * Local variables
+ 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)'
+ 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
+
+ ! read dimensions
+ npiglo= getdim (cfilet,'x')
+ npjglo= getdim (cfilet,'y')
+ npk = getdim (cfilet,'depth')
+
+ dep(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'
+
+
+ !PRINT *, 'npiglo=', npiglo
+ !PRINT *, 'npjglo=', npjglo
+ !PRINT *, 'npk =', npk
+
+
+ ! 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
+ ENDDO
+ ENDDO
+
+
+ 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
+
+ !! 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')
+
+ ierr = closeout(ncout)
+
+
+END PROGRAM cdfmxlhcsc
diff --git a/cdfmxlheatc-full.f90 b/cdfmxlheatc-full.f90
new file mode 100644
index 0000000..13565b9
--- /dev/null
+++ b/cdfmxlheatc-full.f90
@@ -0,0 +1,138 @@
+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
new file mode 100644
index 0000000..ce4c425
--- /dev/null
+++ b/cdfmxlheatc.f90
@@ -0,0 +1,136 @@
+PROGRAM cdfmxlheatc
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfmxlheatc ***
+ !!
+ !! ** 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
+ !!
+ !!
+ !! 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 :: 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()
+ 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'
+ 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(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)
+
+ ! 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
+
+ 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
diff --git a/cdfmxlsaltc.f90 b/cdfmxlsaltc.f90
new file mode 100644
index 0000000..14b2557
--- /dev/null
+++ b/cdfmxlsaltc.f90
@@ -0,0 +1,133 @@
+PROGRAM cdfmxlsaltc
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfmxlsaltc ***
+ !!
+ !! ** 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
+ !!
+ !!
+ !! 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 :: 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()
+ 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'
+ 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= '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'
+
+
+ PRINT *, 'npiglo=', npiglo
+ PRINT *, 'npjglo=', npjglo
+ PRINT *, 'npk =', npk
+
+ ! Allocate arrays
+ ALLOCATE ( zmask(npiglo,npjglo) , zmxlsaltc(npiglo, npjglo) )
+ ALLOCATE ( zs(npiglo,npjglo) ,zmxl(npiglo,npjglo) )
+ ALLOCATE ( e3(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)
+
+ ! 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
+
+ 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)
+
+END PROGRAM cdfmxlsaltc
diff --git a/cdfnrjcomp.f90 b/cdfnrjcomp.f90
new file mode 100644
index 0000000..2705b37
--- /dev/null
+++ b/cdfnrjcomp.f90
@@ -0,0 +1,169 @@
+PROGRAM cdfnrjcomp
+ !!---------------------------------------------------------------------------
+ !! *** 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
+ !!
+ !! history :
+ !! Original : A. Melet (Feb 2008)
+ !!---------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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
+
+ !!
+ 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)'
+ 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'
+
+ 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'
+
+
+ typvar%units=' '
+ typvar%missing_value=0.
+ typvar%valid_min= -1000.
+ typvar%valid_max= 1000.
+ typvar%online_operation='N/A'
+ typvar%axis='TYX'
+
+ ipk(:) = npk
+
+ !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)
+
+ ! 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 ( anotsqrt(npiglo,npjglo) )
+
+
+ tim=getvar1d(cfile,'time_counter',nt)
+ ierr=putvar1d(ncout,tim,1,'T')
+
+ DO jk=1, npk
+ PRINT *,' level ',jk
+
+ anousqrt(:,:) = 0.d0
+ anovsqrt(:,:) = 0.d0
+ anotsqrt(:,:) = 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)
+ tn(:,:) = getvar(cfile, 'tbar', jk ,npiglo,npjglo, ktime=1)
+ t2n(:,:) = getvar(cfile, '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)
+ IF (umask(ji,jj) /= 0.) umask(ji,jj)=1.
+ IF (vmask(ji,jj) /= 0.) vmask(ji,jj)=1.
+ ENDDO
+ ENDDO
+
+ 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) ) &
+ & + ( 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) ) )
+
+ 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)
+ END DO
+ ierr = closeout(ncout)
+
+END PROGRAM cdfnrjcomp
+
diff --git a/cdfpendep.f90 b/cdfpendep.f90
new file mode 100644
index 0000000..dda7ea6
--- /dev/null
+++ b/cdfpendep.f90
@@ -0,0 +1,99 @@
+PROGRAM cdfpendep
+ !!-------------------------------------------------------------------
+ !! PROGRAM CDFPENDEP
+ !! *****************
+ !!
+ !! ** 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
+ !!
+ !! history:
+ !! Original: J.M. Molines (Feb. 2008(
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !!
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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, 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()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfpendep ''TRC file'' [-inv inventory_name -trc trc_name ]'
+ PRINT *,' if not given, inventory name is cfcinv, and trc name is cfc '
+ PRINT *,' Output on pendep.nc ,variable pendep (m) '
+ 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 ('-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,'depth')
+
+ 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(cfiletrc,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
diff --git a/cdfpolymask.f90 b/cdfpolymask.f90
new file mode 100644
index 0000000..7c8dc04
--- /dev/null
+++ b/cdfpolymask.f90
@@ -0,0 +1,132 @@
+PROGRAM cdfpolymask
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM CDFPOLYMASK ***
+ !!
+ !! ** 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 )
+ !!
+ !! history:
+ !! Original: J.M. Molines (July 2007 )
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !!
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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
+
+ 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'
+
+
+ PRINT *, 'npiglo=', npiglo
+ PRINT *, 'npjglo=', npjglo
+
+ ALLOCATE( rpmask(npiglo,npjglo) )
+
+ ncout =create(cfileout, cfile,npiglo,npjglo,npk)
+
+ ierr= createvar(ncout ,typvar,1, ipk,id_varout )
+ ierr= putheadervar(ncout, cfile, npiglo, npjglo,npk)
+
+ CALL polymask(cpoly, rpmask)
+
+ 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)
+
+CONTAINS
+ SUBROUTINE polymask( cdpoly, pmask)
+ 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
+ IF ( lreverse ) THEN
+ rin=0. ; rout=1.
+ ELSE
+ rin=1. ; rout=0.
+ ENDIF
+ pmask(:,:)=rout
+ CALL ReadPoly(cdpoly,nfront, carea)
+ DO jjpoly=1, nfront
+ 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
+ ENDDO
+! IF ( jj < 405 .AND. jj > 335 ) THEN
+! print '(i4,100i2)', jj, NINT(pmask(170:260,jj))
+! ENDIF
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE polymask
+
+END PROGRAM cdfpolymask
diff --git a/cdfprobe.f90 b/cdfprobe.f90
new file mode 100644
index 0000000..b189a56
--- /dev/null
+++ b/cdfprobe.f90
@@ -0,0 +1,41 @@
+PROGRAM cdfprobe
+ !!----------------------------------------------------------------
+ !! *** 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$
+ !!--------------------------------------------------------------
+ USE cdfio
+ IMPLICIT NONE
+ INTEGER :: narg, iargc
+ INTEGER :: ilook, jlook, ilevel
+ CHARACTER(LEN=256) :: cfile, cdum , cvar
+
+ 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
+ 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)
+ IF ( narg == 5 ) THEN
+ CALL getarg(5, cdum) ; READ(cdum,*) ilevel
+ CALL gettimeseries(cfile,cvar,ilook,jlook,klev=ilevel)
+ ELSE
+ CALL gettimeseries(cfile,cvar,ilook,jlook)
+ ENDIF
+
+END PROGRAM cdfprobe
diff --git a/cdfprofile.f90 b/cdfprofile.f90
new file mode 100644
index 0000000..4050728
--- /dev/null
+++ b/cdfprofile.f90
@@ -0,0 +1,69 @@
+PROGRAM cdfprofile
+ !!---------------------------------------------------------------------
+ !! *** PROGRAM cdfprofile ***
+ !!
+ !! ** Purpose: extract a verticcal profile from a CDFfile
+ !!
+ !! ** 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
+ USE cdfio
+
+ !! * Local variables
+ IMPLICIT NONE
+ INTEGER :: narg, iargc, istatus
+ INTEGER :: jk
+ INTEGER :: ilook, jlook
+ INTEGER :: npiglo, npjglo, npk
+
+ REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: v2d
+ REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: depth, profile
+
+ CHARACTER(LEN=256) :: cdum, cfile, cvar, cdep
+
+ !! Read command line and output usage message if not compliant.
+ narg= iargc()
+ IF ( narg /= 4 ) THEN
+ PRINT *,' Usage : cdfprofile I J file varname '
+ PRINT *,' Output on standard output'
+ STOP
+ ENDIF
+
+
+ CALL getarg (1, cdum)
+ READ(cdum,*) ilook
+ CALL getarg (2, cdum)
+ READ(cdum,*) jlook
+ CALL getarg(3, cfile)
+ CALL getarg(4, cvar)
+
+ npiglo= getdim (cfile,'x')
+ npjglo= getdim (cfile,'y')
+ npk = getdim (cfile,'depth',cdep)
+
+ ! Allocate arrays
+ ALLOCATE( v2d (npiglo,npjglo), depth(npk) ,profile(npk) )
+
+ depth(:) = getvar1d(cfile,cdep,npk,istatus)
+
+ DO jk=1,npk
+ v2d (:,:)= getvar(cfile, cvar, jk ,npiglo,npjglo)
+ profile(jk) = v2d(ilook,jlook)
+ END DO
+ PRINT *, "FILE : ", TRIM(cfile)
+ PRINT *, " ", TRIM(cdep)," ", TRIM(cvar),"(",ilook,",",jlook,")"
+ DO jk=1, npk
+ PRINT *, depth(jk), profile(jk)
+ END DO
+
+END PROGRAM cdfprofile
diff --git a/cdfpsi-austral-ssh.f90 b/cdfpsi-austral-ssh.f90
new file mode 100644
index 0000000..0fea1fc
--- /dev/null
+++ b/cdfpsi-austral-ssh.f90
@@ -0,0 +1,232 @@
+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
new file mode 100644
index 0000000..3ed92db
--- /dev/null
+++ b/cdfpsi-full.f90
@@ -0,0 +1,155 @@
+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
new file mode 100644
index 0000000..ca170aa
--- /dev/null
+++ b/cdfpsi-open-zap.f90
@@ -0,0 +1,182 @@
+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
new file mode 100644
index 0000000..99bc2a0
--- /dev/null
+++ b/cdfpsi-open.f90
@@ -0,0 +1,197 @@
+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
new file mode 100644
index 0000000..9bb0bbf
--- /dev/null
+++ b/cdfpsi-open_AM.f90
@@ -0,0 +1,151 @@
+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
new file mode 100644
index 0000000..652c656
--- /dev/null
+++ b/cdfpsi.f90
@@ -0,0 +1,158 @@
+PROGRAM cdfpsi
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfpsi ***
+ !!
+ !! ** 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
+ !! (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
+ !!
+ !! 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, 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, psiu, psiv
+
+ 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
+
+ ! constants
+
+ !! 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'
+ 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)'
+
+ ! 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), 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
+ 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
+ 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
+ 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
diff --git a/cdfpv.f90 b/cdfpv.f90
new file mode 100644
index 0000000..62368fe
--- /dev/null
+++ b/cdfpv.f90
@@ -0,0 +1,205 @@
+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.f90 b/cdfpvor.f90
new file mode 100644
index 0000000..6e12e02
--- /dev/null
+++ b/cdfpvor.f90
@@ -0,0 +1,237 @@
+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 )
+ !!
+ !! * 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
+ 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
+ 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 gridT gridU gridV'
+ 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(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')
+
+ ! -------------------------------- 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 '
+ 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
diff --git a/cdfrhoproj.f90 b/cdfrhoproj.f90
new file mode 100644
index 0000000..f589634
--- /dev/null
+++ b/cdfrhoproj.f90
@@ -0,0 +1,249 @@
+PROGRAM cdfrhoproj
+ !! --------------------------------------------------------------
+ !! *** PROGRAM RHO_VERT_INT ***
+ !! ** 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.
+ !!
+ !! ** 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
+ USE cdfio
+
+ !! * Local declaration
+ 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
+ !
+ 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
+
+ TYPE(variable), DIMENSION(2) :: typvar !: structure for attributes
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: typzvar !: structure for attributes
+ !
+ LOGICAL :: lsingle=.false.
+
+ !! * 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
+ 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
+ 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
+ ! 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')
+
+ CALL getarg(istartarg+2, cfildata)
+ nvars=getnvar(cfildata)
+ ALLOCATE(czvar(nvars), typzvar(nvars))
+
+ czvar(:)=getvarname(cfildata,nvars,typzvar)
+
+ ALLOCATE( v3d(npiglo,npjglo,npk), alpha(npiglo, npjglo, npkk) )
+ ALLOCATE( v2dint(npiglo, npjglo), v2d(npiglo,npjglo), zint(npiglo,npjglo) )
+ ALLOCATE( time_tag(npt), h1d(npk) )
+
+ time_tag(:)=getvar1d(cfilRHOMOD,'time_counter', npt)
+ h1d(:)=getvar1d(cfilRHOMOD,'deptht',npk)
+
+ DO jk=1,npk
+ v3d(:,:,jk) = getvar(cfilRHOMOD,'vosigma0',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
+
+ !! ** Loop on the scalar files to project on choosen isopycnics surfaces
+ DO jfich=istartarg+2,narg
+
+ CALL getarg(jfich,cfildata)
+ PRINT *,'working with ', TRIM(cfildata)
+
+ 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
+ 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
+ END DO
+ END DO
+ CASE('W','w' )
+ STOP 'Case W not done yet :( '
+ END SELECT
+ END DO
+
+ ! ... open output file and write header
+ ipk(:)=npkk
+ DO jvar=1,nvars
+ IF ( cvar == typzvar(jvar)%name ) THEN
+ typvar(1)=typzvar(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'
+
+
+ cfilout=TRIM(cfildata)//'.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)
+
+ 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
+ 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)
+ ELSE
+ v2dint(ji,jj)=spval
+ zint (ji,jj)=spval
+ ENDIF
+ ELSE
+ v2dint(ji,jj)=spval
+ zint (ji,jj)=spval
+ 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)
+ END DO
+ ierr = putvar1d(ncout,time_tag,1,'T')
+ ierr = closeout(ncout)
+ END DO ! loop on scalar files
+ PRINT *,'Projection on isopycns completed successfully'
+END PROGRAM cdfrhoproj
diff --git a/cdfrmsssh.f90 b/cdfrmsssh.f90
new file mode 100644
index 0000000..6d3587c
--- /dev/null
+++ b/cdfrmsssh.f90
@@ -0,0 +1,92 @@
+PROGRAM cdfrmsssh
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfrmsssh ***
+ !!
+ !! ** Purpose: Compute RMS SSH
+ !!
+ !! ** Method: Try to avoid 3 d arrays
+ !!
+ !! history :
+ !! Original : J.M. Molines (Nov 2004 ) for ORCA025
+ !! J.M. Molines Apr 2005 : use modules
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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
+
+ TYPE(variable), DIMENSION(1) :: typvar !: structure for attribute
+
+ INTEGER :: ncout
+ INTEGER :: istatus, ierr
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg /= 2 ) THEN
+ PRINT *,' Usage : cdfrmsssh ''gridX gridX2'' '
+ PRINT *,' Output on rms.nc , variable sossheig_rms '
+ 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)
+ END DO
+ timean=getvar1d(cfile,'time_counter',1)
+ ierr=putvar1d(ncout,timean,1,'T')
+ istatus = closeout(ncout)
+
+END PROGRAM cdfrmsssh
diff --git a/cdfsections.f90 b/cdfsections.f90
new file mode 100644
index 0000000..0149b22
--- /dev/null
+++ b/cdfsections.f90
@@ -0,0 +1,899 @@
+program cdfsections
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! *** PROGRAM cdfsections ***
+!
+! ** Purpose : extract oceanic fields along a track made of several sections.
+!
+! ** Method : computes N sections by taking the nearest point north of 60�N
+! and near undefined values (bottom or coasts), and interpolates
+! between the four nearest points elsewhere.
+!
+! ** Outputs : temperature, salinity, density, current (normal/tangeantial)
+! - normal current is positive northward (westward if meridional section)
+! - tangeantial current is on the right of the normal current.
+!
+! NB : it is recommended to put a lot of points on each section if the aim is
+! to compute X-integrations.
+!
+! WARNING :
+! - require large memory : reduce domain size with ncks if insufficient memory error.
+! - does not work if the section crosses the Greenwich line (easy to modify if needed).
+! - not yet tested north of 60�N (but should work) ...
+!
+! history :
+! N. JOURDAIN (LEGI-MEOM), April 2009
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+
+
+USE netcdf
+USE eos
+
+IMPLICIT NONE
+
+!--- Local variables
+INTEGER :: narg, iargc
+
+!--- grid_T
+INTEGER :: fidT, status, dimID_time_counter, dimID_deptht, dimID_y, dimID_x, &
+& mtime_counter, mdeptht, my, mx, vosaline_ID, votemper_ID, time_counter_ID, &
+& deptht_ID, nav_lat_ID, nav_lon_ID, fidM, dimID_s, X_ID, sig0_ID, sig1_ID, &
+& sig2_ID, sig4_ID
+
+!--- grid_U
+INTEGER :: fidU, dimID_depthu, mdepthu, mxu, vozocrtx_ID
+
+!--- grid_V
+INTEGER :: fidV, dimID_depthv, mdepthv, myu, vomecrty_ID
+
+CHARACTER(LEN=256) :: file_in_T, file_out, file_in_U, file_in_V, cdum
+
+REAL*4 :: RT, dtmp_T, dtmp_U, dtmp_V, miniT, miniU, miniV, rr, ang, pi,&
+& latinf, latsup, loninf, lonsup, a, b, c, e, missing, lonref, latref
+
+REAL*8 :: offset
+
+INTEGER :: N1, N2, i, j, k, s, p, iiT, jjT, Nsec, Ntot,Unorm_ID, Utang_ID, cont,&
+& l, iiU, jjU, iiV, jjV, iinf, isup, jinf, jsup
+
+INTEGER,ALLOCATABLE,DIMENSION(:) :: N
+
+REAL*4,ALLOCATABLE,DIMENSION(:) :: lat, lon
+
+LOGICAL,ALLOCATABLE,DIMENSION(:) :: undefined
+
+!---- grid_T
+REAL*4,ALLOCATABLE,DIMENSION(:,:,:,:) :: vosaline, votemper, sig0, sig1, sig2, sig4
+REAL*4,ALLOCATABLE,DIMENSION(:,:,:) :: somxl010, somxlt02, vosaline_sec, votemper_sec
+REAL*4,ALLOCATABLE,DIMENSION(:,:) :: nav_lat_T, nav_lon_T, somxl010_sec, somxlt02_sec
+REAL*4,ALLOCATABLE,DIMENSION(:) :: time_counter, deptht
+
+!---- grid_U
+REAL*4,ALLOCATABLE,DIMENSION(:,:,:,:) :: vozocrtx
+REAL*4,ALLOCATABLE,DIMENSION(:,:,:) :: vozocrtx_sec
+REAL*4,ALLOCATABLE,DIMENSION(:,:) :: nav_lat_U, nav_lon_U
+
+!---- grid_V
+REAL*4,ALLOCATABLE,DIMENSION(:,:,:,:) :: vomecrty
+REAL*4,ALLOCATABLE,DIMENSION(:,:,:) :: vomecrty_sec
+REAL*4,ALLOCATABLE,DIMENSION(:,:) :: nav_lat_V, nav_lon_V
+
+!---- grid section
+REAL*4,ALLOCATABLE,DIMENSION(:,:,:) :: Unorm, Utang, sigsec0, sigsec1, sigsec2, sigsec4
+REAL*4,ALLOCATABLE,DIMENSION(:) :: lonsec, latsec
+REAL*8,ALLOCATABLE,DIMENSION(:) :: d, X1
+
+!-------------------------------------------------------------------------
+! GETTING ARGUMENTS :
+
+!- Read command line and output usage message if not compliant.
+ narg= iargc()
+ IF ( narg.lt.10 ) THEN
+ PRINT *,'Usage : '
+ PRINT *,' cdfsections Ufile Vfile Tfile larf lorf Nsec lat1 lon1 lat2 lon2 n1'
+ PRINT *,' [ lat3 lon3 n2 ] [ lat4 lon4 n3 ] ....'
+ PRINT *,' '
+ PRINT *,' Computes temperature, salinity, sig0, sig1, sig2, sig4, Uorth, Utang '
+ PRINT *,' along a section made of Nsec linear segments (see output attributes).'
+ PRINT *,' Output is section.nc, var. as a function of X(km), depth(m) and time.'
+ PRINT *,' '
+ PRINT *,'Arguments : '
+ PRINT *,' # larf and lorf -> location of X=0 for the X-absice (may be out of section)'
+ PRINT *,' # Nsec -> number of segments used to compute the whole section.'
+ PRINT *,' # lat1,lat2,lat3,... -> extrema latitudes of the segments (from -90 to 90)'
+ PRINT *,' # lon1,lon2,lon3,... -> extrema latitudes of the segments (from 0 to 360)'
+ PRINT *,' # n1, n2, ... -> number of output points on each segment.'
+ PRINT *,' (you have to give Nsec+1 values of lati/loni and Nsec values of ni)'
+ PRINT *,' '
+ PRINT *,' It is recommended to put a lot of points on each section if the aim'
+ PRINT *,' is to compute X-integrations along the section (10 x the model resolution).'
+ PRINT *,'NB : sections cannot cross the Greenwich line !!'
+ PRINT *,'NB : Not yet tested north of 60�N.'
+ PRINT *,'NB : require a large amount of memory !'
+ PRINT *,' -> reduce domain size with ncks -d if insufficient memory error.'
+ PRINT *,' '
+ PRINT *,'Example for one linear section : '
+ PRINT *,' cdfsections U.nc V.nc T.nc 48.0 305.0 1 49.0 307.0 50.5 337.5 20'
+ PRINT *,'Example for a section made of 2 linear segments : '
+ PRINT *,' cdfsections U.nc V.nc T.nc 48.0 305.0 2 49.0 307.0 50.5 337.5 20 40.3 305.1 50'
+ STOP
+ ENDIF
+
+ CALL getarg (1, file_in_U )
+ CALL getarg (2, file_in_V )
+ CALL getarg (3, file_in_T )
+
+ CALL getarg (4, cdum ); READ(cdum,*) latref
+ CALL getarg (5, cdum ); READ(cdum,*) lonref
+ CALL getarg (6, cdum ); READ(cdum,*) Nsec
+
+ if ( narg.ne.8+Nsec*3) then
+ PRINT *, '**!/# ERROR : wrong number of arguments in cdfsections'
+ PRINT *, 'Usage : '
+ PRINT *, ' cdfsections Ufile Vfile Tfile larf lorf Nsec lat1 lon1 lat2 lon2 n1 ....'
+ PRINT *, '-> please execute cdfsections without any arguments for more details.'
+ STOP
+ endif
+
+ ALLOCATE( lat(Nsec+1), lon(Nsec+1) )
+ ALLOCATE( N(Nsec), d(Nsec) )
+
+ CALL getarg (7, cdum ); READ(cdum,*) lat(1)
+ CALL getarg (8, cdum ); READ(cdum,*) lon(1)
+
+ do i=1,(narg-8),3
+ CALL getarg (i+8, cdum ); READ(cdum,*) lat(i/3+2)
+ CALL getarg (i+9, cdum ); READ(cdum,*) lon(i/3+2)
+ CALL getarg (i+10, cdum ); READ(cdum,*) N(i/3+1)
+ enddo
+
+ do i=1,Nsec+1
+ if ( (lon(i).lt.0.0).or.(lonref.lt.0.0) ) then
+ PRINT *, '**!/# ERROR : longitudes must be between 0 and 360'
+ STOP
+ endif
+ enddo
+
+ file_out = 'section.nc'
+
+ !---- Rayon terrestre en km :
+ RT = 6378
+
+ pi = 3.1415927
+ rr = pi / 180.0
+
+!---------------------------------------
+! Read netcdf input file for grid T :
+
+ write(*,*) TRIM(file_in_T)
+
+ status = NF90_OPEN(TRIM(file_in_T),0,fidT)
+ call erreur(status,.TRUE.,"read")
+
+ !Lecture des ID des dimensions qui nous interessent
+ status = NF90_INQ_DIMID(fidT,"time_counter",dimID_time_counter)
+ call erreur(status,.TRUE.,"inq_dimID_time_counter")
+ status = NF90_INQ_DIMID(fidT,"deptht",dimID_deptht)
+ call erreur(status,.TRUE.,"inq_dimID_deptht")
+ status = NF90_INQ_DIMID(fidT,"y",dimID_y)
+ call erreur(status,.TRUE.,"inq_dimID_y")
+ status = NF90_INQ_DIMID(fidT,"x",dimID_x)
+ call erreur(status,.TRUE.,"inq_dimID_x")
+
+ !Lecture des valeurs des dimensions qui nous interessent
+ status = NF90_INQUIRE_DIMENSION(fidT,dimID_time_counter,len=mtime_counter)
+ call erreur(status,.TRUE.,"inq_dim_time_counter")
+ status = NF90_INQUIRE_DIMENSION(fidT,dimID_deptht,len=mdeptht)
+ call erreur(status,.TRUE.,"inq_dim_deptht")
+ status = NF90_INQUIRE_DIMENSION(fidT,dimID_y,len=my)
+ call erreur(status,.TRUE.,"inq_dim_y")
+ status = NF90_INQUIRE_DIMENSION(fidT,dimID_x,len=mx)
+ call erreur(status,.TRUE.,"inq_dim_x")
+
+ write(*,101) mx, my, mdeptht, mtime_counter
+101 FORMAT(' -> dimensions of arrays : (',3(i4,','),i4,')')
+
+ !Allocation of arrays :
+ ALLOCATE( vosaline(mx,my,mdeptht,mtime_counter) )
+ ALLOCATE( votemper(mx,my,mdeptht,mtime_counter) )
+ ALLOCATE( time_counter(mtime_counter) )
+ ALLOCATE( deptht(mdeptht) )
+ ALLOCATE( nav_lat_T(mx,my) )
+ ALLOCATE( nav_lon_T(mx,my) )
+ ALLOCATE( undefined(mdeptht) )
+
+ !Lecture des ID des variables qui nous interessent
+ status = NF90_INQ_VARID(fidT,"vosaline",vosaline_ID)
+ call erreur(status,.TRUE.,"inq_vosaline_ID")
+ status = NF90_INQ_VARID(fidT,"votemper",votemper_ID)
+ call erreur(status,.TRUE.,"inq_votemper_ID")
+ status = NF90_INQ_VARID(fidT,"time_counter",time_counter_ID)
+ call erreur(status,.TRUE.,"inq_time_counter_ID")
+ status = NF90_INQ_VARID(fidT,"deptht",deptht_ID)
+ call erreur(status,.TRUE.,"inq_deptht_ID")
+ status = NF90_INQ_VARID(fidT,"nav_lat",nav_lat_ID)
+ call erreur(status,.TRUE.,"inq_nav_lat_ID")
+ status = NF90_INQ_VARID(fidT,"nav_lon",nav_lon_ID)
+ call erreur(status,.TRUE.,"inq_nav_lon_ID")
+
+ !Lecture des valeurs des variables qui nous interessent
+ status = NF90_GET_VAR(fidT,vosaline_ID,vosaline)
+ call erreur(status,.TRUE.,"getvar_vosaline")
+ status = NF90_GET_VAR(fidT,votemper_ID,votemper)
+ call erreur(status,.TRUE.,"getvar_votemper")
+ status = NF90_GET_VAR(fidT,time_counter_ID,time_counter)
+ call erreur(status,.TRUE.,"getvar_time_counter")
+ status = NF90_GET_VAR(fidT,deptht_ID,deptht)
+ call erreur(status,.TRUE.,"getvar_deptht")
+ status = NF90_GET_VAR(fidT,nav_lat_ID,nav_lat_T)
+ call erreur(status,.TRUE.,"getvar_nav_lat")
+ status = NF90_GET_VAR(fidT,nav_lon_ID,nav_lon_T)
+ call erreur(status,.TRUE.,"getvar_nav_lon")
+
+ !extract missing value for vosaline :
+ status = NF90_GET_ATT(fidT,vosaline_ID,"missing_value",missing)
+ call erreur(status,.TRUE.,"get_att_vosaline")
+
+ !Fermeture du fichier lu
+ status = NF90_CLOSE(fidT)
+ call erreur(status,.TRUE.,"fin_lecture")
+
+!---------------------------------------
+! Read netcdf input file for grid U :
+
+ write(*,*) TRIM(file_in_U)
+
+ status = NF90_OPEN(TRIM(file_in_U),0,fidU)
+ call erreur(status,.TRUE.,"read")
+
+ !Lecture des ID des dimensions qui nous interessent
+ status = NF90_INQ_DIMID(fidU,"time_counter",dimID_time_counter)
+ call erreur(status,.TRUE.,"inq_dimID_time_counter")
+ status = NF90_INQ_DIMID(fidU,"depthu",dimID_depthu)
+ call erreur(status,.TRUE.,"inq_dimID_depthu")
+ status = NF90_INQ_DIMID(fidU,"y",dimID_y)
+ call erreur(status,.TRUE.,"inq_dimID_y")
+ status = NF90_INQ_DIMID(fidU,"x",dimID_x)
+ call erreur(status,.TRUE.,"inq_dimID_x")
+
+ !Lecture des valeurs des dimensions qui nous interessent
+ status = NF90_INQUIRE_DIMENSION(fidU,dimID_depthu,len=mdepthu)
+ call erreur(status,.TRUE.,"inq_dim_depthu")
+ status = NF90_INQUIRE_DIMENSION(fidU,dimID_x,len=mxu)
+ call erreur(status,.TRUE.,"inq_dim_x")
+
+ write(*,101) mxu, my, mdepthu, mtime_counter
+
+ !Allocation of arrays :
+ ALLOCATE( vozocrtx(mxu,my,mdepthu,mtime_counter) )
+ ALLOCATE( nav_lat_U(mxu,my) )
+ ALLOCATE( nav_lon_U(mxu,my) )
+
+ !Lecture des ID des variables qui nous interessent
+ status = NF90_INQ_VARID(fidU,"vozocrtx",vozocrtx_ID)
+ call erreur(status,.TRUE.,"inq_vozocrtx_ID")
+ status = NF90_INQ_VARID(fidU,"nav_lat",nav_lat_ID)
+ call erreur(status,.TRUE.,"inq_nav_lat_ID")
+ status = NF90_INQ_VARID(fidU,"nav_lon",nav_lon_ID)
+ call erreur(status,.TRUE.,"inq_nav_lon_ID")
+
+ !Lecture des valeurs des variables qui nous interessent
+ status = NF90_GET_VAR(fidU,vozocrtx_ID,vozocrtx)
+ call erreur(status,.TRUE.,"getvar_vozocrtx")
+ status = NF90_GET_VAR(fidU,nav_lat_ID,nav_lat_U)
+ call erreur(status,.TRUE.,"getvar_nav_lat")
+ status = NF90_GET_VAR(fidU,nav_lon_ID,nav_lon_U)
+ call erreur(status,.TRUE.,"getvar_nav_lon")
+
+ !Fermeture du fichier lu
+ status = NF90_CLOSE(fidU)
+ call erreur(status,.TRUE.,"fin_lecture")
+
+
+!---------------------------------------
+! Read netcdf input file for grid V :
+
+ write(*,*) TRIM(file_in_V)
+
+ status = NF90_OPEN(TRIM(file_in_V),0,fidV)
+ call erreur(status,.TRUE.,"read")
+
+ !Lecture des ID des dimensions qui nous interessent
+ status = NF90_INQ_DIMID(fidV,"depthv",dimID_depthv)
+ call erreur(status,.TRUE.,"inq_dimID_depthv")
+ status = NF90_INQ_DIMID(fidV,"y",dimID_y)
+ call erreur(status,.TRUE.,"inq_dimID_y")
+
+ !Lecture des valeurs des dimensions qui nous interessent
+ status = NF90_INQUIRE_DIMENSION(fidV,dimID_depthv,len=mdepthv)
+ call erreur(status,.TRUE.,"inq_dim_depthv")
+ status = NF90_INQUIRE_DIMENSION(fidV,dimID_y,len=myu)
+ call erreur(status,.TRUE.,"inq_dim_y")
+ write(*,101) mx, myu, mdepthv, mtime_counter
+
+ !Allocation of arrays :
+ ALLOCATE( vomecrty(mx,myu,mdepthv,mtime_counter) )
+ ALLOCATE( nav_lat_V(mx,myu) )
+ ALLOCATE( nav_lon_V(mx,myu) )
+
+ !Lecture des ID des variables qui nous interessent
+ status = NF90_INQ_VARID(fidV,"vomecrty",vomecrty_ID)
+ call erreur(status,.TRUE.,"inq_vomecrty_ID")
+ status = NF90_INQ_VARID(fidV,"nav_lat",nav_lat_ID)
+ call erreur(status,.TRUE.,"inq_nav_lat_ID")
+ status = NF90_INQ_VARID(fidV,"nav_lon",nav_lon_ID)
+ call erreur(status,.TRUE.,"inq_nav_lon_ID")
+
+ !Lecture des valeurs des variables qui nous interessent
+ status = NF90_GET_VAR(fidV,vomecrty_ID,vomecrty)
+ call erreur(status,.TRUE.,"getvar_vomecrty")
+ status = NF90_GET_VAR(fidV,nav_lat_ID,nav_lat_V)
+ call erreur(status,.TRUE.,"getvar_nav_lat")
+ status = NF90_GET_VAR(fidV,nav_lon_ID,nav_lon_V)
+ call erreur(status,.TRUE.,"getvar_nav_lon")
+
+ !Fermeture du fichier lu
+ status = NF90_CLOSE(fidV)
+ call erreur(status,.TRUE.,"fin_lecture")
+
+
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+
+!-------------------------------------------------------------------------------
+! Remise des longitudes de 0 � 360 (utile pour l'interpolation):
+
+do i=1,mx
+do j=1,my
+ if (nav_lon_T(i,j).lt.0.0) then
+ nav_lon_T(i,j) = 360.0 + nav_lon_T(i,j)
+ endif
+enddo
+do j=1,myu
+ if (nav_lon_V(i,j).lt.0.0) then
+ nav_lon_V(i,j) = 360.0 + nav_lon_V(i,j)
+ endif
+enddo
+enddo
+
+do i=1,mxu
+do j=1,my
+ if (nav_lon_U(i,j).lt.0.0) then
+ nav_lon_U(i,j) = 360.0 + nav_lon_U(i,j)
+ endif
+enddo
+enddo
+
+
+!-------------------------------------------------------------------------------
+! Calcul des densite avel le module eos des CDFTOOLS-2.1
+
+ ALLOCATE( sig0(mx,my,mdeptht,mtime_counter) )
+ ALLOCATE( sig1(mx,my,mdeptht,mtime_counter) )
+ ALLOCATE( sig2(mx,my,mdeptht,mtime_counter) )
+ ALLOCATE( sig4(mx,my,mdeptht,mtime_counter) )
+
+ do k=1,mdeptht
+ do l=1,mtime_counter
+ sig0(:,:,k,l)=sigma0(votemper(:,:,k,l),vosaline(:,:,k,l),mx,my)
+ sig1(:,:,k,l)=sigmai(votemper(:,:,k,l),vosaline(:,:,k,l),1000.,mx,my)
+ sig2(:,:,k,l)=sigmai(votemper(:,:,k,l),vosaline(:,:,k,l),2000.,mx,my)
+ sig4(:,:,k,l)=sigmai(votemper(:,:,k,l),vosaline(:,:,k,l),4000.,mx,my)
+ enddo
+ enddo
+
+!-------------------------------------------------------------------------------
+! Calcul de la longueur des sections et des points modeles associes
+
+ Ntot=SUM(N(:))
+ write(*,*) '********** total number of points :', Ntot
+
+ ALLOCATE( latsec(Ntot) , lonsec(Ntot) , X1(Ntot) )
+ ALLOCATE( votemper_sec(Ntot,mdeptht,mtime_counter) )
+ ALLOCATE( vosaline_sec(Ntot,mdeptht,mtime_counter) )
+ ALLOCATE( vozocrtx_sec(Ntot,mdepthu,mtime_counter) )
+ ALLOCATE( vomecrty_sec(Ntot,mdepthv,mtime_counter) )
+ ALLOCATE( Unorm(Ntot,mdeptht,mtime_counter) )
+ ALLOCATE( Utang(Ntot,mdeptht,mtime_counter) )
+ ALLOCATE( sigsec0(Ntot,mdeptht,mtime_counter) )
+ ALLOCATE( sigsec1(Ntot,mdeptht,mtime_counter) )
+ ALLOCATE( sigsec2(Ntot,mdeptht,mtime_counter) )
+ ALLOCATE( sigsec4(Ntot,mdeptht,mtime_counter) )
+
+! BOUCLE SUR LE NOMBRE DE SECTIONS Nsec A ACOLLER :
+N2=0
+! Point de r�f�rence pour la distance de la section (exple : dans OVIDE 60N 43.25W)
+offset=RT * acos(cos(latref*rr)*cos(lat(1)*rr)*cos((lonref)*rr-lon(1)*rr)+sin(latref*rr)*sin(lat(1)*rr))
+cont=0
+DO p=1,Nsec
+ N1=N2+1
+ N2=N1+N(p)-1
+ !longueur de la section p en km :
+ d(p) = RT * acos(cos(lat(p)*rr)*cos(lat(p+1)*rr)*cos(lon(p+1)*rr-lon(p)*rr)+sin(lat(p)*rr)*sin(lat(p+1)*rr))
+ write(*,102) p,d(p)
+102 FORMAT('*** Section ',i4,' = ',f8.2, 'km')
+ write(*,103) lat(p), lon(p), lat(p+1), lon(p+1)
+103 FORMAT(' - from (lat,lon) = (',f6.2,',',f6.2,') to (',f6.2,',',f6.2,')')
+ ! "pente" de la section 1 en radians / equateur (angle algebrique)
+ if (lon(p).ne.lon(p+1)) then
+ ang = atan((lat(p+1)-lat(p))/(lon(p+1)-lon(p)))
+ else
+ ang=pi/2.
+ endif
+ write(*,*) ' - angle / equateur (deg) =', ang/rr
+ !coordonn�es de tous les points de la section p en (lon,lat) et en km :
+ DO s=N1,N2
+ undefined(:)=.FALSE.
+ latsec(s)=(lat(p+1)-lat(p))*FLOAT(s-N1+cont)/FLOAT(N2-N1+cont) + lat(p)
+ lonsec(s)=(lon(p+1)-lon(p))*FLOAT(s-N1+cont)/FLOAT(N2-N1+cont) + lon(p)
+ X1(s)=d(p)*FLOAT(s-N1+cont)/FLOAT(N2-N1+cont)+offset
+ miniT=1000 !km
+ miniU=miniT
+ miniV=miniT
+ ! recherche du point le plus proche (on fait comme �a parceque la grille est bizarre vers les poles)
+ do i=1,mx
+ do j=1,my
+ dtmp_T= RT * acos(cos(nav_lat_T(i,j)*rr)*cos(latsec(s)*rr)*cos(nav_lon_T(i,j)*rr-lonsec(s)*rr)+sin(nav_lat_T(i,j)*rr)*sin(latsec(s)*rr))
+ dtmp_U= RT * acos(cos(nav_lat_U(i,j)*rr)*cos(latsec(s)*rr)*cos(nav_lon_U(i,j)*rr-lonsec(s)*rr)+sin(nav_lat_U(i,j)*rr)*sin(latsec(s)*rr))
+ dtmp_V= RT * acos(cos(nav_lat_V(i,j)*rr)*cos(latsec(s)*rr)*cos(nav_lon_V(i,j)*rr-lonsec(s)*rr)+sin(nav_lat_V(i,j)*rr)*sin(latsec(s)*rr))
+ if (dtmp_T.lt.miniT) then
+ miniT=dtmp_T
+ iiT=i
+ jjT=j
+ endif
+ if (dtmp_U.lt.miniU) then
+ miniU=dtmp_U
+ iiU=i
+ jjU=j
+ endif
+ if (dtmp_V.lt.miniV) then
+ miniV=dtmp_V
+ iiV=i
+ jjV=j
+ endif
+ enddo
+ enddo
+ !interpolation des champs T:
+ if (latsec(s).gt.60.0) then
+ !champs le plus proche de la section (U et V interpoles au point T)
+ votemper_sec(s,:,:) = votemper(iiT,jjT,:,:)
+ vosaline_sec(s,:,:) = vosaline(iiT,jjT,:,:)
+ vozocrtx_sec(s,:,:) = vozocrtx(iiU,jjU,:,:)
+ vomecrty_sec(s,:,:) = vomecrty(iiV,jjV,:,:)
+ ! vitesse normale et tangeantielle a la section (section orientee vers le nord, tangeante � droite)
+ Unorm(s,:,:) = vomecrty_sec(s,:,:)*cos(ang) - vozocrtx_sec(s,:,:)*sin(ang)
+ Utang(s,:,:) = vomecrty_sec(s,:,:)*sin(ang) + vozocrtx_sec(s,:,:)*cos(ang)
+ ! densites :
+ sigsec0(s,:,:) = MAX(sig0(iiT,jjT,:,:),10.0)
+ sigsec1(s,:,:) = MAX(sig1(iiT,jjT,:,:),10.0)
+ sigsec2(s,:,:) = MAX(sig2(iiT,jjT,:,:),10.0)
+ sigsec4(s,:,:) = MAX(sig4(iiT,jjT,:,:),20.0)
+ else
+ ! Champs T interpoles
+ if (lonsec(s).ge.nav_lon_T(iiT,jjT)) then
+ iinf=iiT
+ if ( iiT+1.le.mx ) then
+ isup=iiT+1
+ else
+ isup=1
+ endif
+ else
+ if ( iiT-1.ge.1 ) then
+ iinf=iiT-1
+ else
+ iinf=mx
+ endif
+ isup=iiT
+ endif
+ if (latsec(s).ge.nav_lat_T(iiT,jjT)) then
+ jinf=jjT
+ jsup=jjT+1
+ else
+ jinf=jjT-1
+ jsup=jjT
+ endif
+ loninf=nav_lon_T(iinf,jjT)
+ lonsup=nav_lon_T(isup,jjT)
+ latinf=nav_lat_T(iiT,jinf)
+ latsup=nav_lat_T(iiT,jsup)
+ a=(lonsec(s)-loninf)/(lonsup-loninf)
+ b=(lonsup-lonsec(s))/(lonsup-loninf)
+ c=(latsec(s)-latinf)/(latsup-latinf)
+ e=(latsup-latsec(s))/(latsup-latinf)
+ votemper_sec(s,:,:) = c*(a*votemper(isup,jsup,:,:)+b*votemper(iinf,jsup,:,:)) &
+& +e*(a*votemper(isup,jinf,:,:)+b*votemper(iinf,jinf,:,:))
+ vosaline_sec(s,:,:) = c*(a*vosaline(isup,jsup,:,:)+b*vosaline(iinf,jsup,:,:)) &
+& +e*(a*vosaline(isup,jinf,:,:)+b*vosaline(iinf,jinf,:,:))
+ sigsec0(s,:,:) = c*(a*sig0(isup,jsup,:,:)+b*sig0(iinf,jsup,:,:)) &
+& +e*(a*sig0(isup,jinf,:,:)+b*sig0(iinf,jinf,:,:))
+ sigsec0(s,:,:) = MAX(sigsec0(s,:,:),10.0)
+ sigsec1(s,:,:) = c*(a*sig1(isup,jsup,:,:)+b*sig1(iinf,jsup,:,:)) &
+& +e*(a*sig1(isup,jinf,:,:)+b*sig1(iinf,jinf,:,:))
+ sigsec1(s,:,:) = MAX(sigsec1(s,:,:),10.0)
+ sigsec2(s,:,:) = c*(a*sig2(isup,jsup,:,:)+b*sig2(iinf,jsup,:,:)) &
+& +e*(a*sig2(isup,jinf,:,:)+b*sig2(iinf,jinf,:,:))
+ sigsec2(s,:,:) = MAX(sigsec2(s,:,:),10.0)
+ sigsec4(s,:,:) = c*(a*sig4(isup,jsup,:,:)+b*sig4(iinf,jsup,:,:)) &
+& +e*(a*sig4(isup,jinf,:,:)+b*sig4(iinf,jinf,:,:))
+ sigsec4(s,:,:) = MAX(sigsec4(s,:,:),20.0)
+ ! test si valeurs indefinies sur un des 4 points :
+ do k=1,mdeptht
+ if ((vosaline(iinf,jinf,k,1).eq.missing).or.(vosaline(iinf,jsup,k,1).eq.missing).or.&
+& (vosaline(isup,jinf,k,1).eq.missing).or.(vosaline(isup,jsup,k,1).eq.missing) ) then
+ votemper_sec(s,:,:) = votemper(iiT,jjT,:,:)
+ vosaline_sec(s,:,:) = vosaline(iiT,jjT,:,:)
+ vozocrtx_sec(s,:,:) = vozocrtx(iiU,jjU,:,:)
+ vomecrty_sec(s,:,:) = vomecrty(iiV,jjV,:,:)
+ sigsec0(s,:,:) = MAX(sig0(iiT,jjT,:,:),10.0)
+ sigsec1(s,:,:) = MAX(sig1(iiT,jjT,:,:),10.0)
+ sigsec2(s,:,:) = MAX(sig2(iiT,jjT,:,:),10.0)
+ sigsec4(s,:,:) = MAX(sig4(iiT,jjT,:,:),20.0)
+ undefined(k)=.TRUE.
+ endif
+ enddo
+ ! Champs U interpoles
+ if (lonsec(s).ge.nav_lon_U(iiU,jjU)) then
+ iinf=iiU
+ if ( iiU+1.le.mx ) then
+ isup=iiU+1
+ else
+ isup=1
+ endif
+ else
+ if ( iiU-1.ge.1 ) then
+ iinf=iiU-1
+ else
+ iinf=mx
+ endif
+ isup=iiU
+ endif
+ if (latsec(s).ge.nav_lat_U(iiU,jjU)) then
+ jinf=jjU
+ jsup=jjU+1
+ else
+ jinf=jjU-1
+ jsup=jjU
+ endif
+ loninf=nav_lon_U(iinf,jjU)
+ lonsup=nav_lon_U(isup,jjU)
+ latinf=nav_lat_U(iiU,jinf)
+ latsup=nav_lat_U(iiU,jsup)
+ a=(lonsec(s)-loninf)/(lonsup-loninf)
+ b=(lonsup-lonsec(s))/(lonsup-loninf)
+ c=(latsec(s)-latinf)/(latsup-latinf)
+ e=(latsup-latsec(s))/(latsup-latinf)
+ vozocrtx_sec(s,:,:) = c*(a*vozocrtx(isup,jsup,:,:)+b*vozocrtx(iinf,jsup,:,:)) &
+& +e*(a*vozocrtx(isup,jinf,:,:)+b*vozocrtx(iinf,jinf,:,:))
+ ! Champs V interpoles
+ if (lonsec(s).ge.nav_lon_U(iiU,jjU)) then
+ iinf=iiU
+ if ( iiU+1.le.mx ) then
+ isup=iiU+1
+ else
+ isup=1
+ endif
+ else
+ if ( iiU-1.ge.1 ) then
+ iinf=iiU-1
+ else
+ iinf=mx
+ endif
+ isup=iiU
+ endif
+ if (latsec(s).ge.nav_lat_V(iiV,jjV)) then
+ jinf=jjV
+ jsup=jjV+1
+ else
+ jinf=jjV-1
+ jsup=jjV
+ endif
+ loninf=nav_lon_V(iinf,jjV)
+ lonsup=nav_lon_V(isup,jjV)
+ latinf=nav_lat_V(iiV,jinf)
+ latsup=nav_lat_V(iiV,jsup)
+ a=(lonsec(s)-loninf)/(lonsup-loninf)
+ b=(lonsup-lonsec(s))/(lonsup-loninf)
+ c=(latsec(s)-latinf)/(latsup-latinf)
+ e=(latsup-latsec(s))/(latsup-latinf)
+ vomecrty_sec(s,:,:) = c*(a*vomecrty(isup,jsup,:,:)+b*vomecrty(iinf,jsup,:,:)) &
+& +e*(a*vomecrty(isup,jinf,:,:)+b*vomecrty(iinf,jinf,:,:))
+ ! si l'un des 4 points de l'interpolation etait indefini :
+ do k=1,mdeptht
+ if (undefined(k)) then
+ vozocrtx_sec(s,k,:) = vozocrtx(iiU,jjU,k,:)
+ vomecrty_sec(s,k,:) = vomecrty(iiV,jjV,k,:)
+ endif
+ enddo
+ ! vitesse normale et tangeantielle a la section (section orientee vers le nord, tangeante � droite)
+ Unorm(s,:,:) = vomecrty_sec(s,:,:)*cos(ang) - vozocrtx_sec(s,:,:)*sin(ang)
+ Utang(s,:,:) = vomecrty_sec(s,:,:)*sin(ang) + vozocrtx_sec(s,:,:)*cos(ang)
+ endif
+ ENDDO !- s nb de points sur section p
+ cont=1
+ offset=X1(N2)
+ENDDO !- p nb de sections
+
+!----------------------------------------------------------
+!----------------------------------------------------------
+! Writing new netcdf file :
+
+ status = NF90_CREATE(TRIM(file_out),NF90_NOCLOBBER,fidM)
+ call erreur(status,.TRUE.,'create')
+
+ !Definition des dimensions du fichiers
+ status = NF90_DEF_DIM(fidM,"time_counter",NF90_UNLIMITED,dimID_time_counter)
+ call erreur(status,.TRUE.,"def_dimID_time_counter")
+ status = NF90_DEF_DIM(fidM,"deptht",mdeptht,dimID_deptht)
+ call erreur(status,.TRUE.,"def_dimID_deptht")
+ status = NF90_DEF_DIM(fidM,"X",Ntot,dimID_s)
+ call erreur(status,.TRUE.,"def_dimID_s")
+
+ !Definition des variables
+ status = NF90_DEF_VAR(fidM,"vosaline",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),vosaline_ID)
+ call erreur(status,.TRUE.,"def_var_vosaline_ID")
+ status = NF90_DEF_VAR(fidM,"votemper",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),votemper_ID)
+ call erreur(status,.TRUE.,"def_var_votemper_ID")
+ status = NF90_DEF_VAR(fidM,"time_counter",NF90_FLOAT,(/dimID_time_counter/),time_counter_ID)
+ call erreur(status,.TRUE.,"def_var_time_counter_ID")
+ status = NF90_DEF_VAR(fidM,"deptht",NF90_FLOAT,(/dimID_deptht/),deptht_ID)
+ call erreur(status,.TRUE.,"def_var_deptht_ID")
+ status = NF90_DEF_VAR(fidM,"nav_lat",NF90_FLOAT,(/dimID_s/),nav_lat_ID)
+ call erreur(status,.TRUE.,"def_var_nav_lat_ID")
+ status = NF90_DEF_VAR(fidM,"nav_lon",NF90_FLOAT,(/dimID_s/),nav_lon_ID)
+ call erreur(status,.TRUE.,"def_var_nav_lon_ID")
+ status = NF90_DEF_VAR(fidM,"X",NF90_DOUBLE,(/dimID_s/),X_ID)
+ call erreur(status,.TRUE.,"def_var_X_ID")
+ status = NF90_DEF_VAR(fidM,"Uorth",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),Unorm_ID)
+ call erreur(status,.TRUE.,"def_var_Unorm_ID")
+ status = NF90_DEF_VAR(fidM,"Utang",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),Utang_ID)
+ call erreur(status,.TRUE.,"def_var_Utang_ID")
+ status = NF90_DEF_VAR(fidM,"sig0",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),sig0_ID)
+ call erreur(status,.TRUE.,"def_var_sig0_ID")
+ status = NF90_DEF_VAR(fidM,"sig1",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),sig1_ID)
+ call erreur(status,.TRUE.,"def_var_sig1_ID")
+ status = NF90_DEF_VAR(fidM,"sig2",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),sig2_ID)
+ call erreur(status,.TRUE.,"def_var_sig2_ID")
+ status = NF90_DEF_VAR(fidM,"sig4",NF90_FLOAT,(/dimID_s,dimID_deptht,dimID_time_counter/),sig4_ID)
+ call erreur(status,.TRUE.,"def_var_sig4_ID")
+
+
+ ! Attributs des variables :
+ status = NF90_PUT_ATT(fidM,vosaline_ID,"online_operation","N/A")
+ call erreur(status,.TRUE.,"put_att_vosaline_ID")
+ status = NF90_PUT_ATT(fidM,vosaline_ID,"short_name","vosaline")
+ call erreur(status,.TRUE.,"put_att_vosaline_ID")
+ status = NF90_PUT_ATT(fidM,vosaline_ID,"long_name","sea_water_salinity")
+ call erreur(status,.TRUE.,"put_att_vosaline_ID")
+ status = NF90_PUT_ATT(fidM,vosaline_ID,"valid_max",45.)
+ call erreur(status,.TRUE.,"put_att_vosaline_ID")
+ status = NF90_PUT_ATT(fidM,vosaline_ID,"valid_min",0.)
+ call erreur(status,.TRUE.,"put_att_vosaline_ID")
+ status = NF90_PUT_ATT(fidM,vosaline_ID,"missing_value",0.)
+ call erreur(status,.TRUE.,"put_att_vosaline_ID")
+ status = NF90_PUT_ATT(fidM,vosaline_ID,"units","PSU")
+ call erreur(status,.TRUE.,"put_att_vosaline_ID")
+
+ status = NF90_PUT_ATT(fidM,votemper_ID,"online_operation","N/A")
+ call erreur(status,.TRUE.,"put_att_votemper_ID")
+ status = NF90_PUT_ATT(fidM,votemper_ID,"short_name","votemper")
+ call erreur(status,.TRUE.,"put_att_votemper_ID")
+ status = NF90_PUT_ATT(fidM,votemper_ID,"long_name","sea_water_potential_temperature")
+ call erreur(status,.TRUE.,"put_att_votemper_ID")
+ status = NF90_PUT_ATT(fidM,votemper_ID,"valid_max",45.)
+ call erreur(status,.TRUE.,"put_att_votemper_ID")
+ status = NF90_PUT_ATT(fidM,votemper_ID,"valid_min",-2.)
+ call erreur(status,.TRUE.,"put_att_votemper_ID")
+ status = NF90_PUT_ATT(fidM,votemper_ID,"missing_value",0.)
+ call erreur(status,.TRUE.,"put_att_votemper_ID")
+ status = NF90_PUT_ATT(fidM,votemper_ID,"units","C")
+ call erreur(status,.TRUE.,"put_att_votemper_ID")
+
+ status = NF90_PUT_ATT(fidM,time_counter_ID,"time_origin","2001-OCT-03 00:00:00")
+ call erreur(status,.TRUE.,"put_att_time_counter_ID")
+ status = NF90_PUT_ATT(fidM,time_counter_ID,"units","seconds since 2001-10-03 00:00:00")
+ call erreur(status,.TRUE.,"put_att_time_counter_ID")
+ status = NF90_PUT_ATT(fidM,time_counter_ID,"long_name","Time axis")
+ call erreur(status,.TRUE.,"put_att_time_counter_ID")
+ status = NF90_PUT_ATT(fidM,time_counter_ID,"title","Time")
+ call erreur(status,.TRUE.,"put_att_time_counter_ID")
+ status = NF90_PUT_ATT(fidM,time_counter_ID,"calendar","gregorian")
+ call erreur(status,.TRUE.,"put_att_time_counter_ID")
+
+ status = NF90_PUT_ATT(fidM,deptht_ID,"long_name","Vertical T levels")
+ call erreur(status,.TRUE.,"put_att_deptht_ID")
+ status = NF90_PUT_ATT(fidM,deptht_ID,"title","deptht")
+ call erreur(status,.TRUE.,"put_att_deptht_ID")
+ status = NF90_PUT_ATT(fidM,deptht_ID,"valid_max",50.)
+ call erreur(status,.TRUE.,"put_att_deptht_ID")
+ status = NF90_PUT_ATT(fidM,deptht_ID,"valid_min",0.)
+ call erreur(status,.TRUE.,"put_att_deptht_ID")
+ status = NF90_PUT_ATT(fidM,deptht_ID,"positive","unknown")
+ call erreur(status,.TRUE.,"put_att_deptht_ID")
+ status = NF90_PUT_ATT(fidM,deptht_ID,"units","m")
+ call erreur(status,.TRUE.,"put_att_deptht_ID")
+
+ status = NF90_PUT_ATT(fidM,nav_lat_ID,"long_name","Latitude")
+ call erreur(status,.TRUE.,"put_att_nav_lat_ID")
+ status = NF90_PUT_ATT(fidM,nav_lat_ID,"scale_factor",1.)
+ call erreur(status,.TRUE.,"put_att_nav_lat_ID")
+ status = NF90_PUT_ATT(fidM,nav_lat_ID,"add_offset",0.)
+ call erreur(status,.TRUE.,"put_att_nav_lat_ID")
+ status = NF90_PUT_ATT(fidM,nav_lat_ID,"valid_max",89.947868347168)
+ call erreur(status,.TRUE.,"put_att_nav_lat_ID")
+ status = NF90_PUT_ATT(fidM,nav_lat_ID,"valid_min",-77.0104751586914)
+ call erreur(status,.TRUE.,"put_att_nav_lat_ID")
+ status = NF90_PUT_ATT(fidM,nav_lat_ID,"units","degrees_north")
+ call erreur(status,.TRUE.,"put_att_nav_lat_ID")
+
+ status = NF90_PUT_ATT(fidM,nav_lon_ID,"long_name","Longitude")
+ call erreur(status,.TRUE.,"put_att_nav_lon_ID")
+ status = NF90_PUT_ATT(fidM,nav_lon_ID,"scale_factor",1.)
+ call erreur(status,.TRUE.,"put_att_nav_lon_ID")
+ status = NF90_PUT_ATT(fidM,nav_lon_ID,"add_offset",0.)
+ call erreur(status,.TRUE.,"put_att_nav_lon_ID")
+ status = NF90_PUT_ATT(fidM,nav_lon_ID,"valid_max",180.)
+ call erreur(status,.TRUE.,"put_att_nav_lon_ID")
+ status = NF90_PUT_ATT(fidM,nav_lon_ID,"valid_min",-180.)
+ call erreur(status,.TRUE.,"put_att_nav_lon_ID")
+ status = NF90_PUT_ATT(fidM,nav_lon_ID,"units","degrees_east")
+ call erreur(status,.TRUE.,"put_att_nav_lon_ID")
+
+ status = NF90_PUT_ATT(fidM,X_ID,"nav_model","Default grid")
+ call erreur(status,.TRUE.,"put_att_X_ID")
+ status = NF90_PUT_ATT(fidM,X_ID,"long_name","X")
+ call erreur(status,.TRUE.,"put_att_X_ID")
+ status = NF90_PUT_ATT(fidM,X_ID,"scale_factor",1.)
+ call erreur(status,.TRUE.,"put_att_X_ID")
+ status = NF90_PUT_ATT(fidM,X_ID,"add_offset",0.)
+ call erreur(status,.TRUE.,"put_att_X_ID")
+ status = NF90_PUT_ATT(fidM,X_ID,"units","km")
+ call erreur(status,.TRUE.,"put_att_X_ID")
+
+ status = NF90_PUT_ATT(fidM,Unorm_ID,"online_operation","N/A")
+ call erreur(status,.TRUE.,"put_att_Unorm_ID")
+ status = NF90_PUT_ATT(fidM,Unorm_ID,"short_name","Uorth")
+ call erreur(status,.TRUE.,"put_att_Unorm_ID")
+ status = NF90_PUT_ATT(fidM,Unorm_ID,"long_name","ocean speed orthogonal to the section oriented south-north")
+ call erreur(status,.TRUE.,"put_att_Unorm_ID")
+ status = NF90_PUT_ATT(fidM,Unorm_ID,"valid_max",10.)
+ call erreur(status,.TRUE.,"put_att_Unorm_ID")
+ status = NF90_PUT_ATT(fidM,Unorm_ID,"valid_min",-10.)
+ call erreur(status,.TRUE.,"put_att_Unorm_ID")
+ status = NF90_PUT_ATT(fidM,Unorm_ID,"missing_value",0.)
+ call erreur(status,.TRUE.,"put_att_Unorm_ID")
+ status = NF90_PUT_ATT(fidM,Unorm_ID,"units","m/s")
+ call erreur(status,.TRUE.,"put_att_Unorm_ID")
+
+ status = NF90_PUT_ATT(fidM,Utang_ID,"online_operation","N/A")
+ call erreur(status,.TRUE.,"put_att_Utang_ID")
+ status = NF90_PUT_ATT(fidM,Utang_ID,"short_name","Utang")
+ call erreur(status,.TRUE.,"put_att_Utang_ID")
+ status = NF90_PUT_ATT(fidM,Utang_ID,"long_name","ocean speed tangential to the section oriented south-north")
+ call erreur(status,.TRUE.,"put_att_Utang_ID")
+ status = NF90_PUT_ATT(fidM,Utang_ID,"valid_max",10.)
+ call erreur(status,.TRUE.,"put_att_Utang_ID")
+ status = NF90_PUT_ATT(fidM,Utang_ID,"valid_min",-10.)
+ call erreur(status,.TRUE.,"put_att_Utang_ID")
+ status = NF90_PUT_ATT(fidM,Utang_ID,"missing_value",0.)
+ call erreur(status,.TRUE.,"put_att_Utang_ID")
+ status = NF90_PUT_ATT(fidM,Utang_ID,"units","m/s")
+ call erreur(status,.TRUE.,"put_att_Utang_ID")
+
+ status = NF90_PUT_ATT(fidM,sig0_ID,"short_name","sig0")
+ call erreur(status,.TRUE.,"put_att_sig0_ID")
+ status = NF90_PUT_ATT(fidM,sig0_ID,"long_name","Potential Density Sigma 0")
+ call erreur(status,.TRUE.,"put_att_sig0_ID")
+ status = NF90_PUT_ATT(fidM,sig0_ID,"valid_max",100.)
+ call erreur(status,.TRUE.,"put_att_sig0_ID")
+ status = NF90_PUT_ATT(fidM,sig0_ID,"valid_min",10.0)
+ call erreur(status,.TRUE.,"put_att_sig0_ID")
+ status = NF90_PUT_ATT(fidM,sig0_ID,"missing_value",10.0)
+ call erreur(status,.TRUE.,"put_att_sig0_ID")
+ status = NF90_PUT_ATT(fidM,sig0_ID,"units","kg/m3")
+ call erreur(status,.TRUE.,"put_att_sig0_ID")
+
+ status = NF90_PUT_ATT(fidM,sig1_ID,"short_name","sig1")
+ call erreur(status,.TRUE.,"put_att_sig1_ID")
+ status = NF90_PUT_ATT(fidM,sig1_ID,"long_name","Potential Density Sigma 0")
+ call erreur(status,.TRUE.,"put_att_sig1_ID")
+ status = NF90_PUT_ATT(fidM,sig1_ID,"valid_max",100.)
+ call erreur(status,.TRUE.,"put_att_sig1_ID")
+ status = NF90_PUT_ATT(fidM,sig1_ID,"valid_min",10.0)
+ call erreur(status,.TRUE.,"put_att_sig1_ID")
+ status = NF90_PUT_ATT(fidM,sig1_ID,"missing_value",10.0)
+ call erreur(status,.TRUE.,"put_att_sig1_ID")
+ status = NF90_PUT_ATT(fidM,sig1_ID,"units","kg/m3")
+ call erreur(status,.TRUE.,"put_att_sig1_ID")
+
+ status = NF90_PUT_ATT(fidM,sig2_ID,"short_name","sig2")
+ call erreur(status,.TRUE.,"put_att_sig2_ID")
+ status = NF90_PUT_ATT(fidM,sig2_ID,"long_name","Potential Density Sigma 0")
+ call erreur(status,.TRUE.,"put_att_sig2_ID")
+ status = NF90_PUT_ATT(fidM,sig2_ID,"valid_max",100.)
+ call erreur(status,.TRUE.,"put_att_sig2_ID")
+ status = NF90_PUT_ATT(fidM,sig2_ID,"valid_min",10.0)
+ call erreur(status,.TRUE.,"put_att_sig2_ID")
+ status = NF90_PUT_ATT(fidM,sig2_ID,"missing_value",10.0)
+ call erreur(status,.TRUE.,"put_att_sig2_ID")
+ status = NF90_PUT_ATT(fidM,sig2_ID,"units","kg/m3")
+ call erreur(status,.TRUE.,"put_att_sig2_ID")
+
+ status = NF90_PUT_ATT(fidM,sig4_ID,"short_name","sig4")
+ call erreur(status,.TRUE.,"put_att_sig4_ID")
+ status = NF90_PUT_ATT(fidM,sig4_ID,"long_name","Potential Density Sigma 0")
+ call erreur(status,.TRUE.,"put_att_sig4_ID")
+ status = NF90_PUT_ATT(fidM,sig4_ID,"valid_max",100.)
+ call erreur(status,.TRUE.,"put_att_sig4_ID")
+ status = NF90_PUT_ATT(fidM,sig4_ID,"valid_min",20.0)
+ call erreur(status,.TRUE.,"put_att_sig4_ID")
+ status = NF90_PUT_ATT(fidM,sig4_ID,"missing_value",20.0)
+ call erreur(status,.TRUE.,"put_att_sig4_ID")
+ status = NF90_PUT_ATT(fidM,sig4_ID,"units","kg/m3")
+ call erreur(status,.TRUE.,"put_att_sig4_ID")
+
+ ! Attributs globaux :
+ status = NF90_PUT_ATT(fidM,NF90_GLOBAL,"history","Created by cdfsections (see CDFTOOLS)")
+ call erreur(status,.TRUE.,"put_att_global_ID")
+
+ !Fin des definitions
+ status = NF90_ENDDEF(fidM)
+ call erreur(status,.TRUE.,"fin_definition")
+
+ !Valeurs prises par les variables :
+ status = NF90_PUT_VAR(fidM,vosaline_ID,vosaline_sec)
+ call erreur(status,.TRUE.,"var_vosaline_ID")
+ status = NF90_PUT_VAR(fidM,votemper_ID,votemper_sec)
+ call erreur(status,.TRUE.,"var_votemper_ID")
+ status = NF90_PUT_VAR(fidM,time_counter_ID,time_counter)
+ call erreur(status,.TRUE.,"var_time_counter_ID")
+ status = NF90_PUT_VAR(fidM,deptht_ID,deptht)
+ call erreur(status,.TRUE.,"var_deptht_ID")
+ status = NF90_PUT_VAR(fidM,nav_lat_ID,latsec)
+ call erreur(status,.TRUE.,"var_nav_lat_ID")
+ status = NF90_PUT_VAR(fidM,nav_lon_ID,lonsec)
+ call erreur(status,.TRUE.,"var_nav_lon_ID")
+ status = NF90_PUT_VAR(fidM,X_ID,X1)
+ call erreur(status,.TRUE.,"var_X_ID")
+ status = NF90_PUT_VAR(fidM,Unorm_ID,Unorm)
+ call erreur(status,.TRUE.,"var_Unorm_ID")
+ status = NF90_PUT_VAR(fidM,Utang_ID,Utang)
+ call erreur(status,.TRUE.,"var_Utang_ID")
+ status = NF90_PUT_VAR(fidM,sig0_ID,sigsec0)
+ call erreur(status,.TRUE.,"var_sig0_ID")
+ status = NF90_PUT_VAR(fidM,sig1_ID,sigsec1)
+ call erreur(status,.TRUE.,"var_sig1_ID")
+ status = NF90_PUT_VAR(fidM,sig2_ID,sigsec2)
+ call erreur(status,.TRUE.,"var_sigsec2_ID")
+ status = NF90_PUT_VAR(fidM,sig4_ID,sigsec4)
+ call erreur(status,.TRUE.,"var_sigsec4_ID")
+
+ !Fin de l'ecriture
+ status = NF90_CLOSE(fidM)
+ call erreur(status,.TRUE.,"final")
+
+end program cdfsections
+
+
+
+SUBROUTINE erreur(iret, lstop, chaine)
+ ! pour les messages d'erreur
+ USE netcdf
+ INTEGER, INTENT(in) :: iret
+ LOGICAL, INTENT(in) :: lstop
+ CHARACTER(LEN=*), INTENT(in) :: chaine
+ !
+ CHARACTER(LEN=256) :: message
+ !
+ IF ( iret .NE. 0 ) THEN
+ WRITE(*,*) 'ROUTINE: ', TRIM(chaine)
+ WRITE(*,*) 'ERREUR: ', iret
+ message=NF90_STRERROR(iret)
+ WRITE(*,*) 'THIS MEANS :',TRIM(message)
+ IF ( lstop ) STOP
+ ENDIF
+ !
+END SUBROUTINE erreur
diff --git a/cdfsig0.f90 b/cdfsig0.f90
new file mode 100644
index 0000000..0338e6b
--- /dev/null
+++ b/cdfsig0.f90
@@ -0,0 +1,112 @@
+PROGRAM cdfsig0
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfsig0 ***
+ !!
+ !! ** Purpose: Compute sigma0 3D field from gridT file
+ !! Store the results on a 'similar' cdf file.
+ !!
+ !! ** Method: Try to avoid 3 d arrays
+ !!
+ !! history:
+ !! Original : J.M. Molines (Nov 2004 ) for ORCA025
+ !! J.M. Molines Apr 2005 : use modules
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+ USE eos
+
+ !! * Local variables
+ 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')
+
+ 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'
+
+
+ PRINT *, 'npiglo=', npiglo
+ PRINT *, 'npjglo=', npjglo
+ PRINT *, 'npk =', npk
+ PRINT *, 'npt =', npt
+
+ ALLOCATE (ztemp(npiglo,npjglo), zsal(npiglo,npjglo), zsig0(npiglo,npjglo) ,zmask(npiglo,npjglo))
+ ALLOCATE (tim(npt))
+
+ ! 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)
+ tim=getvar1d(cfilet,'time_counter',npt)
+ ierr=putvar1d(ncout,tim,npt,'T')
+
+ DO jt=1,npt
+ 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)
+
+ 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)
+
+ ierr = putvar(ncout, id_varout(1) ,zsig0, jk,npiglo, npjglo,ktime=jt)
+
+ END DO ! loop to next level
+ END DO ! next time frame
+
+ istatus = closeout(ncout)
+END PROGRAM cdfsig0
diff --git a/cdfsigi.f90 b/cdfsigi.f90
new file mode 100644
index 0000000..2dc0197
--- /dev/null
+++ b/cdfsigi.f90
@@ -0,0 +1,121 @@
+PROGRAM cdfsigi
+ !!-------------------------------------------------------------------
+ !! *** 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
+ USE cdfio
+ USE eos
+
+ !! * Local variables
+ 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()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfsigi gridT Ref_dep(m)'
+ PRINT *,' Output on sigi.nc, variable vosigmai'
+ 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')
+
+ 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))
+ ALLOCATE (tim(npt) )
+
+ ! 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)
+
+ 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.
+
+ ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo,ktime=jt)
+ zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo,ktime=jt)
+
+ WHERE(zsal == spval ) 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
+
+ ierr = putvar(ncout, id_varout(1) ,zsigi, jk,npiglo, npjglo,ktime=jt)
+
+ END DO ! loop to next level
+ END DO ! loop on time
+
+ istatus = closeout(ncout)
+END PROGRAM cdfsigi
diff --git a/cdfsiginsitu.f90 b/cdfsiginsitu.f90
new file mode 100644
index 0000000..5c1621f
--- /dev/null
+++ b/cdfsiginsitu.f90
@@ -0,0 +1,110 @@
+PROGRAM cdfsiginsitu
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfsiginsitu ***
+ !!
+ !! ** Purpose: Compute sigmainsitu 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
+ USE cdfio
+ USE eos
+
+ !! * Local variables
+ 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()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfsiginsitu gridT '
+ PRINT *,' Output on siginsitu.nc, variable vosigmainsitu'
+ PRINT *,' Depths are taken from input file '
+ 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'
+
+
+ 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))
+ ALLOCATE (prof(npk) , tim(npt) )
+
+ ! 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)
+ prof(:)=getvar1d(cfilet,'deptht',npk)
+ tim=getvar1d(cfilet,'time_counter',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 jk = 1, npk
+ zmask(:,:)=1.
+
+ ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo, ktime=jt)
+ zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo, ktime=jt)
+
+ WHERE(zsal == spval ) zmask = 0
+
+ zsigi(:,:) = sigmai ( ztemp,zsal,prof(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
+
+ istatus = closeout(ncout)
+END PROGRAM cdfsiginsitu
diff --git a/cdfsigintegr.f90 b/cdfsigintegr.f90
new file mode 100644
index 0000000..e9ea719
--- /dev/null
+++ b/cdfsigintegr.f90
@@ -0,0 +1,281 @@
+PROGRAM cdfsigintegr
+ !! --------------------------------------------------------------
+ !! *** 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.
+ !!
+ !! ** Usage :
+ !! cdfsigintegr 'rho file' 'scalar file (*)'
+ !!
+ !! * history:
+ !! Original : J.M. Molines December 2007 (From cdfrhoproj )
+ !! ---------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+
+ !! * Used modules
+ USE cdfio
+
+ !! * Local declaration
+ 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
+ !
+
+ !! * 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
+ 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)
+
+ ! 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)
+ IF ( jk == 1 ) THEN
+ WHERE (v3d(:,:,jk) == spvalz ) tmask=0.
+ ENDIF
+ 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
+
+ !! ** Loop on the scalar files to project on choosen isopycnics surfaces
+ DO jfich=3,narg
+
+ CALL getarg(jfich,cfildata)
+ PRINT *,'working with ', TRIM(cfildata)
+
+ 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
+ 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
+ END DO
+ END DO
+ CASE('W','w' )
+ STOP 'Case W not done yet :( '
+ 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
+ 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
+ ENDIF
+ END DO
+ END DO
+ END DO ! end on vertical integral for isopynal jkk
+
+ dum=zint(:,:,1)
+
+ WHERE (tmask == 0. ) dum=spval
+ ierr = putvar(ncout,id_varout(3), dum ,jkk,npiglo,npjglo)
+
+ 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)
+
+ 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)
+
+ END DO
+ ierr = putvar1d(ncout,time_tag,1,'T')
+ ierr = closeout(ncout)
+ END DO ! loop on scalar files
+ PRINT *,' integral between isopycnals completed successfully'
+END PROGRAM cdfsigintegr
diff --git a/cdfsigitrp.f90 b/cdfsigitrp.f90
new file mode 100644
index 0000000..5805204
--- /dev/null
+++ b/cdfsigitrp.f90
@@ -0,0 +1,461 @@
+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
new file mode 100644
index 0000000..18eed65
--- /dev/null
+++ b/cdfsigtrp-full.f90
@@ -0,0 +1,449 @@
+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
new file mode 100644
index 0000000..b87725f
--- /dev/null
+++ b/cdfsigtrp.f90
@@ -0,0 +1,554 @@
+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
+ !! : R. Dussin (Jul. 2009) add cdf output
+ !!---------------------------------------------------------------------
+ !! $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 !: 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
+
+ ! 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
+
+ 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=.FALSE.
+ CHARACTER(LEN=80) :: cfor9000, cfor9001, cfor9002, cfor9003
+
+
+ !! * 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 *,' cdfout : output in small netcdf files'
+ 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
+
+ DO jarg=7, narg
+ CALL getarg(jarg,cdum)
+ SELECT CASE (cdum)
+ CASE ('-print' )
+ l_print = .TRUE.
+ CASE ('-bimg')
+ l_bimg = .TRUE.
+ CASE ('cdfout')
+ lwrtcdf = .TRUE.
+ CASE DEFAULT
+ PRINT *,' Unknown option ', TRIM(cdum),' ... ignored'
+ END SELECT
+ END DO
+
+ IF(lwrtcdf) THEN
+
+ 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(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'
+
+ 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)
+
+ ! 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, 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
+
+ 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
+ WRITE(cfor9000,'(a,i3,a)') '(i7,',npts,'f8.3)'
+ WRITE(cfor9001,'(a,i3,a)') '(i7,',npts,'f8.0)'
+ WRITE(cfor9002,'(a,i3,a)') '(f7.3,',npts,'f8.0)'
+ WRITE(cfor9003,'(a,i3,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
+
+ PRINT *, 'E3 (m)'
+ DO jk=1,nk
+ PRINT cfor9001,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 .OR. zalfa < 0 ) 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 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)
+ 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 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)
+ 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 cfor9003, 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)
+
+
+ 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')
+
+ ! netcdf output
+ DO jiso=1,nbins
+ dummy1=sigma_lev(jiso)
+ dummy2=trpbin(jsec,jiso)
+ ierr = putvar(ncout,id_varout(1), dummy1, jiso, kx, ky )
+ ierr = putvar(ncout,id_varout(2), dummy2, jiso, kx, ky )
+ END DO
+
+ ierr = closeout(ncout)
+
+ END DO
+
+ ENDIF
+
+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
+
+ ! 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
+
+ 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
+ ! 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/cdfsigtrp2.f90 b/cdfsigtrp2.f90
new file mode 100644
index 0000000..286132d
--- /dev/null
+++ b/cdfsigtrp2.f90
@@ -0,0 +1,394 @@
+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
new file mode 100644
index 0000000..a7197d6
--- /dev/null
+++ b/cdfsmooth.f90
@@ -0,0 +1,376 @@
+PROGRAM cdfsmooth
+ !!----------------------------------------------------------------------------
+ !! *** 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
+ !!
+ !! * 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
+ USE cdfio
+ 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=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
+ ! ---
+
+
+ ! * 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.'
+ STOP
+ END IF
+ !
+ 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
+
+ IF ( narg == 3 ) THEN
+ CALL getarg(3, cnom)
+ SELECT CASE ( cnom)
+ CASE ( 'Lanczos','L','l')
+ nfilter=1
+ WRITE(cfilout,'(a,a,i3.3)') TRIM(cfile),'L',ncoup
+ PRINT *,' Working with Lanczos filter'
+ CASE ( 'Hanning','H','h')
+ nfilter=2
+ WRITE(cfilout,'(a,a,i3.3)') TRIM(cfile),'H',ncoup
+ PRINT *,' Working with Hanning filter'
+ CASE ( 'Shapiro','S','s')
+ nfilter=3
+ WRITE(cfilout,'(a,a,i3.3)') TRIM(cfile),'S',ncoup
+ PRINT *,' Working with Shapiro filter'
+ CASE ( 'Box','B','b')
+ nfilter=4
+ WRITE(cfilout,'(a,a,i3.3)') TRIM(cfile),'B',ncoup
+ PRINT *,' Working with Box filter'
+ CASE DEFAULT
+ PRINT *, TRIM(cnom),' : undefined filter ' ; STOP
+ END SELECT
+ ENDIF
+
+ 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)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cfile,'z',cdtrue=cdep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ npk = getdim (cfile,'sigma',cdtrue=cdep,kstatus=ierr)
+ IF ( ierr /= 0 ) THEN
+ PRINT *,' assume file with no depth'
+ npk=0
+ ENDIF
+ ENDIF
+ ENDIF
+ nt = getdim (cfile,'time',cdtrue=ctim)
+
+ PRINT *, 'npiglo = ',npiglo
+ PRINT *, 'npjglo = ',npjglo
+ PRINT *, 'npk = ',npk
+ PRINT *, 'nt = ',nt
+
+ 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 (id_var(nvars),ipk(nvars),id_varout(nvars) )
+
+ ! get list of variable names and collect attributes in typvar (optional)
+ cvarname(:)=getvarname(cfile,nvars,typvar)
+
+ ! 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)
+ !
+ DO jvar =1,nvars
+ IF (cvarname(jvar) == 'nav_lon' .OR. &
+ cvarname(jvar) == 'nav_lat' .OR. cvarname(jvar) == 'none' ) THEN
+ ! skip these variables
+ ELSE
+ spval=typvar(jvar)%missing_value
+ print *,'VAR ',TRIM(cvarname(jvar)),' SVPAL=',spval
+ !STOP
+ DO jt=1,nt
+ DO jk=1,ipk(jvar)
+ PRINT *, jt,'/',nt,' and ',jk,'/',ipk(jvar)
+ v2d(:,:) = getvar(cfile,cvarname(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)
+ !
+ END DO
+ END DO
+ ENDIF
+ END DO
+ ierr=putvar1d(ncout, tim,nt,'T')
+ ierr=closeout(ncout)
+
+CONTAINS
+
+ SUBROUTINE filterinit(kfilter, pfn, kband)
+ INTEGER, INTENT(in) :: kfilter, kband
+ REAL(KIND=4),INTENT(in) :: pfn
+ 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)
+ 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
+
+ SELECT CASE ( kfilter)
+ CASE ( 1 )
+ CALL lislanczos2d(px,kpx,py,npiglo,npjglo,fn,nband,npiglo,npjglo)
+ CASE ( 2 )
+ print *,' not available'
+ CASE ( 3 )
+ print *,' not available'
+ CASE ( 4 )
+ CALL lisbox(px,kpx,py,npiglo,npjglo,fn,nband,npiglo,npjglo)
+ 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
+
+ e(0)= 2.*pfn
+ DO ji=1,knj
+ e(ji)=SIN(zcoef*ji)/(zpi*ji)
+ END DO
+ !
+ ec(0) = 2*pfn
+ DO ji=1,knj
+ zey=zpi*ji/knj
+ ec(ji)=e(ji)*SIN(zey)/zey
+ END DO
+ !
+ END SUBROUTINE initlanc
+
+ SUBROUTINE inithann(pfn,knj)
+ INTEGER, INTENT(in) :: knj !: bandwidth
+ REAL(KIND=4),INTENT(in) :: pfn
+ PRINT *,' Init hann not done already' ; STOP
+ END SUBROUTINE inithann
+
+ SUBROUTINE initshap(pfn,knj)
+ INTEGER, INTENT(in) :: knj !: bandwidth
+ REAL(KIND=4),INTENT(in) :: pfn
+ PRINT *,' Init shap not done already' ; STOP
+ END SUBROUTINE initshap
+
+ SUBROUTINE initbox(pfn,knj)
+ INTEGER, INTENT(in) :: knj !: bandwidth
+ REAL(KIND=4),INTENT(in) :: pfn
+ ! dummy init
+ ec(:) = 1.
+ 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
+ !!
+ ! filtering
+ inxmin = knj
+ inxmaxi = knx-knj+1
+ inymin = knj
+ inymaxi = kny-knj+1
+ PRINT *,' filtering parameters'
+ PRINT *,' nx=',knx
+ PRINT *,' nband=',knj
+ PRINT *,' fn=',pfn
+ DO jj=1,kny
+ DO jmx=1,knx
+ ik1x = -knj
+ ik2x = knj
+ !
+ IF (jmx <= inxmin) ik1x = 1-jmx
+ IF (jmx >= inxmaxi) ik2x = knx-jmx
+ !
+ zyy = 0.d0
+ zden = 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)
+ END IF
+ END DO
+ !
+ ztmpx(jmx,jj)=zyy/zden
+ END DO
+ END DO
+
+ DO ji=1,knx
+ DO jmx=1,kny
+ ik1x = -knj
+ ik2x = knj
+ !
+ IF (jmx <= inymin) ik1x=1-jmx
+ IF (jmx >= inymaxi) ik2x=kny-jmx
+ !
+ zyy=0.d0
+ zden=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)
+ END IF
+ END DO
+! ztmpy(ji,jmx)=zyy/zden
+ py(ji,jmx)=0.
+ IF (zden .NE. 0.) py(ji,jmx)=zyy/zden
+ END DO
+ END DO
+! py=0.5*(ztmpx + ztmpy )
+ !
+ END SUBROUTINE lislanczos2d
+
+ 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
+ END DO
+
+ END SUBROUTINE lisbox
+
+END PROGRAM cdfsmooth
diff --git a/cdfspeed.f90 b/cdfspeed.f90
new file mode 100644
index 0000000..8a51608
--- /dev/null
+++ b/cdfspeed.f90
@@ -0,0 +1,146 @@
+PROGRAM cdfspeed
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfspeed ***
+ !!
+ !! ** Purpose : combine u and v to obtains the wind speed
+ !!
+ !! ** Method : sqrt(u**2 + v**2)
+ !!
+ !!
+ !! history ;
+ !! Original : P. Mathiot (Nov. 2007) from cdfmeanvar
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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
+
+ REAL(kind=4), DIMENSION(:), ALLOCATABLE :: tim
+
+ 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
+
+ LOGICAL :: lforcing
+ INTEGER :: istatus
+
+ TYPE (variable), DIMENSION(1) :: typvar !: structure for attibutes
+ ! constants
+
+ !! 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'
+ 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'
+ STOP
+ ENDIF
+
+ npiglo= getdim (cfilev,'x')
+ npjglo= getdim (cfilev,'y')
+ npk = getdim (cfilev,'depth')
+ nvpk = getvdim(cfilev,cvarv)
+ nt = getdim (cfilev,'time_counter')
+
+ 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
+
+ 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
+
+ ! 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'
+
+ ! 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)
+ 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)
+ END IF
+ ! Allocate arrays
+ ALLOCATE ( zv(npiglo,npjglo), zu(npiglo,npjglo), U(npiglo,npjglo), tim(nt))
+
+ DO jt=1,nt
+ 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)
+ IF ( lforcing ) THEN
+ ! 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
+ DO jj=1,npjglo
+ zu(ji,jj)=0.5*(zu(ji,jj)+zu(ji+1,jj))
+ ENDDO
+ ENDDO
+ DO ji=1,npiglo
+ DO jj=1,npjglo-1
+ zv(ji,jj)=0.5*(zv(ji,jj)+zv(ji,jj+1))
+ ENDDO
+ ENDDO
+ END IF
+
+ U=SQRT(zv*zv+zu*zu)
+ ierr = putvar(ncout, id_varout(1) ,U, jk ,npiglo, npjglo, ktime=jt)
+ END DO
+ END DO
+ ierr = closeout(ncout)
+
+END PROGRAM cdfspeed
diff --git a/cdfsstconv.f90 b/cdfsstconv.f90
new file mode 100644
index 0000000..54f2fd3
--- /dev/null
+++ b/cdfsstconv.f90
@@ -0,0 +1,576 @@
+PROGRAM cdfflxconv
+ !!-------------------------------------------------------------------
+ !! PROGRAM CDFFLXCONV
+ !! ******************
+ !!
+ !! ** Purpose: Convert a set of fluxes dimgfile (Clipper like)
+ !! to a set of CDF files (Drakkar like )
+ !!
+ !! ** Method: takes the current year as input, and config name
+ !! automatically read
+ !! ECMWF.Y${year}.M??.FLUX.${config}.dimg (daily, 1 file per month)
+ !! ECMWF.Y${year}.M??.STRESS.${config}.dimg (daily, 1 file per month)
+ !! REYNOLDS.Y${year}.SST.${config}.dimg ( weekly, 1 file per year ) ! Danger !
+ !! creates 6 netcdf daily files :
+ !! ECMWF_emp_1d_${year}.${config}.nc
+ !! ECMWF_qnet_1d_${year}.${config}.nc
+ !! ECMWF_qsr_1d_${year}.${config}.nc
+ !! ECMWF_sst_1d_${year}.${config}.nc
+ !! ECMWF_taux_1d_${year}.${config}.nc
+ !! ECMWF_tauy_1d_${year}.${config}.nc
+ !! Requires coordinates.diags file (to be input consistent)
+ !!
+ !! history:
+ !! Original: J.M. Molines (Feb. 2007 )
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !!
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ IMPLICIT NONE
+ INTEGER :: ji,jj,jk, jvar, jmonth, jdim, jday, jt
+ INTEGER :: narg, iargc, nvar
+ INTEGER :: npiglo,npjglo, npk !: size of the domain
+ INTEGER :: iyear, icurrday, jul, jul1, jul2
+ INTEGER :: id1, id2, ii1, ii2, ntime, ntp, ntn, itt
+ INTEGER :: january1, december31
+ INTEGER, DIMENSION(:), ALLOCATABLE :: itime
+
+ REAL(KIND=4) , DIMENSION (:,:,:), ALLOCATABLE :: v2d
+ REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glam, gphi, z2d, v2daily
+ REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamu, gphiu
+ REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamv, gphiv
+ REAL(KIND=4) , DIMENSION (:), ALLOCATABLE :: dep, timetab
+ REAL(KIND=8) , DIMENSION (:), ALLOCATABLE :: timetag, timetagp,timetagn
+ REAL(KIND=4) ,DIMENSION(1) :: timean
+
+ CHARACTER(LEN=256) :: ctag, confcase
+
+ ! Dimg stuff
+ INTEGER :: irecl, ii, nt, ndim, irec
+ INTEGER :: numflx=10, numcoo=11, numtau=12, numsst=14, numsstp=15, numsstn=16
+ CHARACTER(LEN=256) :: cflux, ctau, csstr,csstrp, csstrn
+ CHARACTER(LEN=256) :: coord='coordinates.diags'
+ CHARACTER(LEN=256) :: cheader, cdum, config
+ CHARACTER(LEN=4) :: cver
+ REAL(KIND=4) :: x1,y1, dx,dy, spval
+ ! coordinates.diags
+ INTEGER :: nrecl8
+ REAL(KIND=8) :: zrecl8, zpiglo,zpjglo
+ REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: dzvar
+ CHARACTER(LEN=256) :: cltextco
+ LOGICAL :: lexist
+
+ ! Netcdf Stuff
+ CHARACTER(LEN=256) :: cemp, cqnet, cqsr, ctaux, ctauy, csst
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvaremp,typvarqnet,typvarqsr
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvartaux,typvartauy,typvarsst
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ipkemp, ipkqnet, ipkqsr, id_varoutemp,id_varoutqnet, id_varoutqsr
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ipktaux, ipktauy, ipksst, id_varouttaux,id_varouttauy, id_varoutsst
+ INTEGER :: ncoutemp, ncoutqnet, ncoutqsr, ncouttaux, ncouttauy, ncoutsst
+ INTEGER :: istatus
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg /= 2 ) THEN
+ PRINT *,' Usage : cdfflxconv YEAR config '
+ PRINT *,' Output 6 cdf files : for emp, qnet, qsr, sst, taux, tauy with standard var name :'
+ PRINT *,' sowaflup, sohefldo, soshfldo, sst, sozotaux, sometauy '
+ PRINT *,' coordinates.diags ( clipper like) is required in current dir '
+ STOP
+ ENDIF
+ !!
+ CALL getarg (1, cdum)
+ READ(cdum,*) iyear
+ CALL getarg (2, config)
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !! ..... FLUXES FLUXES FLUXES ..... !!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ PRINT *, 'Doing fluxes ... '
+ GOTO 10
+
+ !! read glam gphi in the coordinates file for T point (fluxes)
+ nrecl8=200
+ OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8)
+ READ(numcoo,rec=1) cltextco,zrecl8,zpiglo,zpjglo
+ CLOSE(numcoo)
+ nrecl8=zrecl8 ; npiglo=zpiglo ; npjglo=zpjglo
+ ALLOCATE ( glam(npiglo,npjglo), gphi(npiglo,npjglo) ,dzvar(npiglo,npjglo) )
+ OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8)
+ READ(numcoo,REC=2)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glam(:,:) = dzvar(:,:)
+ READ(numcoo,REC=6)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphi(:,:) = dzvar(:,:)
+ DEALLOCATE ( dzvar )
+ CLOSE(numcoo)
+
+ !! build nc output files
+ WRITE(cemp,'(a,I4.4,a)') 'ECMWF_emp_1d_',iyear,'.'//TRIM(config)//'.nc'
+ WRITE(cqnet,'(a,I4.4,a)') 'ECMWF_qnet_1d_',iyear,'.'//TRIM(config)//'.nc'
+ WRITE(cqsr,'(a,I4.4,a)') 'ECMWF_qsr_1d_',iyear,'.'//TRIM(config)//'.nc'
+
+ jmonth=1
+ !! Build dimg file names
+ WRITE(cflux,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.FLUX.'//TRIM(config)//'.dimg'
+ ! WRITE(ctau ,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',imonth,'.STRESS.'//TRIM(config)//'.dimg'
+ ! WRITE(csst ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg'
+
+ ! open (and check ?? if they exists )
+ irecl=isdirect(cflux) ; OPEN( numflx,FILE=cflux, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+
+ READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk
+
+ ALLOCATE (v2d(npiglo, npjglo,4), dep(npk) )
+ ALLOCATE (z2d(npiglo, npjglo) )
+ READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, &
+ x1,y1,dx,dy,spval, &
+ (dep(jk),jk=1,npk), &
+ timean(1)
+ CLOSE(numflx)
+
+ ! Build cdf files output
+ nvar = 1 ! 1 var but many files ... (OK ... 3 actually )
+ ALLOCATE ( typvaremp(nvar), ipkemp(nvar), id_varoutemp(nvar) )
+ ALLOCATE ( typvarqnet(nvar), ipkqnet(nvar), id_varoutqnet(nvar) )
+ 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)%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'
+
+ ipkqnet(jvar) = 1
+ typvarqnet(jvar)%name='sohefldo' ! QNET = dim 1 dimgfile
+ typvarqnet(jvar)%units='W/m2'
+ typvarqnet(jvar)%missing_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'
+
+ ipkqsr(jvar) = 1
+ typvarqsr(jvar)%name='soshfldo' ! QSR = dim 2 dimgfile
+ typvarqsr(jvar)%units='W/m2'
+ typvarqsr(jvar)%missing_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'
+
+ ncoutemp =create(cemp, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncoutemp ,typvaremp,nvar, ipkemp,id_varoutemp )
+ istatus= putheadervar(ncoutemp, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+ ncoutqnet =create(cqnet, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncoutqnet ,typvarqnet,nvar, ipkqnet,id_varoutqnet )
+ istatus= putheadervar(ncoutqnet, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+ ncoutqsr =create(cqsr, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncoutqsr ,typvarqsr,nvar, ipkqsr,id_varoutqsr )
+ istatus= putheadervar(ncoutqsr, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+
+ ! Ready for time loop on month
+ icurrday=0
+ DO jmonth = 1, 12
+ WRITE(cflux,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.FLUX.'//TRIM(config)//'.dimg'
+ irecl=isdirect(cflux) ; OPEN( numflx,FILE=cflux, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ READ(numflx,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim
+ ! loop for days in files
+ DO jday=1,nt
+ icurrday=icurrday +1
+ DO jdim=1,ndim
+ irec=1+(jday-1)*ndim +jdim
+ READ(numflx,REC=irec) (( v2d(ji,jj,jdim),ji=1,npiglo),jj=1,npjglo)
+ END DO
+ ! emp
+ z2d=(v2d(:,:,3) - v2d(:,:,4) )/ 86400. ! scaling from mm/d to kg/m2/s
+ istatus = putvar(ncoutemp,id_varoutemp(1),z2d,icurrday,npiglo,npjglo)
+ ! qnet
+ istatus = putvar(ncoutqnet,id_varoutqnet(1),v2d(:,:,1),icurrday,npiglo,npjglo)
+ ! qsr
+ istatus = putvar(ncoutqsr,id_varoutqsr(1),v2d(:,:,2),icurrday,npiglo,npjglo)
+ END DO ! loop on days
+ CLOSE(numflx)
+ END DO ! loop on month
+
+ ! update time_counter
+ ALLOCATE( timetab (icurrday) )
+ timetab=(/(jt,jt=1,icurrday)/)
+ istatus=putvar1d(ncoutemp,timetab,icurrday,'T')
+ istatus=putvar1d(ncoutqnet,timetab,icurrday,'T')
+ istatus=putvar1d(ncoutqsr,timetab,icurrday,'T')
+ ! close fluxes files
+ istatus=closeout(ncoutemp)
+ istatus=closeout(ncoutqnet)
+ istatus=closeout(ncoutqsr)
+ DEALLOCATE (v2d , dep, z2d , timetab )
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !! ..... STRESSES STRESSES STRESSES ...... !!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ PRINT *,' Doing Stresses ...'
+
+ !! read glam gphi in the coordinates file for U point (fluxes)
+ nrecl8=200
+ OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8)
+ READ(numcoo,rec=1) cltextco,zrecl8,zpiglo,zpjglo
+ CLOSE(numcoo)
+ nrecl8=zrecl8 ; npiglo=zpiglo ; npjglo=zpjglo
+ ALLOCATE ( glamu(npiglo,npjglo), gphiu(npiglo,npjglo) ,dzvar(npiglo,npjglo) )
+ ALLOCATE ( glamv(npiglo,npjglo), gphiv(npiglo,npjglo) )
+ OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8)
+ READ(numcoo,REC=3)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamu(:,:) = dzvar(:,:)
+ READ(numcoo,REC=7)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiu(:,:) = dzvar(:,:)
+ READ(numcoo,REC=4)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamv(:,:) = dzvar(:,:)
+ READ(numcoo,REC=8)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiv(:,:) = dzvar(:,:)
+ DEALLOCATE ( dzvar )
+ CLOSE(numcoo)
+
+ !! build nc output files
+ WRITE(ctaux,'(a,I4.4,a)') 'ECMWF_taux_1d_',iyear,'.'//TRIM(config)//'.nc'
+ WRITE(ctauy,'(a,I4.4,a)') 'ECMWF_tauy_1d_',iyear,'.'//TRIM(config)//'.nc'
+
+ jmonth=1
+ !! Build dimg file names
+ WRITE(ctau ,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg'
+ ! WRITE(csst ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg'
+
+ ! open (and check ?? if they exists )
+ irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+
+ READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk
+
+ ALLOCATE (v2d(npiglo, npjglo,2), dep(npk) )
+ ALLOCATE (z2d(npiglo, npjglo) )
+ READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, &
+ x1,y1,dx,dy,spval, &
+ (dep(jk),jk=1,npk), &
+ timean(1)
+ CLOSE(numtau)
+
+ ! Build cdf files output
+ nvar = 1 ! 1 var but many files ... (OK ... 3 actually )
+ ALLOCATE ( typvartaux(nvar), ipktaux(nvar), id_varouttaux(nvar) )
+ 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)%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'
+
+ ipktauy(jvar) = 1
+ typvartauy(jvar)%name='sometauy' ! tauy dim 2 of dimgfile
+ typvartauy(jvar)%units='N/m2'
+ typvartauy(jvar)%missing_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'
+
+ ncouttaux =create(ctaux, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncouttaux ,typvartaux,nvar, ipktaux,id_varouttaux )
+ istatus= putheadervar(ncouttaux, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+
+ ncouttauy =create(ctauy, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncouttauy ,typvartauy,nvar, ipktauy,id_varouttauy )
+ istatus= putheadervar(ncouttauy, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+
+ ! Ready for time loop on month
+ icurrday=0
+ DO jmonth = 1, 12
+ WRITE(ctau,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg'
+ irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim
+ ! loop for days in files
+ DO jday=1,nt
+ icurrday=icurrday +1
+ DO jdim=1,ndim
+ irec=1+(jday-1)*ndim +jdim
+ READ(numtau,REC=irec) (( v2d(ji,jj,jdim),ji=1,npiglo),jj=1,npjglo)
+ END DO
+ ! taux
+ istatus = putvar(ncouttaux,id_varouttaux(1),v2d(:,:,1),icurrday,npiglo,npjglo)
+ ! tauy
+ istatus = putvar(ncouttauy,id_varouttauy(1),v2d(:,:,2),icurrday,npiglo,npjglo)
+ END DO ! loop on days
+ CLOSE(numtau)
+ END DO ! loop on month
+
+ ! update time_counter
+ ALLOCATE( timetab (icurrday) )
+ timetab=(/(jt,jt=1,icurrday)/)
+ istatus=putvar1d(ncouttaux,timetab,icurrday,'T')
+ istatus=putvar1d(ncouttauy,timetab,icurrday,'T')
+ ! close fluxes files
+ istatus=closeout(ncouttaux)
+ istatus=closeout(ncouttauy)
+ DEALLOCATE (v2d , dep, z2d , timetab)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !! ..... SST SST SST .....
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 10 continue
+ PRINT *,' Doing SST ...'
+
+ !! glam gphi are already read ( T point)
+
+ !! build nc output files
+ WRITE(csst,'(a,I4.4,a)') 'REYNOLDS_sst_1d_',iyear,'.'//TRIM(config)//'.nc'
+
+ !! Build dimg file names
+ WRITE(csstr ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg'
+
+ ! open (and check ?? if they exists )
+ irecl=isdirect(csstr) ; OPEN( numsst,FILE=csstr, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+
+ READ(numsst,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt
+
+ ALLOCATE (v2d(npiglo, npjglo,nt+2),itime(nt+2), dep(npk) ,timetab(nt), timetag(nt) )
+ ALLOCATE (z2d(npiglo, npjglo) ,v2daily(npiglo,npjglo) )
+ READ(numsst,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, &
+ x1,y1,dx,dy,spval, &
+ (dep(jk),jk=1,npk), &
+ (timetab(jt), jt=1,nt)
+ timetag=timetab ! convert to dble precision
+ DEALLOCATE(timetab)
+
+ ! Build cdf files output
+ nvar = 1 ! 1 var but many files ... (OK ... 3 actually )
+ 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)%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'
+
+ ncoutsst =create(csst, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncoutsst ,typvarsst,nvar, ipksst,id_varoutsst )
+ istatus= putheadervar(ncoutsst, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+
+ ! We want to interpolate the data for every day. (weekly in the file)
+ ! if first day of the file is not 01/01, needs to read previous year
+ ! Clipper SST files are not y2k compliant ...
+ IF (timetag (1) < 10000 ) THEN
+ timetag(:)=timetag(:)+20000000.
+ ELSE
+ timetag(:)=timetag(:)+19000000.
+ ENDIF
+ january1=iyear*10000+01*100+01
+ december31=iyear*10000+12*100+31
+ jul1=julday(january1)
+ jul2=julday(december31)
+
+ itt=0
+ IF (jul1 < julday(INT(timetag(1))) ) THEN
+ ! need to read previous year
+ WRITE(csstrp ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear-1,'.SST.'//TRIM(config)//'.dimg'
+ irecl=isdirect(csstrp) ; OPEN( numsstp,FILE=csstrp, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ READ(numsstp,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntp
+ ALLOCATE (timetagp (ntp) ,timetab(ntp))
+ READ(numsstp,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntp, ndim, &
+ x1,y1,dx,dy,spval, &
+ (dep(jk),jk=1,npk), &
+ (timetab(jt), jt=1,ntp)
+ timetagp=timetab
+ DEALLOCATE(timetab)
+ IF (timetagp (1) < 10000 ) THEN
+ timetagp(:)=timetagp(:)+20000000.
+ ELSE
+ timetagp(:)=timetagp(:)+19000000.
+ ENDIF
+ IF ( julday(INT(timetagp (ntp))) <= jul1 ) THEN
+ !read ntp sst as 1 data
+ itt = itt +1
+ READ(numsstp,REC=ntp+1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday( INT(timetagp(ntp)) )
+ ELSE IF ( julday(INT(timetagp (ntp-1)) ) <= jul1 ) THEN
+ itt = itt +1
+ READ(numsstp,REC=ntp) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT(timetagp(ntp-1)) )
+ ELSE IF ( julday(INT(timetagp (ntp-2) )) <= jul1 ) THEN
+ itt = itt +1
+ READ(numsstp,REC=ntp-1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT(timetagp(ntp-2)) )
+ ELSE
+ PRINT *,' Something is wrong in previous file SST ' ; STOP
+ ENDIF
+ ENDIF
+ DO jt=1,nt
+ itt = itt +1
+ READ(numsst,REC=jt+1) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT(timetag(jt)) )
+ END DO
+
+ IF ( jul2 > julday(INT(timetag(nt))) ) THEN
+ ! need to read next year
+ IF ( iyear == 2000 ) THEN ! persistance ...
+ itt=itt+1 ; v2d(:,:,itt)= v2d(:,:,itt-1) ; itime(itt)=jul2
+ ELSE
+ WRITE(csstrn ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear+1,'.SST.'//TRIM(config)//'.dimg'
+ irecl=isdirect(csstrn) ; OPEN( numsstn,FILE=csstrn, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ READ(numsstn,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntn
+ ALLOCATE (timetagn (ntn) ,timetab(ntn))
+ READ(numsstn,REC=1) cver, cheader, ii, npiglo, npjglo, npk, ntn, ndim, &
+ x1,y1,dx,dy,spval, &
+ (dep(jk),jk=1,npk), &
+ (timetab(jt), jt=1,ntn)
+ timetagn=timetab
+ DEALLOCATE( timetab)
+ IF (timetagn (1) < 10000 ) THEN
+ timetagn(:)=INT(timetagn(:))+20000000
+ ELSE
+ timetagn(:)=INT(timetagn(:))+19000000
+ ENDIF
+
+ IF ( julday(INT(timetagn (1) )) >= jul2 ) THEN
+ !read 1 sst as 1 data
+ itt = itt +1
+ READ(numsstn,REC=2) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT(timetagn(1)) )
+ ELSE IF ( julday(INT(timetagn (2)) ) >= jul2 ) THEN
+ itt = itt +1
+ READ(numsstn,REC=3) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT( timetagn(2)) )
+ ELSE IF ( julday(INT(timetagn (3))) >= jul2 ) THEN
+ itt = itt +1
+ READ(numsstn,REC=4) (( v2d(ji,jj,itt),ji=1,npiglo),jj=1,npjglo)
+ itime(itt)=julday(INT(timetagn(3)) )
+ ELSE
+ PRINT *,' Something is wrong in next file SST ' ; STOP
+ ENDIF
+ ENDIF
+ ENDIF
+ ntime=itt
+
+ icurrday=0
+ ii1=1 ; ii2 = 2 ; id1=itime(ii1) ; id2=itime(ii2)
+ DO jul = jul1, jul2
+ icurrday=icurrday + 1
+ IF ( jul > id2 ) THEN
+ ii1=ii1+1 ; ii2=ii2+1 ; id1=itime(ii1) ; id2=itime(ii2)
+ ENDIF
+ v2daily(:,:)=FLOAT((jul - id1 ))/(FLOAT(id2-id1))*(v2d(:,:,ii2) - v2d(:,:,ii1) ) + v2d(:,:,ii1)
+ istatus = putvar(ncoutsst,id_varoutsst(1),v2daily(:,:),icurrday,npiglo,npjglo)
+ END DO
+
+ ! update time_counter
+ ALLOCATE( timetab (icurrday) )
+ timetab=(/(jt,jt=1,icurrday)/)
+ istatus=putvar1d(ncoutsst,timetab,icurrday,'T')
+ ! close fluxes files
+ istatus=closeout(ncoutsst)
+ istatus=closeout(ncoutsst)
+ DEALLOCATE (v2d , dep, z2d )
+
+ 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=256) :: clheader
+ !
+ INTEGER :: irecl
+
+ !
+ OPEN(100,FILE=clname, FORM ='UNFORMATTED', ACCESS ='DIRECT', RECL =88)
+ READ(100,REC=1) cver ,clheader,irecl
+ CLOSE(100)
+ !
+ IF (cver == '@!01' ) THEN
+ isdirect=irecl
+ ELSE
+ isdirect=0
+ END IF
+ !
+ END FUNCTION isdirect
+
+ FUNCTION julday(kdastp)
+ !! ------------------------------------------------------------------
+ !! *** FUNCTION JULDAY ***
+ !!
+ !! Purpose: This routine returns the julian day number which begins at noon
+ !! of the calendar date specified by month kmm, day kid, and year kiyyy.
+ !! positive year signifies a.d.; negative, b.c. (remember that the
+ !! year after 1 b.c. was 1 a.d.)
+ !! routine handles changeover to gregorian calendar on oct. 15, 1582.
+ !!
+ !! Method: This routine comes directly from the Numerical Recipe Book,
+ !! press et al., numerical recipes, cambridge univ. press, 1986.
+ !!
+ !! Arguments:
+ !! kdastp : OPA date yyyymmdd (instead of kmm kid kiyyy)
+ !! kmm : input, corresponding month
+ !! kid : input, corresponding day
+ !! kiyyy : input, corresponding year, positive IF a.d, negative b.c.
+ !!
+ !!
+ !! history
+ !! 1998: J.M. Molines for the Doctor form.
+ !! 2007 : J.M. Molines in F90
+ !! -----------------------------------------------------------------
+ ! * Declarations
+ !
+ INTEGER :: julday, kiyyy,kid,kmm
+ INTEGER, INTENT(in) ::kdastp
+ ! * Local
+ INTEGER, PARAMETER ::jpgreg=15+31*(10+12*1582)
+ INTEGER :: iy, im, ia
+ ! ... Year 0 never existed ...
+ kiyyy=kdastp/10000
+ kmm=(kdastp - kiyyy*10000)/100
+ kid= kdastp - kiyyy*10000 - kmm*100
+ IF (kiyyy == 0) STOP 101
+ !
+ IF (kiyyy < 0) kiyyy = kiyyy + 1
+ IF (kmm > 2) THEN
+ iy = kiyyy
+ im = kmm + 1
+ ELSE
+ iy = kiyyy - 1
+ im = kmm + 13
+ END IF
+ !
+ julday = INT(365.25*iy) + INT(30.6001*im) + kid + 1720995
+ IF (kid+31*(kmm+12*kiyyy).GE.jpgreg) THEN
+ ia = INT(0.01*iy)
+ julday = julday + 2 - ia + INT(0.25*ia)
+ END IF
+ END FUNCTION JULDAY
+ END PROGRAM cdfflxconv
diff --git a/cdfstatcoord.f90 b/cdfstatcoord.f90
new file mode 100644
index 0000000..0c72be1
--- /dev/null
+++ b/cdfstatcoord.f90
@@ -0,0 +1,79 @@
+PROGRAM cdfstatcoord
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfstatcoord ***
+ !!
+ !! ** Purpose: Compute statistics about the grid metric versus latitude
+ !!
+ !! ** 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
+ USE cdfio
+
+ !! * Local variables
+ 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()
+ 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 '
+ STOP
+ ENDIF
+
+ CALL getarg (1, coord)
+ CALL getarg (2, cmask)
+ IF ( narg == 3 ) CALL getarg(3,cvmask)
+
+ npiglo= getdim (coord,'x')
+ npjglo= getdim (coord,'y')
+
+ PRINT *, 'npiglo=', npiglo
+ PRINT *, 'npjglo=', npjglo
+
+ ALLOCATE ( e1(npiglo,npjglo) , e2(npiglo,npjglo) )
+ ALLOCATE ( gphi(npiglo,npjglo), tmask(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)
+
+ 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
+ ENDDO
+END PROGRAM cdfstatcoord
diff --git a/cdfstd.f90 b/cdfstd.f90
new file mode 100644
index 0000000..48abad4
--- /dev/null
+++ b/cdfstd.f90
@@ -0,0 +1,160 @@
+PROGRAM cdfstd
+ !!-----------------------------------------------------------------------
+ !! *** PROGRAM cdfrms ***
+ !!
+ !! ** 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$
+ !!--------------------------------------------------------------
+ !!
+ USE cdfio
+
+ 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
+
+ !!
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfstd ''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',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), std(npiglo,npjglo) )
+
+ nvars = getnvar(cfile)
+ PRINT *,' nvars =', nvars
+
+ ALLOCATE (cvarname(nvars), cvarnameo(nvars) )
+ ALLOCATE (typvar(nvars), typvaro(nvars) )
+ ALLOCATE (id_var(nvars),ipk(nvars),id_varout(nvars) )
+
+ 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)
+ DO jvar = 1, nvars
+ cvarnameo(jvar)=TRIM(cvarname(jvar))//'_std'
+ ENDDO
+
+ WHERE( ipk == 0 ) cvarnameo='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)
+ 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 )
+
+ lcaltmean=.TRUE.
+ DO jvar = 1,nvars
+ IF (cvarname(jvar) == 'nav_lon' .OR. &
+ cvarname(jvar) == 'nav_lat' .OR. &
+ cvarnameo(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.; ntframe=0
+ DO jt = 1, narg
+ CALL getarg (jt, cfile)
+ nt = getdim (cfile,'time_counter')
+ IF ( lcaltmean ) THEN
+ tim(1:nt)=getvar1d(cfile,'time_counter',nt)
+ total_time = total_time + SUM(tim(1:nt) )
+ 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(:,:)
+ 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')
+ 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)
+
+END PROGRAM cdfstd
diff --git a/cdfstdevts.f90 b/cdfstdevts.f90
new file mode 100644
index 0000000..c6df4bf
--- /dev/null
+++ b/cdfstdevts.f90
@@ -0,0 +1,110 @@
+PROGRAM cdfstdevts
+ !!--------------------------------------------------------------------
+ !! *** PROGRAM cdfstdevts ***
+ !!
+ !! ** Purpose : Compute standard deviation of TS fields
+ !!
+ !! ** Method : Try to avoid 3 d arrays
+ !!
+ !! history :
+ !! Original : J.M. Molines (nov 2004) for ORCA025
+ !! J.M. Molines (Apr 2005) : use of modules
+ !!--------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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, rms
+ REAL(KIND=4) ,DIMENSION(1) :: timean
+
+ CHARACTER(LEN=256) :: cfile ,cfile2 ,cfileout='rmsts.nc' !: file name
+ CHARACTER(LEN=256), DIMENSION(2) :: cvar, cvar2
+
+ TYPE(variable), DIMENSION(2) :: typvar !: structure for attributes
+
+ INTEGER :: ncout
+ INTEGER :: istatus, ierr
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg /= 2 ) THEN
+ PRINT *,' Usage : cdfstdevts ''gridX gridX2'' '
+ PRINT *,' Output on rmsts.nc variable votemper_rms vosaline_rms'
+ 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_rms'
+ typvar(1)%units='DegC'
+ typvar(1)%missing_value=0.
+ typvar(1)%valid_min= 0.
+ typvar(1)%valid_max= 20.
+ typvar(1)%long_name='RMS_temperature'
+ typvar(1)%short_name='votemper_rms'
+ typvar(1)%online_operation='N/A'
+ typvar(1)%axis='TZYX'
+
+ ipk(2) = npk
+ typvar(2)%name= 'vosaline_rms'
+ typvar(2)%units='PSU'
+ typvar(2)%missing_value=0.
+ typvar(2)%valid_min= 0.
+ typvar(2)%valid_max= 10.
+ typvar(2)%long_name='RMS_salinity'
+ typvar(2)%short_name='vosaline_rms'
+ 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( rms(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)
+
+ rms(:,:) = 0.
+ DO ji=2, npiglo
+ DO jj=2,npjglo
+ rms(ji,jj) = ((u2(ji,jj)-u(ji,jj)*u(ji,jj)))
+ END DO
+ END DO
+ ierr=putvar(ncout,id_varout(jvar), real(rms), jk, npiglo, npjglo)
+ END DO
+ timean=getvar1d(cfile,'time_counter',1)
+ END DO
+ ierr=putvar1d(ncout,timean,1,'T')
+ istatus = closeout(ncout)
+
+END PROGRAM cdfstdevts
diff --git a/cdfstdevw.f90 b/cdfstdevw.f90
new file mode 100644
index 0000000..b9b834c
--- /dev/null
+++ b/cdfstdevw.f90
@@ -0,0 +1,92 @@
+PROGRAM cdfstdevw
+ !!--------------------------------------------------------------------
+ !! *** PROGRAM cdfstdevw ***
+ !!
+ !! ** Purpose : Compute standard deviation of W fields
+ !!
+ !! ** Method : Try to avoid 3 d arrays
+ !!
+ !! history :
+ !! Original : J.M. Molines (nov 2004) for ORCA025
+ !! J.M. Molines (Apr 2005) : use of modules
+ !!--------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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
+
+ TYPE(variable), DIMENSION(1) :: typvar !: structure for attributes
+
+ INTEGER :: ncout
+ INTEGER :: istatus, ierr
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg /= 2 ) THEN
+ PRINT *,' Usage : cdfstdevw ''gridX gridX2'' '
+ PRINT *,' Output on rmsw.nc variable vovecrtz_rms'
+ 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
+ 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)
+
+END PROGRAM cdfstdevw
diff --git a/cdfstrconv.f90 b/cdfstrconv.f90
new file mode 100644
index 0000000..9cb268f
--- /dev/null
+++ b/cdfstrconv.f90
@@ -0,0 +1,287 @@
+PROGRAM cdfstrconv
+ !!-------------------------------------------------------------------
+ !! PROGRAM CDFFLXCONV
+ !! ******************
+ !!
+ !! ** Purpose: Convert a set of fluxes dimgfile (Clipper like)
+ !! to a set of CDF files (Drakkar like )
+ !!
+ !! ** Method: takes the current year as input, and config name
+ !! automatically read
+ !! ECMWF.Y${year}.M??.FLUX.${config}.dimg (daily, 1 file per month)
+ !! ECMWF.Y${year}.M??.STRESS.${config}.dimg (daily, 1 file per month)
+ !! REYNOLDS.Y${year}.SST.${config}.dimg ( weekly, 1 file per year ) ! Danger !
+ !! creates 6 netcdf daily files :
+ !! ECMWF_emp_1d_${year}.${config}.nc
+ !! ECMWF_qnet_1d_${year}.${config}.nc
+ !! ECMWF_qsr_1d_${year}.${config}.nc
+ !! ECMWF_sst_1d_${year}.${config}.nc
+ !! ECMWF_taux_1d_${year}.${config}.nc
+ !! ECMWF_tauy_1d_${year}.${config}.nc
+ !! Requires coordinates.diags file (to be input consistent)
+ !!
+ !! history:
+ !! Original: J.M. Molines (Feb. 2007 )
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !!
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ IMPLICIT NONE
+ INTEGER :: ji,jj,jk, jvar, jmonth, jdim, jday, jt
+ INTEGER :: narg, iargc, nvar
+ INTEGER :: npiglo,npjglo, npk !: size of the domain
+ INTEGER :: iyear, icurrday, jul, jul1, jul2
+ INTEGER :: id1, id2, ii1, ii2, ntime, ntp, ntn, itt
+ INTEGER :: january1, december31
+ INTEGER, DIMENSION(:), ALLOCATABLE :: itime
+
+ REAL(KIND=4) , DIMENSION (:,:,:), ALLOCATABLE :: v2d
+ REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glam, gphi, z2d, v2daily
+ REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamu, gphiu
+ REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: glamv, gphiv
+ REAL(KIND=4) , DIMENSION (:), ALLOCATABLE :: dep, timetab
+ REAL(KIND=8) , DIMENSION (:), ALLOCATABLE :: timetag, timetagp,timetagn
+ REAL(KIND=4) ,DIMENSION(1) :: timean
+
+ CHARACTER(LEN=256) :: ctag, confcase
+
+ ! Dimg stuff
+ INTEGER :: irecl, ii, nt, ndim, irec
+ INTEGER :: numflx=10, numcoo=11, numtau=12, numsst=14, numsstp=15, numsstn=16
+ CHARACTER(LEN=256) :: cflux, ctau, csstr,csstrp, csstrn
+ CHARACTER(LEN=256) :: coord='coordinates.diags'
+ CHARACTER(LEN=256) :: cheader, cdum, config
+ CHARACTER(LEN=4) :: cver
+ REAL(KIND=4) :: x1,y1, dx,dy, spval
+ ! coordinates.diags
+ INTEGER :: nrecl8
+ REAL(KIND=8) :: zrecl8, zpiglo,zpjglo
+ REAL(KIND=8) , DIMENSION (:,:), ALLOCATABLE :: dzvar
+ CHARACTER(LEN=256) :: cltextco
+ LOGICAL :: lexist
+
+ ! Netcdf Stuff
+ CHARACTER(LEN=256) :: cemp, cqnet, cqsr, ctaux, ctauy, csst
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvaremp,typvarqnet,typvarqsr
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvartaux,typvartauy,typvarsst
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ipkemp, ipkqnet, ipkqsr, id_varoutemp,id_varoutqnet, id_varoutqsr
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ipktaux, ipktauy, ipksst, id_varouttaux,id_varouttauy, id_varoutsst
+ INTEGER :: ncoutemp, ncoutqnet, ncoutqsr, ncouttaux, ncouttauy, ncoutsst
+ INTEGER :: istatus
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg /= 2 ) THEN
+ PRINT *,' Usage : cdfstrconv YEAR config '
+ PRINT *,' Output 6 cdf files : for emp, qnet, qsr, sst, taux, tauy with standard var name :'
+ PRINT *,' sowaflup, sohefldo, soshfldo, sst, sozotaux, sometauy '
+ PRINT *,' coordinates.diags ( clipper like) is required in current dir '
+ STOP
+ ENDIF
+ !!
+ CALL getarg (1, cdum)
+ READ(cdum,*) iyear
+ CALL getarg (2, config)
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !! ..... STRESSES STRESSES STRESSES ...... !!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ PRINT *,' Doing Stresses ...'
+
+ !! read glam gphi in the coordinates file for U point (fluxes)
+ nrecl8=200
+ OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8)
+ READ(numcoo,rec=1) cltextco,zrecl8,zpiglo,zpjglo
+ CLOSE(numcoo)
+ nrecl8=zrecl8 ; npiglo=zpiglo ; npjglo=zpjglo
+ ALLOCATE ( glamu(npiglo,npjglo), gphiu(npiglo,npjglo) ,dzvar(npiglo,npjglo) )
+ ALLOCATE ( glamv(npiglo,npjglo), gphiv(npiglo,npjglo) )
+ OPEN(numcoo,FILE=coord,status='old' ,form='unformatted', access='direct',recl=nrecl8)
+ READ(numcoo,REC=3)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamu(:,:) = dzvar(:,:)
+ READ(numcoo,REC=7)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiu(:,:) = dzvar(:,:)
+ READ(numcoo,REC=4)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; glamv(:,:) = dzvar(:,:)
+ READ(numcoo,REC=8)((dzvar(ji,jj),ji=1,npiglo),jj=1,npjglo) ; gphiv(:,:) = dzvar(:,:)
+ DEALLOCATE ( dzvar )
+ CLOSE(numcoo)
+
+ !! build nc output files
+ WRITE(ctaux,'(a,I4.4,a)') 'ECMWF_taux_1d_',iyear,'.'//TRIM(config)//'.nc'
+ WRITE(ctauy,'(a,I4.4,a)') 'ECMWF_tauy_1d_',iyear,'.'//TRIM(config)//'.nc'
+
+ jmonth=1
+ !! Build dimg file names
+ WRITE(ctau ,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg'
+ ! WRITE(csst ,'(a,I4.4,a,I2.2,a)') 'REYNOLDS.Y',iyear,'.SST.'//TRIM(config)//'.dimg'
+
+ ! open (and check ?? if they exists )
+ irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+
+ READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk
+
+ ALLOCATE (v2d(npiglo, npjglo,2), dep(npk) )
+ ALLOCATE (z2d(npiglo, npjglo) )
+ READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim, &
+ x1,y1,dx,dy,spval, &
+ (dep(jk),jk=1,npk), &
+ timean(1)
+ CLOSE(numtau)
+
+ ! Build cdf files output
+ nvar = 1 ! 1 var but many files ... (OK ... 3 actually )
+ ALLOCATE ( typvartaux(nvar), ipktaux(nvar), id_varouttaux(nvar) )
+ 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)%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'
+
+ ipktauy(jvar) = 1
+ typvartauy(jvar)%name='sometauy' ! tauy dim 2 of dimgfile
+ typvartauy(jvar)%units='N/m2'
+ typvartauy(jvar)%missing_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'
+
+ ncouttaux =create(ctaux, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncouttaux ,typvartaux,nvar, ipktaux,id_varouttaux )
+ istatus= putheadervar(ncouttaux, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+
+ ncouttauy =create(ctauy, 'none',npiglo,npjglo,npk,cdep='deptht' )
+ istatus= createvar(ncouttauy ,typvartauy,nvar, ipktauy,id_varouttauy )
+ istatus= putheadervar(ncouttauy, 'none', npiglo, npjglo,npk, pnavlon=glam,pnavlat=gphi,pdep=dep )
+
+ ! Ready for time loop on month
+ icurrday=0
+ DO jmonth = 1, 12
+ WRITE(ctau,'(a,I4.4,a,I2.2,a)') 'ECMWF.Y',iyear,'.M',jmonth,'.STRESS.'//TRIM(config)//'.dimg'
+ irecl=isdirect(ctau) ; OPEN( numtau,FILE=ctau, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl )
+ READ(numtau,REC=1) cver, cheader, ii, npiglo, npjglo, npk, nt, ndim
+ ! loop for days in files
+ DO jday=1,nt
+ icurrday=icurrday +1
+ DO jdim=1,ndim
+ irec=1+(jday-1)*ndim +jdim
+ READ(numtau,REC=irec) (( v2d(ji,jj,jdim),ji=1,npiglo),jj=1,npjglo)
+ END DO
+ ! taux
+ istatus = putvar(ncouttaux,id_varouttaux(1),v2d(:,:,1),icurrday,npiglo,npjglo)
+ ! tauy
+ istatus = putvar(ncouttauy,id_varouttauy(1),v2d(:,:,2),icurrday,npiglo,npjglo)
+ END DO ! loop on days
+ CLOSE(numtau)
+ END DO ! loop on month
+
+ ! update time_counter
+ ALLOCATE( timetab (icurrday) )
+ timetab=(/(jt,jt=1,icurrday)/)
+ istatus=putvar1d(ncouttaux,timetab,icurrday,'T')
+ istatus=putvar1d(ncouttauy,timetab,icurrday,'T')
+ ! close fluxes files
+ istatus=closeout(ncouttaux)
+ istatus=closeout(ncouttauy)
+ DEALLOCATE (v2d , dep, z2d , timetab)
+
+ 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=256) :: clheader
+ !
+ INTEGER :: irecl
+
+ !
+ OPEN(100,FILE=clname, FORM ='UNFORMATTED', ACCESS ='DIRECT', RECL =88)
+ READ(100,REC=1) cver ,clheader,irecl
+ CLOSE(100)
+ !
+ IF (cver == '@!01' ) THEN
+ isdirect=irecl
+ ELSE
+ isdirect=0
+ END IF
+ !
+ END FUNCTION isdirect
+
+ FUNCTION julday(kdastp)
+ !! ------------------------------------------------------------------
+ !! *** FUNCTION JULDAY ***
+ !!
+ !! Purpose: This routine returns the julian day number which begins at noon
+ !! of the calendar date specified by month kmm, day kid, and year kiyyy.
+ !! positive year signifies a.d.; negative, b.c. (remember that the
+ !! year after 1 b.c. was 1 a.d.)
+ !! routine handles changeover to gregorian calendar on oct. 15, 1582.
+ !!
+ !! Method: This routine comes directly from the Numerical Recipe Book,
+ !! press et al., numerical recipes, cambridge univ. press, 1986.
+ !!
+ !! Arguments:
+ !! kdastp : OPA date yyyymmdd (instead of kmm kid kiyyy)
+ !! kmm : input, corresponding month
+ !! kid : input, corresponding day
+ !! kiyyy : input, corresponding year, positive IF a.d, negative b.c.
+ !!
+ !!
+ !! history
+ !! 1998: J.M. Molines for the Doctor form.
+ !! 2007 : J.M. Molines in F90
+ !! -----------------------------------------------------------------
+ ! * Declarations
+ !
+ INTEGER :: julday, kiyyy,kid,kmm
+ INTEGER, INTENT(in) ::kdastp
+ ! * Local
+ INTEGER, PARAMETER ::jpgreg=15+31*(10+12*1582)
+ INTEGER :: iy, im, ia
+ ! ... Year 0 never existed ...
+ kiyyy=kdastp/10000
+ kmm=(kdastp - kiyyy*10000)/100
+ kid= kdastp - kiyyy*10000 - kmm*100
+ IF (kiyyy == 0) STOP 101
+ !
+ IF (kiyyy < 0) kiyyy = kiyyy + 1
+ IF (kmm > 2) THEN
+ iy = kiyyy
+ im = kmm + 1
+ ELSE
+ iy = kiyyy - 1
+ im = kmm + 13
+ END IF
+ !
+ julday = INT(365.25*iy) + INT(30.6001*im) + kid + 1720995
+ IF (kid+31*(kmm+12*kiyyy).GE.jpgreg) THEN
+ ia = INT(0.01*iy)
+ julday = julday + 2 - ia + INT(0.25*ia)
+ END IF
+ END FUNCTION JULDAY
+ END PROGRAM cdfstrconv
diff --git a/cdfsum.f90 b/cdfsum.f90
new file mode 100644
index 0000000..227b539
--- /dev/null
+++ b/cdfsum.f90
@@ -0,0 +1,190 @@
+PROGRAM cdfsum
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfsum ***
+ !!
+ !! ** Purpose : Compute the SUM over the ocean
+ !! PARTIAL STEPS
+ !!
+ !! ** Method : compute the sum ( V * e1 *e2 * e3 *mask )
+ !!
+ !!
+ !! history ;
+ !! Original : J.M. Molines (Oct. 2005)
+ !! : P. Mathiot ( 2008) : adaptation from cdfmean
+ !!-------------------------------------------------------------------
+ !! $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, 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.
+ 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'
+ 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
+
+ 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
+ IF (lforcing) OPEN(unit=numout, file='out.txt' , form='formatted', status='new', iostat=err)
+
+ ! 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
+ zsum=0.d0
+ zv=0.
+ DO jk = 1,nvpk
+ ik = jk+kmin-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)
+ ! zmask(:,npjglo)=0.
+
+ ! get e3 at level ik ( ps...)
+ e3(:,:) = getvar(coordzgr, ce3, ik,npiglo,npjglo,kimin=imin,kjmin=jmin, 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
+ ELSE
+ 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
+ END IF
+ END DO
+ IF (.NOT. lforcing) PRINT * ,' Sum value over the ocean: ', zsum
+ END DO
+ CLOSE(1)
+ END PROGRAM cdfsum
diff --git a/cdftemptrp-full.f90 b/cdftemptrp-full.f90
new file mode 100644
index 0000000..7a3c0d4
--- /dev/null
+++ b/cdftemptrp-full.f90
@@ -0,0 +1,425 @@
+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/cdftempvol-full.f90 b/cdftempvol-full.f90
new file mode 100644
index 0000000..65def6d
--- /dev/null
+++ b/cdftempvol-full.f90
@@ -0,0 +1,335 @@
+PROGRAM cdftempvol_full
+ !!---------------------------------------------------------------------
+ !! *** PROGRAM cdftempvol_full ***
+ !!
+ !! ** Purpose: Compute water volume in a given domain between isotherms
+ !! FULL STEPS version
+ !!
+ !! ** Method : compute the sum ( e1 * e2 * e3 * mask )
+ !! -The box boundary are given by imin, imax, jmin, jmax
+ !! read metrics, depth, etc
+ !! read T and SSH
+ !! compute the depths of isothermal surfaces
+ !! compute the volume from surface to the isotherm
+ !! compute the volume in each class of temperature
+ !! compute the total volume
+ !!
+ !! 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, jj, jk, jclass, jiso, jbin, jarg !: dummy loop index
+ INTEGER :: ipos !: working variable
+ INTEGER :: narg, iargc !: command line
+ INTEGER :: npiglo,npjglo !: size of the domain
+ 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 :: imin, imax, jmin, jmax !: working box limits
+
+ 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 :: e1t, e2t !: lon, lat of T from file
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zt !: temperature from file
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: zssh !: SSH from file
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: tmp !: temporary array
+
+ ! double precision for cumulative variables
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: e1, e2 !: either e1t or e2t
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: e3 , zmask !: e3 and zmask
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztemp, gdep !: temp., depth of temp. 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 :: zwvol, zwvolbin, volbin2 !: volume arrays
+ REAL(KIND=8), DIMENSION (:), ALLOCATABLE :: volbin !: volume arrays
+
+ CHARACTER(LEN=256) :: cfilet !: files name
+ CHARACTER(LEN=256) :: coordhgr='mesh_hgr.nc', coordzgr='mesh_zgr.nc' !: coordinates files
+ CHARACTER(LEN=256) :: cfilout='voltemp.txt' !: output file
+ CHARACTER(LEN=256) :: cdum !: dummy string
+
+ LOGICAL :: l_print=.FALSE. !: flag for printing additional results
+ LOGICAL :: l_print2=.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 : cdftempvol-full gridTfile imin, imax, jmin, jmax temp_max temp_min nbins [options]'
+ PRINT '(255a)',' imin, imax, jmin, jmax : horizontal limit of the box'
+ 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)',' Output on voltemp.txt'
+ STOP
+ ENDIF
+
+ !! Read arguments
+ CALL getarg (1, cfilet)
+ 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,*) temp_max
+ CALL getarg (7,cdum) ; READ(cdum,*) temp_min
+ CALL getarg (8,cdum) ; READ(cdum,*) nbins
+
+ DO jarg=9, 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
+
+ ! Allocate and build temp. levels and section array
+ ALLOCATE ( temp_lev (nbins+1) )
+
+ 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 size of the domain
+ npiglo= getdim (cfilet,'x')
+ npjglo= getdim (cfilet,'y')
+ npk = getdim (cfilet,'depth')
+ IF (imin /= 0 ) THEN ; npiglo=imax -imin + 1; ELSE ; imin=1 ; ENDIF
+ IF (jmin /= 0 ) THEN ; npjglo=jmax -jmin + 1; ELSE ; jmin=1 ; ENDIF
+ ALLOCATE ( gdept(npk), gdepw(npk), e1t(npiglo,npjglo), e2t(npiglo,npjglo), e3t(npk) )
+ ALLOCATE ( volbin(nbins), volbin2(npjglo,nbins) )
+ volbin=0.d0 ; volbin2=0.d0
+
+ ! read dimensions
+ gdept(:) = getvare3(coordzgr, 'gdept',npk)
+ gdepw(:) = getvare3(coordzgr, 'gdepw',npk)
+ e1t(:,:) = getvar(coordhgr, 'e1t', 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
+ e2t(:,:) = getvar(coordhgr, 'e2t', 1,npiglo,npjglo,kimin=imin,kjmin=jmin)
+ e3t(:) = getvare3(coordzgr, 'e3t',npk)
+
+
+ !! * Main loop
+
+ DO jj=jmin,jmax
+
+ ALLOCATE ( zt(npiglo,npk), tmp(npiglo,1), ztemp(npiglo,0:npk), zssh(npiglo,1) )
+ ALLOCATE ( e1(npiglo,npk), e2(npiglo,npk), e3(npiglo,npk), gdep(npiglo, npk), zmask(npiglo,npk) )
+ ALLOCATE ( zwvol(npiglo, nbins+1) , hiso(npiglo,nbins+1), zwvolbin(npiglo,nbins) )
+
+ zssh= 0. ; gdep= 0. ; zmask = 0. ; ztemp=0.d0 ; e1=0.d0 ; e2=0.d0 ; e3=0.d0
+ zwvol=0.d0 ; zwvolbin=0.d0
+
+ zssh(:,:)=getvar(cfilet,'sossheig',1, npiglo, 1 , kimin=imin+1 , kjmin=jj)
+
+ DO jk=1,npk
+ ! initiliaze gdep to gdept()
+ gdep(:,jk) = gdept(jk)
+
+ ! metrics (Full step case)
+ e1(:,jk)=e1t(:,jj-jmin+1)
+ e2(:,jk)=e2t(:,jj-jmin+1)
+ e3(:,jk)=e3t(jk)
+
+
+ ! temperature
+ tmp(:,:)=getvar(cfilet,'votemper',jk, npiglo, 1, kimin=imin+1, kjmin=jj)
+ zmask(:,jk)=tmp(:,1)
+ WHERE ( zmask(:,jk) /= 0 ) zmask(:,jk)=1
+
+ zt(:,jk) = tmp(:,1)
+
+ ! 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
+
+ ! 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_print2 ) THEN
+ PRINT *,' T (deg C)'
+ DO jk=1,nk
+ PRINT 9000, jk, (ztemp(ji,jk),ji=1,npiglo)
+ END DO
+
+ PRINT *,' SSH (m)'
+ PRINT 9000, 1, (zssh(ji,1),ji=1,npiglo)
+
+ PRINT *,' GDEP (m) '
+ DO jk=1,nk
+ PRINT 9001,jk, (gdep(ji,jk)*zmask(ji,jk),ji=1,npiglo)
+ END DO
+
+ PRINT *, 'E1 (m)'
+ DO jk=1,nk
+ PRINT 9001,jk, (e1(ji,jk)*zmask(ji,jk),ji=1,npiglo)
+ END DO
+
+ PRINT *, 'E2 (m)'
+ DO jk=1,nk
+ PRINT 9001,jk, (e2(ji,jk)*zmask(ji,jk),ji=1,npiglo)
+ END DO
+
+ PRINT *, 'E3 (m)'
+ DO jk=1,nk
+ PRINT 9001,jk, (e3(ji,jk)*zmask(ji,jk),ji=1,npiglo)
+ 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,npiglo
+ 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)= gdep(ji,jk)*zalfa + (1.-zalfa)* gdep(ji,jk-1)
+ ENDIF
+ EXIT
+ ENDIF
+ END DO
+ END DO
+ IF (l_print) PRINT 9002, temp,(hiso(ji,jiso),ji=1,npiglo)
+ END DO
+
+ ! compute volume between surface and isotherm
+ IF (l_print) PRINT *,' VOL SURF --> ISO (1.e12 M3)'
+ DO jiso = 1, nbins + 1
+ temp=temp_lev(jiso)
+ DO ji=1,npiglo
+ !zwvol(ji,jiso) = e1(ji,1)*e2(ji,1)*zssh(ji,1)
+ DO jk=1, nk
+ IF ( gdepw(jk+1) < hiso(ji,jiso) ) THEN
+ zwvol(ji,jiso)= zwvol(ji,jiso) + e1(ji,jk)*e2(ji,jk)*e3(ji,jk)
+ ELSE ! last box ( fraction)
+ zwvol(ji,jiso)= zwvol(ji,jiso) + e1(ji,jk)*e2(ji,jk)*(hiso(ji,jiso)-gdepw(jk))
+ EXIT ! jk loop
+ ENDIF
+ END DO
+ END DO
+ IF (l_print) PRINT 9003, temp,(zwvol(ji,jiso)/1.e12,ji=1,npiglo)
+ END DO
+
+ ! binned volume : difference between 2 isotherms
+ IF (l_print) PRINT *,' VOL bins (SV)'
+ DO jbin=1, nbins
+ temp=temp_lev(jbin)
+ DO ji=1, npiglo
+ zwvolbin(ji,jbin) = zwvol(ji,jbin+1) - zwvol(ji,jbin)
+ END DO
+ volbin2(jj-jmin+1,jbin)=SUM(zwvolbin(:,jbin) )
+ IF (l_print) PRINT 9003, temp,(zwvolbin(ji,jbin)/1.e12,ji=1,npiglo), volbin2(jj-jmin+1,jbin)/1.e12
+ volbin(jbin)=volbin(jbin)+volbin2(jj-jmin+1,jbin)
+ END DO
+ PRINT *,' Total volume in all bins (1e.15 M3):',SUM(volbin2(jj-jmin+1,:) )/1.e15
+
+
+! ! output of the code for 1 section
+! IF (l_bimg) THEN
+! ! (along section, depth ) 2D variables
+! cdum='Tdep.bimg'
+! OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED')
+! cdum=' 3 dimensions in this file '
+! WRITE(numbimg) cdum
+! cdum=' 1: T '
+! WRITE(numbimg) cdum
+! WRITE(cdum,'(a,4i5.4)') 'in box ', imin,imax,jmin,jmax
+! WRITE(numbimg) cdum
+! cdum=' file '//TRIM(cfilet)
+! WRITE(numbimg) cdum
+! WRITE(numbimg) npiglo,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,npiglo) , jk=nk,1,-1 )
+! CLOSE(numbimg)
+
+! ! (along section, temp ) 2D variables
+! cdum='Volume_water_Tdep.bimg'
+! OPEN(numbimg,FILE=cdum,FORM='UNFORMATTED')
+! cdum=' 3 dimensions in this file '
+! WRITE(numbimg) cdum
+! cdum=' 1: hiso ; 2: bin vol '
+! WRITE(numbimg) cdum
+! WRITE(cdum,'(a,4i5.4)') ' in box ', imin,imax,jmin,jmax
+! WRITE(numbimg) cdum
+! cdum=' file '//TRIM(cfilet)
+! WRITE(numbimg) cdum
+! WRITE(numbimg) npiglo,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,npiglo) , jiso=nbins,1,-1)
+! ! binned transport
+! WRITE(numbimg) (( REAL(zwvolbin(ji,jiso))/1.e15, ji=1,npiglo) , jiso=nbins,1,-1)
+! CLOSE(numbimg)
+! ENDIF
+
+ ! free memory for the next section
+ DEALLOCATE ( zt, tmp, ztemp, zssh )
+ DEALLOCATE ( e1, e2, e3, gdep, zmask )
+ DEALLOCATE ( zwvol, hiso, zwvolbin )
+
+ PRINT *,' Total volume in all bins (1e.15 M3):',SUM(volbin(:)/1.e15 )
+
+ 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,*) ' temp. '
+ DO jiso=1,nbins
+ WRITE(numout,9004) temp_lev(jiso), volbin(jiso)
+ ENDDO
+ CLOSE(numout)
+
+9000 FORMAT(i7,60f8.3)
+9001 FORMAT(i7,60f8.0)
+9002 FORMAT(f7.3,60f8.0)
+9003 FORMAT(f7.3,60f8.3)
+9004 FORMAT(f9.4, 60e16.7)
+9005 FORMAT('#',a9, 60(2x,a12,2x) )
+9006 FORMAT('# ',a)
+
+
+END PROGRAM cdftempvol_full
diff --git a/cdftransportiz-full.f90 b/cdftransportiz-full.f90
new file mode 100644
index 0000000..518820c
--- /dev/null
+++ b/cdftransportiz-full.f90
@@ -0,0 +1,506 @@
+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
new file mode 100644
index 0000000..a57e713
--- /dev/null
+++ b/cdftransportiz.f90
@@ -0,0 +1,641 @@
+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
+ !!---------------------------------------------------------------------
+ !! $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_noheat.f90 b/cdftransportiz_noheat.f90
new file mode 100644
index 0000000..dd2b4e8
--- /dev/null
+++ b/cdftransportiz_noheat.f90
@@ -0,0 +1,510 @@
+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= 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), 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/cdftransportizpm.f90 b/cdftransportizpm.f90
new file mode 100644
index 0000000..935f57b
--- /dev/null
+++ b/cdftransportizpm.f90
@@ -0,0 +1,549 @@
+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
new file mode 100755
index 0000000..cadaf36
--- /dev/null
+++ b/cdftrp_bathy.f90
@@ -0,0 +1,153 @@
+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
new file mode 100644
index 0000000..11c01a6
--- /dev/null
+++ b/cdftrp_gaelle.f90
@@ -0,0 +1,364 @@
+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
new file mode 100644
index 0000000..ff4f2f7
--- /dev/null
+++ b/cdfvT.f90
@@ -0,0 +1,223 @@
+PROGRAM cdfvT
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfvT ***
+ !!
+ !! ** Purpose:
+ !!
+ !! ** Method: Try to avoid 3 d arrays
+ !!
+ !! history :
+ !! Original : J.M. Molines (Nov 2004 ) for ORCA025
+ !! J.M. Molines (apr 2005 ) : use of modules
+ !!-------------------------------------------------------------------
+ !! $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, 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, 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
+
+ !! 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 '
+ 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)
+ 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
+
+ PRINT *,TRIM(cfilet)
+ npiglo= getdim (cfilet,'x')
+ npjglo= getdim (cfilet,'y')
+ npk = getdim (cfilet,'depth')
+
+ 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))
+
+
+ ! 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 )
+
+ DO jk = 1, npk
+ PRINT *,'level ',jk
+ zcumulut(:,:) = 0.d0 ; zcumulvt(:,:) = 0.d0 ; total_time = 0.
+ zcumulus(:,:) = 0.d0 ; zcumulvs(:,:) = 0.d0
+
+ DO jt = 2, narg
+ 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
+
+ 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
+
+ IF (jk == 1 ) THEN
+ tim=getvar1d(cfilet,'time_counter',1)
+ total_time = total_time + tim(1)
+ END IF
+
+ zvitu(:,:)= getvar(cfileu, 'vozocrtx' , jk ,npiglo, npjglo )
+ zvitv(:,:)= getvar(cfilev, 'vomecrty' , jk ,npiglo, npjglo )
+ ztemp(:,:)= getvar(cfilet, 'votemper', jk ,npiglo, npjglo )
+ zsal(:,:) = getvar(cfilet, 'vosaline', jk ,npiglo, npjglo )
+
+ ! temperature
+ zworku(:,:) = 0. ; zworkv(:,:) = 0.
+ DO ji=1, npiglo-1
+ DO jj = 1, npjglo -1
+ zworku(ji,jj) = 0.5 * ( ztemp(ji,jj) + ztemp(ji+1,jj) ) ! temper at Upoint
+ zworkv(ji,jj) = 0.5 * ( ztemp(ji,jj) + ztemp(ji,jj+1) ) ! temper at Vpoint
+ END DO
+ END DO
+
+ zcumulut(:,:) = zcumulut(:,:) + zworku(:,:) * zvitu(:,:)
+ zcumulvt(:,:) = zcumulvt(:,:) + zworkv(:,:) * zvitv(:,:)
+
+ ! salinity
+ zworku(:,:) = 0. ; zworkv(:,:) = 0.
+ DO ji=1, npiglo-1
+ DO jj = 1, npjglo -1
+ zworku(ji,jj) = 0.5 * ( zsal(ji,jj) + zsal(ji+1,jj) ) ! salinity at Upoint
+ zworkv(ji,jj) = 0.5 * ( zsal(ji,jj) + zsal(ji,jj+1) ) ! salinity at Vpoint
+ END DO
+ END DO
+
+ zcumulus(:,:) = zcumulus(:,:) + zworku(:,:) * zvitu(:,:)
+ zcumulvs(:,:) = zcumulvs(:,:) + zworkv(:,:) * zvitv(:,:)
+
+ END DO
+
+ ! finish with level jk ; compute mean (assume spval is 0 )
+ rmean(:,:) = zcumulvt(:,:)/ntags
+ ierr = putvar(ncout, id_varout(1) ,rmean, jk,npiglo, npjglo )
+
+ rmean(:,:) = zcumulvs(:,:)/ntags
+ ierr = putvar(ncout, id_varout(2) ,rmean, jk,npiglo, npjglo )
+
+ rmean(:,:) = zcumulut(:,:)/ntags
+ ierr = putvar(ncout, id_varout(3) ,rmean, jk,npiglo, npjglo )
+
+ rmean(:,:) = zcumulus(:,:)/ntags
+ ierr = putvar(ncout, id_varout(4) ,rmean, jk,npiglo, npjglo )
+
+ IF (jk == 1 ) THEN
+ timean(1)= total_time/ntags
+ ierr=putvar1d(ncout,timean,1,'T')
+ END IF
+
+ END DO ! loop to next level
+
+ istatus = closeout(ncout)
+
+END PROGRAM cdfvT
diff --git a/cdfvar.f90 b/cdfvar.f90
new file mode 100644
index 0000000..8142392
--- /dev/null
+++ b/cdfvar.f90
@@ -0,0 +1,372 @@
+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
new file mode 100644
index 0000000..4dac607
--- /dev/null
+++ b/cdfvertmean.f90
@@ -0,0 +1,189 @@
+PROGRAM cdfvertmean
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfvertmean ***
+ !!
+ !! ** 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
+ !!
+ !!
+ !! history ;
+ !! Original : J.M. Molines ( 2008) January
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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()
+ 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'
+ 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
+
+ IF (dep_down < dep_up ) THEN
+ PRINT *,'Give depth limits in increasing order !'
+ STOP
+ ENDIF
+
+ npiglo= getdim (cfilet,'x')
+ npjglo= getdim (cfilet,'y')
+ npk = getdim (cfilet,'depth')
+
+ nvars = getnvar(cfilet)
+ ALLOCATE( cvarname(nvars), typvarin(nvars) )
+ cvarname(:)=getvarname(cfilet,nvars,typvarin)
+ ivar=1
+ DO jvar=1,nvars
+ IF ( TRIM(cvarname(jvar)) == TRIM(cvarnam) ) THEN
+ EXIT
+ ENDIF
+ ivar=ivar+1
+ ENDDO
+ IF ( ivar == nvars+1 ) THEN
+ PRINT *,' Variable ',TRIM(cvarnam),' not found in ', TRIM(cfilet)
+ 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
+
+ ! 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) )
+
+ ! 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
+ SELECT CASE ( ctype)
+ CASE( 'T','U','V','t','u','v'); cdep='gdepw' ; ce3='e3t_ps'
+ CASE( 'W' ,'w') ; cdep='gdept' ; ce3='e3w_ps'
+ CASE DEFAULT ; PRINT *,'Point type ', TRIM(ctype),' not known! ' ; STOP
+ END SELECT
+ gdep(:) = getvare3(coordzgr,cdep,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'
+ END SELECT
+
+ ! Look for k1 and k2 as nearest level of dep_up and dep_down
+ k1=1; k2=npk
+ DO jk=1,npk
+ IF ( gdep(jk) <= dep_up ) k1=jk
+ IF ( gdep(jk) <= dep_down ) k2=jk
+ ENDDO
+
+ PRINT *, dep_up, dep_down, k1, k2 , gdep(k1), gdep(k2)
+
+
+ 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)
+
+END PROGRAM cdfvertmean
diff --git a/cdfvhst-full.f90 b/cdfvhst-full.f90
new file mode 100644
index 0000000..4eb714b
--- /dev/null
+++ b/cdfvhst-full.f90
@@ -0,0 +1,172 @@
+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
new file mode 100644
index 0000000..a2d2f6b
--- /dev/null
+++ b/cdfvhst.f90
@@ -0,0 +1,175 @@
+PROGRAM cdfvhst
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfvhst ***
+ !!
+ !! ** 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
+ !!
+ !!
+ !! 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, 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.
+
+ !! 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 '
+ 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),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))
+
+ ! 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
diff --git a/cdfvita.f90 b/cdfvita.f90
new file mode 100644
index 0000000..05ee315
--- /dev/null
+++ b/cdfvita.f90
@@ -0,0 +1,154 @@
+PROGRAM cdfvita
+ !!-------------------------------------------------------------------
+ !! PROGRAM CDFVITA
+ !! **************
+ !!
+ !! ** Purpose: Compute surface velocity on t grid
+ !! gridU , gridV gridT (reference)
+ !!
+ !! ** Method: Try to avoid 3 d arrays
+ !!
+ !! history:
+ !! Original: J.M. Molines (Nov 2006 ) for ORCA025
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !!
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ IMPLICIT NONE
+ INTEGER :: ji,jj,jk
+ INTEGER :: narg, iargc !:
+ INTEGER :: npiglo,npjglo, npk !: size of the domain
+ INTEGER, DIMENSION(:),ALLOCATABLE :: ipk, id_varout
+ TYPE(variable), DIMENSION(:), ALLOCATABLE :: typvar
+ REAL(KIND=4) , DIMENSION (:,:), ALLOCATABLE :: u, v, ua, va, vmod
+ REAL(KIND=4) ,DIMENSION(1) :: timean
+
+ CHARACTER(LEN=256) :: cfileu ,cfilev, cfilew, cfilet, cfileout='vita.nc' !: file name
+
+ INTEGER :: ncout
+ INTEGER :: istatus, ierr
+
+ !! Read command line
+ narg= iargc()
+ IF ( narg < 3 ) THEN
+ PRINT *,' Usage : cdfvita ''gridU gridV gridT2 [gridW ] '' '
+ PRINT *,' Grid T2 is only required for the Tgrid of output field'
+ PRINT *,' if optionnal gridW file is given, then the W component is also interpolated'
+ PRINT *,' We suggest to give a gridT2 file, which is smaller '
+ PRINT *,' Output on vita.nc ,variables sovitua sovitva sovitmod [ sovitwa ]'
+ STOP
+ ENDIF
+ !!
+ !! Initialisation from 1st file (all file are assume to have the same geometry)
+ CALL getarg (1, cfileu)
+ CALL getarg (2, cfilev)
+ CALL getarg (3, cfilet)
+ IF ( narg == 4 ) CALL getarg(4,cfilew)
+ ! Next allocation is tricky ! but it works : without w there are 3 output var (3=narg) [ vitua, vitva, vitmoda ]
+ ! with W there are 4 output var (4=narg) [ idem + sovitwa ]
+ ALLOCATE ( ipk(narg), id_varout(narg), typvar(narg) )
+
+ npiglo = getdim (cfileu,'x')
+ npjglo = getdim (cfileu,'y')
+ npk = getdim (cfileu,'depth')
+
+ ipk(1) = npk
+ 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) = npk
+ 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) = npk
+ 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'
+
+ IF ( narg == 4 ) THEN
+ ipk(4) = npk
+ 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'
+ ENDIF
+
+
+ PRINT *, 'npiglo=', npiglo
+ PRINT *, 'npjglo=', npjglo
+ PRINT *, 'npk =', npk
+
+ ALLOCATE( u(npiglo,npjglo), v(npiglo,npjglo) )
+ ALLOCATE( ua(npiglo,npjglo), va(npiglo,npjglo), vmod(npiglo,npjglo) )
+
+ ncout =create(cfileout, cfilet,npiglo,npjglo,npk)
+
+ ierr= createvar(ncout ,typvar,narg, 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)
+
+ 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) )
+ END DO
+ END DO
+ ierr=putvar(ncout,id_varout(1), ua, jk ,npiglo, npjglo)
+ ierr=putvar(ncout,id_varout(2), va, jk ,npiglo, npjglo)
+ ierr=putvar(ncout,id_varout(3), vmod, jk ,npiglo, npjglo)
+ END DO
+
+ IF ( narg == 4 ) THEN
+ ! reuse u an v arrays to store Wk and Wk+1
+ u(:,:) = getvar(cfilew,'vovecrtz',1 ,npiglo, npjglo)
+ DO jk=2, npk
+ v(:,:) = getvar(cfilew,'vovecrtz',jk ,npiglo, npjglo)
+ ua(:,:)=0.5*(u(:,:) + v(:,:))*1000. ! mm/sec
+ ierr=putvar(ncout,id_varout(4), ua, jk-1 ,npiglo, npjglo)
+ u(:,:)=v(:,:)
+ END DO
+ ua(:,:)=0.e0
+ ierr=putvar(ncout,id_varout(4), ua, npk ,npiglo, npjglo)
+ ENDIF
+
+ timean=getvar1d(cfileu,'time_counter',1)
+ ierr=putvar1d(ncout,timean,1,'T')
+ istatus = closeout(ncout)
+
+END PROGRAM cdfvita
diff --git a/cdfvsig.f90 b/cdfvsig.f90
new file mode 100644
index 0000000..8681b3f
--- /dev/null
+++ b/cdfvsig.f90
@@ -0,0 +1,258 @@
+PROGRAM cdfvsig
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfvsig ***
+ !!
+ !! ** Purpose:
+ !!
+ !! ** Method: Try to avoid 3 d arrays
+ !!
+ !! history :
+ !! Original : J.M. Molines (Nov 2004 ) for ORCA025
+ !! J.M. Molines (apr 2005 ) : use of modules
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+ USE eos
+
+ !! * 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
+ 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
+
+ !! 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 '
+ 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 )
+
+ 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
+ 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)
+ 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
+ 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
+
+ ! 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')
+ END IF
+
+ 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
+
+END PROGRAM cdfvsig
diff --git a/cdfvtrp.f90 b/cdfvtrp.f90
new file mode 100644
index 0000000..dc0617c
--- /dev/null
+++ b/cdfvtrp.f90
@@ -0,0 +1,138 @@
+PROGRAM cdfvtrp
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfvtrp ***
+ !!
+ !! ** 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
+ !!
+ !!
+ !! 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, e3v !: mask, metrics
+ REAL(KIND=4), DIMENSION (:,:), ALLOCATABLE :: e2u, e3u !: mask, metrics
+ REAL(KIND=4) ,DIMENSION(1) :: tim
+
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zwku , zwkv, zu, zv
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: ztrpu, ztrpv
+
+ 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
+
+
+ INTEGER :: istatus
+
+ ! constants
+
+ !! 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 '
+ 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'
+
+ typvar(1)%units='m3/s'
+ typvar(2)%units='m3/s'
+
+ typvar%missing_value=0.
+ typvar%valid_min= -100.
+ typvar%valid_max= 100.
+
+ typvar(2)%long_name='Z_Integrated_Meridional_mass_transport'
+ typvar(1)%long_name='Z_Integrated_Zonal_mass_transport'
+
+ typvar(2)%short_name='somevtrp'
+ typvar(1)%short_name='sozoutrp'
+
+ typvar%online_operation='N/A'
+ typvar%axis='TYX'
+
+ ipk(1) = 1 ! 2D
+ ipk(2) = 1 ! 2D
+
+ 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 ( zwku(npiglo,npjglo), zwkv(npiglo,npjglo))
+ ALLOCATE ( ztrpu(npiglo,npjglo), ztrpv(npiglo,npjglo))
+ ALLOCATE ( zu(npiglo,npjglo), zv(npiglo,npjglo))
+
+
+ ! 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
+
+ ierr = putvar(ncout, id_varout(1) ,REAL(ztrpu(:,:)), 1, npiglo, npjglo)
+ ierr = putvar(ncout, id_varout(2) ,REAL(ztrpv(:,:)), 1, npiglo, npjglo)
+
+ istatus = closeout (ncout)
+
+ END PROGRAM cdfvtrp
diff --git a/cdfw.f90 b/cdfw.f90
new file mode 100644
index 0000000..a095586
--- /dev/null
+++ b/cdfw.f90
@@ -0,0 +1,151 @@
+PROGRAM cdfw
+ !!---------------------------------------------------------------------------
+ !! *** PROGRAM cdfw ***
+ !!
+ !! ** 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
+ !!
+ !! history :
+ !! Original : J.M. Molines (June 2005)
+ !!---------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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
+
+ !!
+ 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'
+ 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
+
+ ! 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 ( glamt(npiglo,npjglo), gphit(npiglo,npjglo) )
+ ALLOCATE ( un(npiglo,npjglo) , vn(npiglo,npjglo) ,hdivn(npiglo,npjglo) )
+ ALLOCATE ( wn(npiglo,npjglo,2) , gdepw(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)
+
+ ! and the coordinates from the mesh_hgr file
+ glamt = getvar(chgr, 'glamt', 1,npiglo,npjglo)
+ gphit = getvar(chgr, '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)
+
+ ! 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) )
+ END DO
+ END DO
+
+ ! 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)
+
+ ! swap top and bottom index
+ itmp=itop ; itop = ibot ; ibot = itmp
+
+ ENDDO ! loop to next level
+ ierr = closeout(ncout)
+
+
+END PROGRAM cdfw
+
diff --git a/cdfweight.f90 b/cdfweight.f90
new file mode 100644
index 0000000..874162c
--- /dev/null
+++ b/cdfweight.f90
@@ -0,0 +1,542 @@
+PROGRAM cdfweight
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfweight ***
+ !!
+ !! ** 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$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * 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 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.
+ 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 '
+ 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')
+ npk= getdim (czgr,'z')
+
+ 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')
+
+ ! read depth of model T points (hence U and V)
+ gdept(:)=getvare3(czgr,'gdept',npk)
+
+ 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
+ ! 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
+ 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.
+ 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
+
+ ! 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 cdfweight
diff --git a/cdfweight2D.f90 b/cdfweight2D.f90
new file mode 100644
index 0000000..a31c132
--- /dev/null
+++ b/cdfweight2D.f90
@@ -0,0 +1,516 @@
+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
new file mode 100644
index 0000000..396728f
--- /dev/null
+++ b/cdfwflx.f90
@@ -0,0 +1,134 @@
+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.
+ !!
+ !! ** 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
+ USE cdfio
+
+ !! * Local variables
+ 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'
+
+ 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'
+ STOP
+ ENDIF
+
+ CALL getarg (1, cfilet)
+ CALL getarg (2, cfiler)
+ npiglo= getdim (cfilet,'x')
+ npjglo= getdim (cfilet,'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'
+
+
+ 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.
+
+ ! Evap :
+ evap(:,:)= -1.* getvar(cfilet, 'solhflup', 1 ,npiglo,npjglo)/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
+ zwk(:,:) = getvar(cfilet, 'sowaflup', 1 ,npiglo,npjglo)*86400.*zmask(:,:) ! mm/days
+ print *,'Total water flux done'
+ ! Precip:
+ 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')
+
+ ierr=closeout(ncout)
+
+ END PROGRAM cdfwflx
diff --git a/cdfwhereij.f90 b/cdfwhereij.f90
new file mode 100644
index 0000000..bbd784c
--- /dev/null
+++ b/cdfwhereij.f90
@@ -0,0 +1,86 @@
+PROGRAM cdfwhereij
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfwhereij ***
+ !!
+ !! ** 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
+ !!
+ !! history ;
+ !! Original : J.M. Molines (May 2005 )
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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.
+ 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 '
+ 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 )
+
+ npiglo= getdim (coord,'x')
+ npjglo= getdim (coord,'y')
+ IF ( imax > npiglo ) THEN
+ PRINT *,' ERROR : imax is greater than the maximum size ', imax, npiglo
+ STOP
+ ENDIF
+
+ IF ( jmax > npjglo ) THEN
+ PRINT *,' ERROR : jmax is greater than the maximum size ', jmax, 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 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)
+
+ END PROGRAM cdfwhereij
diff --git a/cdfzeromean.f90 b/cdfzeromean.f90
new file mode 100644
index 0000000..ae9d773
--- /dev/null
+++ b/cdfzeromean.f90
@@ -0,0 +1,239 @@
+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/cdfzonalmean.f90 b/cdfzonalmean.f90
new file mode 100644
index 0000000..f160b56
--- /dev/null
+++ b/cdfzonalmean.f90
@@ -0,0 +1,286 @@
+PROGRAM cdfzonalmean
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfzonalmean ***
+ !!
+ !! ** 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 ...
+ !!
+ !!
+ !! 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
+ 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,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.
+
+ REAL(KIND=8), DIMENSION (:,:), ALLOCATABLE :: zomsf , area !: 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'/)
+
+ LOGICAL :: lrevert_dep = .TRUE. !: flag to revert the order of depth in the output file (plotting facility)
+ LOGICAL :: lforcing = .FALSE.
+
+ !! 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.'
+ 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)='zo'//TRIM(cvarname(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'
+ 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')
+ nt = getdim (cfilev,'time_counter')
+
+ PRINT *, 'npiglo=', npiglo
+ PRINT *, 'npjglo=', npjglo
+ PRINT *, 'npk =', npk
+ PRINT *, 'nt =', nt
+ ! if forcing 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'
+ 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))
+
+
+ ! 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
+
+ ! 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 jt = 1,nt
+ IF (MOD(jt,100)==0) PRINT *, jt,'/',nt
+ DO jkk = 1, ipk(jvar)
+ PRINT *,TRIM(cvarname(jvar)), ' level ',jkk
+ ! Get variables and mask at level jk
+ zv(:,:) = getvar(cfilev, cvarname(jvar),jkk ,npiglo,npjglo,ktime=jt)
+ zmaskvar(:,:) = getvar(cmaskfil, cmask, jkk ,npiglo,npjglo)
+
+ ! For all basins
+ DO jbasin = 1, npbasins
+ zomsf(:,:) = 0.d0
+ area(:,:) = 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)
+ END DO
+ END DO
+
+ ! compute the mean value if the area is not 0, else assign spval
+ WHERE (area /= 0 )
+ zomsf=zomsf/area
+ ELSEWHERE
+ zomsf=spval
+ ENDWHERE
+ ivar= (jjvar-1)*npbasins + jbasin
+ ierr = putvar (ncout, id_varout(ivar),REAL(zomsf(:,jkk)), jkk,1,npjglo, ktime=jt)
+ END DO !next basin
+ END DO ! next k
+ END DO ! next time
+ END DO ! next variable
+
+ ierr = closeout(ncout)
+
+END PROGRAM cdfzonalmean
diff --git a/cdfzonalout.f90 b/cdfzonalout.f90
new file mode 100644
index 0000000..927b0c9
--- /dev/null
+++ b/cdfzonalout.f90
@@ -0,0 +1,104 @@
+PROGRAM cdfzonalout
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfzonalout ***
+ !!
+ !! ** Purpose : Output zonal mean/integral as ascii files
+ !!
+ !! ** Method :
+ !! Read zonalmean or zonalsum file, determine 1D variable and dump them on an ASCII file
+ !!
+ !!
+ !! history ;
+ !! Original : J.M. Molines (Feb. 2006)
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * Modules used
+ USE cdfio
+
+ !! * Local variables
+ 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
+
+ REAL(KIND=8), DIMENSION (:,:,:), ALLOCATABLE :: zv
+
+ CHARACTER(LEN=256) :: cfilev
+ CHARACTER(LEN=256), DIMENSION(:), ALLOCATABLE :: cvarname !: array of var name for input
+ TYPE(variable), DIMENSION(:),ALLOCATABLE :: typvar
+
+ !! Read command line and output usage message if not compliant.
+ narg= iargc()
+ IF ( narg == 0 ) THEN
+ PRINT *,' Usage : cdfzonalout file '
+ STOP
+ ENDIF
+
+ CALL getarg (1, cfilev)
+
+ 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)
+
+ ! 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
+ ! skip variables such as nav_lon, nav_lat, time_counter deptht ...
+ IF (ipk(jvar) == 0 .OR. ipk(jvar) > 1 ) THEN
+ cvarname(jvar)='none'
+ ELSE
+ mvar = mvar + 1 ! count for valid input variables
+ ijvar(mvar) = 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,*) 'npiglo=', npiglo
+ WRITE(6,*) 'npjglo=', npjglo
+ WRITE(6,*) 'npk =', npk
+
+ ! Allocate arrays
+ ALLOCATE ( zv(npiglo,npjglo,mvar) )
+ ALLOCATE ( dumlon(1,npjglo) , dumlat(1,npjglo))
+
+
+ dumlat(:,:) = getvar(cfilev,'nav_lat',1,1,npjglo)
+
+ ! 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)
+
+ END DO ! next variable
+
+ 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)
+ ENDDO
+
+
+END PROGRAM cdfzonalout
diff --git a/cdfzonalsum.f90 b/cdfzonalsum.f90
new file mode 100644
index 0000000..75afbb3
--- /dev/null
+++ b/cdfzonalsum.f90
@@ -0,0 +1,273 @@
+PROGRAM cdfzonalsum
+ !!-------------------------------------------------------------------
+ !! *** PROGRAM cdfzonalsum ***
+ !!
+ !! ** 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 ...
+ !!
+ !!
+ !! history ;
+ !! Original : J.M. Molines (nov. 2005)
+ !!-------------------------------------------------------------------
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+ !! * 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), 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
+
+ !! 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.'
+ 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'
+ ! 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'
+ 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
+
+ ! 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))
+
+
+ ! 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
+
+ ! 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
+
+ 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 cdfzonalsum
diff --git a/cdfzoom.f90 b/cdfzoom.f90
new file mode 100644
index 0000000..7fa1b54
--- /dev/null
+++ b/cdfzoom.f90
@@ -0,0 +1,212 @@
+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
+ !!
+ !! ** 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
+ USE cdfio
+
+ ! * Local Variable
+ 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
+ !
+ REAL ,DIMENSION(:),ALLOCATABLE :: h, rtime
+ REAL ,DIMENSION (:,:), ALLOCATABLE :: v2d
+ REAL :: fact
+ !
+ CHARACTER(LEN=256) :: cfilein, cline1, cline2
+ CHARACTER(LEN=256) :: cvar='none', cdim
+ !!
+ !! 1. Initializations:
+ !! -------------------
+ !!
+ narg = iargc()
+ IF (narg == 0) THEN
+ PRINT *,'usage :cdfzoom -f file '// &
+ ' -lev kmin kmax -fact facteur' // &
+ ' -zoom imin imax jmin jmax' // &
+ ' -var cdfvarname '
+ STOP
+ END IF
+ !
+ kext=1 ; kmin=1 ; kmax=1
+ fact=1
+ numin = 10
+ jarg=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 '
+ STOP
+ END IF
+ END DO
+ !
+ ni=0 ; nj=0; nk=0; nt=0
+ niz=imax-imin+1
+ njz=jmax-jmin+1
+ nkz=kmax-kmin+1
+ kext=kmin
+
+ 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
+ ELSE
+ PRINT *, 'Either niz or njz must me one'
+ STOP
+ ENDIF
+ ENDIF
+
+ 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
+
+ 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
+
+ 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
+
+ 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
+
+ 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 (nkz == 1 ) THEN
+ ALLOCATE (v2d(niz,njz) )
+ ELSE
+ IF ( niz == 1 ) THEN
+ ALLOCATE (v2d(njz,nkz))
+ ELSE
+ 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
+
+ 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
+
+ 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
+9000 FORMAT(i4,a,20f12.4)
+9001 FORMAT(a,20i12)
+
+END PROGRAM cdfzoom
diff --git a/coordinates2hgr.f90 b/coordinates2hgr.f90
new file mode 100644
index 0000000..e285096
--- /dev/null
+++ b/coordinates2hgr.f90
@@ -0,0 +1,277 @@
+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(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 &
+ ,(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
new file mode 100644
index 0000000..c3dc6a9
--- /dev/null
+++ b/coordinates2hgr_karine.f90
@@ -0,0 +1,282 @@
+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
new file mode 100644
index 0000000..67024bb
--- /dev/null
+++ b/coordinates2zgr.f90
@@ -0,0 +1,239 @@
+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(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 &
+ ,(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
new file mode 100644
index 0000000..91eaceb
--- /dev/null
+++ b/coordinates2zgr_karine.f90
@@ -0,0 +1,244 @@
+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
new file mode 100644
index 0000000..2716abc
--- /dev/null
+++ b/eos.f90
@@ -0,0 +1,340 @@
+MODULE eos
+ !! $Rev$
+ !! $Date$
+ !! $Id$
+ !!--------------------------------------------------------------
+
+IMPLICIT NONE
+PRIVATE
+PUBLIC sigma0, eosbn2, sigmai, albet, beta
+
+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
+ 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
+
+ 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
+
+ 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)&
+ *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(ji,jj)=dlrhop/(1.0d0-dlref/(dlk0-dlref*(dla-dlref*dlb)))&
+ -dprau0
+
+ 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 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 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 MODULE eos
diff --git a/macro.g95 b/macro.g95
new file mode 100644
index 0000000..9d2f8bc
--- /dev/null
+++ b/macro.g95
@@ -0,0 +1,19 @@
+# Makefile for CDFTOOLS
+# $Rev: 173 $
+# $Date: 2008-03-17 11:42:21 +0100 (Mon, 17 Mar 2008) $
+# --------------------------------------------------------------
+#
+#NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf
+#NCDF = -I/usr/local/netcdf-3.6.1/ifort/include -L /usr/local/netcdf-3.6.1/ifort/lib/ \
+# -I/opt/netcdf/include -L /opt/netcdf/lib/ \
+# -I/usr/local/include -L/usr/local/lib -lnetcdf
+NCDF= -I /usr/local/g95/include /usr/local/g95/lib/libnetcdf.a
+
+F90=g95
+MPF90=mpif90
+FFLAGS= -O $(NCDF) -fno-second-underscore -fendian=big -ffixed-line-length-132
+LMPI=-lmpich
+
+#INSTALL=$(HOME)/bin
+INSTALL=/usr/local/bin
+
diff --git a/macro.gorgon b/macro.gorgon
new file mode 100644
index 0000000..db454c2
--- /dev/null
+++ b/macro.gorgon
@@ -0,0 +1,7 @@
+# Makefile for CDFTOOLS (Linux with pgi)
+#
+NCDF = -I/usr/local/Cluster-Apps/netcdf/pgi/3.6.1/include -L/usr/local/Cluster-Apps/netcdf/pgi/3.6.1/lib -lnetcdf
+INCDIR = -I/usr/local/Cluster-Apps/netcdf/pgi/3.6.1/include
+
+F90=pgf90
+FFLAGS = -fast $(NCDF) -byteswapio
diff --git a/macro.ifort b/macro.ifort
new file mode 100644
index 0000000..eabb24b
--- /dev/null
+++ b/macro.ifort
@@ -0,0 +1,16 @@
+# Makefile for CDFTOOLS
+# $Rev$
+# $Date$
+# --------------------------------------------------------------
+#
+#NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf
+NCDF = -I/usr/local/netcdf-3.6.1/ifort/include -L /usr/local/netcdf-3.6.1/ifort/lib/ \
+ -I/opt/netcdf/include -L /opt/netcdf/lib/ \
+ -I/usr/local/include -L/usr/local/lib -lnetcdf
+
+F90=ifort
+MPF90=mpif90
+FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian
+LMPI=-lmpich
+
+INSTALL=$(HOME)/bin
diff --git a/macro.ifort_ursus b/macro.ifort_ursus
new file mode 100644
index 0000000..cc80a12
--- /dev/null
+++ b/macro.ifort_ursus
@@ -0,0 +1,13 @@
+# Makefile for CDFTOOLS
+# !! $Rev$
+# !! $Date$
+# !! $Id$
+# !!--------------------------------------------------------------
+#
+NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf
+
+F90=ifort
+MPF90=ifort
+FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian
+
+INSTALL=$(HOME)/bin
diff --git a/macro.jade b/macro.jade
new file mode 100644
index 0000000..71abadc
--- /dev/null
+++ b/macro.jade
@@ -0,0 +1,14 @@
+# macro.jade for jade at CINES
+# $Rev$
+# $Date$
+# $Id$
+# -------------------------------------------------------------
+#
+NCDF= -I/opt/software/SGI/netcdf/4.0/include -L/opt/software/SGI/netcdf/4.0/lib -lnetcdff -lnetcdf
+
+F90=ifort
+MPF90=mpif90
+FFLAGS= -static -O $(NCDF) -assume byterecl -convert big_endian
+LMPI=-lmpich
+
+INSTALL=$(WORKDIR)/bin
diff --git a/macro.mac b/macro.mac
new file mode 100644
index 0000000..5906a20
--- /dev/null
+++ b/macro.mac
@@ -0,0 +1,17 @@
+# Makefile for CDFTOOLS
+# $Rev: 173 $
+# $Date: 2008-03-17 11:42:21 +0100 (Mon, 17 Mar 2008) $
+# --------------------------------------------------------------
+#
+#NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf
+NCDF = -I/usr/local/netcdf-3.6.1/ifort/include -L /usr/local/netcdf-3.6.1/ifort/lib/ \
+ -I/opt/netcdf/include -L /opt/netcdf/lib/ \
+ -I/usr/local/include -L/usr/local/lib -lnetcdf
+
+F90=ifort
+MPF90=mpif90
+FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian
+LMPI=-lmpich
+
+#INSTALL=$(HOME)/bin
+INSTALL=/usr/local/bin
diff --git a/macro.mirage b/macro.mirage
new file mode 100644
index 0000000..e4fc0ea
--- /dev/null
+++ b/macro.mirage
@@ -0,0 +1,12 @@
+# Makefile for CDFTOOLS
+# $Rev$
+# $Date$
+# --------------------------------------------------------------
+#
+NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf
+
+F90=ifort
+MPF90=ifort
+FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian
+LMPI=-lmpi
+INSTALL=$(HOME)/bin
diff --git a/macro.nymphea b/macro.nymphea
new file mode 100644
index 0000000..0a2d46c
--- /dev/null
+++ b/macro.nymphea
@@ -0,0 +1,12 @@
+# Makefile for CDFTOOLS : Nymphea (OSF1)
+# !! $Rev$
+# !! $Date$
+# !! $Id$
+# !!--------------------------------------------------------------
+#
+NCDF = -I/home/nymphea/services/bibli/netcdf-3.6.0/include -L/home/nymphea/services/bibli/netcdf-3.6.0/lib -lnetcdf
+
+F90=f90
+FFLAGS= -convert big_endian -assume byterecl $(NCDF)
+
+INSTALL=$(HOME)/bin
diff --git a/macro.p630 b/macro.p630
new file mode 100644
index 0000000..108bab6
--- /dev/null
+++ b/macro.p630
@@ -0,0 +1,14 @@
+# Makefile for CDFTOOLS : AIX (p630)
+# !! $Rev$
+# !! $Date$
+# !! $Id$
+# !!--------------------------------------------------------------
+#
+NCDF = -I/usr/local/netcdf-3.6.0-p1/include -L/usr/local/netcdf-3.6.0-p1/lib -lnetcdf
+
+F90=xlf90
+MPF90=mpxlf90_r
+FFLAGS= -O4 -qsuffix=f=f90 -bmaxdata:500000000 $(NCDF) -q64 -qsave
+
+INSTALL=/usr/local/bin
+
diff --git a/macro.pgi b/macro.pgi
new file mode 100644
index 0000000..6d70f07
--- /dev/null
+++ b/macro.pgi
@@ -0,0 +1,13 @@
+# Makefile for CDFTOOLS (Linux with pgi)
+# !! $Rev$
+# !! $Date$
+# !! $Id$
+# !!--------------------------------------------------------------
+#
+NCDF = -lnetcdf
+
+F90=pgf90
+MPF90=pgf90
+FFLAGS = -fast $(NCDF) -byteswapio
+
+INSTALL=/usr/local/bin
diff --git a/macro.porzig b/macro.porzig
new file mode 100644
index 0000000..3294929
--- /dev/null
+++ b/macro.porzig
@@ -0,0 +1,13 @@
+# Makefile for CDFTOOLS
+# $Rev: 95 $
+# $Date: 2007-09-18 11:00:06 +0200 (Tue, 18 Sep 2007) $
+# --------------------------------------------------------------
+#
+#NCDF = -I/usr/local/include -L/usr/local/lib -lnetcdf
+NCDF = -I/export/home/services/netcdf-3.6.0-p1/include -L/export/home/services/netcdf-3.6.0-p1/lib -lnetcdf
+
+F90=ifort
+MPF90=ifort
+FFLAGS= -O $(NCDF) -assume byterecl -convert big_endian
+LMPI=-lmpi
+INSTALL=$(HOME)/bin
diff --git a/macro.rhodes b/macro.rhodes
new file mode 100644
index 0000000..90ccbad
--- /dev/null
+++ b/macro.rhodes
@@ -0,0 +1,15 @@
+# Makefile for CDFTOOLS on RHODES.IDRIS.FR (SGI Origin 2100)
+# !! $Rev$
+# !! $Date$
+# !! $Id$
+# !!--------------------------------------------------------------
+#
+NCDF = -I/usr/local/pub/netcdf-3.6.1/include -L/usr/local/pub/netcdf-3.6.1/lib -lnetcdf
+
+F90=f90
+MPF90=f90
+FFLAGS= -O2 -mips4 -bytereclen $(NCDF) -bytereclen
+
+INSTALL=$(HOME_BIS)/CDFTOOLS-2.1/
+
+
diff --git a/macro.sx8 b/macro.sx8
new file mode 100644
index 0000000..6ce44a4
--- /dev/null
+++ b/macro.sx8
@@ -0,0 +1,17 @@
+#Makefile for CDFTOOLS : SX8 (brodie)
+# !! $Rev$
+# !! $Date$
+# !! $Id$
+# !!--------------------------------------------------------------
+
+#
+MPF90 = sxmpif90
+F90 = sxf90
+
+#-
+NCDF = -I/SXlocal/pub/netCDF/netCDF-3.6.1/include -L/SXlocal/pub/netCDF/netCDF-3.6.1/lib -lnetcdf
+
+FFLAGS=$(NCDF) -dW -sx8 -C vopt -Wf"-P nh" -Wf,-pvctl noassume loopcnt=10000 -L transform
+
+INSTALL=./
+
diff --git a/macro.vargas b/macro.vargas
new file mode 100644
index 0000000..42aeff6
--- /dev/null
+++ b/macro.vargas
@@ -0,0 +1,15 @@
+# Makefile for CDFTOOLS : AIX (zahir)
+# !! $Rev: 82 $
+# !! $Date: 2007-07-17 10:24:09 +0200 (Tue, 17 Jul 2007) $
+# !! $Id: macro.zahir 82 2007-07-17 08:24:09Z molines $
+# !!--------------------------------------------------------------
+#
+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
+#FFLAGS= -O4 -qsuffix=f=f90 $(NCDF) -q64 -qsave
+FFLAGS= -O4 -qsuffix=f=f90 $(NCDF) -q64
+
+INSTALL=./
+
diff --git a/macro.zahir b/macro.zahir
new file mode 100644
index 0000000..fee37ed
--- /dev/null
+++ b/macro.zahir
@@ -0,0 +1,16 @@
+# Makefile for CDFTOOLS : AIX (zahir)
+# !! $Rev$
+# !! $Date$
+# !! $Id$
+# !!--------------------------------------------------------------
+#
+NCDF = -I/usr/local/pub/netcdf/include -L/usr/local/pub/netcdf/lib -lnetcdf
+NCDF= -I/usr/local/pub/netcdf/netcdf-3.5.0/include -L/usr/local/pub/netcdf/netcdf-3.5.0/lib -lnetcdf
+
+F90=xlf90
+MPF90=mpxlf90_r
+#FFLAGS= -O4 -qsuffix=f=f90 $(NCDF) -q64 -qsave
+FFLAGS= -O4 -qsuffix=f=f90 $(NCDF) -q64
+
+INSTALL=./
+
diff --git a/mkupdate b/mkupdate
new file mode 100755
index 0000000..976c655
--- /dev/null
+++ b/mkupdate
@@ -0,0 +1,2 @@
+# svn export --force svn://meolcar.hmg.inpg.fr/home/forge/REPOS_CDFTOOLS/CDFTOOLS/tags/CDFTOOLS-2.1 ./
+svn export --force svn://meolcar.hmg.inpg.fr/home/forge/REPOS_CDFTOOLS/CDFTOOLS/trunk ./
diff --git a/modpoly.f90 b/modpoly.f90
new file mode 100644
index 0000000..12f1a2f
--- /dev/null
+++ b/modpoly.f90
@@ -0,0 +1,338 @@
+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
+ IMPLICIT NONE
+ PRIVATE
+
+ INTEGER,PUBLIC , PARAMETER :: jpvert = 50, & !: Number of vertex per polygon
+ & 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
+
+CONTAINS
+
+ SUBROUTINE ReadPoly(cdfront,kpoly,cdarea)
+ !!-------------------------------------------------------------------------
+ !! *** SUBROUTINE ReadPoly ***
+ !!
+ !! ** Purpose : read an ASCII file with names of polygon area
+ !! and vertices.
+ !!
+ !! ** Method :
+ !!
+ !! 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)
+ 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
+ ! take care of the date line for pacific zone
+ IF (ipac(ipoly) == 1 ) THEN
+ DO jj=1,jmax
+ 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)
+ ENDDO
+995 kpoly=ipoly-1
+ CLOSE(numpol)
+
+ END SUBROUTINE ReadPoly
+
+ SUBROUTINE PrepPoly ( kpolyid )
+ !!---------------------------------------------------------------------
+ !! *** SUBROUTINE PrepPoly ***
+ !!
+ !! ** 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
+
+ ! - 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) )
+ 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) )
+
+ ! - 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)
+ 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)
+ END DO
+
+ END SUBROUTINE PrepPoly
+
+
+ SUBROUTINE InPoly ( kpolyid, pxpoint, pypoint, ld_in )
+ !!------------------------------------------------------------------------
+ !! *** SUBROUTINE InPoly ***
+ !!
+ !! ** 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.
+ !!
+ !! 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)
+ ! - 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
+ ! - step through the polygon boundaries
+ DO ji = 1, numvert
+ ! - 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
+ ! - it has crossed the polygon boundary
+ icross = icross + 1
+! if (zy == 398) print *, zx, zy, icross ,'A', ji
+ ENDIF ! ( zy test )
+ ELSEIF ( ( (zy <= verty(kpolyid,ji) ) .AND. &
+ & (zy > verty(kpolyid,ji+1) ) ) .OR. &
+ & ( (zy >= verty(kpolyid,ji) ) .AND. &
+ & (zy < verty(kpolyid,ji+1) ) ) ) THEN
+ ! - it has crossed the polygon boundary
+ icross = icross + 1
+! if (zy == 398) print *, zx, zy, icross,'B', ji
+ ENDIF ! ( ji = numvert )
+ 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
+ IF ( zx >= zxpt) THEN
+ ! - it has crossed the polygon boundary
+ icross = icross + 1
+! if (zy == 398) print *, zx, zy, icross,'C', ji
+ ENDIF ! ( zx >= zxpt )
+ ENDIF ! ( zxpt test )
+ ELSEIF ( ( (zxpt <= vertx(kpolyid,ji) ) .AND. &
+ & (zxpt > vertx(kpolyid,ji+1) ) ) .OR. &
+ & ( (zxpt >= vertx(kpolyid,ji) ) .AND. &
+ & (zxpt < vertx(kpolyid,ji+1) ) ) ) THEN
+ IF ( zx >= zxpt ) THEN
+ ! - it has crossed the polygon boundary
+ icross = icross + 1
+! if (zy == 398) print *, zx, zy, icross,'D', ji, slope(ji), zxpt
+ ENDIF ! ( zx >= zxpt )
+ ENDIF ! ( ji = numvert )
+ ENDIF ! ( zxpt test )
+ END DO ! ( ji = 1, numvert )
+ ! - decide how many times scanline crossed poly bounds
+ zevenodd = AMOD ( ( icross * 1.0 ), 2.0 )
+ IF ( zevenodd .NE. 0 ) THEN
+ ! - point is in polygon
+ ld_in = .TRUE.
+ ELSE
+ ld_in = .FALSE.
+ ENDIF
+ ! - ( zevenodd ne 0 )
+ ELSE
+ ld_in = .FALSE.
+ ENDIF
+ ! - ( zy >= pminy )
+ ELSE
+ ld_in = .FALSE.
+ ENDIF
+ ! - ( zy <= pmaxy )
+ ELSE
+ ld_in = .FALSE.
+ ENDIF
+ ! - ( zx >= pminx )
+ ELSE
+ ld_in = .FALSE.
+ ENDIF
+ ! - ( zx <= pmaxx )
+
+ END SUBROUTINE InPoly
+
+ SUBROUTINE PointSlope ( pslup, pvertxa, pvertxb, pvertya, pvertyb, pax, pby, pcnstnt )
+ !!-------------------------------------------------------------------------
+ !! *** SUBROUTINE PointSlope ***
+ !!
+ !! ** Purpose: To get the slope and general equations of lines.
+ !!
+ !! ** 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.
+ !!
+ !! 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
+ REAL(KIND=8) :: zvertxa, zvertxb, zvertya, zvertyb
+ REAL(KIND=8) :: zrise, zrun
+
+ zvertxa=pvertxa ; zvertxb=pvertxb
+ zvertya=pvertya ; zvertyb=pvertyb
+
+ zrise = zvertyb - zvertya
+ 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
+ pcnstnt = zvertya
+ ELSEIF ( pslup == 9999 ) THEN
+ pax = 1
+ pby = 0
+ pcnstnt = zvertxa
+ ELSE
+ pax = pslup
+ pby = -1
+ pcnstnt = ( pslup * zvertxa - zvertya )
+ ENDIF
+
+ END SUBROUTINE PointSlope
+
+END MODULE modpoly
diff --git a/section.dat b/section.dat
new file mode 100644
index 0000000..23b3a94
--- /dev/null
+++ b/section.dat
@@ -0,0 +1,57 @@
+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
new file mode 100644
index 0000000..f98d269
--- /dev/null
+++ b/tag
@@ -0,0 +1,5 @@
+ !! $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