New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
ooo_data.F90 in branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC – NEMO

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90 @ 5006

Last change on this file since 5006 was 4132, checked in by andrewryan, 10 years ago

renamed namoff to namooo to further reduce confusion with OFF_SRC, documentation, quick script, example namelist and data module have been updated and tested to reflect this change

File size: 6.1 KB
Line 
1MODULE ooo_data
2   !! =================================================================
3   !!                    *** MODULE ooo_data ***
4   !! =================================================================
5   USE par_kind, ONLY: lc
6
7   IMPLICIT NONE
8
9   !! Public data
10
11   INTEGER, PARAMETER :: MaxNumFiles = 1000
12
13   !! Class 4 file settings
14   INTEGER :: &
15           & cl4_fcst_idx(MaxNumFiles), & !: forecast indices
16           & cl4_match_len, &             !: number of match types
17           & cl4_fcst_len                 !: number of forecast days
18   CHARACTER(len=lc) :: &
19           & cl4_vars(MaxNumFiles), &  !: class 4 variables
20           & cl4_sys, &                !: class 4 system
21           & cl4_cfg, &                !: class 4 configuration
22           & cl4_date, &               !: class 4 date
23           & cl4_vn,  &                !: class 4 version
24           & cl4_prefix, &             !: class 4 prefix
25           & cl4_contact, &            !: class 4 contact
26           & cl4_inst                  !: class 4 institute
27   REAL ::   cl4_modjuld               !: model Julian day
28   REAL :: &
29      & cl4_leadtime(MaxNumFiles)      !: Lead time data
30
31   !! Offline obs_oper settings
32   CHARACTER(len=lc) :: &
33      & ooo_files(MaxNumFiles)         !: model files
34   INTEGER            :: &
35      & jifile, &                      !: current file list index
36      & n_files, &                     !: number of files
37      & jimatch, &                     !: current match
38      & nn_ooo_idx(MaxNumFiles), &     !: time_counter indices
39      & nn_ooo_freq                    !: read frequency in time steps
40   CHARACTER(len=128) :: &
41      & alt_file                       !: altimeter file
42CONTAINS
43   SUBROUTINE ooo_data_init( ld_cl4 )
44      !!----------------------------------------------------------------------
45      !!                    ***  SUBROUTINE ooo_data_init ***
46      !!
47      !! ** Purpose : To read namelists and initialise offline_oper run.
48      !!
49      !!----------------------------------------------------------------------
50      USE in_out_manager
51      INTEGER            :: &
52         & jf                           !: file dummy loop index
53      LOGICAL :: lmask(MaxNumFiles)     !: Logical mask used for counting
54      LOGICAL, INTENT(IN) :: ld_cl4     !: Logical class 4 on/off
55
56      ! Standard offline obs_oper information
57      NAMELIST/namooo/ooo_files, nn_ooo_idx, nn_ooo_freq
58
59      ! Class 4 file specifiers
60      NAMELIST/namcl4/cl4_vars, cl4_sys, cl4_cfg, cl4_date, cl4_vn, &
61         &            cl4_prefix, cl4_contact, cl4_inst, cl4_leadtime, &
62         &            cl4_fcst_idx, cl4_fcst_len, cl4_match_len
63
64      ! Standard offline obs_oper initialisation
65      jimatch = 0                   !: match-up iteration variable
66      jifile = 1                    !: input file iteration variable
67      n_files = 0                   !: number of files to cycle through
68      ooo_files(:) = ''             !: list of files to read in
69      nn_ooo_idx(:) = 0             !: list of indices inside each file
70      nn_ooo_freq = -1              !: input frequency in time steps
71
72      ! Class 4 initialisation
73      cl4_leadtime(:) = 0           !: Lead time axis value for each file
74      cl4_fcst_len = 0              !: Length of the forecast dimension
75      cl4_match_len = 1             !: Number of match types
76      cl4_fcst_idx(:) = 0           !: output file forecast index
77      cl4_vars(:) = ''              !: output file variable names
78      cl4_sys = ''                  !: output file system
79      cl4_cfg = ''                  !: output file configuration
80      cl4_date = ''                 !: output file date string
81      cl4_vn = ''                   !: output file version
82      cl4_prefix = 'class4'         !: output file prefix
83      cl4_contact = ''              !: output file contact details
84      cl4_inst = ''                 !: output file institution
85
86      ! Standard offline obs_oper settings
87      READ(numnam, namooo)
88
89      ! Read class 4 output settings
90      IF (ld_cl4) THEN
91         READ(numnam, namcl4)
92      ENDIF
93
94      ! count input files
95      lmask(:) = .FALSE.
96      WHERE (ooo_files(:) /= '') lmask(:) = .TRUE.
97      n_files = COUNT(lmask)
98
99      !! Initialise sub obs window frequency
100      IF (nn_ooo_freq == -1) THEN
101         !! Run length
102         nn_ooo_freq = nitend - nit000 + 1
103      ENDIF
104
105      !! Print summary of settings
106      IF(lwp) THEN
107         WRITE(numout,*)
108         WRITE(numout,*) 'offline obs_oper : Initialization'
109         WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
110         WRITE(numout,*) '   Namelist namooo : set offline obs_oper parameters' 
111         DO jf = 1, n_files
112            WRITE(numout,'(1X,2A)') '   Input forecast file name          forecastfile = ', &
113               TRIM(ooo_files(jf))
114            WRITE(numout,*) '   Input forecast file index        forecastindex = ', &
115               nn_ooo_idx(jf)
116            WRITE(numout,*) '   Output forecast leadtime index   leadtimeindex = ', &
117               cl4_fcst_idx(jf)
118            WRITE(numout,*) '   Output forecast leadtime value   leadtimevalue = ', &
119               cl4_leadtime(jf)
120            WRITE(numout,'(1X,2A)') '   Input class 4 variable       class 4 parameter = ', &
121               TRIM(cl4_vars(jf))
122         END DO
123         WRITE(numout, '(1X,2A)') '   Input class 4 system            class 4 system = ', &
124            TRIM(cl4_sys)
125         WRITE(numout, '(1X,2A)') '   Input class 4 config            class 4 config = ', &
126            TRIM(cl4_cfg)
127         WRITE(numout, '(1X,2A)') '   Input class 4 date                class 4 date = ', &
128            TRIM(cl4_date)
129         WRITE(numout, '(1X,2A)') '   Input class 4 version          class 4 version = ', &
130            TRIM(cl4_vn)
131         WRITE(numout, '(1X,2A)') '   Input class 4 prefix            class 4 prefix = ', &
132            TRIM(cl4_prefix)
133         WRITE(numout, '(1X,2A)') '   Input class 4 contact          class 4 contact = ', &
134            TRIM(cl4_contact)
135         WRITE(numout, '(1X,2A)') '   Input class 4 institute      class 4 institute = ', &
136            TRIM(cl4_inst)
137      END IF
138
139   END SUBROUTINE ooo_data_init
140
141END MODULE ooo_data
142
Note: See TracBrowser for help on using the repository browser.