- Timestamp:
- 2011-11-14T16:28:04+01:00 (13 years ago)
- Location:
- branches/2011/dev_NOC_UKMO_MERGE
- Files:
-
- 1 deleted
- 99 edited
- 20 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NOC_UKMO_MERGE/DOC/TexFiles/Biblio/Biblio.bib
r2541 r3094 1306 1306 volume = {23}, 1307 1307 pages = {2428--2446} 1308 } 1309 1310 @ARTICLE{Hunke2008, 1311 author = {E.C. Hunke and W.H. Lipscomb}, 1312 title = {CICE: the Los Alamos sea ice model documentation and software user's manual, 1313 Version 4.0}, 1314 publisher = {LA-CC-06-012, Los Alamos National Laboratory, N.M.}, 1315 year = {2008} 1308 1316 } 1309 1317 -
branches/2011/dev_NOC_UKMO_MERGE/DOC/TexFiles/Chapters/Chap_ASM.tex
r2483 r3094 15 15 The ASM code adds the functionality to apply increments to the model variables: 16 16 temperature, salinity, sea surface height, velocity and sea ice concentration. 17 These are read into the model from a NetCDF file which may be produced by data18 assimilation . The code can also output model background fields which are used17 These are read into the model from a NetCDF file which may be produced by separate data 18 assimilation code. The code can also output model background fields which are used 19 19 as an input to data assimilation code. This is all controlled by the namelist 20 20 \textit{nam\_asminc}. There is a brief description of all the namelist options -
branches/2011/dev_NOC_UKMO_MERGE/DOC/TexFiles/Chapters/Chap_OBS.tex
r2483 r3094 13 13 $\ $\newline % force a new line 14 14 15 The observation and model comparison code (OBS) reads in observation files 16 (profile temperature and salinity, sea surface temperature, sea level anomaly,17 sea ice concentration, and velocity) and calculates an interpolated model equivalent 18 value at the observation location and nearest model timestep. The OBS code is 19 called from \np{opa.F90} in order to initialise the model and to calculate the 20 model equivalent values for observations on the 0th timestep. The code is then 21 called again after each timestep from \np{step.F90}. The code was originally 22 developed for use with NEMOVAR. 23 24 For all data types a 2D horizontal interpolator is needed 25 to interpolate the model fields to the observation location.26 For {\em in situ} profiles, a 1D vertical interpolator is needed in addition to 27 provide model fields at the observation depths. Currently this only works in 28 z-level model configurations, but is being developed to work with a 29 generalised vertical coordinate system. 30 Temperature data from moored buoys (TAO, TRITON, PIRATA) in the 31 ENACT/ENSEMBLES data-base are available as daily averaged quantities. For this 32 type of observation the 33 observation operator will compare such observations to the model temperature15 The observation and model comparison code (OBS) reads in observation files (profile 16 temperature and salinity, sea surface temperature, sea level anomaly, sea ice concentration, 17 and velocity) and calculates an interpolated model equivalent value at the observation 18 location and nearest model timestep. The resulting data are saved in a ``feedback'' file (or 19 files). The code was originally developed for use with the NEMOVAR data assimilation code, but 20 can be used for validation or verification of model or any other data assimilation system. 21 22 The OBS code is called from \np{opa.F90} for model initialisation and to calculate the model 23 equivalent values for observations on the 0th timestep. The code is then called again after 24 each timestep from \np{step.F90}. To build with the OBS code active \key{diaobs} must be 25 set. 26 27 For all data types a 2D horizontal interpolator is needed to interpolate the model fields to 28 the observation location. For {\em in situ} profiles, a 1D vertical interpolator is needed in 29 addition to provide model fields at the observation depths. Currently this only works in 30 z-level model configurations, but is being developed to work with a generalised vertical 31 coordinate system. Temperature data from moored buoys (TAO, TRITON, PIRATA) in the 32 ENACT/ENSEMBLES data-base are available as daily averaged quantities. For this type of 33 observation the observation operator will compare such observations to the model temperature 34 34 fields averaged over one day. The relevant observation type may be specified in the namelist 35 using \np{endailyavtypes}. Otherwise the model value from the nearest 36 timestep to the observation time is used. 37 38 The resulting data are saved in a ``feedback'' file (or files) which can be used 39 for model validation and verification and also to provide information for data 40 assimilation. This code is controlled by the namelist \textit{nam\_obs}. To 41 build with the OBS code active \key{diaobs} must be set. 42 43 Section~\ref{OBS_example} introduces a test example of the observation operator 44 code including where to obtain data and how to setup the namelist. 45 Section~\ref{OBS_details} introduces some more technical details of the 46 different observation types used and also shows a more complete namelist. 47 Finally section~\ref{OBS_theory} introduces some of the theoretical aspects of 48 the observation operator including interpolation methods and running on multiple 49 processors. 35 using \np{endailyavtypes}. Otherwise the model value from the nearest timestep to the 36 observation time is used. 37 38 The code is controlled by the namelist \textit{nam\_obs}. See the following sections for more 39 details on setting up the namelist. 40 41 Section~\ref{OBS_example} introduces a test example of the observation operator code including 42 where to obtain data and how to setup the namelist. Section~\ref{OBS_details} introduces some 43 more technical details of the different observation types used and also shows a more complete 44 namelist. Section~\ref{OBS_theory} introduces some of the theoretical aspects of the 45 observation operator including interpolation methods and running on multiple processors. 46 Section~\ref{OBS_obsutils} introduces some utilities to help working with the files produced 47 by the OBS code. 50 48 51 49 % ================================================================ … … 69 67 \item Add the following to the NEMO namelist to run the observation 70 68 operator on this data. Set the \np{enactfiles} namelist parameter to the 71 observation file name (or link in to \np{profiles\_01\.nc}):69 observation file name: 72 70 \end{enumerate} 73 71 … … 76 74 %------------------------------------------------------------------------------------------------------------- 77 75 78 The option \np{ln\_t3d} and \np{ln\_s3d} switch on the temperature and salinity76 The options \np{ln\_t3d} and \np{ln\_s3d} switch on the temperature and salinity 79 77 profile observation operator code. The \np{ln\_ena} switch turns on the reading 80 78 of ENACT/ENSEMBLES type profile data. The filename or array of filenames are … … 88 86 Setting \np{ln\_grid\_global} means that the code distributes the observations 89 87 evenly between processors. Alternatively each processor will work with 90 observations located within the model subdomain .91 92 The NEMOVAR system contains utilitiesto plot the feedback files, convert and93 recombine the files. These are available on request from the NEMOVAR team.88 observations located within the model subdomain (see section~\ref{OBS_parallel}). 89 90 A number of utilities are now provided to plot the feedback files, convert and 91 recombine the files. These are explained in more detail in section~\ref{OBS_obsutils}. 94 92 95 93 \section{Technical details} … … 713 711 714 712 \subsection{Parallel aspects of horizontal interpolation} 713 \label{OBS_parallel} 715 714 716 715 For horizontal interpolation, there is the basic problem that the … … 779 778 \subsection{Vertical interpolation operator} 780 779 781 The vertical interpolation is achieved using either a cubic spline or780 Vertical interpolation is achieved using either a cubic spline or 782 781 linear interpolation. For the cubic spline, the top and 783 782 bottom boundary conditions for the second derivative of the 784 783 interpolating polynomial in the spline are set to zero. 785 784 At the bottom boundary, this is done using the land-ocean mask. 785 786 \newpage 787 788 \section{Observation Utilities} 789 \label{OBS_obsutils} 790 791 Some tools for viewing and processing of observation and feedback files are provided in the 792 NEMO repository for convenience. These include OBSTOOLS which are a collection of Fortran 793 programs which are helpful to deal with feedback files. They do such tasks as observation file 794 conversion, printing of file contents, some basic statistical analysis of feedback files. The 795 other tool is an IDL program called dataplot which uses a graphical interface to visualise 796 observations and feedback files. OBSTOOLS and dataplot are described in more detail below. 797 798 \subsection{Obstools} 799 800 A series of Fortran utilities is provided with NEMO called OBSTOOLS. This are helpful in 801 handling observation files and the feedback file output from the NEMO observation operator. 802 The utilities are as follows 803 804 \subsubsection{corio2fb} 805 806 The program corio2fb converts profile observation files from the Coriolis format to the 807 standard feedback format. The program is called in the following way: 808 809 \begin{alltt} 810 \footnotesize 811 \begin{verbatim} 812 corio2fb.exe outputfile inputfile1 inputfile2 ... 813 \end{verbatim} 814 \end{alltt} 815 816 \subsubsection{enact2fb} 817 818 The program enact2fb converts profile observation files from the ENACT format to the standard 819 feedback format. The program is called in the following way: 820 821 \begin{alltt} 822 \footnotesize 823 \begin{verbatim} 824 enact2fb.exe outputfile inputfile1 inputfile2 ... 825 \end{verbatim} 826 \end{alltt} 827 828 \subsubsection{fbcomb} 829 830 The program fbcomb combines multiple feedback files produced by individual processors in an 831 MPI run of NEMO into a single feedback file. The program is called in the following way: 832 833 \begin{alltt} 834 \footnotesize 835 \begin{verbatim} 836 fbcomb.exe outputfile inputfile1 inputfile2 ... 837 \end{verbatim} 838 \end{alltt} 839 840 \subsubsection{fbmatchup} 841 842 The program fbmatchup will match observations from two feedback files. The program is called 843 in the following way: 844 845 \begin{alltt} 846 \footnotesize 847 \begin{verbatim} 848 fbmatchup.exe outputfile inputfile1 varname1 inputfile2 varname2 ... 849 \end{verbatim} 850 \end{alltt} 851 852 853 \subsubsection{fbprint} 854 855 The program fbprint will print the contents of a feedback file or files to standard output. 856 Selected information can be output using optional arguments. The program is called in the 857 following way: 858 859 \begin{alltt} 860 \footnotesize 861 \begin{verbatim} 862 fbprint.exe [options] inputfile 863 864 options: 865 -b shorter output 866 -q Select observations based on QC flags 867 -Q Select observations based on QC flags 868 -B Select observations based on QC flags 869 -u unsorted 870 -s ID select station ID 871 -t TYPE select observation type 872 -v NUM1-NUM2 select variable range to print by number 873 (default all) 874 -a NUM1-NUM2 select additional variable range to print by number 875 (default all) 876 -e NUM1-NUM2 select extra variable range to print by number 877 (default all) 878 -d output date range 879 -D print depths 880 -z use zipped files 881 \end{verbatim} 882 \end{alltt} 883 884 \subsubsection{fbsel} 885 886 The program fbsel will select or subsample observations. The program is called in the 887 following way: 888 889 \begin{alltt} 890 \footnotesize 891 \begin{verbatim} 892 fbsel.exe <input filename> <output filename> 893 \end{verbatim} 894 \end{alltt} 895 896 \subsubsection{fbstat} 897 898 The program fbstat will output summary statistics in different global areas into a number of 899 files. The program is called in the following way: 900 901 \begin{alltt} 902 \footnotesize 903 \begin{verbatim} 904 fbstat.exe [-nmlev] <filenames> 905 \end{verbatim} 906 \end{alltt} 907 908 \subsubsection{fbthin} 909 910 The program fbthin will thin the data to 1 degree resolution. The code could easily be 911 modified to thin to a different resolution. The program is called in the following way: 912 913 \begin{alltt} 914 \footnotesize 915 \begin{verbatim} 916 fbthin.exe inputfile outputfile 917 \end{verbatim} 918 \end{alltt} 919 920 \subsubsection{sla2fb} 921 922 The program sla2fb will convert an AVISO SLA format file to feedback format. The program is 923 called in the following way: 924 925 \begin{alltt} 926 \footnotesize 927 \begin{verbatim} 928 sla2fb.exe [-s type] outputfile inputfile1 inputfile2 ... 929 930 Option: 931 -s Select altimeter data_source 932 \end{verbatim} 933 \end{alltt} 934 935 \subsubsection{vel2fb} 936 937 The program vel2fb will convert TAO/PIRATA/RAMA currents files to feedback format. The program 938 is called in the following way: 939 940 \begin{alltt} 941 \footnotesize 942 \begin{verbatim} 943 vel2fb.exe outputfile inputfile1 inputfile2 ... 944 \end{verbatim} 945 \end{alltt} 946 947 \subsection{building the obstools} 948 949 To build the obstools use in the tools directory use ./maketools -n OBSTOOLS -m [ARCH]. 950 951 \subsection{Dataplot} 952 953 An IDL program called dataplot is included which uses a graphical interface to visualise 954 observations and feedback files. It is possible to zoom in, plot individual profiles and 955 calculate some basic statistics. To plot some data run IDL and then: 956 \begin{alltt} 957 \footnotesize 958 \begin{verbatim} 959 IDL> dataplot, "filename" 960 \end{verbatim} 961 \end{alltt} 962 963 To read multiple files into dataplot, for example multiple feedback files from different 964 processors or from different days, the easiest method is to use the spawn command to generate 965 a list of files which can then be passed to dataplot. 966 \begin{alltt} 967 \footnotesize 968 \begin{verbatim} 969 IDL> spawn, 'ls profb*.nc', files 970 IDL> dataplot, files 971 \end{verbatim} 972 \end{alltt} 973 974 Fig~\ref{fig:obsdataplotmain} shows the main window which is launched when dataplot starts. 975 This is split into three parts. At the top there is a menu bar which contains a variety of 976 drop down menus. Areas - zooms into prespecified regions; plot - plots the data as a 977 timeseries or a T-S diagram if appropriate; Find - allows data to be searched; Config - sets 978 various configuration options. 979 980 The middle part is a plot of the geographical location of the observations. This will plot the 981 observation value, the model background value or observation minus background value depending 982 on the option selected in the radio button at the bottom of the window. The plotting colour 983 range can be changed by clicking on the colour bar. The title of the plot gives some basic 984 information about the date range and depth range shown, the extreme values, and the mean and 985 rms values. It is possible to zoom in using a drag-box. You may also zoom in or out using the 986 mouse wheel. 987 988 The bottom part of the window controls what is visible in the plot above. There are two bars 989 which select the level range plotted (for profile data). The other bars below select the date 990 range shown. The bottom of the figure allows the option to plot the mean, root mean square, 991 standard deviation or mean square values. As mentioned above you can choose to plot the 992 observation value, the model background value or observation minus background value. The next 993 group of radio buttons selects the map projection. This can either be regular latitude 994 longitude grid, or north or south polar stereographic. The next group of radio buttons will 995 plot bad observations, switch to salinity and plot density for profile observations. The 996 rightmost group of buttons will print the plot window as a postscript, save it as png, or exit 997 from dataplot. 998 999 %>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1000 \begin{figure} \begin{center} 1001 %\includegraphics[width=10cm,height=12cm,angle=-90.]{./TexFiles/Figures/Fig_OBS_dataplot_main} 1002 \includegraphics[width=9cm,angle=-90.]{./TexFiles/Figures/Fig_OBS_dataplot_main} 1003 \caption{ \label{fig:obsdataplotmain} 1004 Main window of dataplot.} 1005 \end{center} \end{figure} 1006 %>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1007 1008 If a profile point is clicked with the mouse button a plot of the observation and background 1009 values as a function of depth (Fig~\ref{fig:obsdataplotprofile}). 1010 1011 %>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1012 \begin{figure} \begin{center} 1013 %\includegraphics[width=10cm,height=12cm,angle=-90.]{./TexFiles/Figures/Fig_OBS_dataplot_prof} 1014 \includegraphics[width=7cm,angle=-90.]{./TexFiles/Figures/Fig_OBS_dataplot_prof} 1015 \caption{ \label{fig:obsdataplotprofile} 1016 Profile plot from dataplot produced by right clicking on a point in the main window.} 1017 \end{center} \end{figure} 1018 %>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1019 1020 1021 1022 -
branches/2011/dev_NOC_UKMO_MERGE/DOC/TexFiles/Chapters/Chap_SBC.tex
r2541 r3094 602 602 \footnote{The \key{oasis4} exist. It activates portion of the code that are still under development.}. 603 603 It has been successfully used to interface \NEMO to most of the European atmospheric 604 GCM (ARPEGE, ECHAM, ECMWF, HadAM, LMDz),604 GCM (ARPEGE, ECHAM, ECMWF, HadAM, HadGAM, LMDz), 605 605 as well as to \href{http://wrf-model.org/}{WRF} (Weather Research and Forecasting Model). 606 606 … … 610 610 When PISCES biogeochemical model (\key{top} and \key{pisces}) is also used in the coupled system, 611 611 the whole carbon cycle is computed by defining \key{cpl\_carbon\_cycle}. In this case, 612 CO$_2$ fluxes are exchanged between the atmosphere and the ice-ocean system. 612 CO$_2$ fluxes will be exchanged between the atmosphere and the ice-ocean system (and need to be activated 613 in namsbc{\_}cpl). 614 615 The new namelist above allows control of various aspects of the coupling fields (particularly for 616 vectors) and now allows for any coupling fields to have multiple sea ice categories (as required by LIM3 617 and CICE). When indicating a multi-category coupling field in namsbc{\_}cpl the number of categories will be 618 determined by the number used in the sea ice model. In some limited cases it may be possible to specify 619 single category coupling fields even when the sea ice model is running with multiple categories - in this 620 case the user should examine the code to be sure the assumptions made are satisfactory. In cases where 621 this is definitely not possible the model should abort with an error message. The new code has been tested using 622 ECHAM with LIM2, and HadGAM3 with CICE but although it will compile with \key{lim3} additional minor code changes 623 may be required to run using LIM3. 613 624 614 625 … … 909 920 ice-ocean fluxes, that are combined with the air-sea fluxes using the ice fraction of 910 921 each model cell to provide the surface ocean fluxes. Note that the activation of a 911 sea-ice model is is done by defining a CPP key (\key{lim2} or \key{lim3}).912 The activation automatically ove writethe read value of nn{\_}ice to its appropriate913 value ($i.e.$ $2$ for LIM-2 and $3$ for LIM-3).922 sea-ice model is is done by defining a CPP key (\key{lim2}, \key{lim3} or \key{cice}). 923 The activation automatically overwrites the read value of nn{\_}ice to its appropriate 924 value ($i.e.$ $2$ for LIM-2, $3$ for LIM-3 or $4$ for CICE). 914 925 \end{description} 915 926 916 927 % {Description of Ice-ocean interface to be added here or in LIM 2 and 3 doc ?} 928 929 \subsection [Interface to CICE (\textit{sbcice\_cice})] 930 {Interface to CICE (\mdl{sbcice\_cice})} 931 \label{SBC_cice} 932 933 It is now possible to couple a global NEMO configuration (without AGRIF) to the CICE sea-ice 934 model by using \key{cice}. The CICE code can be obtained from 935 \href{http://oceans11.lanl.gov/trac/CICE/}{LANL} and the additional 'hadgem3' drivers will be required, 936 even with the latest code release. Input grid files consistent with those used in NEMO will also be needed, 937 and CICE CPP keys \textbf{ORCA\_GRID}, \textbf{CICE\_IN\_NEMO} and \textbf{coupled} should be used (seek advice from UKMO 938 if necessary). Currently the code is only designed to work when using the CORE forcing option for NEMO (with 939 \textit{calc\_strair~=~true} and \textit{calc\_Tsfc~=~true} in the CICE name-list), or alternatively when NEMO 940 is coupled to the HadGAM3 atmosphere model (with \textit{calc\_strair~=~false} and \textit{calc\_Tsfc~=~false}). 941 The code is intended to be used with \np{nn\_fsbc} set to 1 (although coupling ocean and ice less frequently 942 should work, it is possible the calculation of some of the ocean-ice fluxes needs to be modified slightly - the 943 user should check that results are not significantly different to the standard case). 944 945 There are two options for the technical coupling between NEMO and CICE. The standard version allows 946 complete flexibility for the domain decompositions in the individual models, but this is at the expense of global 947 gather and scatter operations in the coupling which become very expensive on larger numbers of processors. The 948 alternative option (using \key{nemocice\_decomp} for both NEMO and CICE) ensures that the domain decomposition is 949 identical in both models (provided domain parameters are set appropriately, and 950 \textit{processor\_shape~=~square-ice} and \textit{distribution\_wght~=~block} in the CICE name-list) and allows 951 much more efficient direct coupling on individual processors. This solution scales much better although it is at 952 the expense of having more idle CICE processors in areas where there is no sea ice. 953 917 954 918 955 % ------------------------------------------------------------------------------------------------------------- -
branches/2011/dev_NOC_UKMO_MERGE/DOC/TexFiles/Chapters/Introduction.tex
r2570 r3094 63 63 \citep{OASIS2006}. Two-way nesting is also available through an interface to the 64 64 AGRIF package (Adaptative Grid Refinement in \textsc{Fortran}) \citep{Debreu_al_CG2008}. 65 The interface code for coupling to an alternative sea ice model (CICE, \citet{Hunke2008}) is now 66 available although this is currently only designed for global domains, without the use of AGRIF. 65 67 66 68 Other model characteristics are the lateral boundary conditions (chapter~\ref{LBC}). -
branches/2011/dev_NOC_UKMO_MERGE/DOC/TexFiles/Namelist/namobs_example
r2298 r3094 57 57 ln_s3d = .true. 58 58 ln_ena = .true. 59 enactfiles = ' profiles_01.nc'59 enactfiles = 'enact.1.nc' 60 60 ln_grid_global = .true. 61 61 ln_grid_search_lookup = .true. -
branches/2011/dev_NOC_UKMO_MERGE/DOC/TexFiles/Namelist/namsbc_cpl
r2540 r3094 2 2 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 3 3 !----------------------------------------------------------------------- 4 ! ! send 5 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 6 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 7 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 8 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 9 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 10 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 11 cn_snd_crt_grid = 'T' ! 'T' 12 ! ! receive 13 cn_rcv_w10m = 'none' ! 'none' 'coupled' 14 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 15 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 16 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 17 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 18 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 19 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 20 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 21 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 22 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 23 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 24 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 4 ! ! description ! multiple ! vector ! vector ! vector ! 5 ! ! ! categories ! reference ! orientation ! grids ! 6 ! send 7 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 8 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 9 sn_snd_thick = 'none' , 'no' , '' , '' , '' 10 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 11 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 12 ! receive 13 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 14 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 15 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 16 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 17 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 18 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 19 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 20 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 21 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 22 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 25 23 / -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/CONFIG/GYRE/EXP00/namelist
r2715 r3094 3 3 !! namelists 2 - Domain (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 4 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 5 !! namsbc_cpl, nam sbc_cpl_co2 namtra_qsr, namsbc_rnf,5 !! namsbc_cpl, namtra_qsr, namsbc_rnf, 6 6 !! namsbc_apr, namsbc_ssr, namsbc_alb) 7 7 !! 4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) … … 121 121 !! namsbc_core CORE bulk formulea formulation 122 122 !! namsbc_cpl CouPLed formulation ("key_coupled") 123 !! namsbc_cpl_co2 coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle")124 123 !! namtra_qsr penetrative solar radiation 125 124 !! namsbc_rnf river runoffs … … 212 211 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 213 212 !----------------------------------------------------------------------- 214 ! ! send 215 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 216 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 217 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 218 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 219 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 220 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 221 cn_snd_crt_grid = 'T' ! 'T' 222 ! ! receive 223 cn_rcv_w10m = 'none' ! 'none' 'coupled' 224 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 225 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 226 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 227 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 228 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 229 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 230 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 231 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 232 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 233 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 234 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 235 / 236 !----------------------------------------------------------------------- 237 &namsbc_cpl_co2 ! coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle") 238 !----------------------------------------------------------------------- 239 cn_snd_co2 = 'coupled' ! send : 'none' 'coupled' 240 cn_rcv_co2 = 'coupled' ! receive : 'none' 'coupled' 213 ! ! description ! multiple ! vector ! vector ! vector ! 214 ! ! ! categories ! reference ! orientation ! grids ! 215 ! send 216 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 217 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 218 sn_snd_thick = 'none' , 'no' , '' , '' , '' 219 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 220 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 221 ! receive 222 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 223 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 224 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 225 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 226 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 227 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 228 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 229 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 230 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 231 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 241 232 / 242 233 !----------------------------------------------------------------------- -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist
r2735 r3094 3 3 !! namelists 2 - Domain (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 4 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 5 !! namsbc_cpl, nam sbc_cpl_co2 namtra_qsr, namsbc_rnf,5 !! namsbc_cpl, namtra_qsr, namsbc_rnf, 6 6 !! namsbc_apr, namsbc_ssr, namsbc_alb) 7 7 !! 4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) … … 121 121 !! namsbc_core CORE bulk formulea formulation 122 122 !! namsbc_cpl CouPLed formulation ("key_coupled") 123 !! namsbc_cpl_co2 coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle")124 123 !! namtra_qsr penetrative solar radiation 125 124 !! namsbc_rnf river runoffs … … 212 211 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 213 212 !----------------------------------------------------------------------- 214 ! ! send 215 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 216 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 217 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 218 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 219 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 220 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 221 cn_snd_crt_grid = 'T' ! 'T' 222 ! ! receive 223 cn_rcv_w10m = 'none' ! 'none' 'coupled' 224 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 225 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 226 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 227 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 228 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 229 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 230 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 231 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 232 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 233 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 234 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 235 / 236 !----------------------------------------------------------------------- 237 &namsbc_cpl_co2 ! coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle") 238 !----------------------------------------------------------------------- 239 cn_snd_co2 = 'coupled' ! send : 'none' 'coupled' 240 cn_rcv_co2 = 'coupled' ! receive : 'none' 'coupled' 213 ! ! description ! multiple ! vector ! vector ! vector ! 214 ! ! ! categories ! reference ! orientation ! grids ! 215 ! send 216 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 217 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 218 sn_snd_thick = 'none' , 'no' , '' , '' , '' 219 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 220 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 221 ! receive 222 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 223 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 224 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 225 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 226 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 227 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 228 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 229 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 230 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 231 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 241 232 / 242 233 !----------------------------------------------------------------------- -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist
r2715 r3094 3 3 !! namelists 2 - Domain (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 4 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 5 !! namsbc_cpl, nam sbc_cpl_co2 namtra_qsr, namsbc_rnf,5 !! namsbc_cpl, namtra_qsr, namsbc_rnf, 6 6 !! namsbc_apr, namsbc_ssr, namsbc_alb) 7 7 !! 4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) … … 121 121 !! namsbc_core CORE bulk formulea formulation 122 122 !! namsbc_cpl CouPLed formulation ("key_coupled") 123 !! namsbc_cpl_co2 coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle")124 123 !! namtra_qsr penetrative solar radiation 125 124 !! namsbc_rnf river runoffs … … 212 211 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 213 212 !----------------------------------------------------------------------- 214 ! ! send 215 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 216 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 217 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 218 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 219 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 220 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 221 cn_snd_crt_grid = 'T' ! 'T' 222 ! ! receive 223 cn_rcv_w10m = 'none' ! 'none' 'coupled' 224 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 225 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 226 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 227 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 228 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 229 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 230 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 231 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 232 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 233 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 234 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 235 / 236 !----------------------------------------------------------------------- 237 &namsbc_cpl_co2 ! coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle") 238 !----------------------------------------------------------------------- 239 cn_snd_co2 = 'coupled' ! send : 'none' 'coupled' 240 cn_rcv_co2 = 'coupled' ! receive : 'none' 'coupled' 213 ! ! description ! multiple ! vector ! vector ! vector ! 214 ! ! ! categories ! reference ! orientation ! grids ! 215 ! send 216 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 217 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 218 sn_snd_thick = 'none' , 'no' , '' , '' , '' 219 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 220 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 221 ! receive 222 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 223 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 224 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 225 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 226 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 227 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 228 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 229 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 230 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 231 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 241 232 / 242 233 !----------------------------------------------------------------------- -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist
r2715 r3094 3 3 !! namelists 2 - Domain (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 4 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 5 !! namsbc_cpl, nam sbc_cpl_co2 namtra_qsr, namsbc_rnf,5 !! namsbc_cpl, namtra_qsr, namsbc_rnf, 6 6 !! namsbc_apr, namsbc_ssr, namsbc_alb) 7 7 !! 4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) … … 121 121 !! namsbc_core CORE bulk formulea formulation 122 122 !! namsbc_cpl CouPLed formulation ("key_coupled") 123 !! namsbc_cpl_co2 coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle")124 123 !! namtra_qsr penetrative solar radiation 125 124 !! namsbc_rnf river runoffs … … 212 211 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 213 212 !----------------------------------------------------------------------- 214 ! ! send 215 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 216 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 217 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 218 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 219 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 220 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 221 cn_snd_crt_grid = 'T' ! 'T' 222 ! ! receive 223 cn_rcv_w10m = 'none' ! 'none' 'coupled' 224 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 225 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 226 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 227 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 228 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 229 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 230 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 231 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 232 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 233 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 234 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 235 / 236 !----------------------------------------------------------------------- 237 &namsbc_cpl_co2 ! coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle") 238 !----------------------------------------------------------------------- 239 cn_snd_co2 = 'coupled' ! send : 'none' 'coupled' 240 cn_rcv_co2 = 'coupled' ! receive : 'none' 'coupled' 213 ! ! description ! multiple ! vector ! vector ! vector ! 214 ! ! ! categories ! reference ! orientation ! grids ! 215 ! send 216 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 217 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 218 sn_snd_thick = 'none' , 'no' , '' , '' , '' 219 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 220 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 221 ! receive 222 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 223 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 224 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 225 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 226 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 227 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 228 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 229 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 230 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 231 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 241 232 / 242 233 !----------------------------------------------------------------------- -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/CONFIG/POMME/EXP00/namelist
r2650 r3094 3 3 !! namelists 2 - Domain (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 4 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 5 !! namsbc_cpl, nam sbc_cpl_co2 namtra_qsr, namsbc_rnf,5 !! namsbc_cpl, namtra_qsr, namsbc_rnf, 6 6 !! namsbc_apr, namsbc_ssr, namsbc_alb) 7 7 !! 4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) … … 121 121 !! namsbc_core CORE bulk formulea formulation 122 122 !! namsbc_cpl CouPLed formulation ("key_coupled") 123 !! namsbc_cpl_co2 coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle")124 123 !! namtra_qsr penetrative solar radiation 125 124 !! namsbc_rnf river runoffs … … 212 211 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 213 212 !----------------------------------------------------------------------- 214 ! ! send 215 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 216 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 217 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 218 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 219 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 220 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 221 cn_snd_crt_grid = 'T' ! 'T' 222 ! ! receive 223 cn_rcv_w10m = 'none' ! 'none' 'coupled' 224 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 225 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 226 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 227 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 228 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 229 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 230 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 231 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 232 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 233 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 234 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 235 / 236 !----------------------------------------------------------------------- 237 &namsbc_cpl_co2 ! coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle") 238 !----------------------------------------------------------------------- 239 cn_snd_co2 = 'coupled' ! send : 'none' 'coupled' 240 cn_rcv_co2 = 'coupled' ! receive : 'none' 'coupled' 213 ! ! description ! multiple ! vector ! vector ! vector ! 214 ! ! ! categories ! reference ! orientation ! grids ! 215 ! send 216 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 217 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 218 sn_snd_thick = 'none' , 'no' , '' , '' , '' 219 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 220 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 221 ! receive 222 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 223 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 224 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 225 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 226 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 227 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 228 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 229 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 230 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 231 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 241 232 / 242 233 !----------------------------------------------------------------------- -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r2715 r3094 27 27 USE sbc_ice ! surface boundary condition: ice 28 28 USE sbc_oce ! surface boundary condition: ocean 29 USE sbccpl 29 30 30 31 USE albedo ! albedo parameters … … 234 235 !-----------------------------------------------! 235 236 236 IF( lk_cpl ) THEN ! coupled case 237 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 238 ! ! Computation of snow/ice and ocean albedo 239 CALL albedo_ice( tn_ice, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalbp, zalb ) 240 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 241 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 242 ENDIF 237 #if defined key_coupled 238 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 239 ht_i(:,:,1) = hicif(:,:) 240 ht_s(:,:,1) = hsnif(:,:) 241 a_i(:,:,1) = fr_i(:,:) 242 ! ! Computation of snow/ice and ocean albedo 243 CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 244 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 245 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 246 #endif 243 247 244 248 IF(ln_ctl) THEN ! control print -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r2715 r3094 372 372 DO ji = kideb, kiut 373 373 sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) ) 374 qla_ice_1d(ji) = -9999. ! default definition, not used as parsub = 0. in this case 374 375 zfcsu(ji) = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) ) 375 376 END DO -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r2528 r3094 18 18 USE lib_mpp ! distributed memory computing library 19 19 USE trabbc ! bottom boundary condition 20 USE obc_par ! (for lk_obc) 20 21 USE bdy_par ! (for lk_bdy) 21 USE obc_par ! (for lk_obc)22 22 23 23 IMPLICIT NONE … … 205 205 WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 206 206 WRITE(numout,*) "~~~~~~~ output written in the 'heat_salt_volume_budgets.txt' ASCII file" 207 IF( lk_obc . OR. lk_bdy) THEN207 IF( lk_obc .or. lk_bdy ) THEN 208 208 CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' ) 209 209 ENDIF -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r2715 r3094 150 150 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .FALSE. !: fixed grid flag 151 151 #endif 152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur , hvr !: inverse of u and v-points ocean depth (1/m)153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters)154 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: refernce depth at u- and v-points (meters)152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hur , hvr !: inverse of u and v-points ocean depth (1/m) 153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters) 154 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: refernce depth at u- and v-points (meters) 155 155 156 156 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r2715 r3094 25 25 USE oce ! ocean dynamics and tracers 26 26 USE dom_oce ! ocean space and time domain 27 USE obc_oce ! ocean open boundary conditions28 27 USE in_out_manager ! I/O manager 29 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r2715 r3094 1495 1495 ! 1496 1496 !! H. Liu, POL. April 2009. Added for passing the scale check for the new released vvl code. 1497 where (e3t (:,:,:).eq.0.0) e3t(:,:,:) = 1.0 1498 where (e3u (:,:,:).eq.0.0) e3u(:,:,:) = 1.0 1499 where (e3v (:,:,:).eq.0.0) e3v(:,:,:) = 1.0 1500 where (e3f (:,:,:).eq.0.0) e3f(:,:,:) = 1.0 1501 where (e3w (:,:,:).eq.0.0) e3w(:,:,:) = 1.0 1502 where (e3uw (:,:,:).eq.0.0) e3uw(:,:,:) = 1.0 1503 where (e3vw (:,:,:).eq.0.0) e3vw(:,:,:) = 1.0 1504 1497 1505 1498 1506 fsdept(:,:,:) = gdept (:,:,:) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r2528 r3094 9 9 !! - ! 2006-08 (G. Madec) style 10 10 !! 3.2 ! 2006-08 (S. Masson, G. Madec) suppress useless variables + style 11 !! 3.4 ! 2011-11 (C. Harris) minor changes for CICE constants 11 12 !!---------------------------------------------------------------------- 12 13 … … 48 49 #endif 49 50 51 #if defined key_cice 52 REAL(wp), PUBLIC :: rau0 = 1026._wp !: reference volumic mass (density) (kg/m3) 53 #else 50 54 REAL(wp), PUBLIC :: rau0 = 1035._wp !: reference volumic mass (density) (kg/m3) 55 #endif 51 56 REAL(wp), PUBLIC :: rau0r !: reference specific volume (m3/kg) 52 57 REAL(wp), PUBLIC :: rcp = 4.e+3_wp !: ocean specific heat 53 58 REAL(wp), PUBLIC :: ro0cpr !: = 1. / ( rau0 * rcp ) 54 59 55 #if defined key_lim3 60 #if defined key_lim3 || defined key_cice 56 61 REAL(wp), PUBLIC :: rcdsn = 0.31_wp !: thermal conductivity of snow 57 62 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: thermal conductivity of fresh ice … … 100 105 rsiyea = 365.25 * rday * 2. * rpi / 6.283076 101 106 rsiday = rday / ( 1. + rday / rsiyea ) 107 #if defined key_cice 108 omega = 7.292116e-05 109 #else 102 110 omega = 2. * rpi / rsiday 111 #endif 103 112 104 113 rau0r = 1. / rau0 … … 155 164 WRITE(numout,*) ' latent heat of fusion of fresh ice / snow = ', lfus , ' J/kg' 156 165 WRITE(numout,*) ' latent heat of subl. of fresh ice / snow = ', lsub , ' J/kg' 166 #elif defined key_cice 167 WRITE(numout,*) ' latent heat of fusion of fresh ice / snow = ', lfus , ' J/kg' 157 168 #else 158 169 WRITE(numout,*) ' density times specific heat for snow = ', rcpsn , ' J/m^3/K' -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r2715 r3094 27 27 USE sbc_oce, ONLY : ln_rnf ! surface boundary condition: ocean 28 28 USE sbcrnf ! river runoff 29 USE obc_oce ! ocean lateral open boundary condition30 29 USE cla ! cross land advection (cla_div routine) 31 30 USE in_out_manager ! I/O manager … … 121 120 END DO 122 121 123 #if defined key_obc124 IF( Agrif_Root() ) THEN125 ! open boundaries (div must be zero behind the open boundary)126 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column127 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east128 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west129 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north130 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south131 ENDIF132 #endif133 122 IF( .NOT. AGRIF_Root() ) THEN 134 123 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east … … 304 293 END DO 305 294 306 #if defined key_obc307 IF( Agrif_Root() ) THEN308 ! open boundaries (div must be zero behind the open boundary)309 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column310 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east311 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west312 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north313 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south314 ENDIF315 #endif316 295 IF( .NOT. AGRIF_Root() ) THEN 317 296 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r2779 r3094 33 33 USE obcdyn_bt ! 2D open boundary condition for momentum (obc_dyn_bt routine) 34 34 USE obcvol ! ocean open boundary condition (obc_vol routines) 35 USE bdy_oce ! unstructured open boundary conditions 36 USE bdydta ! unstructured open boundary conditions 37 USE bdydyn ! unstructured open boundary conditions 35 USE bdy_oce ! ocean open boundary conditions 36 USE bdydta ! ocean open boundary conditions 37 USE bdydyn ! ocean open boundary conditions 38 USE bdyvol ! ocean open boundary condition (bdy_vol routines) 38 39 USE in_out_manager ! I/O manager 39 40 USE lbclnk ! lateral boundary condition (or mpp link) … … 77 78 !! * Apply lateral boundary conditions on after velocity 78 79 !! at the local domain boundaries through lbc_lnk call, 79 !! at the radiative open boundaries (lk_obc=T), 80 !! at the relaxed open boundaries (lk_bdy=T), and 80 !! at the one-way open boundaries (lk_obc=T), 81 81 !! at the AGRIF zoom boundaries (lk_agrif=T) 82 82 !! … … 174 174 ENDIF 175 175 ! 176 # elif defined key_bdy 176 # elif defined key_bdy 177 177 ! !* BDY open boundaries 178 IF( .NOT. lk_dynspg_flt ) THEN 179 CALL bdy_dyn_frs( kt ) 180 # if ! defined key_vvl 181 ua_e(:,:) = 0.e0 182 va_e(:,:) = 0.e0 183 ! Set these variables for use in bdy_dyn_fla 184 hur_e(:,:) = hur(:,:) 185 hvr_e(:,:) = hvr(:,:) 186 DO jk = 1, jpkm1 !! Vertically integrated momentum trends 187 ua_e(:,:) = ua_e(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 188 va_e(:,:) = va_e(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 189 END DO 190 ua_e(:,:) = ua_e(:,:) * hur(:,:) 191 va_e(:,:) = va_e(:,:) * hvr(:,:) 192 DO jk = 1 , jpkm1 193 ua(:,:,jk) = ua(:,:,jk) - ua_e(:,:) 194 va(:,:,jk) = va(:,:,jk) - va_e(:,:) 195 END DO 196 CALL bdy_dta_fla( kt+1, 0,2*nn_baro) 197 CALL bdy_dyn_fla( sshn_b ) 198 CALL lbc_lnk( ua_e, 'U', -1. ) ! Boundary points should be updated 199 CALL lbc_lnk( va_e, 'V', -1. ) ! 200 DO jk = 1 , jpkm1 201 ua(:,:,jk) = ( ua(:,:,jk) + ua_e(:,:) ) * umask(:,:,jk) 202 va(:,:,jk) = ( va(:,:,jk) + va_e(:,:) ) * vmask(:,:,jk) 203 END DO 204 # endif 205 ENDIF 178 IF( lk_dynspg_exp ) CALL bdy_dyn( kt ) 179 IF( lk_dynspg_ts ) CALL bdy_dyn( kt, dyn3d_only=.true. ) 180 181 !!$ Do we need a call to bdy_vol here?? 182 ! 206 183 # endif 207 184 ! -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r2715 r3094 15 15 USE dom_oce ! ocean space and time domain variables 16 16 USE phycst ! physical constants 17 USE obc_oce ! ocean open boundary conditions18 17 USE sbc_oce ! surface boundary condition: ocean 19 18 USE sbcapr ! surface boundary condition: atmospheric pressure … … 222 221 ENDIF 223 222 224 #if defined key_obc225 ! ! Conservation of ocean volume (key_dynspg_flt)226 IF( lk_dynspg_flt ) ln_vol_cst = .true.227 228 ! ! Application of Flather's algorithm at open boundaries229 IF( lk_dynspg_flt ) ln_obc_fla = .false.230 IF( lk_dynspg_exp ) ln_obc_fla = .true.231 IF( lk_dynspg_ts ) ln_obc_fla = .true.232 #endif233 223 ! 234 224 END SUBROUTINE dyn_spg_init -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r2715 r3094 21 21 USE phycst ! physical constants 22 22 USE obc_par ! open boundary condition parameters 23 USE obcdta ! open boundary condition data ( obc_dta_bt routine)23 USE obcdta ! open boundary condition data (bdy_dta_bt routine) 24 24 USE in_out_manager ! I/O manager 25 25 USE lib_mpp ! distributed memory computing library -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r2715 r3094 26 26 USE sbc_oce ! surface boundary condition: ocean 27 27 USE obc_oce ! Lateral open boundary condition 28 USE bdy_oce ! Lateral open boundary condition 28 29 USE sol_oce ! ocean elliptic solver 29 30 USE phycst ! physical constants … … 33 34 USE solpcg ! preconditionned conjugate gradient solver 34 35 USE solsor ! Successive Over-relaxation solver 35 USE obcdyn ! ocean open boundary condition (obc_dyn routines) 36 USE obcvol ! ocean open boundary condition (obc_vol routines) 37 USE bdy_oce ! Unstructured open boundaries condition 38 USE bdydyn ! Unstructured open boundaries condition (bdy_dyn routine) 39 USE bdyvol ! Unstructured open boundaries condition (bdy_vol routine) 36 USE obcdyn ! ocean open boundary condition on dynamics 37 USE obcvol ! ocean open boundary condition (obc_vol routine) 38 USE bdydyn ! ocean open boundary condition on dynamics 39 USE bdyvol ! ocean open boundary condition (bdy_vol routine) 40 40 USE cla ! cross land advection 41 41 USE in_out_manager ! I/O manager … … 187 187 #endif 188 188 #if defined key_bdy 189 CALL bdy_dyn _frs( kt ) ! Update velocities on unstructured boundary using the Flow Relaxation Scheme190 CALL bdy_vol( kt ) 189 CALL bdy_dyn( kt ) ! Update velocities on each open boundary 190 CALL bdy_vol( kt ) ! Correction of the barotropic component velocity to control the volume of the system 191 191 #endif 192 192 #if defined key_agrif … … 304 304 #if defined key_obc 305 305 ! caution : grad D = 0 along open boundaries 306 ! Remark: The filtering force could be reduced here in the FRS zone 307 ! by multiplying spgu/spgv by (1-alpha) ?? 306 308 spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 307 309 spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 308 310 #elif defined key_bdy 309 311 ! caution : grad D = 0 along open boundaries 310 ! Remark: The filtering force could be reduced here in the FRS zone311 ! by multiplying spgu/spgv by (1-alpha) ??312 312 spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj) 313 spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj) 313 spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj) 314 314 #else 315 315 spgu(ji,jj) = z2dt * ztdgu -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
r2715 r3094 34 34 35 35 ! !!! Time splitting scheme (key_dynspg_ts) 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_e, ssha_e ! sea surface heigth (now, after, average)37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_e , va_e ! barotropic velocities (after)38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e )39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur_e , hvr_e ! inverse of hu_e and hv_e40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_b! before field without time-filter36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_e, ssha_e ! sea surface heigth (now, after, average) 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: ua_e , va_e ! barotropic velocities (after) 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e ) 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hur_e , hvr_e ! inverse of hu_e and hv_e 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_b ! before field without time-filter 41 41 42 42 !!---------------------------------------------------------------------- -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r2724 r3094 25 25 USE domvvl ! variable volume 26 26 USE zdfbfr ! bottom friction 27 USE obcdta ! open boundary condition data28 USE obcfla ! Flather open boundary condition29 27 USE dynvor ! vorticity term 30 28 USE obc_oce ! Lateral open boundary condition 31 29 USE obc_par ! open boundary condition parameters 32 USE bdy_oce ! unstructured open boundaries 33 USE bdy_par ! unstructured open boundaries 34 USE bdydta ! unstructured open boundaries 35 USE bdydyn ! unstructured open boundaries 36 USE bdytides ! tidal forcing at unstructured open boundaries. 30 USE obcdta ! open boundary condition data 31 USE obcfla ! Flather open boundary condition 32 USE bdy_par ! for lk_bdy 33 USE bdy_oce ! Lateral open boundary condition 34 USE bdydta ! open boundary condition data 35 USE bdydyn2d ! open boundary conditions on barotropic variables 37 36 USE lib_mpp ! distributed memory computing library 38 37 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 367 366 IF( jn == 1 ) z2dt_e = rdt / nn_baro 368 367 369 ! !* Update the forcing ( OBC,BDY and tides)368 ! !* Update the forcing (BDY and tides) 370 369 ! ! ------------------ 371 370 IF( lk_obc ) CALL obc_dta_bt ( kt, jn ) 372 IF( lk_bdy ) CALL bdy_dta _fla( kt, jn+1, icycle)371 IF( lk_bdy ) CALL bdy_dta ( kt, jit=jn, time_offset=+1 ) 373 372 374 373 ! !* after ssh_e … … 489 488 ! !* domain lateral boundary 490 489 ! ! ----------------------- 491 ! ! Flather's boundary condition for the barotropic loop : 492 ! ! - Update sea surface height on each open boundary 493 ! ! - Correct the velocity 494 490 491 ! OBC open boundaries 495 492 IF( lk_obc ) CALL obc_fla_ts ( ua_e, va_e, sshn_e, ssha_e ) 496 IF( lk_bdy .OR. ln_tides ) CALL bdy_dyn_fla( sshn_e ) 493 494 ! BDY open boundaries 495 #if defined key_bdy 496 pssh => sshn_e 497 phur => hur_e 498 phvr => hvr_e 499 pu2d => ua_e 500 pv2d => va_e 501 502 IF( lk_bdy ) CALL bdy_dyn2d( kt ) 503 #endif 504 497 505 ! 498 506 CALL lbc_lnk( ua_e , 'U', -1. ) ! local domain boundaries -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r2715 r3094 182 182 #if defined key_bdy 183 183 ssha(:,:) = ssha(:,:) * bdytmask(:,:) 184 CALL lbc_lnk( ssha, 'T', 1. ) 184 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm) 185 185 #endif 186 186 -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
r2715 r3094 345 345 ! more time. 346 346 # if defined key_obc 347 DO jfl = 1, jpnfl 348 IF( lp_obc_east ) THEN 349 IF( jped <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <= zgifl(jfl) ) THEN 350 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 351 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 352 zagefl(jfl) = rdt 353 END IF 354 END IF 355 IF( lp_obc_west ) THEN 356 IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >= zgifl(jfl) ) THEN 357 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 358 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 359 zagefl(jfl) = rdt 360 END IF 361 END IF 362 IF( lp_obc_north ) THEN 363 IF( jpnd <= zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >= zgjfl(jfl) ) THEN 364 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 365 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 366 zagefl(jfl) = rdt 367 END IF 368 END IF 369 IF( lp_obc_south ) THEN 370 IF( jpsd <= zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND. njsob >= zgjfl(jfl) ) THEN 371 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 372 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 373 zagefl(jfl) = rdt 374 END IF 375 END IF 376 END DO 347 !!!!!!!! NEED TO SORT THIS OUT !!!!!!!! 348 !!$ DO jfl = 1, jpnfl 349 !!$ IF( lp_obc_east ) THEN 350 !!$ IF( jped <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <= zgifl(jfl) ) THEN 351 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 352 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 353 !!$ zagefl(jfl) = rdt 354 !!$ END IF 355 !!$ END IF 356 !!$ IF( lp_obc_west ) THEN 357 !!$ IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >= zgifl(jfl) ) THEN 358 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 359 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 360 !!$ zagefl(jfl) = rdt 361 !!$ END IF 362 !!$ END IF 363 !!$ IF( lp_obc_north ) THEN 364 !!$ IF( jpnd <= zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >= zgjfl(jfl) ) THEN 365 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 366 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 367 !!$ zagefl(jfl) = rdt 368 !!$ END IF 369 !!$ END IF 370 !!$ IF( lp_obc_south ) THEN 371 !!$ IF( jpsd <= zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND. njsob >= zgjfl(jfl) ) THEN 372 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 373 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 374 !!$ zagefl(jfl) = rdt 375 !!$ END IF 376 !!$ END IF 377 !!$ END DO 377 378 #endif 378 379 -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r2715 r3094 5 5 !!====================================================================== 6 6 !! History : 9.0 ! 05-07 (C. Talandier) original code 7 !! 3.4 ! 11-11 (C. Harris) decomposition changes for running with CICE 7 8 !!---------------------------------------------------------------------- 8 9 USE dom_oce ! ocean space and time domain variables … … 434 435 435 436 ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 437 #if defined key_nemocice_decomp 438 ijpj = ( jpjglo+1-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 439 #else 436 440 ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 441 #endif 437 442 438 443 ALLOCATE(ilcitl (isplt,jsplt)) … … 445 450 446 451 IF( irestil == 0 ) irestil = isplt 452 #if defined key_nemocice_decomp 453 454 ! In order to match CICE the size of domains in NEMO has to be changed 455 ! The last line of blocks (west) will have fewer points 456 DO jj = 1, jsplt 457 DO ji=1, isplt-1 458 ilcitl(ji,jj) = ijpi 459 END DO 460 ilcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 461 END DO 462 463 #else 464 447 465 DO jj = 1, jsplt 448 466 DO ji = 1, irestil … … 453 471 END DO 454 472 END DO 473 474 #endif 455 475 456 476 IF( irestjl == 0 ) irestjl = jsplt 477 #if defined key_nemocice_decomp 478 479 ! Same change to domains in North-South direction as in East-West. 480 DO ji = 1, isplt 481 DO jj=1, jsplt-1 482 ilcjtl(ji,jj) = ijpj 483 END DO 484 ilcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 485 END DO 486 487 #else 488 457 489 DO ji = 1, isplt 458 490 DO jj = 1, irestjl … … 463 495 END DO 464 496 END DO 465 497 498 #endif 466 499 zidom = nrecil 467 500 DO ji = 1, isplt -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r2731 r3094 47 47 !! mppsync : 48 48 !! mppstop : 49 !! mppobc : variant of mpp_lnk for open boundary condition50 49 !! mpp_ini_north : initialisation of north fold 51 50 !! mpp_lbc_north : north fold processors gathering … … 64 63 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 65 64 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 66 PUBLIC mpp obc, mpp_ini_ice, mpp_ini_znl65 PUBLIC mpp_ini_ice, mpp_ini_znl 67 66 PUBLIC mppsize 68 67 PUBLIC lib_mpp_alloc ! Called in nemogcm.F90 … … 1726 1725 END SUBROUTINE mppstop 1727 1726 1728 1729 SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout)1730 !!----------------------------------------------------------------------1731 !! *** routine mppobc ***1732 !!1733 !! ** Purpose : Message passing manadgement for open boundary1734 !! conditions array1735 !!1736 !! ** Method : Use mppsend and mpprecv function for passing mask1737 !! between processors following neighboring subdomains.1738 !! domain parameters1739 !! nlci : first dimension of the local subdomain1740 !! nlcj : second dimension of the local subdomain1741 !! nbondi : mark for "east-west local boundary"1742 !! nbondj : mark for "north-south local boundary"1743 !! noea : number for local neighboring processors1744 !! nowe : number for local neighboring processors1745 !! noso : number for local neighboring processors1746 !! nono : number for local neighboring processors1747 !!1748 !!----------------------------------------------------------------------1749 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released1750 USE wrk_nemo, ONLY: ztab => wrk_2d_11751 !1752 INTEGER , INTENT(in ) :: kd1, kd2 ! starting and ending indices1753 INTEGER , INTENT(in ) :: kl ! index of open boundary1754 INTEGER , INTENT(in ) :: kk ! vertical dimension1755 INTEGER , INTENT(in ) :: ktype ! define north/south or east/west cdt1756 ! ! = 1 north/south ; = 2 east/west1757 INTEGER , INTENT(in ) :: kij ! horizontal dimension1758 INTEGER , INTENT(in ) :: kumout ! ocean.output logical unit1759 REAL(wp), INTENT(inout), DIMENSION(kij,kk) :: ptab ! variable array1760 !1761 INTEGER :: ji, jj, jk, jl ! dummy loop indices1762 INTEGER :: iipt0, iipt1, ilpt1 ! local integers1763 INTEGER :: ijpt0, ijpt1 ! - -1764 INTEGER :: imigr, iihom, ijhom ! - -1765 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend1766 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend1767 !!----------------------------------------------------------------------1768 1769 IF( wrk_in_use(2, 1) ) THEN1770 WRITE(kumout, cform_err)1771 WRITE(kumout,*) 'mppobc : requested workspace array unavailable'1772 CALL mppstop1773 ENDIF1774 1775 ! boundary condition initialization1776 ! ---------------------------------1777 ztab(:,:) = 0.e01778 !1779 IF( ktype==1 ) THEN ! north/south boundaries1780 iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci ) )1781 iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )1782 ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci ) )1783 ijpt0 = MAX( 1, MIN(kl - njmpp+1, nlcj ) )1784 ijpt1 = MAX( 0, MIN(kl - njmpp+1, nlcj - 1 ) )1785 ELSEIF( ktype==2 ) THEN ! east/west boundaries1786 iipt0 = MAX( 1, MIN(kl - nimpp+1, nlci ) )1787 iipt1 = MAX( 0, MIN(kl - nimpp+1, nlci - 1 ) )1788 ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj ) )1789 ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )1790 ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj ) )1791 ELSE1792 WRITE(kumout, cform_err)1793 WRITE(kumout,*) 'mppobc : bad ktype'1794 CALL mppstop1795 ENDIF1796 1797 ! Communication level by level1798 ! ----------------------------1799 !!gm Remark : this is very time consumming!!!1800 ! ! ------------------------ !1801 DO jk = 1, kk ! Loop over the levels !1802 ! ! ------------------------ !1803 !1804 IF( ktype == 1 ) THEN ! north/south boundaries1805 DO jj = ijpt0, ijpt11806 DO ji = iipt0, iipt11807 ztab(ji,jj) = ptab(ji,jk)1808 END DO1809 END DO1810 ELSEIF( ktype == 2 ) THEN ! east/west boundaries1811 DO jj = ijpt0, ijpt11812 DO ji = iipt0, iipt11813 ztab(ji,jj) = ptab(jj,jk)1814 END DO1815 END DO1816 ENDIF1817 1818 1819 ! 1. East and west directions1820 ! ---------------------------1821 !1822 IF( nbondi /= 2 ) THEN ! Read Dirichlet lateral conditions1823 iihom = nlci-nreci1824 DO jl = 1, jpreci1825 t2ew(:,jl,1) = ztab(jpreci+jl,:)1826 t2we(:,jl,1) = ztab(iihom +jl,:)1827 END DO1828 ENDIF1829 !1830 ! ! Migrations1831 imigr=jpreci*jpj1832 !1833 IF( nbondi == -1 ) THEN1834 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )1835 CALL mpprecv( 1, t2ew(1,1,2), imigr )1836 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )1837 ELSEIF( nbondi == 0 ) THEN1838 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )1839 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )1840 CALL mpprecv( 1, t2ew(1,1,2), imigr )1841 CALL mpprecv( 2, t2we(1,1,2), imigr )1842 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )1843 IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err )1844 ELSEIF( nbondi == 1 ) THEN1845 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )1846 CALL mpprecv( 2, t2we(1,1,2), imigr )1847 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )1848 ENDIF1849 !1850 ! ! Write Dirichlet lateral conditions1851 iihom = nlci-jpreci1852 !1853 IF( nbondi == 0 .OR. nbondi == 1 ) THEN1854 DO jl = 1, jpreci1855 ztab(jl,:) = t2we(:,jl,2)1856 END DO1857 ENDIF1858 IF( nbondi == -1 .OR. nbondi == 0 ) THEN1859 DO jl = 1, jpreci1860 ztab(iihom+jl,:) = t2ew(:,jl,2)1861 END DO1862 ENDIF1863 1864 1865 ! 2. North and south directions1866 ! -----------------------------1867 !1868 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions1869 ijhom = nlcj-nrecj1870 DO jl = 1, jprecj1871 t2sn(:,jl,1) = ztab(:,ijhom +jl)1872 t2ns(:,jl,1) = ztab(:,jprecj+jl)1873 END DO1874 ENDIF1875 !1876 ! ! Migrations1877 imigr = jprecj * jpi1878 !1879 IF( nbondj == -1 ) THEN1880 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )1881 CALL mpprecv( 3, t2ns(1,1,2), imigr )1882 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )1883 ELSEIF( nbondj == 0 ) THEN1884 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )1885 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )1886 CALL mpprecv( 3, t2ns(1,1,2), imigr )1887 CALL mpprecv( 4, t2sn(1,1,2), imigr )1888 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err )1889 IF( l_isend ) CALL mpi_wait( ml_req2, ml_stat, ml_err )1890 ELSEIF( nbondj == 1 ) THEN1891 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )1892 CALL mpprecv( 4, t2sn(1,1,2), imigr)1893 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err )1894 ENDIF1895 !1896 ! ! Write Dirichlet lateral conditions1897 ijhom = nlcj - jprecj1898 IF( nbondj == 0 .OR. nbondj == 1 ) THEN1899 DO jl = 1, jprecj1900 ztab(:,jl) = t2sn(:,jl,2)1901 END DO1902 ENDIF1903 IF( nbondj == 0 .OR. nbondj == -1 ) THEN1904 DO jl = 1, jprecj1905 ztab(:,ijhom+jl) = t2ns(:,jl,2)1906 END DO1907 ENDIF1908 IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN1909 DO jj = ijpt0, ijpt1 ! north/south boundaries1910 DO ji = iipt0,ilpt11911 ptab(ji,jk) = ztab(ji,jj)1912 END DO1913 END DO1914 ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN1915 DO jj = ijpt0, ilpt1 ! east/west boundaries1916 DO ji = iipt0,iipt11917 ptab(jj,jk) = ztab(ji,jj)1918 END DO1919 END DO1920 ENDIF1921 !1922 END DO1923 !1924 IF( wrk_not_released(2, 1) ) THEN1925 WRITE(kumout, cform_err)1926 WRITE(kumout,*) 'mppobc : failed to release workspace array'1927 CALL mppstop1928 ENDIF1929 !1930 END SUBROUTINE mppobc1931 1932 1933 1727 SUBROUTINE mpp_comm_free( kcom ) 1934 1728 !!---------------------------------------------------------------------- … … 2488 2282 MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 2489 2283 END INTERFACE 2490 INTERFACE mppobc2491 MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d2492 END INTERFACE2493 2284 INTERFACE mpp_minloc 2494 2285 MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d … … 2603 2394 WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom 2604 2395 END SUBROUTINE mppmin_int 2605 2606 SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij, knum )2607 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum2608 REAL, DIMENSION(:) :: parr ! variable array2609 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij, knum2610 END SUBROUTINE mppobc_1d2611 2612 SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij, knum )2613 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum2614 REAL, DIMENSION(:,:) :: parr ! variable array2615 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij, knum2616 END SUBROUTINE mppobc_2d2617 2618 SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij, knum )2619 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum2620 REAL, DIMENSION(:,:,:) :: parr ! variable array2621 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij, knum2622 END SUBROUTINE mppobc_3d2623 2624 SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij, knum )2625 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum2626 REAL, DIMENSION(:,:,:,:) :: parr ! variable array2627 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij, knum2628 END SUBROUTINE mppobc_4d2629 2396 2630 2397 SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj ) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r2715 r3094 125 125 !! ! 98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 126 126 !! 8.5 ! 02-08 (G. Madec) F90 : free form 127 !! 3.4 ! 11-11 (C. Harris) decomposition changes for running with CICE 127 128 !!---------------------------------------------------------------------- 128 129 INTEGER :: ji, jj, jn ! dummy loop indices … … 152 153 153 154 IF( iresti == 0 ) iresti = jpni 155 156 #if defined key_nemocice_decomp 157 ! In order to match CICE the size of domains in NEMO has to be changed 158 ! The last line of blocks (west) will have fewer points 159 160 DO jj = 1, jpnj 161 DO ji=1, jpni-1 162 ilcit(ji,jj) = jpi 163 END DO 164 ilcit(jpni,jj) = jpiglo - (jpni - 1) * (jpi - nreci) 165 END DO 166 167 #else 168 154 169 DO jj = 1, jpnj 155 170 DO ji = 1, iresti … … 161 176 END DO 162 177 178 #endif 163 179 IF( irestj == 0 ) irestj = jpnj 180 181 #if defined key_nemocice_decomp 182 ! Same change to domains in North-South direction as in East-West. 183 DO ji=1,jpni 184 DO jj=1,jpnj-1 185 ilcjt(ji,jj) = jpj 186 END DO 187 ilcjt(ji,jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) 188 END DO 189 190 #else 191 164 192 DO ji = 1, jpni 165 193 DO jj = 1, irestj … … 171 199 END DO 172 200 201 #endif 173 202 IF(lwp) THEN 174 203 WRITE(numout,*) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r2715 r3094 13 13 !! " " ! 06-01 (W. Park) modification of physical part 14 14 !! " " ! 06-02 (R. Redler, W. Park) buffer array fix for root exchange 15 !! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields 15 16 !!---------------------------------------------------------------------- 16 17 #if defined key_oasis3 … … 52 53 INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 53 54 54 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information 55 LOGICAL :: laction ! To be coupled or not 56 CHARACTER(len = 8) :: clname ! Name of the coupling field 57 CHARACTER(len = 1) :: clgrid ! Grid type 58 REAL(wp) :: nsgn ! Control of the sign change 59 INTEGER :: nid ! Id of the field 55 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information 56 LOGICAL :: laction ! To be coupled or not 57 CHARACTER(len = 8) :: clname ! Name of the coupling field 58 CHARACTER(len = 1) :: clgrid ! Grid type 59 REAL(wp) :: nsgn ! Control of the sign change 60 INTEGER, DIMENSION(9) :: nid ! Id of the field (no more than 9 categories) 61 INTEGER :: nct ! Number of categories in field 60 62 END TYPE FLD_CPL 61 63 … … 118 120 INTEGER :: paral(5) ! OASIS3 box partition 119 121 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 120 INTEGER :: ji ! local loop indicees 122 INTEGER :: ji,jc ! local loop indicees 123 CHARACTER(LEN=8) :: zclname 121 124 !!-------------------------------------------------------------------- 122 125 … … 164 167 DO ji = 1, ksnd 165 168 IF ( ssnd(ji)%laction ) THEN 166 CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/), & 167 & PRISM_Out , ishape , PRISM_REAL, nerror) 168 IF ( nerror /= PRISM_Ok ) THEN 169 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(ssnd(ji)%clname) 170 CALL prism_abort_proto ( ssnd(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 171 ENDIF 169 DO jc = 1, ssnd(ji)%nct 170 IF ( ssnd(ji)%nct .gt. 1 ) THEN 171 WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 172 ELSE 173 zclname=ssnd(ji)%clname 174 ENDIF 175 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 176 CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 177 PRISM_Out, ishape, PRISM_REAL, nerror) 178 IF ( nerror /= PRISM_Ok ) THEN 179 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 180 CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 181 ENDIF 182 END DO 172 183 ENDIF 173 184 END DO … … 177 188 DO ji = 1, krcv 178 189 IF ( srcv(ji)%laction ) THEN 179 CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/), & 180 & PRISM_In , ishape , PRISM_REAL, nerror) 181 IF ( nerror /= PRISM_Ok ) THEN 182 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%clname) 183 CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 184 ENDIF 190 DO jc = 1, srcv(ji)%nct 191 IF ( srcv(ji)%nct .gt. 1 ) THEN 192 WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 193 ELSE 194 zclname=srcv(ji)%clname 195 ENDIF 196 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 197 CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 198 & PRISM_In , ishape , PRISM_REAL, nerror) 199 IF ( nerror /= PRISM_Ok ) THEN 200 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 201 CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 202 ENDIF 203 END DO 185 204 ENDIF 186 205 END DO … … 203 222 !! like sst or ice cover to the coupler or remote application. 204 223 !!---------------------------------------------------------------------- 205 INTEGER , INTENT(in ) :: kid ! variable index in the array 206 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 207 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 208 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pdata 224 INTEGER , INTENT(in ) :: kid ! variable index in the array 225 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 226 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 227 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 228 !! 229 INTEGER :: jc ! local loop index 209 230 !!-------------------------------------------------------------------- 210 231 ! 211 232 ! snd data to OASIS3 212 233 ! 213 CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo ) 214 215 IF ( ln_ctl ) THEN 216 IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. & 217 & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN 218 WRITE(numout,*) '****************' 219 WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 220 WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid 221 WRITE(numout,*) 'prism_put_proto: kstep ', kstep 222 WRITE(numout,*) 'prism_put_proto: info ', kinfo 223 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata) 224 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata) 225 WRITE(numout,*) ' - Sum value is ', SUM(pdata) 226 WRITE(numout,*) '****************' 234 DO jc = 1, ssnd(kid)%nct 235 236 CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 237 238 IF ( ln_ctl ) THEN 239 IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. & 240 & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN 241 WRITE(numout,*) '****************' 242 WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 243 WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 244 WRITE(numout,*) 'prism_put_proto: kstep ', kstep 245 WRITE(numout,*) 'prism_put_proto: info ', kinfo 246 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 247 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 248 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 249 WRITE(numout,*) '****************' 250 ENDIF 227 251 ENDIF 228 ENDIF 252 253 ENDDO 229 254 ! 230 255 END SUBROUTINE cpl_prism_snd … … 238 263 !! like stresses and fluxes from the coupler or remote application. 239 264 !!---------------------------------------------------------------------- 240 INTEGER , INTENT(in ) :: kid ! variable index in the array 241 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 242 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 243 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 244 !! 245 LOGICAL :: llaction 265 INTEGER , INTENT(in ) :: kid ! variable index in the array 266 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 267 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 268 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 269 !! 270 INTEGER :: jc ! local loop index 271 LOGICAL :: llaction 246 272 !!-------------------------------------------------------------------- 247 273 ! 248 274 ! receive local data from OASIS3 on every process 249 275 ! 250 CALL prism_get_proto ( srcv(kid)%nid, kstep, exfld, kinfo ) 251 252 llaction = .false. 253 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. & 254 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE. 255 256 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid 257 258 IF ( llaction ) THEN 259 260 kinfo = OASIS_Rcv 261 pdata(nldi:nlei, nldj:nlej) = exfld(:,:) 262 263 !--- Fill the overlap areas and extra hallows (mpp) 264 !--- check periodicity conditions (all cases) 265 CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn ) 266 267 IF ( ln_ctl ) THEN 268 WRITE(numout,*) '****************' 269 WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 270 WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid 271 WRITE(numout,*) 'prism_get_proto: kstep', kstep 272 WRITE(numout,*) 'prism_get_proto: info ', kinfo 273 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata) 274 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata) 275 WRITE(numout,*) ' - Sum value is ', SUM(pdata) 276 WRITE(numout,*) '****************' 276 DO jc = 1, srcv(kid)%nct 277 278 CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo ) 279 280 llaction = .false. 281 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. & 282 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE. 283 284 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 285 286 IF ( llaction ) THEN 287 288 kinfo = OASIS_Rcv 289 pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 290 291 !--- Fill the overlap areas and extra hallows (mpp) 292 !--- check periodicity conditions (all cases) 293 CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 294 295 IF ( ln_ctl ) THEN 296 WRITE(numout,*) '****************' 297 WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 298 WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid(jc) 299 WRITE(numout,*) 'prism_get_proto: kstep', kstep 300 WRITE(numout,*) 'prism_get_proto: info ', kinfo 301 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 302 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 303 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 304 WRITE(numout,*) '****************' 305 ENDIF 306 307 ELSE 308 kinfo = OASIS_idle 277 309 ENDIF 278 279 ELSE 280 kinfo = OASIS_idle 281 ENDIF 310 311 ENDDO 282 312 ! 283 313 END SUBROUTINE cpl_prism_rcv -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r2777 r3094 24 24 IMPLICIT NONE 25 25 PRIVATE 26 27 PUBLIC fld_map ! routine called by tides_init 26 28 27 29 TYPE, PUBLIC :: FLD_N !: Namelist field informations … … 56 58 LOGICAL :: rotn ! flag to indicate whether field has been rotated 57 59 END TYPE FLD 60 61 TYPE, PUBLIC :: MAP_POINTER !: Array of integer pointers to 1D arrays 62 INTEGER, POINTER :: ptr(:) 63 END TYPE MAP_POINTER 58 64 59 65 !$AGRIF_DO_NOT_TREAT … … 98 104 CONTAINS 99 105 100 SUBROUTINE fld_read( kt, kn_fsbc, sd )106 SUBROUTINE fld_read( kt, kn_fsbc, sd, map, jit, time_offset ) 101 107 !!--------------------------------------------------------------------- 102 108 !! *** ROUTINE fld_read *** … … 113 119 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 114 120 TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables 121 TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping index 122 INTEGER , INTENT(in ), OPTIONAL :: jit ! subcycle timestep for timesplitting option 123 INTEGER , INTENT(in ), OPTIONAL :: time_offset ! provide fields at time other than "now" 124 ! time_offset = -1 => fields at "before" time level 125 ! time_offset = +1 => fields at "after" time levels 126 ! etc. 115 127 !! 116 128 INTEGER :: imf ! size of the structure sd … … 119 131 INTEGER :: isecend ! number of second since Jan. 1st 00h of nit000 year at nitend 120 132 INTEGER :: isecsbc ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 133 INTEGER :: time_add ! local time_offset variable 121 134 LOGICAL :: llnxtyr ! open next year file? 122 135 LOGICAL :: llnxtmth ! open next month file? 123 136 LOGICAL :: llstop ! stop is the file does not exist 137 LOGICAL :: ll_firstcall ! true if this is the first call to fld_read for this set of fields 124 138 REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation 125 139 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation 126 140 CHARACTER(LEN=1000) :: clfmt ! write format 127 141 !!--------------------------------------------------------------------- 142 ll_firstcall = .false. 143 IF( PRESENT(jit) ) THEN 144 IF(kt == nit000 .and. jit == 1) ll_firstcall = .true. 145 ELSE 146 IF(kt == nit000) ll_firstcall = .true. 147 ENDIF 148 149 time_add = 0 150 IF( PRESENT(time_offset) ) THEN 151 time_add = time_offset 152 ENDIF 153 128 154 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 129 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) ! middle of sbc time step 155 IF( present(jit) ) THEN 156 ! ignore kn_fsbc in this case 157 isecsbc = nsec_year + nsec1jan000 + (jit+time_add)*rdt/REAL(nn_baro,wp) 158 ELSE 159 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + time_add * rdttra(1) ! middle of sbc time step 160 ENDIF 130 161 imf = SIZE( sd ) 131 162 ! 132 IF( kt == nit000 ) THEN ! initialization 133 DO jf = 1, imf 134 CALL fld_init( kn_fsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 135 END DO 163 IF( ll_firstcall ) THEN ! initialization 164 IF( PRESENT(map) ) THEN 165 DO jf = 1, imf 166 CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr ) ! read each before field (put them in after as they will be swapped) 167 END DO 168 ELSE 169 DO jf = 1, imf 170 CALL fld_init( kn_fsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 171 END DO 172 ENDIF 136 173 IF( lwp ) CALL wgt_print() ! control print 137 174 CALL fld_rot( kt, sd ) ! rotate vector fiels if needed … … 143 180 DO jf = 1, imf ! --- loop over field --- ! 144 181 145 IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000) THEN ! read/update the after data?182 IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN ! read/update the after data? 146 183 147 184 IF( sd(jf)%ln_tint ) THEN ! swap before record field and informations … … 151 188 ENDIF 152 189 153 CALL fld_rec( kn_fsbc, sd(jf) ) ! update record informations 190 IF( PRESENT(jit) ) THEN 191 CALL fld_rec( kn_fsbc, sd(jf), jit=jit ) ! update record informations 192 ELSE 193 CALL fld_rec( kn_fsbc, sd(jf) ) ! update record informations 194 ENDIF 154 195 155 196 ! do we have to change the year/month/week/day of the forcing field?? … … 212 253 213 254 ! read after data 214 CALL fld_get( sd(jf) ) 255 IF( PRESENT(map) ) THEN 256 CALL fld_get( sd(jf), map(jf)%ptr ) 257 ELSE 258 CALL fld_get( sd(jf) ) 259 ENDIF 215 260 216 261 ENDIF … … 225 270 clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & 226 271 & "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')" 227 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 272 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 228 273 & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 274 WRITE(numout, *) 'time_add is : ',time_add 229 275 ENDIF 230 276 ! temporal interpolation weights … … 253 299 254 300 255 SUBROUTINE fld_init( kn_fsbc, sdjf )301 SUBROUTINE fld_init( kn_fsbc, sdjf, map ) 256 302 !!--------------------------------------------------------------------- 257 303 !! *** ROUTINE fld_init *** … … 262 308 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 263 309 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 310 INTEGER , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 264 311 !! 265 312 LOGICAL :: llprevyr ! are we reading previous year file? … … 364 411 365 412 ! read before data 366 CALL fld_get( sdjf ) ! read before values in after arrays(as we will swap it later) 413 IF( PRESENT(map) ) THEN 414 CALL fld_get( sdjf, map ) ! read before values in after arrays(as we will swap it later) 415 ELSE 416 CALL fld_get( sdjf ) ! read before values in after arrays(as we will swap it later) 417 ENDIF 367 418 368 419 clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" … … 396 447 397 448 398 SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore )449 SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit ) 399 450 !!--------------------------------------------------------------------- 400 451 !! *** ROUTINE fld_rec *** … … 410 461 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 411 462 LOGICAL , INTENT(in ), OPTIONAL :: ldbefore ! sent back before record values (default = .FALSE.) 463 INTEGER , INTENT(in ), OPTIONAL :: jit ! index of barotropic subcycle 412 464 ! used only if sdjf%ln_tint = .TRUE. 413 465 !! … … 443 495 ! 444 496 ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 497 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 445 498 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 446 499 ! swap at the middle of the year … … 471 524 ! 472 525 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 526 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 473 527 imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 474 528 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) … … 498 552 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1) ! shift time to be centrered in the middle of sbc time step 499 553 ztmp = ztmp + 0.01 * rdttra(1) ! add 0.01 time step to avoid truncation error 554 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 500 555 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 501 556 ! … … 546 601 547 602 548 SUBROUTINE fld_get( sdjf )549 !!--------------------------------------------------------------------- 550 !! *** ROUTINE fld_ clopn***603 SUBROUTINE fld_get( sdjf, map ) 604 !!--------------------------------------------------------------------- 605 !! *** ROUTINE fld_get *** 551 606 !! 552 607 !! ** Purpose : read the data 553 608 !!---------------------------------------------------------------------- 554 609 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 610 INTEGER , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 555 611 !! 556 612 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) … … 559 615 560 616 ipk = SIZE( sdjf%fnow, 3 ) 561 IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 617 618 IF( PRESENT(map) ) THEN 619 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 620 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map ) 621 ENDIF 622 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 562 623 CALL wgt_list( sdjf, iw ) 563 624 IF( sdjf%ln_tint ) THEN ; CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) … … 581 642 END SUBROUTINE fld_get 582 643 644 SUBROUTINE fld_map( num, clvar, dta, nrec, map ) 645 !!--------------------------------------------------------------------- 646 !! *** ROUTINE fld_get *** 647 !! 648 !! ** Purpose : read global data from file and map onto local data 649 !! using a general mapping (for open boundaries) 650 !!---------------------------------------------------------------------- 651 #if defined key_bdy 652 USE bdy_oce, ONLY: dta_global ! workspace to read in global data arrays 653 #endif 654 655 INTEGER , INTENT(in ) :: num ! stream number 656 CHARACTER(LEN=*) , INTENT(in ) :: clvar ! variable name 657 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: dta ! output field on model grid (2 dimensional) 658 INTEGER , INTENT(in ) :: nrec ! record number to read (ie time slice) 659 INTEGER, DIMENSION(:) , INTENT(in ) :: map ! global-to-local mapping indices 660 !! 661 INTEGER :: ipi ! length of boundary data on local process 662 INTEGER :: ipj ! length of dummy dimension ( = 1 ) 663 INTEGER :: ipk ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk ) 664 INTEGER :: ilendta ! length of data in file 665 INTEGER :: idvar ! variable ID 666 INTEGER :: ib, ik ! loop counters 667 INTEGER :: ierr 668 REAL(wp), POINTER, DIMENSION(:,:,:) :: dta_read ! work space for global data 669 !!--------------------------------------------------------------------- 670 671 #if defined key_bdy 672 dta_read => dta_global 673 #endif 674 675 ipi = SIZE( dta, 1 ) 676 ipj = 1 677 ipk = SIZE( dta, 3 ) 678 679 idvar = iom_varid( num, clvar ) 680 ilendta = iom_file(num)%dimsz(1,idvar) 681 IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta 682 IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk 683 684 SELECT CASE( ipk ) 685 CASE(1) 686 CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1 ), nrec ) 687 CASE DEFAULT 688 CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec ) 689 END SELECT 690 ! 691 DO ib = 1, ipi 692 DO ik = 1, ipk 693 dta(ib,1,ik) = dta_read(map(ib),1,ik) 694 END DO 695 END DO 696 697 END SUBROUTINE fld_map 698 583 699 584 700 SUBROUTINE fld_rot( kt, sd ) 585 701 !!--------------------------------------------------------------------- 586 !! *** ROUTINE fld_ clopn***702 !! *** ROUTINE fld_rot *** 587 703 !! 588 704 !! ** Purpose : Vector fields may need to be rotated onto the local grid direction 589 705 !!---------------------------------------------------------------------- 590 706 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 591 USE wrk_nemo, ONLY: utmp => wrk_2d_ 4, vtmp => wrk_2d_5 ! 2D workspace707 USE wrk_nemo, ONLY: utmp => wrk_2d_24, vtmp => wrk_2d_25 ! 2D workspace 592 708 !! 593 709 INTEGER , INTENT(in ) :: kt ! ocean time step … … 601 717 !!--------------------------------------------------------------------- 602 718 603 IF(wrk_in_use(2, 4,5) ) THEN719 IF(wrk_in_use(2, 24,25) ) THEN 604 720 CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.') ; RETURN 605 721 END IF … … 638 754 END DO 639 755 ! 640 IF(wrk_not_released(2, 4,5) ) CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.')756 IF(wrk_not_released(2, 24,25) ) CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 641 757 ! 642 758 END SUBROUTINE fld_rot … … 672 788 ! 673 789 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 674 790 ! 675 791 END SUBROUTINE fld_clopn 676 792 -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r2777 r3094 6 6 !! History : 3.0 ! 2006-08 (G. Madec) Surface module 7 7 !! 3.2 ! 2009-06 (S. Masson) merge with ice_oce 8 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 8 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 9 !! 3.4 ! 2011-11 (C. Harris) CICE added as an option 9 10 !!---------------------------------------------------------------------- 10 #if defined key_lim3 || defined key_lim2 11 #if defined key_lim3 || defined key_lim2 || defined key_cice 11 12 !!---------------------------------------------------------------------- 12 13 !! 'key_lim2' or 'key_lim3' : LIM-2 or LIM-3 sea-ice model … … 19 20 USE par_ice_2 ! LIM-2 parameters 20 21 # endif 22 # if defined key_cice 23 USE ice_domain_size, only: ncat 24 #endif 21 25 USE lib_mpp ! MPP library 22 26 USE in_out_manager ! I/O manager … … 30 34 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .TRUE. !: LIM-2 ice model 31 35 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .FALSE. !: no LIM-3 36 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE 32 37 # if defined key_lim2_vp 33 38 CHARACTER(len=1), PUBLIC, PARAMETER :: cp_ice_msh = 'I' !: VP : 'I'-grid ice-velocity (B-grid lower left corner) … … 39 44 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .FALSE. !: no LIM-2 40 45 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .TRUE. !: LIM-3 ice model 46 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE 41 47 CHARACTER(len=1), PUBLIC, PARAMETER :: cp_ice_msh = 'C' !: 'C'-grid ice-velocity 42 48 # endif 49 # if defined key_cice 50 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .FALSE. !: no LIM-2 51 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .FALSE. !: no LIM-3 52 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .TRUE. !: CICE ice model 53 CHARACTER(len=1), PUBLIC :: cp_ice_msh = 'F' !: 'F'-grid ice-velocity 54 # endif 43 55 56 #if defined key_lim3 || defined key_lim2 44 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2] 45 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] … … 60 73 # endif 61 74 75 #elif defined key_cice 76 ! 77 ! for consistency with LIM, these are declared with three dimensions 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qlw_ice !: incoming long-wave 79 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2] 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] 81 ! 82 ! other forcing arrays are two dimensional 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ss_iou !: x ice-ocean surface stress at NEMO U point 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ss_iov !: y ice-ocean surface stress at NEMO V point 85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation-snow budget over ice [kg/m2] 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qatm_ice !: specific humidity 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndi_ice !: i wind at T point 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndj_ice !: j wind at T point 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfrzmlt !: NEMO frzmlt 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_iu !: ice fraction at NEMO U point 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_iv !: ice fraction at NEMO V point 93 ! 94 ! finally, arrays corresponding to different ice categories 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: category ice fraction 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: botmelt !: category botmelt 98 #endif 99 62 100 !!---------------------------------------------------------------------- 63 101 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 71 109 !! *** FUNCTION sbc_ice_alloc *** 72 110 !!---------------------------------------------------------------------- 111 #if defined key_lim3 || defined key_lim2 73 112 ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , & 74 113 & qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) , & … … 77 116 & utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , & 78 117 & fr1_i0 (jpi,jpj) , fr2_i0 (jpi,jpj) , & 79 # 118 #if defined key_lim3 80 119 & emp_ice(jpi,jpj) , tatm_ice(jpi,jpj) , STAT= sbc_ice_alloc ) 81 # 120 #else 82 121 & emp_ice(jpi,jpj) , STAT= sbc_ice_alloc ) 83 # endif 122 #endif 123 #elif defined key_cice 124 ALLOCATE( qla_ice(jpi,jpj,1) , qlw_ice(jpi,jpj,1) , qsr_ice(jpi,jpj,1) , & 125 wndi_ice(jpi,jpj) , tatm_ice(jpi,jpj) , qatm_ice(jpi,jpj) , & 126 wndj_ice(jpi,jpj) , nfrzmlt(jpi,jpj) , ss_iou(jpi,jpj) , & 127 ss_iov(jpi,jpj) , fr_iu(jpi,jpj) , fr_iv(jpi,jpj) , & 128 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= sbc_ice_alloc ) 129 #endif 84 130 ! 85 131 IF( lk_mpp ) CALL mpp_sum ( sbc_ice_alloc ) … … 89 135 #else 90 136 !!---------------------------------------------------------------------- 91 !! Default option NO LIM 2.0 or 3.0 sea-ice model137 !! Default option NO LIM 2.0 or 3.0 or CICE sea-ice model 92 138 !!---------------------------------------------------------------------- 93 139 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .FALSE. !: no LIM-2 ice model 94 140 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .FALSE. !: no LIM-3 ice model 141 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE ice model 95 142 CHARACTER(len=1), PUBLIC, PARAMETER :: cp_ice_msh = '-' !: no grid ice-velocity 96 143 #endif -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r2715 r3094 10 10 !! sbc_apr : read atmospheric pressure in netcdf files 11 11 !!---------------------------------------------------------------------- 12 USE bdy_par ! Unstructured boundary parameters13 12 USE obc_par ! open boundary condition parameters 14 13 USE dom_oce ! ocean space and time domain … … 30 29 ! !!* namsbc_apr namelist (Atmospheric PRessure) * 31 30 LOGICAL, PUBLIC :: ln_apr_obc = .FALSE. !: inverse barometer added to OBC ssh data 32 LOGICAL, PUBLIC :: ln_apr_bdy = .FALSE. !: inverse barometer added to BDY ssh data33 31 LOGICAL, PUBLIC :: ln_ref_apr = .FALSE. !: ref. pressure: global mean Patm (F) or a constant (F) 34 32 … … 115 113 ! 116 114 ! !* control check 117 IF( ln_apr_obc .OR. ln_apr_bdy) &118 CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC or BDYssh data not yet implemented ' )115 IF( ln_apr_obc ) & 116 CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC ssh data not yet implemented ' ) 119 117 IF( ln_apr_obc .AND. .NOT. lk_obc ) & 120 118 CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_obc' ) 121 IF( ln_apr_bdy .AND. .NOT. lk_bdy ) & 122 CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_bdy' ) 123 IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. lk_dynspg_ts ) & 119 IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts ) & 124 120 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' ) 125 IF( ( ln_apr_obc .OR. ln_apr_bdy) .AND. .NOT. ln_apr_dyn ) &121 IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn ) & 126 122 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 127 123 ENDIF -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r2777 r3094 14 14 !! 3.2 ! 2009-04 (B. Lemaire) Introduce iom_put 15 15 !! 3.3 ! 2010-10 (S. Masson) add diurnal cycle 16 !! 3.4 ! 2011-11 (C. Harris) Fill arrays required by CICE 16 17 !!---------------------------------------------------------------------- 17 18 … … 34 35 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 35 36 USE prtctl ! Print control 36 #if defined key_lim3 37 #if defined key_lim3 || defined key_cice 37 38 USE sbc_ice ! Surface boundary condition: ice fields 38 39 #endif … … 182 183 ! ! surface ocean fluxes computed with CLIO bulk formulea 183 184 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 185 186 #if defined key_cice 187 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 188 qlw_ice(:,:,1) = sf(jp_qlw)%fnow(:,:,1) 189 qsr_ice(:,:,1) = sf(jp_qsr)%fnow(:,:,1) 190 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 191 qatm_ice(:,:) = sf(jp_humi)%fnow(:,:,1) 192 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac 193 sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac 194 wndi_ice(:,:) = sf(jp_wndi)%fnow(:,:,1) 195 wndj_ice(:,:) = sf(jp_wndj)%fnow(:,:,1) 196 ENDIF 197 #endif 184 198 ! 185 199 END SUBROUTINE sbc_blk_core -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r2715 r3094 7 7 !! 3.0 ! 2008-02 (G. Madec, C Talandier) surface module 8 8 !! 3.1 ! 2009_02 (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface 9 !! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_oasis3 || defined key_oasis4 … … 41 42 USE geo2ocean ! 42 43 USE restart ! 43 USE oce , ONLY : t n, un, vn44 USE oce , ONLY : tsn, un, vn 44 45 USE albedo ! 45 46 USE in_out_manager ! I/O manager … … 51 52 #endif 52 53 USE diaar5, ONLY : lk_diaar5 54 #if defined key_cice 55 USE ice_domain_size, only: ncat 56 #endif 53 57 IMPLICIT NONE 54 58 PRIVATE … … 89 93 INTEGER, PARAMETER :: jpr_cal = 29 ! calving 90 94 INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module 91 #if ! defined key_cpl_carbon_cycle92 INTEGER, PARAMETER :: jprcv = 30 ! total number of fields received93 #else94 95 INTEGER, PARAMETER :: jpr_co2 = 31 95 INTEGER, PARAMETER :: jprcv = 31 ! total number of fields received 96 #endif 96 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 97 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 98 INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received 99 97 100 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction 98 101 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature … … 109 112 INTEGER, PARAMETER :: jps_ivy1 = 13 ! 110 113 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 111 #if ! defined key_cpl_carbon_cycle112 INTEGER, PARAMETER :: jpsnd = 14 ! total number of fields sended113 #else114 114 INTEGER, PARAMETER :: jps_co2 = 15 115 115 INTEGER, PARAMETER :: jpsnd = 15 ! total number of fields sended 116 #endif 116 117 117 ! !!** namelist namsbc_cpl ** 118 ! Send to the atmosphere ! 119 CHARACTER(len=100) :: cn_snd_temperature = 'oce only' ! 'oce only' 'weighted oce and ice' or 'mixed oce-ice' 120 CHARACTER(len=100) :: cn_snd_albedo = 'none' ! 'none' 'weighted ice' or 'mixed oce-ice' 121 CHARACTER(len=100) :: cn_snd_thickness = 'none' ! 'none' or 'weighted ice and snow' 122 CHARACTER(len=100) :: cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' or 'mixed oce-ice' 123 CHARACTER(len=100) :: cn_snd_crt_refere = 'spherical' ! 'spherical' or 'cartesian' 124 CHARACTER(len=100) :: cn_snd_crt_orient = 'local grid' ! 'eastward-northward' or 'local grid' 125 CHARACTER(len=100) :: cn_snd_crt_grid = 'T' ! always at 'T' point 126 #if defined key_cpl_carbon_cycle 127 CHARACTER(len=100) :: cn_snd_co2 = 'none' ! 'none' or 'coupled' 118 TYPE :: FLD_C 119 CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy 120 CHARACTER(len = 32) :: clcat ! multiple ice categories strategy 121 CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian') 122 CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid') 123 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 124 END TYPE FLD_C 125 ! Send to the atmosphere ! 126 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 127 ! Received from the atmosphere ! 128 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 129 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 130 131 TYPE :: DYNARR 132 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 133 END TYPE DYNARR 134 135 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 136 137 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 138 139 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 140 141 #if ! defined key_lim2 && ! defined key_lim3 142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl) 128 144 #endif 129 ! Received from the atmosphere ! 130 CHARACTER(len=100) :: cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' or 'mixed oce-ice' 131 CHARACTER(len=100) :: cn_rcv_tau_refere = 'spherical' ! 'spherical' or 'cartesian' 132 CHARACTER(len=100) :: cn_rcv_tau_orient = 'local grid' ! 'eastward-northward' or 'local grid' 133 CHARACTER(len=100) :: cn_rcv_tau_grid = 'T' ! 'T', 'U,V', 'U,V,I', 'T,I', or 'T,U,V' 134 CHARACTER(len=100) :: cn_rcv_w10m = 'none' ! 'none' or 'coupled' 135 CHARACTER(len=100) :: cn_rcv_dqnsdt = 'none' ! 'none' or 'coupled' 136 CHARACTER(len=100) :: cn_rcv_qsr = 'oce only' ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice' 137 CHARACTER(len=100) :: cn_rcv_qns = 'oce only' ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice' 138 CHARACTER(len=100) :: cn_rcv_emp = 'oce only' ! 'oce only' 'conservative' or 'oce and ice' 139 CHARACTER(len=100) :: cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' or 'mixed' 140 CHARACTER(len=100) :: cn_rcv_cal = 'none' ! 'none' or 'coupled' 141 CHARACTER(len=100) :: cn_rcv_taumod = 'none' ! 'none' or 'coupled' 142 #if defined key_cpl_carbon_cycle 143 CHARACTER(len=100) :: cn_rcv_co2 = 'none' ! 'none' or 'coupled' 145 146 #if defined key_cice 147 INTEGER, PARAMETER :: jpl = ncat 148 #elif ! defined key_lim2 && ! defined key_lim3 149 INTEGER, PARAMETER :: jpl = 1 150 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice 151 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice 144 152 #endif 145 153 146 !! CHARACTER(len=100), PUBLIC :: cn_rcv_rnf !: ??? ==>> !!gm treat this case in a different maner 147 148 CHARACTER(len=100), DIMENSION(4) :: cn_snd_crt ! array combining cn_snd_crt_* 149 CHARACTER(len=100), DIMENSION(4) :: cn_rcv_tau ! array combining cn_rcv_tau_* 150 151 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 152 153 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: frcv ! all fields recieved from the atmosphere 154 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 155 156 #if ! defined key_lim2 && ! defined key_lim3 157 ! quick patch to be able to run the coupled model without sea-ice... 158 INTEGER, PARAMETER :: jpl = 1 159 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicif, hsnif, u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 160 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice ! (jpi,jpj,jpl) 161 REAL(wp) :: lfus 154 #if ! defined key_lim3 && ! defined key_cice 155 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 156 #endif 157 158 #if ! defined key_lim3 159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 160 #endif 161 162 #if ! defined key_cice 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt 162 164 #endif 163 165 … … 176 178 !! *** FUNCTION sbc_cpl_alloc *** 177 179 !!---------------------------------------------------------------------- 178 INTEGER :: ierr( 2)180 INTEGER :: ierr(4),jn 179 181 !!---------------------------------------------------------------------- 180 182 ierr(:) = 0 181 183 ! 182 ALLOCATE( albedo_oce_mix(jpi,jpj), frcv(jpi,jpj,jprcv),nrcvinfo(jprcv), STAT=ierr(1) )184 ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 183 185 ! 184 186 #if ! defined key_lim2 && ! defined key_lim3 185 187 ! quick patch to be able to run the coupled model without sea-ice... 186 ALLOCATE( hicif(jpi,jpj) , u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,jpl) , & 187 hsnif(jpi,jpj) , v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,jpl) , STAT=ierr(2) ) 188 ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 189 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1), & 190 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 191 #endif 192 193 #if ! defined key_lim3 && ! defined key_cice 194 ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 195 #endif 196 197 #if defined key_cice || defined key_lim2 198 ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 188 199 #endif 189 200 sbc_cpl_alloc = MAXVAL( ierr ) … … 213 224 INTEGER :: jn ! dummy loop index 214 225 !! 215 NAMELIST/namsbc_cpl/ cn_snd_temperature, cn_snd_albedo , cn_snd_thickness, & 216 cn_snd_crt_nature, cn_snd_crt_refere , cn_snd_crt_orient, cn_snd_crt_grid , & 217 cn_rcv_w10m , cn_rcv_taumod , & 218 cn_rcv_tau_nature, cn_rcv_tau_refere , cn_rcv_tau_orient, cn_rcv_tau_grid , & 219 cn_rcv_dqnsdt , cn_rcv_qsr , cn_rcv_qns , cn_rcv_emp , cn_rcv_rnf , cn_rcv_cal 220 #if defined key_cpl_carbon_cycle 221 NAMELIST/namsbc_cpl_co2/ cn_snd_co2, cn_rcv_co2 222 #endif 226 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 227 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 228 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx , sn_rcv_co2 223 229 !!--------------------------------------------------------------------- 224 230 … … 230 236 ! Namelist informations ! 231 237 ! ================================ ! 238 239 ! default definitions 240 ! ! description ! multiple ! vector ! vector ! vector ! 241 ! ! ! categories ! reference ! orientation ! grids ! 242 ! send 243 sn_snd_temp = FLD_C( 'weighted oce and ice', 'no' , '' , '' , '' ) 244 sn_snd_alb = FLD_C( 'weighted ice' , 'no' , '' , '' , '' ) 245 sn_snd_thick = FLD_C( 'none' , 'no' , '' , '' , '' ) 246 sn_snd_crt = FLD_C( 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' ) 247 sn_snd_co2 = FLD_C( 'none' , 'no' , '' , '' , '' ) 248 ! receive 249 sn_rcv_w10m = FLD_C( 'none' , 'no' , '' , '' , '' ) 250 sn_rcv_taumod = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 251 sn_rcv_tau = FLD_C( 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' ) 252 sn_rcv_dqnsdt = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 253 sn_rcv_qsr = FLD_C( 'oce and ice' , 'no' , '' , '' , '' ) 254 sn_rcv_qns = FLD_C( 'oce and ice' , 'no' , '' , '' , '' ) 255 sn_rcv_emp = FLD_C( 'conservative' , 'no' , '' , '' , '' ) 256 sn_rcv_rnf = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 257 sn_rcv_cal = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 258 sn_rcv_iceflx = FLD_C( 'none' , 'no' , '' , '' , '' ) 259 sn_rcv_co2 = FLD_C( 'none' , 'no' , '' , '' , '' ) 232 260 233 261 REWIND( numnam ) ! ... read namlist namsbc_cpl … … 238 266 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 239 267 WRITE(numout,*)'~~~~~~~~~~~~' 240 WRITE(numout,*)' received fields' 241 WRITE(numout,*)' 10m wind module cn_rcv_w10m = ', cn_rcv_w10m 242 WRITE(numout,*)' surface stress - nature cn_rcv_tau_nature = ', cn_rcv_tau_nature 243 WRITE(numout,*)' - referential cn_rcv_tau_refere = ', cn_rcv_tau_refere 244 WRITE(numout,*)' - orientation cn_rcv_tau_orient = ', cn_rcv_tau_orient 245 WRITE(numout,*)' - mesh cn_rcv_tau_grid = ', cn_rcv_tau_grid 246 WRITE(numout,*)' non-solar heat flux sensitivity cn_rcv_dqnsdt = ', cn_rcv_dqnsdt 247 WRITE(numout,*)' solar heat flux cn_rcv_qsr = ', cn_rcv_qsr 248 WRITE(numout,*)' non-solar heat flux cn_rcv_qns = ', cn_rcv_qns 249 WRITE(numout,*)' freshwater budget cn_rcv_emp = ', cn_rcv_emp 250 WRITE(numout,*)' runoffs cn_rcv_rnf = ', cn_rcv_rnf 251 WRITE(numout,*)' calving cn_rcv_cal = ', cn_rcv_cal 252 WRITE(numout,*)' stress module cn_rcv_taumod = ', cn_rcv_taumod 253 WRITE(numout,*)' sent fields' 254 WRITE(numout,*)' surface temperature cn_snd_temperature = ', cn_snd_temperature 255 WRITE(numout,*)' albedo cn_snd_albedo = ', cn_snd_albedo 256 WRITE(numout,*)' ice/snow thickness cn_snd_thickness = ', cn_snd_thickness 257 WRITE(numout,*)' surface current - nature cn_snd_crt_nature = ', cn_snd_crt_nature 258 WRITE(numout,*)' - referential cn_snd_crt_refere = ', cn_snd_crt_refere 259 WRITE(numout,*)' - orientation cn_snd_crt_orient = ', cn_snd_crt_orient 260 WRITE(numout,*)' - mesh cn_snd_crt_grid = ', cn_snd_crt_grid 261 ENDIF 262 263 #if defined key_cpl_carbon_cycle 264 REWIND( numnam ) ! read namlist namsbc_cpl_co2 265 READ ( numnam, namsbc_cpl_co2 ) 266 IF(lwp) THEN ! control print 267 WRITE(numout,*) 268 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl_co2 namelist ' 269 WRITE(numout,*)'~~~~~~~~~~~~' 270 WRITE(numout,*)' received fields' 271 WRITE(numout,*)' atm co2 cn_rcv_co2 = ', cn_rcv_co2 272 WRITE(numout,*)' sent fields' 273 WRITE(numout,*)' oce co2 flux cn_snd_co2 = ', cn_snd_co2 274 WRITE(numout,*) 275 ENDIF 276 #endif 277 ! save current & stress in an array and suppress possible blank in the name 278 cn_snd_crt(1) = TRIM( cn_snd_crt_nature ) ; cn_snd_crt(2) = TRIM( cn_snd_crt_refere ) 279 cn_snd_crt(3) = TRIM( cn_snd_crt_orient ) ; cn_snd_crt(4) = TRIM( cn_snd_crt_grid ) 280 cn_rcv_tau(1) = TRIM( cn_rcv_tau_nature ) ; cn_rcv_tau(2) = TRIM( cn_rcv_tau_refere ) 281 cn_rcv_tau(3) = TRIM( cn_rcv_tau_orient ) ; cn_rcv_tau(4) = TRIM( cn_rcv_tau_grid ) 282 283 ! ! allocate zdfric arrays 268 WRITE(numout,*)' received fields (mutiple ice categogies)' 269 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' 270 WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' 271 WRITE(numout,*)' surface stress = ', TRIM(sn_rcv_tau%cldes ), ' (', TRIM(sn_rcv_tau%clcat ), ')' 272 WRITE(numout,*)' - referential = ', sn_rcv_tau%clvref 273 WRITE(numout,*)' - orientation = ', sn_rcv_tau%clvor 274 WRITE(numout,*)' - mesh = ', sn_rcv_tau%clvgrd 275 WRITE(numout,*)' non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')' 276 WRITE(numout,*)' solar heat flux = ', TRIM(sn_rcv_qsr%cldes ), ' (', TRIM(sn_rcv_qsr%clcat ), ')' 277 WRITE(numout,*)' non-solar heat flux = ', TRIM(sn_rcv_qns%cldes ), ' (', TRIM(sn_rcv_qns%clcat ), ')' 278 WRITE(numout,*)' freshwater budget = ', TRIM(sn_rcv_emp%cldes ), ' (', TRIM(sn_rcv_emp%clcat ), ')' 279 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 280 WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')' 281 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 282 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 283 WRITE(numout,*)' sent fields (multiple ice categories)' 284 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' 285 WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')' 286 WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' 287 WRITE(numout,*)' surface current = ', TRIM(sn_snd_crt%cldes ), ' (', TRIM(sn_snd_crt%clcat ), ')' 288 WRITE(numout,*)' - referential = ', sn_snd_crt%clvref 289 WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor 290 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 291 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 292 ENDIF 293 294 ! ! allocate sbccpl arrays 284 295 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 285 296 … … 294 305 295 306 ! default definitions of srcv 296 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. 307 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 297 308 298 309 ! ! ------------------------- ! … … 315 326 ! 316 327 ! Vectors: change of sign at north fold ONLY if on the local grid 317 IF( TRIM( cn_rcv_tau(3)) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1.328 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 318 329 319 330 ! ! Set grid and action 320 SELECT CASE( TRIM( cn_rcv_tau(4)) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'331 SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' 321 332 CASE( 'T' ) 322 333 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point … … 364 375 srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2 365 376 CASE default 366 CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_tau(4)' )377 CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' ) 367 378 END SELECT 368 379 ! 369 IF( TRIM( cn_rcv_tau(2)) == 'spherical' ) & ! spherical: 3rd component not received380 IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received 370 381 & srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 371 382 ! 372 IF( TRIM( cn_rcv_tau(1)) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used383 IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used 373 384 srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received 374 385 srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation … … 388 399 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation 389 400 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 390 SELECT CASE( TRIM( cn_rcv_emp) )401 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 391 402 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 392 403 CASE( 'conservative' ) ; srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 393 404 CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 394 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_emp' )405 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 395 406 END SELECT 396 407 … … 398 409 ! ! Runoffs & Calving ! 399 410 ! ! ------------------------- ! 400 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( cn_rcv_rnf ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 401 IF( TRIM( cn_rcv_rnf ) == 'climato' ) THEN ; ln_rnf = .TRUE. 402 ELSE ; ln_rnf = .FALSE. 403 ENDIF 404 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( cn_rcv_cal ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 411 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 412 ! This isn't right - really just want ln_rnf_emp changed 413 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 414 ! ELSE ; ln_rnf = .FALSE. 415 ! ENDIF 416 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 405 417 406 418 ! ! ------------------------- ! … … 410 422 srcv(jpr_qnsice)%clname = 'O_QnsIce' 411 423 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 412 SELECT CASE( TRIM( cn_rcv_qns ) )424 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 413 425 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 414 426 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 415 427 CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 416 428 CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE. 417 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qns' )429 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 418 430 END SELECT 419 431 IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 432 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 420 433 ! ! ------------------------- ! 421 434 ! ! solar radiation ! Qsr … … 424 437 srcv(jpr_qsrice)%clname = 'O_QsrIce' 425 438 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 426 SELECT CASE( TRIM( cn_rcv_qsr) )439 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 427 440 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 428 441 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 429 442 CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 430 443 CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE. 431 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qsr' )444 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 432 445 END SELECT 433 446 IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 447 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 434 448 ! ! ------------------------- ! 435 449 ! ! non solar sensitivity ! d(Qns)/d(T) 436 450 ! ! ------------------------- ! 437 451 srcv(jpr_dqnsdt)%clname = 'O_dQnsdT' 438 IF( TRIM( cn_rcv_dqnsdt) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE.439 ! 440 ! non solar sensitivity mandatory for ice model441 IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. k_ice /= 0) &442 CALL ctl_stop( 'sbc_cpl_init: cn_rcv_dqnsdtmust be coupled in namsbc_cpl namelist' )452 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE. 453 ! 454 ! non solar sensitivity mandatory for LIM ice model 455 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 456 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 443 457 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 444 IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. TRIM( cn_rcv_qns ) == 'mixed oce-ice' ) &445 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between cn_rcv_qns and cn_rcv_dqnsdt' )458 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 459 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 446 460 ! ! ------------------------- ! 447 461 ! ! Ice Qsr penetration ! … … 456 470 ! ! 10m wind module ! 457 471 ! ! ------------------------- ! 458 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM( cn_rcv_w10m) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE.472 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE. 459 473 ! 460 474 ! ! ------------------------- ! 461 475 ! ! wind stress module ! 462 476 ! ! ------------------------- ! 463 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM( cn_rcv_taumod) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE.477 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE. 464 478 lhftau = srcv(jpr_taum)%laction 465 479 466 #if defined key_cpl_carbon_cycle467 480 ! ! ------------------------- ! 468 481 ! ! Atmospheric CO2 ! 469 482 ! ! ------------------------- ! 470 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(cn_rcv_co2 ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 471 #endif 472 483 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 484 ! ! ------------------------- ! 485 ! ! topmelt and botmelt ! 486 ! ! ------------------------- ! 487 srcv(jpr_topm )%clname = 'OTopMlt' 488 srcv(jpr_botm )%clname = 'OBotMlt' 489 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 490 IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 491 srcv(jpr_topm:jpr_botm)%nct = jpl 492 ELSE 493 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) 494 ENDIF 495 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 496 ENDIF 497 498 ! Allocate all parts of frcv used for received fields 499 DO jn = 1, jprcv 500 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 501 END DO 502 ! Allocate taum part of frcv which is used even when not received as coupling field 503 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 504 473 505 ! ================================ ! 474 506 ! Define the send interface ! 475 507 ! ================================ ! 476 ! for each field: define the OASIS name (s rcv(:)%clname)477 ! define send or not from the namelist parameters (s rcv(:)%laction)478 ! define the north fold type of lbc (s rcv(:)%nsgn)508 ! for each field: define the OASIS name (ssnd(:)%clname) 509 ! define send or not from the namelist parameters (ssnd(:)%laction) 510 ! define the north fold type of lbc (ssnd(:)%nsgn) 479 511 480 512 ! default definitions of nsnd 481 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. 513 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 482 514 483 515 ! ! ------------------------- ! … … 487 519 ssnd(jps_tice)%clname = 'O_TepIce' 488 520 ssnd(jps_tmix)%clname = 'O_TepMix' 489 SELECT CASE( TRIM( cn_snd_temperature) )521 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 490 522 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 491 CASE( 'weighted oce and ice' ) ; ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 523 CASE( 'weighted oce and ice' ) 524 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 525 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl 492 526 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 493 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_temperature' )527 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 494 528 END SELECT 495 529 … … 499 533 ssnd(jps_albice)%clname = 'O_AlbIce' 500 534 ssnd(jps_albmix)%clname = 'O_AlbMix' 501 SELECT CASE( TRIM( cn_snd_albedo) )535 SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 502 536 CASE( 'none' ) ! nothing to do 503 537 CASE( 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE. 504 538 CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE. 505 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_albedo' )539 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 506 540 END SELECT 507 541 ! … … 509 543 ! 1. sending mixed oce-ice albedo or 510 544 ! 2. receiving mixed oce-ice solar radiation 511 IF ( TRIM ( cn_snd_albedo ) == 'mixed oce-ice' .OR. TRIM ( cn_rcv_qsr) == 'mixed oce-ice' ) THEN545 IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 512 546 CALL albedo_oce( zaos, zacs ) 513 547 ! Due to lack of information on nebulosity : mean clear/overcast sky … … 518 552 ! ! Ice fraction & Thickness ! 519 553 ! ! ------------------------- ! 520 ssnd(jps_fice)%clname = 'OIceFrac' 521 ssnd(jps_hice)%clname = 'O_IceTck' 522 ssnd(jps_hsnw)%clname = 'O_SnwTck' 523 IF( k_ice /= 0 ) ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 524 IF( TRIM( cn_snd_thickness ) == 'weighted ice and snow' ) ssnd( (/jps_hice, jps_hsnw/) )%laction = .TRUE. 525 554 ssnd(jps_fice)%clname = 'OIceFrc' 555 ssnd(jps_hice)%clname = 'OIceTck' 556 ssnd(jps_hsnw)%clname = 'OSnwTck' 557 IF( k_ice /= 0 ) THEN 558 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 559 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 560 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 561 ENDIF 562 563 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 564 CASE ( 'ice and snow' ) 565 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 566 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 567 ssnd(jps_hice:jps_hsnw)%nct = jpl 568 ELSE 569 IF ( jpl > 1 ) THEN 570 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 571 ENDIF 572 ENDIF 573 CASE ( 'weighted ice and snow' ) 574 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 575 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl 576 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 577 END SELECT 578 526 579 ! ! ------------------------- ! 527 580 ! ! Surface current ! … … 534 587 ssnd(jps_ocx1:jps_ivz1)%nsgn = -1. ! vectors: change of the sign at the north fold 535 588 536 IF( cn_snd_crt(4) /= 'T' ) CALL ctl_stop( 'cn_snd_crt(4) must be equal to T' ) 537 ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid 538 589 IF( sn_snd_crt%clvgrd == 'U,V' ) THEN 590 ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V' 591 ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 592 CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 593 ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid 594 ENDIF 539 595 ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send 540 IF( TRIM( cn_snd_crt(2) ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 541 SELECT CASE( TRIM( cn_snd_crt(1) ) ) 596 IF( TRIM( sn_snd_crt%clvref ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 597 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1. 598 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 542 599 CASE( 'none' ) ; ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE. 543 600 CASE( 'oce only' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 544 601 CASE( 'weighted oce and ice' ) ! nothing to do 545 602 CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 546 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_crt(1)' )603 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' ) 547 604 END SELECT 548 605 549 #if defined key_cpl_carbon_cycle550 606 ! ! ------------------------- ! 551 607 ! ! CO2 flux ! 552 608 ! ! ------------------------- ! 553 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(cn_snd_co2) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 554 #endif 609 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 555 610 ! 556 611 ! ================================ ! … … 636 691 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 637 692 DO jn = 1, jprcv ! received fields sent by the atmosphere 638 IF( srcv(jn)%laction ) CALL cpl_prism_rcv( jn, isec, frcv( :,:,jn), nrcvinfo(jn) )693 IF( srcv(jn)%laction ) CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 639 694 END DO 640 695 … … 642 697 IF( srcv(jpr_otx1)%laction ) THEN ! ocean stress components ! 643 698 ! ! ========================= ! 644 ! define frcv( :,:,jpr_otx1) and frcv(:,:,jpr_oty1): stress at U/V point along model grid699 ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid 645 700 ! => need to be done only when we receive the field 646 701 IF( nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN 647 702 ! 648 IF( TRIM( cn_rcv_tau(2)) == 'cartesian' ) THEN ! 2 components on the sphere703 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 649 704 ! ! (cartesian to spherical -> 3 to 2 components) 650 705 ! 651 CALL geo2oce( frcv( :,:,jpr_otx1), frcv(:,:,jpr_oty1), frcv(:,:,jpr_otz1), &706 CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), & 652 707 & srcv(jpr_otx1)%clgrid, ztx, zty ) 653 frcv( :,:,jpr_otx1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid654 frcv( :,:,jpr_oty1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid708 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 709 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 655 710 ! 656 711 IF( srcv(jpr_otx2)%laction ) THEN 657 CALL geo2oce( frcv( :,:,jpr_otx2), frcv(:,:,jpr_oty2), frcv(:,:,jpr_otz2), &712 CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), & 658 713 & srcv(jpr_otx2)%clgrid, ztx, zty ) 659 frcv( :,:,jpr_otx2) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid660 frcv( :,:,jpr_oty2) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid714 frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 715 frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 661 716 ENDIF 662 717 ! 663 718 ENDIF 664 719 ! 665 IF( TRIM( cn_rcv_tau(3)) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid720 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 666 721 ! ! (geographical to local grid -> rotate the components) 667 CALL rot_rep( frcv( :,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )668 frcv( :,:,jpr_otx1) = ztx(:,:) ! overwrite 1st component on the 1st grid722 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 723 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 669 724 IF( srcv(jpr_otx2)%laction ) THEN 670 CALL rot_rep( frcv( :,:,jpr_otx2), frcv(:,:,jpr_oty2), srcv(jpr_otx2)%clgrid, 'en->j', zty )671 ELSE 672 CALL rot_rep( frcv( :,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->j', zty )725 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 726 ELSE 727 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 673 728 ENDIF 674 frcv( :,:,jpr_oty1) = zty(:,:) ! overwrite 2nd component on the 2nd grid729 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 675 730 ENDIF 676 731 ! … … 678 733 DO jj = 2, jpjm1 ! T ==> (U,V) 679 734 DO ji = fs_2, fs_jpim1 ! vector opt. 680 frcv(j i,jj,jpr_otx1) = 0.5 * ( frcv(ji+1,jj ,jpr_otx1) + frcv(ji,jj,jpr_otx1) )681 frcv(j i,jj,jpr_oty1) = 0.5 * ( frcv(ji ,jj+1,jpr_oty1) + frcv(ji,jj,jpr_oty1) )735 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 736 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 682 737 END DO 683 738 END DO 684 CALL lbc_lnk( frcv( :,:,jpr_otx1), 'U', -1. ) ; CALL lbc_lnk( frcv(:,:,jpr_oty1), 'V', -1. )739 CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U', -1. ) ; CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V', -1. ) 685 740 ENDIF 686 741 llnewtx = .TRUE. … … 691 746 ELSE ! No dynamical coupling ! 692 747 ! ! ========================= ! 693 frcv( :,:,jpr_otx1) = 0.e0 ! here simply set to zero694 frcv( :,:,jpr_oty1) = 0.e0 ! an external read in a file can be added instead748 frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero 749 frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead 695 750 llnewtx = .TRUE. 696 751 ! … … 708 763 !CDIR NOVERRCHK 709 764 DO ji = fs_2, fs_jpim1 ! vect. opt. 710 zzx = frcv(j i-1,jj ,jpr_otx1) + frcv(ji,jj,jpr_otx1)711 zzy = frcv(j i ,jj-1,jpr_oty1) + frcv(ji,jj,jpr_oty1)712 frcv(j i,jj,jpr_taum) = 0.5 * SQRT( zzx * zzx + zzy * zzy )765 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 766 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 767 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 713 768 END DO 714 769 END DO 715 CALL lbc_lnk( frcv( :,:,jpr_taum), 'T', 1. )770 CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 716 771 llnewtau = .TRUE. 717 772 ELSE … … 722 777 ! Stress module can be negative when received (interpolation problem) 723 778 IF( llnewtau ) THEN 724 DO jj = 1, jpj 725 DO ji = 1, jpi 726 frcv(ji,jj,jpr_taum) = MAX( 0.0e0, frcv(ji,jj,jpr_taum) ) 727 END DO 728 END DO 779 frcv(jpr_taum)%z3(:,:,1) = MAX( 0.0e0, frcv(jpr_taum)%z3(:,:,1) ) 729 780 ENDIF 730 781 ENDIF … … 742 793 !CDIR NOVERRCHK 743 794 DO ji = 1, jpi 744 frcv(ji,jj,jpr_w10m) = SQRT( frcv(ji,jj,jpr_taum) * zcoef )795 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 745 796 END DO 746 797 END DO 747 798 ENDIF 748 ENDIF 749 750 ! u(v)tau and taum will be modified by ice model (wndm will be changed by PISCES) 799 ELSE 800 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 801 ENDIF 802 803 ! u(v)tau and taum will be modified by ice model 751 804 ! -> need to be reset before each call of the ice/fsbc 752 805 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 753 806 ! 754 utau(:,:) = frcv(:,:,jpr_otx1) 755 vtau(:,:) = frcv(:,:,jpr_oty1) 756 taum(:,:) = frcv(:,:,jpr_taum) 757 wndm(:,:) = frcv(:,:,jpr_w10m) 807 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 808 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 809 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 758 810 CALL iom_put( "taum_oce", taum ) ! output wind stress module 759 811 ! 760 812 ENDIF 813 814 #if defined key_cpl_carbon_cycle 815 ! ! atmosph. CO2 (ppm) 816 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 817 #endif 818 761 819 ! ! ========================= ! 762 820 IF( k_ice <= 1 ) THEN ! heat & freshwater fluxes ! (Ocean only case) … … 764 822 ! 765 823 ! ! non solar heat flux over the ocean (qns) 766 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv( :,:,jpr_qnsoce)767 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv( :,:,jpr_qnsmix)824 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 825 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 768 826 ! add the latent heat of solid precip. melting 769 IF( srcv(jpr_snow )%laction ) qns(:,:) = qns(:,:) - frcv( :,:,jpr_snow) * lfus827 IF( srcv(jpr_snow )%laction ) qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus 770 828 771 829 ! ! solar flux over the ocean (qsr) 772 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv( :,:,jpr_qsroce)773 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv( :,:,jpr_qsrmix)830 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 831 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 774 832 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 775 833 ! 776 834 ! ! total freshwater fluxes over the ocean (emp, emps) 777 SELECT CASE( TRIM( cn_rcv_emp) ) ! evaporation - precipitation835 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 778 836 CASE( 'conservative' ) 779 emp(:,:) = frcv( :,:,jpr_tevp) - ( frcv(:,:,jpr_rain) + frcv(:,:,jpr_snow) )837 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 780 838 CASE( 'oce only', 'oce and ice' ) 781 emp(:,:) = frcv( :,:,jpr_oemp)839 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 782 840 CASE default 783 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of cn_rcv_emp' )841 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 784 842 END SELECT 785 843 ! 786 844 ! ! runoffs and calving (added in emp) 787 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv( :,:,jpr_rnf)788 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv( :,:,jpr_cal)845 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 846 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 789 847 ! 790 848 !!gm : this seems to be internal cooking, not sure to need that in a generic interface 791 849 !!gm at least should be optional... 792 !! IF( TRIM( cn_rcv_rnf) == 'coupled' ) THEN ! add to the total freshwater budget850 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 793 851 !! ! remove negative runoff 794 !! zcumulpos = SUM( MAX( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )795 !! zcumulneg = SUM( MIN( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )852 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 853 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 796 854 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 797 855 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 798 856 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 799 857 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 800 !! frcv( :,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg858 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 801 859 !! ENDIF 802 860 !! ! add runoff to e-p 803 !! emp(:,:) = emp(:,:) - frcv( :,:,jpr_rnf)861 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 804 862 !! ENDIF 805 863 !!gm end of internal cooking … … 807 865 emps(:,:) = emp(:,:) ! concentration/dilution = emp 808 866 809 ! ! 10 m wind speed810 IF( srcv(jpr_w10m)%laction ) wndm(:,:) = frcv(:,:,jpr_w10m)811 !812 #if defined key_cpl_carbon_cycle813 ! ! atmosph. CO2 (ppm)814 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(:,:,jpr_co2)815 #endif816 817 867 ENDIF 818 868 ! … … 880 930 ! ! ======================= ! 881 931 ! 882 IF( TRIM( cn_rcv_tau(2)) == 'cartesian' ) THEN ! 2 components on the sphere932 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 883 933 ! ! (cartesian to spherical -> 3 to 2 components) 884 CALL geo2oce( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), frcv(:,:,jpr_itz1), &934 CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), & 885 935 & srcv(jpr_itx1)%clgrid, ztx, zty ) 886 frcv( :,:,jpr_itx1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid887 frcv( :,:,jpr_itx1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid936 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 937 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 888 938 ! 889 939 IF( srcv(jpr_itx2)%laction ) THEN 890 CALL geo2oce( frcv( :,:,jpr_itx2), frcv(:,:,jpr_ity2), frcv(:,:,jpr_itz2), &940 CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), & 891 941 & srcv(jpr_itx2)%clgrid, ztx, zty ) 892 frcv( :,:,jpr_itx2) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid893 frcv( :,:,jpr_ity2) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid942 frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 943 frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 894 944 ENDIF 895 945 ! 896 946 ENDIF 897 947 ! 898 IF( TRIM( cn_rcv_tau(3)) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid948 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 899 949 ! ! (geographical to local grid -> rotate the components) 900 CALL rot_rep( frcv( :,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )901 frcv( :,:,jpr_itx1) = ztx(:,:) ! overwrite 1st component on the 1st grid950 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx ) 951 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 902 952 IF( srcv(jpr_itx2)%laction ) THEN 903 CALL rot_rep( frcv( :,:,jpr_itx2), frcv(:,:,jpr_ity2), srcv(jpr_itx2)%clgrid, 'en->j', zty )953 CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty ) 904 954 ELSE 905 CALL rot_rep( frcv( :,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->j', zty )955 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 906 956 ENDIF 907 frcv( :,:,jpr_ity1) = zty(:,:) ! overwrite 2nd component on the 1st grid957 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid 908 958 ENDIF 909 959 ! ! ======================= ! 910 960 ELSE ! use ocean stress ! 911 961 ! ! ======================= ! 912 frcv( :,:,jpr_itx1) = frcv(:,:,jpr_otx1)913 frcv( :,:,jpr_ity1) = frcv(:,:,jpr_oty1)962 frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1) 963 frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1) 914 964 ! 915 965 ENDIF … … 934 984 DO jj = 2, jpjm1 ! (U,V) ==> I 935 985 DO ji = 2, jpim1 ! NO vector opt. 936 p_taui(ji,jj) = 0.5 * ( frcv(j i-1,jj ,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) )937 p_tauj(ji,jj) = 0.5 * ( frcv(j i ,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) )986 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 987 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 938 988 END DO 939 989 END DO … … 941 991 DO jj = 2, jpjm1 ! F ==> I 942 992 DO ji = 2, jpim1 ! NO vector opt. 943 p_taui(ji,jj) = frcv(j i-1,jj-1,jpr_itx1)944 p_tauj(ji,jj) = frcv(j i-1,jj-1,jpr_ity1)993 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1) 994 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1) 945 995 END DO 946 996 END DO … … 948 998 DO jj = 2, jpjm1 ! T ==> I 949 999 DO ji = 2, jpim1 ! NO vector opt. 950 p_taui(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_itx1) + frcv(ji-1,jj ,jpr_itx1) &951 & + frcv(j i,jj-1,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) )952 p_tauj(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_ity1) + frcv(ji-1,jj ,jpr_ity1) &953 & + frcv(j i,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) )1000 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj ,1) & 1001 & + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 1002 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) & 1003 & + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 954 1004 END DO 955 1005 END DO 956 1006 CASE( 'I' ) 957 p_taui(:,:) = frcv( :,:,jpr_itx1) ! I ==> I958 p_tauj(:,:) = frcv( :,:,jpr_ity1)1007 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! I ==> I 1008 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 959 1009 END SELECT 960 1010 IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN … … 967 1017 DO jj = 2, jpjm1 ! (U,V) ==> F 968 1018 DO ji = fs_2, fs_jpim1 ! vector opt. 969 p_taui(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_itx1) + frcv(ji ,jj+1,jpr_itx1) )970 p_tauj(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_ity1) + frcv(ji+1,jj ,jpr_ity1) )1019 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj+1,1) ) 1020 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) ) 971 1021 END DO 972 1022 END DO … … 974 1024 DO jj = 2, jpjm1 ! I ==> F 975 1025 DO ji = 2, jpim1 ! NO vector opt. 976 p_taui(ji,jj) = frcv(j i+1,jj+1,jpr_itx1)977 p_tauj(ji,jj) = frcv(j i+1,jj+1,jpr_ity1)1026 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1) 1027 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1) 978 1028 END DO 979 1029 END DO … … 981 1031 DO jj = 2, jpjm1 ! T ==> F 982 1032 DO ji = 2, jpim1 ! NO vector opt. 983 p_taui(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_itx1) + frcv(ji+1,jj ,jpr_itx1) &984 & + frcv(j i,jj+1,jpr_itx1) + frcv(ji+1,jj+1,jpr_itx1) )985 p_tauj(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_ity1) + frcv(ji+1,jj ,jpr_ity1) &986 & + frcv(j i,jj+1,jpr_ity1) + frcv(ji+1,jj+1,jpr_ity1) )1033 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) & 1034 & + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) ) 1035 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) & 1036 & + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) ) 987 1037 END DO 988 1038 END DO 989 1039 CASE( 'F' ) 990 p_taui(:,:) = frcv( :,:,jpr_itx1) ! F ==> F991 p_tauj(:,:) = frcv( :,:,jpr_ity1)1040 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! F ==> F 1041 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 992 1042 END SELECT 993 1043 IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN … … 998 1048 SELECT CASE ( srcv(jpr_itx1)%clgrid ) 999 1049 CASE( 'U' ) 1000 p_taui(:,:) = frcv( :,:,jpr_itx1) ! (U,V) ==> (U,V)1001 p_tauj(:,:) = frcv( :,:,jpr_ity1)1050 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V) 1051 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1002 1052 CASE( 'F' ) 1003 1053 DO jj = 2, jpjm1 ! F ==> (U,V) 1004 1054 DO ji = fs_2, fs_jpim1 ! vector opt. 1005 p_taui(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_itx1) + frcv(ji ,jj-1,jpr_itx1) )1006 p_tauj(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_ity1) + frcv(ji-1,jj ,jpr_ity1) )1055 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) ) 1056 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) ) 1007 1057 END DO 1008 1058 END DO … … 1010 1060 DO jj = 2, jpjm1 ! T ==> (U,V) 1011 1061 DO ji = fs_2, fs_jpim1 ! vector opt. 1012 p_taui(ji,jj) = 0.5 * ( frcv(j i+1,jj ,jpr_itx1) + frcv(ji,jj,jpr_itx1) )1013 p_tauj(ji,jj) = 0.5 * ( frcv(j i ,jj+1,jpr_ity1) + frcv(ji,jj,jpr_ity1) )1062 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1063 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1014 1064 END DO 1015 1065 END DO … … 1017 1067 DO jj = 2, jpjm1 ! I ==> (U,V) 1018 1068 DO ji = 2, jpim1 ! NO vector opt. 1019 p_taui(ji,jj) = 0.5 * ( frcv(j i+1,jj+1,jpr_itx1) + frcv(ji+1,jj ,jpr_itx1) )1020 p_tauj(ji,jj) = 0.5 * ( frcv(j i+1,jj+1,jpr_ity1) + frcv(ji ,jj+1,jpr_ity1) )1069 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) ) 1070 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) ) 1021 1071 END DO 1022 1072 END DO … … 1027 1077 END SELECT 1028 1078 1029 !!gm Should be useless as sbc_cpl_ice_tau only called at coupled frequency1030 ! The receive stress are transformed such that in all case frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1)1031 ! become the i-component and j-component of the stress at the right grid point1032 !!gm frcv(:,:,jpr_itx1) = p_taui(:,:)1033 !!gm frcv(:,:,jpr_ity1) = p_tauj(:,:)1034 !!gm1035 1079 ENDIF 1036 1080 ! … … 1040 1084 1041 1085 1042 SUBROUTINE sbc_cpl_ice_flx( p_frld , & 1043 & pqns_tot, pqns_ice, pqsr_tot , pqsr_ice, & 1044 & pemp_tot, pemp_ice, pdqns_ice, psprecip, & 1045 & palbi , psst , pist ) 1086 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist ) 1046 1087 !!---------------------------------------------------------------------- 1047 !! *** ROUTINE sbc_cpl_ice_flx _rcv***1088 !! *** ROUTINE sbc_cpl_ice_flx *** 1048 1089 !! 1049 1090 !! ** Purpose : provide the heat and freshwater fluxes of the … … 1066 1107 !! the atmosphere 1067 1108 !! 1068 !! N.B. - fields over sea-ice are passed in argument so that1069 !! the module can be compile without sea-ice.1070 1109 !! - the fluxes have been separated from the stress as 1071 1110 !! (a) they are updated at each ice time step compare to … … 1078 1117 !! 1079 1118 !! ** Action : update at each nf_ice time step: 1080 !! pqns_tot, pqsr_tot non-solar and solar total heat fluxes1081 !! pqns_ice, pqsr_ice non-solar and solar heat fluxes over the ice1082 !! pemp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)1083 !! pemp_ice ice sublimation - solid precipitation over the ice1084 !! pdqns_ice d(non-solar heat flux)/d(Temperature) over the ice1119 !! qns_tot, qsr_tot non-solar and solar total heat fluxes 1120 !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice 1121 !! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 1122 !! emp_ice ice sublimation - solid precipitation over the ice 1123 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1085 1124 !! sprecip solid precipitation over the ocean 1086 1125 !!---------------------------------------------------------------------- 1087 1126 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 1088 USE wrk_nemo, ONLY: zcptn => wrk_2d_1 ! rcp * tn(:,:,1) 1089 USE wrk_nemo, ONLY: ztmp => wrk_2d_2 ! temporary array 1090 USE wrk_nemo, ONLY: zsnow => wrk_2d_3 ! snow precipitation 1091 USE wrk_nemo, ONLY: zicefr => wrk_3d_4 ! ice fraction 1092 !! 1093 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p_frld ! lead fraction [0 to 1] 1094 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqns_tot ! total non solar heat flux [W/m2] 1095 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqns_ice ! ice non solar heat flux [W/m2] 1096 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqsr_tot ! total solar heat flux [W/m2] 1097 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqsr_ice ! ice solar heat flux [W/m2] 1098 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_tot ! total freshwater budget [Kg/m2/s] 1099 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_ice ! solid freshwater budget over ice [Kg/m2/s] 1100 REAL(wp), INTENT( out), DIMENSION(:,: ) :: psprecip ! Net solid precipitation (=emp_ice) [Kg/m2/s] 1101 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice 1127 USE wrk_nemo, ONLY: zcptn => wrk_2d_2 ! rcp * tn(:,:,1) 1128 USE wrk_nemo, ONLY: ztmp => wrk_2d_3 ! temporary array 1129 USE wrk_nemo, ONLY: zicefr => wrk_2d_4 ! ice fraction 1130 !! 1131 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1102 1132 ! optional arguments, used only in 'mixed oce-ice' case 1103 1133 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo 1104 1134 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius] 1105 1135 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1106 !! 1107 INTEGER :: ji, jj ! dummy loop indices 1108 INTEGER :: isec, info ! temporary integer 1109 REAL(wp):: zcoef, ztsurf ! temporary scalar 1136 ! 1137 INTEGER :: jl ! dummy loop index 1110 1138 !!---------------------------------------------------------------------- 1111 1139 1112 IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3,4) ) THEN1140 IF( wrk_in_use(2, 2,3,4) ) THEN 1113 1141 CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable') ; RETURN 1114 1142 ENDIF 1115 1143 1116 zicefr(:,: ,1) = 1.- p_frld(:,:,1)1117 IF( lk_diaar5 ) zcptn(:,:) = rcp * t n(:,:,1)1144 zicefr(:,:) = 1.- p_frld(:,:) 1145 IF( lk_diaar5 ) zcptn(:,:) = rcp * tsn(:,:,1,1) 1118 1146 ! 1119 1147 ! ! ========================= ! … … 1124 1152 ! ! solid precipitation - sublimation (emp_ice) 1125 1153 ! ! solid Precipitation (sprecip) 1126 SELECT CASE( TRIM( cn_rcv_emp) )1154 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1127 1155 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1128 pemp_tot(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_rain) - frcv(:,:,jpr_snow) 1129 pemp_ice(:,:) = frcv(:,:,jpr_ievp) - frcv(:,:,jpr_snow) 1130 zsnow (:,:) = frcv(:,:,jpr_snow) 1131 CALL iom_put( 'rain' , frcv(:,:,jpr_rain) ) ! liquid precipitation 1132 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(:,:,jpr_rain) * zcptn(:,:) ) ! heat flux from liq. precip. 1133 ztmp(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_ievp) * zicefr(:,:,1) 1156 sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1157 tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 1158 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 1159 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1160 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1161 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1162 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1134 1163 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1135 1164 IF( lk_diaar5 ) CALL iom_put( 'hflx_evap_cea', ztmp(:,: ) * zcptn(:,:) ) ! heat flux from from evap (cell ave) 1136 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp 1137 pemp_tot(:,:) = p_frld(:,:,1) * frcv(:,:,jpr_oemp) + zicefr(:,:,1) * frcv(:,:,jpr_sbpr)1138 pemp_ice(:,:) = frcv(:,:,jpr_semp)1139 zsnow (:,:) = - frcv(:,:,jpr_semp) + frcv(:,:,jpr_ievp)1165 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1166 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1167 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1168 sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 1140 1169 END SELECT 1141 psprecip(:,:) = - pemp_ice(:,:) 1142 CALL iom_put( 'snowpre' , zsnow) ! Snow1143 CALL iom_put( 'snow_ao_cea', zsnow(:,: ) * p_frld(:,:,1)) ! Snow over ice-free ocean (cell average)1144 CALL iom_put( 'snow_ai_cea', zsnow(:,: ) * zicefr(:,:,1)) ! Snow over sea-ice (cell average)1145 CALL iom_put( 'subl_ai_cea', frcv (:,:,jpr_ievp) * zicefr(:,:,1) ) ! Sublimation over sea-ice (cell average)1170 1171 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1172 CALL iom_put( 'snow_ao_cea', sprecip(:,: ) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1173 CALL iom_put( 'snow_ai_cea', sprecip(:,: ) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1174 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1146 1175 ! 1147 1176 ! ! runoffs and calving (put in emp_tot) 1148 1177 IF( srcv(jpr_rnf)%laction ) THEN 1149 pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf)1150 CALL iom_put( 'runoffs' , frcv( :,:,jpr_rnf) ) ! rivers1151 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv( :,:,jpr_rnf) * zcptn(:,:) ) ! heat flux from rivers1178 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 1179 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1180 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1152 1181 ENDIF 1153 1182 IF( srcv(jpr_cal)%laction ) THEN 1154 pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_cal)1155 CALL iom_put( 'calving', frcv( :,:,jpr_cal) )1183 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1184 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 1156 1185 ENDIF 1157 1186 ! … … 1159 1188 !!gm at least should be optional... 1160 1189 !! ! remove negative runoff ! sum over the global domain 1161 !! zcumulpos = SUM( MAX( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1162 !! zcumulneg = SUM( MIN( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1190 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1191 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1163 1192 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) 1164 1193 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 1165 1194 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 1166 1195 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 1167 !! frcv( :,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg1196 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 1168 1197 !! ENDIF 1169 !! pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf) ! add runoff to e-p1198 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p 1170 1199 !! 1171 1200 !!gm end of internal cooking 1172 1201 1173 1174 1202 ! ! ========================= ! 1175 SELECT CASE( TRIM( cn_rcv_qns ) )! non solar heat fluxes ! (qns)1203 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1176 1204 ! ! ========================= ! 1205 CASE( 'oce only' ) ! the required field is directly provided 1206 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1) 1177 1207 CASE( 'conservative' ) ! the required fields are directly provided 1178 pqns_tot(:,: ) = frcv(:,:,jpr_qnsmix) 1179 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsice) 1208 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1209 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1210 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1211 ELSE 1212 ! Set all category values equal for the moment 1213 DO jl=1,jpl 1214 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1215 ENDDO 1216 ENDIF 1180 1217 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1181 pqns_tot(:,: ) = p_frld(:,:,1) * frcv(:,:,jpr_qnsoce) + zicefr(:,:,1) * frcv(:,:,jpr_qnsice) 1182 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsice) 1218 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1219 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1220 DO jl=1,jpl 1221 qns_tot(:,: ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1222 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 1223 ENDDO 1224 ELSE 1225 DO jl=1,jpl 1226 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1227 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1228 ENDDO 1229 ENDIF 1183 1230 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1184 pqns_tot(:,: ) = frcv(:,:,jpr_qnsmix) 1185 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsmix) & 1186 & + frcv(:,:,jpr_dqnsdt) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:,1) & 1187 & + pist(:,:,1) * zicefr(:,:,1) ) ) 1231 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1232 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1233 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1234 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1235 & + pist(:,:,1) * zicefr(:,:) ) ) 1188 1236 END SELECT 1189 ztmp(:,:) = p_frld(:,: ,1) * zsnow(:,:) * lfus ! add the latent heat of solid precip. melting1190 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)! over free ocean1191 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)1237 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus ! add the latent heat of solid precip. melting 1238 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) ! over free ocean 1239 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1192 1240 !!gm 1193 1241 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in … … 1199 1247 ! 1200 1248 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1201 ztmp(:,:) = frcv( :,:,jpr_cal) * lfus! add the latent heat of iceberg melting1202 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)1203 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv( :,:,jpr_cal) * zcptn(:,:) ) ! heat flux from calving1249 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1250 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 1251 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1204 1252 ENDIF 1205 1253 1206 1254 ! ! ========================= ! 1207 SELECT CASE( TRIM( cn_rcv_qsr ) )! solar heat fluxes ! (qsr)1255 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) 1208 1256 ! ! ========================= ! 1257 CASE( 'oce only' ) 1258 qsr_tot(:,: ) = MAX(0.0,frcv(jpr_qsroce)%z3(:,:,1)) 1209 1259 CASE( 'conservative' ) 1210 pqsr_tot(:,: ) = frcv(:,:,jpr_qsrmix) 1211 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrice) 1260 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1261 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1262 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1263 ELSE 1264 ! Set all category values equal for the moment 1265 DO jl=1,jpl 1266 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1267 ENDDO 1268 ENDIF 1269 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1270 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1212 1271 CASE( 'oce and ice' ) 1213 pqsr_tot(:,: ) = p_frld(:,:,1) * frcv(:,:,jpr_qsroce) + zicefr(:,:,1) * frcv(:,:,jpr_qsrice) 1214 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrice) 1272 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1273 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1274 DO jl=1,jpl 1275 qsr_tot(:,: ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1276 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1277 ENDDO 1278 ELSE 1279 DO jl=1,jpl 1280 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1281 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1282 ENDDO 1283 ENDIF 1215 1284 CASE( 'mixed oce-ice' ) 1216 pqsr_tot(:,: ) = frcv(:,:,jpr_qsrmix) 1285 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1286 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1217 1287 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1218 1288 ! ( see OASIS3 user guide, 5th edition, p39 ) 1219 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrmix) * ( 1.- palbi(:,:,1) ) &1220 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,: ,1)&1221 & + palbi (:,:,1) * zicefr(:,: ,1) ) )1289 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1290 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1291 & + palbi (:,:,1) * zicefr(:,:) ) ) 1222 1292 END SELECT 1223 1293 IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle 1224 pqsr_tot(:,: ) = sbc_dcy( pqsr_tot(:,: ) ) 1225 pqsr_ice(:,:,1) = sbc_dcy( pqsr_ice(:,:,1) ) 1226 ENDIF 1227 1228 SELECT CASE( TRIM( cn_rcv_dqnsdt ) ) 1294 qsr_tot(:,: ) = sbc_dcy( qsr_tot(:,: ) ) 1295 DO jl=1,jpl 1296 qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 1297 ENDDO 1298 ENDIF 1299 1300 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 1229 1301 CASE ('coupled') 1230 pdqns_ice(:,:,1) = frcv(:,:,jpr_dqnsdt) 1302 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1303 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1304 ELSE 1305 ! Set all category values equal for the moment 1306 DO jl=1,jpl 1307 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 1308 ENDDO 1309 ENDIF 1231 1310 END SELECT 1232 1311 1233 IF( wrk_not_released(2, 1,2,3) .OR. & 1234 wrk_not_released(3, 4) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 1312 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 1313 CASE ('coupled') 1314 topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 1315 botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:) 1316 END SELECT 1317 1318 IF( wrk_not_released(2, 2,3,4) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 1235 1319 ! 1236 1320 END SUBROUTINE sbc_cpl_ice_flx … … 1249 1333 USE wrk_nemo, ONLY: zfr_l => wrk_2d_1 ! 1. - fr_i(:,:) 1250 1334 USE wrk_nemo, ONLY: ztmp1 => wrk_2d_2 , ztmp2 => wrk_2d_3 1335 USE wrk_nemo, ONLY: ztmp3 => wrk_3d_1 , ztmp4 => wrk_3d_2 1251 1336 USE wrk_nemo, ONLY: zotx1 => wrk_2d_4 , zoty1 => wrk_2d_5 , zotz1 => wrk_2d_6 1252 1337 USE wrk_nemo, ONLY: zitx1 => wrk_2d_7 , zity1 => wrk_2d_8 , zitz1 => wrk_2d_9 … … 1254 1339 INTEGER, INTENT(in) :: kt 1255 1340 ! 1256 INTEGER :: ji, jj 1341 INTEGER :: ji, jj, jl ! dummy loop indices 1257 1342 INTEGER :: isec, info ! local integer 1258 1343 !!---------------------------------------------------------------------- 1259 1344 1260 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) ) THEN1345 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) .OR. wrk_in_use(3, 1,2) ) THEN 1261 1346 CALL ctl_stop('sbc_cpl_snd: requested workspace arrays are unavailable') ; RETURN 1262 1347 ENDIF … … 1269 1354 ! ! Surface temperature ! in Kelvin 1270 1355 ! ! ------------------------- ! 1271 SELECT CASE( cn_snd_temperature) 1272 CASE( 'oce only' ) ; ztmp1(:,:) = tn(:,:,1) + rt0 1273 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) 1274 ztmp2(:,:) = tn_ice(:,:,1) * fr_i(:,:) 1275 CASE( 'mixed oce-ice' ) ; ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:) 1276 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of cn_snd_temperature' ) 1356 SELECT CASE( sn_snd_temp%cldes) 1357 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,1) + rt0 1358 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:) 1359 SELECT CASE( sn_snd_temp%clcat ) 1360 CASE( 'yes' ) 1361 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1362 CASE( 'no' ) 1363 ztmp3(:,:,:) = 0.0 1364 DO jl=1,jpl 1365 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1366 ENDDO 1367 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1368 END SELECT 1369 CASE( 'mixed oce-ice' ) 1370 ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:) 1371 DO jl=1,jpl 1372 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1373 ENDDO 1374 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1277 1375 END SELECT 1278 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, ztmp1, info )1279 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp 2, info )1280 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, ztmp1, info )1376 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1377 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 1378 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1281 1379 ! 1282 1380 ! ! ------------------------- ! … … 1284 1382 ! ! ------------------------- ! 1285 1383 IF( ssnd(jps_albice)%laction ) THEN ! ice 1286 ztmp 1(:,:) = alb_ice(:,:,1) * fr_i(:,:)1287 CALL cpl_prism_snd( jps_albice, isec, ztmp 1, info )1384 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1385 CALL cpl_prism_snd( jps_albice, isec, ztmp3, info ) 1288 1386 ENDIF 1289 1387 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 1290 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) + alb_ice(:,:,1) * fr_i(:,:) 1291 CALL cpl_prism_snd( jps_albmix, isec, ztmp1, info ) 1388 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) 1389 DO jl=1,jpl 1390 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 1391 ENDDO 1392 CALL cpl_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1292 1393 ENDIF 1293 1394 ! ! ------------------------- ! 1294 1395 ! ! Ice fraction & Thickness ! 1295 1396 ! ! ------------------------- ! 1296 IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, fr_i , info ) 1297 IF( ssnd(jps_hice)%laction ) CALL cpl_prism_snd( jps_hice, isec, hicif(:,:) * fr_i(:,:), info ) 1298 IF( ssnd(jps_hsnw)%laction ) CALL cpl_prism_snd( jps_hsnw, isec, hsnif(:,:) * fr_i(:,:), info ) 1397 ! Send ice fraction field 1398 SELECT CASE( sn_snd_thick%clcat ) 1399 CASE( 'yes' ) 1400 ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 1401 CASE( 'no' ) 1402 ztmp3(:,:,1) = fr_i(:,:) 1403 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1404 END SELECT 1405 IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 1406 1407 ! Send ice and snow thickness field 1408 SELECT CASE( sn_snd_thick%cldes) 1409 CASE( 'weighted ice and snow' ) 1410 SELECT CASE( sn_snd_thick%clcat ) 1411 CASE( 'yes' ) 1412 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) * a_i(:,:,1:jpl) 1413 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 1414 CASE( 'no' ) 1415 ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0 1416 DO jl=1,jpl 1417 ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 1418 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl) 1419 ENDDO 1420 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1421 END SELECT 1422 CASE( 'ice and snow' ) 1423 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1424 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1425 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1426 END SELECT 1427 IF( ssnd(jps_hice)%laction ) CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 1428 IF( ssnd(jps_hsnw)%laction ) CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 1299 1429 ! 1300 1430 #if defined key_cpl_carbon_cycle … … 1302 1432 ! ! CO2 flux from PISCES ! 1303 1433 ! ! ------------------------- ! 1304 IF( ssnd(jps_co2)%laction ) CALL cpl_prism_snd( jps_co2, isec, oce_co2, info )1434 IF( ssnd(jps_co2)%laction ) CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1305 1435 ! 1306 1436 #endif 1437 ! ! ------------------------- ! 1307 1438 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current ! 1308 1439 ! ! ------------------------- ! … … 1316 1447 ! i-1 i i 1317 1448 ! i i+1 (for I) 1318 SELECT CASE( TRIM( cn_snd_crt(1)) )1449 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1319 1450 CASE( 'oce only' ) ! C-grid ==> T 1320 1451 DO jj = 2, jpjm1 … … 1394 1525 END SELECT 1395 1526 END SELECT 1396 CALL lbc_lnk( zotx1, 'T', -1. ) ; CALL lbc_lnk( zoty1, 'T', -1. )1527 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1397 1528 ! 1398 1529 ! 1399 IF( TRIM( cn_snd_crt(3)) == 'eastward-northward' ) THEN ! Rotation of the components1530 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 1400 1531 ! ! Ocean component 1401 1532 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component … … 1412 1543 ! 1413 1544 ! spherical coordinates to cartesian -> 2 components to 3 components 1414 IF( TRIM( cn_snd_crt(2)) == 'cartesian' ) THEN1545 IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN 1415 1546 ztmp1(:,:) = zotx1(:,:) ! ocean currents 1416 1547 ztmp2(:,:) = zoty1(:,:) … … 1424 1555 ENDIF 1425 1556 ! 1426 IF( ssnd(jps_ocx1)%laction ) CALL cpl_prism_snd( jps_ocx1, isec, zotx1, info ) ! ocean x current 1st grid1427 IF( ssnd(jps_ocy1)%laction ) CALL cpl_prism_snd( jps_ocy1, isec, zoty1, info ) ! ocean y current 1st grid1428 IF( ssnd(jps_ocz1)%laction ) CALL cpl_prism_snd( jps_ocz1, isec, zotz1, info ) ! ocean z current 1st grid1557 IF( ssnd(jps_ocx1)%laction ) CALL cpl_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 1558 IF( ssnd(jps_ocy1)%laction ) CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 1559 IF( ssnd(jps_ocz1)%laction ) CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid 1429 1560 ! 1430 IF( ssnd(jps_ivx1)%laction ) CALL cpl_prism_snd( jps_ivx1, isec, zitx1, info ) ! ice x current 1st grid1431 IF( ssnd(jps_ivy1)%laction ) CALL cpl_prism_snd( jps_ivy1, isec, zity1, info ) ! ice y current 1st grid1432 IF( ssnd(jps_ivz1)%laction ) CALL cpl_prism_snd( jps_ivz1, isec, zitz1, info ) ! ice z current 1st grid1561 IF( ssnd(jps_ivx1)%laction ) CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid 1562 IF( ssnd(jps_ivy1)%laction ) CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid 1563 IF( ssnd(jps_ivz1)%laction ) CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid 1433 1564 ! 1434 1565 ENDIF 1435 1566 ! 1436 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) ) CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays')1567 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) .OR. wrk_not_released(3, 1,2) ) CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays') 1437 1568 ! 1438 1569 END SUBROUTINE sbc_cpl_snd … … 1459 1590 END SUBROUTINE sbc_cpl_ice_tau 1460 1591 ! 1461 SUBROUTINE sbc_cpl_ice_flx( p_frld , & 1462 & pqns_tot, pqns_ice, pqsr_tot , pqsr_ice, & 1463 & pemp_tot, pemp_ice, pdqns_ice, psprecip, & 1464 & palbi , psst , pist ) 1465 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p_frld ! lead fraction [0 to 1] 1466 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqns_tot ! total non solar heat flux [W/m2] 1467 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqns_ice ! ice non solar heat flux [W/m2] 1468 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqsr_tot ! total solar heat flux [W/m2] 1469 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqsr_ice ! ice solar heat flux [W/m2] 1470 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_tot ! total freshwater budget [Kg/m2/s] 1471 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_ice ! ice solid freshwater budget [Kg/m2/s] 1472 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice 1473 REAL(wp), INTENT( out), DIMENSION(:,: ) :: psprecip ! solid precipitation [Kg/m2/s] 1592 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist ) 1593 REAL(wp), INTENT(in ), DIMENSION(:,: ) :: p_frld ! lead fraction [0 to 1] 1474 1594 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo 1475 1595 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius] 1476 1596 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1477 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1,1), palbi(1,1,1), psst(1,1), pist(1,1,1) 1478 ! stupid definition to avoid warning message when compiling... 1479 pqns_tot(:,:) = 0. ; pqns_ice(:,:,:) = 0. ; pdqns_ice(:,:,:) = 0. 1480 pqsr_tot(:,:) = 0. ; pqsr_ice(:,:,:) = 0. 1481 pemp_tot(:,:) = 0. ; pemp_ice(:,:) = 0. ; psprecip(:,:) = 0. 1597 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1) 1482 1598 END SUBROUTINE sbc_cpl_ice_flx 1483 1599 -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r2715 r3094 16 16 USE eosbn2 ! equation of state 17 17 USE sbc_oce ! surface boundary condition: ocean fields 18 USE sbccpl 18 19 USE fldread ! read input field 19 20 USE iom ! I/O manager library … … 97 98 98 99 fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius] 100 #if defined key_coupled 101 a_i(:,:,1) = fr_i(:,:) 102 #endif 99 103 100 104 ! Flux and ice fraction computation -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r2715 r3094 202 202 #if defined key_coupled 203 203 ! ! Ice surface fluxes in coupled mode 204 IF( ksbc == 5 ) CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ), &205 & qns_tot, qns_ice, qsr_tot , qsr_ice, &206 & emp_tot, emp_ice, dqns_ice, sprecip,&204 IF( ksbc == 5 ) THEN 205 a_i(:,:,1)=fr_i 206 CALL sbc_cpl_ice_flx( frld, & 207 207 ! optional arguments, used only in 'mixed oce-ice' case 208 208 & palbi = zalb_ice_cs, psst = sst_m, pist = zsist ) 209 sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 210 ENDIF 209 211 #endif 210 212 CALL lim_thd_2 ( kt ) ! Ice thermodynamics -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r2715 r3094 11 11 !! - ! 2010-11 (G. Madec) ice-ocean stress always computed at each ocean time-step 12 12 !! - ! 2010-10 (J. Chanut, C. Bricaud, G. Madec) add the surface pressure forcing 13 !! 3.4 ! 2011-11 (C. Harris) CICE added as an option 13 14 !!---------------------------------------------------------------------- 14 15 … … 32 33 USE sbcice_lim ! surface boundary condition: LIM 3.0 sea-ice model 33 34 USE sbcice_lim_2 ! surface boundary condition: LIM 2.0 sea-ice model 35 USE sbcice_cice ! surface boundary condition: CICE sea-ice model 34 36 USE sbccpl ! surface boundary condition: coupled florulation 35 37 USE cpl_oasis3, ONLY:lk_cpl ! are we in coupled mode? … … 38 40 USE sbcfwb ! surface boundary condition: freshwater budget 39 41 USE closea ! closed sea 40 USE bdy_par ! unstructured open boundary data variables41 USE bdyice ! unstructured open boundary data (bdy_ice_frsroutine)42 USE bdy_par ! for lk_bdy 43 USE bdyice_lim2 ! unstructured open boundary data (bdy_ice_lim_2 routine) 42 44 43 45 USE prtctl ! Print control (prt_ctl routine) … … 94 96 IF( lk_lim2 ) nn_ice = 2 95 97 IF( lk_lim3 ) nn_ice = 3 98 IF( lk_cice ) nn_ice = 4 96 99 ENDIF 97 100 IF( cp_cfg == 'gyre' ) THEN ! GYRE configuration … … 144 147 & CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 145 148 ! 146 IF( nn_ice == 2 .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) ) & 147 & CALL ctl_stop( 'sea-ice model requires a bulk formulation or coupled configuration' ) 149 IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) ) & 150 & CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 151 IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) ) & 152 & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 153 IF( nn_ice == 4 .AND. ( .NOT. ( cp_cfg == 'orca' ) .OR. lk_agrif ) ) & 154 & CALL ctl_stop( 'CICE sea-ice model currently only available in a global ORCA configuration without AGRIF' ) 148 155 149 156 IF( ln_dm2dc ) nday_qsr = -1 ! initialisation flag … … 182 189 IF( nsbc == 5 ) WRITE(numout,*) ' coupled formulation' 183 190 ENDIF 191 192 IF( nn_ice == 4 ) CALL cice_sbc_init (nsbc) 184 193 ! 185 194 END SUBROUTINE sbc_init … … 253 262 ! 254 263 CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model 255 IF( lk_bdy ) CALL bdy_ice_ frs( kt ) ! BDY boundary condition264 IF( lk_bdy ) CALL bdy_ice_lim_2( kt ) ! BDY boundary condition 256 265 ! 257 266 CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model 267 ! 268 CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 258 269 END SELECT 259 270 … … 338 349 & tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask, ovlap=1 ) 339 350 ENDIF 351 352 IF( kt == nitend ) CALL sbc_final ! Close down surface module if necessary 340 353 ! 341 354 END SUBROUTINE sbc 355 356 SUBROUTINE sbc_final 357 !!--------------------------------------------------------------------- 358 !! *** ROUTINE sbc_final *** 359 !!--------------------------------------------------------------------- 360 361 !----------------------------------------------------------------- 362 ! Finalize CICE (if used) 363 !----------------------------------------------------------------- 364 365 IF( nn_ice == 4 ) CALL cice_sbc_final 366 ! 367 END SUBROUTINE sbc_final 342 368 343 369 !!====================================================================== -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
r2715 r3094 23 23 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 24 24 USE solmat ! matrix of the solver 25 USE obc_oce ! Lateral open boundary condition26 25 USE in_out_manager ! I/O manager 27 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r2715 r3094 93 93 ! 94 94 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & 95 & CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' )! add the eiv transport (if necessary)95 & CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary) 96 96 ! 97 97 CALL iom_put( "uocetr_eff", zun ) ! output effective transport … … 100 100 101 101 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 102 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered103 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD104 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL105 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2106 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS107 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST102 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 103 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 104 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL 105 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 106 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 107 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 108 108 ! 109 109 CASE (-1 ) !== esopa: test all possibility with control print ==! 110 CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )110 CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 111 111 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, & 112 112 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 113 CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )113 CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 114 114 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 115 115 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 116 CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts )116 CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) 117 117 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 118 118 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 119 CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )119 CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 120 120 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, & 121 121 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 122 CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )122 CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 123 123 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, & 124 124 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 125 CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )125 CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 126 126 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 127 127 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r2715 r3094 53 53 CONTAINS 54 54 55 SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn,&55 SUBROUTINE tra_adv_cen2( kt, kit000, cdtype, pun, pvn, pwn, & 56 56 & ptb, ptn, pta, kjpt ) 57 57 !!---------------------------------------------------------------------- … … 116 116 ! 117 117 INTEGER , INTENT(in ) :: kt ! ocean time-step index 118 INTEGER , INTENT(in ) :: kit000 ! first time step index 118 119 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 119 120 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 131 132 !!---------------------------------------------------------------------- 132 133 133 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN134 IF( wrk_in_use(2, 35) .OR. wrk_in_use(3, 14,15) ) THEN 134 135 CALL ctl_stop('tra_adv_cen2: requested workspace arrays unavailable') ; RETURN 135 136 ENDIF 136 137 137 IF( kt == nit000 ) THEN138 IF( kt == kit000 ) THEN 138 139 IF(lwp) WRITE(numout,*) 139 140 IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme on ', cdtype … … 141 142 IF(lwp) WRITE(numout,*) 142 143 ! 143 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 144 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') 144 IF (.not. ALLOCATED(upsmsk))THEN 145 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 146 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') 147 ENDIF 148 145 149 ! 146 150 upsmsk(:,:) = 0._wp ! not upstream by default … … 275 279 ENDIF 276 280 ! 277 IF( wrk_not_released(2, 1) .OR. &278 wrk_not_released(3, 1 ,2) ) CALL ctl_stop('tra_adv_cen2: failed to release workspace arrays')281 IF( wrk_not_released(2, 35) .OR. & 282 wrk_not_released(3, 14,15) ) CALL ctl_stop('tra_adv_cen2: failed to release workspace arrays') 279 283 ! 280 284 END SUBROUTINE tra_adv_cen2 -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r2715 r3094 45 45 CONTAINS 46 46 47 SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype )47 SUBROUTINE tra_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype ) 48 48 !!---------------------------------------------------------------------- 49 49 !! *** ROUTINE tra_adv_eiv *** … … 69 69 #endif 70 70 INTEGER , INTENT(in ) :: kt ! ocean time-step index 71 INTEGER , INTENT(in ) :: kit000 ! first time step index 71 72 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 72 73 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pun ! in : 3 ocean velocity components … … 90 91 ENDIF 91 92 92 IF( kt == nit000 ) THEN93 IF( kt == kit000 ) THEN 93 94 IF(lwp) WRITE(numout,*) 94 95 IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection on ', cdtype,' :' … … 203 204 !!---------------------------------------------------------------------- 204 205 CONTAINS 205 SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype ) ! Empty routine206 SUBROUTINE tra_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype ) ! Empty routine 206 207 INTEGER :: kt 208 INTEGER :: kit000 207 209 CHARACTER(len=3) :: cdtype 208 210 REAL, DIMENSION(:,:,:) :: pun, pvn, pwn -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r2715 r3094 44 44 CONTAINS 45 45 46 SUBROUTINE tra_adv_muscl( kt, cdtype, p2dt, pun, pvn, pwn, &46 SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 47 47 & ptb, pta, kjpt ) 48 48 !!---------------------------------------------------------------------- … … 66 66 ! 67 67 INTEGER , INTENT(in ) :: kt ! ocean time-step index 68 INTEGER , INTENT(in ) :: kit000 ! first time step index 68 69 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 69 70 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 83 84 ENDIF 84 85 85 IF( kt == nit000 ) THEN86 IF( kt == kit000 ) THEN 86 87 IF(lwp) WRITE(numout,*) 87 88 IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r2715 r3094 42 42 CONTAINS 43 43 44 SUBROUTINE tra_adv_muscl2( kt, cdtype, p2dt, pun, pvn, pwn, &44 SUBROUTINE tra_adv_muscl2( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 45 45 & ptb, ptn, pta, kjpt ) 46 46 !!---------------------------------------------------------------------- … … 64 64 !! 65 65 INTEGER , INTENT(in ) :: kt ! ocean time-step index 66 INTEGER , INTENT(in ) :: kit000 ! first time step index 66 67 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 67 68 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 81 82 ENDIF 82 83 83 IF( kt == nit000 ) THEN84 IF( kt == kit000 ) THEN 84 85 IF(lwp) WRITE(numout,*) 85 86 IF(lwp) WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme on ', cdtype -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r2715 r3094 45 45 CONTAINS 46 46 47 SUBROUTINE tra_adv_qck ( kt, cdtype, p2dt, pun, pvn, pwn, &47 SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 48 48 & ptb, ptn, pta, kjpt ) 49 49 !!---------------------------------------------------------------------- … … 82 82 !!---------------------------------------------------------------------- 83 83 INTEGER , INTENT(in ) :: kt ! ocean time-step index 84 INTEGER , INTENT(in ) :: kit000 ! first time step index 84 85 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 85 86 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 90 91 !!---------------------------------------------------------------------- 91 92 92 IF( kt == nit000 ) THEN93 IF( kt == kit000 ) THEN 93 94 IF(lwp) WRITE(numout,*) 94 95 IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r2715 r3094 51 51 CONTAINS 52 52 53 SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn, &53 SUBROUTINE tra_adv_tvd ( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 54 54 & ptb, ptn, pta, kjpt ) 55 55 !!---------------------------------------------------------------------- … … 71 71 ! 72 72 INTEGER , INTENT(in ) :: kt ! ocean time-step index 73 INTEGER , INTENT(in ) :: kit000 ! first time step index 73 74 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 74 75 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 89 90 ENDIF 90 91 91 IF( kt == nit000 ) THEN92 IF( kt == kit000 ) THEN 92 93 IF(lwp) WRITE(numout,*) 93 94 IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r2715 r3094 40 40 CONTAINS 41 41 42 SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn, &42 SUBROUTINE tra_adv_ubs ( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 43 43 & ptb, ptn, pta, kjpt ) 44 44 !!---------------------------------------------------------------------- … … 80 80 ! 81 81 INTEGER , INTENT(in ) :: kt ! ocean time-step index 82 INTEGER , INTENT(in ) :: kit000 ! first time step index 82 83 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 83 84 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 97 98 ENDIF 98 99 99 IF( kt == nit000 ) THEN100 IF( kt == kit000 ) THEN 100 101 IF(lwp) WRITE(numout,*) 101 102 IF(lwp) WRITE(numout,*) 'tra_adv_ubs : horizontal UBS advection scheme on ', cdtype -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r2715 r3094 106 106 !!---------------------------------------------------------------------- 107 107 108 IF( l_trdtra ) THEN !* Save ta and sa trends108 IF( l_trdtra ) THEN !* Save ta and sa trends 109 109 ALLOCATE( ztrdt(jpi,jpj,jpk) ) ; ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 110 110 ALLOCATE( ztrds(jpi,jpj,jpk) ) ; ztrds(:,:,:) = tsa(:,:,:,jp_sal) 111 111 ENDIF 112 112 113 IF( l_bbl ) CALL bbl( kt, 'TRA' )!* bbl coef. and transport (only if not already done in trcbbl)114 115 116 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl113 IF( l_bbl ) CALL bbl( kt, nit000, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl) 114 115 116 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl 117 117 CALL tra_bbl_dif( tsb, tsa, jpts ) 118 118 IF( ln_ctl ) & … … 311 311 312 312 313 SUBROUTINE bbl( kt, cdtype )313 SUBROUTINE bbl( kt, kit000, cdtype ) 314 314 !!---------------------------------------------------------------------- 315 315 !! *** ROUTINE bbl *** … … 343 343 ! 344 344 INTEGER , INTENT(in ) :: kt ! ocean time-step index 345 INTEGER , INTENT(in ) :: kit000 ! first time step index 345 346 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 346 347 !! … … 389 390 ENDIF 390 391 391 IF( kt == nit000 ) THEN392 IF( kt == kit000 ) THEN 392 393 IF(lwp) WRITE(numout,*) 393 394 IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype … … 537 538 !! 538 539 !! ** Method : Read the nambbl namelist and check the parameters 539 !! called by nemo_init at the first timestep ( nit000)540 !! called by nemo_init at the first timestep (kit000) 540 541 !!---------------------------------------------------------------------- 541 542 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r2715 r3094 68 68 69 69 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 70 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level laplacian70 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level laplacian 71 71 CASE ( 1 ) ! rotated laplacian 72 72 IF( ln_traldf_grif ) THEN 73 CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Griffies operator73 CALL tra_ldf_iso_grif( kt, nit000,'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Griffies operator 74 74 ELSE 75 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Madec operator76 ENDIF 77 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level bilaplacian78 CASE ( 3 ) ; CALL tra_ldf_bilapg ( kt, 'TRA', tsb, tsa, jpts ) ! s-coord. geopot. bilap.75 CALL tra_ldf_iso ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Madec operator 76 ENDIF 77 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level bilaplacian 78 CASE ( 3 ) ; CALL tra_ldf_bilapg ( kt, nit000, 'TRA', tsb, tsa, jpts ) ! s-coord. geopot. bilap. 79 79 ! 80 80 CASE ( -1 ) ! esopa: test all possibility with control print 81 CALL tra_ldf_lap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts )81 CALL tra_ldf_lap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) 82 82 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask, & 83 83 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 84 84 IF( ln_traldf_grif ) THEN 85 CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )85 CALL tra_ldf_iso_grif( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 86 86 ELSE 87 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )87 CALL tra_ldf_iso ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 88 88 ENDIF 89 89 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask, & 90 90 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 91 CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts )91 CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) 92 92 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask, & 93 93 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 94 CALL tra_ldf_bilapg( kt, 'TRA', tsb, tsa, jpts )94 CALL tra_ldf_bilapg( kt, nit000, 'TRA', tsb, tsa, jpts ) 95 95 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask, & 96 96 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 297 297 ! Compute the ldf trends 298 298 ! ---------------------- 299 CALL tra_ldf( nit000 +1 ) ! horizontal components (+1: no more init)300 CALL tra_zdf( nit000 ) ! vertical component (if necessary nit000 to performed the init)299 CALL tra_ldf( nit000 + 1 ) ! horizontal components (+1: no more init) 300 CALL tra_zdf( nit000 ) ! vertical component (if necessary nit000 to performed the init) 301 301 302 302 ! finalise the computation and recover all arrays -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r2715 r3094 47 47 CONTAINS 48 48 49 SUBROUTINE tra_ldf_bilap( kt, cdtype, pgu, pgv, &49 SUBROUTINE tra_ldf_bilap( kt, kit000, cdtype, pgu, pgv, & 50 50 & ptb, pta, kjpt ) 51 51 !!---------------------------------------------------------------------- … … 79 79 !! 80 80 INTEGER , INTENT(in ) :: kt ! ocean time-step index 81 INTEGER , INTENT(in ) :: kit000 ! first time step index 81 82 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 82 83 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 93 94 ENDIF 94 95 95 IF( kt == nit000 ) THEN96 IF( kt == kit000 ) THEN 96 97 IF(lwp) WRITE(numout,*) 97 98 IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r2715 r3094 42 42 CONTAINS 43 43 44 SUBROUTINE tra_ldf_bilapg( kt, cdtype, ptb, pta, kjpt )44 SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt ) 45 45 !!---------------------------------------------------------------------- 46 46 !! *** ROUTINE tra_ldf_bilapg *** … … 70 70 ! 71 71 INTEGER , INTENT(in ) :: kt ! ocean time-step index 72 INTEGER , INTENT(in ) :: kit000 ! first time step index 72 73 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 73 74 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 82 83 ENDIF 83 84 84 IF( kt == nit000 ) THEN85 IF( kt == kit000 ) THEN 85 86 IF(lwp) WRITE(numout,*) 86 87 IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate on ', cdtype … … 345 346 !!---------------------------------------------------------------------- 346 347 CONTAINS 347 SUBROUTINE tra_ldf_bilapg( kt, cdtype, ptb, pta, kjpt ) ! Empty routine 348 SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt ) ! Empty routine 349 INTEGER :: kt, kit000 348 350 CHARACTER(len=3) :: cdtype 349 351 REAL, DIMENSION(:,:,:,:) :: ptb, pta 350 WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, cdtype, ptb(1,1,1,1), pta(1,1,1,1), kjpt 352 WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', & 353 & kt, kit000, cdtype, ptb(1,1,1,1), pta(1,1,1,1), kjpt 351 354 END SUBROUTINE tra_ldf_bilapg 352 355 #endif -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r2715 r3094 49 49 CONTAINS 50 50 51 SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv, &51 SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv, & 52 52 & ptb, pta, kjpt, pahtb0 ) 53 53 !!---------------------------------------------------------------------- … … 96 96 ! 97 97 INTEGER , INTENT(in ) :: kt ! ocean time-step index 98 INTEGER , INTENT(in ) :: kit000 ! first time step index 98 99 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 99 100 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 116 117 ENDIF 117 118 118 IF( kt == nit000 ) THEN119 IF( kt == kit000 ) THEN 119 120 IF(lwp) WRITE(numout,*) 120 121 IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype … … 301 302 !!---------------------------------------------------------------------- 302 303 CONTAINS 303 SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 ) ! Empty routine 304 SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 ) ! Empty routine 305 INTEGER:: kt, kit000 304 306 CHARACTER(len=3) :: cdtype 305 307 REAL, DIMENSION(:,:,:) :: pgu, pgv ! tracer gradient at pstep levels 306 308 REAL, DIMENSION(:,:,:,:) :: ptb, pta 307 WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, cdtype, pgu(1,1,1), pgv(1,1,1), &308 & 309 WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype, & 310 & pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0 309 311 END SUBROUTINE tra_ldf_iso 310 312 #endif -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r2715 r3094 48 48 CONTAINS 49 49 50 SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv, &50 SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv, & 51 51 & ptb, pta, kjpt, pahtb0 ) 52 52 !!---------------------------------------------------------------------- … … 95 95 ! 96 96 INTEGER , INTENT(in ) :: kt ! ocean time-step index 97 INTEGER , INTENT(in ) :: kit000 ! first time step index 97 98 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 98 99 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 127 128 !zdkt(1:jpi,1:jpj,0:1) => wrk_3d_9(:,:,1:2) 128 129 129 IF( kt == nit000 ) THEN130 IF( kt == kit000 ) THEN 130 131 IF(lwp) WRITE(numout,*) 131 132 IF(lwp) WRITE(numout,*) 'tra_ldf_iso_grif : rotated laplacian diffusion operator on ', cdtype 132 133 IF(lwp) WRITE(numout,*) ' WARNING: STILL UNDER TEST, NOT RECOMMENDED. USE AT YOUR OWN PERIL' 133 134 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 134 ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt(jpi,jpj,0:1), STAT=ierr ) 135 IF (.not. ALLOCATED(ah_wslp2))THEN 136 ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt(jpi,jpj,0:1), STAT=ierr ) 137 ENDIF 135 138 IF( lk_mpp ) CALL mpp_sum ( ierr ) 136 139 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays') 137 140 IF( ln_traldf_gdia ) THEN 138 ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 139 IF( lk_mpp ) CALL mpp_sum ( ierr ) 140 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics') 141 IF (.not. ALLOCATED(psix_eiv))THEN 142 ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 143 IF( lk_mpp ) CALL mpp_sum ( ierr ) 144 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics') 145 ENDIF 141 146 ENDIF 142 147 ENDIF -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r2715 r3094 44 44 CONTAINS 45 45 46 SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv, &46 SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu, pgv, & 47 47 & ptb, pta, kjpt ) 48 48 !!---------------------------------------------------------------------- … … 66 66 ! 67 67 INTEGER , INTENT(in ) :: kt ! ocean time-step index 68 INTEGER , INTENT(in ) :: kit000 ! first time step index 68 69 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 69 70 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 77 78 !!---------------------------------------------------------------------- 78 79 79 IF( kt == nit000 ) THEN80 IF( kt == kit000 ) THEN 80 81 IF(lwp) WRITE(numout,*) 81 82 IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r2715 r3094 36 36 USE obc_oce 37 37 USE obctra ! open boundary condition (obc_tra routine) 38 USE bdy_ par ! Unstructured open boundary condition (bdy_tra_frs routine)39 USE bdytra ! Unstructured open boundary condition (bdy_tra_frsroutine)38 USE bdy_oce 39 USE bdytra ! open boundary condition (bdy_tra routine) 40 40 USE in_out_manager ! I/O manager 41 41 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 43 43 USE traqsr ! penetrative solar radiation (needed for nksr) 44 44 USE traswp ! swap array 45 USE obc_oce46 45 #if defined key_agrif 47 46 USE agrif_opa_update … … 81 80 !! - Apply lateral boundary conditions on (ta,sa) 82 81 !! at the local domain boundaries through lbc_lnk call, 83 !! at the radiative open boundaries (lk_obc=T), 84 !! at the relaxed open boundaries (lk_bdy=T), and 82 !! at the one-way open boundaries (lk_obc=T), 85 83 !! at the AGRIF zoom boundaries (lk_agrif=T) 86 84 !! … … 119 117 #endif 120 118 #if defined key_bdy 121 IF( lk_bdy ) CALL bdy_tra _frs( kt ) ! BDY open boundaries119 IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 122 120 #endif 123 121 #if defined key_agrif … … 148 146 ELSE ! Leap-Frog + Asselin filter time stepping 149 147 ! 150 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, 'TRA', tsb, tsn, tsa, jpts ) ! variable volume level (vvl)151 ELSE ; CALL tra_nxt_fix( kt, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level148 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! variable volume level (vvl) 149 ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level 152 150 ENDIF 153 151 ENDIF … … 179 177 180 178 181 SUBROUTINE tra_nxt_fix( kt, cdtype, ptb, ptn, pta, kjpt )179 SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt ) 182 180 !!---------------------------------------------------------------------- 183 181 !! *** ROUTINE tra_nxt_fix *** … … 203 201 !!---------------------------------------------------------------------- 204 202 INTEGER , INTENT(in ) :: kt ! ocean time-step index 203 INTEGER , INTENT(in ) :: kit000 ! first time step index 205 204 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 206 205 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 214 213 !!---------------------------------------------------------------------- 215 214 216 IF( kt == nit000 ) THEN215 IF( kt == kit000 ) THEN 217 216 IF(lwp) WRITE(numout,*) 218 IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping' 217 IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype 219 218 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 220 219 ENDIF … … 245 244 246 245 247 SUBROUTINE tra_nxt_vvl( kt, cdtype, ptb, ptn, pta, kjpt )246 SUBROUTINE tra_nxt_vvl( kt, kit000, cdtype, ptb, ptn, pta, kjpt ) 248 247 !!---------------------------------------------------------------------- 249 248 !! *** ROUTINE tra_nxt_vvl *** … … 270 269 !!---------------------------------------------------------------------- 271 270 INTEGER , INTENT(in ) :: kt ! ocean time-step index 271 INTEGER , INTENT(in ) :: kit000 ! first time step index 272 272 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 273 273 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 282 282 !!---------------------------------------------------------------------- 283 283 284 IF( kt == nit000 )THEN284 IF( kt == kit000 ) THEN 285 285 IF(lwp) WRITE(numout,*) 286 IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping' 286 IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype 287 287 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 288 288 ENDIF -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r2715 r3094 76 76 77 77 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 78 CASE ( 0 ) ; CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) ! explicit scheme79 CASE ( 1 ) ; CALL tra_zdf_imp( kt, 'TRA', r2dtra, tsb, tsa, jpts ) ! implicit scheme78 CASE ( 0 ) ; CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) ! explicit scheme 79 CASE ( 1 ) ; CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra, tsb, tsa, jpts ) ! implicit scheme 80 80 CASE ( -1 ) ! esopa: test all possibility with control print 81 CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )81 CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) 82 82 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask, & 83 83 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 84 CALL tra_zdf_imp( kt, 'TRA', r2dtra, tsb, tsa, jpts )84 CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra, tsb, tsa, jpts ) 85 85 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask, & 86 86 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
r2715 r3094 48 48 CONTAINS 49 49 50 SUBROUTINE tra_zdf_exp( kt, cdtype, p2dt, kn_zdfexp, &50 SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, kn_zdfexp, & 51 51 & ptb , pta , kjpt ) 52 52 !!---------------------------------------------------------------------- … … 77 77 ! 78 78 INTEGER , INTENT(in ) :: kt ! ocean time-step index 79 INTEGER , INTENT(in ) :: kit000 ! first time step index 79 80 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 80 81 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 93 94 ENDIF 94 95 95 IF( kt == nit000 ) THEN96 IF( kt == kit000 ) THEN 96 97 IF(lwp) WRITE(numout,*) 97 98 IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing on ', cdtype -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r2715 r3094 55 55 CONTAINS 56 56 57 SUBROUTINE tra_zdf_imp( kt, cdtype, p2dt, ptb, pta, kjpt )57 SUBROUTINE tra_zdf_imp( kt, kit000, cdtype, p2dt, ptb, pta, kjpt ) 58 58 !!---------------------------------------------------------------------- 59 59 !! *** ROUTINE tra_zdf_imp *** … … 79 79 ! 80 80 INTEGER , INTENT(in ) :: kt ! ocean time-step index 81 INTEGER , INTENT(in ) :: kit000 ! first time step index 81 82 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 82 83 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 93 94 ENDIF 94 95 95 IF( kt == nit000 ) THEN96 IF( kt == kit000 ) THEN 96 97 IF(lwp)WRITE(numout,*) 97 98 IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r2715 r3094 27 27 !! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 28 28 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 29 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 29 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 30 !! 3.4 ! 2011-11 (C. Harris) decomposition changes for running with CICE 30 31 !!---------------------------------------------------------------------- 31 32 … … 46 47 USE domain ! domain initialization (dom_init routine) 47 48 USE obcini ! open boundary cond. initialization (obc_ini routine) 48 USE bdyini ! unstructured open boundary cond. initialization (bdy_init routine) 49 USE bdyini ! open boundary cond. initialization (bdy_init routine) 50 USE bdydta ! open boundary cond. initialization (bdy_dta_init routine) 51 USE bdytides ! open boundary cond. initialization (tide_init routine) 49 52 USE istate ! initial state setting (istate_init routine) 50 53 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) … … 245 248 IF( Agrif_Root() ) THEN 246 249 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 250 #if defined key_nemocice_decomp 251 jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 252 #else 247 253 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 254 #endif 248 255 jpk = jpkdta ! third dim 249 256 jpim1 = jpi-1 ! inner domain indices … … 295 302 296 303 IF( lk_obc ) CALL obc_init ! Open boundaries 297 IF( lk_bdy ) CALL bdy_init ! Unstructured open boundaries 304 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 305 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays 306 IF( lk_bdy ) CALL tide_init ! Open boundaries initialisation of tidal harmonic forcing 298 307 299 308 CALL istate_init ! ocean initial state (Dynamics and tracers) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/oce.F90
r2715 r3094 35 35 !! free surface ! before ! now ! after ! 36 36 !! ------------ ! fields ! fields ! trends ! 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshb , sshn , ssha !: sea surface height at t-point [m]38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m]39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m]40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshf_n !: sea surface height at f-point [m]37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshb , sshn , ssha !: sea surface height at t-point [m] 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m] 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m] 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshf_n !: sea surface height at f-point [m] 41 41 ! 42 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: spgu, spgv !: horizontal surface pressure gradient -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
r2715 r3094 81 81 !!--------------------------------------------------------------------- 82 82 # include "par_POMME_R025.h90" 83 #elif defined key_amm_12km 84 !!--------------------------------------------------------------------- 85 !! 'key_amm_12km': Atlantic Margin Model : AMM12km 86 !!--------------------------------------------------------------------- 87 # include "par_AMM_12km.h90" 83 88 #else 84 89 !!--------------------------------------------------------------------- -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/step.F90
r2715 r3094 99 99 IF( lk_obc ) CALL obc_dta( kstp ) ! update dynamic and tracer data at open boundaries 100 100 IF( lk_obc ) CALL obc_rad( kstp ) ! compute phase velocities at open boundaries 101 IF( lk_bdy ) CALL bdy_dta _frs( kstp ) ! update dynamic and tracer data for FRS conditions (BDY)101 IF( lk_bdy ) CALL bdy_dta( kstp, time_offset=+1 ) ! update dynamic and tracer data at open boundaries 102 102 103 103 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r2528 r3094 53 53 USE obcrad ! open boundary cond. radiation (obc_rad routine) 54 54 55 USE bdy_par ! unstructured open boundary data variables56 USE bdydta ! unstructured open boundary data(bdy_dta routine)55 USE bdy_par ! for lk_bdy 56 USE bdydta ! open boundary condition data (bdy_dta routine) 57 57 58 58 USE sshwzv ! vertical velocity and ssh (ssh_wzv routine) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r2715 r3094 119 119 ENDIF 120 120 121 IF( kt == nit 000 ) THEN ! Computation of decay coeffcient121 IF( kt == nittrc000 ) THEN ! Computation of decay coeffcient 122 122 zdemi = 5730._wp 123 123 xlambda = LOG(2.) / zdemi / ( nyear_len(1) * rday ) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
r2715 r3094 37 37 !! 38 38 !! ** Method : Read the namcfc namelist and check the parameter 39 !! values called at the first timestep (nit 000)39 !! values called at the first timestep (nittrc000) 40 40 !! 41 41 !! ** input : Namelist namcfc -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r2715 r3094 97 97 ENDIF 98 98 99 IF( kt == nit 000 ) CALL trc_cfc_cst99 IF( kt == nittrc000 ) CALL trc_cfc_cst 100 100 101 101 ! Temporal interpolation -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r2715 r3094 95 95 #endif 96 96 97 IF( kt == nit 000 ) THEN97 IF( kt == nittrc000 ) THEN 98 98 IF(lwp) WRITE(numout,*) 99 99 IF(lwp) WRITE(numout,*) ' trc_bio: LOBSTER bio-model' -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r2715 r3094 61 61 !!--------------------------------------------------------------------- 62 62 63 IF( kt == nit 000 ) THEN63 IF( kt == nittrc000 ) THEN 64 64 IF(lwp) WRITE(numout,*) 65 65 IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export' -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r2715 r3094 72 72 END IF 73 73 74 IF( kt == nit 000 ) THEN74 IF( kt == nittrc000 ) THEN 75 75 IF(lwp) WRITE(numout,*) 76 76 IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model' -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r2715 r3094 74 74 END IF 75 75 76 IF( kt == nit 000 ) THEN76 IF( kt == nittrc000 ) THEN 77 77 IF(lwp) WRITE(numout,*) 78 78 IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation' -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90
r2774 r3094 329 329 330 330 ! Calendar computation 331 IF( kt == nit 000 .OR. imois /= nflx1 ) THEN332 333 IF( kt == nit 000 ) nflx1 = 0331 IF( kt == nittrc000 .OR. imois /= nflx1 ) THEN 332 333 IF( kt == nittrc000 ) nflx1 = 0 334 334 335 335 ! nflx1 number of the first file record used in the simulation -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90
r2715 r3094 245 245 #if defined key_dtatrc 246 246 ! Restore close seas values to initial data 247 CALL trc_dta( nit 000 )247 CALL trc_dta( nittrc000 ) 248 248 DO jn = 1, jptra 249 249 IF( lutini(jn) ) THEN -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
r2715 r3094 72 72 !!--------------------------------------------------------------------- 73 73 74 IF( kt == nit 000 ) CALL trc_sms_pisces_init ! Initialization (first time-step only)74 IF( kt == nittrc000 ) CALL trc_sms_pisces_init ! Initialization (first time-step only) 75 75 76 76 IF( wrk_in_use(3,1) ) THEN -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90
r2761 r3094 449 449 450 450 dtsed = rdt 451 nitsed000 = nit 000451 nitsed000 = nittrc000 452 452 nitsedend = nitend 453 453 #if ! defined key_sed_off -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/SED/sedmodel.F90
r2528 r3094 35 35 36 36 37 IF( kt == nit 000 ) CALL sed_init ! Initialization of sediment model37 IF( kt == nittrc000 ) CALL sed_init ! Initialization of sediment model 38 38 39 39 CALL sed_stp( kt ) ! Time stepping of Sediment model -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/SED/sedwri.F90
r2761 r3094 56 56 ! Initialisation 57 57 ! ----------------- 58 IF( kt == nit 000 ) ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) )58 IF( kt == nittrc000 ) ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) ) 59 59 60 60 ! Define frequency of output and means -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r2715 r3094 35 35 INTEGER :: nadv ! choice of the type of advection scheme 36 36 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 37 ! ! except at nit 000 (=rdttra) if neuler=037 ! ! except at nitrrc000 (=rdttra) if neuler=0 38 38 39 39 !! * Substitutions … … 80 80 ENDIF 81 81 82 IF( kt == nit 000 ) CALL trc_adv_ctl ! initialisation & control of options82 IF( kt == nittrc000 ) CALL trc_adv_ctl ! initialisation & control of options 83 83 84 84 #if ! defined key_pisces 85 IF( neuler == 0 .AND. kt == nit 000 ) THEN ! at nit00085 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 86 86 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 87 ELSEIF( kt <= nit 000 + nn_dttrc ) THEN ! at nit000 or nit000+187 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 88 88 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 89 89 ENDIF … … 103 103 104 104 ! ! add the eiv transport (if necessary) 105 IF( lk_traldf_eiv ) CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRC' )105 IF( lk_traldf_eiv ) CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 106 106 ! 107 107 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 108 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered109 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD110 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra ) ! MUSCL111 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2112 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS113 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST108 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered 109 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD 110 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra ) ! MUSCL 111 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2 112 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS 113 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST 114 114 ! 115 115 CASE (-1 ) !== esopa: test all possibility with control print ==! 116 CALL tra_adv_cen2 ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra )116 CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) 117 117 WRITE(charout, FMT="('adv1')") ; CALL prt_ctl_trc_info(charout) 118 118 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 119 CALL tra_adv_tvd ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )119 CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 120 120 WRITE(charout, FMT="('adv2')") ; CALL prt_ctl_trc_info(charout) 121 121 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 122 CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra )122 CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra ) 123 123 WRITE(charout, FMT="('adv3')") ; CALL prt_ctl_trc_info(charout) 124 124 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 125 CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )125 CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 126 126 WRITE(charout, FMT="('adv4')") ; CALL prt_ctl_trc_info(charout) 127 127 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 128 CALL tra_adv_ubs ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )128 CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 129 129 WRITE(charout, FMT="('adv5')") ; CALL prt_ctl_trc_info(charout) 130 130 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 131 CALL tra_adv_qck ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )131 CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 132 132 WRITE(charout, FMT="('adv6')") ; CALL prt_ctl_trc_info(charout) 133 133 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r2528 r3094 56 56 !!---------------------------------------------------------------------- 57 57 58 IF( .NOT. lk_offline ) THEN59 CALL bbl( kt, 'TRC' )! Online coupling with dynamics : Computation of bbl coef and bbl transport60 l_bbl = .FALSE. ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files58 IF( .NOT. lk_offline .AND. nn_dttrc == 1 ) THEN 59 CALL bbl( kt, nittrc000, 'TRC' ) ! Online coupling with dynamics : Computation of bbl coef and bbl transport 60 l_bbl = .FALSE. ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 61 61 ENDIF 62 62 63 63 IF( l_trdtrc ) THEN 64 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) 64 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends 65 65 ztrtrd(:,:,:,:) = tra(:,:,:,:) 66 66 ENDIF -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r2715 r3094 94 94 ! 0. Initialization (first time-step only) 95 95 ! -------------- 96 IF( kt == nit 000 ) CALL trc_dmp_init96 IF( kt == nittrc000 ) CALL trc_dmp_init 97 97 98 98 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) ! temporary save of trends … … 173 173 !! 174 174 !! ** Method : read the nammbf namelist and check the parameters 175 !! called by trc_dmp at the first timestep (nit 000)175 !! called by trc_dmp at the first timestep (nittrc000) 176 176 !!---------------------------------------------------------------------- 177 177 -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r2715 r3094 59 59 !!---------------------------------------------------------------------- 60 60 61 IF( kt == nit 000 ) CALL ldf_ctl ! initialisation & control of options61 IF( kt == nittrc000 ) CALL ldf_ctl ! initialisation & control of options 62 62 63 63 IF( l_trdtrc ) THEN … … 67 67 68 68 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 69 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level laplacian70 CASE ( 1 ) ; CALL tra_ldf_iso ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) ! rotated laplacian71 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level bilaplacian72 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian69 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level laplacian 70 CASE ( 1 ) ; CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) ! rotated laplacian 71 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level bilaplacian 72 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian 73 73 ! 74 74 CASE ( -1 ) ! esopa: test all possibility with control print 75 CALL tra_ldf_lap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra )75 CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) 76 76 WRITE(charout, FMT="('ldf0 ')") ; CALL prt_ctl_trc_info(charout) 77 77 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 78 CALL tra_ldf_iso ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )78 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 79 79 WRITE(charout, FMT="('ldf1 ')") ; CALL prt_ctl_trc_info(charout) 80 80 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 81 CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra )81 CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) 82 82 WRITE(charout, FMT="('ldf2 ')") ; CALL prt_ctl_trc_info(charout) 83 83 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 84 CALL tra_ldf_bilapg( kt, 'TRC', trb, tra, jptra )84 CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) 85 85 WRITE(charout, FMT="('ldf3 ')") ; CALL prt_ctl_trc_info(charout) 86 86 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r2715 r3094 96 96 !!---------------------------------------------------------------------- 97 97 98 IF( kt == nit 000 .AND. lwp ) THEN98 IF( kt == nittrc000 .AND. lwp ) THEN 99 99 WRITE(numout,*) 100 100 WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' … … 119 119 120 120 ! set time step size (Euler/Leapfrog) 121 IF( neuler == 0 .AND. kt == nit 000) THEN ; r2dt(:) = rdttrc(:) ! at nit000 (Euler)122 ELSEIF( kt <= nit 000 + 1) THEN ; r2dt(:) = 2.* rdttrc(:) ! at nit000 or nit000+1 (Leapfrog)121 IF( neuler == 0 .AND. kt == nittrc000) THEN ; r2dt(:) = rdttrc(:) ! at nittrc000 (Euler) 122 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; r2dt(:) = 2.* rdttrc(:) ! at nit000 or nit000+1 (Leapfrog) 123 123 ENDIF 124 124 … … 129 129 ENDIF 130 130 ! Leap-Frog + Asselin filter time stepping 131 IF( neuler == 0 .AND. kt == nit 000 ) THEN ! Euler time-stepping at first time-step132 ! ! (only swap)131 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! Euler time-stepping at first time-step 132 ! ! (only swap) 133 133 DO jn = 1, jptra 134 134 DO jk = 1, jpkm1 … … 139 139 ELSE 140 140 ! Leap-Frog + Asselin filter time stepping 141 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, 'TRC', trb, trn, tra, jptra ) ! variable volume level (vvl)142 ELSE ; CALL tra_nxt_fix( kt, 'TRC', trb, trn, tra, jptra ) ! fixed volume level141 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt,nittrc000, 'TRC', trb, trn, tra, jptra ) ! variable volume level (vvl) 142 ELSE ; CALL tra_nxt_fix( kt,nittrc000, 'TRC', trb, trn, tra, jptra ) ! fixed volume level 143 143 ENDIF 144 144 ENDIF -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r2715 r3094 53 53 !!---------------------------------------------------------------------- 54 54 55 IF( kt == nit 000 ) THEN55 IF( kt == nittrc000 ) THEN 56 56 IF(lwp) WRITE(numout,*) 57 57 IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r2715 r3094 72 72 END IF 73 73 74 IF( kt == nit 000 ) THEN74 IF( kt == nittrc000 ) THEN 75 75 IF(lwp) WRITE(numout,*) 76 76 IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r2715 r3094 32 32 ! ! defined from ln_zdf... namlist logicals) 33 33 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 34 ! ! except at nit 000 (=rdttra) if neuler=034 ! ! except at nittrc000 (=rdttra) if neuler=0 35 35 36 36 !! * Substitutions … … 69 69 !!--------------------------------------------------------------------- 70 70 71 IF( kt == nit 000 ) CALL zdf_ctl ! initialisation & control of options71 IF( kt == nittrc000 ) CALL zdf_ctl ! initialisation & control of options 72 72 73 73 #if ! defined key_pisces 74 IF( neuler == 0 .AND. kt == nit 000 ) THEN ! at nit00074 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 75 75 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 76 ELSEIF( kt <= nit 000 + nn_dttrc ) THEN ! at nit000 or nit000+176 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+nn_dttrc 77 77 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 78 78 ENDIF … … 88 88 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 89 89 CASE ( -1 ) ! esopa: test all possibility with control print 90 CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )90 CALL tra_zdf_exp( kt,nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) 91 91 WRITE(charout, FMT="('zdf1 ')") ; CALL prt_ctl_trc_info(charout) 92 92 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 93 CALL tra_zdf_imp( kt, 'TRC', r2dt, trb, tra, jptra )93 CALL tra_zdf_imp( kt,nittrc000, 'TRC', r2dt, trb, tra, jptra ) 94 94 WRITE(charout, FMT="('zdf2 ')") ; CALL prt_ctl_trc_info(charout) 95 95 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 96 CASE ( 0 ) ; CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme97 CASE ( 1 ) ; CALL tra_zdf_imp( kt, 'TRC', r2dt, trb, tra, jptra ) ! implicit scheme96 CASE ( 0 ) ; CALL tra_zdf_exp( kt,nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme 97 CASE ( 1 ) ; CALL tra_zdf_imp( kt,nittrc000, 'TRC', r2dt, trb, tra, jptra ) ! implicit scheme 98 98 99 99 END SELECT -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90
r2715 r3094 475 475 ! II.1 Set before values of vertically averages passive tracers 476 476 ! ------------------------------------------------------------- 477 IF( kt > nit 000 ) THEN477 IF( kt > nittrc000 ) THEN 478 478 DO jn = 1, jptra 479 479 IF( ln_trdtrc(jn) ) THEN … … 497 497 ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window 498 498 ! ------------------------------------------------------------------------ 499 IF( kt == 2) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) ???499 IF( kt == nittrc000 + nn_dttrc ) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) ??? 500 500 ! 501 501 DO jn = 1, jptra … … 560 560 tmltrd_trc(:,:,:,:) = tmltrd_trc(:,:,:,:) * rn_ucf_trc 561 561 562 itmod = kt - nit 000 + 1562 itmod = kt - nittrc000 + 1 563 563 it = kt 564 564 … … 980 980 ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window 981 981 ! ------------------------------------------------------------------------ 982 IF( kt == 2) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)982 IF( kt == nittrc000 + nn_dttrc ) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) 983 983 ! 984 984 tmltrd_csum_ub_bio (:,:,:) = 0.e0 … … 1086 1086 1087 1087 ! define time axis 1088 itmod = kt - nit 000 + 11088 itmod = kt - nittrc000 + 1 1089 1089 it = kt 1090 1090 … … 1331 1331 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 1332 1332 IF(lwp) WRITE(numout,*)' ' 1333 IF(lwp) WRITE(numout,*)' Date 0 used :', nit 000&1333 IF(lwp) WRITE(numout,*)' Date 0 used :', nittrc000 & 1334 1334 & ,' YEAR ', nyear, ' MONTH ', nmonth,' DAY ', nday & 1335 1335 & ,'Julian day : ', zjulian … … 1360 1360 CALL dia_nam( clhstnam, nn_trd_trc, csuff ) 1361 1361 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 1362 & 1, jpi, 1, jpj, nit 000, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set )1362 & 1, jpi, 1, jpj, nittrc000, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 1363 1363 1364 1364 !-- Define the ML depth variable … … 1373 1373 CALL dia_nam( clhstnam, nn_trd_trc, 'trdbio' ) 1374 1374 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 1375 & 1, jpi, 1, jpj, nit 000, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set )1375 & 1, jpi, 1, jpj, nittrc000, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set ) 1376 1376 #endif 1377 1377 -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90
r2528 r3094 50 50 !!---------------------------------------------------------------------- 51 51 52 IF( kt == nit 000 ) THEN52 IF( kt == nittrc000 ) THEN 53 53 ! IF(lwp)WRITE(numout,*) 54 54 ! IF(lwp)WRITE(numout,*) 'trd_mod_trc:' -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r2787 r3094 108 108 USE dom_oce , ONLY : e3w_0 => e3w_0 !: reference depth of w-points (m) 109 109 USE dom_oce , ONLY : gdepw_0 => gdepw_0 !: reference depth of w-points (m) 110 # if ! defined key_zco 110 111 USE dom_oce , ONLY : gdep3w => gdep3w !: ??? 111 112 USE dom_oce , ONLY : gdept => gdept !: depth of t-points (m) … … 118 119 USE dom_oce , ONLY : e3uw => e3uw !: uw-points (m) 119 120 USE dom_oce , ONLY : e3vw => e3vw !: vw-points (m) 120 121 # endif 121 122 USE dom_oce , ONLY : ln_zps => ln_zps !: partial steps flag 122 123 USE dom_oce , ONLY : ln_sco => ln_sco !: s-coordinate flag … … 192 193 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 193 194 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s) 195 USE oce , ONLY : rotn => rotn !: relative vorticity [s-1] 196 USE oce , ONLY : hdivb => hdivb !: horizontal divergence (1/s) 197 USE oce , ONLY : rotb => rotb !: relative vorticity [s-1] 198 USE oce , ONLY : sshn => sshn !: sea surface height at t-point [m] 199 USE oce , ONLY : sshb => sshb !: sea surface height at t-point [m] 200 USE oce , ONLY : ssha => ssha !: sea surface height at t-point [m] 201 USE oce , ONLY : sshu_n => sshu_n !: sea surface height at u-point [m] 202 USE oce , ONLY : sshu_b => sshu_b !: sea surface height at u-point [m] 203 USE oce , ONLY : sshu_a => sshu_a !: sea surface height at u-point [m] 204 USE oce , ONLY : sshv_n => sshv_n !: sea surface height at v-point [m] 205 USE oce , ONLY : sshv_b => sshv_b !: sea surface height at v-point [m] 206 USE oce , ONLY : sshv_a => sshv_a !: sea surface height at v-point [m] 207 USE oce , ONLY : sshf_n => sshf_n !: sea surface height at v-point [m] 208 USE oce , ONLY : l_traldf_rot => l_traldf_rot !: rotated laplacian operator for lateral diffusion 194 209 USE oce , ONLY : l_traldf_rot => l_traldf_rot !: rotated laplacian operator for lateral diffusion 195 210 #if defined key_offline … … 212 227 USE sbc_oce , ONLY : qsr => qsr !: penetrative solar radiation (w m-2) 213 228 USE sbc_oce , ONLY : emp => emp !: freshwater budget: volume flux [Kg/m2/s] 229 USE sbc_oce , ONLY : emp_b => emp_b !: freshwater budget: volume flux [Kg/m2/s] 214 230 USE sbc_oce , ONLY : emps => emps !: freshwater budget: concentration/dillution [Kg/m2/s] 215 231 USE sbc_oce , ONLY : rnf => rnf !: river runoff [Kg/m2/s] … … 222 238 USE sbcrnf , ONLY : rnfmsk => rnfmsk !: mixed adv scheme in runoffs vicinity (hori.) 223 239 USE sbcrnf , ONLY : rnfmsk_z => rnfmsk_z !: mixed adv scheme in runoffs vicinity (vert.) 240 USE sbcrnf , ONLY : h_rnf => h_rnf !: river runoff [Kg/m2/s] 224 241 225 242 USE trc_oce -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/trc.F90
r2715 r3094 58 58 CHARACTER(len=50), PUBLIC :: cn_trcrst_in !: suffix of pass. tracer restart name (input) 59 59 CHARACTER(len=50), PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output) 60 61 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model 60 62 61 63 !! information for outputs … … 97 99 # if defined key_dtatrc 98 100 INTEGER , PUBLIC, DIMENSION(jptra) :: numtr !: logical unit for passive tracers data 101 # endif 102 103 !! variables to average over physics over passive tracer sub-steps. 104 !! ---------------------------------------------------------------- 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_tm !: i-horizontal velocity average [m/s] 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vn_tm !: j-horizontal velocity average [m/s] 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsn_tm !: t/s average [m/s] 108 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_tm !: vertical diffusivity coeff. at w-point [m2/s] 109 # if defined key_zdfddm 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_tm !: vertical double diffusivity coeff. at w-point [m/s] 111 # endif 112 #if defined key_ldfslp 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpi_tm !: i-direction slope at u-, w-points 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpj_tm !: j-direction slope at u-, w-points 115 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm !: j-direction slope at u-, w-points 116 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vslp_tm !: j-direction slope at u-, w-points 117 #endif 118 #if defined key_trabbl 119 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_tm !: u-, w-points 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahv_bbl_tm !: j-direction slope at u-, w-points 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utr_bbl_tm !: j-direction slope at u-, w-points 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtr_bbl_tm !: j-direction slope at u-, w-points 123 #endif 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_tm !: average ssh for the now step [m] 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_n_tm !: average ssh for the now step [m] 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_n_tm !: average ssh for the now step [m] 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshb_hold !:hold sshb from the beginning of each sub-stepping[m] 128 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_b_hold !:hold sshb from the beginning of each sub-stepping[m] 129 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_b_hold !:hold sshb from the beginning of each sub-stepping[m] 130 131 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf_tm !: river runoff 132 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h_rnf_tm !: depth in metres to the bottom of the relevant grid box 133 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld_tm !: mixed layer depth average [m] 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i_tm !: average ice fraction [m/s] 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tm !: freshwater budget: volume flux [Kg/m2/s] 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emps_tm !: freshwater budget:concentration/dilution [Kg/m2/s] 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_b_hold !: hold emp from the beginning of each sub-stepping[m] 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tm !: solar radiation average [m] 139 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm_tm !: 10m wind average [m] 140 ! 141 #if defined key_traldf_c3d 142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm !: ** 3D coefficients ** at T-,U-,V-,W-points 143 #elif defined key_traldf_c2d 144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm !: ** 2D coefficients ** at T-,U-,V-,W-points 145 #elif defined key_traldf_c1d 146 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm !: ** 1D coefficients ** at T-,U-,V-,W-points 147 #else 148 REAL(wp), PUBLIC :: ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm !: ** 0D coefficients ** at T-,U-,V-,W-points 149 #endif 150 ! 151 #if defined key_traldf_eiv 152 # if defined key_traldf_c3d 153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aeiu_tm , aeiv_tm , aeiw_tm !: ** 3D coefficients ** 154 # elif defined key_traldf_c2d 155 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: aeiu_tm , aeiv_tm , aeiw_tm !: ** 2D coefficients ** 156 # elif defined key_traldf_c1d 157 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: aeiu_tm , aeiv_tm, aeiw_tm !: ** 1D coefficients ** 158 # else 159 REAL(wp), PUBLIC :: aeiu_tm , aeiv_tm , aeiw_tm !: ** 0D coefficients ** 160 # endif 161 #endif 162 163 ! Temporary physical arrays for sub_stepping 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsn_temp 165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_temp,vn_temp,wn_temp !: hold current values of avt, un, vn, wn 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_temp !: hold current values of avt, un, vn, wn 167 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_temp,e3u_temp,e3v_temp,e3w_temp !: hold current values 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_temp, sshb_temp, ssha_temp, rnf_temp,h_rnf_temp 169 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_n_temp, sshu_b_temp, sshu_a_temp 170 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshf_n_temp 171 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_n_temp, sshv_b_temp, sshv_a_temp 172 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_temp, hv_temp, hur_temp, hvr_temp 173 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivn_temp, rotn_temp 174 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivb_temp, rotb_temp 175 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld_temp, qsr_temp, fr_i_temp,wndm_temp 176 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_temp, emps_temp, emp_b_temp 177 ! 178 #if defined key_trabbl 179 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_temp, ahv_bbl_temp, utr_bbl_temp, vtr_bbl_temp !: hold current values 180 #endif 181 ! 182 #if defined key_ldfslp 183 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpi_temp, wslpj_temp, uslp_temp, vslp_temp !: hold current values 184 #endif 185 ! 186 # if defined key_zdfddm 187 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_temp !: salinity vertical diffusivity coeff. at w-point [m/s] 188 # endif 189 ! 190 #if defined key_traldf_c3d 191 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 192 #elif defined key_traldf_c2d 193 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 194 #elif defined key_traldf_c1d 195 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 196 #else 197 REAL(wp), PUBLIC :: ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 198 #endif 199 ! 200 #if defined key_traldf_eiv 201 # if defined key_traldf_c3d 202 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aeiu_temp , aeiv_temp , aeiw_temp !: ** 3D coefficients ** 203 # elif defined key_traldf_c2d 204 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: aeiu_temp , aeiv_temp , aeiw_temp !: ** 2D coefficients ** 205 # elif defined key_traldf_c1d 206 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: aeiu_temp , aeiv_temp, aeiw_temp !: ** 1D coefficients ** 207 # else 208 REAL(wp), PUBLIC :: aeiu_temp , aeiv_temp , aeiw_temp !: ** 0D coefficients ** 209 # endif 99 210 # endif 100 211 -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
r2715 r3094 85 85 !! ** Purpose : Standard output of passive tracer : concentration fields 86 86 !! 87 !! ** Method : At the beginning of the first time step (nit 000), define all87 !! ** Method : At the beginning of the first time step (nittrc000), define all 88 88 !! the NETCDF files and fields for concentration of passive tracer 89 89 !! … … 135 135 136 136 ! define time axis 137 itmod = kt - nit 000 + 1137 itmod = kt - nittrc000 + 1 138 138 it = kt 139 139 iiter = ( nit000 - 1 ) / nn_dttrc … … 144 144 IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic 145 145 146 IF( kt == nit 000 ) THEN146 IF( kt == nittrc000 ) THEN 147 147 148 148 ! Compute julian date from starting date of the run … … 150 150 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 151 151 IF(lwp)WRITE(numout,*)' ' 152 IF(lwp)WRITE(numout,*)' Date 0 used :', nit 000 &152 IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000 & 153 153 & ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday & 154 154 & ,'Julian day : ', zjulian … … 226 226 !! ** Purpose : output of passive tracer : additional 2D and 3D arrays 227 227 !! 228 !! ** Method : At the beginning of the first time step (nit 000), define all228 !! ** Method : At the beginning of the first time step (nittrc000), define all 229 229 !! the NETCDF files and fields for concentration of passive tracer 230 230 !! … … 275 275 276 276 ! define time axis 277 itmod = kt - nit 000 + 1277 itmod = kt - nittrc000 + 1 278 278 it = kt 279 279 iiter = ( nit000 - 1 ) / nn_dttrc … … 284 284 IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic 285 285 286 IF( kt == nit 000 ) THEN286 IF( kt == nittrc000 ) THEN 287 287 288 288 ! Define the NETCDF files for additional arrays : 2D or 3D … … 375 375 !! ** Purpose : output of passive tracer : biological fields 376 376 !! 377 !! ** Method : At the beginning of the first time step (nit 000), define all377 !! ** Method : At the beginning of the first time step (nittrc000), define all 378 378 !! the NETCDF files and fields for concentration of passive tracer 379 379 !! … … 424 424 425 425 ! define time axis 426 itmod = kt - nit 000 + 1426 itmod = kt - nittrc000 + 1 427 427 it = kt 428 428 iiter = ( nit000 - 1 ) / nn_dttrc … … 433 433 IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 434 434 435 IF( kt == nit 000 ) THEN435 IF( kt == nittrc000 ) THEN 436 436 437 437 ! Define the NETCDF files for biological trends -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r2715 r3094 71 71 IF( lutini(jn) ) THEN 72 72 73 IF ( kt == nit 000 ) THEN73 IF ( kt == nittrc000 ) THEN 74 74 !! 3D tracer data 75 75 IF(lwp)WRITE(numout,*) … … 86 86 87 87 88 ! First call kt=nit 00088 ! First call kt=nittrc000 89 89 ! -------------------- 90 90 91 IF ( kt == nit 000 .AND. nlectr(jn) == 0 ) THEN91 IF ( kt == nittrc000 .AND. nlectr(jn) == 0 ) THEN 92 92 ntrc1(jn) = 0 93 93 IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields' … … 104 104 # if defined key_pisces 105 105 ! Read montly file 106 IF( ( kt == nit 000 .AND. nlectr(jn) == 0) .OR. imois /= ntrc1(jn) ) THEN106 IF( ( kt == nittrc000 .AND. nlectr(jn) == 0) .OR. imois /= ntrc1(jn) ) THEN 107 107 nlectr(jn) = 1 108 108 … … 186 186 # else 187 187 ! Read init file only 188 IF( kt == nit 000 ) THEN188 IF( kt == nittrc000 ) THEN 189 189 ntrc1(jn) = 1 190 190 CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) ) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r2715 r3094 29 29 USE zpshde ! partial step: hor. derivative (zps_hde routine) 30 30 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) 31 USE trcsub ! variables to substep passive tracers 31 32 32 33 IMPLICIT NONE … … 122 123 IF( ln_rsttr ) THEN 123 124 ! 124 IF( lk_offline ) neuler = 1 ! Set time-step indicator at nit 000 (leap-frog)125 IF( lk_offline ) neuler = 1 ! Set time-step indicator at nittrc000 (leap-frog) 125 126 CALL trc_rst_read ! restart from a file 126 127 ! 127 128 ELSE 128 129 IF( lk_offline ) THEN 129 neuler = 0 ! Set time-step indicator at nit 000 (euler)130 neuler = 0 ! Set time-step indicator at nittrc000 (euler) 130 131 CALL day_init ! set calendar 131 132 ENDIF 132 133 #if defined key_dtatrc 133 CALL trc_dta( nit 000 ) ! Initialization of tracer from a file that may also be used for damping134 CALL trc_dta( nittrc000 ) ! Initialization of tracer from a file that may also be used for damping 134 135 DO jn = 1, jptra 135 136 IF( lutini(jn) ) trn(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:) ! initialisation from file if required … … 143 144 144 145 IF( ln_zps .AND. .NOT. lk_c1d ) & ! Partial steps: before horizontal gradient of passive 145 & CALL zps_hde( nit 000, jptra, trn, gtru, gtrv ) ! tracers at the bottom ocean level146 147 146 & CALL zps_hde( nittrc000, jptra, trn, gtru, gtrv ) ! tracers at the bottom ocean level 147 ! 148 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 148 149 ! 149 150 trai = 0._wp ! Computation content of all tracers -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r2715 r3094 109 109 END DO 110 110 111 !!KPE computes the first time step of tracer model 112 nittrc000 = nit000 + nn_dttrc - 1 113 111 114 112 115 IF(lwp) THEN ! control print … … 114 117 WRITE(numout,*) ' Namelist : namtrc' 115 118 WRITE(numout,*) ' time step freq. for pass. trac. nn_dttrc = ', nn_dttrc 119 WRITE(numout,*) ' first time step for pass. trac. nittrc000 = ', nittrc000 116 120 WRITE(numout,*) ' frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc 117 121 WRITE(numout,*) ' restart LOGICAL for passive tr. ln_rsttr = ', ln_rsttr -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r2715 r3094 60 60 ! 61 61 IF( lk_offline ) THEN 62 IF( kt == nit 000 ) THEN62 IF( kt == nittrc000 ) THEN 63 63 lrst_trc = .FALSE. 64 64 nitrst = nitend … … 71 71 ENDIF 72 72 ELSE 73 IF( kt == nit 000 ) lrst_trc = .FALSE.73 IF( kt == nittrc000 ) lrst_trc = .FALSE. 74 74 ENDIF 75 75 … … 77 77 ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 78 78 ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 79 IF( kt == nitrst - 2*nn_dttrc + 1 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc + 1.AND. .NOT. lrst_trc ) ) THEN79 IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 80 80 ! beware of the format used to write kt (default is i8.8, that should be large enough) 81 81 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst … … 119 119 ! Time domain : restart 120 120 ! --------------------- 121 CALL trc_rst_cal( nit 000, 'READ' ) ! calendar121 CALL trc_rst_cal( nittrc000, 'READ' ) ! calendar 122 122 123 123 ! READ prognostic variables and computes diagnostic variable … … 151 151 REAL(wp) :: zarak0 152 152 !!---------------------------------------------------------------------- 153 154 153 155 154 CALL trc_rst_cal( kt, 'WRITE' ) ! calendar … … 196 195 !! 197 196 !! According to namelist parameter nrstdt, 198 !! nn_rsttr = 0 no control on the date (nit 000 is arbitrary).199 !! nn_rsttr = 1 we verify that nit 000 is equal to the last197 !! nn_rsttr = 0 no control on the date (nittrc000 is arbitrary). 198 !! nn_rsttr = 1 we verify that nittrc000 is equal to the last 200 199 !! time step of previous run + 1. 201 200 !! In both those options, the exact duration of the experiment … … 223 222 WRITE(numout,*) ' *** restart option' 224 223 SELECT CASE ( nn_rsttr ) 225 CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nit 000'226 CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit 000 (use ndate0 read in the namelist)'224 CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 225 CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 227 226 CASE ( 2 ) ; WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 228 227 END SELECT … … 230 229 ENDIF 231 230 ! Control of date 232 IF( nit 000 - NINT( zkt ) /= 1.AND. nn_rsttr /= 0 ) &233 & CALL ctl_stop( ' ===>>>> : problem with nit 000 for the restart', &231 IF( nittrc000 - NINT( zkt ) /= nn_dttrc .AND. nn_rsttr /= 0 ) & 232 & CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', & 234 233 & ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 235 234 IF( lk_offline ) THEN ! set the date in offline mode … … 246 245 ELSE 247 246 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam 248 adatrj = ( REAL( nit 000-1, wp ) * rdttra(1) ) / rday247 adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday 249 248 ! note this is wrong if time step has changed during run 250 249 ENDIF -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r2528 r3094 22 22 USE iom 23 23 USE in_out_manager 24 USE trcsub 24 25 25 26 IMPLICIT NONE … … 27 28 28 29 PUBLIC trc_stp ! called by step 30 # include "domzgr_substitute.h90" 29 31 30 32 !!---------------------------------------------------------------------- … … 49 51 !!------------------------------------------------------------------- 50 52 51 IF( MOD( kt - 1 , nn_dttrc ) == 0 ) THEN ! only every nn_dttrc time step 53 IF( nn_dttrc /= 1 ) CALL trc_sub_stp( kt ) ! averaging physical variables for sub-stepping 54 55 IF( MOD( kt , nn_dttrc ) == 0 ) THEN ! only every nn_dttrc time step 52 56 ! 53 57 IF(ln_ctl) THEN … … 58 62 tra(:,:,:,:) = 0.e0 59 63 ! 60 IF( kt == nit 000 .AND. lk_trdmld_trc ) &64 IF( kt == nittrc000 .AND. lk_trdmld_trc ) & 61 65 & CALL trd_mld_trc_init ! trends: Mixed-layer 62 66 CALL trc_rst_opn( kt ) ! Open tracer restart file … … 66 70 CALL trc_sms( kt ) ! tracers: sink and source 67 71 CALL trc_trp( kt ) ! transport of passive tracers 68 IF( kt == nit000 ) CALL iom_close( numrtr ) ! close input passive tracers restart file 69 IF( lrst_trc ) CALL trc_rst_wri( kt ) ! write tracer restart file 70 IF( lk_trdmld_trc ) CALL trd_mld_trc( kt ) ! trends: Mixed-layer 72 IF( kt == nittrc000 ) CALL iom_close( numrtr ) ! close input passive tracers restart file 73 IF( lrst_trc ) CALL trc_rst_wri( kt ) ! write tracer restart file 74 IF( lk_trdmld_trc ) CALL trd_mld_trc( kt ) ! trends: Mixed-layer 75 ! 76 IF( nn_dttrc /= 1 ) CALL trc_sub_reset( kt ) ! resetting physical variables when sub-stepping 71 77 ! 72 78 ENDIF -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r2567 r3094 57 57 !!--------------------------------------------------------------------- 58 58 59 IF( lk_offline .AND. kt == nit 000 .AND. lwp ) THEN ! WRITE root name in date.file for use by postpro59 IF( lk_offline .AND. kt == nittrc000 .AND. lwp ) THEN ! WRITE root name in date.file for use by postpro 60 60 CALL dia_nam( clhstnam, nn_writetrc,' ' ) 61 61 CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/TOOLS/COMPILE/cfg.txt
r2413 r3094 3 3 GYRE_LOBSTER OPA_SRC TOP_SRC 4 4 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 5 POMME OPA_SRC NST_SRC6 5 ORCA2_LIM3 OPA_SRC LIM_SRC_3 7 6 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 7 POMME OPA_SRC NST_SRC 8 AMM OPA_SRC TOP_SRC 9 AMM-PISCES OPA_SRC TOP_SRC
Note: See TracChangeset
for help on using the changeset viewer.